]>
Commit | Line | Data |
---|---|---|
70482933 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- F N A M E . U F -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
6e937c1c | 9 | -- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- |
70482933 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- -- | |
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. -- | |
21 | -- -- | |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
70482933 RK |
24 | -- -- |
25 | ------------------------------------------------------------------------------ | |
26 | ||
27 | with Alloc; | |
28 | with Debug; use Debug; | |
17c5c8a5 | 29 | with Fmap; use Fmap; |
70482933 RK |
30 | with Krunch; |
31 | with Namet; use Namet; | |
32 | with Opt; use Opt; | |
33 | with Osint; use Osint; | |
34 | with Table; | |
2820d220 | 35 | with Uname; use Uname; |
70482933 RK |
36 | with Widechar; use Widechar; |
37 | ||
38 | with GNAT.HTable; | |
39 | ||
40 | package body Fname.UF is | |
41 | ||
42 | -------------------------------------------------------- | |
43 | -- Declarations for Handling Source_File_Name pragmas -- | |
44 | -------------------------------------------------------- | |
45 | ||
46 | type SFN_Entry is record | |
2820d220 AC |
47 | U : Unit_Name_Type; -- Unit name |
48 | F : File_Name_Type; -- Spec/Body file name | |
49 | Index : Nat; -- Index from SFN pragma (0 if none) | |
70482933 RK |
50 | end record; |
51 | -- Record single Unit_Name type call to Set_File_Name | |
52 | ||
53 | package SFN_Table is new Table.Table ( | |
54 | Table_Component_Type => SFN_Entry, | |
55 | Table_Index_Type => Int, | |
56 | Table_Low_Bound => 0, | |
57 | Table_Initial => Alloc.SFN_Table_Initial, | |
58 | Table_Increment => Alloc.SFN_Table_Increment, | |
59 | Table_Name => "SFN_Table"); | |
60 | -- Table recording all Unit_Name calls to Set_File_Name | |
61 | ||
62 | type SFN_Header_Num is range 0 .. 100; | |
63 | ||
64 | function SFN_Hash (F : Unit_Name_Type) return SFN_Header_Num; | |
65 | -- Compute hash index for use by Simple_HTable | |
66 | ||
67 | No_Entry : constant Int := -1; | |
68 | -- Signals no entry in following table | |
69 | ||
70 | package SFN_HTable is new GNAT.HTable.Simple_HTable ( | |
71 | Header_Num => SFN_Header_Num, | |
72 | Element => Int, | |
73 | No_Element => No_Entry, | |
74 | Key => Unit_Name_Type, | |
75 | Hash => SFN_Hash, | |
76 | Equal => "="); | |
77 | -- Hash table allowing rapid access to SFN_Table, the element value | |
78 | -- is an index into this table. | |
79 | ||
80 | type SFN_Pattern_Entry is record | |
81 | Pat : String_Ptr; -- File name pattern (with asterisk in it) | |
82 | Typ : Character; -- 'S'/'B'/'U' for spec/body/subunit | |
83 | Dot : String_Ptr; -- Dot_Separator string | |
84 | Cas : Casing_Type; -- Upper/Lower/Mixed | |
85 | end record; | |
86 | -- Records single call to Set_File_Name_Patterm | |
87 | ||
88 | package SFN_Patterns is new Table.Table ( | |
89 | Table_Component_Type => SFN_Pattern_Entry, | |
90 | Table_Index_Type => Int, | |
91 | Table_Low_Bound => 1, | |
92 | Table_Initial => 10, | |
93 | Table_Increment => 100, | |
94 | Table_Name => "SFN_Patterns"); | |
95 | -- Table recording all calls to Set_File_Name_Pattern. Note that the | |
96 | -- first two entries are set to represent the standard GNAT rules | |
97 | -- for file naming. | |
98 | ||
99 | ----------------------- | |
100 | -- File_Name_Of_Body -- | |
101 | ----------------------- | |
102 | ||
103 | function File_Name_Of_Body (Name : Name_Id) return File_Name_Type is | |
104 | begin | |
105 | Get_Name_String (Name); | |
106 | Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "%b"; | |
107 | Name_Len := Name_Len + 2; | |
108 | return Get_File_Name (Name_Enter, Subunit => False); | |
109 | end File_Name_Of_Body; | |
110 | ||
111 | ----------------------- | |
112 | -- File_Name_Of_Spec -- | |
113 | ----------------------- | |
114 | ||
115 | function File_Name_Of_Spec (Name : Name_Id) return File_Name_Type is | |
116 | begin | |
117 | Get_Name_String (Name); | |
118 | Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "%s"; | |
119 | Name_Len := Name_Len + 2; | |
120 | return Get_File_Name (Name_Enter, Subunit => False); | |
121 | end File_Name_Of_Spec; | |
122 | ||
2820d220 AC |
123 | ---------------------------- |
124 | -- Get_Expected_Unit_Type -- | |
125 | ---------------------------- | |
126 | ||
127 | function Get_Expected_Unit_Type | |
128 | (Fname : File_Name_Type) return Expected_Unit_Type | |
129 | is | |
130 | begin | |
131 | -- In syntax checking only mode or in multiple unit per file mode, | |
132 | -- there can be more than one unit in a file, so the file name is | |
133 | -- not a useful guide to the nature of the unit. | |
134 | ||
135 | if Operating_Mode = Check_Syntax | |
136 | or else Multiple_Unit_Index /= 0 | |
137 | then | |
138 | return Unknown; | |
139 | end if; | |
140 | ||
141 | -- Search the file mapping table, if we find an entry for this | |
142 | -- file we know whether it is a spec or a body. | |
143 | ||
144 | for J in SFN_Table.First .. SFN_Table.Last loop | |
145 | if Fname = SFN_Table.Table (J).F then | |
146 | if Is_Body_Name (SFN_Table.Table (J).U) then | |
147 | return Expect_Body; | |
148 | else | |
149 | return Expect_Spec; | |
150 | end if; | |
151 | end if; | |
152 | end loop; | |
153 | ||
154 | -- If no entry in file naming table, assume .ads/.adb for spec/body | |
155 | -- and return unknown if we have neither of these two cases. | |
156 | ||
157 | Get_Name_String (Fname); | |
158 | ||
159 | if Name_Len > 4 then | |
160 | if Name_Buffer (Name_Len - 3 .. Name_Len) = ".ads" then | |
161 | return Expect_Spec; | |
162 | elsif Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb" then | |
163 | return Expect_Body; | |
164 | end if; | |
165 | end if; | |
166 | ||
167 | return Unknown; | |
168 | end Get_Expected_Unit_Type; | |
169 | ||
70482933 RK |
170 | ------------------- |
171 | -- Get_File_Name -- | |
172 | ------------------- | |
173 | ||
174 | function Get_File_Name | |
06effe87 AC |
175 | (Uname : Unit_Name_Type; |
176 | Subunit : Boolean; | |
6e937c1c | 177 | May_Fail : Boolean := False) return File_Name_Type |
70482933 RK |
178 | is |
179 | Unit_Char : Character; | |
180 | -- Set to 's' or 'b' for spec or body or to 'u' for a subunit | |
181 | ||
182 | Unit_Char_Search : Character; | |
183 | -- Same as Unit_Char, except that in the case of 'u' for a subunit, | |
184 | -- we set Unit_Char_Search to 'b' if we do not find a subunit match. | |
185 | ||
186 | N : Int; | |
187 | ||
6510f4c9 GB |
188 | Pname : File_Name_Type := No_File; |
189 | Fname : File_Name_Type := No_File; | |
17c5c8a5 | 190 | -- Path name and File name for mapping |
6510f4c9 | 191 | |
70482933 | 192 | begin |
44d6a706 | 193 | -- Null or error name means that some previous error occurred |
70482933 RK |
194 | -- This is an unrecoverable error, so signal it. |
195 | ||
196 | if Uname <= Error_Name then | |
197 | raise Unrecoverable_Error; | |
198 | end if; | |
199 | ||
17c5c8a5 | 200 | -- Look in the map from unit names to file names |
6510f4c9 | 201 | |
17c5c8a5 | 202 | Fname := Mapped_File_Name (Uname); |
6510f4c9 GB |
203 | |
204 | -- If the unit name is already mapped, return the corresponding | |
17c5c8a5 | 205 | -- file name from the map. |
6510f4c9 GB |
206 | |
207 | if Fname /= No_File then | |
208 | return Fname; | |
209 | end if; | |
210 | ||
211 | -- If there is a specific SFN pragma, return the corresponding file name | |
212 | ||
70482933 RK |
213 | N := SFN_HTable.Get (Uname); |
214 | ||
215 | if N /= No_Entry then | |
216 | return SFN_Table.Table (N).F; | |
217 | end if; | |
218 | ||
219 | -- Here for the case where the name was not found in the table | |
220 | ||
221 | Get_Decoded_Name_String (Uname); | |
222 | ||
223 | -- A special fudge, normally we don't have operator symbols present, | |
224 | -- since it is always an error to do so. However, if we do, at this | |
225 | -- stage it has a leading double quote. | |
226 | ||
227 | -- What we do in this case is to go back to the undecoded name, which | |
228 | -- is of the form, for example: | |
229 | ||
230 | -- Oand%s | |
231 | ||
232 | -- and build a file name that looks like: | |
233 | ||
234 | -- _and_.ads | |
235 | ||
236 | -- which is bit peculiar, but we keep it that way. This means that | |
237 | -- we avoid bombs due to writing a bad file name, and w get expected | |
238 | -- error processing downstream, e.g. a compilation following gnatchop. | |
239 | ||
240 | if Name_Buffer (1) = '"' then | |
241 | Get_Name_String (Uname); | |
242 | Name_Len := Name_Len + 1; | |
243 | Name_Buffer (Name_Len) := Name_Buffer (Name_Len - 1); | |
244 | Name_Buffer (Name_Len - 1) := Name_Buffer (Name_Len - 2); | |
245 | Name_Buffer (Name_Len - 2) := '_'; | |
246 | Name_Buffer (1) := '_'; | |
247 | end if; | |
248 | ||
249 | -- Deal with spec or body suffix | |
250 | ||
251 | Unit_Char := Name_Buffer (Name_Len); | |
252 | pragma Assert (Unit_Char = 'b' or else Unit_Char = 's'); | |
253 | pragma Assert (Name_Len >= 3 and then Name_Buffer (Name_Len - 1) = '%'); | |
254 | Name_Len := Name_Len - 2; | |
255 | ||
256 | if Subunit then | |
257 | Unit_Char := 'u'; | |
258 | end if; | |
259 | ||
260 | -- Now we need to find the proper translation of the name | |
261 | ||
262 | declare | |
263 | Uname : constant String (1 .. Name_Len) := | |
264 | Name_Buffer (1 .. Name_Len); | |
265 | ||
266 | Pent : Nat; | |
267 | Plen : Natural; | |
268 | Fnam : File_Name_Type := No_File; | |
269 | J : Natural; | |
270 | Dot : String_Ptr; | |
271 | Dotl : Natural; | |
272 | ||
fbf5a39b AC |
273 | Is_Predef : Boolean; |
274 | -- Set True for predefined file | |
275 | ||
70482933 RK |
276 | function C (N : Natural) return Character; |
277 | -- Return N'th character of pattern | |
278 | ||
279 | function C (N : Natural) return Character is | |
280 | begin | |
281 | return SFN_Patterns.Table (Pent).Pat (N); | |
282 | end C; | |
283 | ||
284 | -- Start of search through pattern table | |
285 | ||
286 | begin | |
287 | -- Search pattern table to find a matching entry. In the general | |
288 | -- case we do two complete searches. The first time through we | |
289 | -- stop only if a matching file is found, the second time through | |
290 | -- we accept the first match regardless. Note that there will | |
291 | -- always be a match the second time around, because of the | |
292 | -- default entries at the end of the table. | |
293 | ||
294 | for No_File_Check in False .. True loop | |
295 | Unit_Char_Search := Unit_Char; | |
296 | ||
297 | <<Repeat_Search>> | |
298 | -- The search is repeated with Unit_Char_Search set to b, if an | |
299 | -- initial search for the subunit case fails to find any match. | |
300 | ||
301 | Pent := SFN_Patterns.First; | |
302 | while Pent <= SFN_Patterns.Last loop | |
303 | if SFN_Patterns.Table (Pent).Typ = Unit_Char_Search then | |
304 | Name_Len := 0; | |
305 | ||
fbf5a39b AC |
306 | -- Determine if we have a predefined file name |
307 | ||
308 | Name_Len := Uname'Length; | |
309 | Name_Buffer (1 .. Name_Len) := Uname; | |
310 | Is_Predef := | |
311 | Is_Predefined_File_Name (Renamings_Included => True); | |
312 | ||
70482933 RK |
313 | -- Found a match, execute the pattern |
314 | ||
315 | Name_Len := Uname'Length; | |
316 | Name_Buffer (1 .. Name_Len) := Uname; | |
fbf5a39b AC |
317 | |
318 | -- Apply casing, except that we do not do this for the case | |
319 | -- of a predefined library file. For the latter, we always | |
320 | -- use the all lower case name, regardless of the setting. | |
321 | ||
322 | if not Is_Predef then | |
323 | Set_Casing (SFN_Patterns.Table (Pent).Cas); | |
324 | end if; | |
70482933 RK |
325 | |
326 | -- If dot translation required do it | |
327 | ||
328 | Dot := SFN_Patterns.Table (Pent).Dot; | |
329 | Dotl := Dot.all'Length; | |
330 | ||
331 | if Dot.all /= "." then | |
332 | J := 1; | |
333 | ||
334 | while J <= Name_Len loop | |
335 | if Name_Buffer (J) = '.' then | |
336 | ||
337 | if Dotl = 1 then | |
338 | Name_Buffer (J) := Dot (Dot'First); | |
339 | ||
340 | else | |
341 | Name_Buffer (J + Dotl .. Name_Len + Dotl - 1) := | |
342 | Name_Buffer (J + 1 .. Name_Len); | |
343 | Name_Buffer (J .. J + Dotl - 1) := Dot.all; | |
344 | Name_Len := Name_Len + Dotl - 1; | |
345 | end if; | |
346 | ||
347 | J := J + Dotl; | |
348 | ||
349 | -- Skip past wide char sequences to avoid messing | |
350 | -- with dot characters that are part of a sequence. | |
351 | ||
352 | elsif Name_Buffer (J) = ASCII.ESC | |
353 | or else (Upper_Half_Encoding | |
354 | and then | |
355 | Name_Buffer (J) in Upper_Half_Character) | |
356 | then | |
357 | Skip_Wide (Name_Buffer, J); | |
358 | else | |
359 | J := J + 1; | |
360 | end if; | |
361 | end loop; | |
362 | end if; | |
363 | ||
364 | -- Here move result to right if preinsertion before * | |
365 | ||
366 | Plen := SFN_Patterns.Table (Pent).Pat'Length; | |
367 | for K in 1 .. Plen loop | |
368 | if C (K) = '*' then | |
369 | if K /= 1 then | |
370 | Name_Buffer (1 + K - 1 .. Name_Len + K - 1) := | |
371 | Name_Buffer (1 .. Name_Len); | |
372 | ||
373 | for L in 1 .. K - 1 loop | |
374 | Name_Buffer (L) := C (L); | |
375 | end loop; | |
376 | ||
377 | Name_Len := Name_Len + K - 1; | |
378 | end if; | |
379 | ||
380 | for L in K + 1 .. Plen loop | |
381 | Name_Len := Name_Len + 1; | |
382 | Name_Buffer (Name_Len) := C (L); | |
383 | end loop; | |
384 | ||
385 | exit; | |
386 | end if; | |
387 | end loop; | |
388 | ||
389 | -- Execute possible crunch on constructed name. The krunch | |
390 | -- operation excludes any extension that may be present. | |
391 | ||
392 | J := Name_Len; | |
393 | while J > 1 loop | |
394 | exit when Name_Buffer (J) = '.'; | |
395 | J := J - 1; | |
396 | end loop; | |
397 | ||
398 | -- Case of extension present | |
399 | ||
400 | if J > 1 then | |
401 | declare | |
402 | Ext : constant String := Name_Buffer (J .. Name_Len); | |
403 | ||
404 | begin | |
405 | -- Remove extension | |
406 | ||
407 | Name_Len := J - 1; | |
408 | ||
409 | -- Krunch what's left | |
410 | ||
411 | Krunch | |
412 | (Name_Buffer, | |
413 | Name_Len, | |
414 | Integer (Maximum_File_Name_Length), | |
415 | Debug_Flag_4); | |
416 | ||
417 | -- Replace extension | |
418 | ||
419 | Name_Buffer | |
420 | (Name_Len + 1 .. Name_Len + Ext'Length) := Ext; | |
421 | Name_Len := Name_Len + Ext'Length; | |
422 | end; | |
423 | ||
424 | -- Case of no extension present, straight krunch on | |
425 | -- the entire file name. | |
426 | ||
427 | else | |
428 | Krunch | |
429 | (Name_Buffer, | |
430 | Name_Len, | |
431 | Integer (Maximum_File_Name_Length), | |
432 | Debug_Flag_4); | |
433 | end if; | |
434 | ||
435 | Fnam := File_Name_Type (Name_Find); | |
436 | ||
07fc65c4 GB |
437 | -- If we are in the second search of the table, we accept |
438 | -- the file name without checking, because we know that | |
06effe87 AC |
439 | -- the file does not exist, except when May_Fail is True, |
440 | -- in which case we return No_File. | |
70482933 | 441 | |
07fc65c4 | 442 | if No_File_Check then |
6e937c1c AC |
443 | if May_Fail then |
444 | return No_File; | |
6e937c1c AC |
445 | else |
446 | return Fnam; | |
447 | end if; | |
70482933 | 448 | |
07fc65c4 | 449 | -- Otherwise we check if the file exists |
70482933 | 450 | |
6510f4c9 GB |
451 | else |
452 | Pname := Find_File (Fnam, Source); | |
453 | ||
07fc65c4 GB |
454 | -- If it does exist, we add it to the mappings and |
455 | -- return the file name. | |
70482933 | 456 | |
6510f4c9 | 457 | if Pname /= No_File then |
70482933 | 458 | |
6510f4c9 GB |
459 | -- Add to mapping, so that we don't do another |
460 | -- path search in Find_File for this file name | |
07fc65c4 GB |
461 | -- and, if we use a mapping file, we are ready |
462 | -- to update it at the end of this compilation | |
463 | -- for the benefit of other compilation processes. | |
6510f4c9 | 464 | |
17c5c8a5 | 465 | Add_To_File_Map (Get_File_Name.Uname, Fnam, Pname); |
6510f4c9 GB |
466 | return Fnam; |
467 | ||
07fc65c4 GB |
468 | -- If there are only two entries, they are those of |
469 | -- the default GNAT naming scheme. The file does | |
470 | -- not exist, but there is no point doing the | |
471 | -- second search, because we will end up with the | |
472 | -- same file name. Just return the file name. | |
473 | ||
474 | elsif SFN_Patterns.Last = 2 then | |
475 | return Fnam; | |
476 | ||
477 | -- The file does not exist, but there may be other | |
478 | -- naming scheme. Keep on searching. | |
6510f4c9 GB |
479 | |
480 | else | |
481 | Fnam := No_File; | |
482 | end if; | |
70482933 RK |
483 | end if; |
484 | end if; | |
485 | ||
486 | Pent := Pent + 1; | |
487 | end loop; | |
488 | ||
489 | -- If search failed, and was for a subunit, repeat the search | |
490 | -- with Unit_Char_Search reset to 'b', since in the normal case | |
491 | -- we simply treat subunits as bodies. | |
492 | ||
493 | if Fnam = No_File and then Unit_Char_Search = 'u' then | |
494 | Unit_Char_Search := 'b'; | |
495 | goto Repeat_Search; | |
496 | end if; | |
497 | ||
498 | -- Repeat entire search in No_File_Check mode if necessary | |
499 | ||
500 | end loop; | |
501 | ||
502 | -- Something is wrong if search fails completely, since the | |
503 | -- default entries should catch all possibilities at this stage. | |
504 | ||
505 | raise Program_Error; | |
506 | end; | |
507 | end Get_File_Name; | |
508 | ||
2820d220 AC |
509 | -------------------- |
510 | -- Get_Unit_Index -- | |
511 | -------------------- | |
512 | ||
513 | function Get_Unit_Index (Uname : Unit_Name_Type) return Nat is | |
514 | N : constant Int := SFN_HTable.Get (Uname); | |
515 | begin | |
516 | if N /= No_Entry then | |
517 | return SFN_Table.Table (N).Index; | |
518 | else | |
519 | return 0; | |
520 | end if; | |
521 | end Get_Unit_Index; | |
522 | ||
70482933 RK |
523 | ---------------- |
524 | -- Initialize -- | |
525 | ---------------- | |
526 | ||
527 | procedure Initialize is | |
528 | begin | |
529 | SFN_Table.Init; | |
530 | SFN_Patterns.Init; | |
531 | ||
532 | -- Add default entries to SFN_Patterns.Table to represent the | |
533 | -- standard default GNAT rules for file name translation. | |
534 | ||
535 | SFN_Patterns.Append (New_Val => | |
536 | (Pat => new String'("*.ads"), | |
537 | Typ => 's', | |
538 | Dot => new String'("-"), | |
539 | Cas => All_Lower_Case)); | |
540 | ||
541 | SFN_Patterns.Append (New_Val => | |
542 | (Pat => new String'("*.adb"), | |
543 | Typ => 'b', | |
544 | Dot => new String'("-"), | |
545 | Cas => All_Lower_Case)); | |
546 | end Initialize; | |
547 | ||
548 | ---------- | |
549 | -- Lock -- | |
550 | ---------- | |
551 | ||
552 | procedure Lock is | |
553 | begin | |
554 | SFN_Table.Locked := True; | |
555 | SFN_Table.Release; | |
556 | end Lock; | |
557 | ||
558 | ------------------- | |
559 | -- Set_File_Name -- | |
560 | ------------------- | |
561 | ||
2820d220 AC |
562 | procedure Set_File_Name |
563 | (U : Unit_Name_Type; | |
564 | F : File_Name_Type; | |
565 | Index : Nat) | |
566 | is | |
70482933 RK |
567 | begin |
568 | SFN_Table.Increment_Last; | |
2820d220 | 569 | SFN_Table.Table (SFN_Table.Last) := (U, F, Index); |
70482933 RK |
570 | SFN_HTable.Set (U, SFN_Table.Last); |
571 | end Set_File_Name; | |
572 | ||
573 | --------------------------- | |
574 | -- Set_File_Name_Pattern -- | |
575 | --------------------------- | |
576 | ||
577 | procedure Set_File_Name_Pattern | |
578 | (Pat : String_Ptr; | |
579 | Typ : Character; | |
580 | Dot : String_Ptr; | |
581 | Cas : Casing_Type) | |
582 | is | |
583 | L : constant Nat := SFN_Patterns.Last; | |
2820d220 | 584 | |
70482933 RK |
585 | begin |
586 | SFN_Patterns.Increment_Last; | |
587 | ||
588 | -- Move up the last two entries (the default ones) and then | |
589 | -- put the new entry into the table just before them (we | |
590 | -- always have the default entries be the last ones). | |
591 | ||
592 | SFN_Patterns.Table (L + 1) := SFN_Patterns.Table (L); | |
593 | SFN_Patterns.Table (L) := SFN_Patterns.Table (L - 1); | |
594 | SFN_Patterns.Table (L - 1) := (Pat, Typ, Dot, Cas); | |
595 | end Set_File_Name_Pattern; | |
596 | ||
597 | -------------- | |
598 | -- SFN_Hash -- | |
599 | -------------- | |
600 | ||
601 | function SFN_Hash (F : Unit_Name_Type) return SFN_Header_Num is | |
602 | begin | |
603 | return SFN_Header_Num (Int (F) rem SFN_Header_Num'Range_Length); | |
604 | end SFN_Hash; | |
605 | ||
606 | begin | |
607 | ||
608 | -- We call the initialization routine from the package body, so that | |
609 | -- Fname.Init only needs to be called explicitly to reinitialize. | |
610 | ||
611 | Fname.UF.Initialize; | |
612 | end Fname.UF; |