1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2004 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 pragma Warnings (Off);
60 -- These unchecked conversions are aliasing safe, since they are never
61 -- used to construct improperly aliased pointer values.
63 function To_Address is
64 new Unchecked_Conversion (Lines_Table_Ptr, Address);
66 function To_Address is
67 new Unchecked_Conversion (Logical_Lines_Table_Ptr, Address);
69 function To_Pointer is
70 new Unchecked_Conversion (Address, Lines_Table_Ptr);
72 function To_Pointer is
73 new Unchecked_Conversion (Address, Logical_Lines_Table_Ptr);
77 ---------------------------
78 -- Add_Line_Tables_Entry --
79 ---------------------------
81 procedure Add_Line_Tables_Entry
82 (S : in out Source_File_Record;
85 LL : Physical_Line_Number;
88 -- Reallocate the lines tables if necessary.
90 -- Note: the reason we do not use the normal Table package
91 -- mechanism is that we have several of these tables. We could
92 -- use the new GNAT.Dynamic_Tables package and that would probably
95 if S.Last_Source_Line = S.Lines_Table_Max then
98 Int (S.Last_Source_Line) *
99 ((100 + Alloc.Lines_Increment) / 100));
102 Write_Str ("--> Reallocating lines table, size = ");
103 Write_Int (Int (S.Lines_Table_Max));
108 S.Last_Source_Line := S.Last_Source_Line + 1;
109 LL := S.Last_Source_Line;
111 S.Lines_Table (LL) := P;
113 -- Deal with setting new entry in logical lines table if one is
114 -- present. Note that there is always space (because the call to
115 -- Alloc_Line_Tables makes sure both tables are the same length),
117 if S.Logical_Lines_Table /= null then
119 -- We can always set the entry from the previous one, because
120 -- the processing for a Source_Reference pragma ensures that
121 -- at least one entry following the pragma is set up correctly.
123 S.Logical_Lines_Table (LL) := S.Logical_Lines_Table (LL - 1) + 1;
125 end Add_Line_Tables_Entry;
127 -----------------------
128 -- Alloc_Line_Tables --
129 -----------------------
131 procedure Alloc_Line_Tables
132 (S : in out Source_File_Record;
135 subtype size_t is Memory.size_t;
137 New_Table : Lines_Table_Ptr;
139 New_Logical_Table : Logical_Lines_Table_Ptr;
141 New_Size : constant size_t :=
142 size_t (New_Max * Lines_Table_Type'Component_Size /
146 if S.Lines_Table = null then
147 New_Table := To_Pointer (Memory.Alloc (New_Size));
151 To_Pointer (Memory.Realloc (To_Address (S.Lines_Table), New_Size));
154 if New_Table = null then
157 S.Lines_Table := New_Table;
158 S.Lines_Table_Max := Physical_Line_Number (New_Max);
161 if S.Num_SRef_Pragmas /= 0 then
162 if S.Logical_Lines_Table = null then
163 New_Logical_Table := To_Pointer (Memory.Alloc (New_Size));
165 New_Logical_Table := To_Pointer
166 (Memory.Realloc (To_Address (S.Logical_Lines_Table), New_Size));
169 if New_Logical_Table = null then
172 S.Logical_Lines_Table := New_Logical_Table;
175 end Alloc_Line_Tables;
181 procedure Backup_Line (P : in out Source_Ptr) is
182 Sindex : constant Source_File_Index := Get_Source_File_Index (P);
183 Src : constant Source_Buffer_Ptr :=
184 Source_File.Table (Sindex).Source_Text;
185 Sfirst : constant Source_Ptr :=
186 Source_File.Table (Sindex).Source_First;
196 if Src (P - 1) = LF then
201 if Src (P - 1) = CR then
206 -- Now find first character of the previous line
209 and then Src (P - 1) /= LF
210 and then Src (P - 1) /= CR
216 ---------------------------
217 -- Build_Location_String --
218 ---------------------------
220 procedure Build_Location_String (Loc : Source_Ptr) is
226 -- Loop through instantiations
230 Get_Name_String_And_Append
231 (Reference_Name (Get_Source_File_Index (Ptr)));
232 Add_Char_To_Name_Buffer (':');
233 Add_Nat_To_Name_Buffer
234 (Nat (Get_Logical_Line_Number (Ptr)));
236 Ptr := Instantiation_Location (Ptr);
237 exit when Ptr = No_Location;
238 Add_Str_To_Name_Buffer (" instantiated at ");
241 Name_Buffer (Name_Len + 1) := NUL;
243 end Build_Location_String;
245 -----------------------
246 -- Get_Column_Number --
247 -----------------------
249 function Get_Column_Number (P : Source_Ptr) return Column_Number is
252 Sindex : Source_File_Index;
253 Src : Source_Buffer_Ptr;
256 -- If the input source pointer is not a meaningful value then return
257 -- at once with column number 1. This can happen for a file not found
258 -- condition for a file loaded indirectly by RTE, and also perhaps on
259 -- some unknown internal error conditions. In either case we certainly
260 -- don't want to blow up.
266 Sindex := Get_Source_File_Index (P);
267 Src := Source_File.Table (Sindex).Source_Text;
273 C := (C - 1) / 8 * 8 + (8 + 1);
283 end Get_Column_Number;
285 -----------------------------
286 -- Get_Logical_Line_Number --
287 -----------------------------
289 function Get_Logical_Line_Number
291 return Logical_Line_Number
293 SFR : Source_File_Record
294 renames Source_File.Table (Get_Source_File_Index (P));
296 L : constant Physical_Line_Number := Get_Physical_Line_Number (P);
299 if SFR.Num_SRef_Pragmas = 0 then
300 return Logical_Line_Number (L);
302 return SFR.Logical_Lines_Table (L);
304 end Get_Logical_Line_Number;
306 ------------------------------
307 -- Get_Physical_Line_Number --
308 ------------------------------
310 function Get_Physical_Line_Number
312 return Physical_Line_Number
314 Sfile : Source_File_Index;
315 Table : Lines_Table_Ptr;
316 Lo : Physical_Line_Number;
317 Hi : Physical_Line_Number;
318 Mid : Physical_Line_Number;
322 -- If the input source pointer is not a meaningful value then return
323 -- at once with line number 1. This can happen for a file not found
324 -- condition for a file loaded indirectly by RTE, and also perhaps on
325 -- some unknown internal error conditions. In either case we certainly
326 -- don't want to blow up.
331 -- Otherwise we can do the binary search
334 Sfile := Get_Source_File_Index (P);
335 Loc := P + Source_File.Table (Sfile).Sloc_Adjust;
336 Table := Source_File.Table (Sfile).Lines_Table;
338 Hi := Source_File.Table (Sfile).Last_Source_Line;
341 Mid := (Lo + Hi) / 2;
343 if Loc < Table (Mid) then
346 else -- Loc >= Table (Mid)
349 Loc < Table (Mid + 1)
360 end Get_Physical_Line_Number;
362 ---------------------------
363 -- Get_Source_File_Index --
364 ---------------------------
366 Source_Cache_First : Source_Ptr := 1;
367 Source_Cache_Last : Source_Ptr := 0;
368 -- Records the First and Last subscript values for the most recently
369 -- referenced entry in the source table, to optimize the common case
370 -- of repeated references to the same entry. The initial values force
371 -- an initial search to set the cache value.
373 Source_Cache_Index : Source_File_Index := No_Source_File;
374 -- Contains the index of the entry corresponding to Source_Cache
376 function Get_Source_File_Index
378 return Source_File_Index
381 if S in Source_Cache_First .. Source_Cache_Last then
382 return Source_Cache_Index;
385 for J in Source_File_Index_Table (Int (S) / Chunk_Size)
388 if S in Source_File.Table (J).Source_First ..
389 Source_File.Table (J).Source_Last
391 Source_Cache_Index := J;
392 Source_Cache_First :=
393 Source_File.Table (Source_Cache_Index).Source_First;
395 Source_File.Table (Source_Cache_Index).Source_Last;
396 return Source_Cache_Index;
401 -- We must find a matching entry in the above loop!
404 end Get_Source_File_Index;
410 procedure Initialize is
412 Source_Cache_First := 1;
413 Source_Cache_Last := 0;
414 Source_Cache_Index := No_Source_File;
415 Source_gnat_adc := No_Source_File;
416 First_Time_Around := True;
421 -------------------------
422 -- Instantiation_Depth --
423 -------------------------
425 function Instantiation_Depth (S : Source_Ptr) return Nat is
426 Sind : Source_File_Index;
435 Sind := Get_Source_File_Index (Sval);
436 Sval := Instantiation (Sind);
437 exit when Sval = No_Location;
442 end Instantiation_Depth;
444 ----------------------------
445 -- Instantiation_Location --
446 ----------------------------
448 function Instantiation_Location (S : Source_Ptr) return Source_Ptr is
450 return Instantiation (Get_Source_File_Index (S));
451 end Instantiation_Location;
453 ----------------------
454 -- Last_Source_File --
455 ----------------------
457 function Last_Source_File return Source_File_Index is
459 return Source_File.Last;
460 end Last_Source_File;
466 function Line_Start (P : Source_Ptr) return Source_Ptr is
467 Sindex : constant Source_File_Index := Get_Source_File_Index (P);
468 Src : constant Source_Buffer_Ptr :=
469 Source_File.Table (Sindex).Source_Text;
470 Sfirst : constant Source_Ptr :=
471 Source_File.Table (Sindex).Source_First;
478 and then Src (S - 1) /= CR
479 and then Src (S - 1) /= LF
488 (L : Physical_Line_Number;
489 S : Source_File_Index)
493 return Source_File.Table (S).Lines_Table (L);
502 Source_File.Locked := True;
506 ----------------------
507 -- Num_Source_Files --
508 ----------------------
510 function Num_Source_Files return Nat is
512 return Int (Source_File.Last) - Int (Source_File.First) + 1;
513 end Num_Source_Files;
515 ----------------------
516 -- Num_Source_Lines --
517 ----------------------
519 function Num_Source_Lines (S : Source_File_Index) return Nat is
521 return Nat (Source_File.Table (S).Last_Source_Line);
522 end Num_Source_Lines;
524 -----------------------
525 -- Original_Location --
526 -----------------------
528 function Original_Location (S : Source_Ptr) return Source_Ptr is
529 Sindex : Source_File_Index;
530 Tindex : Source_File_Index;
533 if S <= No_Location then
537 Sindex := Get_Source_File_Index (S);
539 if Instantiation (Sindex) = No_Location then
543 Tindex := Template (Sindex);
544 while Instantiation (Tindex) /= No_Location loop
545 Tindex := Template (Tindex);
548 return S - Source_First (Sindex) + Source_First (Tindex);
551 end Original_Location;
553 -------------------------
554 -- Physical_To_Logical --
555 -------------------------
557 function Physical_To_Logical
558 (Line : Physical_Line_Number;
559 S : Source_File_Index)
560 return Logical_Line_Number
562 SFR : Source_File_Record renames Source_File.Table (S);
565 if SFR.Num_SRef_Pragmas = 0 then
566 return Logical_Line_Number (Line);
568 return SFR.Logical_Lines_Table (Line);
570 end Physical_To_Logical;
572 --------------------------------
573 -- Register_Source_Ref_Pragma --
574 --------------------------------
576 procedure Register_Source_Ref_Pragma
577 (File_Name : Name_Id;
578 Stripped_File_Name : Name_Id;
580 Line_After_Pragma : Physical_Line_Number)
582 subtype size_t is Memory.size_t;
584 SFR : Source_File_Record renames Source_File.Table (Current_Source_File);
586 ML : Logical_Line_Number;
589 if File_Name /= No_Name then
590 SFR.Reference_Name := Stripped_File_Name;
591 SFR.Full_Ref_Name := File_Name;
593 if not Debug_Generated_Code then
594 SFR.Debug_Source_Name := Stripped_File_Name;
595 SFR.Full_Debug_Name := File_Name;
598 SFR.Num_SRef_Pragmas := SFR.Num_SRef_Pragmas + 1;
601 if SFR.Num_SRef_Pragmas = 1 then
602 SFR.First_Mapped_Line := Logical_Line_Number (Mapped_Line);
605 if SFR.Logical_Lines_Table = null then
606 SFR.Logical_Lines_Table := To_Pointer
608 (size_t (SFR.Lines_Table_Max *
609 Logical_Lines_Table_Type'Component_Size /
613 SFR.Logical_Lines_Table (Line_After_Pragma - 1) := No_Line_Number;
615 ML := Logical_Line_Number (Mapped_Line);
616 for J in Line_After_Pragma .. SFR.Last_Source_Line loop
617 SFR.Logical_Lines_Table (J) := ML;
620 end Register_Source_Ref_Pragma;
622 ---------------------------------
623 -- Set_Source_File_Index_Table --
624 ---------------------------------
626 procedure Set_Source_File_Index_Table (Xnew : Source_File_Index) is
629 SL : constant Source_Ptr := Source_File.Table (Xnew).Source_Last;
632 SP := (Source_File.Table (Xnew).Source_First + Chunk_Size - 1)
633 / Chunk_Size * Chunk_Size;
634 Ind := Int (SP) / Chunk_Size;
637 Source_File_Index_Table (Ind) := Xnew;
638 SP := SP + Chunk_Size;
641 end Set_Source_File_Index_Table;
643 ---------------------------
644 -- Skip_Line_Terminators --
645 ---------------------------
647 -- There are two distinct concepts of line terminator in GNAT
649 -- A logical line terminator is what corresponds to the "end of a line"
650 -- as described in RM 2.2 (13). Any of the characters FF, LF, CR or VT
651 -- acts as an end of logical line in this sense, and it is essentially
652 -- irrelevant whether one or more appears in sequence (since if a
653 -- sequence of such characters is regarded as separate ends of line,
654 -- then the intervening logical lines are null in any case).
656 -- A physical line terminator is a sequence of format effectors that
657 -- is treated as ending a physical line. Physical lines have no Ada
658 -- semantic significance, but they are significant for error reporting
659 -- purposes, since errors are identified by line and column location.
661 -- In GNAT, a physical line is ended by any of the sequences LF, CR/LF,
662 -- CR or LF/CR. LF is used in typical Unix systems, CR/LF in DOS systems,
663 -- and CR alone in System 7. We don't know of any system using LF/CR, but
664 -- it seems reasonable to include this case for consistency. In addition,
665 -- we recognize any of these sequences in any of the operating systems,
666 -- for better behavior in treating foreign files (e.g. a Unix file with
667 -- LF terminators transferred to a DOS system).
669 procedure Skip_Line_Terminators
670 (P : in out Source_Ptr;
671 Physical : out Boolean)
674 pragma Assert (Source (P) in Line_Terminator);
676 if Source (P) = CR then
677 if Source (P + 1) = LF then
683 elsif Source (P) = LF then
684 if Source (P + 1) = CR then
690 else -- Source (P) = FF or else Source (P) = VT
696 -- Fall through in the physical line terminator case. First deal with
697 -- making a possible entry into the lines table if one is needed.
699 -- Note: we are dealing with a real source file here, this cannot be
700 -- the instantiation case, so we need not worry about Sloc adjustment.
703 S : Source_File_Record
704 renames Source_File.Table (Current_Source_File);
709 -- Make entry in lines table if not already made (in some scan backup
710 -- cases, we will be rescanning previously scanned source, so the
711 -- entry may have already been made on the previous forward scan).
714 and then P > S.Lines_Table (S.Last_Source_Line)
716 Add_Line_Tables_Entry (S, P);
719 end Skip_Line_Terminators;
725 function Source_Offset (S : Source_Ptr) return Nat is
726 Sindex : constant Source_File_Index := Get_Source_File_Index (S);
727 Sfirst : constant Source_Ptr :=
728 Source_File.Table (Sindex).Source_First;
731 return Nat (S - Sfirst);
734 ------------------------
735 -- Top_Level_Location --
736 ------------------------
738 function Top_Level_Location (S : Source_Ptr) return Source_Ptr is
746 Newloc := Instantiation_Location (Oldloc);
747 exit when Newloc = No_Location;
751 end Top_Level_Location;
757 procedure Tree_Read is
759 -- First we must free any old source buffer pointers
761 if not First_Time_Around then
762 for J in Source_File.First .. Source_File.Last loop
764 S : Source_File_Record renames Source_File.Table (J);
766 procedure Free_Ptr is new Unchecked_Deallocation
767 (Big_Source_Buffer, Source_Buffer_Ptr);
769 pragma Warnings (Off);
770 -- This unchecked conversion is aliasing safe, since it is not
771 -- used to create improperly aliased pointer values.
773 function To_Source_Buffer_Ptr is new
774 Unchecked_Conversion (Address, Source_Buffer_Ptr);
776 pragma Warnings (On);
778 Tmp1 : Source_Buffer_Ptr;
781 if S.Instantiation /= No_Location then
785 -- We have to recreate a proper pointer to the actual array
786 -- from the zero origin pointer stored in the source table.
790 (S.Source_Text (S.Source_First)'Address);
793 -- Note: we are using free here, because we used malloc
794 -- or realloc directly to allocate the tables. That is
795 -- because we were playing the big array trick.
797 if S.Lines_Table /= null then
798 Memory.Free (To_Address (S.Lines_Table));
799 S.Lines_Table := null;
802 if S.Logical_Lines_Table /= null then
803 Memory.Free (To_Address (S.Logical_Lines_Table));
804 S.Logical_Lines_Table := null;
811 -- Reset source cache pointers to force new read
813 Source_Cache_First := 1;
814 Source_Cache_Last := 0;
816 -- Read in source file table
818 Source_File.Tree_Read;
820 -- The pointers we read in there for the source buffer and lines
821 -- table pointers are junk. We now read in the actual data that
822 -- is referenced by these two fields.
824 for J in Source_File.First .. Source_File.Last loop
826 S : Source_File_Record renames Source_File.Table (J);
829 -- For the instantiation case, we do not read in any data. Instead
830 -- we share the data for the generic template entry. Since the
831 -- template always occurs first, we can safetly refer to its data.
833 if S.Instantiation /= No_Location then
835 ST : Source_File_Record renames
836 Source_File.Table (S.Template);
839 -- The lines tables are copied from the template entry
842 Source_File.Table (S.Template).Lines_Table;
843 S.Logical_Lines_Table :=
844 Source_File.Table (S.Template).Logical_Lines_Table;
846 -- In the case of the source table pointer, we share the
847 -- same data as the generic template, but the virtual origin
848 -- is adjusted. For example, if the first subscript of the
849 -- template is 100, and that of the instantiation is 200,
850 -- then the instantiation pointer is obtained by subtracting
851 -- 100 from the template pointer.
854 pragma Suppress (All_Checks);
856 pragma Warnings (Off);
857 -- This unchecked conversion is aliasing safe since it
858 -- not used to create improperly aliased pointer values.
860 function To_Source_Buffer_Ptr is new
861 Unchecked_Conversion (Address, Source_Buffer_Ptr);
863 pragma Warnings (On);
869 (ST.Source_First - S.Source_First)'Address);
873 -- Normal case (non-instantiation)
876 First_Time_Around := False;
877 S.Lines_Table := null;
878 S.Logical_Lines_Table := null;
879 Alloc_Line_Tables (S, Int (S.Last_Source_Line));
881 for J in 1 .. S.Last_Source_Line loop
882 Tree_Read_Int (Int (S.Lines_Table (J)));
885 if S.Num_SRef_Pragmas /= 0 then
886 for J in 1 .. S.Last_Source_Line loop
887 Tree_Read_Int (Int (S.Logical_Lines_Table (J)));
891 -- Allocate source buffer and read in the data and then set the
892 -- virtual origin to point to the logical zero'th element. This
893 -- address must be computed with subscript checks turned off.
896 subtype B is Text_Buffer (S.Source_First .. S.Source_Last);
897 type Text_Buffer_Ptr is access B;
900 pragma Suppress (All_Checks);
902 pragma Warnings (Off);
903 -- This unchecked conversion is aliasing safe, since it is
904 -- never used to create improperly aliased pointer values.
906 function To_Source_Buffer_Ptr is new
907 Unchecked_Conversion (Address, Source_Buffer_Ptr);
909 pragma Warnings (On);
914 Tree_Read_Data (T (S.Source_First)'Address,
915 Int (S.Source_Last) - Int (S.Source_First) + 1);
917 S.Source_Text := To_Source_Buffer_Ptr (T (0)'Address);
922 Set_Source_File_Index_Table (J);
930 procedure Tree_Write is
932 Source_File.Tree_Write;
934 -- The pointers we wrote out there for the source buffer and lines
935 -- table pointers are junk, we now write out the actual data that
936 -- is referenced by these two fields.
938 for J in Source_File.First .. Source_File.Last loop
940 S : Source_File_Record renames Source_File.Table (J);
943 -- For instantiations, there is nothing to do, since the data is
944 -- shared with the generic template. When the tree is read, the
945 -- pointers must be set, but no extra data needs to be written.
947 if S.Instantiation /= No_Location then
950 -- For the normal case, write out the data of the tables
955 for J in 1 .. S.Last_Source_Line loop
956 Tree_Write_Int (Int (S.Lines_Table (J)));
959 -- Logical lines table if present
961 if S.Num_SRef_Pragmas /= 0 then
962 for J in 1 .. S.Last_Source_Line loop
963 Tree_Write_Int (Int (S.Logical_Lines_Table (J)));
970 (S.Source_Text (S.Source_First)'Address,
971 Int (S.Source_Last) - Int (S.Source_First) + 1);
981 procedure Write_Location (P : Source_Ptr) is
983 if P = No_Location then
984 Write_Str ("<no location>");
986 elsif P <= Standard_Location then
987 Write_Str ("<standard location>");
991 SI : constant Source_File_Index := Get_Source_File_Index (P);
994 Write_Name (Debug_Source_Name (SI));
996 Write_Int (Int (Get_Logical_Line_Number (P)));
998 Write_Int (Int (Get_Column_Number (P)));
1000 if Instantiation (SI) /= No_Location then
1002 Write_Location (Instantiation (SI));
1009 ----------------------
1010 -- Write_Time_Stamp --
1011 ----------------------
1013 procedure Write_Time_Stamp (S : Source_File_Index) is
1014 T : constant Time_Stamp_Type := Time_Stamp (S);
1027 Write_Char (T (P + 1));
1028 Write_Char (T (P + 2));
1031 Write_Char (T (P + 3));
1032 Write_Char (T (P + 4));
1035 Write_Char (T (P + 5));
1036 Write_Char (T (P + 6));
1039 Write_Char (T (P + 7));
1040 Write_Char (T (P + 8));
1043 Write_Char (T (P + 9));
1044 Write_Char (T (P + 10));
1047 Write_Char (T (P + 11));
1048 Write_Char (T (P + 12));
1049 end Write_Time_Stamp;
1051 ----------------------------------------------
1052 -- Access Subprograms for Source File Table --
1053 ----------------------------------------------
1055 function Debug_Source_Name (S : SFI) return File_Name_Type is
1057 return Source_File.Table (S).Debug_Source_Name;
1058 end Debug_Source_Name;
1060 function File_Name (S : SFI) return File_Name_Type is
1062 return Source_File.Table (S).File_Name;
1065 function File_Type (S : SFI) return Type_Of_File is
1067 return Source_File.Table (S).File_Type;
1070 function First_Mapped_Line (S : SFI) return Logical_Line_Number is
1072 return Source_File.Table (S).First_Mapped_Line;
1073 end First_Mapped_Line;
1075 function Full_Debug_Name (S : SFI) return File_Name_Type is
1077 return Source_File.Table (S).Full_Debug_Name;
1078 end Full_Debug_Name;
1080 function Full_File_Name (S : SFI) return File_Name_Type is
1082 return Source_File.Table (S).Full_File_Name;
1085 function Full_Ref_Name (S : SFI) return File_Name_Type is
1087 return Source_File.Table (S).Full_Ref_Name;
1090 function Identifier_Casing (S : SFI) return Casing_Type is
1092 return Source_File.Table (S).Identifier_Casing;
1093 end Identifier_Casing;
1095 function Inlined_Body (S : SFI) return Boolean is
1097 return Source_File.Table (S).Inlined_Body;
1100 function Instantiation (S : SFI) return Source_Ptr is
1102 return Source_File.Table (S).Instantiation;
1105 function Keyword_Casing (S : SFI) return Casing_Type is
1107 return Source_File.Table (S).Keyword_Casing;
1110 function Last_Source_Line (S : SFI) return Physical_Line_Number is
1112 return Source_File.Table (S).Last_Source_Line;
1113 end Last_Source_Line;
1115 function License (S : SFI) return License_Type is
1117 return Source_File.Table (S).License;
1120 function Num_SRef_Pragmas (S : SFI) return Nat is
1122 return Source_File.Table (S).Num_SRef_Pragmas;
1123 end Num_SRef_Pragmas;
1125 function Reference_Name (S : SFI) return File_Name_Type is
1127 return Source_File.Table (S).Reference_Name;
1130 function Source_Checksum (S : SFI) return Word is
1132 return Source_File.Table (S).Source_Checksum;
1133 end Source_Checksum;
1135 function Source_First (S : SFI) return Source_Ptr is
1137 if S = Internal_Source_File then
1138 return Internal_Source'First;
1140 return Source_File.Table (S).Source_First;
1144 function Source_Last (S : SFI) return Source_Ptr is
1146 if S = Internal_Source_File then
1147 return Internal_Source'Last;
1149 return Source_File.Table (S).Source_Last;
1154 function Source_Text (S : SFI) return Source_Buffer_Ptr is
1156 if S = Internal_Source_File then
1157 return Internal_Source_Ptr;
1159 return Source_File.Table (S).Source_Text;
1164 function Template (S : SFI) return SFI is
1166 return Source_File.Table (S).Template;
1169 function Time_Stamp (S : SFI) return Time_Stamp_Type is
1171 return Source_File.Table (S).Time_Stamp;
1174 ------------------------------------------
1175 -- Set Procedures for Source File Table --
1176 ------------------------------------------
1178 procedure Set_Identifier_Casing (S : SFI; C : Casing_Type) is
1180 Source_File.Table (S).Identifier_Casing := C;
1181 end Set_Identifier_Casing;
1183 procedure Set_Keyword_Casing (S : SFI; C : Casing_Type) is
1185 Source_File.Table (S).Keyword_Casing := C;
1186 end Set_Keyword_Casing;
1188 procedure Set_License (S : SFI; L : License_Type) is
1190 Source_File.Table (S).License := L;
1193 ----------------------
1194 -- Trim_Lines_Table --
1195 ----------------------
1197 procedure Trim_Lines_Table (S : Source_File_Index) is
1198 Max : constant Nat := Nat (Source_File.Table (S).Last_Source_Line);
1201 -- Release allocated storage that is no longer needed
1203 Source_File.Table (S).Lines_Table := To_Pointer
1205 (To_Address (Source_File.Table (S).Lines_Table),
1207 (Max * (Lines_Table_Type'Component_Size / System.Storage_Unit))));
1208 Source_File.Table (S).Lines_Table_Max := Physical_Line_Number (Max);
1209 end Trim_Lines_Table;
1215 procedure wl (P : Source_Ptr) is