6cbcc54138
* xeinfo.adb: Don't look for revision numbers. * xnmake.adb: Likewise. * xsinfo.adb: Likewise. * xsnames.adb: Likewise. * xtreeprs.adb: Likewise. From-SVN: r50768
254 lines
9.8 KiB
Ada
254 lines
9.8 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT RUN-TIME COMPONENTS --
|
|
-- --
|
|
-- T A R G P A R M --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- --
|
|
-- Copyright (C) 1999-2001 Free Software Foundation, Inc. --
|
|
-- --
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
|
-- for more details. You should have received a copy of the GNU General --
|
|
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
|
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
|
|
-- MA 02111-1307, USA. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Namet; use Namet;
|
|
with Output; use Output;
|
|
with Sinput; use Sinput;
|
|
with Sinput.L; use Sinput.L;
|
|
with Types; use Types;
|
|
|
|
package body Targparm is
|
|
|
|
type Targparm_Tags is
|
|
(AAM, -- AAMP;
|
|
BDC, -- Backend_Divide_Checks;
|
|
BOC, -- Backend_Overflow_Checks;
|
|
CLA, -- Command_Line_Args;
|
|
DEN, -- Denorm;
|
|
DSP, -- Functions_Return_By_DSP;
|
|
FEL, -- Frontend_Layout;
|
|
FFO, -- Fractional_Fixed_Ops
|
|
HIM, -- High_Integrity_Mode;
|
|
LSI, -- Long_Shifts_Inlined;
|
|
MOV, -- Machine_Overflows;
|
|
MRN, -- Machine_Rounds;
|
|
SCD, -- Stack_Check_Default;
|
|
SCP, -- Stack_Check_Probes;
|
|
SNZ, -- Signed_Zeros;
|
|
UAM, -- Use_Ada_Main_Program_Name;
|
|
VMS, -- OpenVMS;
|
|
ZCD, -- ZCX_By_Default;
|
|
ZCG, -- GCC_ZCX_Support;
|
|
ZCF); -- Front_End_ZCX_Support;
|
|
|
|
Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
|
|
-- Flag is set True if corresponding parameter is scanned
|
|
|
|
AAM_Str : aliased constant Source_Buffer := "AAMP";
|
|
BDC_Str : aliased constant Source_Buffer := "Backend_Divide_Checks";
|
|
BOC_Str : aliased constant Source_Buffer := "Backend_Overflow_Checks";
|
|
CLA_Str : aliased constant Source_Buffer := "Command_Line_Args";
|
|
DEN_Str : aliased constant Source_Buffer := "Denorm";
|
|
DSP_Str : aliased constant Source_Buffer := "Functions_Return_By_DSP";
|
|
FEL_Str : aliased constant Source_Buffer := "Frontend_Layout";
|
|
FFO_Str : aliased constant Source_Buffer := "Fractional_Fixed_Ops";
|
|
HIM_Str : aliased constant Source_Buffer := "High_Integrity_Mode";
|
|
LSI_Str : aliased constant Source_Buffer := "Long_Shifts_Inlined";
|
|
MOV_Str : aliased constant Source_Buffer := "Machine_Overflows";
|
|
MRN_Str : aliased constant Source_Buffer := "Machine_Rounds";
|
|
SCD_Str : aliased constant Source_Buffer := "Stack_Check_Default";
|
|
SCP_Str : aliased constant Source_Buffer := "Stack_Check_Probes";
|
|
SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros";
|
|
UAM_Str : aliased constant Source_Buffer := "Use_Ada_Main_Program_Name";
|
|
VMS_Str : aliased constant Source_Buffer := "OpenVMS";
|
|
ZCD_Str : aliased constant Source_Buffer := "ZCX_By_Default";
|
|
ZCG_Str : aliased constant Source_Buffer := "GCC_ZCX_Support";
|
|
ZCF_Str : aliased constant Source_Buffer := "Front_End_ZCX_Support";
|
|
|
|
type Buffer_Ptr is access constant Source_Buffer;
|
|
Targparm_Str : array (Targparm_Tags) of Buffer_Ptr :=
|
|
(AAM_Str'Access,
|
|
BDC_Str'Access,
|
|
BOC_Str'Access,
|
|
CLA_Str'Access,
|
|
DEN_Str'Access,
|
|
DSP_Str'Access,
|
|
FEL_Str'Access,
|
|
FFO_Str'Access,
|
|
HIM_Str'Access,
|
|
LSI_Str'Access,
|
|
MOV_Str'Access,
|
|
MRN_Str'Access,
|
|
SCD_Str'Access,
|
|
SCP_Str'Access,
|
|
SNZ_Str'Access,
|
|
UAM_Str'Access,
|
|
VMS_Str'Access,
|
|
ZCD_Str'Access,
|
|
ZCG_Str'Access,
|
|
ZCF_Str'Access);
|
|
|
|
---------------------------
|
|
-- Get_Target_Parameters --
|
|
---------------------------
|
|
|
|
procedure Get_Target_Parameters is
|
|
use ASCII;
|
|
|
|
S : Source_File_Index;
|
|
N : Name_Id;
|
|
T : Source_Buffer_Ptr;
|
|
P : Source_Ptr;
|
|
Z : Source_Ptr;
|
|
|
|
Fatal : Boolean := False;
|
|
-- Set True if a fatal error is detected
|
|
|
|
Result : Boolean;
|
|
-- Records boolean from system line
|
|
|
|
begin
|
|
Name_Buffer (1 .. 10) := "system.ads";
|
|
Name_Len := 10;
|
|
N := Name_Find;
|
|
S := Load_Source_File (N);
|
|
|
|
if S = No_Source_File then
|
|
Write_Line ("fatal error, run-time library not installed correctly");
|
|
Write_Str ("cannot locate file ");
|
|
Write_Line (Name_Buffer (1 .. Name_Len));
|
|
raise Unrecoverable_Error;
|
|
|
|
-- This must always be the first source file read, and we have defined
|
|
-- a constant Types.System_Source_File_Index as 1 to reflect this.
|
|
|
|
else
|
|
pragma Assert (S = System_Source_File_Index);
|
|
null;
|
|
end if;
|
|
|
|
P := Source_First (S);
|
|
Z := Source_Last (S);
|
|
T := Source_Text (S);
|
|
|
|
while T (P .. P + 10) /= "end System;" loop
|
|
|
|
for K in Targparm_Tags loop
|
|
if T (P + 3 .. P + 2 + Targparm_Str (K)'Length) =
|
|
Targparm_Str (K).all
|
|
then
|
|
P := P + 3 + Targparm_Str (K)'Length;
|
|
|
|
if Targparm_Flags (K) then
|
|
Set_Standard_Error;
|
|
Write_Line
|
|
("fatal error: system.ads is incorrectly formatted");
|
|
Write_Str ("duplicate line for parameter: ");
|
|
|
|
for J in Targparm_Str (K)'Range loop
|
|
Write_Char (Targparm_Str (K).all (J));
|
|
end loop;
|
|
|
|
Write_Eol;
|
|
Set_Standard_Output;
|
|
Fatal := True;
|
|
|
|
else
|
|
Targparm_Flags (K) := True;
|
|
end if;
|
|
|
|
while T (P) /= ':' or else T (P + 1) /= '=' loop
|
|
P := P + 1;
|
|
end loop;
|
|
|
|
P := P + 2;
|
|
|
|
while T (P) = ' ' loop
|
|
P := P + 1;
|
|
end loop;
|
|
|
|
Result := (T (P) = 'T');
|
|
|
|
case K is
|
|
when AAM => AAMP_On_Target := Result;
|
|
when BDC => Backend_Divide_Checks_On_Target := Result;
|
|
when BOC => Backend_Overflow_Checks_On_Target := Result;
|
|
when CLA => Command_Line_Args_On_Target := Result;
|
|
when DEN => Denorm_On_Target := Result;
|
|
when DSP => Functions_Return_By_DSP_On_Target := Result;
|
|
when FEL => Frontend_Layout_On_Target := Result;
|
|
when FFO => Fractional_Fixed_Ops_On_Target := Result;
|
|
when HIM => High_Integrity_Mode_On_Target := Result;
|
|
when LSI => Long_Shifts_Inlined_On_Target := Result;
|
|
when MOV => Machine_Overflows_On_Target := Result;
|
|
when MRN => Machine_Rounds_On_Target := Result;
|
|
when SCD => Stack_Check_Default_On_Target := Result;
|
|
when SCP => Stack_Check_Probes_On_Target := Result;
|
|
when SNZ => Signed_Zeros_On_Target := Result;
|
|
when UAM => Use_Ada_Main_Program_Name_On_Target := Result;
|
|
when VMS => OpenVMS_On_Target := Result;
|
|
when ZCD => ZCX_By_Default_On_Target := Result;
|
|
when ZCG => GCC_ZCX_Support_On_Target := Result;
|
|
when ZCF => Front_End_ZCX_Support_On_Target := Result;
|
|
end case;
|
|
|
|
exit;
|
|
end if;
|
|
end loop;
|
|
|
|
while T (P) /= CR and then T (P) /= LF loop
|
|
P := P + 1;
|
|
exit when P >= Z;
|
|
end loop;
|
|
|
|
while T (P) = CR or else T (P) = LF loop
|
|
P := P + 1;
|
|
exit when P >= Z;
|
|
end loop;
|
|
|
|
if P >= Z then
|
|
Set_Standard_Error;
|
|
Write_Line ("fatal error, system.ads not formatted correctly");
|
|
Set_Standard_Output;
|
|
raise Unrecoverable_Error;
|
|
end if;
|
|
end loop;
|
|
|
|
for K in Targparm_Tags loop
|
|
if not Targparm_Flags (K) then
|
|
Set_Standard_Error;
|
|
Write_Line
|
|
("fatal error: system.ads is incorrectly formatted");
|
|
Write_Str ("missing line for parameter: ");
|
|
|
|
for J in Targparm_Str (K)'Range loop
|
|
Write_Char (Targparm_Str (K).all (J));
|
|
end loop;
|
|
|
|
Write_Eol;
|
|
Set_Standard_Output;
|
|
Fatal := True;
|
|
end if;
|
|
end loop;
|
|
|
|
if Fatal then
|
|
raise Unrecoverable_Error;
|
|
end if;
|
|
end Get_Target_Parameters;
|
|
|
|
end Targparm;
|