-- $Header: /cf/ua/arcadia/alex-ayacc/ayacc/src/RCS/source_file_body.a,v 1.1 88/08/08 14:29:03 arcadia Exp $

-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
--    The primary authors of ayacc were David Taback and Deepak Tolani.
--    Enhancements were made by Ronald J. Schmalz.
--
--    Send requests for ayacc information to ayacc-info@ics.uci.edu
--    Send bug reports for ayacc to ayacc-bugs@ics.uci.edu
--
-- 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.

-- Module       : source_file_body.ada
-- Component of : ayacc
-- Version      : 1.2
-- Date         : 11/21/86  12:36:09
-- SCCS File    : disk21~/rschm/hasee/sccs/ayacc/sccs/sxsource_file_body.ada

-- $Header: /cf/ua/arcadia/alex-ayacc/ayacc/src/RCS/source_file_body.a,v 1.1 88/08/08 14:29:03 arcadia Exp $
-- $Log:        source_file_body.a,v $
--Revision 1.1  88/08/08  14:29:03  arcadia
--Initial revision
--
-- Revision 0.1  86/04/01  15:12:32  ada
--  This version fixes some minor bugs with empty grammars
--  and $$ expansion. It also uses vads5.1b enhancements
--  such as pragma inline.
--
--
-- Revision 0.0  86/02/19  18:42:02  ada
--
-- These files comprise the initial version of Ayacc
-- designed and implemented by David Taback and Deepak Tolani.
-- Ayacc has been compiled and tested under the Verdix Ada compiler
-- version 4.06 on a vax 11/750 running Unix 4.2BSD.
--

with Text_Io, Ayacc_File_Names;
use Text_Io;
package body Source_File is

   -- SCCS_ID : constant String := "@(#) source_file_body.ada, Version 1.2";
   -- Rcs_ID : constant String := "$Header: /cf/ua/arcadia/alex-ayacc/ayacc/src/RCS/source_file_body.a,v 1.1 88/08/08 14:29:03 arcadia Exp $";

   Input_File : File_Type;

   Max_Line_Length : constant := 260;

   type Long_Str is record
      Name   : String (1 .. Max_Line_Length);
      Length : Natural := 0;
   end record;

   Current_Line  : Long_Str;
   Previous_Line : Long_Str;
   Column_Number : Natural;   -- column number of current_line.
   Line_Number   : Natural;

   Get_New_Line       : Boolean := True;
   End_Of_Source_File : Boolean := False;

   procedure Open is
      use Ayacc_File_Names;
   begin
      Open (Input_File, In_File, Get_Source_File_Name);
      Current_Line  := ((others => ' '), 0);
      Previous_Line := ((others => ' '), 0);
      Column_Number := 1;
      Line_Number   := 0;
   exception
      when Name_Error | Use_Error =>
         Put_Line ("Ayacc: Error Opening """ & Get_Source_File_Name & """.");
         raise;
   end Open;

   procedure Close is
   begin
      Close (Input_File);
   end Close;

   function Is_End_Of_File return Boolean is
   begin
      return End_Of_File (Input_File);
   end Is_End_Of_File;

   function Source_Line_Number return Natural is
   begin
      return Line_Number;
   end Source_Line_Number;

   function Maximum_Line_Length return Natural is
   begin
      return Max_Line_Length;
   end Maximum_Line_Length;

   procedure Get_Char (Ch : out Character) is
   begin

      if Get_New_Line then
         Previous_Line := Current_Line;
         Get_Line (Input_File, Current_Line.Name, Current_Line.Length);
         Get_New_Line  := False;
         Column_Number := 1;
         Line_Number   := Line_Number + 1;
      end if;

      if Column_Number > Current_Line.Length then
         if End_Of_File (Input_File) then
            Ch                 := Eof;
            End_Of_Source_File := True;
            return;
         end if;
         Ch           := Eoln;
         Get_New_Line := True;
      else
         Ch            := Current_Line.Name (Column_Number);
         Column_Number := Column_Number + 1;
      end if;

   end Get_Char;

   -- Note: You can't correctly peek at next character if the last character
   -- read is a EOLN. It is assumed that the lexical analyzer won't
   -- call this function in that case.
   function Peek_Next_Char return Character is
   begin
      if Column_Number > Current_Line.Length then
         if End_Of_File (Input_File) then
            return Eof;
         else
            return Eoln;
         end if;
      end if;
      return Current_Line.Name (Column_Number);
   end Peek_Next_Char;

   procedure Unget_Char is -- (Ch : in Character) is
   begin
      if Get_New_Line then
         Get_New_Line := False;
      elsif End_Of_Source_File then
         End_Of_Source_File := False;
      elsif Column_Number = 1 then
         Put_Line ("Ayacc: Error in Unget_Char, Attempt to 'unget' an EOLN");
         raise Pushback_Error;
      else
         Column_Number := Column_Number - 1;
      end if;
   end Unget_Char;

   procedure Print_Context_Lines is
      Ptr_Location : Integer := 0;
   begin

      --  Print previous line followed by current line  --

      Put (Integer'Image (Line_Number - 1) & Ascii.Ht);
      Put_Line (Previous_Line.Name (1 .. Previous_Line.Length));
      Put (Integer'Image (Line_Number) & Ascii.Ht);
      Put_Line (Current_Line.Name (1 .. Current_Line.Length));

      --  Correct for any tab characters so that the pointer will
      --  point to the proper location on the source line.
      for I in 1 .. Column_Number - 1 loop
         if Current_Line.Name (I) = Ascii.Ht then -- Adjust for tab.
            Ptr_Location := (((Ptr_Location / 8) + 1) * 8);
         else
            Ptr_Location := Ptr_Location + 1;
         end if;
      end loop;

      Put (Ascii.Ht);
      for I in 1 .. Ptr_Location - 1 loop
         Put ('-');
      end loop;
      Put ('^');

   end Print_Context_Lines;

   procedure Read_Line (Source_Line : out String; Last : out Natural) is
   begin
      Get_Line (Input_File, Source_Line, Last);
      Line_Number := Line_Number + 1;
   end Read_Line;

end Source_File;
