+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME COMPONENTS --
--- --
--- T A R G P A R M --
--- --
--- B o d y --
--- --
--- $Revision: 1.1.16.1 $
--- --
--- 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 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;
projects / msp430-gcc.git / blobdiff