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