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