mirror of
git://gcc.gnu.org/git/gcc.git
synced 2024-12-20 14:39:29 +08:00
bb4daba346
2005-12-05 Doug Rupp <rupp@adacore.com>
* mlib-tgt-vms-ia64.adb, mlib-tgt-vms-alpha.adb (Is_Interface): Change
Ada bind file prefix on VMS from b$ to b__.
(Build_Dynamic_Library): Change Init file suffix on VMS from $init to
__init.
* prj-nmsc.adb: Change some Hostparm.OpenVMS checks to
Targparm.OpenVMS_On_Target.
(Object_Suffix): Initialize with target object suffix.
(Get_Unit): Change Ada bind file prefix on VMS from b$ to b__.
* butil.adb: Change some Hostparm.OpenVMS checks to
Targparm.OpenVMS_On_Target.
* clean.adb: Change some Hostparm.OpenVMS checks to
Targparm.OpenVMS_On_Target.
(Object_Suffix): Initialize with call to Get_Target_Object_Suffix.
({declaraction},Delete_Binder_Generated_Files,{initialization}): Change
Ada bind file prefix on VMS from b$ to b__.
* gnatlink.adb (Process_Args): Call Add_Src_Search_Dir for -I in
--GCC so that Get_Target_Parameters can find system.ads.
(Gnatlink): Call Get_Target_Parameters in mainline.
Initialize standard packages for Targparm.
Change some Hostparm.OpenVMS checks to Targparm.OpenVMS_On_Target.
(Process_Args): Also Check for object files with target object
extension.
(Make_Binder_File_Names): Create with target object extension.
(Make_Binder_File_Names): Change Ada bind file prefix on VMS from b$
to b__.
* mlib-prj.adb: Change some Hostparm.OpenVMS checks to
Targparm.OpenVMS_On_Target.
({declaration},Build_Library,Check_Library): Change Ada bind file
prefix on VMS from b$ to b__.
* osint-b.adb: Change some Hostparm.OpenVMS checks to
Targparm.OpenVMS_On_Target.
(Create_Binder_Output): Change Ada bind file prefix on VMS from b$ to
b__.
* targext.c: New file.
* Makefile.in: add support for vxworks653 builds
(../../vxaddr2line): gnatlink with targext.o.
(TOOLS_LIBS): Move targext.o to precede libgnat.
(init.o, initialize.o): Minor clean up in dependencies.
(GNATLINK_OBJS): Add targparm.o, snames.o
Add rules fo building targext.o and linking it explicitly with all
tools.
Also add targext.o to gnatlib.
* Make-lang.in: Add rules for building targext.o and linking it in
with gnat1 and gnatbind.
Add entry for exp_sel.o.
* osint.adb Change some Hostparm.OpenVMS checks to
Targparm.OpenVMS_On_Target.
(Object_File_Name): Use target object suffix.
* osint.ads (Object_Suffix): Remove, no longer used.
(Target_Object_Suffix): Initialize with target object suffix.
* rident.ads: Add special exception to license.
* targparm.adb (Get_Target_Parameters): Set the value of
Multi_Unit_Index_Character after OpenVMS_On_Target gets its definitive
value.
(Get_Target_Parameters): Set OpenVMS_On_Target if openvms.
* targparm.ads: Add special exception to license.
* g-os_lib.ads, g-os_lib.adb (Get_Target_Debuggable_Suffix): New
function.
(Copy_File): Make sure from file is closed if error on to file
(Get_Target_Executable_Suffix, Get_Target_Object_Suffix): New functions.
* make.adb (Object_Suffix): Intialize with Get_Target_Object_Suffix.
(Executable_Suffix): Intialize with Get_Target_Executable_Suffix.
* osint-c.adb (Set_Output_Object_File_Name): Initialize extension with
target object suffix.
From-SVN: r108285
639 lines
23 KiB
Ada
639 lines
23 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT RUN-TIME COMPONENTS --
|
|
-- --
|
|
-- T A R G P A R M --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 1999-2005, 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, 51 Franklin Street, Fifth Floor, --
|
|
-- Boston, MA 02110-1301, USA. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Csets; use Csets;
|
|
with Namet; use Namet;
|
|
with Opt; use Opt;
|
|
with Osint; use Osint;
|
|
with Output; use Output;
|
|
|
|
package body Targparm is
|
|
use ASCII;
|
|
|
|
Parameters_Obtained : Boolean := False;
|
|
-- Set True after first call to Get_Target_Parameters. Used to avoid
|
|
-- reading system.ads more than once, since it cannot change.
|
|
|
|
-- The following array defines a tag name for each entry
|
|
|
|
type Targparm_Tags is
|
|
(AAM, -- AAMP
|
|
BDC, -- Backend_Divide_Checks
|
|
BOC, -- Backend_Overflow_Checks
|
|
CLA, -- Command_Line_Args
|
|
CRT, -- Configurable_Run_Times
|
|
CSV, -- Compiler_System_Version
|
|
D32, -- Duration_32_Bits
|
|
DEN, -- Denorm
|
|
DSP, -- Functions_Return_By_DSP
|
|
EXS, -- Exit_Status_Supported
|
|
FEL, -- Frontend_Layout
|
|
FFO, -- Fractional_Fixed_Ops
|
|
MOV, -- Machine_Overflows
|
|
MRN, -- Machine_Rounds
|
|
PAS, -- Preallocated_Stacks
|
|
S64, -- Support_64_Bit_Divides
|
|
SAG, -- Support_Aggregates
|
|
SCA, -- Support_Composite_Assign
|
|
SCC, -- Support_Composite_Compare
|
|
SCD, -- Stack_Check_Default
|
|
SCP, -- Stack_Check_Probes
|
|
SLS, -- Support_Long_Shifts
|
|
SNZ, -- Signed_Zeros
|
|
SSL, -- Suppress_Standard_Library
|
|
UAM, -- Use_Ada_Main_Program_Name
|
|
VMS, -- OpenVMS
|
|
ZCD, -- ZCX_By_Default
|
|
ZCG); -- GCC_ZCX_Support
|
|
|
|
subtype Targparm_Tags_OK is Targparm_Tags range AAM .. ZCG;
|
|
-- Range excluding obsolete entries
|
|
|
|
Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
|
|
-- Flag is set True if corresponding parameter is scanned
|
|
|
|
-- The following list of string constants gives the parameter names
|
|
|
|
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";
|
|
CRT_Str : aliased constant Source_Buffer := "Configurable_Run_Time";
|
|
CSV_Str : aliased constant Source_Buffer := "Compiler_System_Version";
|
|
D32_Str : aliased constant Source_Buffer := "Duration_32_Bits";
|
|
DEN_Str : aliased constant Source_Buffer := "Denorm";
|
|
DSP_Str : aliased constant Source_Buffer := "Functions_Return_By_DSP";
|
|
EXS_Str : aliased constant Source_Buffer := "Exit_Status_Supported";
|
|
FEL_Str : aliased constant Source_Buffer := "Frontend_Layout";
|
|
FFO_Str : aliased constant Source_Buffer := "Fractional_Fixed_Ops";
|
|
MOV_Str : aliased constant Source_Buffer := "Machine_Overflows";
|
|
MRN_Str : aliased constant Source_Buffer := "Machine_Rounds";
|
|
PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks";
|
|
S64_Str : aliased constant Source_Buffer := "Support_64_Bit_Divides";
|
|
SAG_Str : aliased constant Source_Buffer := "Support_Aggregates";
|
|
SCA_Str : aliased constant Source_Buffer := "Support_Composite_Assign";
|
|
SCC_Str : aliased constant Source_Buffer := "Support_Composite_Compare";
|
|
SCD_Str : aliased constant Source_Buffer := "Stack_Check_Default";
|
|
SCP_Str : aliased constant Source_Buffer := "Stack_Check_Probes";
|
|
SLS_Str : aliased constant Source_Buffer := "Support_Long_Shifts";
|
|
SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros";
|
|
SSL_Str : aliased constant Source_Buffer := "Suppress_Standard_Library";
|
|
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";
|
|
|
|
-- The following defines a set of pointers to the above strings,
|
|
-- indexed by the tag values.
|
|
|
|
type Buffer_Ptr is access constant Source_Buffer;
|
|
Targparm_Str : constant array (Targparm_Tags) of Buffer_Ptr :=
|
|
(AAM_Str'Access,
|
|
BDC_Str'Access,
|
|
BOC_Str'Access,
|
|
CLA_Str'Access,
|
|
CRT_Str'Access,
|
|
CSV_Str'Access,
|
|
D32_Str'Access,
|
|
DEN_Str'Access,
|
|
DSP_Str'Access,
|
|
EXS_Str'Access,
|
|
FEL_Str'Access,
|
|
FFO_Str'Access,
|
|
MOV_Str'Access,
|
|
MRN_Str'Access,
|
|
PAS_Str'Access,
|
|
S64_Str'Access,
|
|
SAG_Str'Access,
|
|
SCA_Str'Access,
|
|
SCC_Str'Access,
|
|
SCD_Str'Access,
|
|
SCP_Str'Access,
|
|
SLS_Str'Access,
|
|
SNZ_Str'Access,
|
|
SSL_Str'Access,
|
|
UAM_Str'Access,
|
|
VMS_Str'Access,
|
|
ZCD_Str'Access,
|
|
ZCG_Str'Access);
|
|
|
|
-----------------------
|
|
-- Local Subprograms --
|
|
-----------------------
|
|
|
|
procedure Set_Profile_Restrictions (P : Profile_Name);
|
|
-- Set Restrictions_On_Target for the given profile
|
|
|
|
------------------------------
|
|
-- Set_Profile_Restrictions --
|
|
------------------------------
|
|
|
|
procedure Set_Profile_Restrictions (P : Profile_Name) is
|
|
R : Restriction_Flags renames Profile_Info (P).Set;
|
|
V : Restriction_Values renames Profile_Info (P).Value;
|
|
begin
|
|
for J in R'Range loop
|
|
if R (J) then
|
|
Restrictions_On_Target.Set (J) := True;
|
|
|
|
if J in All_Parameter_Restrictions then
|
|
Restrictions_On_Target.Value (J) := V (J);
|
|
end if;
|
|
end if;
|
|
end loop;
|
|
end Set_Profile_Restrictions;
|
|
|
|
---------------------------
|
|
-- Get_Target_Parameters --
|
|
---------------------------
|
|
|
|
-- Version which reads in system.ads
|
|
|
|
procedure Get_Target_Parameters is
|
|
Text : Source_Buffer_Ptr;
|
|
Hi : Source_Ptr;
|
|
|
|
begin
|
|
if Parameters_Obtained then
|
|
return;
|
|
end if;
|
|
|
|
Name_Buffer (1 .. 10) := "system.ads";
|
|
Name_Len := 10;
|
|
|
|
Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text);
|
|
|
|
if Text = null then
|
|
Write_Line ("fatal error, run-time library not installed correctly");
|
|
Write_Line ("cannot locate file system.ads");
|
|
raise Unrecoverable_Error;
|
|
end if;
|
|
|
|
Targparm.Get_Target_Parameters
|
|
(System_Text => Text,
|
|
Source_First => 0,
|
|
Source_Last => Hi);
|
|
end Get_Target_Parameters;
|
|
|
|
-- Version where caller supplies system.ads text
|
|
|
|
procedure Get_Target_Parameters
|
|
(System_Text : Source_Buffer_Ptr;
|
|
Source_First : Source_Ptr;
|
|
Source_Last : Source_Ptr)
|
|
is
|
|
P : Source_Ptr;
|
|
-- Scans source buffer containing source of system.ads
|
|
|
|
Fatal : Boolean := False;
|
|
-- Set True if a fatal error is detected
|
|
|
|
Result : Boolean;
|
|
-- Records boolean from system line
|
|
|
|
begin
|
|
if Parameters_Obtained then
|
|
return;
|
|
else
|
|
Parameters_Obtained := True;
|
|
end if;
|
|
|
|
Opt.Address_Is_Private := False;
|
|
|
|
P := Source_First;
|
|
Line_Loop : while System_Text (P .. P + 10) /= "end System;" loop
|
|
|
|
-- Skip comments quickly
|
|
|
|
if System_Text (P) = '-' then
|
|
goto Line_Loop_Continue;
|
|
|
|
-- Test for type Address is private
|
|
|
|
elsif System_Text (P .. P + 26) = " type Address is private;" then
|
|
Opt.Address_Is_Private := True;
|
|
P := P + 26;
|
|
goto Line_Loop_Continue;
|
|
|
|
-- Test for pragma Profile (Ravenscar);
|
|
|
|
elsif System_Text (P .. P + 26) =
|
|
"pragma Profile (Ravenscar);"
|
|
then
|
|
Set_Profile_Restrictions (Ravenscar);
|
|
Opt.Task_Dispatching_Policy := 'F';
|
|
Opt.Locking_Policy := 'C';
|
|
P := P + 27;
|
|
goto Line_Loop_Continue;
|
|
|
|
-- Test for pragma Profile (Restricted);
|
|
|
|
elsif System_Text (P .. P + 27) =
|
|
"pragma Profile (Restricted);"
|
|
then
|
|
Set_Profile_Restrictions (Restricted);
|
|
P := P + 28;
|
|
goto Line_Loop_Continue;
|
|
|
|
-- Test for pragma Restrictions
|
|
|
|
elsif System_Text (P .. P + 20) = "pragma Restrictions (" then
|
|
P := P + 21;
|
|
|
|
Rloop : for K in All_Boolean_Restrictions loop
|
|
declare
|
|
Rname : constant String := Restriction_Id'Image (K);
|
|
|
|
begin
|
|
for J in Rname'Range loop
|
|
if Fold_Upper (System_Text (P + Source_Ptr (J - 1)))
|
|
/= Rname (J)
|
|
then
|
|
goto Rloop_Continue;
|
|
end if;
|
|
end loop;
|
|
|
|
if System_Text (P + Rname'Length) = ')' then
|
|
Restrictions_On_Target.Set (K) := True;
|
|
goto Line_Loop_Continue;
|
|
end if;
|
|
end;
|
|
|
|
<<Rloop_Continue>>
|
|
null;
|
|
end loop Rloop;
|
|
|
|
Ploop : for K in All_Parameter_Restrictions loop
|
|
declare
|
|
Rname : constant String :=
|
|
All_Parameter_Restrictions'Image (K);
|
|
|
|
V : Natural;
|
|
-- Accumulates value
|
|
|
|
begin
|
|
for J in Rname'Range loop
|
|
if Fold_Upper (System_Text (P + Source_Ptr (J - 1)))
|
|
/= Rname (J)
|
|
then
|
|
goto Ploop_Continue;
|
|
end if;
|
|
end loop;
|
|
|
|
if System_Text (P + Rname'Length .. P + Rname'Length + 3) =
|
|
" => "
|
|
then
|
|
P := P + Rname'Length + 4;
|
|
|
|
V := 0;
|
|
loop
|
|
if System_Text (P) in '0' .. '9' then
|
|
declare
|
|
pragma Unsuppress (Overflow_Check);
|
|
|
|
begin
|
|
-- Accumulate next digit
|
|
|
|
V := 10 * V +
|
|
Character'Pos (System_Text (P)) -
|
|
Character'Pos ('0');
|
|
|
|
exception
|
|
-- On overflow, we just ignore the pragma since
|
|
-- that is the standard handling in this case.
|
|
|
|
when Constraint_Error =>
|
|
goto Line_Loop_Continue;
|
|
end;
|
|
|
|
elsif System_Text (P) = '_' then
|
|
null;
|
|
|
|
elsif System_Text (P) = ')' then
|
|
Restrictions_On_Target.Value (K) := V;
|
|
Restrictions_On_Target.Set (K) := True;
|
|
goto Line_Loop_Continue;
|
|
|
|
else
|
|
exit Ploop;
|
|
end if;
|
|
|
|
P := P + 1;
|
|
end loop;
|
|
|
|
else
|
|
exit Ploop;
|
|
end if;
|
|
end;
|
|
|
|
<<Ploop_Continue>>
|
|
null;
|
|
end loop Ploop;
|
|
|
|
Set_Standard_Error;
|
|
Write_Line
|
|
("fatal error: system.ads is incorrectly formatted");
|
|
Write_Str ("unrecognized or incorrect restrictions pragma: ");
|
|
|
|
while System_Text (P) /= ')'
|
|
and then
|
|
System_Text (P) /= ASCII.LF
|
|
loop
|
|
Write_Char (System_Text (P));
|
|
P := P + 1;
|
|
end loop;
|
|
|
|
Write_Eol;
|
|
Fatal := True;
|
|
Set_Standard_Output;
|
|
|
|
-- Test for pragma Detect_Blocking;
|
|
|
|
elsif System_Text (P .. P + 22) = "pragma Detect_Blocking;" then
|
|
P := P + 23;
|
|
Opt.Detect_Blocking := True;
|
|
goto Line_Loop_Continue;
|
|
|
|
-- Discard_Names
|
|
|
|
elsif System_Text (P .. P + 20) = "pragma Discard_Names;" then
|
|
P := P + 21;
|
|
Opt.Global_Discard_Names := True;
|
|
goto Line_Loop_Continue;
|
|
|
|
-- Locking Policy
|
|
|
|
elsif System_Text (P .. P + 22) = "pragma Locking_Policy (" then
|
|
P := P + 23;
|
|
Opt.Locking_Policy := System_Text (P);
|
|
Opt.Locking_Policy_Sloc := System_Location;
|
|
goto Line_Loop_Continue;
|
|
|
|
-- Normalize_Scalars
|
|
|
|
elsif System_Text (P .. P + 24) = "pragma Normalize_Scalars;" then
|
|
P := P + 25;
|
|
Opt.Normalize_Scalars := True;
|
|
Opt.Init_Or_Norm_Scalars := True;
|
|
goto Line_Loop_Continue;
|
|
|
|
-- Polling (On)
|
|
|
|
elsif System_Text (P .. P + 19) = "pragma Polling (On);" then
|
|
P := P + 20;
|
|
Opt.Polling_Required := True;
|
|
goto Line_Loop_Continue;
|
|
|
|
-- Ignore pragma Pure (System)
|
|
|
|
elsif System_Text (P .. P + 20) = "pragma Pure (System);" then
|
|
P := P + 21;
|
|
goto Line_Loop_Continue;
|
|
|
|
-- Queuing Policy
|
|
|
|
elsif System_Text (P .. P + 22) = "pragma Queuing_Policy (" then
|
|
P := P + 23;
|
|
Opt.Queuing_Policy := System_Text (P);
|
|
Opt.Queuing_Policy_Sloc := System_Location;
|
|
goto Line_Loop_Continue;
|
|
|
|
-- Suppress_Exception_Locations
|
|
|
|
elsif System_Text (P .. P + 34) =
|
|
"pragma Suppress_Exception_Locations;"
|
|
then
|
|
P := P + 35;
|
|
Opt.Exception_Locations_Suppressed := True;
|
|
goto Line_Loop_Continue;
|
|
|
|
-- Task_Dispatching Policy
|
|
|
|
elsif System_Text (P .. P + 31) =
|
|
"pragma Task_Dispatching_Policy ("
|
|
then
|
|
P := P + 32;
|
|
Opt.Task_Dispatching_Policy := System_Text (P);
|
|
Opt.Task_Dispatching_Policy_Sloc := System_Location;
|
|
goto Line_Loop_Continue;
|
|
|
|
-- No other pragmas are permitted
|
|
|
|
elsif System_Text (P .. P + 6) = "pragma " then
|
|
Set_Standard_Error;
|
|
Write_Line ("unrecognized line in system.ads: ");
|
|
|
|
while System_Text (P) /= ')'
|
|
and then System_Text (P) /= ASCII.LF
|
|
loop
|
|
Write_Char (System_Text (P));
|
|
P := P + 1;
|
|
end loop;
|
|
|
|
Write_Eol;
|
|
Set_Standard_Output;
|
|
Fatal := True;
|
|
|
|
-- See if we have a Run_Time_Name
|
|
|
|
elsif System_Text (P .. P + 38) =
|
|
" Run_Time_Name : constant String := """
|
|
then
|
|
P := P + 39;
|
|
|
|
Name_Len := 0;
|
|
while System_Text (P) in 'A' .. 'Z'
|
|
or else
|
|
System_Text (P) in 'a' .. 'z'
|
|
or else
|
|
System_Text (P) in '0' .. '9'
|
|
or else
|
|
System_Text (P) = ' '
|
|
or else
|
|
System_Text (P) = '_'
|
|
loop
|
|
Add_Char_To_Name_Buffer (System_Text (P));
|
|
P := P + 1;
|
|
end loop;
|
|
|
|
if System_Text (P) /= '"'
|
|
or else System_Text (P + 1) /= ';'
|
|
or else (System_Text (P + 2) /= ASCII.LF
|
|
and then
|
|
System_Text (P + 2) /= ASCII.CR)
|
|
then
|
|
Set_Standard_Error;
|
|
Write_Line
|
|
("incorrectly formatted Run_Time_Name in system.ads");
|
|
Set_Standard_Output;
|
|
Fatal := True;
|
|
|
|
else
|
|
Run_Time_Name_On_Target := Name_Enter;
|
|
end if;
|
|
|
|
goto Line_Loop_Continue;
|
|
|
|
-- Next See if we have a configuration parameter
|
|
|
|
else
|
|
Config_Param_Loop : for K in Targparm_Tags loop
|
|
if System_Text (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 System_Text (P) /= ':'
|
|
or else System_Text (P + 1) /= '='
|
|
loop
|
|
P := P + 1;
|
|
end loop;
|
|
|
|
P := P + 2;
|
|
|
|
while System_Text (P) = ' ' loop
|
|
P := P + 1;
|
|
end loop;
|
|
|
|
Result := (System_Text (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 CRT => Configurable_Run_Time_On_Target := Result;
|
|
when CSV => Compiler_System_Version := Result;
|
|
when D32 => Duration_32_Bits_On_Target := Result;
|
|
when DEN => Denorm_On_Target := Result;
|
|
when DSP => Functions_Return_By_DSP_On_Target := Result;
|
|
when EXS => Exit_Status_Supported_On_Target := Result;
|
|
when FEL => Frontend_Layout_On_Target := Result;
|
|
when FFO => Fractional_Fixed_Ops_On_Target := Result;
|
|
when MOV => Machine_Overflows_On_Target := Result;
|
|
when MRN => Machine_Rounds_On_Target := Result;
|
|
when PAS => Preallocated_Stacks_On_Target := Result;
|
|
when S64 => Support_64_Bit_Divides_On_Target := Result;
|
|
when SAG => Support_Aggregates_On_Target := Result;
|
|
when SCA => Support_Composite_Assign_On_Target := Result;
|
|
when SCC => Support_Composite_Compare_On_Target := Result;
|
|
when SCD => Stack_Check_Default_On_Target := Result;
|
|
when SCP => Stack_Check_Probes_On_Target := Result;
|
|
when SLS => Support_Long_Shifts_On_Target := Result;
|
|
when SSL => Suppress_Standard_Library_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;
|
|
|
|
goto Line_Loop_Continue;
|
|
end case;
|
|
|
|
-- Here we are seeing a parameter we do not understand. We
|
|
-- simply ignore this (will happen when an old compiler is
|
|
-- used to compile a newer version of GNAT which does not
|
|
-- support the
|
|
end if;
|
|
end loop Config_Param_Loop;
|
|
end if;
|
|
|
|
-- Here after processing one line of System spec
|
|
|
|
<<Line_Loop_Continue>>
|
|
|
|
while System_Text (P) /= CR and then System_Text (P) /= LF loop
|
|
P := P + 1;
|
|
exit when P >= Source_Last;
|
|
end loop;
|
|
|
|
while System_Text (P) = CR or else System_Text (P) = LF loop
|
|
P := P + 1;
|
|
exit when P >= Source_Last;
|
|
end loop;
|
|
|
|
if P >= Source_Last then
|
|
Set_Standard_Error;
|
|
Write_Line ("fatal error, system.ads not formatted correctly");
|
|
Write_Line ("unexpected end of file");
|
|
Set_Standard_Output;
|
|
raise Unrecoverable_Error;
|
|
end if;
|
|
end loop Line_Loop;
|
|
|
|
-- Now that OpenVMS_On_Target has been given its definitive value,
|
|
-- change the multi-unit index character from '~' to '$' for OpenVMS.
|
|
|
|
if OpenVMS_On_Target then
|
|
Multi_Unit_Index_Character := '$';
|
|
end if;
|
|
|
|
-- Check no missing target parameter settings (skip for compiler vsn)
|
|
|
|
if not Compiler_System_Version then
|
|
for K in Targparm_Tags_OK 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;
|
|
end if;
|
|
|
|
if Fatal then
|
|
raise Unrecoverable_Error;
|
|
end if;
|
|
end Get_Target_Parameters;
|
|
|
|
end Targparm;
|