1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
9 -- Copyright (C) 1999-2001 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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
;
28 with Output
; use Output
;
29 with Sinput
; use Sinput
;
30 with Sinput
.L
; use Sinput
.L
;
31 with Types
; use Types
;
33 package body Targparm
is
37 BDC
, -- Backend_Divide_Checks;
38 BOC
, -- Backend_Overflow_Checks;
39 CLA
, -- Command_Line_Args;
41 DSP
, -- Functions_Return_By_DSP;
42 FEL
, -- Frontend_Layout;
43 FFO
, -- Fractional_Fixed_Ops
44 HIM
, -- High_Integrity_Mode;
45 LSI
, -- Long_Shifts_Inlined;
46 MOV
, -- Machine_Overflows;
47 MRN
, -- Machine_Rounds;
48 SCD
, -- Stack_Check_Default;
49 SCP
, -- Stack_Check_Probes;
51 UAM
, -- Use_Ada_Main_Program_Name;
53 ZCD
, -- ZCX_By_Default;
54 ZCG
, -- GCC_ZCX_Support;
55 ZCF
); -- Front_End_ZCX_Support;
57 Targparm_Flags
: array (Targparm_Tags
) of Boolean := (others => False);
58 -- Flag is set True if corresponding parameter is scanned
60 AAM_Str
: aliased constant Source_Buffer
:= "AAMP";
61 BDC_Str
: aliased constant Source_Buffer
:= "Backend_Divide_Checks";
62 BOC_Str
: aliased constant Source_Buffer
:= "Backend_Overflow_Checks";
63 CLA_Str
: aliased constant Source_Buffer
:= "Command_Line_Args";
64 DEN_Str
: aliased constant Source_Buffer
:= "Denorm";
65 DSP_Str
: aliased constant Source_Buffer
:= "Functions_Return_By_DSP";
66 FEL_Str
: aliased constant Source_Buffer
:= "Frontend_Layout";
67 FFO_Str
: aliased constant Source_Buffer
:= "Fractional_Fixed_Ops";
68 HIM_Str
: aliased constant Source_Buffer
:= "High_Integrity_Mode";
69 LSI_Str
: aliased constant Source_Buffer
:= "Long_Shifts_Inlined";
70 MOV_Str
: aliased constant Source_Buffer
:= "Machine_Overflows";
71 MRN_Str
: aliased constant Source_Buffer
:= "Machine_Rounds";
72 SCD_Str
: aliased constant Source_Buffer
:= "Stack_Check_Default";
73 SCP_Str
: aliased constant Source_Buffer
:= "Stack_Check_Probes";
74 SNZ_Str
: aliased constant Source_Buffer
:= "Signed_Zeros";
75 UAM_Str
: aliased constant Source_Buffer
:= "Use_Ada_Main_Program_Name";
76 VMS_Str
: aliased constant Source_Buffer
:= "OpenVMS";
77 ZCD_Str
: aliased constant Source_Buffer
:= "ZCX_By_Default";
78 ZCG_Str
: aliased constant Source_Buffer
:= "GCC_ZCX_Support";
79 ZCF_Str
: aliased constant Source_Buffer
:= "Front_End_ZCX_Support";
81 type Buffer_Ptr
is access constant Source_Buffer
;
82 Targparm_Str
: array (Targparm_Tags
) of Buffer_Ptr
:=
104 ---------------------------
105 -- Get_Target_Parameters --
106 ---------------------------
108 procedure Get_Target_Parameters
is
111 S
: Source_File_Index
;
113 T
: Source_Buffer_Ptr
;
117 Fatal
: Boolean := False;
118 -- Set True if a fatal error is detected
121 -- Records boolean from system line
124 Name_Buffer
(1 .. 10) := "system.ads";
127 S
:= Load_Source_File
(N
);
129 if S
= No_Source_File
then
130 Write_Line
("fatal error, run-time library not installed correctly");
131 Write_Str
("cannot locate file ");
132 Write_Line
(Name_Buffer
(1 .. Name_Len
));
133 raise Unrecoverable_Error
;
135 -- This must always be the first source file read, and we have defined
136 -- a constant Types.System_Source_File_Index as 1 to reflect this.
139 pragma Assert
(S
= System_Source_File_Index
);
143 P
:= Source_First
(S
);
144 Z
:= Source_Last
(S
);
145 T
:= Source_Text
(S
);
147 while T
(P
.. P
+ 10) /= "end System;" loop
149 for K
in Targparm_Tags
loop
150 if T
(P
+ 3 .. P
+ 2 + Targparm_Str
(K
)'Length) =
153 P
:= P
+ 3 + Targparm_Str
(K
)'Length;
155 if Targparm_Flags
(K
) then
158 ("fatal error: system.ads is incorrectly formatted");
159 Write_Str
("duplicate line for parameter: ");
161 for J
in Targparm_Str
(K
)'Range loop
162 Write_Char
(Targparm_Str
(K
).all (J
));
170 Targparm_Flags
(K
) := True;
173 while T
(P
) /= ':' or else T
(P
+ 1) /= '=' loop
179 while T
(P
) = ' ' loop
183 Result
:= (T
(P
) = 'T');
186 when AAM
=> AAMP_On_Target
:= Result
;
187 when BDC
=> Backend_Divide_Checks_On_Target
:= Result
;
188 when BOC
=> Backend_Overflow_Checks_On_Target
:= Result
;
189 when CLA
=> Command_Line_Args_On_Target
:= Result
;
190 when DEN
=> Denorm_On_Target
:= Result
;
191 when DSP
=> Functions_Return_By_DSP_On_Target
:= Result
;
192 when FEL
=> Frontend_Layout_On_Target
:= Result
;
193 when FFO
=> Fractional_Fixed_Ops_On_Target
:= Result
;
194 when HIM
=> High_Integrity_Mode_On_Target
:= Result
;
195 when LSI
=> Long_Shifts_Inlined_On_Target
:= Result
;
196 when MOV
=> Machine_Overflows_On_Target
:= Result
;
197 when MRN
=> Machine_Rounds_On_Target
:= Result
;
198 when SCD
=> Stack_Check_Default_On_Target
:= Result
;
199 when SCP
=> Stack_Check_Probes_On_Target
:= Result
;
200 when SNZ
=> Signed_Zeros_On_Target
:= Result
;
201 when UAM
=> Use_Ada_Main_Program_Name_On_Target
:= Result
;
202 when VMS
=> OpenVMS_On_Target
:= Result
;
203 when ZCD
=> ZCX_By_Default_On_Target
:= Result
;
204 when ZCG
=> GCC_ZCX_Support_On_Target
:= Result
;
205 when ZCF
=> Front_End_ZCX_Support_On_Target
:= Result
;
212 while T
(P
) /= CR
and then T
(P
) /= LF
loop
217 while T
(P
) = CR
or else T
(P
) = LF
loop
224 Write_Line
("fatal error, system.ads not formatted correctly");
226 raise Unrecoverable_Error
;
230 for K
in Targparm_Tags
loop
231 if not Targparm_Flags
(K
) then
234 ("fatal error: system.ads is incorrectly formatted");
235 Write_Str
("missing line for parameter: ");
237 for J
in Targparm_Str
(K
)'Range loop
238 Write_Char
(Targparm_Str
(K
).all (J
));
248 raise Unrecoverable_Error
;
250 end Get_Target_Parameters
;