home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / sinput-l.adb < prev    next >
Text File  |  1996-09-28  |  7KB  |  207 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                             S I N P U T . L                              --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.2 $                              --
  10. --                                                                          --
  11. --        Copyright (c) 1992,1993,1994,1995 NYU, All Rights Reserved        --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. with Alloc;  use Alloc;
  26. with Atree;  use Atree;
  27. with Debug;  use Debug;
  28. with Namet;  use Namet;
  29. with Osint;  use Osint;
  30. with Output; use Output;
  31. with System; use System;
  32.  
  33. with Unchecked_Conversion;
  34.  
  35. package body Sinput.L is
  36.  
  37.    -------------------------------
  38.    -- Adjust_Instantiation_Sloc --
  39.    -------------------------------
  40.  
  41.    procedure Adjust_Instantiation_Sloc (N : Node_Id; A : Sloc_Adjustment) is
  42.    begin
  43.       Set_Sloc (N, Source_Ptr (Int (Sloc (N)) + Int (A)));
  44.    end Adjust_Instantiation_Sloc;
  45.  
  46.    ---------------------------------
  47.    -- Create_Instantiation_Source --
  48.    ---------------------------------
  49.  
  50.    procedure Create_Instantiation_Source
  51.      (X   : Source_File_Index;
  52.       Loc : Source_Ptr;
  53.       A   : out Sloc_Adjustment)
  54.    is
  55.       Xnew : Source_File_Index;
  56.       Adj  : Source_Ptr;
  57.  
  58.    begin
  59.       Source_File.Increment_Last;
  60.       Xnew := Source_File.Last;
  61.  
  62.       Source_File.Table (Xnew) := Source_File.Table (X);
  63.  
  64.       Source_File.Table (Xnew).Instantiation := Loc;
  65.       Source_File.Table (Xnew).Template      := X;
  66.  
  67.       --  Now we need to compute the new values of Source_First, Source_Last
  68.       --  and adjust the source file pointer to have the correct virtual
  69.       --  origin for the new range of values.
  70.  
  71.       Source_File.Table (Xnew).Source_First :=
  72.         Source_File.Table (Xnew - 1).Source_Last + 1;
  73.  
  74.       Adj := Source_File.Table (Xnew).Source_First -
  75.              Source_File.Table (X).Source_First;
  76.  
  77.       A := Sloc_Adjustment (Adj);
  78.  
  79.       Source_File.Table (Xnew).Source_Last :=
  80.         Source_File.Table (X).Source_Last + Adj;
  81.  
  82.       Source_File.Table (Xnew).Sloc_Adjust :=
  83.         Source_File.Table (X).Sloc_Adjust - Adj;
  84.  
  85.       --  For a given character in the source, a higher subscript will be
  86.       --  used to access the instantiation, which means that the virtual
  87.       --  origin must have a corresponding lower value. We compute this
  88.       --  new origin by taking the address of the appropriate adjusted
  89.       --  element in the old array. Since this adjusted element will be
  90.       --  at a negative subscript, we must suppress checks.
  91.  
  92.       declare
  93.          pragma Suppress (All_Checks);
  94.  
  95.          function To_Source_Buffer_Ptr is new
  96.            Unchecked_Conversion (Address, Source_Buffer_Ptr);
  97.  
  98.       begin
  99.          Source_File.Table (Xnew).Source_Text :=
  100.            To_Source_Buffer_Ptr
  101.              (Source_File.Table (X).Source_Text (-Adj)'Address);
  102.       end;
  103.  
  104.    end Create_Instantiation_Source;
  105.  
  106.    ----------------------
  107.    -- Load_Source_File --
  108.    ----------------------
  109.  
  110.    function Load_Source_File
  111.      (N    : File_Name_Type)
  112.       return Source_File_Index
  113.    is
  114.       Src  : Source_Buffer_Ptr;
  115.       Lptr : Lines_Table_Ptr;
  116.       X    : Source_File_Index;
  117.       Lo   : Source_Ptr;
  118.       Hi   : Source_Ptr;
  119.  
  120.    begin
  121.       for J in 1 .. Source_File.Last loop
  122.          if Source_File.Table (J).File_Name = N then
  123.             return J;
  124.          end if;
  125.       end loop;
  126.  
  127.       --  Here we must build a new entry in the file table
  128.  
  129.       Source_File.Increment_Last;
  130.       X := Source_File.Last;
  131.  
  132.       if X = Source_File.First then
  133.          Lo := First_Source_Ptr;
  134.       else
  135.          Lo := Source_File.Table (X - 1).Source_Last + 1;
  136.       end if;
  137.  
  138.       Read_Source_File (N, Lo, Hi, Src);
  139.  
  140.       if Src = null then
  141.          Source_File.Decrement_Last;
  142.          return No_Source_File;
  143.  
  144.       else
  145.          if Debug_Flag_L then
  146.             Write_Str ("*** Build source file table entry, Index = ");
  147.             Write_Int (Int (X));
  148.             Write_Str (", file name = ");
  149.             Write_Name (N);
  150.             Write_Eol;
  151.             Write_Str ("  Lo = ");
  152.             Write_Int (Int (Lo));
  153.             Write_Eol;
  154.             Write_Str ("  Hi = ");
  155.             Write_Int (Int (Hi));
  156.             Write_Eol;
  157.  
  158.             Write_Str ("  First 10 chars -->");
  159.  
  160.             for J in Lo .. Lo + 9 loop
  161.                Write_Char (Src (J));
  162.             end loop;
  163.  
  164.             Write_Str ("<--");
  165.             Write_Eol;
  166.  
  167.             Write_Str ("  Last 10 chars  -->");
  168.  
  169.             for J in Hi - 10 .. Hi - 1 loop
  170.                Write_Char (Src (J));
  171.             end loop;
  172.  
  173.             Write_Str ("<--");
  174.             Write_Eol;
  175.  
  176.             if Src (Hi) = EOF then
  177.                Write_Str ("  OK, EOF at end");
  178.             else
  179.                Write_Str ("  error, no EOF at end");
  180.             end if;
  181.          end if;
  182.  
  183.          Lptr := new Lines_Table_Type (1 .. Alloc_Lines_Initial);
  184.          Lptr (1) := Src'First;
  185.  
  186.          Source_File.Table (X).File_Name         := N;
  187.          Source_File.Table (X).Full_File_Name    := Full_Source_Name;
  188.          Source_File.Table (X).Reference_Name    := Full_Source_Name;
  189.          Source_File.Table (X).Line_Offset       := 0;
  190.          Source_File.Table (X).Source_Text       := Src;
  191.          Source_File.Table (X).Source_First      := Lo;
  192.          Source_File.Table (X).Source_Last       := Hi;
  193.          Source_File.Table (X).Time_Stamp        := Current_Source_File_Stamp;
  194.          Source_File.Table (X).Lines_Table       := Lptr;
  195.          Source_File.Table (X).Num_Source_Lines  := 1;
  196.          Source_File.Table (X).Keyword_Casing    := Unknown;
  197.          Source_File.Table (X).Identifier_Casing := Unknown;
  198.          Source_File.Table (X).Instantiation     := No_Location;
  199.          Source_File.Table (X).Template          := No_Source_File;
  200.          Source_File.Table (X).Sloc_Adjust       := 0;
  201.  
  202.          return X;
  203.       end if;
  204.    end Load_Source_File;
  205.  
  206. end Sinput.L;
  207.