1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 pragma Style_Checks (All_Checks);
35 -- Subprograms not all in alpha order
37 with Debug; use Debug;
38 with Namet; use Namet;
40 with Output; use Output;
41 with Tree_IO; use Tree_IO;
42 with System; use System;
46 with Unchecked_Conversion;
47 with Unchecked_Deallocation;
49 package body Sinput is
52 -- Make control characters visible
54 First_Time_Around : Boolean := True;
56 -- Routines to support conversion between types Lines_Table_Ptr,
57 -- Logical_Lines_Table_Ptr and System.Address.
59 function To_Address is
60 new Unchecked_Conversion (Lines_Table_Ptr, Address);
62 function To_Address is
63 new Unchecked_Conversion (Logical_Lines_Table_Ptr, Address);
65 function To_Pointer is
66 new Unchecked_Conversion (Address, Lines_Table_Ptr);
68 function To_Pointer is
69 new Unchecked_Conversion (Address, Logical_Lines_Table_Ptr);
71 ---------------------------
72 -- Add_Line_Tables_Entry --
73 ---------------------------
75 procedure Add_Line_Tables_Entry
76 (S : in out Source_File_Record;
79 LL : Physical_Line_Number;
82 -- Reallocate the lines tables if necessary.
84 -- Note: the reason we do not use the normal Table package
85 -- mechanism is that we have several of these tables. We could
86 -- use the new GNAT.Dynamic_Tables package and that would probably
89 if S.Last_Source_Line = S.Lines_Table_Max then
92 Int (S.Last_Source_Line) *
93 ((100 + Alloc.Lines_Increment) / 100));
96 Write_Str ("--> Reallocating lines table, size = ");
97 Write_Int (Int (S.Lines_Table_Max));
102 S.Last_Source_Line := S.Last_Source_Line + 1;
103 LL := S.Last_Source_Line;
105 S.Lines_Table (LL) := P;
107 -- Deal with setting new entry in logical lines table if one is
108 -- present. Note that there is always space (because the call to
109 -- Alloc_Line_Tables makes sure both tables are the same length),
111 if S.Logical_Lines_Table /= null then
113 -- We can always set the entry from the previous one, because
114 -- the processing for a Source_Reference pragma ensures that
115 -- at least one entry following the pragma is set up correctly.
117 S.Logical_Lines_Table (LL) := S.Logical_Lines_Table (LL - 1) + 1;
119 end Add_Line_Tables_Entry;
121 -----------------------
122 -- Alloc_Line_Tables --
123 -----------------------
125 procedure Alloc_Line_Tables
126 (S : in out Source_File_Record;
129 subtype size_t is Memory.size_t;
131 New_Table : Lines_Table_Ptr;
133 New_Logical_Table : Logical_Lines_Table_Ptr;
135 New_Size : constant size_t :=
136 size_t (New_Max * Lines_Table_Type'Component_Size /
140 if S.Lines_Table = null then
141 New_Table := To_Pointer (Memory.Alloc (New_Size));
145 To_Pointer (Memory.Realloc (To_Address (S.Lines_Table), New_Size));
148 if New_Table = null then
151 S.Lines_Table := New_Table;
152 S.Lines_Table_Max := Physical_Line_Number (New_Max);
155 if S.Num_SRef_Pragmas /= 0 then
156 if S.Logical_Lines_Table = null then
157 New_Logical_Table := To_Pointer (Memory.Alloc (New_Size));
159 New_Logical_Table := To_Pointer
160 (Memory.Realloc (To_Address (S.Logical_Lines_Table), New_Size));
163 if New_Logical_Table = null then
166 S.Logical_Lines_Table := New_Logical_Table;
169 end Alloc_Line_Tables;
175 procedure Backup_Line (P : in out Source_Ptr) is
176 Sindex : constant Source_File_Index := Get_Source_File_Index (P);
177 Src : constant Source_Buffer_Ptr :=
178 Source_File.Table (Sindex).Source_Text;
179 Sfirst : constant Source_Ptr :=
180 Source_File.Table (Sindex).Source_First;
190 if Src (P - 1) = LF then
195 if Src (P - 1) = CR then
200 -- Now find first character of the previous line
203 and then Src (P - 1) /= LF
204 and then Src (P - 1) /= CR
210 ---------------------------
211 -- Build_Location_String --
212 ---------------------------
214 procedure Build_Location_String (Loc : Source_Ptr) is
220 -- Loop through instantiations
224 Get_Name_String_And_Append
225 (Reference_Name (Get_Source_File_Index (Ptr)));
226 Add_Char_To_Name_Buffer (':');
227 Add_Nat_To_Name_Buffer
228 (Nat (Get_Logical_Line_Number (Ptr)));
230 Ptr := Instantiation_Location (Ptr);
231 exit when Ptr = No_Location;
232 Add_Str_To_Name_Buffer (" instantiated at ");
235 Name_Buffer (Name_Len + 1) := NUL;
237 end Build_Location_String;
239 -----------------------
240 -- Get_Column_Number --
241 -----------------------
243 function Get_Column_Number (P : Source_Ptr) return Column_Number is
246 Sindex : Source_File_Index;
247 Src : Source_Buffer_Ptr;
250 -- If the input source pointer is not a meaningful value then return
251 -- at once with column number 1. This can happen for a file not found
252 -- condition for a file loaded indirectly by RTE, and also perhaps on
253 -- some unknown internal error conditions. In either case we certainly
254 -- don't want to blow up.
260 Sindex := Get_Source_File_Index (P);
261 Src := Source_File.Table (Sindex).Source_Text;
267 C := (C - 1) / 8 * 8 + (8 + 1);
277 end Get_Column_Number;
279 -----------------------------
280 -- Get_Logical_Line_Number --
281 -----------------------------
283 function Get_Logical_Line_Number
285 return Logical_Line_Number
287 SFR : Source_File_Record
288 renames Source_File.Table (Get_Source_File_Index (P));
290 L : constant Physical_Line_Number := Get_Physical_Line_Number (P);
293 if SFR.Num_SRef_Pragmas = 0 then
294 return Logical_Line_Number (L);
296 return SFR.Logical_Lines_Table (L);
298 end Get_Logical_Line_Number;
300 ------------------------------
301 -- Get_Physical_Line_Number --
302 ------------------------------
304 function Get_Physical_Line_Number
306 return Physical_Line_Number
308 Sfile : Source_File_Index;
309 Table : Lines_Table_Ptr;
310 Lo : Physical_Line_Number;
311 Hi : Physical_Line_Number;
312 Mid : Physical_Line_Number;
316 -- If the input source pointer is not a meaningful value then return
317 -- at once with line number 1. This can happen for a file not found
318 -- condition for a file loaded indirectly by RTE, and also perhaps on
319 -- some unknown internal error conditions. In either case we certainly
320 -- don't want to blow up.
325 -- Otherwise we can do the binary search
328 Sfile := Get_Source_File_Index (P);
329 Loc := P + Source_File.Table (Sfile).Sloc_Adjust;
330 Table := Source_File.Table (Sfile).Lines_Table;
332 Hi := Source_File.Table (Sfile).Last_Source_Line;
335 Mid := (Lo + Hi) / 2;
337 if Loc < Table (Mid) then
340 else -- Loc >= Table (Mid)
343 Loc < Table (Mid + 1)
354 end Get_Physical_Line_Number;
356 ---------------------------
357 -- Get_Source_File_Index --
358 ---------------------------
360 Source_Cache_First : Source_Ptr := 1;
361 Source_Cache_Last : Source_Ptr := 0;
362 -- Records the First and Last subscript values for the most recently
363 -- referenced entry in the source table, to optimize the common case
364 -- of repeated references to the same entry. The initial values force
365 -- an initial search to set the cache value.
367 Source_Cache_Index : Source_File_Index := No_Source_File;
368 -- Contains the index of the entry corresponding to Source_Cache
370 function Get_Source_File_Index
372 return Source_File_Index
375 if S in Source_Cache_First .. Source_Cache_Last then
376 return Source_Cache_Index;
379 for J in Source_File_Index_Table (Int (S) / Chunk_Size)
382 if S in Source_File.Table (J).Source_First ..
383 Source_File.Table (J).Source_Last
385 Source_Cache_Index := J;
386 Source_Cache_First :=
387 Source_File.Table (Source_Cache_Index).Source_First;
389 Source_File.Table (Source_Cache_Index).Source_Last;
390 return Source_Cache_Index;
395 -- We must find a matching entry in the above loop!
398 end Get_Source_File_Index;
404 procedure Initialize is
406 Source_Cache_First := 1;
407 Source_Cache_Last := 0;
408 Source_Cache_Index := No_Source_File;
409 Source_gnat_adc := No_Source_File;
410 First_Time_Around := True;
415 -------------------------
416 -- Instantiation_Depth --
417 -------------------------
419 function Instantiation_Depth (S : Source_Ptr) return Nat is
420 Sind : Source_File_Index;
429 Sind := Get_Source_File_Index (Sval);
430 Sval := Instantiation (Sind);
431 exit when Sval = No_Location;
436 end Instantiation_Depth;
438 ----------------------------
439 -- Instantiation_Location --
440 ----------------------------
442 function Instantiation_Location (S : Source_Ptr) return Source_Ptr is
444 return Instantiation (Get_Source_File_Index (S));
445 end Instantiation_Location;
447 ----------------------
448 -- Last_Source_File --
449 ----------------------
451 function Last_Source_File return Source_File_Index is
453 return Source_File.Last;
454 end Last_Source_File;
460 function Line_Start (P : Source_Ptr) return Source_Ptr is
461 Sindex : constant Source_File_Index := Get_Source_File_Index (P);
462 Src : constant Source_Buffer_Ptr :=
463 Source_File.Table (Sindex).Source_Text;
464 Sfirst : constant Source_Ptr :=
465 Source_File.Table (Sindex).Source_First;
472 and then Src (S - 1) /= CR
473 and then Src (S - 1) /= LF
482 (L : Physical_Line_Number;
483 S : Source_File_Index)
487 return Source_File.Table (S).Lines_Table (L);
496 Source_File.Locked := True;
500 ----------------------
501 -- Num_Source_Files --
502 ----------------------
504 function Num_Source_Files return Nat is
506 return Int (Source_File.Last) - Int (Source_File.First) + 1;
507 end Num_Source_Files;
509 ----------------------
510 -- Num_Source_Lines --
511 ----------------------
513 function Num_Source_Lines (S : Source_File_Index) return Nat is
515 return Nat (Source_File.Table (S).Last_Source_Line);
516 end Num_Source_Lines;
518 -----------------------
519 -- Original_Location --
520 -----------------------
522 function Original_Location (S : Source_Ptr) return Source_Ptr is
523 Sindex : Source_File_Index;
524 Tindex : Source_File_Index;
527 if S <= No_Location then
531 Sindex := Get_Source_File_Index (S);
533 if Instantiation (Sindex) = No_Location then
537 Tindex := Template (Sindex);
538 while Instantiation (Tindex) /= No_Location loop
539 Tindex := Template (Tindex);
542 return S - Source_First (Sindex) + Source_First (Tindex);
545 end Original_Location;
547 -------------------------
548 -- Physical_To_Logical --
549 -------------------------
551 function Physical_To_Logical
552 (Line : Physical_Line_Number;
553 S : Source_File_Index)
554 return Logical_Line_Number
556 SFR : Source_File_Record renames Source_File.Table (S);
559 if SFR.Num_SRef_Pragmas = 0 then
560 return Logical_Line_Number (Line);
562 return SFR.Logical_Lines_Table (Line);
564 end Physical_To_Logical;
566 --------------------------------
567 -- Register_Source_Ref_Pragma --
568 --------------------------------
570 procedure Register_Source_Ref_Pragma
571 (File_Name : Name_Id;
572 Stripped_File_Name : Name_Id;
574 Line_After_Pragma : Physical_Line_Number)
576 subtype size_t is Memory.size_t;
578 SFR : Source_File_Record renames Source_File.Table (Current_Source_File);
580 ML : Logical_Line_Number;
583 if File_Name /= No_Name then
584 SFR.Reference_Name := Stripped_File_Name;
585 SFR.Full_Ref_Name := File_Name;
587 if not Debug_Generated_Code then
588 SFR.Debug_Source_Name := Stripped_File_Name;
589 SFR.Full_Debug_Name := File_Name;
592 SFR.Num_SRef_Pragmas := SFR.Num_SRef_Pragmas + 1;
595 if SFR.Num_SRef_Pragmas = 1 then
596 SFR.First_Mapped_Line := Logical_Line_Number (Mapped_Line);
599 if SFR.Logical_Lines_Table = null then
600 SFR.Logical_Lines_Table := To_Pointer
602 (size_t (SFR.Lines_Table_Max *
603 Logical_Lines_Table_Type'Component_Size /
607 SFR.Logical_Lines_Table (Line_After_Pragma - 1) := No_Line_Number;
609 ML := Logical_Line_Number (Mapped_Line);
610 for J in Line_After_Pragma .. SFR.Last_Source_Line loop
611 SFR.Logical_Lines_Table (J) := ML;
614 end Register_Source_Ref_Pragma;
616 ---------------------------------
617 -- Set_Source_File_Index_Table --
618 ---------------------------------
620 procedure Set_Source_File_Index_Table (Xnew : Source_File_Index) is
623 SL : constant Source_Ptr := Source_File.Table (Xnew).Source_Last;
626 SP := (Source_File.Table (Xnew).Source_First + Chunk_Size - 1)
627 / Chunk_Size * Chunk_Size;
628 Ind := Int (SP) / Chunk_Size;
631 Source_File_Index_Table (Ind) := Xnew;
632 SP := SP + Chunk_Size;
635 end Set_Source_File_Index_Table;
637 ---------------------------
638 -- Skip_Line_Terminators --
639 ---------------------------
641 -- There are two distinct concepts of line terminator in GNAT
643 -- A logical line terminator is what corresponds to the "end of a line"
644 -- as described in RM 2.2 (13). Any of the characters FF, LF, CR or VT
645 -- acts as an end of logical line in this sense, and it is essentially
646 -- irrelevant whether one or more appears in sequence (since if a
647 -- sequence of such characters is regarded as separate ends of line,
648 -- then the intervening logical lines are null in any case).
650 -- A physical line terminator is a sequence of format effectors that
651 -- is treated as ending a physical line. Physical lines have no Ada
652 -- semantic significance, but they are significant for error reporting
653 -- purposes, since errors are identified by line and column location.
655 -- In GNAT, a physical line is ended by any of the sequences LF, CR/LF,
656 -- CR or LF/CR. LF is used in typical Unix systems, CR/LF in DOS systems,
657 -- and CR alone in System 7. We don't know of any system using LF/CR, but
658 -- it seems reasonable to include this case for consistency. In addition,
659 -- we recognize any of these sequences in any of the operating systems,
660 -- for better behavior in treating foreign files (e.g. a Unix file with
661 -- LF terminators transferred to a DOS system).
663 procedure Skip_Line_Terminators
664 (P : in out Source_Ptr;
665 Physical : out Boolean)
668 pragma Assert (Source (P) in Line_Terminator);
670 if Source (P) = CR then
671 if Source (P + 1) = LF then
677 elsif Source (P) = LF then
678 if Source (P + 1) = CR then
684 else -- Source (P) = FF or else Source (P) = VT
690 -- Fall through in the physical line terminator case. First deal with
691 -- making a possible entry into the lines table if one is needed.
693 -- Note: we are dealing with a real source file here, this cannot be
694 -- the instantiation case, so we need not worry about Sloc adjustment.
697 S : Source_File_Record
698 renames Source_File.Table (Current_Source_File);
703 -- Make entry in lines table if not already made (in some scan backup
704 -- cases, we will be rescanning previously scanned source, so the
705 -- entry may have already been made on the previous forward scan).
708 and then P > S.Lines_Table (S.Last_Source_Line)
710 Add_Line_Tables_Entry (S, P);
713 end Skip_Line_Terminators;
719 function Source_Offset (S : Source_Ptr) return Nat is
720 Sindex : constant Source_File_Index := Get_Source_File_Index (S);
721 Sfirst : constant Source_Ptr :=
722 Source_File.Table (Sindex).Source_First;
725 return Nat (S - Sfirst);
728 ------------------------
729 -- Top_Level_Location --
730 ------------------------
732 function Top_Level_Location (S : Source_Ptr) return Source_Ptr is
740 Newloc := Instantiation_Location (Oldloc);
741 exit when Newloc = No_Location;
745 end Top_Level_Location;
751 procedure Tree_Read is
753 -- First we must free any old source buffer pointers
755 if not First_Time_Around then
756 for J in Source_File.First .. Source_File.Last loop
758 S : Source_File_Record renames Source_File.Table (J);
760 procedure Free_Ptr is new Unchecked_Deallocation
761 (Big_Source_Buffer, Source_Buffer_Ptr);
763 function To_Source_Buffer_Ptr is new
764 Unchecked_Conversion (Address, Source_Buffer_Ptr);
766 Tmp1 : Source_Buffer_Ptr;
769 if S.Instantiation /= No_Location then
773 -- We have to recreate a proper pointer to the actual array
774 -- from the zero origin pointer stored in the source table.
778 (S.Source_Text (S.Source_First)'Address);
781 -- Note: we are using free here, because we used malloc
782 -- or realloc directly to allocate the tables. That is
783 -- because we were playing the big array trick.
785 if S.Lines_Table /= null then
786 Memory.Free (To_Address (S.Lines_Table));
787 S.Lines_Table := null;
790 if S.Logical_Lines_Table /= null then
791 Memory.Free (To_Address (S.Logical_Lines_Table));
792 S.Logical_Lines_Table := null;
799 -- Reset source cache pointers to force new read
801 Source_Cache_First := 1;
802 Source_Cache_Last := 0;
804 -- Read in source file table
806 Source_File.Tree_Read;
808 -- The pointers we read in there for the source buffer and lines
809 -- table pointers are junk. We now read in the actual data that
810 -- is referenced by these two fields.
812 for J in Source_File.First .. Source_File.Last loop
814 S : Source_File_Record renames Source_File.Table (J);
817 -- For the instantiation case, we do not read in any data. Instead
818 -- we share the data for the generic template entry. Since the
819 -- template always occurs first, we can safetly refer to its data.
821 if S.Instantiation /= No_Location then
823 ST : Source_File_Record renames
824 Source_File.Table (S.Template);
827 -- The lines tables are copied from the template entry
830 Source_File.Table (S.Template).Lines_Table;
831 S.Logical_Lines_Table :=
832 Source_File.Table (S.Template).Logical_Lines_Table;
834 -- In the case of the source table pointer, we share the
835 -- same data as the generic template, but the virtual origin
836 -- is adjusted. For example, if the first subscript of the
837 -- template is 100, and that of the instantiation is 200,
838 -- then the instantiation pointer is obtained by subtracting
839 -- 100 from the template pointer.
842 pragma Suppress (All_Checks);
844 function To_Source_Buffer_Ptr is new
845 Unchecked_Conversion (Address, Source_Buffer_Ptr);
851 (ST.Source_First - S.Source_First)'Address);
855 -- Normal case (non-instantiation)
858 First_Time_Around := False;
859 S.Lines_Table := null;
860 S.Logical_Lines_Table := null;
861 Alloc_Line_Tables (S, Int (S.Last_Source_Line));
863 for J in 1 .. S.Last_Source_Line loop
864 Tree_Read_Int (Int (S.Lines_Table (J)));
867 if S.Num_SRef_Pragmas /= 0 then
868 for J in 1 .. S.Last_Source_Line loop
869 Tree_Read_Int (Int (S.Logical_Lines_Table (J)));
873 -- Allocate source buffer and read in the data and then set the
874 -- virtual origin to point to the logical zero'th element. This
875 -- address must be computed with subscript checks turned off.
878 subtype B is Text_Buffer (S.Source_First .. S.Source_Last);
879 type Text_Buffer_Ptr is access B;
882 pragma Suppress (All_Checks);
884 function To_Source_Buffer_Ptr is new
885 Unchecked_Conversion (Address, Source_Buffer_Ptr);
890 Tree_Read_Data (T (S.Source_First)'Address,
891 Int (S.Source_Last) - Int (S.Source_First) + 1);
893 S.Source_Text := To_Source_Buffer_Ptr (T (0)'Address);
898 Set_Source_File_Index_Table (J);
906 procedure Tree_Write is
908 Source_File.Tree_Write;
910 -- The pointers we wrote out there for the source buffer and lines
911 -- table pointers are junk, we now write out the actual data that
912 -- is referenced by these two fields.
914 for J in Source_File.First .. Source_File.Last loop
916 S : Source_File_Record renames Source_File.Table (J);
919 -- For instantiations, there is nothing to do, since the data is
920 -- shared with the generic template. When the tree is read, the
921 -- pointers must be set, but no extra data needs to be written.
923 if S.Instantiation /= No_Location then
926 -- For the normal case, write out the data of the tables
931 for J in 1 .. S.Last_Source_Line loop
932 Tree_Write_Int (Int (S.Lines_Table (J)));
935 -- Logical lines table if present
937 if S.Num_SRef_Pragmas /= 0 then
938 for J in 1 .. S.Last_Source_Line loop
939 Tree_Write_Int (Int (S.Logical_Lines_Table (J)));
946 (S.Source_Text (S.Source_First)'Address,
947 Int (S.Source_Last) - Int (S.Source_First) + 1);
957 procedure Write_Location (P : Source_Ptr) is
959 if P = No_Location then
960 Write_Str ("<no location>");
962 elsif P <= Standard_Location then
963 Write_Str ("<standard location>");
967 SI : constant Source_File_Index := Get_Source_File_Index (P);
970 Write_Name (Debug_Source_Name (SI));
972 Write_Int (Int (Get_Logical_Line_Number (P)));
974 Write_Int (Int (Get_Column_Number (P)));
976 if Instantiation (SI) /= No_Location then
978 Write_Location (Instantiation (SI));
985 ----------------------
986 -- Write_Time_Stamp --
987 ----------------------
989 procedure Write_Time_Stamp (S : Source_File_Index) is
990 T : constant Time_Stamp_Type := Time_Stamp (S);
1003 Write_Char (T (P + 1));
1004 Write_Char (T (P + 2));
1007 Write_Char (T (P + 3));
1008 Write_Char (T (P + 4));
1011 Write_Char (T (P + 5));
1012 Write_Char (T (P + 6));
1015 Write_Char (T (P + 7));
1016 Write_Char (T (P + 8));
1019 Write_Char (T (P + 9));
1020 Write_Char (T (P + 10));
1023 Write_Char (T (P + 11));
1024 Write_Char (T (P + 12));
1025 end Write_Time_Stamp;
1027 ----------------------------------------------
1028 -- Access Subprograms for Source File Table --
1029 ----------------------------------------------
1031 function Debug_Source_Name (S : SFI) return File_Name_Type is
1033 return Source_File.Table (S).Debug_Source_Name;
1034 end Debug_Source_Name;
1036 function File_Name (S : SFI) return File_Name_Type is
1038 return Source_File.Table (S).File_Name;
1041 function File_Type (S : SFI) return Type_Of_File is
1043 return Source_File.Table (S).File_Type;
1046 function First_Mapped_Line (S : SFI) return Logical_Line_Number is
1048 return Source_File.Table (S).First_Mapped_Line;
1049 end First_Mapped_Line;
1051 function Full_Debug_Name (S : SFI) return File_Name_Type is
1053 return Source_File.Table (S).Full_Debug_Name;
1054 end Full_Debug_Name;
1056 function Full_File_Name (S : SFI) return File_Name_Type is
1058 return Source_File.Table (S).Full_File_Name;
1061 function Full_Ref_Name (S : SFI) return File_Name_Type is
1063 return Source_File.Table (S).Full_Ref_Name;
1066 function Identifier_Casing (S : SFI) return Casing_Type is
1068 return Source_File.Table (S).Identifier_Casing;
1069 end Identifier_Casing;
1071 function Inlined_Body (S : SFI) return Boolean is
1073 return Source_File.Table (S).Inlined_Body;
1076 function Instantiation (S : SFI) return Source_Ptr is
1078 return Source_File.Table (S).Instantiation;
1081 function Keyword_Casing (S : SFI) return Casing_Type is
1083 return Source_File.Table (S).Keyword_Casing;
1086 function Last_Source_Line (S : SFI) return Physical_Line_Number is
1088 return Source_File.Table (S).Last_Source_Line;
1089 end Last_Source_Line;
1091 function License (S : SFI) return License_Type is
1093 return Source_File.Table (S).License;
1096 function Num_SRef_Pragmas (S : SFI) return Nat is
1098 return Source_File.Table (S).Num_SRef_Pragmas;
1099 end Num_SRef_Pragmas;
1101 function Reference_Name (S : SFI) return File_Name_Type is
1103 return Source_File.Table (S).Reference_Name;
1106 function Source_Checksum (S : SFI) return Word is
1108 return Source_File.Table (S).Source_Checksum;
1109 end Source_Checksum;
1111 function Source_First (S : SFI) return Source_Ptr is
1113 if S = Internal_Source_File then
1114 return Internal_Source'First;
1116 return Source_File.Table (S).Source_First;
1120 function Source_Last (S : SFI) return Source_Ptr is
1122 if S = Internal_Source_File then
1123 return Internal_Source'Last;
1125 return Source_File.Table (S).Source_Last;
1130 function Source_Text (S : SFI) return Source_Buffer_Ptr is
1132 if S = Internal_Source_File then
1133 return Internal_Source_Ptr;
1135 return Source_File.Table (S).Source_Text;
1140 function Template (S : SFI) return SFI is
1142 return Source_File.Table (S).Template;
1145 function Time_Stamp (S : SFI) return Time_Stamp_Type is
1147 return Source_File.Table (S).Time_Stamp;
1150 ------------------------------------------
1151 -- Set Procedures for Source File Table --
1152 ------------------------------------------
1154 procedure Set_Identifier_Casing (S : SFI; C : Casing_Type) is
1156 Source_File.Table (S).Identifier_Casing := C;
1157 end Set_Identifier_Casing;
1159 procedure Set_Keyword_Casing (S : SFI; C : Casing_Type) is
1161 Source_File.Table (S).Keyword_Casing := C;
1162 end Set_Keyword_Casing;
1164 procedure Set_License (S : SFI; L : License_Type) is
1166 Source_File.Table (S).License := L;
1169 ----------------------
1170 -- Trim_Lines_Table --
1171 ----------------------
1173 procedure Trim_Lines_Table (S : Source_File_Index) is
1174 Max : constant Nat := Nat (Source_File.Table (S).Last_Source_Line);
1177 -- Release allocated storage that is no longer needed
1179 Source_File.Table (S).Lines_Table := To_Pointer
1181 (To_Address (Source_File.Table (S).Lines_Table),
1183 (Max * (Lines_Table_Type'Component_Size / System.Storage_Unit))));
1184 Source_File.Table (S).Lines_Table_Max := Physical_Line_Number (Max);
1185 end Trim_Lines_Table;
1191 procedure wl (P : Source_Ptr) is