229 lines
8.8 KiB
Ada
229 lines
8.8 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT RUN-TIME COMPONENTS --
|
|
-- --
|
|
-- T A R G P A R M --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- $Revision: 1.15 $
|
|
-- --
|
|
-- 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 Fname.UF; use Fname.UF;
|
|
with Types; use Types;
|
|
|
|
package body Targparm is
|
|
|
|
type Targparm_Tags is
|
|
(AAM, CLA, DEN, DSP, FEL, HIM, LSI, MOV,
|
|
MRN, SCD, SCP, SNZ, UAM, VMS, ZCD, ZCG, ZCF);
|
|
|
|
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";
|
|
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";
|
|
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,
|
|
CLA_Str'Access,
|
|
DEN_Str'Access,
|
|
DSP_Str'Access,
|
|
FEL_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 .. 6) := "system";
|
|
Name_Len := 6;
|
|
N := File_Name_Of_Spec (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 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 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;
|