⟦90cfe1bcd⟧

E3 Source Code



package body Ascan_Io is
-- gets input and stuffs it into 'buf'.  number of characters read, or YY_NULL,
-- is returned in 'result'.

    procedure Yy_Input (Buf : out Unbounded_Character_Array;
                        Result : out Integer;
                        Max_Size : in Integer) is
        C : Character;
        I : Integer := 1;
        Loc : Integer := Buf'First;
    begin
        while (I <= Max_Size) loop
            if (End_Of_Line) then -- Ada ate our newline, put it back on the end.
                Buf (Loc) := Ascii.Lf;
                Skip_Line (1);
            else
                Get (Buf (Loc));
            end if;

            Loc := Loc + 1;
            I := I + 1;
        end loop;

        Result := I - 1;
    exception
        when End_Error =>
            Result := I - 1;
            -- when we hit EOF we need to set yy_eof_has_been_seen
            Yy_Eof_Has_Been_Seen := True;
    end Yy_Input;

-- yy_get_next_buffer - try to read in new buffer
--
-- returns a code representing an action
--     EOB_ACT_LAST_MATCH -
--     EOB_ACT_RESTART_SCAN - restart the scanner
--     EOB_ACT_END_OF_FILE - end of file

    function Yy_Get_Next_Buffer return Eob_Action_Type is
        Dest : Integer := 0;
        Source : Integer := Yytext_Ptr - 1; -- copy prev. char, too
        Number_To_Move : Integer;
        Ret_Val : Eob_Action_Type;
        Num_To_Read : Integer;
    begin  
        if (Yy_C_Buf_P > Yy_N_Chars + 1) then
            raise Null_In_Input;
        end if;

        -- try to read more data

        -- first move last chars to start of buffer
        Number_To_Move := Yy_C_Buf_P - Yytext_Ptr;

        for I in 0 .. Number_To_Move - 1 loop
            Yy_Ch_Buf (Dest) := Yy_Ch_Buf (Source);
            Dest := Dest + 1;
            Source := Source + 1;
        end loop;

        if (Yy_Eof_Has_Been_Seen) then
            -- don't do the read, it's not guaranteed to return an EOF,
            -- just force an EOF

            Yy_N_Chars := 0;
        else
            Num_To_Read := Yy_Buf_Size - Number_To_Move - 1;

            if (Num_To_Read > Yy_Read_Buf_Size) then
                Num_To_Read := Yy_Read_Buf_Size;
            end if;

            -- read in more data
            Yy_Input (Yy_Ch_Buf (Number_To_Move .. Yy_Ch_Buf'Last),
                      Yy_N_Chars, Num_To_Read);
        end if;
        if (Yy_N_Chars = 0) then
            if (Number_To_Move = 1) then
                Ret_Val := Eob_Act_End_Of_File;
            else
                Ret_Val := Eob_Act_Last_Match;
            end if;

            Yy_Eof_Has_Been_Seen := True;
        else
            Ret_Val := Eob_Act_Restart_Scan;
        end if;

        Yy_N_Chars := Yy_N_Chars + Number_To_Move;
        Yy_Ch_Buf (Yy_N_Chars) := Yy_End_Of_Buffer_Char;
        Yy_Ch_Buf (Yy_N_Chars + 1) := Yy_End_Of_Buffer_Char;

        -- yytext begins at the second character in
        -- yy_ch_buf; the first character is the one which
        -- preceded it before reading in the latest buffer;
        -- it needs to be kept around in case it's a
        -- newline, so yy_get_previous_state() will have
        -- with '^' rules active

        Yytext_Ptr := 1;

        return Ret_Val;
    end Yy_Get_Next_Buffer;

    procedure Yyunput (C : Character; Yy_Bp : in out Integer) is
        Number_To_Move : Integer;
        Dest : Integer;
        Source : Integer;
        Tmp_Yy_Cp : Integer;
    begin
        Tmp_Yy_Cp := Yy_C_Buf_P;
        Yy_Ch_Buf (Tmp_Yy_Cp) :=
           Yy_Hold_Char; -- undo effects of setting up yytext

        if (Tmp_Yy_Cp < 2) then
            -- need to shift things up to make room
            Number_To_Move := Yy_N_Chars + 2; -- +2 for EOB chars
            Dest := Yy_Buf_Size + 2;
            Source := Number_To_Move;

            while (Source > 0) loop
                Dest := Dest - 1;
                Source := Source - 1;
                Yy_Ch_Buf (Dest) := Yy_Ch_Buf (Source);
            end loop;

            Tmp_Yy_Cp := Tmp_Yy_Cp + Dest - Source;
            Yy_Bp := Yy_Bp + Dest - Source;
            Yy_N_Chars := Yy_Buf_Size;

            if (Tmp_Yy_Cp < 2) then
                raise Pushback_Overflow;
            end if;
        end if;

        if (Tmp_Yy_Cp > Yy_Bp and then
            Yy_Ch_Buf (Tmp_Yy_Cp - 1) = Ascii.Lf) then
            Yy_Ch_Buf (Tmp_Yy_Cp - 2) := Ascii.Lf;
        end if;

        Tmp_Yy_Cp := Tmp_Yy_Cp - 1;
        Yy_Ch_Buf (Tmp_Yy_Cp) := C;

--  Note:  this code is the text of YY_DO_BEFORE_ACTION, only
--         here we get different yy_cp and yy_bp's
        Yytext_Ptr := Yy_Bp;
        Yy_Hold_Char := Yy_Ch_Buf (Tmp_Yy_Cp);
        Yy_Ch_Buf (Tmp_Yy_Cp) := Ascii.Nul;
        Yy_C_Buf_P := Tmp_Yy_Cp;
    end Yyunput;

    procedure Unput (C : Character) is
    begin
        Yyunput (C, Yy_Bp);
    end Unput;

    function Input return Character is
        C : Character;
        Yy_Cp : Integer := Yy_C_Buf_P;
    begin
        Yy_Ch_Buf (Yy_Cp) := Yy_Hold_Char;

        if (Yy_Ch_Buf (Yy_C_Buf_P) = Yy_End_Of_Buffer_Char) then
            -- need more input
            Yytext_Ptr := Yy_C_Buf_P;
            Yy_C_Buf_P := Yy_C_Buf_P + 1;

            case Yy_Get_Next_Buffer is
                -- this code, unfortunately, is somewhat redundant with
                -- that above

                when Eob_Act_End_Of_File =>
                    if (Yywrap) then
                        Yy_C_Buf_P := Yytext_Ptr;
                        return Ascii.Nul;
                    end if;

                    Yy_Ch_Buf (0) := Ascii.Lf;
                    Yy_N_Chars := 1;
                    Yy_Ch_Buf (Yy_N_Chars) := Yy_End_Of_Buffer_Char;
                    Yy_Ch_Buf (Yy_N_Chars + 1) := Yy_End_Of_Buffer_Char;
                    Yy_Eof_Has_Been_Seen := False;
                    Yy_C_Buf_P := 1;
                    Yytext_Ptr := Yy_C_Buf_P;
                    Yy_Hold_Char := Yy_Ch_Buf (Yy_C_Buf_P);

                    return (Input);
                when Eob_Act_Restart_Scan =>
                    Yy_C_Buf_P := Yytext_Ptr;

                when Eob_Act_Last_Match =>
                    raise Unexpected_Last_Match;
                when others =>
                    null;
            end case;
        end if;

        C := Yy_Ch_Buf (Yy_C_Buf_P);
        Yy_C_Buf_P := Yy_C_Buf_P + 1;
        Yy_Hold_Char := Yy_Ch_Buf (Yy_C_Buf_P);

        return C;
    end Input;

    procedure Output (C : Character) is
    begin
        Text_Io.Put (C);
    end Output;

-- default yywrap function - always treat EOF as an EOF
    function Yywrap return Boolean is
    begin
        return True;
    end Yywrap;

    procedure Open_Input (Fname : in String) is
        F : File_Type;
    begin
        Yy_Init := True;
        Open (F, In_File, Fname);
        Set_Input (F);
    end Open_Input;

    procedure Create_Output (Fname : in String := "") is
        F : File_Type;
    begin
        if (Fname /= "") then
            Create (F, Out_File, Fname);
            Set_Output (F);
        end if;
    end Create_Output;

    procedure Close_Input is
    begin
        null;
    end Close_Input;

    procedure Close_Output is
    begin
        null;
    end Close_Output;

end Ascan_Io;
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine.  The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

-- TITLE character classes routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION routines for character classes like [abc]
-- $Header: /co/ua/self/arcadia/aflex/ada/src/RCS/cclB.a,v 1.5 90/01/12 15:19:40 self Exp Locker: self $
DataMuseum.dk

Rational R1000/400

⟦90cfe1bcd⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
