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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [mlib.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
--                                 M L I B                                  --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--                     Copyright (C) 1999-2009, AdaCore                     --
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 Ada.Characters.Handling; use Ada.Characters.Handling;
27
with Interfaces.C.Strings;
28
with System;
29
 
30
with Hostparm;
31
with Opt;
32
with Output; use Output;
33
 
34
with MLib.Utl; use MLib.Utl;
35
 
36
with Prj.Com;
37
 
38
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
39
 
40
package body MLib is
41
 
42
   -------------------
43
   -- Build_Library --
44
   -------------------
45
 
46
   procedure Build_Library
47
     (Ofiles      : Argument_List;
48
      Output_File : String;
49
      Output_Dir  : String)
50
   is
51
   begin
52
      if Opt.Verbose_Mode and not Opt.Quiet_Output then
53
         Write_Line ("building a library...");
54
         Write_Str  ("   make ");
55
         Write_Line (Output_File);
56
      end if;
57
 
58
      Ar (Output_Dir &
59
          "lib" & Output_File & ".a", Objects => Ofiles);
60
   end Build_Library;
61
 
62
   ------------------------
63
   -- Check_Library_Name --
64
   ------------------------
65
 
66
   procedure Check_Library_Name (Name : String) is
67
   begin
68
      if Name'Length = 0 then
69
         Prj.Com.Fail ("library name cannot be empty");
70
      end if;
71
 
72
      if Name'Length > Max_Characters_In_Library_Name then
73
         Prj.Com.Fail ("illegal library name """
74
                       & Name
75
                       & """: too long");
76
      end if;
77
 
78
      if not Is_Letter (Name (Name'First)) then
79
         Prj.Com.Fail ("illegal library name """
80
                       & Name
81
                       & """: should start with a letter");
82
      end if;
83
 
84
      for Index in Name'Range loop
85
         if not Is_Alphanumeric (Name (Index)) then
86
            Prj.Com.Fail ("illegal library name """
87
                          & Name
88
                          & """: should include only letters and digits");
89
         end if;
90
      end loop;
91
   end Check_Library_Name;
92
 
93
   --------------------
94
   -- Copy_ALI_Files --
95
   --------------------
96
 
97
   procedure Copy_ALI_Files
98
     (Files      : Argument_List;
99
      To         : Path_Name_Type;
100
      Interfaces : String_List)
101
   is
102
      Success      : Boolean := False;
103
      To_Dir       : constant String := Get_Name_String (To);
104
      Is_Interface : Boolean := False;
105
 
106
      procedure Verbose_Copy (Index : Positive);
107
      --  In verbose mode, output a message that the indexed file is copied
108
      --  to the destination directory.
109
 
110
      ------------------
111
      -- Verbose_Copy --
112
      ------------------
113
 
114
      procedure Verbose_Copy (Index : Positive) is
115
      begin
116
         if Opt.Verbose_Mode then
117
            Write_Str ("Copying """);
118
            Write_Str (Files (Index).all);
119
            Write_Str (""" to """);
120
            Write_Str (To_Dir);
121
            Write_Line ("""");
122
         end if;
123
      end Verbose_Copy;
124
 
125
   --  Start of processing for Copy_ALI_Files
126
 
127
   begin
128
      if Interfaces'Length = 0 then
129
 
130
         --  If there are no Interfaces, copy all the ALI files as is
131
 
132
         for Index in Files'Range loop
133
            Verbose_Copy (Index);
134
            Set_Writable
135
              (To_Dir &
136
               Directory_Separator &
137
               Base_Name (Files (Index).all));
138
            Copy_File
139
              (Files (Index).all,
140
               To_Dir,
141
               Success,
142
               Mode => Overwrite,
143
               Preserve => Preserve);
144
 
145
            exit when not Success;
146
         end loop;
147
 
148
      else
149
         --  Copy only the interface ALI file, and put the special indicator
150
         --  "SL" on the P line.
151
 
152
         for Index in Files'Range loop
153
 
154
            declare
155
               File_Name : String := Base_Name (Files (Index).all);
156
 
157
            begin
158
               Canonical_Case_File_Name (File_Name);
159
 
160
               --  Check if this is one of the interface ALIs
161
 
162
               Is_Interface := False;
163
 
164
               for Index in Interfaces'Range loop
165
                  if File_Name = Interfaces (Index).all then
166
                     Is_Interface := True;
167
                     exit;
168
                  end if;
169
               end loop;
170
 
171
               --  If it is an interface ALI, copy line by line. Insert
172
               --  the interface indication at the end of the P line.
173
               --  Do not copy ALI files that are not Interfaces.
174
 
175
               if Is_Interface then
176
                  Success := False;
177
                  Verbose_Copy (Index);
178
                  Set_Writable
179
                    (To_Dir &
180
                     Directory_Separator &
181
                     Base_Name (Files (Index).all));
182
 
183
                  declare
184
                     FD           : File_Descriptor;
185
                     Len          : Integer;
186
                     Actual_Len   : Integer;
187
                     S            : String_Access;
188
                     Curr         : Natural;
189
                     P_Line_Found : Boolean;
190
                     Status       : Boolean;
191
 
192
                  begin
193
                     --  Open the file
194
 
195
                     Name_Len := Files (Index)'Length;
196
                     Name_Buffer (1 .. Name_Len) := Files (Index).all;
197
                     Name_Len := Name_Len + 1;
198
                     Name_Buffer (Name_Len) := ASCII.NUL;
199
 
200
                     FD := Open_Read (Name_Buffer'Address, Binary);
201
 
202
                     if FD /= Invalid_FD then
203
                        Len := Integer (File_Length (FD));
204
 
205
                        --  ??? Why "+3" here
206
 
207
                        S := new String (1 .. Len + 3);
208
 
209
                        --  Read the file. Note that the loop is not necessary
210
                        --  since the whole file is read at once except on VMS.
211
 
212
                        Curr := S'First;
213
                        while Curr <= Len loop
214
                           Actual_Len := Read (FD, S (Curr)'Address, Len);
215
 
216
                           --  Exit if we could not read for some reason
217
 
218
                           exit when Actual_Len = 0;
219
 
220
                           Curr := Curr + Actual_Len;
221
                        end loop;
222
 
223
                        --  We are done with the input file, so we close it
224
                        --  ignoring any bad status.
225
 
226
                        Close (FD, Status);
227
 
228
                        P_Line_Found := False;
229
 
230
                        --  Look for the P line. When found, add marker SL
231
                        --  at the beginning of the P line.
232
 
233
                        for Index in 1 .. Len - 3 loop
234
                           if (S (Index) = ASCII.LF
235
                                 or else
236
                               S (Index) = ASCII.CR)
237
                             and then S (Index + 1) = 'P'
238
                           then
239
                              S (Index + 5 .. Len + 3) := S (Index + 2 .. Len);
240
                              S (Index + 2 .. Index + 4) := " SL";
241
                              P_Line_Found := True;
242
                              exit;
243
                           end if;
244
                        end loop;
245
 
246
                        if P_Line_Found then
247
 
248
                           --  Create new modified ALI file
249
 
250
                           Name_Len := To_Dir'Length;
251
                           Name_Buffer (1 .. Name_Len) := To_Dir;
252
                           Name_Len := Name_Len + 1;
253
                           Name_Buffer (Name_Len) := Directory_Separator;
254
                           Name_Buffer
255
                             (Name_Len + 1 .. Name_Len + File_Name'Length) :=
256
                                File_Name;
257
                           Name_Len := Name_Len + File_Name'Length + 1;
258
                           Name_Buffer (Name_Len) := ASCII.NUL;
259
 
260
                           FD := Create_File (Name_Buffer'Address, Binary);
261
 
262
                           --  Write the modified text and close the newly
263
                           --  created file.
264
 
265
                           if FD /= Invalid_FD then
266
                              Actual_Len := Write (FD, S (1)'Address, Len + 3);
267
 
268
                              Close (FD, Status);
269
 
270
                              --  Set Success to True only if the newly
271
                              --  created file has been correctly written.
272
 
273
                              Success := Status and then Actual_Len = Len + 3;
274
 
275
                              if Success then
276
 
277
                                 --  Set_Read_Only is used here, rather than
278
                                 --  Set_Non_Writable, so that gprbuild can
279
                                 --  he compiled with older compilers.
280
 
281
                                 Set_Read_Only
282
                                   (Name_Buffer (1 .. Name_Len - 1));
283
                              end if;
284
                           end if;
285
                        end if;
286
                     end if;
287
                  end;
288
 
289
               --  This is not an interface ALI
290
 
291
               else
292
                  Success := True;
293
               end if;
294
            end;
295
 
296
            if not Success then
297
               Prj.Com.Fail ("could not copy ALI files to library dir");
298
            end if;
299
         end loop;
300
      end if;
301
   end Copy_ALI_Files;
302
 
303
   ----------------------
304
   -- Create_Sym_Links --
305
   ----------------------
306
 
307
   procedure Create_Sym_Links
308
     (Lib_Path    : String;
309
      Lib_Version : String;
310
      Lib_Dir     : String;
311
      Maj_Version : String)
312
   is
313
      function Symlink
314
        (Oldpath : System.Address;
315
         Newpath : System.Address) return Integer;
316
      pragma Import (C, Symlink, "__gnat_symlink");
317
 
318
      Version_Path : String_Access;
319
 
320
      Success : Boolean;
321
      Result  : Integer;
322
      pragma Unreferenced (Success, Result);
323
 
324
   begin
325
      Version_Path := new String (1 .. Lib_Version'Length + 1);
326
      Version_Path (1 .. Lib_Version'Length) := Lib_Version;
327
      Version_Path (Version_Path'Last)       := ASCII.NUL;
328
 
329
      if Maj_Version'Length = 0 then
330
         declare
331
            Newpath : String (1 .. Lib_Path'Length + 1);
332
         begin
333
            Newpath (1 .. Lib_Path'Length) := Lib_Path;
334
            Newpath (Newpath'Last)         := ASCII.NUL;
335
            Delete_File (Lib_Path, Success);
336
            Result := Symlink (Version_Path (1)'Address, Newpath'Address);
337
         end;
338
 
339
      else
340
         declare
341
            Newpath1 : String (1 .. Lib_Path'Length + 1);
342
            Maj_Path : constant String :=
343
                         Lib_Dir & Directory_Separator & Maj_Version;
344
            Newpath2 : String (1 .. Maj_Path'Length + 1);
345
            Maj_Ver  : String (1 .. Maj_Version'Length + 1);
346
 
347
         begin
348
            Newpath1 (1 .. Lib_Path'Length) := Lib_Path;
349
            Newpath1 (Newpath1'Last)        := ASCII.NUL;
350
 
351
            Newpath2 (1 .. Maj_Path'Length) := Maj_Path;
352
            Newpath2 (Newpath2'Last)        := ASCII.NUL;
353
 
354
            Maj_Ver (1 .. Maj_Version'Length) := Maj_Version;
355
            Maj_Ver (Maj_Ver'Last)            := ASCII.NUL;
356
 
357
            Delete_File (Maj_Path, Success);
358
 
359
            Result := Symlink (Version_Path (1)'Address, Newpath2'Address);
360
 
361
            Delete_File (Lib_Path, Success);
362
 
363
            Result := Symlink (Maj_Ver'Address, Newpath1'Address);
364
         end;
365
      end if;
366
   end Create_Sym_Links;
367
 
368
   --------------------------------
369
   -- Linker_Library_Path_Option --
370
   --------------------------------
371
 
372
   function Linker_Library_Path_Option return String_Access is
373
 
374
      Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr;
375
      pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option");
376
      --  Pointer to string representing the native linker option which
377
      --  specifies the path where the dynamic loader should find shared
378
      --  libraries. Equal to null string if this system doesn't support it.
379
 
380
      S : constant String := Interfaces.C.Strings.Value (Run_Path_Option_Ptr);
381
 
382
   begin
383
      if S'Length = 0 then
384
         return null;
385
      else
386
         return new String'(S);
387
      end if;
388
   end Linker_Library_Path_Option;
389
 
390
   -------------------
391
   -- Major_Id_Name --
392
   -------------------
393
 
394
   function Major_Id_Name
395
     (Lib_Filename : String;
396
      Lib_Version  : String)
397
      return String
398
   is
399
      Maj_Version : constant String := Lib_Version;
400
      Last_Maj    : Positive;
401
      Last        : Positive;
402
      Ok_Maj      : Boolean := False;
403
 
404
   begin
405
      Last_Maj := Maj_Version'Last;
406
      while Last_Maj > Maj_Version'First loop
407
         if Maj_Version (Last_Maj) in '0' .. '9' then
408
            Last_Maj := Last_Maj - 1;
409
 
410
         else
411
            Ok_Maj := Last_Maj /= Maj_Version'Last and then
412
            Maj_Version (Last_Maj) = '.';
413
 
414
            if Ok_Maj then
415
               Last_Maj := Last_Maj - 1;
416
            end if;
417
 
418
            exit;
419
         end if;
420
      end loop;
421
 
422
      if Ok_Maj then
423
         Last := Last_Maj;
424
         while Last > Maj_Version'First loop
425
            if Maj_Version (Last) in '0' .. '9' then
426
               Last := Last - 1;
427
 
428
            else
429
               Ok_Maj := Last /= Last_Maj and then
430
               Maj_Version (Last) = '.';
431
 
432
               if Ok_Maj then
433
                  Last := Last - 1;
434
                  Ok_Maj :=
435
                    Maj_Version (Maj_Version'First .. Last) = Lib_Filename;
436
               end if;
437
 
438
               exit;
439
            end if;
440
         end loop;
441
      end if;
442
 
443
      if Ok_Maj then
444
         return Maj_Version (Maj_Version'First .. Last_Maj);
445
      else
446
         return "";
447
      end if;
448
   end Major_Id_Name;
449
 
450
   -------------------------------
451
   -- Separate_Run_Path_Options --
452
   -------------------------------
453
 
454
   function Separate_Run_Path_Options return Boolean is
455
      Separate_Paths : Boolean;
456
      for Separate_Paths'Size use Character'Size;
457
      pragma Import (C, Separate_Paths, "__gnat_separate_run_path_options");
458
   begin
459
      return Separate_Paths;
460
   end Separate_Run_Path_Options;
461
 
462
--  Package elaboration
463
 
464
begin
465
   --  Copy_Attributes always fails on VMS
466
 
467
   if Hostparm.OpenVMS then
468
      Preserve := None;
469
   end if;
470
end MLib;

powered by: WebSVN 2.1.0

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