aflex_1.7.0_77dbb4da/templates/body-reentrant-io.adb

--  Warning: This file is automatically generated by AFLEX.
--           It is useless to modify it. Change the ".Y" & ".L" files instead.
--  Template: templates/body-reentrant-io.adb
package body ${NAME}_IO is

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

   procedure YY_INPUT (Context  : in out Context_Type;
                       buf      : out unbounded_character_array;
                       result   : out Integer;
                       max_size : in Integer) is
      c   : Character;
      i   : Integer := 1;
      loc : Integer := buf'First;
%if error
   --    Since buf is an out parameter which is not readable
   --    and saved lines is a string pointer which space must
   --    be allocated after we know the size, we maintain
   --    an extra buffer to collect the input line and
   --    save it into the saved line 2.
      Temp_Line : String (1 .. YY_BUF_SIZE + 2);
%end
   begin
%if error
      -- buf := ( others => ASCII.NUL ); -- CvdL: does not work in GNAT
      for j in buf'First .. buf'Last loop
         buf (j) := ASCII.NUL;
      end loop;
      -- Move the saved lines forward.
      Context.Saved_Tok_Line1 := Context.Saved_Tok_Line2;
      Context.Line_Number_Of_Saved_Tok_Line1 := Context.Line_Number_Of_Saved_Tok_Line2;

%end
      if Ada.Text_IO.Is_Open (Context.user_input_file) then
         while i <= max_size loop
            --  Ada ate our newline, put it back on the end.
            if Ada.Text_IO.End_Of_Line (Context.user_input_file) then
               buf (loc) := ASCII.LF;
               Ada.Text_IO.Skip_Line (Context.user_input_file, 1);
%if error
               --   We try to get one line by one line. So we return
               --   here because we saw the end_of_line.
               result := i;
               Temp_Line (i) := ASCII.LF;
               Context.Saved_Tok_Line2 := new String (1 .. i);
               Context.Saved_Tok_Line2 (1 .. i) := Temp_Line (1 .. i);
               Context.Line_Number_Of_Saved_Tok_Line2 := Context.Line_Number_Of_Saved_Tok_Line1 + 1;
               return;
%end
%if interactive
               i := i + 1; --  update counter, miss end of loop
               exit; --  in interactive mode return at end of line.
%end
            else
               --  UCI CODES CHANGED:
               --    The following codes are modified. Previous codes is commented out.
               --    The purpose of doing this is to make it possible to set Temp_Line
               --    in Ayacc-extension specific codes. Definitely, we can read the character
               --    into the Temp_Line and then set the buf. But Temp_Line will only
               --    be used in Ayacc-extension specific codes which makes
               --    this approach impossible.
               Ada.Text_IO.Get (Context.user_input_file, c);
               buf (loc) := c;
--             Ada.Text_IO.Get (Context.user_input_file, buf (loc));
%if error
               Temp_Line (i) := c;
%end
            end if;

            loc := loc + 1;
            i := i + 1;
         end loop;
      else
         while i <= max_size loop
            if Ada.Text_IO.End_Of_Line then -- Ada ate our newline, put it back on the end.
               buf (loc) := ASCII.LF;
               Ada.Text_IO.Skip_Line (1);
%if error
               --   We try to get one line by one line. So we return
               --   here because we saw the end_of_line.
               result := i;
               Temp_Line (i) := ASCII.LF;
               Context.Saved_Tok_Line2 := new String (1 .. i);
               Context.Saved_Tok_Line2 (1 .. i) := Temp_Line (1 .. i);
               Context.Line_Number_Of_Saved_Tok_Line2 := Context.Line_Number_Of_Saved_Tok_Line1 + 1;
               return;
%end

            else
               --  The following codes are modified. Previous codes is commented out.
               --  The purpose of doing this is to make it possible to set Temp_Line
               --  in Ayacc-extension specific codes. Definitely, we can read the character
               --  into the Temp_Line and then set the buf. But Temp_Line will only
               --  be used in Ayacc-extension specific codes which makes this approach impossible.
               Ada.Text_IO.Get (c);
               buf (loc) := c;
%if error
               Temp_Line (i) := c;
%end
            end if;

            loc := loc + 1;
            i := i + 1;
         end loop;
      end if; --  for input file being standard input
      result := i - 1;

%if error
      --  Since we get one line by one line, if we
      --  reach here, it means that current line have
      --  more that max_size characters. So it is
      --  impossible to hold the whole line. We
      --  report the warning message and continue.
      buf (loc - 1) := Ascii.LF;
      if Ada.Text_IO.Is_Open (Context.user_input_file) then
         Ada.Text_IO.Skip_Line (Context.user_input_file, 1);
      else
         Ada.Text_IO.Skip_Line (1);
      end if;
      Temp_Line (i - 1) := ASCII.LF;
      Context.Saved_Tok_Line2 := new String (1 .. i - 1);
      Context.Saved_Tok_Line2 (1 .. i - 1) := Temp_Line (1 .. i - 1);
      Context.Line_Number_Of_Saved_Tok_Line2 := Context.Line_Number_Of_Saved_Tok_Line1 + 1;
      Put_Line ("Input line "
                & Integer'Image ( Context.Line_Number_Of_Saved_Tok_Line2 )
                & "has more than "
                & Integer'Image ( max_size )
                & " characters, ... truncated." );
%end
   exception
      when Ada.Text_IO.End_Error =>
         result := i - 1;
         --  when we hit EOF we need to set yy_eof_has_been_seen
         Context.yy_eof_has_been_seen := True;
%if error
         --   Processing incomplete line.
         if i /= 1 then
            -- Current line is not empty but do not have end_of_line.
            -- So current line is incomplete line. But we still need
            -- to save it.
            Context.Saved_Tok_Line2 := new String (1 .. i - 1);
            Context.Saved_Tok_Line2 (1 .. i - 1) := Temp_Line (1 .. i - 1);
            Context.Line_Number_Of_Saved_Tok_Line2 := Context.Line_Number_Of_Saved_Tok_Line1 + 1;
         end if;
%end
   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 (Context : in out Context_Type) return eob_action_type is
      dest           : Integer := 0;
      source         : Integer := Context.dfa.yytext_ptr - 1; -- copy prev. char, too
      number_to_move : Integer;
      ret_val        : eob_action_type;
      num_to_read    : Integer;
   begin
      if Context.dfa.yy_c_buf_p > Context.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 := Context.dfa.yy_c_buf_p - Context.dfa.yytext_ptr;

      for i in 0 .. number_to_move - 1 loop
         Context.dfa.yy_ch_buf (dest) := Context.dfa.yy_ch_buf (source);
         dest := dest + 1;
         source := source + 1;
      end loop;

      if Context.yy_eof_has_been_seen then
         --  don't do the read, it's not guaranteed to return an EOF,
         --  just force an EOF

         Context.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 (Context,
                   Context.dfa.yy_ch_buf (number_to_move .. Context.dfa.yy_ch_buf'Last),
                   Context.yy_n_chars, num_to_read);
      end if;
      if Context.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;

         Context.yy_eof_has_been_seen := True;
      else
         ret_val := EOB_ACT_RESTART_SCAN;
      end if;

      Context.yy_n_chars := Context.yy_n_chars + number_to_move;
      Context.dfa.yy_ch_buf (Context.yy_n_chars) := YY_END_OF_BUFFER_CHAR;
      Context.dfa.yy_ch_buf (Context.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

      Context.dfa.yytext_ptr := 1;

      return ret_val;
   end yy_get_next_buffer;

%if unput
   procedure yyUnput (Context : in out Context_Type;
                      c : Character; yy_bp : in out Integer) is
      number_to_move : Integer;
      dest : Integer;
      source : Integer;
      tmp_yy_cp : Integer;
   begin
      tmp_yy_cp := Context.dfa.yy_c_buf_p;
      --  undo effects of setting up yytext
      Context.dfa.yy_ch_buf (tmp_yy_cp) := Context.dfa.yy_hold_char;

      if tmp_yy_cp < 2 then
         --  need to shift things up to make room
         number_to_move := Context.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;
            Context.dfa.yy_ch_buf (dest) := Context.dfa.yy_ch_buf (source);
         end loop;

         tmp_yy_cp := tmp_yy_cp + dest - source;
         Context.dfa.yy_bp := Context.dfa.yy_bp + dest - source;
         Context.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 Context.dfa.yy_ch_buf (tmp_yy_cp - 1) = ASCII.LF
      then
         Context.dfa.yy_ch_buf (tmp_yy_cp - 2) := ASCII.LF;
      end if;

      tmp_yy_cp := tmp_yy_cp - 1;
      Context.dfa.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
      Context.dfa.yytext_ptr := Context.dfa.yy_bp;
      Context.dfa.yy_hold_char := Context.dfa.yy_ch_buf (tmp_yy_cp);
      Context.dfa.yy_ch_buf (tmp_yy_cp) := ASCII.NUL;
      Context.dfa.yy_c_buf_p := tmp_yy_cp;
   end yyUnput;

   procedure Unput (Context : in out Context_Type; c : Character) is
   begin
      yyUnput (Context, c, Context.dfa.yy_bp);
   end Unput;

%end
%if input
   function Input (Context : in out Context_Type) return Character is
      c : Character;
   begin
      Context.dfa.yy_ch_buf (Context.dfa.yy_c_buf_p) := Context.dfa.yy_hold_char;

      if Context.dfa.yy_ch_buf (Context.dfa.yy_c_buf_p) = YY_END_OF_BUFFER_CHAR then
         --  need more input
         Context.dfa.yytext_ptr := Context.dfa.yy_c_buf_p;
         Context.dfa.yy_c_buf_p := Context.dfa.yy_c_buf_p + 1;

         case yy_get_next_buffer (Context) is
            --  this code, unfortunately, is somewhat redundant with
            --  that above

         when EOB_ACT_END_OF_FILE =>
%if yywrap
            if yyWrap (Context) then
               Context.dfa.yy_c_buf_p := Context.dfa.yytext_ptr;
               return ASCII.NUL;
            end if;

            Context.dfa.yy_ch_buf (0) := ASCII.LF;
            Context.yy_n_chars := 1;
            Context.dfa.yy_ch_buf (Context.yy_n_chars) := YY_END_OF_BUFFER_CHAR;
            Context.dfa.yy_ch_buf (Context.yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;
            Context.yy_eof_has_been_seen := False;
            Context.yy_c_buf_p := 1;
            Context.dfa.yytext_ptr := Context.dfa.yy_c_buf_p;
            Context.dfa.yy_hold_char := Context.dfa.yy_ch_buf (Context.yy_c_buf_p);

            return Input;
%else
            Context.dfa.yy_c_buf_p := Context.dfa.yytext_ptr;
            return ASCII.NUL;
%end
         when EOB_ACT_RESTART_SCAN =>
            Context.dfa.yy_c_buf_p := Context.dfa.yytext_ptr;

         when EOB_ACT_LAST_MATCH =>
            raise UNEXPECTED_LAST_MATCH;
         end case;
      end if;

      c := Context.dfa.yy_ch_buf (Context.dfa.yy_c_buf_p);
      Context.dfa.yy_c_buf_p := Context.dfa.yy_c_buf_p + 1;
      Context.dfa.yy_hold_char := Context.dfa.yy_ch_buf (Context.dfa.yy_c_buf_p);

      return c;
   end Input;

%end
%if output
   procedure Output (Context : in out Context_Type; c : Character) is
   begin
      if Ada.Text_IO.Is_Open (Context.user_output_file) then
         Ada.Text_IO.Put (Context.user_output_file, c);
      else
         Ada.Text_IO.Put (c);
      end if;
   end Output;

   procedure Output_New_Line (Context : in out Context_Type) is
   begin
      if Ada.Text_IO.Is_Open (Context.user_output_file) then
         Ada.Text_IO.New_Line (Context.user_output_file);
      else
         Ada.Text_IO.New_Line;
      end if;
   end Output_New_Line;

   function Output_Column (Context : in Context_Type) return Ada.Text_IO.Count is
   begin
      if Ada.Text_IO.Is_Open (Context.user_output_file) then
         return Ada.Text_IO.Col (Context.user_output_file);
      else
         return Ada.Text_IO.Col;
      end if;
   end Output_Column;

%end
%if error
   function Input_Line (Context : in Context_Type) return Ada.Text_IO.Count is
   begin
      return Ada.Text_IO.Count (Context.Line_Number_Of_Saved_Tok_Line2);
   end Input_Line;

%end
%if yywrap
   --  default yywrap function - always treat EOF as an EOF
   function yyWrap (Context : in Context_Type) return Boolean is
   begin
%if yywrapcode
%yywrap
%else
      return True;
%end
   end yyWrap;

%end
   procedure Open_Input (Context : in out Context_Type; fname : in String) is
   begin
      Context.dfa.yy_init := True;
      Ada.Text_IO.Open (Context.user_input_file, Ada.Text_IO.In_File, fname);
%if yylineno
      Context.dfa.yylineno  := 1;
      Context.dfa.yylinecol := 0;
%end
   end Open_Input;

%if output
   procedure Create_Output (Context : in out Context_Type; fname : in String := "") is
   begin
      if fname /= "" then
         Ada.Text_IO.Create (Context.user_output_file, Ada.Text_IO.Out_File, fname);
      end if;
   end Create_Output;

%end
   procedure Close_Input (Context : in out Context_Type) is
   begin
      if Ada.Text_IO.Is_Open (Context.user_input_file) then
         Ada.Text_IO.Close (Context.user_input_file);
      end if;
   end Close_Input;

%if output
   procedure Close_Output (Context : in out Context_Type) is
   begin
      if Ada.Text_IO.Is_Open (Context.user_output_file) then
         Ada.Text_IO.Close (Context.user_output_file);
      end if;
   end Close_Output;

%end
%if error
   procedure Yy_Get_Token_Line (Context : in out Context_Type;
                                Yy_Line_String : out String;
                                Yy_Line_Length : out Natural ) is
   begin
      --  Currently processing line is either in saved token line1 or
      --  in saved token line2.
      if Context.Yy_Line_Number = Context.Line_Number_Of_Saved_Tok_Line1 then
         Context.Yy_Line_Length := Context.Saved_Tok_Line1.all'length;
         Context.Yy_Line_String ( Context.Yy_Line_String'First .. ( Context.Yy_Line_String'First + Context.Saved_Tok_Line1.all'length - 1 ))
           := Context.Saved_Tok_Line1 ( 1 .. Context.Saved_Tok_Line1.all'length );
      else
         Context.Yy_Line_Length := Context.Saved_Tok_Line2.all'length;
         Context.Yy_Line_String ( Context.Yy_Line_String'First .. ( Context.Yy_Line_String'First + Context.Saved_Tok_Line2.all'length - 1 ))
           := Context.Saved_Tok_Line2 ( 1 .. Context.Saved_Tok_Line2.all'length );
      end if;
   end Yy_Get_Token_Line;

   function Yy_Line_Number (Context : in Context_Type) return Natural is
   begin
      return Context.dfa.Tok_Begin_Line;
   end Yy_Line_Number;

   function Yy_Begin_Column (Context : in Context_Type) return Natural is
   begin
      return Context.dfa.Tok_Begin_Col;
   end Yy_Begin_Column;

   function Yy_End_Column (Context : in Context_Type) return Natural is
   begin
      return Context.dfa.Tok_End_Col;
   end Yy_End_Column;

%end
end ${NAME}_IO;