1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2006 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Namet
; use Namet
;
29 with Targparm
; use Targparm
;
31 package body Osint
.B
is
33 -------------------------
34 -- Close_Binder_Output --
35 -------------------------
37 procedure Close_Binder_Output
is
40 Close
(Output_FD
, Status
);
44 ("error while closing generated file ",
45 Get_Name_String
(Output_File_Name
));
48 end Close_Binder_Output
;
50 --------------------------
51 -- Create_Binder_Output --
52 --------------------------
54 procedure Create_Binder_Output
55 (Output_File_Name
: String;
59 File_Name
: String_Ptr
;
64 Bind_File_Prefix_Len
: Natural := 2;
65 -- Length of binder file prefix (normally set to 2 for b~, but gets
66 -- reset to 3 for VMS for b__).
69 if Output_File_Name
/= "" then
70 Name_Buffer
(Output_File_Name
'Range) := Output_File_Name
;
71 Name_Buffer
(Output_File_Name
'Last + 1) := ASCII
.NUL
;
74 Name_Buffer
(Output_File_Name
'Last) := 's';
77 Name_Len
:= Output_File_Name
'Last;
80 Name_Buffer
(1) := 'b';
81 File_Name
:= File_Names
(Current_File_Name_Index
);
83 Findex1
:= File_Name
'First;
85 -- The ali file might be specified by a full path name. However,
86 -- the binder generated file should always be created in the
87 -- current directory, so the path might need to be stripped away.
88 -- In addition to the default directory_separator allow the '/' to
89 -- act as separator since this is allowed in MS-DOS and OS2 ports.
91 for J
in reverse File_Name
'Range loop
92 if File_Name
(J
) = Directory_Separator
93 or else File_Name
(J
) = '/'
100 Findex2
:= File_Name
'Last;
101 while File_Name
(Findex2
) /= '.' loop
102 Findex2
:= Findex2
- 1;
105 Flength
:= Findex2
- Findex1
;
107 if Maximum_File_Name_Length
> 0 then
109 if OpenVMS_On_Target
and then Typ
/= 'c' then
110 Bind_File_Prefix_Len
:= 3;
113 -- Make room for the extra two characters in "b?"
115 while Int
(Flength
) >
116 Maximum_File_Name_Length
- Nat
(Bind_File_Prefix_Len
)
118 Findex2
:= Findex2
- 1;
119 Flength
:= Findex2
- Findex1
;
124 (Bind_File_Prefix_Len
+ 1 .. Flength
+ Bind_File_Prefix_Len
) :=
125 File_Name
(Findex1
.. Findex2
- 1);
126 Name_Buffer
(Flength
+ Bind_File_Prefix_Len
+ 1) := '.';
128 -- C bind file, name is b_xxx.c
131 Name_Buffer
(2) := '_';
132 Name_Buffer
(Flength
+ 4) := 'c';
133 Name_Buffer
(Flength
+ 5) := ASCII
.NUL
;
134 Name_Len
:= Flength
+ 4;
136 -- Ada bind file, name is b~xxx.adb or b~xxx.ads
137 -- (with __ instead of ~ in VMS)
140 if OpenVMS_On_Target
then
141 Name_Buffer
(2) := '_';
142 Name_Buffer
(3) := '_';
144 Name_Buffer
(2) := '~';
147 Name_Buffer
(Flength
+ Bind_File_Prefix_Len
+ 2) := 'a';
148 Name_Buffer
(Flength
+ Bind_File_Prefix_Len
+ 3) := 'd';
149 Name_Buffer
(Flength
+ Bind_File_Prefix_Len
+ 4) := Typ
;
150 Name_Buffer
(Flength
+ Bind_File_Prefix_Len
+ 5) := ASCII
.NUL
;
151 Name_Len
:= Flength
+ Bind_File_Prefix_Len
+ 4;
157 Create_File_And_Check
(Output_FD
, Text
);
158 end Create_Binder_Output
;
164 function More_Lib_Files
return Boolean renames More_Files
;
166 ------------------------
167 -- Next_Main_Lib_File --
168 ------------------------
170 function Next_Main_Lib_File
return File_Name_Type
renames Next_Main_File
;
172 -----------------------
173 -- Write_Binder_Info --
174 -----------------------
176 procedure Write_Binder_Info
(Info
: String) renames Write_Info
;
179 Set_Program
(Binder
);