]>
Commit | Line | Data |
---|---|---|
996ae0b0 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- S I N P U T -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
748086b7 | 9 | -- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- |
996ae0b0 RK |
10 | -- -- |
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- -- | |
748086b7 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
996ae0b0 RK |
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 -- | |
748086b7 JJ |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
17 | -- -- | |
18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
19 | -- additional permissions described in the GCC Runtime Library Exception, -- | |
20 | -- version 3.1, as published by the Free Software Foundation. -- | |
21 | -- -- | |
22 | -- You should have received a copy of the GNU General Public License and -- | |
23 | -- a copy of the GCC Runtime Library Exception along with this program; -- | |
24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
25 | -- <http://www.gnu.org/licenses/>. -- | |
996ae0b0 RK |
26 | -- -- |
27 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
996ae0b0 RK |
29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
32 | pragma Style_Checks (All_Checks); | |
33 | -- Subprograms not all in alpha order | |
34 | ||
4e7a4f6e | 35 | with Atree; use Atree; |
82c80734 | 36 | with Debug; use Debug; |
82c80734 RD |
37 | with Opt; use Opt; |
38 | with Output; use Output; | |
39 | with Tree_IO; use Tree_IO; | |
40 | with System; use System; | |
41 | with Widechar; use Widechar; | |
996ae0b0 | 42 | |
07fc65c4 GB |
43 | with System.Memory; |
44 | ||
996ae0b0 RK |
45 | with Unchecked_Conversion; |
46 | with Unchecked_Deallocation; | |
47 | ||
48 | package body Sinput is | |
49 | ||
50 | use ASCII; | |
51 | -- Make control characters visible | |
52 | ||
53 | First_Time_Around : Boolean := True; | |
54 | ||
07fc65c4 GB |
55 | -- Routines to support conversion between types Lines_Table_Ptr, |
56 | -- Logical_Lines_Table_Ptr and System.Address. | |
57 | ||
8a6a52dc AC |
58 | pragma Warnings (Off); |
59 | -- These unchecked conversions are aliasing safe, since they are never | |
60 | -- used to construct improperly aliased pointer values. | |
61 | ||
07fc65c4 GB |
62 | function To_Address is |
63 | new Unchecked_Conversion (Lines_Table_Ptr, Address); | |
64 | ||
65 | function To_Address is | |
66 | new Unchecked_Conversion (Logical_Lines_Table_Ptr, Address); | |
67 | ||
68 | function To_Pointer is | |
69 | new Unchecked_Conversion (Address, Lines_Table_Ptr); | |
70 | ||
71 | function To_Pointer is | |
72 | new Unchecked_Conversion (Address, Logical_Lines_Table_Ptr); | |
73 | ||
8a6a52dc AC |
74 | pragma Warnings (On); |
75 | ||
996ae0b0 RK |
76 | --------------------------- |
77 | -- Add_Line_Tables_Entry -- | |
78 | --------------------------- | |
79 | ||
80 | procedure Add_Line_Tables_Entry | |
81 | (S : in out Source_File_Record; | |
82 | P : Source_Ptr) | |
83 | is | |
84 | LL : Physical_Line_Number; | |
85 | ||
86 | begin | |
9de61fcb | 87 | -- Reallocate the lines tables if necessary |
996ae0b0 RK |
88 | |
89 | -- Note: the reason we do not use the normal Table package | |
90 | -- mechanism is that we have several of these tables. We could | |
91 | -- use the new GNAT.Dynamic_Tables package and that would probably | |
92 | -- be a good idea ??? | |
93 | ||
94 | if S.Last_Source_Line = S.Lines_Table_Max then | |
95 | Alloc_Line_Tables | |
96 | (S, | |
97 | Int (S.Last_Source_Line) * | |
98 | ((100 + Alloc.Lines_Increment) / 100)); | |
99 | ||
100 | if Debug_Flag_D then | |
101 | Write_Str ("--> Reallocating lines table, size = "); | |
102 | Write_Int (Int (S.Lines_Table_Max)); | |
103 | Write_Eol; | |
104 | end if; | |
105 | end if; | |
106 | ||
107 | S.Last_Source_Line := S.Last_Source_Line + 1; | |
108 | LL := S.Last_Source_Line; | |
109 | ||
110 | S.Lines_Table (LL) := P; | |
111 | ||
112 | -- Deal with setting new entry in logical lines table if one is | |
113 | -- present. Note that there is always space (because the call to | |
114 | -- Alloc_Line_Tables makes sure both tables are the same length), | |
115 | ||
116 | if S.Logical_Lines_Table /= null then | |
117 | ||
118 | -- We can always set the entry from the previous one, because | |
119 | -- the processing for a Source_Reference pragma ensures that | |
120 | -- at least one entry following the pragma is set up correctly. | |
121 | ||
122 | S.Logical_Lines_Table (LL) := S.Logical_Lines_Table (LL - 1) + 1; | |
123 | end if; | |
124 | end Add_Line_Tables_Entry; | |
125 | ||
126 | ----------------------- | |
127 | -- Alloc_Line_Tables -- | |
128 | ----------------------- | |
129 | ||
130 | procedure Alloc_Line_Tables | |
131 | (S : in out Source_File_Record; | |
132 | New_Max : Nat) | |
133 | is | |
07fc65c4 | 134 | subtype size_t is Memory.size_t; |
996ae0b0 RK |
135 | |
136 | New_Table : Lines_Table_Ptr; | |
137 | ||
138 | New_Logical_Table : Logical_Lines_Table_Ptr; | |
139 | ||
140 | New_Size : constant size_t := | |
141 | size_t (New_Max * Lines_Table_Type'Component_Size / | |
142 | Storage_Unit); | |
143 | ||
144 | begin | |
145 | if S.Lines_Table = null then | |
07fc65c4 | 146 | New_Table := To_Pointer (Memory.Alloc (New_Size)); |
996ae0b0 RK |
147 | |
148 | else | |
149 | New_Table := | |
07fc65c4 | 150 | To_Pointer (Memory.Realloc (To_Address (S.Lines_Table), New_Size)); |
996ae0b0 RK |
151 | end if; |
152 | ||
153 | if New_Table = null then | |
154 | raise Storage_Error; | |
155 | else | |
156 | S.Lines_Table := New_Table; | |
157 | S.Lines_Table_Max := Physical_Line_Number (New_Max); | |
158 | end if; | |
159 | ||
160 | if S.Num_SRef_Pragmas /= 0 then | |
161 | if S.Logical_Lines_Table = null then | |
07fc65c4 | 162 | New_Logical_Table := To_Pointer (Memory.Alloc (New_Size)); |
996ae0b0 | 163 | else |
07fc65c4 GB |
164 | New_Logical_Table := To_Pointer |
165 | (Memory.Realloc (To_Address (S.Logical_Lines_Table), New_Size)); | |
996ae0b0 RK |
166 | end if; |
167 | ||
168 | if New_Logical_Table = null then | |
169 | raise Storage_Error; | |
170 | else | |
171 | S.Logical_Lines_Table := New_Logical_Table; | |
172 | end if; | |
173 | end if; | |
174 | end Alloc_Line_Tables; | |
175 | ||
176 | ----------------- | |
177 | -- Backup_Line -- | |
178 | ----------------- | |
179 | ||
180 | procedure Backup_Line (P : in out Source_Ptr) is | |
181 | Sindex : constant Source_File_Index := Get_Source_File_Index (P); | |
182 | Src : constant Source_Buffer_Ptr := | |
183 | Source_File.Table (Sindex).Source_Text; | |
184 | Sfirst : constant Source_Ptr := | |
185 | Source_File.Table (Sindex).Source_First; | |
186 | ||
187 | begin | |
188 | P := P - 1; | |
189 | ||
190 | if P = Sfirst then | |
191 | return; | |
192 | end if; | |
193 | ||
194 | if Src (P) = CR then | |
195 | if Src (P - 1) = LF then | |
196 | P := P - 1; | |
197 | end if; | |
198 | ||
199 | else -- Src (P) = LF | |
200 | if Src (P - 1) = CR then | |
201 | P := P - 1; | |
202 | end if; | |
203 | end if; | |
204 | ||
205 | -- Now find first character of the previous line | |
206 | ||
207 | while P > Sfirst | |
208 | and then Src (P - 1) /= LF | |
209 | and then Src (P - 1) /= CR | |
210 | loop | |
211 | P := P - 1; | |
212 | end loop; | |
213 | end Backup_Line; | |
214 | ||
215 | --------------------------- | |
216 | -- Build_Location_String -- | |
217 | --------------------------- | |
218 | ||
219 | procedure Build_Location_String (Loc : Source_Ptr) is | |
220 | Ptr : Source_Ptr; | |
221 | ||
222 | begin | |
996ae0b0 RK |
223 | -- Loop through instantiations |
224 | ||
225 | Ptr := Loc; | |
226 | loop | |
227 | Get_Name_String_And_Append | |
228 | (Reference_Name (Get_Source_File_Index (Ptr))); | |
229 | Add_Char_To_Name_Buffer (':'); | |
230 | Add_Nat_To_Name_Buffer | |
231 | (Nat (Get_Logical_Line_Number (Ptr))); | |
232 | ||
233 | Ptr := Instantiation_Location (Ptr); | |
234 | exit when Ptr = No_Location; | |
235 | Add_Str_To_Name_Buffer (" instantiated at "); | |
236 | end loop; | |
237 | ||
238 | Name_Buffer (Name_Len + 1) := NUL; | |
239 | return; | |
240 | end Build_Location_String; | |
241 | ||
242 | ----------------------- | |
243 | -- Get_Column_Number -- | |
244 | ----------------------- | |
245 | ||
246 | function Get_Column_Number (P : Source_Ptr) return Column_Number is | |
247 | S : Source_Ptr; | |
248 | C : Column_Number; | |
249 | Sindex : Source_File_Index; | |
250 | Src : Source_Buffer_Ptr; | |
251 | ||
252 | begin | |
253 | -- If the input source pointer is not a meaningful value then return | |
254 | -- at once with column number 1. This can happen for a file not found | |
255 | -- condition for a file loaded indirectly by RTE, and also perhaps on | |
256 | -- some unknown internal error conditions. In either case we certainly | |
257 | -- don't want to blow up. | |
258 | ||
259 | if P < 1 then | |
260 | return 1; | |
261 | ||
262 | else | |
263 | Sindex := Get_Source_File_Index (P); | |
264 | Src := Source_File.Table (Sindex).Source_Text; | |
265 | S := Line_Start (P); | |
266 | C := 1; | |
267 | ||
268 | while S < P loop | |
269 | if Src (S) = HT then | |
270 | C := (C - 1) / 8 * 8 + (8 + 1); | |
271 | else | |
272 | C := C + 1; | |
273 | end if; | |
274 | ||
275 | S := S + 1; | |
276 | end loop; | |
277 | ||
278 | return C; | |
279 | end if; | |
280 | end Get_Column_Number; | |
281 | ||
282 | ----------------------------- | |
283 | -- Get_Logical_Line_Number -- | |
284 | ----------------------------- | |
285 | ||
286 | function Get_Logical_Line_Number | |
e7d72fb9 | 287 | (P : Source_Ptr) return Logical_Line_Number |
996ae0b0 RK |
288 | is |
289 | SFR : Source_File_Record | |
290 | renames Source_File.Table (Get_Source_File_Index (P)); | |
291 | ||
292 | L : constant Physical_Line_Number := Get_Physical_Line_Number (P); | |
293 | ||
294 | begin | |
295 | if SFR.Num_SRef_Pragmas = 0 then | |
296 | return Logical_Line_Number (L); | |
297 | else | |
298 | return SFR.Logical_Lines_Table (L); | |
299 | end if; | |
300 | end Get_Logical_Line_Number; | |
301 | ||
302 | ------------------------------ | |
303 | -- Get_Physical_Line_Number -- | |
304 | ------------------------------ | |
305 | ||
306 | function Get_Physical_Line_Number | |
e7d72fb9 | 307 | (P : Source_Ptr) return Physical_Line_Number |
996ae0b0 RK |
308 | is |
309 | Sfile : Source_File_Index; | |
310 | Table : Lines_Table_Ptr; | |
311 | Lo : Physical_Line_Number; | |
312 | Hi : Physical_Line_Number; | |
313 | Mid : Physical_Line_Number; | |
314 | Loc : Source_Ptr; | |
315 | ||
316 | begin | |
317 | -- If the input source pointer is not a meaningful value then return | |
318 | -- at once with line number 1. This can happen for a file not found | |
319 | -- condition for a file loaded indirectly by RTE, and also perhaps on | |
320 | -- some unknown internal error conditions. In either case we certainly | |
321 | -- don't want to blow up. | |
322 | ||
323 | if P < 1 then | |
324 | return 1; | |
325 | ||
326 | -- Otherwise we can do the binary search | |
327 | ||
328 | else | |
329 | Sfile := Get_Source_File_Index (P); | |
330 | Loc := P + Source_File.Table (Sfile).Sloc_Adjust; | |
331 | Table := Source_File.Table (Sfile).Lines_Table; | |
332 | Lo := 1; | |
333 | Hi := Source_File.Table (Sfile).Last_Source_Line; | |
334 | ||
335 | loop | |
336 | Mid := (Lo + Hi) / 2; | |
337 | ||
338 | if Loc < Table (Mid) then | |
339 | Hi := Mid - 1; | |
340 | ||
341 | else -- Loc >= Table (Mid) | |
342 | ||
343 | if Mid = Hi or else | |
344 | Loc < Table (Mid + 1) | |
345 | then | |
346 | return Mid; | |
347 | else | |
348 | Lo := Mid + 1; | |
349 | end if; | |
350 | ||
351 | end if; | |
352 | ||
353 | end loop; | |
354 | end if; | |
355 | end Get_Physical_Line_Number; | |
356 | ||
357 | --------------------------- | |
358 | -- Get_Source_File_Index -- | |
359 | --------------------------- | |
360 | ||
361 | Source_Cache_First : Source_Ptr := 1; | |
362 | Source_Cache_Last : Source_Ptr := 0; | |
363 | -- Records the First and Last subscript values for the most recently | |
968d9db3 TQ |
364 | -- referenced entry in the source table, to optimize the common case of |
365 | -- repeated references to the same entry. The initial values force an | |
366 | -- initial search to set the cache value. | |
996ae0b0 RK |
367 | |
368 | Source_Cache_Index : Source_File_Index := No_Source_File; | |
369 | -- Contains the index of the entry corresponding to Source_Cache | |
370 | ||
968d9db3 | 371 | function Get_Source_File_Index (S : Source_Ptr) return Source_File_Index is |
996ae0b0 RK |
372 | begin |
373 | if S in Source_Cache_First .. Source_Cache_Last then | |
374 | return Source_Cache_Index; | |
375 | ||
376 | else | |
968d9db3 TQ |
377 | pragma Assert (Source_File_Index_Table (Int (S) / Chunk_Size) |
378 | /= | |
379 | No_Source_File); | |
fbf5a39b AC |
380 | for J in Source_File_Index_Table (Int (S) / Chunk_Size) |
381 | .. Source_File.Last | |
382 | loop | |
996ae0b0 RK |
383 | if S in Source_File.Table (J).Source_First .. |
384 | Source_File.Table (J).Source_Last | |
385 | then | |
386 | Source_Cache_Index := J; | |
387 | Source_Cache_First := | |
388 | Source_File.Table (Source_Cache_Index).Source_First; | |
389 | Source_Cache_Last := | |
390 | Source_File.Table (Source_Cache_Index).Source_Last; | |
391 | return Source_Cache_Index; | |
392 | end if; | |
393 | end loop; | |
394 | end if; | |
395 | ||
396 | -- We must find a matching entry in the above loop! | |
397 | ||
398 | raise Program_Error; | |
399 | end Get_Source_File_Index; | |
400 | ||
401 | ---------------- | |
402 | -- Initialize -- | |
403 | ---------------- | |
404 | ||
405 | procedure Initialize is | |
406 | begin | |
fbf5a39b AC |
407 | Source_Cache_First := 1; |
408 | Source_Cache_Last := 0; | |
409 | Source_Cache_Index := No_Source_File; | |
410 | Source_gnat_adc := No_Source_File; | |
411 | First_Time_Around := True; | |
412 | ||
996ae0b0 RK |
413 | Source_File.Init; |
414 | end Initialize; | |
415 | ||
416 | ------------------------- | |
417 | -- Instantiation_Depth -- | |
418 | ------------------------- | |
419 | ||
420 | function Instantiation_Depth (S : Source_Ptr) return Nat is | |
421 | Sind : Source_File_Index; | |
422 | Sval : Source_Ptr; | |
423 | Depth : Nat; | |
424 | ||
425 | begin | |
426 | Sval := S; | |
427 | Depth := 0; | |
428 | ||
429 | loop | |
430 | Sind := Get_Source_File_Index (Sval); | |
431 | Sval := Instantiation (Sind); | |
432 | exit when Sval = No_Location; | |
433 | Depth := Depth + 1; | |
434 | end loop; | |
435 | ||
436 | return Depth; | |
437 | end Instantiation_Depth; | |
438 | ||
439 | ---------------------------- | |
440 | -- Instantiation_Location -- | |
441 | ---------------------------- | |
442 | ||
443 | function Instantiation_Location (S : Source_Ptr) return Source_Ptr is | |
444 | begin | |
445 | return Instantiation (Get_Source_File_Index (S)); | |
446 | end Instantiation_Location; | |
447 | ||
448 | ---------------------- | |
449 | -- Last_Source_File -- | |
450 | ---------------------- | |
451 | ||
452 | function Last_Source_File return Source_File_Index is | |
453 | begin | |
454 | return Source_File.Last; | |
455 | end Last_Source_File; | |
456 | ||
457 | ---------------- | |
458 | -- Line_Start -- | |
459 | ---------------- | |
460 | ||
461 | function Line_Start (P : Source_Ptr) return Source_Ptr is | |
462 | Sindex : constant Source_File_Index := Get_Source_File_Index (P); | |
463 | Src : constant Source_Buffer_Ptr := | |
464 | Source_File.Table (Sindex).Source_Text; | |
465 | Sfirst : constant Source_Ptr := | |
466 | Source_File.Table (Sindex).Source_First; | |
467 | S : Source_Ptr; | |
468 | ||
469 | begin | |
470 | S := P; | |
996ae0b0 RK |
471 | while S > Sfirst |
472 | and then Src (S - 1) /= CR | |
473 | and then Src (S - 1) /= LF | |
474 | loop | |
475 | S := S - 1; | |
476 | end loop; | |
477 | ||
478 | return S; | |
479 | end Line_Start; | |
480 | ||
481 | function Line_Start | |
e7d72fb9 AC |
482 | (L : Physical_Line_Number; |
483 | S : Source_File_Index) return Source_Ptr | |
996ae0b0 RK |
484 | is |
485 | begin | |
486 | return Source_File.Table (S).Lines_Table (L); | |
487 | end Line_Start; | |
488 | ||
489 | ---------- | |
490 | -- Lock -- | |
491 | ---------- | |
492 | ||
493 | procedure Lock is | |
494 | begin | |
495 | Source_File.Locked := True; | |
496 | Source_File.Release; | |
497 | end Lock; | |
498 | ||
499 | ---------------------- | |
500 | -- Num_Source_Files -- | |
501 | ---------------------- | |
502 | ||
503 | function Num_Source_Files return Nat is | |
504 | begin | |
505 | return Int (Source_File.Last) - Int (Source_File.First) + 1; | |
506 | end Num_Source_Files; | |
507 | ||
508 | ---------------------- | |
509 | -- Num_Source_Lines -- | |
510 | ---------------------- | |
511 | ||
512 | function Num_Source_Lines (S : Source_File_Index) return Nat is | |
513 | begin | |
514 | return Nat (Source_File.Table (S).Last_Source_Line); | |
515 | end Num_Source_Lines; | |
516 | ||
517 | ----------------------- | |
518 | -- Original_Location -- | |
519 | ----------------------- | |
520 | ||
521 | function Original_Location (S : Source_Ptr) return Source_Ptr is | |
522 | Sindex : Source_File_Index; | |
523 | Tindex : Source_File_Index; | |
524 | ||
525 | begin | |
526 | if S <= No_Location then | |
527 | return S; | |
528 | ||
529 | else | |
530 | Sindex := Get_Source_File_Index (S); | |
531 | ||
532 | if Instantiation (Sindex) = No_Location then | |
533 | return S; | |
534 | ||
535 | else | |
536 | Tindex := Template (Sindex); | |
537 | while Instantiation (Tindex) /= No_Location loop | |
538 | Tindex := Template (Tindex); | |
539 | end loop; | |
540 | ||
541 | return S - Source_First (Sindex) + Source_First (Tindex); | |
542 | end if; | |
543 | end if; | |
544 | end Original_Location; | |
545 | ||
546 | ------------------------- | |
547 | -- Physical_To_Logical -- | |
548 | ------------------------- | |
549 | ||
550 | function Physical_To_Logical | |
551 | (Line : Physical_Line_Number; | |
e7d72fb9 | 552 | S : Source_File_Index) return Logical_Line_Number |
996ae0b0 RK |
553 | is |
554 | SFR : Source_File_Record renames Source_File.Table (S); | |
555 | ||
556 | begin | |
557 | if SFR.Num_SRef_Pragmas = 0 then | |
558 | return Logical_Line_Number (Line); | |
559 | else | |
560 | return SFR.Logical_Lines_Table (Line); | |
561 | end if; | |
562 | end Physical_To_Logical; | |
563 | ||
564 | -------------------------------- | |
565 | -- Register_Source_Ref_Pragma -- | |
566 | -------------------------------- | |
567 | ||
568 | procedure Register_Source_Ref_Pragma | |
1c28fe3a RD |
569 | (File_Name : File_Name_Type; |
570 | Stripped_File_Name : File_Name_Type; | |
996ae0b0 RK |
571 | Mapped_Line : Nat; |
572 | Line_After_Pragma : Physical_Line_Number) | |
573 | is | |
07fc65c4 | 574 | subtype size_t is Memory.size_t; |
996ae0b0 | 575 | |
07fc65c4 | 576 | SFR : Source_File_Record renames Source_File.Table (Current_Source_File); |
996ae0b0 RK |
577 | |
578 | ML : Logical_Line_Number; | |
579 | ||
580 | begin | |
1c28fe3a | 581 | if File_Name /= No_File then |
fbf5a39b AC |
582 | SFR.Reference_Name := Stripped_File_Name; |
583 | SFR.Full_Ref_Name := File_Name; | |
996ae0b0 RK |
584 | |
585 | if not Debug_Generated_Code then | |
fbf5a39b AC |
586 | SFR.Debug_Source_Name := Stripped_File_Name; |
587 | SFR.Full_Debug_Name := File_Name; | |
996ae0b0 RK |
588 | end if; |
589 | ||
996ae0b0 RK |
590 | SFR.Num_SRef_Pragmas := SFR.Num_SRef_Pragmas + 1; |
591 | end if; | |
592 | ||
593 | if SFR.Num_SRef_Pragmas = 1 then | |
594 | SFR.First_Mapped_Line := Logical_Line_Number (Mapped_Line); | |
595 | end if; | |
596 | ||
597 | if SFR.Logical_Lines_Table = null then | |
07fc65c4 GB |
598 | SFR.Logical_Lines_Table := To_Pointer |
599 | (Memory.Alloc | |
996ae0b0 RK |
600 | (size_t (SFR.Lines_Table_Max * |
601 | Logical_Lines_Table_Type'Component_Size / | |
07fc65c4 | 602 | Storage_Unit))); |
996ae0b0 RK |
603 | end if; |
604 | ||
605 | SFR.Logical_Lines_Table (Line_After_Pragma - 1) := No_Line_Number; | |
606 | ||
607 | ML := Logical_Line_Number (Mapped_Line); | |
608 | for J in Line_After_Pragma .. SFR.Last_Source_Line loop | |
609 | SFR.Logical_Lines_Table (J) := ML; | |
610 | ML := ML + 1; | |
611 | end loop; | |
612 | end Register_Source_Ref_Pragma; | |
613 | ||
fbf5a39b AC |
614 | --------------------------------- |
615 | -- Set_Source_File_Index_Table -- | |
616 | --------------------------------- | |
617 | ||
618 | procedure Set_Source_File_Index_Table (Xnew : Source_File_Index) is | |
619 | Ind : Int; | |
620 | SP : Source_Ptr; | |
621 | SL : constant Source_Ptr := Source_File.Table (Xnew).Source_Last; | |
622 | ||
623 | begin | |
624 | SP := (Source_File.Table (Xnew).Source_First + Chunk_Size - 1) | |
625 | / Chunk_Size * Chunk_Size; | |
626 | Ind := Int (SP) / Chunk_Size; | |
627 | ||
628 | while SP <= SL loop | |
629 | Source_File_Index_Table (Ind) := Xnew; | |
630 | SP := SP + Chunk_Size; | |
631 | Ind := Ind + 1; | |
632 | end loop; | |
633 | end Set_Source_File_Index_Table; | |
634 | ||
996ae0b0 RK |
635 | --------------------------- |
636 | -- Skip_Line_Terminators -- | |
637 | --------------------------- | |
638 | ||
996ae0b0 RK |
639 | procedure Skip_Line_Terminators |
640 | (P : in out Source_Ptr; | |
641 | Physical : out Boolean) | |
642 | is | |
82c80734 | 643 | Chr : constant Character := Source (P); |
996ae0b0 | 644 | |
82c80734 | 645 | begin |
e3a6d737 | 646 | if Chr = CR then |
996ae0b0 RK |
647 | if Source (P + 1) = LF then |
648 | P := P + 2; | |
649 | else | |
650 | P := P + 1; | |
651 | end if; | |
652 | ||
82c80734 | 653 | elsif Chr = LF then |
c27f2f15 | 654 | P := P + 1; |
996ae0b0 | 655 | |
82c80734 | 656 | elsif Chr = FF or else Chr = VT then |
996ae0b0 RK |
657 | P := P + 1; |
658 | Physical := False; | |
659 | return; | |
82c80734 RD |
660 | |
661 | -- Otherwise we have a wide character | |
662 | ||
663 | else | |
664 | Skip_Wide (Source, P); | |
996ae0b0 RK |
665 | end if; |
666 | ||
667 | -- Fall through in the physical line terminator case. First deal with | |
668 | -- making a possible entry into the lines table if one is needed. | |
669 | ||
670 | -- Note: we are dealing with a real source file here, this cannot be | |
671 | -- the instantiation case, so we need not worry about Sloc adjustment. | |
672 | ||
673 | declare | |
674 | S : Source_File_Record | |
675 | renames Source_File.Table (Current_Source_File); | |
676 | ||
677 | begin | |
678 | Physical := True; | |
679 | ||
680 | -- Make entry in lines table if not already made (in some scan backup | |
681 | -- cases, we will be rescanning previously scanned source, so the | |
682 | -- entry may have already been made on the previous forward scan). | |
683 | ||
684 | if Source (P) /= EOF | |
685 | and then P > S.Lines_Table (S.Last_Source_Line) | |
686 | then | |
687 | Add_Line_Tables_Entry (S, P); | |
688 | end if; | |
689 | end; | |
690 | end Skip_Line_Terminators; | |
691 | ||
e7d72fb9 AC |
692 | ---------------- |
693 | -- Sloc_Range -- | |
694 | ---------------- | |
695 | ||
696 | procedure Sloc_Range (Expr : Node_Id; Min, Max : out Source_Ptr) is | |
697 | ||
698 | function Process (N : Node_Id) return Traverse_Result; | |
699 | -- Process function for traversing the expression tree | |
700 | ||
701 | procedure Traverse is new Traverse_Proc (Process); | |
702 | ||
703 | ------------- | |
704 | -- Process -- | |
705 | ------------- | |
706 | ||
707 | function Process (N : Node_Id) return Traverse_Result is | |
708 | begin | |
709 | if Sloc (N) < Min then | |
710 | if Sloc (N) > No_Location then | |
711 | Min := Sloc (N); | |
712 | end if; | |
713 | elsif Sloc (N) > Max then | |
714 | if Sloc (N) > No_Location then | |
715 | Max := Sloc (N); | |
716 | end if; | |
717 | end if; | |
718 | ||
719 | return OK; | |
720 | end Process; | |
721 | ||
722 | -- Start of processing for Sloc_Range | |
723 | ||
724 | begin | |
725 | Min := Sloc (Expr); | |
726 | Max := Sloc (Expr); | |
727 | Traverse (Expr); | |
728 | end Sloc_Range; | |
729 | ||
996ae0b0 RK |
730 | ------------------- |
731 | -- Source_Offset -- | |
732 | ------------------- | |
733 | ||
734 | function Source_Offset (S : Source_Ptr) return Nat is | |
735 | Sindex : constant Source_File_Index := Get_Source_File_Index (S); | |
736 | Sfirst : constant Source_Ptr := | |
737 | Source_File.Table (Sindex).Source_First; | |
996ae0b0 RK |
738 | begin |
739 | return Nat (S - Sfirst); | |
740 | end Source_Offset; | |
741 | ||
742 | ------------------------ | |
743 | -- Top_Level_Location -- | |
744 | ------------------------ | |
745 | ||
746 | function Top_Level_Location (S : Source_Ptr) return Source_Ptr is | |
747 | Oldloc : Source_Ptr; | |
748 | Newloc : Source_Ptr; | |
749 | ||
750 | begin | |
751 | Newloc := S; | |
752 | loop | |
753 | Oldloc := Newloc; | |
754 | Newloc := Instantiation_Location (Oldloc); | |
755 | exit when Newloc = No_Location; | |
756 | end loop; | |
757 | ||
758 | return Oldloc; | |
759 | end Top_Level_Location; | |
760 | ||
761 | --------------- | |
762 | -- Tree_Read -- | |
763 | --------------- | |
764 | ||
765 | procedure Tree_Read is | |
766 | begin | |
767 | -- First we must free any old source buffer pointers | |
768 | ||
769 | if not First_Time_Around then | |
770 | for J in Source_File.First .. Source_File.Last loop | |
771 | declare | |
772 | S : Source_File_Record renames Source_File.Table (J); | |
773 | ||
774 | procedure Free_Ptr is new Unchecked_Deallocation | |
775 | (Big_Source_Buffer, Source_Buffer_Ptr); | |
776 | ||
8a6a52dc AC |
777 | pragma Warnings (Off); |
778 | -- This unchecked conversion is aliasing safe, since it is not | |
779 | -- used to create improperly aliased pointer values. | |
780 | ||
996ae0b0 RK |
781 | function To_Source_Buffer_Ptr is new |
782 | Unchecked_Conversion (Address, Source_Buffer_Ptr); | |
783 | ||
8a6a52dc AC |
784 | pragma Warnings (On); |
785 | ||
996ae0b0 RK |
786 | Tmp1 : Source_Buffer_Ptr; |
787 | ||
788 | begin | |
789 | if S.Instantiation /= No_Location then | |
790 | null; | |
791 | ||
792 | else | |
21d27997 RD |
793 | -- Free the buffer, we use 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. We need to | |
796 | -- suppress the warning for freeing from an empty pool! | |
797 | ||
996ae0b0 RK |
798 | -- We have to recreate a proper pointer to the actual array |
799 | -- from the zero origin pointer stored in the source table. | |
800 | ||
801 | Tmp1 := | |
802 | To_Source_Buffer_Ptr | |
803 | (S.Source_Text (S.Source_First)'Address); | |
21d27997 | 804 | pragma Warnings (Off); |
996ae0b0 | 805 | Free_Ptr (Tmp1); |
21d27997 | 806 | pragma Warnings (On); |
07fc65c4 | 807 | |
996ae0b0 | 808 | if S.Lines_Table /= null then |
07fc65c4 | 809 | Memory.Free (To_Address (S.Lines_Table)); |
996ae0b0 RK |
810 | S.Lines_Table := null; |
811 | end if; | |
812 | ||
813 | if S.Logical_Lines_Table /= null then | |
07fc65c4 | 814 | Memory.Free (To_Address (S.Logical_Lines_Table)); |
996ae0b0 RK |
815 | S.Logical_Lines_Table := null; |
816 | end if; | |
817 | end if; | |
818 | end; | |
819 | end loop; | |
820 | end if; | |
821 | ||
822 | -- Reset source cache pointers to force new read | |
823 | ||
824 | Source_Cache_First := 1; | |
825 | Source_Cache_Last := 0; | |
826 | ||
827 | -- Read in source file table | |
828 | ||
829 | Source_File.Tree_Read; | |
830 | ||
831 | -- The pointers we read in there for the source buffer and lines | |
832 | -- table pointers are junk. We now read in the actual data that | |
833 | -- is referenced by these two fields. | |
834 | ||
835 | for J in Source_File.First .. Source_File.Last loop | |
836 | declare | |
837 | S : Source_File_Record renames Source_File.Table (J); | |
838 | ||
839 | begin | |
840 | -- For the instantiation case, we do not read in any data. Instead | |
841 | -- we share the data for the generic template entry. Since the | |
968d9db3 | 842 | -- template always occurs first, we can safely refer to its data. |
996ae0b0 RK |
843 | |
844 | if S.Instantiation /= No_Location then | |
845 | declare | |
846 | ST : Source_File_Record renames | |
847 | Source_File.Table (S.Template); | |
848 | ||
849 | begin | |
850 | -- The lines tables are copied from the template entry | |
851 | ||
852 | S.Lines_Table := | |
853 | Source_File.Table (S.Template).Lines_Table; | |
854 | S.Logical_Lines_Table := | |
855 | Source_File.Table (S.Template).Logical_Lines_Table; | |
856 | ||
857 | -- In the case of the source table pointer, we share the | |
858 | -- same data as the generic template, but the virtual origin | |
859 | -- is adjusted. For example, if the first subscript of the | |
860 | -- template is 100, and that of the instantiation is 200, | |
861 | -- then the instantiation pointer is obtained by subtracting | |
862 | -- 100 from the template pointer. | |
863 | ||
864 | declare | |
865 | pragma Suppress (All_Checks); | |
866 | ||
8a6a52dc AC |
867 | pragma Warnings (Off); |
868 | -- This unchecked conversion is aliasing safe since it | |
869 | -- not used to create improperly aliased pointer values. | |
870 | ||
996ae0b0 RK |
871 | function To_Source_Buffer_Ptr is new |
872 | Unchecked_Conversion (Address, Source_Buffer_Ptr); | |
873 | ||
8a6a52dc AC |
874 | pragma Warnings (On); |
875 | ||
996ae0b0 RK |
876 | begin |
877 | S.Source_Text := | |
878 | To_Source_Buffer_Ptr | |
879 | (ST.Source_Text | |
880 | (ST.Source_First - S.Source_First)'Address); | |
881 | end; | |
882 | end; | |
883 | ||
884 | -- Normal case (non-instantiation) | |
885 | ||
886 | else | |
887 | First_Time_Around := False; | |
888 | S.Lines_Table := null; | |
889 | S.Logical_Lines_Table := null; | |
890 | Alloc_Line_Tables (S, Int (S.Last_Source_Line)); | |
891 | ||
892 | for J in 1 .. S.Last_Source_Line loop | |
893 | Tree_Read_Int (Int (S.Lines_Table (J))); | |
894 | end loop; | |
895 | ||
896 | if S.Num_SRef_Pragmas /= 0 then | |
897 | for J in 1 .. S.Last_Source_Line loop | |
898 | Tree_Read_Int (Int (S.Logical_Lines_Table (J))); | |
899 | end loop; | |
900 | end if; | |
901 | ||
902 | -- Allocate source buffer and read in the data and then set the | |
903 | -- virtual origin to point to the logical zero'th element. This | |
904 | -- address must be computed with subscript checks turned off. | |
905 | ||
906 | declare | |
907 | subtype B is Text_Buffer (S.Source_First .. S.Source_Last); | |
908 | type Text_Buffer_Ptr is access B; | |
909 | T : Text_Buffer_Ptr; | |
910 | ||
911 | pragma Suppress (All_Checks); | |
912 | ||
8a6a52dc AC |
913 | pragma Warnings (Off); |
914 | -- This unchecked conversion is aliasing safe, since it is | |
915 | -- never used to create improperly aliased pointer values. | |
916 | ||
996ae0b0 RK |
917 | function To_Source_Buffer_Ptr is new |
918 | Unchecked_Conversion (Address, Source_Buffer_Ptr); | |
919 | ||
8a6a52dc AC |
920 | pragma Warnings (On); |
921 | ||
996ae0b0 RK |
922 | begin |
923 | T := new B; | |
924 | ||
925 | Tree_Read_Data (T (S.Source_First)'Address, | |
926 | Int (S.Source_Last) - Int (S.Source_First) + 1); | |
927 | ||
928 | S.Source_Text := To_Source_Buffer_Ptr (T (0)'Address); | |
929 | end; | |
930 | end if; | |
931 | end; | |
fbf5a39b AC |
932 | |
933 | Set_Source_File_Index_Table (J); | |
996ae0b0 RK |
934 | end loop; |
935 | end Tree_Read; | |
936 | ||
937 | ---------------- | |
938 | -- Tree_Write -- | |
939 | ---------------- | |
940 | ||
941 | procedure Tree_Write is | |
942 | begin | |
943 | Source_File.Tree_Write; | |
944 | ||
945 | -- The pointers we wrote out there for the source buffer and lines | |
946 | -- table pointers are junk, we now write out the actual data that | |
947 | -- is referenced by these two fields. | |
948 | ||
949 | for J in Source_File.First .. Source_File.Last loop | |
950 | declare | |
951 | S : Source_File_Record renames Source_File.Table (J); | |
952 | ||
953 | begin | |
954 | -- For instantiations, there is nothing to do, since the data is | |
955 | -- shared with the generic template. When the tree is read, the | |
956 | -- pointers must be set, but no extra data needs to be written. | |
957 | ||
958 | if S.Instantiation /= No_Location then | |
959 | null; | |
960 | ||
961 | -- For the normal case, write out the data of the tables | |
962 | ||
963 | else | |
964 | -- Lines table | |
965 | ||
966 | for J in 1 .. S.Last_Source_Line loop | |
967 | Tree_Write_Int (Int (S.Lines_Table (J))); | |
968 | end loop; | |
969 | ||
970 | -- Logical lines table if present | |
971 | ||
972 | if S.Num_SRef_Pragmas /= 0 then | |
973 | for J in 1 .. S.Last_Source_Line loop | |
974 | Tree_Write_Int (Int (S.Logical_Lines_Table (J))); | |
975 | end loop; | |
976 | end if; | |
977 | ||
978 | -- Source buffer | |
979 | ||
980 | Tree_Write_Data | |
981 | (S.Source_Text (S.Source_First)'Address, | |
982 | Int (S.Source_Last) - Int (S.Source_First) + 1); | |
983 | end if; | |
984 | end; | |
985 | end loop; | |
986 | end Tree_Write; | |
987 | ||
988 | -------------------- | |
989 | -- Write_Location -- | |
990 | -------------------- | |
991 | ||
992 | procedure Write_Location (P : Source_Ptr) is | |
993 | begin | |
994 | if P = No_Location then | |
995 | Write_Str ("<no location>"); | |
996 | ||
997 | elsif P <= Standard_Location then | |
998 | Write_Str ("<standard location>"); | |
999 | ||
1000 | else | |
1001 | declare | |
1002 | SI : constant Source_File_Index := Get_Source_File_Index (P); | |
1003 | ||
1004 | begin | |
1005 | Write_Name (Debug_Source_Name (SI)); | |
1006 | Write_Char (':'); | |
1007 | Write_Int (Int (Get_Logical_Line_Number (P))); | |
1008 | Write_Char (':'); | |
1009 | Write_Int (Int (Get_Column_Number (P))); | |
1010 | ||
1011 | if Instantiation (SI) /= No_Location then | |
1012 | Write_Str (" ["); | |
1013 | Write_Location (Instantiation (SI)); | |
1014 | Write_Char (']'); | |
1015 | end if; | |
1016 | end; | |
1017 | end if; | |
1018 | end Write_Location; | |
1019 | ||
1020 | ---------------------- | |
1021 | -- Write_Time_Stamp -- | |
1022 | ---------------------- | |
1023 | ||
1024 | procedure Write_Time_Stamp (S : Source_File_Index) is | |
1025 | T : constant Time_Stamp_Type := Time_Stamp (S); | |
1026 | P : Natural; | |
1027 | ||
1028 | begin | |
1029 | if T (1) = '9' then | |
1030 | Write_Str ("19"); | |
1031 | P := 0; | |
1032 | else | |
1033 | Write_Char (T (1)); | |
1034 | Write_Char (T (2)); | |
1035 | P := 2; | |
1036 | end if; | |
1037 | ||
1038 | Write_Char (T (P + 1)); | |
1039 | Write_Char (T (P + 2)); | |
1040 | Write_Char ('-'); | |
1041 | ||
1042 | Write_Char (T (P + 3)); | |
1043 | Write_Char (T (P + 4)); | |
1044 | Write_Char ('-'); | |
1045 | ||
1046 | Write_Char (T (P + 5)); | |
1047 | Write_Char (T (P + 6)); | |
1048 | Write_Char (' '); | |
1049 | ||
1050 | Write_Char (T (P + 7)); | |
1051 | Write_Char (T (P + 8)); | |
1052 | Write_Char (':'); | |
1053 | ||
1054 | Write_Char (T (P + 9)); | |
1055 | Write_Char (T (P + 10)); | |
1056 | Write_Char (':'); | |
1057 | ||
1058 | Write_Char (T (P + 11)); | |
1059 | Write_Char (T (P + 12)); | |
1060 | end Write_Time_Stamp; | |
1061 | ||
1062 | ---------------------------------------------- | |
1063 | -- Access Subprograms for Source File Table -- | |
1064 | ---------------------------------------------- | |
1065 | ||
1066 | function Debug_Source_Name (S : SFI) return File_Name_Type is | |
1067 | begin | |
1068 | return Source_File.Table (S).Debug_Source_Name; | |
1069 | end Debug_Source_Name; | |
1070 | ||
1071 | function File_Name (S : SFI) return File_Name_Type is | |
1072 | begin | |
1073 | return Source_File.Table (S).File_Name; | |
1074 | end File_Name; | |
1075 | ||
fbf5a39b AC |
1076 | function File_Type (S : SFI) return Type_Of_File is |
1077 | begin | |
1078 | return Source_File.Table (S).File_Type; | |
1079 | end File_Type; | |
1080 | ||
996ae0b0 RK |
1081 | function First_Mapped_Line (S : SFI) return Logical_Line_Number is |
1082 | begin | |
1083 | return Source_File.Table (S).First_Mapped_Line; | |
1084 | end First_Mapped_Line; | |
1085 | ||
fbf5a39b AC |
1086 | function Full_Debug_Name (S : SFI) return File_Name_Type is |
1087 | begin | |
1088 | return Source_File.Table (S).Full_Debug_Name; | |
1089 | end Full_Debug_Name; | |
1090 | ||
996ae0b0 RK |
1091 | function Full_File_Name (S : SFI) return File_Name_Type is |
1092 | begin | |
1093 | return Source_File.Table (S).Full_File_Name; | |
1094 | end Full_File_Name; | |
1095 | ||
1096 | function Full_Ref_Name (S : SFI) return File_Name_Type is | |
1097 | begin | |
1098 | return Source_File.Table (S).Full_Ref_Name; | |
1099 | end Full_Ref_Name; | |
1100 | ||
1101 | function Identifier_Casing (S : SFI) return Casing_Type is | |
1102 | begin | |
1103 | return Source_File.Table (S).Identifier_Casing; | |
1104 | end Identifier_Casing; | |
1105 | ||
fbf5a39b AC |
1106 | function Inlined_Body (S : SFI) return Boolean is |
1107 | begin | |
1108 | return Source_File.Table (S).Inlined_Body; | |
1109 | end Inlined_Body; | |
1110 | ||
996ae0b0 RK |
1111 | function Instantiation (S : SFI) return Source_Ptr is |
1112 | begin | |
1113 | return Source_File.Table (S).Instantiation; | |
1114 | end Instantiation; | |
1115 | ||
1116 | function Keyword_Casing (S : SFI) return Casing_Type is | |
1117 | begin | |
1118 | return Source_File.Table (S).Keyword_Casing; | |
1119 | end Keyword_Casing; | |
1120 | ||
1121 | function Last_Source_Line (S : SFI) return Physical_Line_Number is | |
1122 | begin | |
1123 | return Source_File.Table (S).Last_Source_Line; | |
1124 | end Last_Source_Line; | |
1125 | ||
1126 | function License (S : SFI) return License_Type is | |
1127 | begin | |
1128 | return Source_File.Table (S).License; | |
1129 | end License; | |
1130 | ||
1131 | function Num_SRef_Pragmas (S : SFI) return Nat is | |
1132 | begin | |
1133 | return Source_File.Table (S).Num_SRef_Pragmas; | |
1134 | end Num_SRef_Pragmas; | |
1135 | ||
1136 | function Reference_Name (S : SFI) return File_Name_Type is | |
1137 | begin | |
1138 | return Source_File.Table (S).Reference_Name; | |
1139 | end Reference_Name; | |
1140 | ||
1141 | function Source_Checksum (S : SFI) return Word is | |
1142 | begin | |
1143 | return Source_File.Table (S).Source_Checksum; | |
1144 | end Source_Checksum; | |
1145 | ||
1146 | function Source_First (S : SFI) return Source_Ptr is | |
1147 | begin | |
f1f9fe30 | 1148 | if S = Internal_Source_File then |
6c1e24d3 | 1149 | return Internal_Source'First; |
f1f9fe30 AC |
1150 | else |
1151 | return Source_File.Table (S).Source_First; | |
1152 | end if; | |
996ae0b0 RK |
1153 | end Source_First; |
1154 | ||
1155 | function Source_Last (S : SFI) return Source_Ptr is | |
1156 | begin | |
f1f9fe30 | 1157 | if S = Internal_Source_File then |
6c1e24d3 | 1158 | return Internal_Source'Last; |
f1f9fe30 AC |
1159 | else |
1160 | return Source_File.Table (S).Source_Last; | |
1161 | end if; | |
996ae0b0 RK |
1162 | end Source_Last; |
1163 | ||
1164 | function Source_Text (S : SFI) return Source_Buffer_Ptr is | |
1165 | begin | |
f1f9fe30 AC |
1166 | if S = Internal_Source_File then |
1167 | return Internal_Source_Ptr; | |
1168 | else | |
1169 | return Source_File.Table (S).Source_Text; | |
1170 | end if; | |
996ae0b0 RK |
1171 | end Source_Text; |
1172 | ||
1173 | function Template (S : SFI) return SFI is | |
1174 | begin | |
1175 | return Source_File.Table (S).Template; | |
1176 | end Template; | |
1177 | ||
1178 | function Time_Stamp (S : SFI) return Time_Stamp_Type is | |
1179 | begin | |
1180 | return Source_File.Table (S).Time_Stamp; | |
1181 | end Time_Stamp; | |
1182 | ||
68e2ea27 TQ |
1183 | function Unit (S : SFI) return Unit_Number_Type is |
1184 | begin | |
1185 | return Source_File.Table (S).Unit; | |
1186 | end Unit; | |
1187 | ||
996ae0b0 RK |
1188 | ------------------------------------------ |
1189 | -- Set Procedures for Source File Table -- | |
1190 | ------------------------------------------ | |
1191 | ||
1192 | procedure Set_Identifier_Casing (S : SFI; C : Casing_Type) is | |
1193 | begin | |
1194 | Source_File.Table (S).Identifier_Casing := C; | |
1195 | end Set_Identifier_Casing; | |
1196 | ||
1197 | procedure Set_Keyword_Casing (S : SFI; C : Casing_Type) is | |
1198 | begin | |
1199 | Source_File.Table (S).Keyword_Casing := C; | |
1200 | end Set_Keyword_Casing; | |
1201 | ||
1202 | procedure Set_License (S : SFI; L : License_Type) is | |
1203 | begin | |
1204 | Source_File.Table (S).License := L; | |
1205 | end Set_License; | |
1206 | ||
68e2ea27 TQ |
1207 | procedure Set_Unit (S : SFI; U : Unit_Number_Type) is |
1208 | begin | |
1209 | Source_File.Table (S).Unit := U; | |
1210 | end Set_Unit; | |
1211 | ||
07fc65c4 GB |
1212 | ---------------------- |
1213 | -- Trim_Lines_Table -- | |
1214 | ---------------------- | |
1215 | ||
1216 | procedure Trim_Lines_Table (S : Source_File_Index) is | |
1217 | Max : constant Nat := Nat (Source_File.Table (S).Last_Source_Line); | |
1218 | ||
1219 | begin | |
1220 | -- Release allocated storage that is no longer needed | |
1221 | ||
1222 | Source_File.Table (S).Lines_Table := To_Pointer | |
1223 | (Memory.Realloc | |
1224 | (To_Address (Source_File.Table (S).Lines_Table), | |
1225 | Memory.size_t | |
1226 | (Max * (Lines_Table_Type'Component_Size / System.Storage_Unit)))); | |
1227 | Source_File.Table (S).Lines_Table_Max := Physical_Line_Number (Max); | |
1228 | end Trim_Lines_Table; | |
1229 | ||
1c28fe3a RD |
1230 | ------------ |
1231 | -- Unlock -- | |
1232 | ------------ | |
1233 | ||
1234 | procedure Unlock is | |
1235 | begin | |
1236 | Source_File.Locked := False; | |
1237 | Source_File.Release; | |
1238 | end Unlock; | |
1239 | ||
996ae0b0 RK |
1240 | -------- |
1241 | -- wl -- | |
1242 | -------- | |
1243 | ||
1244 | procedure wl (P : Source_Ptr) is | |
1245 | begin | |
1246 | Write_Location (P); | |
1247 | Write_Eol; | |
1248 | end wl; | |
1249 | ||
1250 | end Sinput; |