------------------------------------------------------------------------------ -- -- -- 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. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ 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;