gcc/ada/targparm.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                        GNAT RUN-TIME COMPONENTS                          --
   4 --                                                                          --
   5 --                             T A R G P A R M                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                                                                          --
  10 --          Copyright (C) 1999-2001 Free Software Foundation, Inc.          --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- GNAT was originally developed  by the GNAT team at  New York University. --
  24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  25 --                                                                          --
  26 ------------------------------------------------------------------------------
  27
  28 with Namet;    use Namet;
  29 with Output;   use Output;
  30 with Sinput;   use Sinput;
  31 with Sinput.L; use Sinput.L;
  32 with Types;    use Types;
  33
  34 package body Targparm is
  35
  36    type Targparm_Tags is
  37      (AAM,  --   AAMP;
  38       BDC,  --   Backend_Divide_Checks;
  39       BOC,  --   Backend_Overflow_Checks;
  40       CLA,  --   Command_Line_Args;
  41       DEN,  --   Denorm;
  42       DSP,  --   Functions_Return_By_DSP;
  43       FEL,  --   Frontend_Layout;
  44       FFO,  --   Fractional_Fixed_Ops
  45       HIM,  --   High_Integrity_Mode;
  46       LSI,  --   Long_Shifts_Inlined;
  47       MOV,  --   Machine_Overflows;
  48       MRN,  --   Machine_Rounds;
  49       SCD,  --   Stack_Check_Default;
  50       SCP,  --   Stack_Check_Probes;
  51       SNZ,  --   Signed_Zeros;
  52       UAM,  --   Use_Ada_Main_Program_Name;
  53       VMS,  --   OpenVMS;
  54       ZCD,  --   ZCX_By_Default;
  55       ZCG,  --   GCC_ZCX_Support;
  56       ZCF); --   Front_End_ZCX_Support;
  57
  58    Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
  59    --  Flag is set True if corresponding parameter is scanned
  60
  61    AAM_Str : aliased constant Source_Buffer := "AAMP";
  62    BDC_Str : aliased constant Source_Buffer := "Backend_Divide_Checks";
  63    BOC_Str : aliased constant Source_Buffer := "Backend_Overflow_Checks";
  64    CLA_Str : aliased constant Source_Buffer := "Command_Line_Args";
  65    DEN_Str : aliased constant Source_Buffer := "Denorm";
  66    DSP_Str : aliased constant Source_Buffer := "Functions_Return_By_DSP";
  67    FEL_Str : aliased constant Source_Buffer := "Frontend_Layout";
  68    FFO_Str : aliased constant Source_Buffer := "Fractional_Fixed_Ops";
  69    HIM_Str : aliased constant Source_Buffer := "High_Integrity_Mode";
  70    LSI_Str : aliased constant Source_Buffer := "Long_Shifts_Inlined";
  71    MOV_Str : aliased constant Source_Buffer := "Machine_Overflows";
  72    MRN_Str : aliased constant Source_Buffer := "Machine_Rounds";
  73    SCD_Str : aliased constant Source_Buffer := "Stack_Check_Default";
  74    SCP_Str : aliased constant Source_Buffer := "Stack_Check_Probes";
  75    SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros";
  76    UAM_Str : aliased constant Source_Buffer := "Use_Ada_Main_Program_Name";
  77    VMS_Str : aliased constant Source_Buffer := "OpenVMS";
  78    ZCD_Str : aliased constant Source_Buffer := "ZCX_By_Default";
  79    ZCG_Str : aliased constant Source_Buffer := "GCC_ZCX_Support";
  80    ZCF_Str : aliased constant Source_Buffer := "Front_End_ZCX_Support";
  81
  82    type Buffer_Ptr is access constant Source_Buffer;
  83    Targparm_Str : array (Targparm_Tags) of Buffer_Ptr :=
  84      (AAM_Str'Access,
  85       BDC_Str'Access,
  86       BOC_Str'Access,
  87       CLA_Str'Access,
  88       DEN_Str'Access,
  89       DSP_Str'Access,
  90       FEL_Str'Access,
  91       FFO_Str'Access,
  92       HIM_Str'Access,
  93       LSI_Str'Access,
  94       MOV_Str'Access,
  95       MRN_Str'Access,
  96       SCD_Str'Access,
  97       SCP_Str'Access,
  98       SNZ_Str'Access,
  99       UAM_Str'Access,
 100       VMS_Str'Access,
 101       ZCD_Str'Access,
 102       ZCG_Str'Access,
 103       ZCF_Str'Access);
 104
 105    ---------------------------
 106    -- Get_Target_Parameters --
 107    ---------------------------
 108
 109    procedure Get_Target_Parameters is
 110       use ASCII;
 111
 112       S : Source_File_Index;
 113       N : Name_Id;
 114       T : Source_Buffer_Ptr;
 115       P : Source_Ptr;
 116       Z : Source_Ptr;
 117
 118       Fatal : Boolean := False;
 119       --  Set True if a fatal error is detected
 120
 121       Result : Boolean;
 122       --  Records boolean from system line
 123
 124    begin
 125       Name_Buffer (1 .. 10) := "system.ads";
 126       Name_Len := 10;
 127       N := Name_Find;
 128       S := Load_Source_File (N);
 129
 130       if S = No_Source_File then
 131          Write_Line ("fatal error, run-time library not installed correctly");
 132          Write_Str ("cannot locate file ");
 133          Write_Line (Name_Buffer (1 .. Name_Len));
 134          raise Unrecoverable_Error;
 135
 136       --  This must always be the first source file read, and we have defined
 137       --  a constant Types.System_Source_File_Index as 1 to reflect this.
 138
 139       else
 140          pragma Assert (S = System_Source_File_Index);
 141          null;
 142       end if;
 143
 144       P := Source_First (S);
 145       Z := Source_Last  (S);
 146       T := Source_Text  (S);
 147
 148       while T (P .. P + 10) /= "end System;" loop
 149
 150          for K in Targparm_Tags loop
 151             if T (P + 3 .. P + 2 + Targparm_Str (K)'Length) =
 152                                                    Targparm_Str (K).all
 153             then
 154                P := P + 3 + Targparm_Str (K)'Length;
 155
 156                if Targparm_Flags (K) then
 157                   Set_Standard_Error;
 158                   Write_Line
 159                     ("fatal error: system.ads is incorrectly formatted");
 160                   Write_Str ("duplicate line for parameter: ");
 161
 162                   for J in Targparm_Str (K)'Range loop
 163                      Write_Char (Targparm_Str (K).all (J));
 164                   end loop;
 165
 166                   Write_Eol;
 167                   Set_Standard_Output;
 168                   Fatal := True;
 169
 170                else
 171                   Targparm_Flags (K) := True;
 172                end if;
 173
 174                while T (P) /= ':' or else T (P + 1) /= '=' loop
 175                   P := P + 1;
 176                end loop;
 177
 178                P := P + 2;
 179
 180                while T (P) = ' ' loop
 181                   P := P + 1;
 182                end loop;
 183
 184                Result := (T (P) = 'T');
 185
 186                case K is
 187                   when AAM => AAMP_On_Target                      := Result;
 188                   when BDC => Backend_Divide_Checks_On_Target     := Result;
 189                   when BOC => Backend_Overflow_Checks_On_Target   := Result;
 190                   when CLA => Command_Line_Args_On_Target         := Result;
 191                   when DEN => Denorm_On_Target                    := Result;
 192                   when DSP => Functions_Return_By_DSP_On_Target   := Result;
 193                   when FEL => Frontend_Layout_On_Target           := Result;
 194                   when FFO => Fractional_Fixed_Ops_On_Target      := Result;
 195                   when HIM => High_Integrity_Mode_On_Target       := Result;
 196                   when LSI => Long_Shifts_Inlined_On_Target       := Result;
 197                   when MOV => Machine_Overflows_On_Target         := Result;
 198                   when MRN => Machine_Rounds_On_Target            := Result;
 199                   when SCD => Stack_Check_Default_On_Target       := Result;
 200                   when SCP => Stack_Check_Probes_On_Target        := Result;
 201                   when SNZ => Signed_Zeros_On_Target              := Result;
 202                   when UAM => Use_Ada_Main_Program_Name_On_Target := Result;
 203                   when VMS => OpenVMS_On_Target                   := Result;
 204                   when ZCD => ZCX_By_Default_On_Target            := Result;
 205                   when ZCG => GCC_ZCX_Support_On_Target           := Result;
 206                   when ZCF => Front_End_ZCX_Support_On_Target     := Result;
 207                end case;
 208
 209                exit;
 210             end if;
 211          end loop;
 212
 213          while T (P) /= CR and then T (P) /= LF loop
 214             P := P + 1;
 215             exit when P >= Z;
 216          end loop;
 217
 218          while T (P) = CR or else T (P) = LF loop
 219             P := P + 1;
 220             exit when P >= Z;
 221          end loop;
 222
 223          if P >= Z then
 224             Set_Standard_Error;
 225             Write_Line ("fatal error, system.ads not formatted correctly");
 226             Set_Standard_Output;
 227             raise Unrecoverable_Error;
 228          end if;
 229       end loop;
 230
 231       for K in Targparm_Tags loop
 232          if not Targparm_Flags (K) then
 233             Set_Standard_Error;
 234             Write_Line
 235               ("fatal error: system.ads is incorrectly formatted");
 236             Write_Str ("missing line for parameter: ");
 237
 238             for J in Targparm_Str (K)'Range loop
 239                Write_Char (Targparm_Str (K).all (J));
 240             end loop;
 241
 242             Write_Eol;
 243             Set_Standard_Output;
 244             Fatal := True;
 245          end if;
 246       end loop;
 247
 248       if Fatal then
 249          raise Unrecoverable_Error;
 250       end if;
 251    end Get_Target_Parameters;
 252
 253 end Targparm;