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;