OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [osint.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                                O S I N T                                 --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
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 3,  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 COPYING3.  If not, go to --
19
-- http://www.gnu.org/licenses for a complete copy of the license.          --
20
--                                                                          --
21
-- GNAT was originally developed  by the GNAT team at  New York University. --
22
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23
--                                                                          --
24
------------------------------------------------------------------------------
25
 
26
with Alloc;
27
with Debug;
28
with Fmap;     use Fmap;
29
with Gnatvsn;  use Gnatvsn;
30
with Hostparm;
31
with Opt;      use Opt;
32
with Output;   use Output;
33
with Sdefault; use Sdefault;
34
with Table;
35
with Targparm; use Targparm;
36
 
37
with Unchecked_Conversion;
38
 
39
pragma Warnings (Off);
40
--  This package is used also by gnatcoll
41
with System.Case_Util; use System.Case_Util;
42
pragma Warnings (On);
43
 
44
with GNAT.HTable;
45
 
46
package body Osint is
47
 
48
   Running_Program : Program_Type := Unspecified;
49
   --  comment required here ???
50
 
51
   Program_Set : Boolean := False;
52
   --  comment required here ???
53
 
54
   Std_Prefix : String_Ptr;
55
   --  Standard prefix, computed dynamically the first time Relocate_Path
56
   --  is called, and cached for subsequent calls.
57
 
58
   Empty  : aliased String := "";
59
   No_Dir : constant String_Ptr := Empty'Access;
60
   --  Used in Locate_File as a fake directory when Name is already an
61
   --  absolute path.
62
 
63
   -------------------------------------
64
   -- Use of Name_Find and Name_Enter --
65
   -------------------------------------
66
 
67
   --  This package creates a number of source, ALI and object file names
68
   --  that are used to locate the actual file and for the purpose of message
69
   --  construction. These names need not be accessible by Name_Find, and can
70
   --  be therefore created by using routine Name_Enter. The files in question
71
   --  are file names with a prefix directory (i.e., the files not in the
72
   --  current directory). File names without a prefix directory are entered
73
   --  with Name_Find because special values might be attached to the various
74
   --  Info fields of the corresponding name table entry.
75
 
76
   -----------------------
77
   -- Local Subprograms --
78
   -----------------------
79
 
80
   function Append_Suffix_To_File_Name
81
     (Name   : File_Name_Type;
82
      Suffix : String) return File_Name_Type;
83
   --  Appends Suffix to Name and returns the new name
84
 
85
   function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type;
86
   --  Convert OS format time to GNAT format time stamp. If T is Invalid_Time,
87
   --  then returns Empty_Time_Stamp.
88
 
89
   function Executable_Prefix return String_Ptr;
90
   --  Returns the name of the root directory where the executable is stored.
91
   --  The executable must be located in a directory called "bin", or under
92
   --  root/lib/gcc-lib/..., or under root/libexec/gcc/... For example, if
93
   --  executable is stored in directory "/foo/bar/bin", this routine returns
94
   --  "/foo/bar/". Return "" if location is not recognized as described above.
95
 
96
   function Update_Path (Path : String_Ptr) return String_Ptr;
97
   --  Update the specified path to replace the prefix with the location where
98
   --  GNAT is installed. See the file prefix.c in GCC for details.
99
 
100
   procedure Locate_File
101
     (N     : File_Name_Type;
102
      T     : File_Type;
103
      Dir   : Natural;
104
      Name  : String;
105
      Found : out File_Name_Type;
106
      Attr  : access File_Attributes);
107
   --  See if the file N whose name is Name exists in directory Dir. Dir is an
108
   --  index into the Lib_Search_Directories table if T = Library. Otherwise
109
   --  if T = Source, Dir is an index into the Src_Search_Directories table.
110
   --  Returns the File_Name_Type of the full file name if file found, or
111
   --  No_File if not found.
112
   --
113
   --  On exit, Found is set to the file that was found, and Attr to a cache of
114
   --  its attributes (at least those that have been computed so far). Reusing
115
   --  the cache will save some system calls.
116
   --
117
   --  Attr is always reset in this call to Unknown_Attributes, even in case of
118
   --  failure
119
 
120
   procedure Find_File
121
     (N     : File_Name_Type;
122
      T     : File_Type;
123
      Found : out File_Name_Type;
124
      Attr  : access File_Attributes);
125
   --  A version of Find_File that also returns a cache of the file attributes
126
   --  for later reuse
127
 
128
   procedure Smart_Find_File
129
     (N     : File_Name_Type;
130
      T     : File_Type;
131
      Found : out File_Name_Type;
132
      Attr  : out File_Attributes);
133
   --  A version of Smart_Find_File that also returns a cache of the file
134
   --  attributes for later reuse
135
 
136
   function C_String_Length (S : Address) return Integer;
137
   --  Returns length of a C string (zero for a null address)
138
 
139
   function To_Path_String_Access
140
     (Path_Addr : Address;
141
      Path_Len  : Integer) return String_Access;
142
   --  Converts a C String to an Ada String. Are we doing this to avoid withing
143
   --  Interfaces.C.Strings ???
144
   --  Caller must free result.
145
 
146
   function Include_Dir_Default_Prefix return String_Access;
147
   --  Same as exported version, except returns a String_Access
148
 
149
   ------------------------------
150
   -- Other Local Declarations --
151
   ------------------------------
152
 
153
   EOL : constant Character := ASCII.LF;
154
   --  End of line character
155
 
156
   Number_File_Names : Int := 0;
157
   --  Number of file names found on command line and placed in File_Names
158
 
159
   Look_In_Primary_Directory_For_Current_Main : Boolean := False;
160
   --  When this variable is True, Find_File only looks in Primary_Directory
161
   --  for the Current_Main file. This variable is always set to True for the
162
   --  compiler. It is also True for gnatmake, when the source name given on
163
   --  the command line has directory information.
164
 
165
   Current_Full_Source_Name  : File_Name_Type  := No_File;
166
   Current_Full_Source_Stamp : Time_Stamp_Type := Empty_Time_Stamp;
167
   Current_Full_Lib_Name     : File_Name_Type  := No_File;
168
   Current_Full_Lib_Stamp    : Time_Stamp_Type := Empty_Time_Stamp;
169
   Current_Full_Obj_Name     : File_Name_Type  := No_File;
170
   Current_Full_Obj_Stamp    : Time_Stamp_Type := Empty_Time_Stamp;
171
   --  Respectively full name (with directory info) and time stamp of the
172
   --  latest source, library and object files opened by Read_Source_File and
173
   --  Read_Library_Info.
174
 
175
   package File_Name_Chars is new Table.Table (
176
     Table_Component_Type => Character,
177
     Table_Index_Type     => Int,
178
     Table_Low_Bound      => 1,
179
     Table_Initial        => Alloc.File_Name_Chars_Initial,
180
     Table_Increment      => Alloc.File_Name_Chars_Increment,
181
     Table_Name           => "File_Name_Chars");
182
   --  Table to store text to be printed by Dump_Source_File_Names
183
 
184
   The_Include_Dir_Default_Prefix : String_Access := null;
185
   --  Value returned by Include_Dir_Default_Prefix. We don't initialize it
186
   --  here, because that causes an elaboration cycle with Sdefault; we
187
   --  initialize it lazily instead.
188
 
189
   ------------------
190
   -- Search Paths --
191
   ------------------
192
 
193
   Primary_Directory : constant := 0;
194
   --  This is index in the tables created below for the first directory to
195
   --  search in for source or library information files. This is the directory
196
   --  containing the latest main input file (a source file for the compiler or
197
   --  a library file for the binder).
198
 
199
   package Src_Search_Directories is new Table.Table (
200
     Table_Component_Type => String_Ptr,
201
     Table_Index_Type     => Integer,
202
     Table_Low_Bound      => Primary_Directory,
203
     Table_Initial        => 10,
204
     Table_Increment      => 100,
205
     Table_Name           => "Osint.Src_Search_Directories");
206
   --  Table of names of directories in which to search for source (Compiler)
207
   --  files. This table is filled in the order in which the directories are
208
   --  to be searched, and then used in that order.
209
 
210
   package Lib_Search_Directories is new Table.Table (
211
     Table_Component_Type => String_Ptr,
212
     Table_Index_Type     => Integer,
213
     Table_Low_Bound      => Primary_Directory,
214
     Table_Initial        => 10,
215
     Table_Increment      => 100,
216
     Table_Name           => "Osint.Lib_Search_Directories");
217
   --  Table of names of directories in which to search for library (Binder)
218
   --  files. This table is filled in the order in which the directories are
219
   --  to be searched and then used in that order. The reason for having two
220
   --  distinct tables is that we need them both in gnatmake.
221
 
222
   ---------------------
223
   -- File Hash Table --
224
   ---------------------
225
 
226
   --  The file hash table is provided to free the programmer from any
227
   --  efficiency concern when retrieving full file names or time stamps of
228
   --  source files. If the programmer calls Source_File_Data (Cache => True)
229
   --  he is guaranteed that the price to retrieve the full name (i.e. with
230
   --  directory info) or time stamp of the file will be payed only once, the
231
   --  first time the full name is actually searched (or the first time the
232
   --  time stamp is actually retrieved). This is achieved by employing a hash
233
   --  table that stores as a key the File_Name_Type of the file and associates
234
   --  to that File_Name_Type the full file name and time stamp of the file.
235
 
236
   File_Cache_Enabled : Boolean := False;
237
   --  Set to true if you want the enable the file data caching mechanism
238
 
239
   type File_Hash_Num is range 0 .. 1020;
240
 
241
   function File_Hash (F : File_Name_Type) return File_Hash_Num;
242
   --  Compute hash index for use by Simple_HTable
243
 
244
   type File_Info_Cache is record
245
      File : File_Name_Type;
246
      Attr : aliased File_Attributes;
247
   end record;
248
 
249
   No_File_Info_Cache : constant File_Info_Cache :=
250
                          (No_File, Unknown_Attributes);
251
 
252
   package File_Name_Hash_Table is new GNAT.HTable.Simple_HTable (
253
     Header_Num => File_Hash_Num,
254
     Element    => File_Info_Cache,
255
     No_Element => No_File_Info_Cache,
256
     Key        => File_Name_Type,
257
     Hash       => File_Hash,
258
     Equal      => "=");
259
 
260
   function Smart_Find_File
261
     (N : File_Name_Type;
262
      T : File_Type) return File_Name_Type;
263
   --  Exactly like Find_File except that if File_Cache_Enabled is True this
264
   --  routine looks first in the hash table to see if the full name of the
265
   --  file is already available.
266
 
267
   function Smart_File_Stamp
268
     (N : File_Name_Type;
269
      T : File_Type) return Time_Stamp_Type;
270
   --  Takes the same parameter as the routine above (N is a file name without
271
   --  any prefix directory information) and behaves like File_Stamp except
272
   --  that if File_Cache_Enabled is True this routine looks first in the hash
273
   --  table to see if the file stamp of the file is already available.
274
 
275
   -----------------------------
276
   -- Add_Default_Search_Dirs --
277
   -----------------------------
278
 
279
   procedure Add_Default_Search_Dirs is
280
      Search_Dir     : String_Access;
281
      Search_Path    : String_Access;
282
      Path_File_Name : String_Access;
283
 
284
      procedure Add_Search_Dir
285
        (Search_Dir            : String;
286
         Additional_Source_Dir : Boolean);
287
      procedure Add_Search_Dir
288
        (Search_Dir            : String_Access;
289
         Additional_Source_Dir : Boolean);
290
      --  Add a source search dir or a library search dir, depending on the
291
      --  value of Additional_Source_Dir.
292
 
293
      procedure Get_Dirs_From_File (Additional_Source_Dir : Boolean);
294
      --  Open a path file and read the directory to search, one per line
295
 
296
      function Get_Libraries_From_Registry return String_Ptr;
297
      --  On Windows systems, get the list of installed standard libraries
298
      --  from the registry key:
299
      --
300
      --  HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\
301
      --                             GNAT\Standard Libraries
302
      --  Return an empty string on other systems.
303
      --
304
      --  Note that this is an undocumented legacy feature, and that it
305
      --  works only when using the default runtime library (i.e. no --RTS=
306
      --  command line switch).
307
 
308
      --------------------
309
      -- Add_Search_Dir --
310
      --------------------
311
 
312
      procedure Add_Search_Dir
313
        (Search_Dir            : String;
314
         Additional_Source_Dir : Boolean)
315
      is
316
      begin
317
         if Additional_Source_Dir then
318
            Add_Src_Search_Dir (Search_Dir);
319
         else
320
            Add_Lib_Search_Dir (Search_Dir);
321
         end if;
322
      end Add_Search_Dir;
323
 
324
      procedure Add_Search_Dir
325
        (Search_Dir            : String_Access;
326
         Additional_Source_Dir : Boolean)
327
      is
328
      begin
329
         if Additional_Source_Dir then
330
            Add_Src_Search_Dir (Search_Dir.all);
331
         else
332
            Add_Lib_Search_Dir (Search_Dir.all);
333
         end if;
334
      end Add_Search_Dir;
335
 
336
      ------------------------
337
      -- Get_Dirs_From_File --
338
      ------------------------
339
 
340
      procedure Get_Dirs_From_File (Additional_Source_Dir : Boolean) is
341
         File_FD    : File_Descriptor;
342
         Buffer     : constant String := Path_File_Name.all & ASCII.NUL;
343
         Len        : Natural;
344
         Actual_Len : Natural;
345
         S          : String_Access;
346
         Curr       : Natural;
347
         First      : Natural;
348
         Ch         : Character;
349
 
350
         Status : Boolean;
351
         pragma Warnings (Off, Status);
352
         --  For the call to Close where status is ignored
353
 
354
      begin
355
         File_FD := Open_Read (Buffer'Address, Binary);
356
 
357
         --  If we cannot open the file, we ignore it, we don't fail
358
 
359
         if File_FD = Invalid_FD then
360
            return;
361
         end if;
362
 
363
         Len := Integer (File_Length (File_FD));
364
 
365
         S := new String (1 .. Len);
366
 
367
         --  Read the file. Note that the loop is not necessary since the
368
         --  whole file is read at once except on VMS.
369
 
370
         Curr := 1;
371
         Actual_Len := Len;
372
         while Curr <= Len and then Actual_Len /= 0 loop
373
            Actual_Len := Read (File_FD, S (Curr)'Address, Len);
374
            Curr := Curr + Actual_Len;
375
         end loop;
376
 
377
         --  We are done with the file, so we close it (ignore any error on
378
         --  the close, since we have successfully read the file).
379
 
380
         Close (File_FD, Status);
381
 
382
         --  Now, we read line by line
383
 
384
         First := 1;
385
         Curr := 0;
386
         while Curr < Len loop
387
            Ch := S (Curr + 1);
388
 
389
            if Ch = ASCII.CR or else Ch = ASCII.LF
390
              or else Ch = ASCII.FF or else Ch = ASCII.VT
391
            then
392
               if First <= Curr then
393
                  Add_Search_Dir (S (First .. Curr), Additional_Source_Dir);
394
               end if;
395
 
396
               First := Curr + 2;
397
            end if;
398
 
399
            Curr := Curr + 1;
400
         end loop;
401
 
402
         --  Last line is a special case, if the file does not end with
403
         --  an end of line mark.
404
 
405
         if First <= S'Last then
406
            Add_Search_Dir (S (First .. S'Last), Additional_Source_Dir);
407
         end if;
408
      end Get_Dirs_From_File;
409
 
410
      ---------------------------------
411
      -- Get_Libraries_From_Registry --
412
      ---------------------------------
413
 
414
      function Get_Libraries_From_Registry return String_Ptr is
415
         function C_Get_Libraries_From_Registry return Address;
416
         pragma Import (C, C_Get_Libraries_From_Registry,
417
                        "__gnat_get_libraries_from_registry");
418
 
419
         function Strlen (Str : Address) return Integer;
420
         pragma Import (C, Strlen, "strlen");
421
 
422
         procedure Strncpy (X : Address; Y : Address; Length : Integer);
423
         pragma Import (C, Strncpy, "strncpy");
424
 
425
         procedure C_Free (Str : Address);
426
         pragma Import (C, C_Free, "free");
427
 
428
         Result_Ptr    : Address;
429
         Result_Length : Integer;
430
         Out_String    : String_Ptr;
431
 
432
      begin
433
         Result_Ptr := C_Get_Libraries_From_Registry;
434
         Result_Length := Strlen (Result_Ptr);
435
 
436
         Out_String := new String (1 .. Result_Length);
437
         Strncpy (Out_String.all'Address, Result_Ptr, Result_Length);
438
 
439
         C_Free (Result_Ptr);
440
 
441
         return Out_String;
442
      end Get_Libraries_From_Registry;
443
 
444
   --  Start of processing for Add_Default_Search_Dirs
445
 
446
   begin
447
      --  After the locations specified on the command line, the next places
448
      --  to look for files are the directories specified by the appropriate
449
      --  environment variable. Get this value, extract the directory names
450
      --  and store in the tables.
451
 
452
      --  Check for eventual project path file env vars
453
 
454
      Path_File_Name := Getenv (Project_Include_Path_File);
455
 
456
      if Path_File_Name'Length > 0 then
457
         Get_Dirs_From_File (Additional_Source_Dir => True);
458
      end if;
459
 
460
      Path_File_Name := Getenv (Project_Objects_Path_File);
461
 
462
      if Path_File_Name'Length > 0 then
463
         Get_Dirs_From_File (Additional_Source_Dir => False);
464
      end if;
465
 
466
      --  On VMS, don't expand the logical name (e.g. environment variable),
467
      --  just put it into Unix (e.g. canonical) format. System services
468
      --  will handle the expansion as part of the file processing.
469
 
470
      for Additional_Source_Dir in False .. True loop
471
         if Additional_Source_Dir then
472
            Search_Path := Getenv (Ada_Include_Path);
473
 
474
            if Search_Path'Length > 0 then
475
               if Hostparm.OpenVMS then
476
                  Search_Path := To_Canonical_Path_Spec ("ADA_INCLUDE_PATH:");
477
               else
478
                  Search_Path := To_Canonical_Path_Spec (Search_Path.all);
479
               end if;
480
            end if;
481
 
482
         else
483
            Search_Path := Getenv (Ada_Objects_Path);
484
 
485
            if Search_Path'Length > 0 then
486
               if Hostparm.OpenVMS then
487
                  Search_Path := To_Canonical_Path_Spec ("ADA_OBJECTS_PATH:");
488
               else
489
                  Search_Path := To_Canonical_Path_Spec (Search_Path.all);
490
               end if;
491
            end if;
492
         end if;
493
 
494
         Get_Next_Dir_In_Path_Init (Search_Path);
495
         loop
496
            Search_Dir := Get_Next_Dir_In_Path (Search_Path);
497
            exit when Search_Dir = null;
498
            Add_Search_Dir (Search_Dir, Additional_Source_Dir);
499
         end loop;
500
      end loop;
501
 
502
      --  For the compiler, if --RTS= was specified, add the runtime
503
      --  directories.
504
 
505
      if RTS_Src_Path_Name /= null
506
        and then RTS_Lib_Path_Name /= null
507
      then
508
         Add_Search_Dirs (RTS_Src_Path_Name, Include);
509
         Add_Search_Dirs (RTS_Lib_Path_Name, Objects);
510
 
511
      else
512
         if not Opt.No_Stdinc then
513
 
514
            --  For WIN32 systems, look for any system libraries defined in
515
            --  the registry. These are added to both source and object
516
            --  directories.
517
 
518
            Search_Path := String_Access (Get_Libraries_From_Registry);
519
 
520
            Get_Next_Dir_In_Path_Init (Search_Path);
521
            loop
522
               Search_Dir := Get_Next_Dir_In_Path (Search_Path);
523
               exit when Search_Dir = null;
524
               Add_Search_Dir (Search_Dir, False);
525
               Add_Search_Dir (Search_Dir, True);
526
            end loop;
527
 
528
            --  The last place to look are the defaults
529
 
530
            Search_Path :=
531
              Read_Default_Search_Dirs
532
                (String_Access (Update_Path (Search_Dir_Prefix)),
533
                 Include_Search_File,
534
                 String_Access (Update_Path (Include_Dir_Default_Name)));
535
 
536
            Get_Next_Dir_In_Path_Init (Search_Path);
537
            loop
538
               Search_Dir := Get_Next_Dir_In_Path (Search_Path);
539
               exit when Search_Dir = null;
540
               Add_Search_Dir (Search_Dir, True);
541
            end loop;
542
         end if;
543
 
544
         --  Even when -nostdlib is used, we still want to have visibility on
545
         --  the run-time object directory, as it is used by gnatbind to find
546
         --  the run-time ALI files in "real" ZFP set up.
547
 
548
         if not Opt.RTS_Switch then
549
            Search_Path :=
550
              Read_Default_Search_Dirs
551
                (String_Access (Update_Path (Search_Dir_Prefix)),
552
                 Objects_Search_File,
553
                 String_Access (Update_Path (Object_Dir_Default_Name)));
554
 
555
            Get_Next_Dir_In_Path_Init (Search_Path);
556
            loop
557
               Search_Dir := Get_Next_Dir_In_Path (Search_Path);
558
               exit when Search_Dir = null;
559
               Add_Search_Dir (Search_Dir, False);
560
            end loop;
561
         end if;
562
      end if;
563
   end Add_Default_Search_Dirs;
564
 
565
   --------------
566
   -- Add_File --
567
   --------------
568
 
569
   procedure Add_File (File_Name : String; Index : Int := No_Index) is
570
   begin
571
      Number_File_Names := Number_File_Names + 1;
572
 
573
      --  As Add_File may be called for mains specified inside a project file,
574
      --  File_Names may be too short and needs to be extended.
575
 
576
      if Number_File_Names > File_Names'Last then
577
         File_Names := new File_Name_Array'(File_Names.all & File_Names.all);
578
         File_Indexes :=
579
           new File_Index_Array'(File_Indexes.all & File_Indexes.all);
580
      end if;
581
 
582
      File_Names   (Number_File_Names) := new String'(File_Name);
583
      File_Indexes (Number_File_Names) := Index;
584
   end Add_File;
585
 
586
   ------------------------
587
   -- Add_Lib_Search_Dir --
588
   ------------------------
589
 
590
   procedure Add_Lib_Search_Dir (Dir : String) is
591
   begin
592
      if Dir'Length = 0 then
593
         Fail ("missing library directory name");
594
      end if;
595
 
596
      declare
597
         Norm : String_Ptr := Normalize_Directory_Name (Dir);
598
 
599
      begin
600
         --  Do nothing if the directory is already in the list. This saves
601
         --  system calls and avoid unneeded work
602
 
603
         for D in Lib_Search_Directories.First ..
604
                  Lib_Search_Directories.Last
605
         loop
606
            if Lib_Search_Directories.Table (D).all = Norm.all then
607
               Free (Norm);
608
               return;
609
            end if;
610
         end loop;
611
 
612
         Lib_Search_Directories.Increment_Last;
613
         Lib_Search_Directories.Table (Lib_Search_Directories.Last) := Norm;
614
      end;
615
   end Add_Lib_Search_Dir;
616
 
617
   ---------------------
618
   -- Add_Search_Dirs --
619
   ---------------------
620
 
621
   procedure Add_Search_Dirs
622
     (Search_Path : String_Ptr;
623
      Path_Type   : Search_File_Type)
624
   is
625
      Current_Search_Path : String_Access;
626
 
627
   begin
628
      Get_Next_Dir_In_Path_Init (String_Access (Search_Path));
629
      loop
630
         Current_Search_Path :=
631
           Get_Next_Dir_In_Path (String_Access (Search_Path));
632
         exit when Current_Search_Path = null;
633
 
634
         if Path_Type = Include then
635
            Add_Src_Search_Dir (Current_Search_Path.all);
636
         else
637
            Add_Lib_Search_Dir (Current_Search_Path.all);
638
         end if;
639
      end loop;
640
   end Add_Search_Dirs;
641
 
642
   ------------------------
643
   -- Add_Src_Search_Dir --
644
   ------------------------
645
 
646
   procedure Add_Src_Search_Dir (Dir : String) is
647
   begin
648
      if Dir'Length = 0 then
649
         Fail ("missing source directory name");
650
      end if;
651
 
652
      Src_Search_Directories.Increment_Last;
653
      Src_Search_Directories.Table (Src_Search_Directories.Last) :=
654
        Normalize_Directory_Name (Dir);
655
   end Add_Src_Search_Dir;
656
 
657
   --------------------------------
658
   -- Append_Suffix_To_File_Name --
659
   --------------------------------
660
 
661
   function Append_Suffix_To_File_Name
662
     (Name   : File_Name_Type;
663
      Suffix : String) return File_Name_Type
664
   is
665
   begin
666
      Get_Name_String (Name);
667
      Name_Buffer (Name_Len + 1 .. Name_Len + Suffix'Length) := Suffix;
668
      Name_Len := Name_Len + Suffix'Length;
669
      return Name_Find;
670
   end Append_Suffix_To_File_Name;
671
 
672
   ---------------------
673
   -- C_String_Length --
674
   ---------------------
675
 
676
   function C_String_Length (S : Address) return Integer is
677
      function Strlen (S : Address) return Integer;
678
      pragma Import (C, Strlen, "strlen");
679
   begin
680
      if S = Null_Address then
681
         return 0;
682
      else
683
         return Strlen (S);
684
      end if;
685
   end C_String_Length;
686
 
687
   ------------------------------
688
   -- Canonical_Case_File_Name --
689
   ------------------------------
690
 
691
   procedure Canonical_Case_File_Name (S : in out String) is
692
   begin
693
      if not File_Names_Case_Sensitive then
694
         To_Lower (S);
695
      end if;
696
   end Canonical_Case_File_Name;
697
 
698
   ---------------------------------
699
   -- Canonical_Case_Env_Var_Name --
700
   ---------------------------------
701
 
702
   procedure Canonical_Case_Env_Var_Name (S : in out String) is
703
   begin
704
      if not Env_Vars_Case_Sensitive then
705
         To_Lower (S);
706
      end if;
707
   end Canonical_Case_Env_Var_Name;
708
 
709
   ---------------------------
710
   -- Create_File_And_Check --
711
   ---------------------------
712
 
713
   procedure Create_File_And_Check
714
     (Fdesc : out File_Descriptor;
715
      Fmode : Mode)
716
   is
717
   begin
718
      Output_File_Name := Name_Enter;
719
      Fdesc := Create_File (Name_Buffer'Address, Fmode);
720
 
721
      if Fdesc = Invalid_FD then
722
         Fail ("Cannot create: " & Name_Buffer (1 .. Name_Len));
723
      end if;
724
   end Create_File_And_Check;
725
 
726
   ------------------------
727
   -- Current_File_Index --
728
   ------------------------
729
 
730
   function Current_File_Index return Int is
731
   begin
732
      return File_Indexes (Current_File_Name_Index);
733
   end Current_File_Index;
734
 
735
   --------------------------------
736
   -- Current_Library_File_Stamp --
737
   --------------------------------
738
 
739
   function Current_Library_File_Stamp return Time_Stamp_Type is
740
   begin
741
      return Current_Full_Lib_Stamp;
742
   end Current_Library_File_Stamp;
743
 
744
   -------------------------------
745
   -- Current_Object_File_Stamp --
746
   -------------------------------
747
 
748
   function Current_Object_File_Stamp return Time_Stamp_Type is
749
   begin
750
      return Current_Full_Obj_Stamp;
751
   end Current_Object_File_Stamp;
752
 
753
   -------------------------------
754
   -- Current_Source_File_Stamp --
755
   -------------------------------
756
 
757
   function Current_Source_File_Stamp return Time_Stamp_Type is
758
   begin
759
      return Current_Full_Source_Stamp;
760
   end Current_Source_File_Stamp;
761
 
762
   ----------------------------
763
   -- Dir_In_Obj_Search_Path --
764
   ----------------------------
765
 
766
   function Dir_In_Obj_Search_Path (Position : Natural) return String_Ptr is
767
   begin
768
      if Opt.Look_In_Primary_Dir then
769
         return
770
           Lib_Search_Directories.Table (Primary_Directory + Position - 1);
771
      else
772
         return Lib_Search_Directories.Table (Primary_Directory + Position);
773
      end if;
774
   end Dir_In_Obj_Search_Path;
775
 
776
   ----------------------------
777
   -- Dir_In_Src_Search_Path --
778
   ----------------------------
779
 
780
   function Dir_In_Src_Search_Path (Position : Natural) return String_Ptr is
781
   begin
782
      if Opt.Look_In_Primary_Dir then
783
         return
784
           Src_Search_Directories.Table (Primary_Directory + Position - 1);
785
      else
786
         return Src_Search_Directories.Table (Primary_Directory + Position);
787
      end if;
788
   end Dir_In_Src_Search_Path;
789
 
790
   ----------------------------
791
   -- Dump_Source_File_Names --
792
   ----------------------------
793
 
794
   procedure Dump_Source_File_Names is
795
      subtype Rng is Int range File_Name_Chars.First .. File_Name_Chars.Last;
796
   begin
797
      Write_Str (String (File_Name_Chars.Table (Rng)));
798
   end Dump_Source_File_Names;
799
 
800
   ---------------------
801
   -- Executable_Name --
802
   ---------------------
803
 
804
   function Executable_Name
805
     (Name              : File_Name_Type;
806
      Only_If_No_Suffix : Boolean := False) return File_Name_Type
807
   is
808
      Exec_Suffix : String_Access;
809
      Add_Suffix  : Boolean;
810
 
811
   begin
812
      if Name = No_File then
813
         return No_File;
814
      end if;
815
 
816
      if Executable_Extension_On_Target = No_Name then
817
         Exec_Suffix := Get_Target_Executable_Suffix;
818
      else
819
         Get_Name_String (Executable_Extension_On_Target);
820
         Exec_Suffix := new String'(Name_Buffer (1 .. Name_Len));
821
      end if;
822
 
823
      if Exec_Suffix'Length /= 0 then
824
         Get_Name_String (Name);
825
 
826
         Add_Suffix := True;
827
         if Only_If_No_Suffix then
828
            for J in reverse 1 .. Name_Len loop
829
               if Name_Buffer (J) = '.' then
830
                  Add_Suffix := False;
831
                  exit;
832
 
833
               elsif Name_Buffer (J) = '/' or else
834
                     Name_Buffer (J) = Directory_Separator
835
               then
836
                  exit;
837
               end if;
838
            end loop;
839
         end if;
840
 
841
         if Add_Suffix then
842
            declare
843
               Buffer : String := Name_Buffer (1 .. Name_Len);
844
 
845
            begin
846
               --  Get the file name in canonical case to accept as is names
847
               --  ending with ".EXE" on VMS and Windows.
848
 
849
               Canonical_Case_File_Name (Buffer);
850
 
851
               --  If Executable does not end with the executable suffix, add
852
               --  it.
853
 
854
               if Buffer'Length <= Exec_Suffix'Length
855
                 or else
856
                   Buffer (Buffer'Last - Exec_Suffix'Length + 1 .. Buffer'Last)
857
                     /= Exec_Suffix.all
858
               then
859
                  Name_Buffer
860
                    (Name_Len + 1 .. Name_Len + Exec_Suffix'Length) :=
861
                      Exec_Suffix.all;
862
                  Name_Len := Name_Len + Exec_Suffix'Length;
863
                  Free (Exec_Suffix);
864
                  return Name_Find;
865
               end if;
866
            end;
867
         end if;
868
      end if;
869
 
870
      Free (Exec_Suffix);
871
      return Name;
872
   end Executable_Name;
873
 
874
   function Executable_Name
875
     (Name              : String;
876
      Only_If_No_Suffix : Boolean := False) return String
877
   is
878
      Exec_Suffix    : String_Access;
879
      Add_Suffix     : Boolean;
880
      Canonical_Name : String := Name;
881
 
882
   begin
883
      if Executable_Extension_On_Target = No_Name then
884
         Exec_Suffix := Get_Target_Executable_Suffix;
885
      else
886
         Get_Name_String (Executable_Extension_On_Target);
887
         Exec_Suffix := new String'(Name_Buffer (1 .. Name_Len));
888
      end if;
889
 
890
      if Exec_Suffix'Length = 0 then
891
         Free (Exec_Suffix);
892
         return Name;
893
 
894
      else
895
         declare
896
            Suffix : constant String := Exec_Suffix.all;
897
 
898
         begin
899
            Free (Exec_Suffix);
900
            Canonical_Case_File_Name (Canonical_Name);
901
 
902
            Add_Suffix := True;
903
            if Only_If_No_Suffix then
904
               for J in reverse Canonical_Name'Range loop
905
                  if Canonical_Name (J) = '.' then
906
                     Add_Suffix := False;
907
                     exit;
908
 
909
                  elsif Canonical_Name (J) = '/' or else
910
                        Canonical_Name (J) = Directory_Separator
911
                  then
912
                     exit;
913
                  end if;
914
               end loop;
915
            end if;
916
 
917
            if Add_Suffix and then
918
              (Canonical_Name'Length <= Suffix'Length
919
               or else Canonical_Name (Canonical_Name'Last - Suffix'Length + 1
920
                                       .. Canonical_Name'Last) /= Suffix)
921
            then
922
               declare
923
                  Result : String (1 .. Name'Length + Suffix'Length);
924
               begin
925
                  Result (1 .. Name'Length) := Name;
926
                  Result (Name'Length + 1 .. Result'Last) := Suffix;
927
                  return Result;
928
               end;
929
            else
930
               return Name;
931
            end if;
932
         end;
933
      end if;
934
   end Executable_Name;
935
 
936
   -----------------------
937
   -- Executable_Prefix --
938
   -----------------------
939
 
940
   function Executable_Prefix return String_Ptr is
941
 
942
      function Get_Install_Dir (Exec : String) return String_Ptr;
943
      --  S is the executable name preceded by the absolute or relative
944
      --  path, e.g. "c:\usr\bin\gcc.exe" or "..\bin\gcc".
945
 
946
      ---------------------
947
      -- Get_Install_Dir --
948
      ---------------------
949
 
950
      function Get_Install_Dir (Exec : String) return String_Ptr is
951
         Full_Path : constant String := Normalize_Pathname (Exec);
952
         --  Use the full path, so that we find "lib" or "bin", even when
953
         --  the tool has been invoked with a relative path, as in
954
         --  "./gnatls -v" invoked in the GNAT bin directory.
955
 
956
      begin
957
         for J in reverse Full_Path'Range loop
958
            if Is_Directory_Separator (Full_Path (J)) then
959
               if J < Full_Path'Last - 5 then
960
                  if (To_Lower (Full_Path (J + 1)) = 'l'
961
                      and then To_Lower (Full_Path (J + 2)) = 'i'
962
                      and then To_Lower (Full_Path (J + 3)) = 'b')
963
                    or else
964
                      (To_Lower (Full_Path (J + 1)) = 'b'
965
                       and then To_Lower (Full_Path (J + 2)) = 'i'
966
                       and then To_Lower (Full_Path (J + 3)) = 'n')
967
                  then
968
                     return new String'(Full_Path (Full_Path'First .. J));
969
                  end if;
970
               end if;
971
            end if;
972
         end loop;
973
 
974
         return new String'("");
975
      end Get_Install_Dir;
976
 
977
   --  Start of processing for Executable_Prefix
978
 
979
   begin
980
      if Exec_Name = null then
981
         Exec_Name := new String (1 .. Len_Arg (0));
982
         Osint.Fill_Arg (Exec_Name (1)'Address, 0);
983
      end if;
984
 
985
      --  First determine if a path prefix was placed in front of the
986
      --  executable name.
987
 
988
      for J in reverse Exec_Name'Range loop
989
         if Is_Directory_Separator (Exec_Name (J)) then
990
            return Get_Install_Dir (Exec_Name.all);
991
         end if;
992
      end loop;
993
 
994
      --  If we come here, the user has typed the executable name with no
995
      --  directory prefix.
996
 
997
      return Get_Install_Dir (Locate_Exec_On_Path (Exec_Name.all).all);
998
   end Executable_Prefix;
999
 
1000
   ------------------
1001
   -- Exit_Program --
1002
   ------------------
1003
 
1004
   procedure Exit_Program (Exit_Code : Exit_Code_Type) is
1005
   begin
1006
      --  The program will exit with the following status:
1007
 
1008
      --    0 if the object file has been generated (with or without warnings)
1009
      --    1 if recompilation was not needed (smart recompilation)
1010
      --    2 if gnat1 has been killed by a signal (detected by GCC)
1011
      --    4 for a fatal error
1012
      --    5 if there were errors
1013
      --    6 if no code has been generated (spec)
1014
 
1015
      --  Note that exit code 3 is not used and must not be used as this is
1016
      --  the code returned by a program aborted via C abort() routine on
1017
      --  Windows. GCC checks for that case and thinks that the child process
1018
      --  has been aborted. This code (exit code 3) used to be the code used
1019
      --  for E_No_Code, but E_No_Code was changed to 6 for this reason.
1020
 
1021
      case Exit_Code is
1022
         when E_Success    => OS_Exit (0);
1023
         when E_Warnings   => OS_Exit (0);
1024
         when E_No_Compile => OS_Exit (1);
1025
         when E_Fatal      => OS_Exit (4);
1026
         when E_Errors     => OS_Exit (5);
1027
         when E_No_Code    => OS_Exit (6);
1028
         when E_Abort      => OS_Abort;
1029
      end case;
1030
   end Exit_Program;
1031
 
1032
   ----------
1033
   -- Fail --
1034
   ----------
1035
 
1036
   procedure Fail (S : String) is
1037
   begin
1038
      --  We use Output in case there is a special output set up.
1039
      --  In this case Set_Standard_Error will have no immediate effect.
1040
 
1041
      Set_Standard_Error;
1042
      Osint.Write_Program_Name;
1043
      Write_Str (": ");
1044
      Write_Str (S);
1045
      Write_Eol;
1046
 
1047
      Exit_Program (E_Fatal);
1048
   end Fail;
1049
 
1050
   ---------------
1051
   -- File_Hash --
1052
   ---------------
1053
 
1054
   function File_Hash (F : File_Name_Type) return File_Hash_Num is
1055
   begin
1056
      return File_Hash_Num (Int (F) rem File_Hash_Num'Range_Length);
1057
   end File_Hash;
1058
 
1059
   -----------------
1060
   -- File_Length --
1061
   -----------------
1062
 
1063
   function File_Length
1064
     (Name : C_File_Name;
1065
      Attr : access File_Attributes) return Long_Integer
1066
   is
1067
      function Internal
1068
        (F : Integer;
1069
         N : C_File_Name;
1070
         A : System.Address) return Long_Integer;
1071
      pragma Import (C, Internal, "__gnat_file_length_attr");
1072
   begin
1073
      return Internal (-1, Name, Attr.all'Address);
1074
   end File_Length;
1075
 
1076
   ---------------------
1077
   -- File_Time_Stamp --
1078
   ---------------------
1079
 
1080
   function File_Time_Stamp
1081
     (Name : C_File_Name;
1082
      Attr : access File_Attributes) return OS_Time
1083
   is
1084
      function Internal (N : C_File_Name; A : System.Address) return OS_Time;
1085
      pragma Import (C, Internal, "__gnat_file_time_name_attr");
1086
   begin
1087
      return Internal (Name, Attr.all'Address);
1088
   end File_Time_Stamp;
1089
 
1090
   function File_Time_Stamp
1091
     (Name : Path_Name_Type;
1092
      Attr : access File_Attributes) return Time_Stamp_Type
1093
   is
1094
   begin
1095
      if Name = No_Path then
1096
         return Empty_Time_Stamp;
1097
      end if;
1098
 
1099
      Get_Name_String (Name);
1100
      Name_Buffer (Name_Len + 1) := ASCII.NUL;
1101
      return OS_Time_To_GNAT_Time
1102
               (File_Time_Stamp (Name_Buffer'Address, Attr));
1103
   end File_Time_Stamp;
1104
 
1105
   ----------------
1106
   -- File_Stamp --
1107
   ----------------
1108
 
1109
   function File_Stamp (Name : File_Name_Type) return Time_Stamp_Type is
1110
   begin
1111
      if Name = No_File then
1112
         return Empty_Time_Stamp;
1113
      end if;
1114
 
1115
      Get_Name_String (Name);
1116
 
1117
      --  File_Time_Stamp will always return Invalid_Time if the file does
1118
      --  not exist, and OS_Time_To_GNAT_Time will convert this value to
1119
      --  Empty_Time_Stamp. Therefore we do not need to first test whether
1120
      --  the file actually exists, which saves a system call.
1121
 
1122
      return OS_Time_To_GNAT_Time
1123
               (File_Time_Stamp (Name_Buffer (1 .. Name_Len)));
1124
   end File_Stamp;
1125
 
1126
   function File_Stamp (Name : Path_Name_Type) return Time_Stamp_Type is
1127
   begin
1128
      return File_Stamp (File_Name_Type (Name));
1129
   end File_Stamp;
1130
 
1131
   ---------------
1132
   -- Find_File --
1133
   ---------------
1134
 
1135
   function Find_File
1136
     (N : File_Name_Type;
1137
      T : File_Type) return File_Name_Type
1138
   is
1139
      Attr  : aliased File_Attributes;
1140
      Found : File_Name_Type;
1141
   begin
1142
      Find_File (N, T, Found, Attr'Access);
1143
      return Found;
1144
   end Find_File;
1145
 
1146
   ---------------
1147
   -- Find_File --
1148
   ---------------
1149
 
1150
   procedure Find_File
1151
     (N     : File_Name_Type;
1152
      T     : File_Type;
1153
      Found : out File_Name_Type;
1154
      Attr  : access File_Attributes) is
1155
   begin
1156
      Get_Name_String (N);
1157
 
1158
      declare
1159
         File_Name : String renames Name_Buffer (1 .. Name_Len);
1160
         File      : File_Name_Type := No_File;
1161
         Last_Dir  : Natural;
1162
 
1163
      begin
1164
         --  If we are looking for a config file, look only in the current
1165
         --  directory, i.e. return input argument unchanged. Also look only in
1166
         --  the current directory if we are looking for a .dg file (happens in
1167
         --  -gnatD mode).
1168
 
1169
         if T = Config
1170
           or else (Debug_Generated_Code
1171
                      and then Name_Len > 3
1172
                      and then
1173
                      (Name_Buffer (Name_Len - 2 .. Name_Len) = ".dg"
1174
                       or else
1175
                       (Hostparm.OpenVMS and then
1176
                        Name_Buffer (Name_Len - 2 .. Name_Len) = "_dg")))
1177
         then
1178
            Found := N;
1179
            Attr.all  := Unknown_Attributes;
1180
            return;
1181
 
1182
         --  If we are trying to find the current main file just look in the
1183
         --  directory where the user said it was.
1184
 
1185
         elsif Look_In_Primary_Directory_For_Current_Main
1186
           and then Current_Main = N
1187
         then
1188
            Locate_File (N, T, Primary_Directory, File_Name, Found, Attr);
1189
            return;
1190
 
1191
         --  Otherwise do standard search for source file
1192
 
1193
         else
1194
            --  Check the mapping of this file name
1195
 
1196
            File := Mapped_Path_Name (N);
1197
 
1198
            --  If the file name is mapped to a path name, return the
1199
            --  corresponding path name
1200
 
1201
            if File /= No_File then
1202
 
1203
               --  For locally removed file, Error_Name is returned; then
1204
               --  return No_File, indicating the file is not a source.
1205
 
1206
               if File = Error_File_Name then
1207
                  Found := No_File;
1208
               else
1209
                  Found := File;
1210
               end if;
1211
 
1212
               Attr.all := Unknown_Attributes;
1213
               return;
1214
            end if;
1215
 
1216
            --  First place to look is in the primary directory (i.e. the same
1217
            --  directory as the source) unless this has been disabled with -I-
1218
 
1219
            if Opt.Look_In_Primary_Dir then
1220
               Locate_File (N, T, Primary_Directory, File_Name, Found, Attr);
1221
 
1222
               if Found /= No_File then
1223
                  return;
1224
               end if;
1225
            end if;
1226
 
1227
            --  Finally look in directories specified with switches -I/-aI/-aO
1228
 
1229
            if T = Library then
1230
               Last_Dir := Lib_Search_Directories.Last;
1231
            else
1232
               Last_Dir := Src_Search_Directories.Last;
1233
            end if;
1234
 
1235
            for D in Primary_Directory + 1 .. Last_Dir loop
1236
               Locate_File (N, T, D, File_Name, Found, Attr);
1237
 
1238
               if Found /= No_File then
1239
                  return;
1240
               end if;
1241
            end loop;
1242
 
1243
            Attr.all := Unknown_Attributes;
1244
            Found := No_File;
1245
         end if;
1246
      end;
1247
   end Find_File;
1248
 
1249
   -----------------------
1250
   -- Find_Program_Name --
1251
   -----------------------
1252
 
1253
   procedure Find_Program_Name is
1254
      Command_Name : String (1 .. Len_Arg (0));
1255
      Cindex1      : Integer := Command_Name'First;
1256
      Cindex2      : Integer := Command_Name'Last;
1257
 
1258
   begin
1259
      Fill_Arg (Command_Name'Address, 0);
1260
 
1261
      if Command_Name = "" then
1262
         Name_Len := 0;
1263
         return;
1264
      end if;
1265
 
1266
      --  The program name might be specified by a full path name. However,
1267
      --  we don't want to print that all out in an error message, so the
1268
      --  path might need to be stripped away.
1269
 
1270
      for J in reverse Cindex1 .. Cindex2 loop
1271
         if Is_Directory_Separator (Command_Name (J)) then
1272
            Cindex1 := J + 1;
1273
            exit;
1274
         end if;
1275
      end loop;
1276
 
1277
      --  Command_Name(Cindex1 .. Cindex2) is now the equivalent of the
1278
      --  POSIX command "basename argv[0]"
1279
 
1280
      --  Strip off any versioning information such as found on VMS.
1281
      --  This would take the form of TOOL.exe followed by a ";" or "."
1282
      --  and a sequence of one or more numbers.
1283
 
1284
      if Command_Name (Cindex2) in '0' .. '9' then
1285
         for J in reverse Cindex1 .. Cindex2 loop
1286
            if Command_Name (J) = '.' or else Command_Name (J) = ';' then
1287
               Cindex2 := J - 1;
1288
               exit;
1289
            end if;
1290
 
1291
            exit when Command_Name (J) not in '0' .. '9';
1292
         end loop;
1293
      end if;
1294
 
1295
      --  Strip off any executable extension (usually nothing or .exe)
1296
      --  but formally reported by autoconf in the variable EXEEXT
1297
 
1298
      if Cindex2 - Cindex1 >= 4 then
1299
         if To_Lower (Command_Name (Cindex2 - 3)) = '.'
1300
            and then To_Lower (Command_Name (Cindex2 - 2)) = 'e'
1301
            and then To_Lower (Command_Name (Cindex2 - 1)) = 'x'
1302
            and then To_Lower (Command_Name (Cindex2)) = 'e'
1303
         then
1304
            Cindex2 := Cindex2 - 4;
1305
         end if;
1306
      end if;
1307
 
1308
      Name_Len := Cindex2 - Cindex1 + 1;
1309
      Name_Buffer (1 .. Name_Len) := Command_Name (Cindex1 .. Cindex2);
1310
   end Find_Program_Name;
1311
 
1312
   ------------------------
1313
   -- Full_Lib_File_Name --
1314
   ------------------------
1315
 
1316
   procedure Full_Lib_File_Name
1317
     (N        : File_Name_Type;
1318
      Lib_File : out File_Name_Type;
1319
      Attr     : out File_Attributes)
1320
   is
1321
      A : aliased File_Attributes;
1322
   begin
1323
      --  ??? seems we could use Smart_Find_File here
1324
      Find_File (N, Library, Lib_File, A'Access);
1325
      Attr := A;
1326
   end Full_Lib_File_Name;
1327
 
1328
   ------------------------
1329
   -- Full_Lib_File_Name --
1330
   ------------------------
1331
 
1332
   function Full_Lib_File_Name (N : File_Name_Type) return File_Name_Type is
1333
      Attr : File_Attributes;
1334
      File : File_Name_Type;
1335
   begin
1336
      Full_Lib_File_Name (N, File, Attr);
1337
      return File;
1338
   end Full_Lib_File_Name;
1339
 
1340
   ----------------------------
1341
   -- Full_Library_Info_Name --
1342
   ----------------------------
1343
 
1344
   function Full_Library_Info_Name return File_Name_Type is
1345
   begin
1346
      return Current_Full_Lib_Name;
1347
   end Full_Library_Info_Name;
1348
 
1349
   ---------------------------
1350
   -- Full_Object_File_Name --
1351
   ---------------------------
1352
 
1353
   function Full_Object_File_Name return File_Name_Type is
1354
   begin
1355
      return Current_Full_Obj_Name;
1356
   end Full_Object_File_Name;
1357
 
1358
   ----------------------
1359
   -- Full_Source_Name --
1360
   ----------------------
1361
 
1362
   function Full_Source_Name return File_Name_Type is
1363
   begin
1364
      return Current_Full_Source_Name;
1365
   end Full_Source_Name;
1366
 
1367
   ----------------------
1368
   -- Full_Source_Name --
1369
   ----------------------
1370
 
1371
   function Full_Source_Name (N : File_Name_Type) return File_Name_Type is
1372
   begin
1373
      return Smart_Find_File (N, Source);
1374
   end Full_Source_Name;
1375
 
1376
   ----------------------
1377
   -- Full_Source_Name --
1378
   ----------------------
1379
 
1380
   procedure Full_Source_Name
1381
     (N         : File_Name_Type;
1382
      Full_File : out File_Name_Type;
1383
      Attr      : access File_Attributes) is
1384
   begin
1385
      Smart_Find_File (N, Source, Full_File, Attr.all);
1386
   end Full_Source_Name;
1387
 
1388
   -------------------
1389
   -- Get_Directory --
1390
   -------------------
1391
 
1392
   function Get_Directory (Name : File_Name_Type) return File_Name_Type is
1393
   begin
1394
      Get_Name_String (Name);
1395
 
1396
      for J in reverse 1 .. Name_Len loop
1397
         if Is_Directory_Separator (Name_Buffer (J)) then
1398
            Name_Len := J;
1399
            return Name_Find;
1400
         end if;
1401
      end loop;
1402
 
1403
      Name_Len := Hostparm.Normalized_CWD'Length;
1404
      Name_Buffer (1 .. Name_Len) := Hostparm.Normalized_CWD;
1405
      return Name_Find;
1406
   end Get_Directory;
1407
 
1408
   --------------------------
1409
   -- Get_Next_Dir_In_Path --
1410
   --------------------------
1411
 
1412
   Search_Path_Pos : Integer;
1413
   --  Keeps track of current position in search path. Initialized by the
1414
   --  call to Get_Next_Dir_In_Path_Init, updated by Get_Next_Dir_In_Path.
1415
 
1416
   function Get_Next_Dir_In_Path
1417
     (Search_Path : String_Access) return String_Access
1418
   is
1419
      Lower_Bound : Positive := Search_Path_Pos;
1420
      Upper_Bound : Positive;
1421
 
1422
   begin
1423
      loop
1424
         while Lower_Bound <= Search_Path'Last
1425
           and then Search_Path.all (Lower_Bound) = Path_Separator
1426
         loop
1427
            Lower_Bound := Lower_Bound + 1;
1428
         end loop;
1429
 
1430
         exit when Lower_Bound > Search_Path'Last;
1431
 
1432
         Upper_Bound := Lower_Bound;
1433
         while Upper_Bound <= Search_Path'Last
1434
           and then Search_Path.all (Upper_Bound) /= Path_Separator
1435
         loop
1436
            Upper_Bound := Upper_Bound + 1;
1437
         end loop;
1438
 
1439
         Search_Path_Pos := Upper_Bound;
1440
         return new String'(Search_Path.all (Lower_Bound .. Upper_Bound - 1));
1441
      end loop;
1442
 
1443
      return null;
1444
   end Get_Next_Dir_In_Path;
1445
 
1446
   -------------------------------
1447
   -- Get_Next_Dir_In_Path_Init --
1448
   -------------------------------
1449
 
1450
   procedure Get_Next_Dir_In_Path_Init (Search_Path : String_Access) is
1451
   begin
1452
      Search_Path_Pos := Search_Path'First;
1453
   end Get_Next_Dir_In_Path_Init;
1454
 
1455
   --------------------------------------
1456
   -- Get_Primary_Src_Search_Directory --
1457
   --------------------------------------
1458
 
1459
   function Get_Primary_Src_Search_Directory return String_Ptr is
1460
   begin
1461
      return Src_Search_Directories.Table (Primary_Directory);
1462
   end Get_Primary_Src_Search_Directory;
1463
 
1464
   ------------------------
1465
   -- Get_RTS_Search_Dir --
1466
   ------------------------
1467
 
1468
   function Get_RTS_Search_Dir
1469
     (Search_Dir : String;
1470
      File_Type  : Search_File_Type) return String_Ptr
1471
   is
1472
      procedure Get_Current_Dir
1473
        (Dir    : System.Address;
1474
         Length : System.Address);
1475
      pragma Import (C, Get_Current_Dir, "__gnat_get_current_dir");
1476
 
1477
      Max_Path : Integer;
1478
      pragma Import (C, Max_Path, "__gnat_max_path_len");
1479
      --  Maximum length of a path name
1480
 
1481
      Current_Dir        : String_Ptr;
1482
      Default_Search_Dir : String_Access;
1483
      Default_Suffix_Dir : String_Access;
1484
      Local_Search_Dir   : String_Access;
1485
      Norm_Search_Dir    : String_Access;
1486
      Result_Search_Dir  : String_Access;
1487
      Search_File        : String_Access;
1488
      Temp_String        : String_Ptr;
1489
 
1490
   begin
1491
      --  Add a directory separator at the end of the directory if necessary
1492
      --  so that we can directly append a file to the directory
1493
 
1494
      if Search_Dir (Search_Dir'Last) /= Directory_Separator then
1495
         Local_Search_Dir :=
1496
           new String'(Search_Dir & String'(1 => Directory_Separator));
1497
      else
1498
         Local_Search_Dir := new String'(Search_Dir);
1499
      end if;
1500
 
1501
      if File_Type = Include then
1502
         Search_File := Include_Search_File;
1503
         Default_Suffix_Dir := new String'("adainclude");
1504
      else
1505
         Search_File := Objects_Search_File;
1506
         Default_Suffix_Dir := new String'("adalib");
1507
      end if;
1508
 
1509
      Norm_Search_Dir := To_Canonical_Path_Spec (Local_Search_Dir.all);
1510
 
1511
      if Is_Absolute_Path (Norm_Search_Dir.all) then
1512
 
1513
         --  We first verify if there is a directory Include_Search_Dir
1514
         --  containing default search directories
1515
 
1516
         Result_Search_Dir :=
1517
           Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
1518
         Default_Search_Dir :=
1519
           new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
1520
         Free (Norm_Search_Dir);
1521
 
1522
         if Result_Search_Dir /= null then
1523
            return String_Ptr (Result_Search_Dir);
1524
         elsif Is_Directory (Default_Search_Dir.all) then
1525
            return String_Ptr (Default_Search_Dir);
1526
         else
1527
            return null;
1528
         end if;
1529
 
1530
      --  Search in the current directory
1531
 
1532
      else
1533
         --  Get the current directory
1534
 
1535
         declare
1536
            Buffer   : String (1 .. Max_Path + 2);
1537
            Path_Len : Natural := Max_Path;
1538
 
1539
         begin
1540
            Get_Current_Dir (Buffer'Address, Path_Len'Address);
1541
 
1542
            if Buffer (Path_Len) /= Directory_Separator then
1543
               Path_Len := Path_Len + 1;
1544
               Buffer (Path_Len) := Directory_Separator;
1545
            end if;
1546
 
1547
            Current_Dir := new String'(Buffer (1 .. Path_Len));
1548
         end;
1549
 
1550
         Norm_Search_Dir :=
1551
           new String'(Current_Dir.all & Local_Search_Dir.all);
1552
 
1553
         Result_Search_Dir :=
1554
           Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
1555
 
1556
         Default_Search_Dir :=
1557
           new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
1558
 
1559
         Free (Norm_Search_Dir);
1560
 
1561
         if Result_Search_Dir /= null then
1562
            return String_Ptr (Result_Search_Dir);
1563
 
1564
         elsif Is_Directory (Default_Search_Dir.all) then
1565
            return String_Ptr (Default_Search_Dir);
1566
 
1567
         else
1568
            --  Search in Search_Dir_Prefix/Search_Dir
1569
 
1570
            Norm_Search_Dir :=
1571
              new String'
1572
               (Update_Path (Search_Dir_Prefix).all & Local_Search_Dir.all);
1573
 
1574
            Result_Search_Dir :=
1575
              Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
1576
 
1577
            Default_Search_Dir :=
1578
              new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
1579
 
1580
            Free (Norm_Search_Dir);
1581
 
1582
            if Result_Search_Dir /= null then
1583
               return String_Ptr (Result_Search_Dir);
1584
 
1585
            elsif Is_Directory (Default_Search_Dir.all) then
1586
               return String_Ptr (Default_Search_Dir);
1587
 
1588
            else
1589
               --  We finally search in Search_Dir_Prefix/rts-Search_Dir
1590
 
1591
               Temp_String :=
1592
                 new String'(Update_Path (Search_Dir_Prefix).all & "rts-");
1593
 
1594
               Norm_Search_Dir :=
1595
                 new String'(Temp_String.all & Local_Search_Dir.all);
1596
 
1597
               Result_Search_Dir :=
1598
                 Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
1599
 
1600
               Default_Search_Dir :=
1601
                 new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
1602
               Free (Norm_Search_Dir);
1603
 
1604
               if Result_Search_Dir /= null then
1605
                  return String_Ptr (Result_Search_Dir);
1606
 
1607
               elsif Is_Directory (Default_Search_Dir.all) then
1608
                  return String_Ptr (Default_Search_Dir);
1609
 
1610
               else
1611
                  return null;
1612
               end if;
1613
            end if;
1614
         end if;
1615
      end if;
1616
   end Get_RTS_Search_Dir;
1617
 
1618
   --------------------------------
1619
   -- Include_Dir_Default_Prefix --
1620
   --------------------------------
1621
 
1622
   function Include_Dir_Default_Prefix return String_Access is
1623
   begin
1624
      if The_Include_Dir_Default_Prefix = null then
1625
         The_Include_Dir_Default_Prefix :=
1626
           String_Access (Update_Path (Include_Dir_Default_Name));
1627
      end if;
1628
 
1629
      return The_Include_Dir_Default_Prefix;
1630
   end Include_Dir_Default_Prefix;
1631
 
1632
   function Include_Dir_Default_Prefix return String is
1633
   begin
1634
      return Include_Dir_Default_Prefix.all;
1635
   end Include_Dir_Default_Prefix;
1636
 
1637
   ----------------
1638
   -- Initialize --
1639
   ----------------
1640
 
1641
   procedure Initialize is
1642
   begin
1643
      Number_File_Names       := 0;
1644
      Current_File_Name_Index := 0;
1645
 
1646
      Src_Search_Directories.Init;
1647
      Lib_Search_Directories.Init;
1648
 
1649
      --  Start off by setting all suppress options to False, these will
1650
      --  be reset later (turning some on if -gnato is not specified, and
1651
      --  turning all of them on if -gnatp is specified).
1652
 
1653
      Suppress_Options := (others => False);
1654
 
1655
      --  Reserve the first slot in the search paths table. This is the
1656
      --  directory of the main source file or main library file and is filled
1657
      --  in by each call to Next_Main_Source/Next_Main_Lib_File with the
1658
      --  directory specified for this main source or library file. This is the
1659
      --  directory which is searched first by default. This default search is
1660
      --  inhibited by the option -I- for both source and library files.
1661
 
1662
      Src_Search_Directories.Set_Last (Primary_Directory);
1663
      Src_Search_Directories.Table (Primary_Directory) := new String'("");
1664
 
1665
      Lib_Search_Directories.Set_Last (Primary_Directory);
1666
      Lib_Search_Directories.Table (Primary_Directory) := new String'("");
1667
   end Initialize;
1668
 
1669
   ------------------
1670
   -- Is_Directory --
1671
   ------------------
1672
 
1673
   function Is_Directory
1674
     (Name : C_File_Name; Attr : access File_Attributes) return Boolean
1675
   is
1676
      function Internal (N : C_File_Name; A : System.Address) return Integer;
1677
      pragma Import (C, Internal, "__gnat_is_directory_attr");
1678
   begin
1679
      return Internal (Name, Attr.all'Address) /= 0;
1680
   end Is_Directory;
1681
 
1682
   ----------------------------
1683
   -- Is_Directory_Separator --
1684
   ----------------------------
1685
 
1686
   function Is_Directory_Separator (C : Character) return Boolean is
1687
   begin
1688
      --  In addition to the default directory_separator allow the '/' to
1689
      --  act as separator since this is allowed in MS-DOS, Windows 95/NT,
1690
      --  and OS2 ports. On VMS, the situation is more complicated because
1691
      --  there are two characters to check for.
1692
 
1693
      return
1694
        C = Directory_Separator
1695
          or else C = '/'
1696
          or else (Hostparm.OpenVMS
1697
                    and then (C = ']' or else C = ':'));
1698
   end Is_Directory_Separator;
1699
 
1700
   -------------------------
1701
   -- Is_Readonly_Library --
1702
   -------------------------
1703
 
1704
   function Is_Readonly_Library (File : File_Name_Type) return Boolean is
1705
   begin
1706
      Get_Name_String (File);
1707
 
1708
      pragma Assert (Name_Buffer (Name_Len - 3 .. Name_Len) = ".ali");
1709
 
1710
      return not Is_Writable_File (Name_Buffer (1 .. Name_Len));
1711
   end Is_Readonly_Library;
1712
 
1713
   ------------------------
1714
   -- Is_Executable_File --
1715
   ------------------------
1716
 
1717
   function Is_Executable_File
1718
     (Name : C_File_Name; Attr : access File_Attributes) return Boolean
1719
   is
1720
      function Internal (N : C_File_Name; A : System.Address) return Integer;
1721
      pragma Import (C, Internal, "__gnat_is_executable_file_attr");
1722
   begin
1723
      return Internal (Name, Attr.all'Address) /= 0;
1724
   end Is_Executable_File;
1725
 
1726
   ----------------------
1727
   -- Is_Readable_File --
1728
   ----------------------
1729
 
1730
   function Is_Readable_File
1731
     (Name : C_File_Name; Attr : access File_Attributes) return Boolean
1732
   is
1733
      function Internal (N : C_File_Name; A : System.Address) return Integer;
1734
      pragma Import (C, Internal, "__gnat_is_readable_file_attr");
1735
   begin
1736
      return Internal (Name, Attr.all'Address) /= 0;
1737
   end Is_Readable_File;
1738
 
1739
   ---------------------
1740
   -- Is_Regular_File --
1741
   ---------------------
1742
 
1743
   function Is_Regular_File
1744
     (Name : C_File_Name; Attr : access File_Attributes) return Boolean
1745
   is
1746
      function Internal (N : C_File_Name; A : System.Address) return Integer;
1747
      pragma Import (C, Internal, "__gnat_is_regular_file_attr");
1748
   begin
1749
      return Internal (Name, Attr.all'Address) /= 0;
1750
   end Is_Regular_File;
1751
 
1752
   ----------------------
1753
   -- Is_Symbolic_Link --
1754
   ----------------------
1755
 
1756
   function Is_Symbolic_Link
1757
     (Name : C_File_Name; Attr : access File_Attributes) return Boolean
1758
   is
1759
      function Internal (N : C_File_Name; A : System.Address) return Integer;
1760
      pragma Import (C, Internal, "__gnat_is_symbolic_link_attr");
1761
   begin
1762
      return Internal (Name, Attr.all'Address) /= 0;
1763
   end Is_Symbolic_Link;
1764
 
1765
   ----------------------
1766
   -- Is_Writable_File --
1767
   ----------------------
1768
 
1769
   function Is_Writable_File
1770
     (Name : C_File_Name; Attr : access File_Attributes) return Boolean
1771
   is
1772
      function Internal (N : C_File_Name; A : System.Address) return Integer;
1773
      pragma Import (C, Internal, "__gnat_is_writable_file_attr");
1774
   begin
1775
      return Internal (Name, Attr.all'Address) /= 0;
1776
   end Is_Writable_File;
1777
 
1778
   -------------------
1779
   -- Lib_File_Name --
1780
   -------------------
1781
 
1782
   function Lib_File_Name
1783
     (Source_File : File_Name_Type;
1784
      Munit_Index : Nat := 0) return File_Name_Type
1785
   is
1786
   begin
1787
      Get_Name_String (Source_File);
1788
 
1789
      for J in reverse 2 .. Name_Len loop
1790
         if Name_Buffer (J) = '.' then
1791
            Name_Len := J - 1;
1792
            exit;
1793
         end if;
1794
      end loop;
1795
 
1796
      if Munit_Index /= 0 then
1797
         Add_Char_To_Name_Buffer (Multi_Unit_Index_Character);
1798
         Add_Nat_To_Name_Buffer (Munit_Index);
1799
      end if;
1800
 
1801
      Add_Char_To_Name_Buffer ('.');
1802
      Add_Str_To_Name_Buffer (ALI_Suffix.all);
1803
      return Name_Find;
1804
   end Lib_File_Name;
1805
 
1806
   -----------------
1807
   -- Locate_File --
1808
   -----------------
1809
 
1810
   procedure Locate_File
1811
     (N     : File_Name_Type;
1812
      T     : File_Type;
1813
      Dir   : Natural;
1814
      Name  : String;
1815
      Found : out File_Name_Type;
1816
      Attr  : access File_Attributes)
1817
   is
1818
      Dir_Name : String_Ptr;
1819
 
1820
   begin
1821
      --  If Name is already an absolute path, do not look for a directory
1822
 
1823
      if Is_Absolute_Path (Name) then
1824
         Dir_Name := No_Dir;
1825
 
1826
      elsif T = Library then
1827
         Dir_Name := Lib_Search_Directories.Table (Dir);
1828
 
1829
      else
1830
         pragma Assert (T /= Config);
1831
         Dir_Name := Src_Search_Directories.Table (Dir);
1832
      end if;
1833
 
1834
      declare
1835
         Full_Name : String (1 .. Dir_Name'Length + Name'Length + 1);
1836
 
1837
      begin
1838
         Full_Name (1 .. Dir_Name'Length) := Dir_Name.all;
1839
         Full_Name (Dir_Name'Length + 1 .. Full_Name'Last - 1) := Name;
1840
         Full_Name (Full_Name'Last) := ASCII.NUL;
1841
 
1842
         Attr.all := Unknown_Attributes;
1843
 
1844
         if not Is_Regular_File (Full_Name'Address, Attr) then
1845
            Found := No_File;
1846
 
1847
         else
1848
            --  If the file is in the current directory then return N itself
1849
 
1850
            if Dir_Name'Length = 0 then
1851
               Found := N;
1852
            else
1853
               Name_Len := Full_Name'Length - 1;
1854
               Name_Buffer (1 .. Name_Len) :=
1855
                 Full_Name (1 .. Full_Name'Last - 1);
1856
               Found := Name_Find;  --  ??? Was Name_Enter, no obvious reason
1857
            end if;
1858
         end if;
1859
      end;
1860
   end Locate_File;
1861
 
1862
   -------------------------------
1863
   -- Matching_Full_Source_Name --
1864
   -------------------------------
1865
 
1866
   function Matching_Full_Source_Name
1867
     (N : File_Name_Type;
1868
      T : Time_Stamp_Type) return File_Name_Type
1869
   is
1870
   begin
1871
      Get_Name_String (N);
1872
 
1873
      declare
1874
         File_Name : constant String := Name_Buffer (1 .. Name_Len);
1875
         File      : File_Name_Type := No_File;
1876
         Attr      : aliased File_Attributes;
1877
         Last_Dir  : Natural;
1878
 
1879
      begin
1880
         if Opt.Look_In_Primary_Dir then
1881
            Locate_File
1882
              (N, Source, Primary_Directory, File_Name, File, Attr'Access);
1883
 
1884
            if File /= No_File and then T = File_Stamp (N) then
1885
               return File;
1886
            end if;
1887
         end if;
1888
 
1889
         Last_Dir := Src_Search_Directories.Last;
1890
 
1891
         for D in Primary_Directory + 1 .. Last_Dir loop
1892
            Locate_File (N, Source, D, File_Name, File, Attr'Access);
1893
 
1894
            if File /= No_File and then T = File_Stamp (File) then
1895
               return File;
1896
            end if;
1897
         end loop;
1898
 
1899
         return No_File;
1900
      end;
1901
   end Matching_Full_Source_Name;
1902
 
1903
   ----------------
1904
   -- More_Files --
1905
   ----------------
1906
 
1907
   function More_Files return Boolean is
1908
   begin
1909
      return (Current_File_Name_Index < Number_File_Names);
1910
   end More_Files;
1911
 
1912
   -------------------------------
1913
   -- Nb_Dir_In_Obj_Search_Path --
1914
   -------------------------------
1915
 
1916
   function Nb_Dir_In_Obj_Search_Path return Natural is
1917
   begin
1918
      if Opt.Look_In_Primary_Dir then
1919
         return Lib_Search_Directories.Last -  Primary_Directory + 1;
1920
      else
1921
         return Lib_Search_Directories.Last -  Primary_Directory;
1922
      end if;
1923
   end Nb_Dir_In_Obj_Search_Path;
1924
 
1925
   -------------------------------
1926
   -- Nb_Dir_In_Src_Search_Path --
1927
   -------------------------------
1928
 
1929
   function Nb_Dir_In_Src_Search_Path return Natural is
1930
   begin
1931
      if Opt.Look_In_Primary_Dir then
1932
         return Src_Search_Directories.Last -  Primary_Directory + 1;
1933
      else
1934
         return Src_Search_Directories.Last -  Primary_Directory;
1935
      end if;
1936
   end Nb_Dir_In_Src_Search_Path;
1937
 
1938
   --------------------
1939
   -- Next_Main_File --
1940
   --------------------
1941
 
1942
   function Next_Main_File return File_Name_Type is
1943
      File_Name : String_Ptr;
1944
      Dir_Name  : String_Ptr;
1945
      Fptr      : Natural;
1946
 
1947
   begin
1948
      pragma Assert (More_Files);
1949
 
1950
      Current_File_Name_Index := Current_File_Name_Index + 1;
1951
 
1952
      --  Get the file and directory name
1953
 
1954
      File_Name := File_Names (Current_File_Name_Index);
1955
      Fptr := File_Name'First;
1956
 
1957
      for J in reverse File_Name'Range loop
1958
         if File_Name (J) = Directory_Separator
1959
           or else File_Name (J) = '/'
1960
         then
1961
            if J = File_Name'Last then
1962
               Fail ("File name missing");
1963
            end if;
1964
 
1965
            Fptr := J + 1;
1966
            exit;
1967
         end if;
1968
      end loop;
1969
 
1970
      --  Save name of directory in which main unit resides for use in
1971
      --  locating other units
1972
 
1973
      Dir_Name := new String'(File_Name (File_Name'First .. Fptr - 1));
1974
 
1975
      case Running_Program is
1976
 
1977
         when Compiler =>
1978
            Src_Search_Directories.Table (Primary_Directory) := Dir_Name;
1979
            Look_In_Primary_Directory_For_Current_Main := True;
1980
 
1981
         when Make =>
1982
            Src_Search_Directories.Table (Primary_Directory) := Dir_Name;
1983
 
1984
            if Fptr > File_Name'First then
1985
               Look_In_Primary_Directory_For_Current_Main := True;
1986
            end if;
1987
 
1988
         when Binder | Gnatls =>
1989
            Dir_Name := Normalize_Directory_Name (Dir_Name.all);
1990
            Lib_Search_Directories.Table (Primary_Directory) := Dir_Name;
1991
 
1992
         when Unspecified =>
1993
            null;
1994
      end case;
1995
 
1996
      Name_Len := File_Name'Last - Fptr + 1;
1997
      Name_Buffer (1 .. Name_Len) := File_Name (Fptr .. File_Name'Last);
1998
      Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1999
      Current_Main := Name_Find;
2000
 
2001
      --  In the gnatmake case, the main file may have not have the
2002
      --  extension. Try ".adb" first then ".ads"
2003
 
2004
      if Running_Program = Make then
2005
         declare
2006
            Orig_Main : constant File_Name_Type := Current_Main;
2007
 
2008
         begin
2009
            if Strip_Suffix (Orig_Main) = Orig_Main then
2010
               Current_Main :=
2011
                 Append_Suffix_To_File_Name (Orig_Main, ".adb");
2012
 
2013
               if Full_Source_Name (Current_Main) = No_File then
2014
                  Current_Main :=
2015
                    Append_Suffix_To_File_Name (Orig_Main, ".ads");
2016
 
2017
                  if Full_Source_Name (Current_Main) = No_File then
2018
                     Current_Main := Orig_Main;
2019
                  end if;
2020
               end if;
2021
            end if;
2022
         end;
2023
      end if;
2024
 
2025
      return Current_Main;
2026
   end Next_Main_File;
2027
 
2028
   ------------------------------
2029
   -- Normalize_Directory_Name --
2030
   ------------------------------
2031
 
2032
   function Normalize_Directory_Name (Directory : String) return String_Ptr is
2033
 
2034
      function Is_Quoted (Path : String) return Boolean;
2035
      pragma Inline (Is_Quoted);
2036
      --  Returns true if Path is quoted (either double or single quotes)
2037
 
2038
      ---------------
2039
      -- Is_Quoted --
2040
      ---------------
2041
 
2042
      function Is_Quoted (Path : String) return Boolean is
2043
         First : constant Character := Path (Path'First);
2044
         Last  : constant Character := Path (Path'Last);
2045
 
2046
      begin
2047
         if (First = ''' and then Last = ''')
2048
               or else
2049
            (First = '"' and then Last = '"')
2050
         then
2051
            return True;
2052
         else
2053
            return False;
2054
         end if;
2055
      end Is_Quoted;
2056
 
2057
      Result : String_Ptr;
2058
 
2059
   --  Start of processing for Normalize_Directory_Name
2060
 
2061
   begin
2062
      if Directory'Length = 0 then
2063
         Result := new String'(Hostparm.Normalized_CWD);
2064
 
2065
      elsif Is_Directory_Separator (Directory (Directory'Last)) then
2066
         Result := new String'(Directory);
2067
 
2068
      elsif Is_Quoted (Directory) then
2069
 
2070
         --  This is a quoted string, it certainly means that the directory
2071
         --  contains some spaces for example. We can safely remove the quotes
2072
         --  here as the OS_Lib.Normalize_Arguments will be called before any
2073
         --  spawn routines. This ensure that quotes will be added when needed.
2074
 
2075
         Result := new String (1 .. Directory'Length - 1);
2076
         Result (1 .. Directory'Length - 2) :=
2077
           Directory (Directory'First + 1 .. Directory'Last - 1);
2078
         Result (Result'Last) := Directory_Separator;
2079
 
2080
      else
2081
         Result := new String (1 .. Directory'Length + 1);
2082
         Result (1 .. Directory'Length) := Directory;
2083
         Result (Directory'Length + 1) := Directory_Separator;
2084
      end if;
2085
 
2086
      return Result;
2087
   end Normalize_Directory_Name;
2088
 
2089
   ---------------------
2090
   -- Number_Of_Files --
2091
   ---------------------
2092
 
2093
   function Number_Of_Files return Int is
2094
   begin
2095
      return Number_File_Names;
2096
   end Number_Of_Files;
2097
 
2098
   -------------------------------
2099
   -- Object_Dir_Default_Prefix --
2100
   -------------------------------
2101
 
2102
   function Object_Dir_Default_Prefix return String is
2103
      Object_Dir : String_Access :=
2104
                     String_Access (Update_Path (Object_Dir_Default_Name));
2105
 
2106
   begin
2107
      if Object_Dir = null then
2108
         return "";
2109
 
2110
      else
2111
         declare
2112
            Result : constant String := Object_Dir.all;
2113
         begin
2114
            Free (Object_Dir);
2115
            return Result;
2116
         end;
2117
      end if;
2118
   end Object_Dir_Default_Prefix;
2119
 
2120
   ----------------------
2121
   -- Object_File_Name --
2122
   ----------------------
2123
 
2124
   function Object_File_Name (N : File_Name_Type) return File_Name_Type is
2125
   begin
2126
      if N = No_File then
2127
         return No_File;
2128
      end if;
2129
 
2130
      Get_Name_String (N);
2131
      Name_Len := Name_Len - ALI_Suffix'Length - 1;
2132
 
2133
      for J in Target_Object_Suffix'Range loop
2134
         Name_Len := Name_Len + 1;
2135
         Name_Buffer (Name_Len) := Target_Object_Suffix (J);
2136
      end loop;
2137
 
2138
      return Name_Enter;
2139
   end Object_File_Name;
2140
 
2141
   -------------------------------
2142
   -- OS_Exit_Through_Exception --
2143
   -------------------------------
2144
 
2145
   procedure OS_Exit_Through_Exception (Status : Integer) is
2146
   begin
2147
      Current_Exit_Status := Status;
2148
      raise Types.Terminate_Program;
2149
   end OS_Exit_Through_Exception;
2150
 
2151
   --------------------------
2152
   -- OS_Time_To_GNAT_Time --
2153
   --------------------------
2154
 
2155
   function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type is
2156
      GNAT_Time : Time_Stamp_Type;
2157
 
2158
      Y  : Year_Type;
2159
      Mo : Month_Type;
2160
      D  : Day_Type;
2161
      H  : Hour_Type;
2162
      Mn : Minute_Type;
2163
      S  : Second_Type;
2164
 
2165
   begin
2166
      if T = Invalid_Time then
2167
         return Empty_Time_Stamp;
2168
      end if;
2169
 
2170
      GM_Split (T, Y, Mo, D, H, Mn, S);
2171
      Make_Time_Stamp
2172
        (Year    => Nat (Y),
2173
         Month   => Nat (Mo),
2174
         Day     => Nat (D),
2175
         Hour    => Nat (H),
2176
         Minutes => Nat (Mn),
2177
         Seconds => Nat (S),
2178
         TS      => GNAT_Time);
2179
 
2180
      return GNAT_Time;
2181
   end OS_Time_To_GNAT_Time;
2182
 
2183
   ------------------
2184
   -- Program_Name --
2185
   ------------------
2186
 
2187
   function Program_Name (Nam : String; Prog : String) return String_Access is
2188
      End_Of_Prefix   : Natural := 0;
2189
      Start_Of_Prefix : Positive := 1;
2190
      Start_Of_Suffix : Positive;
2191
 
2192
   begin
2193
      --  GNAAMP tool names require special treatment
2194
 
2195
      if AAMP_On_Target then
2196
 
2197
         --  The name "gcc" is mapped to "gnaamp" (the compiler driver)
2198
 
2199
         if Nam = "gcc" then
2200
            return new String'("gnaamp");
2201
 
2202
         --  Tool names starting with "gnat" are mapped by substituting the
2203
         --  string "gnaamp" for "gnat" (for example, "gnatpp" => "gnaamppp").
2204
 
2205
         elsif Nam'Length >= 4
2206
           and then Nam (Nam'First .. Nam'First + 3) = "gnat"
2207
         then
2208
            return new String'("gnaamp" & Nam (Nam'First + 4 .. Nam'Last));
2209
 
2210
         --  No other mapping rules, so we continue and handle any other forms
2211
         --  of tool names the same as on other targets.
2212
 
2213
         else
2214
            null;
2215
         end if;
2216
      end if;
2217
 
2218
      --  Get the name of the current program being executed
2219
 
2220
      Find_Program_Name;
2221
 
2222
      Start_Of_Suffix := Name_Len + 1;
2223
 
2224
      --  Find the target prefix if any, for the cross compilation case.
2225
      --  For instance in "powerpc-elf-gcc" the target prefix is
2226
      --  "powerpc-elf-"
2227
      --  Ditto for suffix, e.g. in "gcc-4.1", the suffix is "-4.1"
2228
 
2229
      for J in reverse 1 .. Name_Len loop
2230
         if Name_Buffer (J) = '/'
2231
           or else Name_Buffer (J) = Directory_Separator
2232
           or else Name_Buffer (J) = ':'
2233
         then
2234
            Start_Of_Prefix := J + 1;
2235
            exit;
2236
         end if;
2237
      end loop;
2238
 
2239
      --  Find End_Of_Prefix
2240
 
2241
      for J in Start_Of_Prefix .. Name_Len - Prog'Length + 1 loop
2242
         if Name_Buffer (J .. J + Prog'Length - 1) = Prog then
2243
            End_Of_Prefix := J - 1;
2244
            exit;
2245
         end if;
2246
      end loop;
2247
 
2248
      if End_Of_Prefix > 1 then
2249
         Start_Of_Suffix := End_Of_Prefix + Prog'Length + 1;
2250
      end if;
2251
 
2252
      --  Create the new program name
2253
 
2254
      return new String'
2255
        (Name_Buffer (Start_Of_Prefix .. End_Of_Prefix)
2256
         & Nam
2257
         & Name_Buffer (Start_Of_Suffix .. Name_Len));
2258
   end Program_Name;
2259
 
2260
   ------------------------------
2261
   -- Read_Default_Search_Dirs --
2262
   ------------------------------
2263
 
2264
   function Read_Default_Search_Dirs
2265
     (Search_Dir_Prefix       : String_Access;
2266
      Search_File             : String_Access;
2267
      Search_Dir_Default_Name : String_Access) return String_Access
2268
   is
2269
      Prefix_Len : constant Integer := Search_Dir_Prefix.all'Length;
2270
      Buffer     : String (1 .. Prefix_Len + Search_File.all'Length + 1);
2271
      File_FD    : File_Descriptor;
2272
      S, S1      : String_Access;
2273
      Len        : Integer;
2274
      Curr       : Integer;
2275
      Actual_Len : Integer;
2276
      J1         : Integer;
2277
 
2278
      Prev_Was_Separator : Boolean;
2279
      Nb_Relative_Dir    : Integer;
2280
 
2281
      function Is_Relative (S : String; K : Positive) return Boolean;
2282
      pragma Inline (Is_Relative);
2283
      --  Returns True if a relative directory specification is found
2284
      --  in S at position K, False otherwise.
2285
 
2286
      -----------------
2287
      -- Is_Relative --
2288
      -----------------
2289
 
2290
      function Is_Relative (S : String; K : Positive) return Boolean is
2291
      begin
2292
         return not Is_Absolute_Path (S (K .. S'Last));
2293
      end Is_Relative;
2294
 
2295
   --  Start of processing for Read_Default_Search_Dirs
2296
 
2297
   begin
2298
      --  Construct a C compatible character string buffer
2299
 
2300
      Buffer (1 .. Search_Dir_Prefix.all'Length)
2301
        := Search_Dir_Prefix.all;
2302
      Buffer (Search_Dir_Prefix.all'Length + 1 .. Buffer'Last - 1)
2303
        := Search_File.all;
2304
      Buffer (Buffer'Last) := ASCII.NUL;
2305
 
2306
      File_FD := Open_Read (Buffer'Address, Binary);
2307
      if File_FD = Invalid_FD then
2308
         return Search_Dir_Default_Name;
2309
      end if;
2310
 
2311
      Len := Integer (File_Length (File_FD));
2312
 
2313
      --  An extra character for a trailing Path_Separator is allocated
2314
 
2315
      S := new String (1 .. Len + 1);
2316
      S (Len + 1) := Path_Separator;
2317
 
2318
      --  Read the file. Note that the loop is not necessary since the
2319
      --  whole file is read at once except on VMS.
2320
 
2321
      Curr := 1;
2322
      Actual_Len := Len;
2323
      while Actual_Len /= 0 loop
2324
         Actual_Len := Read (File_FD, S (Curr)'Address, Len);
2325
         Curr := Curr + Actual_Len;
2326
      end loop;
2327
 
2328
      --  Process the file, dealing with path separators
2329
 
2330
      Prev_Was_Separator := True;
2331
      Nb_Relative_Dir := 0;
2332
      for J in 1 .. Len loop
2333
 
2334
         --  Treat any control character as a path separator. Note that we do
2335
         --  not treat space as a path separator (we used to treat space as a
2336
         --  path separator in an earlier version). That way space can appear
2337
         --  as a legitimate character in a path name.
2338
 
2339
         --  Why do we treat all control characters as path separators???
2340
 
2341
         if S (J) in ASCII.NUL .. ASCII.US then
2342
            S (J) := Path_Separator;
2343
         end if;
2344
 
2345
         --  Test for explicit path separator (or control char as above)
2346
 
2347
         if S (J) = Path_Separator then
2348
            Prev_Was_Separator := True;
2349
 
2350
         --  If not path separator, register use of relative directory
2351
 
2352
         else
2353
            if Prev_Was_Separator and then Is_Relative (S.all, J) then
2354
               Nb_Relative_Dir := Nb_Relative_Dir + 1;
2355
            end if;
2356
 
2357
            Prev_Was_Separator := False;
2358
         end if;
2359
      end loop;
2360
 
2361
      if Nb_Relative_Dir = 0 then
2362
         return S;
2363
      end if;
2364
 
2365
      --  Add the Search_Dir_Prefix to all relative paths
2366
 
2367
      S1 := new String (1 .. S'Length + Nb_Relative_Dir * Prefix_Len);
2368
      J1 := 1;
2369
      Prev_Was_Separator := True;
2370
      for J in 1 .. Len + 1 loop
2371
         if S (J) = Path_Separator then
2372
            Prev_Was_Separator := True;
2373
 
2374
         else
2375
            if Prev_Was_Separator and then Is_Relative (S.all, J) then
2376
               S1 (J1 .. J1 + Prefix_Len - 1) := Search_Dir_Prefix.all;
2377
               J1 := J1 + Prefix_Len;
2378
            end if;
2379
 
2380
            Prev_Was_Separator := False;
2381
         end if;
2382
         S1 (J1) := S (J);
2383
         J1 := J1 + 1;
2384
      end loop;
2385
 
2386
      Free (S);
2387
      return S1;
2388
   end Read_Default_Search_Dirs;
2389
 
2390
   -----------------------
2391
   -- Read_Library_Info --
2392
   -----------------------
2393
 
2394
   function Read_Library_Info
2395
     (Lib_File  : File_Name_Type;
2396
      Fatal_Err : Boolean := False) return Text_Buffer_Ptr
2397
   is
2398
      File : File_Name_Type;
2399
      Attr : aliased File_Attributes;
2400
   begin
2401
      Find_File (Lib_File, Library, File, Attr'Access);
2402
      return Read_Library_Info_From_Full
2403
        (Full_Lib_File => File,
2404
         Lib_File_Attr => Attr'Access,
2405
         Fatal_Err     => Fatal_Err);
2406
   end Read_Library_Info;
2407
 
2408
   ---------------------------------
2409
   -- Read_Library_Info_From_Full --
2410
   ---------------------------------
2411
 
2412
   function Read_Library_Info_From_Full
2413
     (Full_Lib_File : File_Name_Type;
2414
      Lib_File_Attr : access File_Attributes;
2415
      Fatal_Err     : Boolean := False) return Text_Buffer_Ptr
2416
   is
2417
      Lib_FD : File_Descriptor;
2418
      --  The file descriptor for the current library file. A negative value
2419
      --  indicates failure to open the specified source file.
2420
 
2421
      Len : Integer;
2422
      --  Length of source file text (ALI). If it doesn't fit in an integer
2423
      --  we're probably stuck anyway (>2 gigs of source seems a lot!)
2424
 
2425
      Text : Text_Buffer_Ptr;
2426
      --  Allocated text buffer
2427
 
2428
      Status : Boolean;
2429
      pragma Warnings (Off, Status);
2430
      --  For the calls to Close
2431
 
2432
   begin
2433
      Current_Full_Lib_Name := Full_Lib_File;
2434
      Current_Full_Obj_Name := Object_File_Name (Current_Full_Lib_Name);
2435
 
2436
      if Current_Full_Lib_Name = No_File then
2437
         if Fatal_Err then
2438
            Fail ("Cannot find: " & Name_Buffer (1 .. Name_Len));
2439
         else
2440
            Current_Full_Obj_Stamp := Empty_Time_Stamp;
2441
            return null;
2442
         end if;
2443
      end if;
2444
 
2445
      Get_Name_String (Current_Full_Lib_Name);
2446
      Name_Buffer (Name_Len + 1) := ASCII.NUL;
2447
 
2448
      --  Open the library FD, note that we open in binary mode, because as
2449
      --  documented in the spec, the caller is expected to handle either
2450
      --  DOS or Unix mode files, and there is no point in wasting time on
2451
      --  text translation when it is not required.
2452
 
2453
      Lib_FD := Open_Read (Name_Buffer'Address, Binary);
2454
 
2455
      if Lib_FD = Invalid_FD then
2456
         if Fatal_Err then
2457
            Fail ("Cannot open: " & Name_Buffer (1 .. Name_Len));
2458
         else
2459
            Current_Full_Obj_Stamp := Empty_Time_Stamp;
2460
            return null;
2461
         end if;
2462
      end if;
2463
 
2464
      --  Compute the length of the file (potentially also preparing other data
2465
      --  like the timestamp and whether the file is read-only, for future use)
2466
 
2467
      Len := Integer (File_Length (Name_Buffer'Address, Lib_File_Attr));
2468
 
2469
      --  Check for object file consistency if requested
2470
 
2471
      if Opt.Check_Object_Consistency then
2472
         --  On most systems, this does not result in an extra system call
2473
 
2474
         Current_Full_Lib_Stamp :=
2475
           OS_Time_To_GNAT_Time
2476
             (File_Time_Stamp (Name_Buffer'Address, Lib_File_Attr));
2477
 
2478
         --  ??? One system call here
2479
 
2480
         Current_Full_Obj_Stamp := File_Stamp (Current_Full_Obj_Name);
2481
 
2482
         if Current_Full_Obj_Stamp (1) = ' ' then
2483
 
2484
            --  When the library is readonly always assume object is consistent
2485
            --  The call to Is_Writable_File only results in a system call on
2486
            --  some systems, but in most cases it has already been computed as
2487
            --  part of the call to File_Length above.
2488
 
2489
            Get_Name_String (Current_Full_Lib_Name);
2490
            Name_Buffer (Name_Len + 1) := ASCII.NUL;
2491
 
2492
            if not Is_Writable_File (Name_Buffer'Address, Lib_File_Attr) then
2493
               Current_Full_Obj_Stamp := Current_Full_Lib_Stamp;
2494
 
2495
            elsif Fatal_Err then
2496
               Get_Name_String (Current_Full_Obj_Name);
2497
               Close (Lib_FD, Status);
2498
 
2499
               --  No need to check the status, we fail anyway
2500
 
2501
               Fail ("Cannot find: " & Name_Buffer (1 .. Name_Len));
2502
 
2503
            else
2504
               Current_Full_Obj_Stamp := Empty_Time_Stamp;
2505
               Close (Lib_FD, Status);
2506
 
2507
               --  No need to check the status, we return null anyway
2508
 
2509
               return null;
2510
            end if;
2511
 
2512
         elsif Current_Full_Obj_Stamp < Current_Full_Lib_Stamp then
2513
            Close (Lib_FD, Status);
2514
 
2515
            --  No need to check the status, we return null anyway
2516
 
2517
            return null;
2518
         end if;
2519
      end if;
2520
 
2521
      --  Read data from the file
2522
 
2523
      declare
2524
         Actual_Len : Integer := 0;
2525
 
2526
         Lo : constant Text_Ptr := 0;
2527
         --  Low bound for allocated text buffer
2528
 
2529
         Hi : Text_Ptr := Text_Ptr (Len);
2530
         --  High bound for allocated text buffer. Note length is Len + 1
2531
         --  which allows for extra EOF character at the end of the buffer.
2532
 
2533
      begin
2534
         --  Allocate text buffer. Note extra character at end for EOF
2535
 
2536
         Text := new Text_Buffer (Lo .. Hi);
2537
 
2538
         --  Some systems (e.g. VMS) have file types that require one
2539
         --  read per line, so read until we get the Len bytes or until
2540
         --  there are no more characters.
2541
 
2542
         Hi := Lo;
2543
         loop
2544
            Actual_Len := Read (Lib_FD, Text (Hi)'Address, Len);
2545
            Hi := Hi + Text_Ptr (Actual_Len);
2546
            exit when Actual_Len = Len or else Actual_Len <= 0;
2547
         end loop;
2548
 
2549
         Text (Hi) := EOF;
2550
      end;
2551
 
2552
      --  Read is complete, close file and we are done
2553
 
2554
      Close (Lib_FD, Status);
2555
      --  The status should never be False. But, if it is, what can we do?
2556
      --  So, we don't test it.
2557
 
2558
      return Text;
2559
 
2560
   end Read_Library_Info_From_Full;
2561
 
2562
   ----------------------
2563
   -- Read_Source_File --
2564
   ----------------------
2565
 
2566
   procedure Read_Source_File
2567
     (N   : File_Name_Type;
2568
      Lo  : Source_Ptr;
2569
      Hi  : out Source_Ptr;
2570
      Src : out Source_Buffer_Ptr;
2571
      T   : File_Type := Source)
2572
   is
2573
      Source_File_FD : File_Descriptor;
2574
      --  The file descriptor for the current source file. A negative value
2575
      --  indicates failure to open the specified source file.
2576
 
2577
      Len : Integer;
2578
      --  Length of file. Assume no more than 2 gigabytes of source!
2579
 
2580
      Actual_Len : Integer;
2581
 
2582
      Status : Boolean;
2583
      pragma Warnings (Off, Status);
2584
      --  For the call to Close
2585
 
2586
   begin
2587
      Current_Full_Source_Name  := Find_File (N, T);
2588
      Current_Full_Source_Stamp := File_Stamp (Current_Full_Source_Name);
2589
 
2590
      if Current_Full_Source_Name = No_File then
2591
 
2592
         --  If we were trying to access the main file and we could not find
2593
         --  it, we have an error.
2594
 
2595
         if N = Current_Main then
2596
            Get_Name_String (N);
2597
            Fail ("Cannot find: " & Name_Buffer (1 .. Name_Len));
2598
         end if;
2599
 
2600
         Src := null;
2601
         Hi  := No_Location;
2602
         return;
2603
      end if;
2604
 
2605
      Get_Name_String (Current_Full_Source_Name);
2606
      Name_Buffer (Name_Len + 1) := ASCII.NUL;
2607
 
2608
      --  Open the source FD, note that we open in binary mode, because as
2609
      --  documented in the spec, the caller is expected to handle either
2610
      --  DOS or Unix mode files, and there is no point in wasting time on
2611
      --  text translation when it is not required.
2612
 
2613
      Source_File_FD := Open_Read (Name_Buffer'Address, Binary);
2614
 
2615
      if Source_File_FD = Invalid_FD then
2616
         Src := null;
2617
         Hi  := No_Location;
2618
         return;
2619
      end if;
2620
 
2621
      --  Print out the file name, if requested, and if it's not part of the
2622
      --  runtimes, store it in File_Name_Chars.
2623
 
2624
      declare
2625
         Name : String renames Name_Buffer (1 .. Name_Len);
2626
         Inc  : String renames Include_Dir_Default_Prefix.all;
2627
 
2628
      begin
2629
         if Debug.Debug_Flag_Dot_N then
2630
            Write_Line (Name);
2631
         end if;
2632
 
2633
         if Inc /= ""
2634
           and then Inc'Length < Name_Len
2635
           and then Name_Buffer (1 .. Inc'Length) = Inc
2636
         then
2637
            --  Part of runtimes, so ignore it
2638
 
2639
            null;
2640
 
2641
         else
2642
            File_Name_Chars.Append_All (File_Name_Chars.Table_Type (Name));
2643
            File_Name_Chars.Append (ASCII.LF);
2644
         end if;
2645
      end;
2646
 
2647
      --  Prepare to read data from the file
2648
 
2649
      Len := Integer (File_Length (Source_File_FD));
2650
 
2651
      --  Set Hi so that length is one more than the physical length,
2652
      --  allowing for the extra EOF character at the end of the buffer
2653
 
2654
      Hi := Lo + Source_Ptr (Len);
2655
 
2656
      --  Do the actual read operation
2657
 
2658
      declare
2659
         subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi);
2660
         --  Physical buffer allocated
2661
 
2662
         type Actual_Source_Ptr is access Actual_Source_Buffer;
2663
         --  This is the pointer type for the physical buffer allocated
2664
 
2665
         Actual_Ptr : constant Actual_Source_Ptr := new Actual_Source_Buffer;
2666
         --  And this is the actual physical buffer
2667
 
2668
      begin
2669
         --  Allocate source buffer, allowing extra character at end for EOF
2670
 
2671
         --  Some systems (e.g. VMS) have file types that require one read per
2672
         --  line, so read until we get the Len bytes or until there are no
2673
         --  more characters.
2674
 
2675
         Hi := Lo;
2676
         loop
2677
            Actual_Len := Read (Source_File_FD, Actual_Ptr (Hi)'Address, Len);
2678
            Hi := Hi + Source_Ptr (Actual_Len);
2679
            exit when Actual_Len = Len or else Actual_Len <= 0;
2680
         end loop;
2681
 
2682
         Actual_Ptr (Hi) := EOF;
2683
 
2684
         --  Now we need to work out the proper virtual origin pointer to
2685
         --  return. This is exactly Actual_Ptr (0)'Address, but we have to
2686
         --  be careful to suppress checks to compute this address.
2687
 
2688
         declare
2689
            pragma Suppress (All_Checks);
2690
 
2691
            pragma Warnings (Off);
2692
            --  This use of unchecked conversion is aliasing safe
2693
 
2694
            function To_Source_Buffer_Ptr is new
2695
              Unchecked_Conversion (Address, Source_Buffer_Ptr);
2696
 
2697
            pragma Warnings (On);
2698
 
2699
         begin
2700
            Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address);
2701
         end;
2702
      end;
2703
 
2704
      --  Read is complete, get time stamp and close file and we are done
2705
 
2706
      Close (Source_File_FD, Status);
2707
 
2708
      --  The status should never be False. But, if it is, what can we do?
2709
      --  So, we don't test it.
2710
 
2711
   end Read_Source_File;
2712
 
2713
   -------------------
2714
   -- Relocate_Path --
2715
   -------------------
2716
 
2717
   function Relocate_Path
2718
     (Prefix : String;
2719
      Path   : String) return String_Ptr
2720
   is
2721
      S : String_Ptr;
2722
 
2723
      procedure set_std_prefix (S : String; Len : Integer);
2724
      pragma Import (C, set_std_prefix);
2725
 
2726
   begin
2727
      if Std_Prefix = null then
2728
         Std_Prefix := Executable_Prefix;
2729
 
2730
         if Std_Prefix.all /= "" then
2731
 
2732
            --  Remove trailing directory separator when calling set_std_prefix
2733
 
2734
            set_std_prefix (Std_Prefix.all, Std_Prefix'Length - 1);
2735
         end if;
2736
      end if;
2737
 
2738
      if Path (Prefix'Range) = Prefix then
2739
         if Std_Prefix.all /= "" then
2740
            S := new String
2741
              (1 .. Std_Prefix'Length + Path'Last - Prefix'Last);
2742
            S (1 .. Std_Prefix'Length) := Std_Prefix.all;
2743
            S (Std_Prefix'Length + 1 .. S'Last) :=
2744
              Path (Prefix'Last + 1 .. Path'Last);
2745
            return S;
2746
         end if;
2747
      end if;
2748
 
2749
      return new String'(Path);
2750
   end Relocate_Path;
2751
 
2752
   -----------------
2753
   -- Set_Program --
2754
   -----------------
2755
 
2756
   procedure Set_Program (P : Program_Type) is
2757
   begin
2758
      if Program_Set then
2759
         Fail ("Set_Program called twice");
2760
      end if;
2761
 
2762
      Program_Set := True;
2763
      Running_Program := P;
2764
   end Set_Program;
2765
 
2766
   ----------------
2767
   -- Shared_Lib --
2768
   ----------------
2769
 
2770
   function Shared_Lib (Name : String) return String is
2771
      Library : String (1 .. Name'Length + Library_Version'Length + 3);
2772
      --  3 = 2 for "-l" + 1 for "-" before lib version
2773
 
2774
   begin
2775
      Library (1 .. 2)                          := "-l";
2776
      Library (3 .. 2 + Name'Length)            := Name;
2777
      Library (3 + Name'Length)                 := '-';
2778
      Library (4 + Name'Length .. Library'Last) := Library_Version;
2779
 
2780
      if OpenVMS_On_Target then
2781
         for K in Library'First + 2 .. Library'Last loop
2782
            if Library (K) = '.' or else Library (K) = '-' then
2783
               Library (K) := '_';
2784
            end if;
2785
         end loop;
2786
      end if;
2787
 
2788
      return Library;
2789
   end Shared_Lib;
2790
 
2791
   ----------------------
2792
   -- Smart_File_Stamp --
2793
   ----------------------
2794
 
2795
   function Smart_File_Stamp
2796
     (N : File_Name_Type;
2797
      T : File_Type) return Time_Stamp_Type
2798
   is
2799
      File : File_Name_Type;
2800
      Attr : aliased File_Attributes;
2801
 
2802
   begin
2803
      if not File_Cache_Enabled then
2804
         Find_File (N, T, File, Attr'Access);
2805
      else
2806
         Smart_Find_File (N, T, File, Attr);
2807
      end if;
2808
 
2809
      if File = No_File then
2810
         return Empty_Time_Stamp;
2811
      else
2812
         Get_Name_String (File);
2813
         Name_Buffer (Name_Len + 1) := ASCII.NUL;
2814
         return
2815
           OS_Time_To_GNAT_Time
2816
             (File_Time_Stamp (Name_Buffer'Address, Attr'Access));
2817
      end if;
2818
   end Smart_File_Stamp;
2819
 
2820
   ---------------------
2821
   -- Smart_Find_File --
2822
   ---------------------
2823
 
2824
   function Smart_Find_File
2825
     (N : File_Name_Type;
2826
      T : File_Type) return File_Name_Type
2827
   is
2828
      File : File_Name_Type;
2829
      Attr : File_Attributes;
2830
   begin
2831
      Smart_Find_File (N, T, File, Attr);
2832
      return File;
2833
   end Smart_Find_File;
2834
 
2835
   ---------------------
2836
   -- Smart_Find_File --
2837
   ---------------------
2838
 
2839
   procedure Smart_Find_File
2840
     (N     : File_Name_Type;
2841
      T     : File_Type;
2842
      Found : out File_Name_Type;
2843
      Attr  : out File_Attributes)
2844
   is
2845
      Info : File_Info_Cache;
2846
 
2847
   begin
2848
      if not File_Cache_Enabled then
2849
         Find_File (N, T, Info.File, Info.Attr'Access);
2850
 
2851
      else
2852
         Info := File_Name_Hash_Table.Get (N);
2853
 
2854
         if Info.File = No_File then
2855
            Find_File (N, T, Info.File, Info.Attr'Access);
2856
            File_Name_Hash_Table.Set (N, Info);
2857
         end if;
2858
      end if;
2859
 
2860
      Found := Info.File;
2861
      Attr  := Info.Attr;
2862
   end Smart_Find_File;
2863
 
2864
   ----------------------
2865
   -- Source_File_Data --
2866
   ----------------------
2867
 
2868
   procedure Source_File_Data (Cache : Boolean) is
2869
   begin
2870
      File_Cache_Enabled := Cache;
2871
   end Source_File_Data;
2872
 
2873
   -----------------------
2874
   -- Source_File_Stamp --
2875
   -----------------------
2876
 
2877
   function Source_File_Stamp (N : File_Name_Type) return Time_Stamp_Type is
2878
   begin
2879
      return Smart_File_Stamp (N, Source);
2880
   end Source_File_Stamp;
2881
 
2882
   ---------------------
2883
   -- Strip_Directory --
2884
   ---------------------
2885
 
2886
   function Strip_Directory (Name : File_Name_Type) return File_Name_Type is
2887
   begin
2888
      Get_Name_String (Name);
2889
 
2890
      for J in reverse 1 .. Name_Len - 1 loop
2891
 
2892
         --  If we find the last directory separator
2893
 
2894
         if Is_Directory_Separator (Name_Buffer (J)) then
2895
 
2896
            --  Return part of Name that follows this last directory separator
2897
 
2898
            Name_Buffer (1 .. Name_Len - J) := Name_Buffer (J + 1 .. Name_Len);
2899
            Name_Len := Name_Len - J;
2900
            return Name_Find;
2901
         end if;
2902
      end loop;
2903
 
2904
      --  There were no directory separator, just return Name
2905
 
2906
      return Name;
2907
   end Strip_Directory;
2908
 
2909
   ------------------
2910
   -- Strip_Suffix --
2911
   ------------------
2912
 
2913
   function Strip_Suffix (Name : File_Name_Type) return File_Name_Type is
2914
   begin
2915
      Get_Name_String (Name);
2916
 
2917
      for J in reverse 2 .. Name_Len loop
2918
 
2919
         --  If we found the last '.', return part of Name that precedes it
2920
 
2921
         if Name_Buffer (J) = '.' then
2922
            Name_Len := J - 1;
2923
            return Name_Enter;
2924
         end if;
2925
      end loop;
2926
 
2927
      return Name;
2928
   end Strip_Suffix;
2929
 
2930
   ---------------------------
2931
   -- To_Canonical_Dir_Spec --
2932
   ---------------------------
2933
 
2934
   function To_Canonical_Dir_Spec
2935
     (Host_Dir     : String;
2936
      Prefix_Style : Boolean) return String_Access
2937
   is
2938
      function To_Canonical_Dir_Spec
2939
        (Host_Dir    : Address;
2940
         Prefix_Flag : Integer) return Address;
2941
      pragma Import (C, To_Canonical_Dir_Spec, "__gnat_to_canonical_dir_spec");
2942
 
2943
      C_Host_Dir         : String (1 .. Host_Dir'Length + 1);
2944
      Canonical_Dir_Addr : Address;
2945
      Canonical_Dir_Len  : Integer;
2946
 
2947
   begin
2948
      C_Host_Dir (1 .. Host_Dir'Length) := Host_Dir;
2949
      C_Host_Dir (C_Host_Dir'Last)      := ASCII.NUL;
2950
 
2951
      if Prefix_Style then
2952
         Canonical_Dir_Addr := To_Canonical_Dir_Spec (C_Host_Dir'Address, 1);
2953
      else
2954
         Canonical_Dir_Addr := To_Canonical_Dir_Spec (C_Host_Dir'Address, 0);
2955
      end if;
2956
 
2957
      Canonical_Dir_Len := C_String_Length (Canonical_Dir_Addr);
2958
 
2959
      if Canonical_Dir_Len = 0 then
2960
         return null;
2961
      else
2962
         return To_Path_String_Access (Canonical_Dir_Addr, Canonical_Dir_Len);
2963
      end if;
2964
 
2965
   exception
2966
      when others =>
2967
         Fail ("erroneous directory spec: " & Host_Dir);
2968
         return null;
2969
   end To_Canonical_Dir_Spec;
2970
 
2971
   ---------------------------
2972
   -- To_Canonical_File_List --
2973
   ---------------------------
2974
 
2975
   function To_Canonical_File_List
2976
     (Wildcard_Host_File : String;
2977
      Only_Dirs          : Boolean) return String_Access_List_Access
2978
   is
2979
      function To_Canonical_File_List_Init
2980
        (Host_File : Address;
2981
         Only_Dirs : Integer) return Integer;
2982
      pragma Import (C, To_Canonical_File_List_Init,
2983
                     "__gnat_to_canonical_file_list_init");
2984
 
2985
      function To_Canonical_File_List_Next return Address;
2986
      pragma Import (C, To_Canonical_File_List_Next,
2987
                     "__gnat_to_canonical_file_list_next");
2988
 
2989
      procedure To_Canonical_File_List_Free;
2990
      pragma Import (C, To_Canonical_File_List_Free,
2991
                     "__gnat_to_canonical_file_list_free");
2992
 
2993
      Num_Files            : Integer;
2994
      C_Wildcard_Host_File : String (1 .. Wildcard_Host_File'Length + 1);
2995
 
2996
   begin
2997
      C_Wildcard_Host_File (1 .. Wildcard_Host_File'Length) :=
2998
        Wildcard_Host_File;
2999
      C_Wildcard_Host_File (C_Wildcard_Host_File'Last) := ASCII.NUL;
3000
 
3001
      --  Do the expansion and say how many there are
3002
 
3003
      Num_Files := To_Canonical_File_List_Init
3004
         (C_Wildcard_Host_File'Address, Boolean'Pos (Only_Dirs));
3005
 
3006
      declare
3007
         Canonical_File_List : String_Access_List (1 .. Num_Files);
3008
         Canonical_File_Addr : Address;
3009
         Canonical_File_Len  : Integer;
3010
 
3011
      begin
3012
         --  Retrieve the expanded directory names and build the list
3013
 
3014
         for J in 1 .. Num_Files loop
3015
            Canonical_File_Addr := To_Canonical_File_List_Next;
3016
            Canonical_File_Len  := C_String_Length (Canonical_File_Addr);
3017
            Canonical_File_List (J) := To_Path_String_Access
3018
                  (Canonical_File_Addr, Canonical_File_Len);
3019
         end loop;
3020
 
3021
         --  Free up the storage
3022
 
3023
         To_Canonical_File_List_Free;
3024
 
3025
         return new String_Access_List'(Canonical_File_List);
3026
      end;
3027
   end To_Canonical_File_List;
3028
 
3029
   ----------------------------
3030
   -- To_Canonical_File_Spec --
3031
   ----------------------------
3032
 
3033
   function To_Canonical_File_Spec
3034
     (Host_File : String) return String_Access
3035
   is
3036
      function To_Canonical_File_Spec (Host_File : Address) return Address;
3037
      pragma Import
3038
        (C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec");
3039
 
3040
      C_Host_File         : String (1 .. Host_File'Length + 1);
3041
      Canonical_File_Addr : Address;
3042
      Canonical_File_Len  : Integer;
3043
 
3044
   begin
3045
      C_Host_File (1 .. Host_File'Length) := Host_File;
3046
      C_Host_File (C_Host_File'Last)      := ASCII.NUL;
3047
 
3048
      Canonical_File_Addr := To_Canonical_File_Spec (C_Host_File'Address);
3049
      Canonical_File_Len  := C_String_Length (Canonical_File_Addr);
3050
 
3051
      if Canonical_File_Len = 0 then
3052
         return null;
3053
      else
3054
         return To_Path_String_Access
3055
                  (Canonical_File_Addr, Canonical_File_Len);
3056
      end if;
3057
 
3058
   exception
3059
      when others =>
3060
         Fail ("erroneous file spec: " & Host_File);
3061
         return null;
3062
   end To_Canonical_File_Spec;
3063
 
3064
   ----------------------------
3065
   -- To_Canonical_Path_Spec --
3066
   ----------------------------
3067
 
3068
   function To_Canonical_Path_Spec
3069
     (Host_Path : String) return String_Access
3070
   is
3071
      function To_Canonical_Path_Spec (Host_Path : Address) return Address;
3072
      pragma Import
3073
        (C, To_Canonical_Path_Spec, "__gnat_to_canonical_path_spec");
3074
 
3075
      C_Host_Path         : String (1 .. Host_Path'Length + 1);
3076
      Canonical_Path_Addr : Address;
3077
      Canonical_Path_Len  : Integer;
3078
 
3079
   begin
3080
      C_Host_Path (1 .. Host_Path'Length) := Host_Path;
3081
      C_Host_Path (C_Host_Path'Last)      := ASCII.NUL;
3082
 
3083
      Canonical_Path_Addr := To_Canonical_Path_Spec (C_Host_Path'Address);
3084
      Canonical_Path_Len  := C_String_Length (Canonical_Path_Addr);
3085
 
3086
      --  Return a null string (vice a null) for zero length paths, for
3087
      --  compatibility with getenv().
3088
 
3089
      return To_Path_String_Access (Canonical_Path_Addr, Canonical_Path_Len);
3090
 
3091
   exception
3092
      when others =>
3093
         Fail ("erroneous path spec: " & Host_Path);
3094
         return null;
3095
   end To_Canonical_Path_Spec;
3096
 
3097
   ---------------------------
3098
   -- To_Host_Dir_Spec --
3099
   ---------------------------
3100
 
3101
   function To_Host_Dir_Spec
3102
     (Canonical_Dir : String;
3103
      Prefix_Style  : Boolean) return String_Access
3104
   is
3105
      function To_Host_Dir_Spec
3106
        (Canonical_Dir : Address;
3107
         Prefix_Flag   : Integer) return Address;
3108
      pragma Import (C, To_Host_Dir_Spec, "__gnat_to_host_dir_spec");
3109
 
3110
      C_Canonical_Dir : String (1 .. Canonical_Dir'Length + 1);
3111
      Host_Dir_Addr   : Address;
3112
      Host_Dir_Len    : Integer;
3113
 
3114
   begin
3115
      C_Canonical_Dir (1 .. Canonical_Dir'Length) := Canonical_Dir;
3116
      C_Canonical_Dir (C_Canonical_Dir'Last)      := ASCII.NUL;
3117
 
3118
      if Prefix_Style then
3119
         Host_Dir_Addr := To_Host_Dir_Spec (C_Canonical_Dir'Address, 1);
3120
      else
3121
         Host_Dir_Addr := To_Host_Dir_Spec (C_Canonical_Dir'Address, 0);
3122
      end if;
3123
      Host_Dir_Len := C_String_Length (Host_Dir_Addr);
3124
 
3125
      if Host_Dir_Len = 0 then
3126
         return null;
3127
      else
3128
         return To_Path_String_Access (Host_Dir_Addr, Host_Dir_Len);
3129
      end if;
3130
   end To_Host_Dir_Spec;
3131
 
3132
   ----------------------------
3133
   -- To_Host_File_Spec --
3134
   ----------------------------
3135
 
3136
   function To_Host_File_Spec
3137
     (Canonical_File : String) return String_Access
3138
   is
3139
      function To_Host_File_Spec (Canonical_File : Address) return Address;
3140
      pragma Import (C, To_Host_File_Spec, "__gnat_to_host_file_spec");
3141
 
3142
      C_Canonical_File      : String (1 .. Canonical_File'Length + 1);
3143
      Host_File_Addr : Address;
3144
      Host_File_Len  : Integer;
3145
 
3146
   begin
3147
      C_Canonical_File (1 .. Canonical_File'Length) := Canonical_File;
3148
      C_Canonical_File (C_Canonical_File'Last)      := ASCII.NUL;
3149
 
3150
      Host_File_Addr := To_Host_File_Spec (C_Canonical_File'Address);
3151
      Host_File_Len  := C_String_Length (Host_File_Addr);
3152
 
3153
      if Host_File_Len = 0 then
3154
         return null;
3155
      else
3156
         return To_Path_String_Access
3157
                  (Host_File_Addr, Host_File_Len);
3158
      end if;
3159
   end To_Host_File_Spec;
3160
 
3161
   ---------------------------
3162
   -- To_Path_String_Access --
3163
   ---------------------------
3164
 
3165
   function To_Path_String_Access
3166
     (Path_Addr : Address;
3167
      Path_Len  : Integer) return String_Access
3168
   is
3169
      subtype Path_String is String (1 .. Path_Len);
3170
      type Path_String_Access is access Path_String;
3171
 
3172
      function Address_To_Access is new
3173
        Unchecked_Conversion (Source => Address,
3174
                              Target => Path_String_Access);
3175
 
3176
      Path_Access : constant Path_String_Access :=
3177
                      Address_To_Access (Path_Addr);
3178
 
3179
      Return_Val : String_Access;
3180
 
3181
   begin
3182
      Return_Val := new String (1 .. Path_Len);
3183
 
3184
      for J in 1 .. Path_Len loop
3185
         Return_Val (J) := Path_Access (J);
3186
      end loop;
3187
 
3188
      return Return_Val;
3189
   end To_Path_String_Access;
3190
 
3191
   -----------------
3192
   -- Update_Path --
3193
   -----------------
3194
 
3195
   function Update_Path (Path : String_Ptr) return String_Ptr is
3196
 
3197
      function C_Update_Path (Path, Component : Address) return Address;
3198
      pragma Import (C, C_Update_Path, "update_path");
3199
 
3200
      function Strlen (Str : Address) return Integer;
3201
      pragma Import (C, Strlen, "strlen");
3202
 
3203
      procedure Strncpy (X : Address; Y : Address; Length : Integer);
3204
      pragma Import (C, Strncpy, "strncpy");
3205
 
3206
      In_Length      : constant Integer := Path'Length;
3207
      In_String      : String (1 .. In_Length + 1);
3208
      Component_Name : aliased String := "GCC" & ASCII.NUL;
3209
      Result_Ptr     : Address;
3210
      Result_Length  : Integer;
3211
      Out_String     : String_Ptr;
3212
 
3213
   begin
3214
      In_String (1 .. In_Length) := Path.all;
3215
      In_String (In_Length + 1) := ASCII.NUL;
3216
      Result_Ptr := C_Update_Path (In_String'Address, Component_Name'Address);
3217
      Result_Length := Strlen (Result_Ptr);
3218
 
3219
      Out_String := new String (1 .. Result_Length);
3220
      Strncpy (Out_String.all'Address, Result_Ptr, Result_Length);
3221
      return Out_String;
3222
   end Update_Path;
3223
 
3224
   ----------------
3225
   -- Write_Info --
3226
   ----------------
3227
 
3228
   procedure Write_Info (Info : String) is
3229
   begin
3230
      Write_With_Check (Info'Address, Info'Length);
3231
      Write_With_Check (EOL'Address, 1);
3232
   end Write_Info;
3233
 
3234
   ------------------------
3235
   -- Write_Program_Name --
3236
   ------------------------
3237
 
3238
   procedure Write_Program_Name is
3239
      Save_Buffer : constant String (1 .. Name_Len) :=
3240
                      Name_Buffer (1 .. Name_Len);
3241
 
3242
   begin
3243
      Find_Program_Name;
3244
 
3245
      --  Convert the name to lower case so error messages are the same on
3246
      --  all systems.
3247
 
3248
      for J in 1 .. Name_Len loop
3249
         if Name_Buffer (J) in 'A' .. 'Z' then
3250
            Name_Buffer (J) :=
3251
              Character'Val (Character'Pos (Name_Buffer (J)) + 32);
3252
         end if;
3253
      end loop;
3254
 
3255
      Write_Str (Name_Buffer (1 .. Name_Len));
3256
 
3257
      --  Restore Name_Buffer which was clobbered by the call to
3258
      --  Find_Program_Name
3259
 
3260
      Name_Len := Save_Buffer'Last;
3261
      Name_Buffer (1 .. Name_Len) := Save_Buffer;
3262
   end Write_Program_Name;
3263
 
3264
   ----------------------
3265
   -- Write_With_Check --
3266
   ----------------------
3267
 
3268
   procedure Write_With_Check (A  : Address; N  : Integer) is
3269
      Ignore : Boolean;
3270
      pragma Warnings (Off, Ignore);
3271
 
3272
   begin
3273
      if N = Write (Output_FD, A, N) then
3274
         return;
3275
 
3276
      else
3277
         Write_Str ("error: disk full writing ");
3278
         Write_Name_Decoded (Output_File_Name);
3279
         Write_Eol;
3280
         Name_Len := Name_Len + 1;
3281
         Name_Buffer (Name_Len) := ASCII.NUL;
3282
         Delete_File (Name_Buffer'Address, Ignore);
3283
         Exit_Program (E_Fatal);
3284
      end if;
3285
   end Write_With_Check;
3286
 
3287
----------------------------
3288
-- Package Initialization --
3289
----------------------------
3290
 
3291
   procedure Reset_File_Attributes (Attr : System.Address);
3292
   pragma Import (C, Reset_File_Attributes, "__gnat_reset_attributes");
3293
 
3294
begin
3295
   Initialization : declare
3296
 
3297
      function Get_Default_Identifier_Character_Set return Character;
3298
      pragma Import (C, Get_Default_Identifier_Character_Set,
3299
                       "__gnat_get_default_identifier_character_set");
3300
      --  Function to determine the default identifier character set,
3301
      --  which is system dependent. See Opt package spec for a list of
3302
      --  the possible character codes and their interpretations.
3303
 
3304
      function Get_Maximum_File_Name_Length return Int;
3305
      pragma Import (C, Get_Maximum_File_Name_Length,
3306
                    "__gnat_get_maximum_file_name_length");
3307
      --  Function to get maximum file name length for system
3308
 
3309
      Sizeof_File_Attributes : Integer;
3310
      pragma Import (C, Sizeof_File_Attributes,
3311
                     "__gnat_size_of_file_attributes");
3312
 
3313
   begin
3314
      pragma Assert (Sizeof_File_Attributes <= File_Attributes_Size);
3315
 
3316
      Reset_File_Attributes (Unknown_Attributes'Address);
3317
 
3318
      Identifier_Character_Set := Get_Default_Identifier_Character_Set;
3319
      Maximum_File_Name_Length := Get_Maximum_File_Name_Length;
3320
 
3321
      --  Following should be removed by having above function return
3322
      --  Integer'Last as indication of no maximum instead of -1 ???
3323
 
3324
      if Maximum_File_Name_Length = -1 then
3325
         Maximum_File_Name_Length := Int'Last;
3326
      end if;
3327
 
3328
      Src_Search_Directories.Set_Last (Primary_Directory);
3329
      Src_Search_Directories.Table (Primary_Directory) := new String'("");
3330
 
3331
      Lib_Search_Directories.Set_Last (Primary_Directory);
3332
      Lib_Search_Directories.Table (Primary_Directory) := new String'("");
3333
 
3334
      Osint.Initialize;
3335
   end Initialization;
3336
 
3337
end Osint;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.