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);
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);
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;
Result : Boolean;
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;
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;