From 1ebc2612da88cbb87faed5106329fd03831e0ebc Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 30 Jul 2014 17:15:32 +0200 Subject: [PATCH] [multiple changes] 2014-07-30 Arnaud Charlet * set_targ.adb (Read_Target_Dependent_Values): New subprogram. (elab body): Add provision for default target config file. * get_targ.ads, get_targ.adb (Get_Back_End_Config_File): New subprogram. 2014-07-30 Ed Schonberg * a-cbhase.adb (Delete): Raise Constraint_Error, not Program_Error, when attempting to remove an element not in the set. This is the given semantics for all set containers. * a-cborse.adb (Delete): Attempt removal first, to check for tampering, before checking whether this is an attempt to delete a non-existing element, and in fthe latter case raise Constraint_Error. 2014-07-30 Vincent Celier * prj-proc.adb (Recursive_Process): Do not create a new Project_Id if the project is already in the list of projects of the tree. 2014-07-30 Ed Schonberg * sem_ch6.adb (Analyze_Function_Return): Reject a return expression whose type is an incomplete formal type. (Analyze_Return_Type): Reject a return type that is an untagged imcomplete formal type. (Process_Formals): Reject a formal parameter whose type is an untagged formal incomplete type. * sem_res.adb (Resolve_Actuals): Reject an actual whose type is an untagged formal incomplete type. From-SVN: r213299 --- gcc/ada/ChangeLog | 33 +++ gcc/ada/a-cbhase.adb | 2 +- gcc/ada/a-cborse.adb | 5 +- gcc/ada/get_targ.adb | 11 +- gcc/ada/get_targ.ads | 5 + gcc/ada/prj-proc.adb | 46 +++- gcc/ada/sem_ch6.adb | 40 ++- gcc/ada/sem_res.adb | 10 + gcc/ada/set_targ.adb | 575 ++++++++++++++++++++++--------------------- 9 files changed, 430 insertions(+), 297 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 54452ab53b7..923f6cddce9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,36 @@ +2014-07-30 Arnaud Charlet + + * set_targ.adb (Read_Target_Dependent_Values): New subprogram. + (elab body): Add provision for default target config file. + * get_targ.ads, get_targ.adb (Get_Back_End_Config_File): New subprogram. + +2014-07-30 Ed Schonberg + + * a-cbhase.adb (Delete): Raise Constraint_Error, not Program_Error, + when attempting to remove an element not in the set. This is + the given semantics for all set containers. + * a-cborse.adb (Delete): Attempt removal first, to check for + tampering, before checking whether this is an attempt to + delete a non-existing element, and in fthe latter case raise + Constraint_Error. + +2014-07-30 Vincent Celier + + * prj-proc.adb (Recursive_Process): Do not create a new + Project_Id if the project is already in the list of projects of + the tree. + +2014-07-30 Ed Schonberg + + * sem_ch6.adb (Analyze_Function_Return): Reject a return expression + whose type is an incomplete formal type. + (Analyze_Return_Type): Reject a return type that is an untagged + imcomplete formal type. + (Process_Formals): Reject a formal parameter whose type is an + untagged formal incomplete type. + * sem_res.adb (Resolve_Actuals): Reject an actual whose type is + an untagged formal incomplete type. + 2014-07-30 Robert Dewar * gnat_ugn.texi: Minor spelling correction. diff --git a/gcc/ada/a-cbhase.adb b/gcc/ada/a-cbhase.adb index dbf234bf3f2..8d4a61ea435 100644 --- a/gcc/ada/a-cbhase.adb +++ b/gcc/ada/a-cbhase.adb @@ -313,7 +313,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is Element_Keys.Delete_Key_Sans_Free (Container, Item, X); if X = 0 then - raise Program_Error with "attempt to delete element not in set"; + raise Constraint_Error with "attempt to delete element not in set"; end if; HT_Ops.Free (Container, X); diff --git a/gcc/ada/a-cborse.adb b/gcc/ada/a-cborse.adb index ffb06a12d53..979357ddc75 100644 --- a/gcc/ada/a-cborse.adb +++ b/gcc/ada/a-cborse.adb @@ -500,11 +500,12 @@ package body Ada.Containers.Bounded_Ordered_Sets is X : constant Count_Type := Element_Keys.Find (Container, Item); begin + Tree_Operations.Delete_Node_Sans_Free (Container, X); + if X = 0 then - raise Program_Error with "attempt to delete element not in set"; + raise Constraint_Error with "attempt to delete element not in set"; end if; - Tree_Operations.Delete_Node_Sans_Free (Container, X); Tree_Operations.Free (Container, X); end Delete; diff --git a/gcc/ada/get_targ.adb b/gcc/ada/get_targ.adb index 661f95b5ab3..fa0c8b9b023 100644 --- a/gcc/ada/get_targ.adb +++ b/gcc/ada/get_targ.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -293,6 +293,15 @@ package body Get_Targ is return C_Get_Double_Scalar_Alignment; end Get_Double_Scalar_Alignment; + ------------------------------ + -- Get_Back_End_Config_File -- + ------------------------------ + + function Get_Back_End_Config_File return String_Ptr is + begin + return null; + end Get_Back_End_Config_File; + ---------------------- -- Digits_From_Size -- ---------------------- diff --git a/gcc/ada/get_targ.ads b/gcc/ada/get_targ.ads index 98be7c9a771..6d484a3143e 100644 --- a/gcc/ada/get_targ.ads +++ b/gcc/ada/get_targ.ads @@ -145,4 +145,9 @@ package Get_Targ is procedure Register_Back_End_Types (Call_Back : Register_Type_Proc); -- Calls the Call_Back function with information for each supported type + function Get_Back_End_Config_File return String_Ptr; + -- Return the back end configuration file, or null if none. + -- If non null, this file should be used instead of calling the various + -- Get_xxx functions in this package. + end Get_Targ; diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 5ba318c3e6f..561f4ec1e1c 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -2845,20 +2845,42 @@ package body Prj.Proc is return; end if; - Project := - new Project_Data' - (Empty_Project - (Project_Qualifier_Of - (From_Project_Node, From_Project_Node_Tree))); + -- Check if the project is already in the tree - -- Note that at this point we do not know yet if the project has - -- been withed from an encapsulated library or not. + Project := No_Project; + declare + List : Project_List := In_Tree.Projects; + Path : constant Path_Name_Type := + Path_Name_Of (From_Project_Node, + From_Project_Node_Tree); - In_Tree.Projects := - new Project_List_Element' - (Project => Project, - From_Encapsulated_Lib => False, - Next => In_Tree.Projects); + begin + while List /= null loop + if List.Project.Path.Display_Name = Path then + Project := List.Project; + exit; + end if; + + List := List.Next; + end loop; + end; + + if Project = No_Project then + Project := + new Project_Data' + (Empty_Project + (Project_Qualifier_Of + (From_Project_Node, From_Project_Node_Tree))); + + -- Note that at this point we do not know yet if the project + -- has been withed from an encapsulated library or not. + + In_Tree.Projects := + new Project_List_Element' + (Project => Project, + From_Encapsulated_Lib => False, + Next => In_Tree.Projects); + end if; -- Keep track of this point diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index a5dda115f7e..05359a97676 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -981,6 +981,14 @@ package body Sem_Ch6 is then Error_Msg_N ("cannot return local access to subprogram", N); end if; + + -- The expression cannot be of a formal incomplete type + + elsif Ekind (Etype (Expr)) = E_Incomplete_Type + and then Is_Generic_Type (Etype (Expr)) + then + Error_Msg_N + ("cannot return expression of a formal incomplete type", N); end if; -- If the result type is class-wide, then check that the return @@ -1953,6 +1961,24 @@ package body Sem_Ch6 is ("invalid use of incomplete type&", Result_Definition (N), Typ); + -- The return type of a subprogram body cannot be of a + -- formal incomplete type. + + elsif Is_Generic_Type (Typ) + and then Nkind (Parent (N)) = N_Subprogram_Body + then + Error_Msg_N + ("return type cannot be a formal incomplete type", + Result_Definition (N)); + + elsif Is_Class_Wide_Type (Typ) + and then Is_Generic_Type (Root_Type (Typ)) + and then Nkind (Parent (N)) = N_Subprogram_Body + then + Error_Msg_N + ("return type cannot be a formal incomplete type", + Result_Definition (N)); + elsif Is_Tagged_Type (Typ) then null; @@ -9827,7 +9853,8 @@ package body Sem_Ch6 is if Is_Tagged_Type (Formal_Type) or else (Ada_Version >= Ada_2012 - and then not From_Limited_With (Formal_Type)) + and then not From_Limited_With (Formal_Type) + and then not Is_Generic_Type (Formal_Type)) then if Ekind (Scope (Current_Scope)) = E_Package and then not Is_Generic_Type (Formal_Type) @@ -9864,8 +9891,17 @@ package body Sem_Ch6 is -- in bodies. Limited views of either kind are not allowed -- if there is no place at which the non-limited view can -- become available. + -- Incomplete formal untagged types are not allowed in + -- subprogram bodies (but are legal in their declarations). - if Ada_Version >= Ada_2012 then + if Is_Generic_Type (Formal_Type) + and then not Is_Tagged_Type (Formal_Type) + and then Nkind (Parent (Related_Nod)) = N_Subprogram_Body + then + Error_Msg_N + ("invalid use of formal incomplete type", Param_Spec); + + elsif Ada_Version >= Ada_2012 then if Is_Tagged_Type (Formal_Type) and then (not From_Limited_With (Formal_Type) or else not In_Package_Body) diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 28277bcefaf..e7ed6648593 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -3864,6 +3864,16 @@ package body Sem_Res is A_Typ := Etype (A); F_Typ := Etype (F); + -- An actual cannot be an untagged formal incomplete type + + if Ekind (A_Typ) = E_Incomplete_Type + and then not Is_Tagged_Type (A_Typ) + and then Is_Generic_Type (A_Typ) + then + Error_Msg_N + ("invalid use of untagged formal incomplete type", A); + end if; + if Comes_From_Source (Original_Node (N)) and then Nkind_In (Original_Node (N), N_Function_Call, N_Procedure_Call_Statement) diff --git a/gcc/ada/set_targ.adb b/gcc/ada/set_targ.adb index d6268c82333..704bea61339 100755 --- a/gcc/ada/set_targ.adb +++ b/gcc/ada/set_targ.adb @@ -130,6 +130,10 @@ package body Set_Targ is -- Local Subprograms -- ----------------------- + procedure Read_Target_Dependent_Values (File_Name : String); + -- Read target dependent values from File_Name, and set the target + -- dependent values (global variables) declared in this package. + procedure Fail (E : String); pragma No_Return (Fail); -- Terminate program with fatal error message passed as parameter @@ -481,6 +485,260 @@ package body Set_Targ is end if; end Write_Target_Dependent_Values; + ---------------------------------- + -- Read_Target_Dependent_Values -- + ---------------------------------- + + procedure Read_Target_Dependent_Values (File_Name : String) is + File_Desc : File_Descriptor; + N : Natural; + + type ANat is access all Natural; + -- Pointer to Nat or Pos value (it is harmless to treat Pos values + -- as Nat via Unchecked_Conversion). + + function To_ANat is new Unchecked_Conversion (Address, ANat); + + VP : ANat; + + Buffer : String (1 .. 2000); + Buflen : Natural; + -- File information and length (2000 easily enough) + + Nam_Buf : String (1 .. 40); + Nam_Len : Natural; + + procedure Check_Spaces; + -- Checks that we have one or more spaces and skips them + + procedure FailN (S : String); + -- Calls Fail adding " name in file xxx", where name is the currently + -- gathered name in Nam_Buf, surrounded by quotes, and xxx is the + -- name of the file. + + procedure Get_Name; + -- Scan out name, leaving it in Nam_Buf with Nam_Len set. Calls + -- Skip_Spaces to skip any following spaces. Note that the name is + -- terminated by a sequence of at least two spaces. + + function Get_Nat return Natural; + -- N on entry points to decimal integer, scan out decimal integer + -- and return it, leaving N pointing to following space or LF. + + procedure Skip_Spaces; + -- Skip past spaces + + ------------------ + -- Check_Spaces -- + ------------------ + + procedure Check_Spaces is + begin + if N > Buflen or else Buffer (N) /= ' ' then + FailN ("missing space for"); + end if; + + Skip_Spaces; + return; + end Check_Spaces; + + ----------- + -- FailN -- + ----------- + + procedure FailN (S : String) is + begin + Fail (S & " """ & Nam_Buf (1 .. Nam_Len) & """ in file " + & File_Name); + end FailN; + + -------------- + -- Get_Name -- + -------------- + + procedure Get_Name is + begin + Nam_Len := 0; + + -- Scan out name and put it in Nam_Buf + + loop + if N > Buflen or else Buffer (N) = ASCII.LF then + FailN ("incorrectly formatted line for"); + end if; + + -- Name is terminated by two blanks + + exit when N < Buflen and then Buffer (N .. N + 1) = " "; + + Nam_Len := Nam_Len + 1; + + if Nam_Len > Nam_Buf'Last then + Fail ("name too long"); + end if; + + Nam_Buf (Nam_Len) := Buffer (N); + N := N + 1; + end loop; + + Check_Spaces; + end Get_Name; + + ------------- + -- Get_Nat -- + ------------- + + function Get_Nat return Natural is + Result : Natural := 0; + + begin + loop + if N > Buflen + or else Buffer (N) not in '0' .. '9' + or else Result > 999 + then + FailN ("bad value for"); + end if; + + Result := Result * 10 + (Character'Pos (Buffer (N)) - 48); + N := N + 1; + + exit when N <= Buflen + and then (Buffer (N) = ASCII.LF or else Buffer (N) = ' '); + end loop; + + return Result; + end Get_Nat; + + ----------------- + -- Skip_Spaces -- + ----------------- + + procedure Skip_Spaces is + begin + while N <= Buflen and Buffer (N) = ' ' loop + N := N + 1; + end loop; + end Skip_Spaces; + + -- Start of processing for Read_Target_Dependent_Values + + begin + File_Desc := Open_Read (File_Name, Text); + + if File_Desc = Invalid_FD then + Fail ("cannot read file " & File_Name); + end if; + + Buflen := Read (File_Desc, Buffer'Address, Buffer'Length); + + if Buflen = Buffer'Length then + Fail ("file is too long: " & File_Name); + end if; + + -- Scan through file for properly formatted entries in first section + + N := 1; + while N <= Buflen and then Buffer (N) /= ASCII.LF loop + Get_Name; + + -- Validate name and get corresponding value pointer + + VP := null; + + for J in DTN'Range loop + if DTN (J).all = Nam_Buf (1 .. Nam_Len) then + VP := To_ANat (DTV (J)); + DTR (J) := True; + exit; + end if; + end loop; + + if VP = null then + FailN ("unrecognized name"); + end if; + + -- Scan out value + + VP.all := Get_Nat; + + if N > Buflen or else Buffer (N) /= ASCII.LF then + FailN ("misformatted line for"); + end if; + + N := N + 1; -- skip LF + end loop; + + -- Fall through this loop when all lines in first section read. + -- Check that values have been supplied for all entries. + + for J in DTR'Range loop + if not DTR (J) then + Fail ("missing entry for " & DTN (J).all & " in file " + & File_Name); + end if; + end loop; + + -- Now acquire FPT entries + + if N >= Buflen then + Fail ("missing entries for FPT modes in file " & File_Name); + end if; + + if Buffer (N) = ASCII.LF then + N := N + 1; + else + Fail ("missing blank line in file " & File_Name); + end if; + + Num_FPT_Modes := 0; + while N <= Buflen loop + Get_Name; + + Num_FPT_Modes := Num_FPT_Modes + 1; + + declare + E : FPT_Mode_Entry renames FPT_Mode_Table (Num_FPT_Modes); + + begin + E.NAME := new String'(Nam_Buf (1 .. Nam_Len)); + + E.DIGS := Get_Nat; + Check_Spaces; + + case Buffer (N) is + when 'I' => + E.FLOAT_REP := IEEE_Binary; + when 'V' => + E.FLOAT_REP := VAX_Native; + when 'A' => + E.FLOAT_REP := AAMP; + when others => + FailN ("bad float rep field for"); + end case; + + N := N + 1; + Check_Spaces; + + E.PRECISION := Get_Nat; + Check_Spaces; + + E.ALIGNMENT := Get_Nat; + + if Buffer (N) /= ASCII.LF then + FailN ("junk at end of line for"); + end if; + + -- ??? We do not read E.SIZE, see Write_Target_Dependent_Values + + E.SIZE := + (E.PRECISION + E.ALIGNMENT - 1) / E.ALIGNMENT * E.ALIGNMENT; + + N := N + 1; + end; + end loop; + end Read_Target_Dependent_Values; + -- Package Initialization, set target dependent values. This must be done -- early on, before we start accessing various compiler packages, since -- these values are used all over the place. @@ -565,40 +823,6 @@ begin end loop; end; - -- If the switch is not set, we get all values from the back end - - if Opt.Target_Dependent_Info_Read_Name = null then - - -- Set values by direct calls to the back end - - Bits_BE := Get_Bits_BE; - Bits_Per_Unit := Get_Bits_Per_Unit; - Bits_Per_Word := Get_Bits_Per_Word; - Bytes_BE := Get_Bytes_BE; - Char_Size := Get_Char_Size; - Double_Float_Alignment := Get_Double_Float_Alignment; - Double_Scalar_Alignment := Get_Double_Scalar_Alignment; - Double_Size := Get_Double_Size; - Float_Size := Get_Float_Size; - Float_Words_BE := Get_Float_Words_BE; - Int_Size := Get_Int_Size; - Long_Double_Size := Get_Long_Double_Size; - Long_Long_Size := Get_Long_Long_Size; - Long_Size := Get_Long_Size; - Maximum_Alignment := Get_Maximum_Alignment; - Max_Unaligned_Field := Get_Max_Unaligned_Field; - Pointer_Size := Get_Pointer_Size; - Short_Enums := Get_Short_Enums; - Short_Size := Get_Short_Size; - Strict_Alignment := Get_Strict_Alignment; - System_Allocator_Alignment := Get_System_Allocator_Alignment; - Wchar_T_Size := Get_Wchar_T_Size; - Words_BE := Get_Words_BE; - - -- Register floating-point types from the back end - - Register_Back_End_Types (Register_Float_Type'Access); - -- Case of reading the target dependent values from file -- This is bit more complex than might be expected, because it has to be @@ -607,257 +831,50 @@ begin -- etc to read the file. We do this at the System.OS_Lib level since it is -- too early to be using Osint directly. + if Opt.Target_Dependent_Info_Read_Name /= null then + Read_Target_Dependent_Values (Target_Dependent_Info_Read_Name.all); else - Read_Target_Dependent_Values : declare - File_Desc : File_Descriptor; - N : Natural; - - type ANat is access all Natural; - -- Pointer to Nat or Pos value (it is harmless to treat Pos values - -- as Nat via Unchecked_Conversion). - - function To_ANat is new Unchecked_Conversion (Address, ANat); - - VP : ANat; - - Buffer : String (1 .. 2000); - Buflen : Natural; - -- File information and length (2000 easily enough) - - Nam_Buf : String (1 .. 40); - Nam_Len : Natural; - - procedure Check_Spaces; - -- Checks that we have one or more spaces and skips them - - procedure FailN (S : String); - -- Calls Fail adding " name in file xxx", where name is the currently - -- gathered name in Nam_Buf, surrounded by quotes, and xxx is the - -- name of the file. - - procedure Get_Name; - -- Scan out name, leaving it in Nam_Buf with Nam_Len set. Calls - -- Skip_Spaces to skip any following spaces. Note that the name is - -- terminated by a sequence of at least two spaces. - - function Get_Nat return Natural; - -- N on entry points to decimal integer, scan out decimal integer - -- and return it, leaving N pointing to following space or LF. - - procedure Skip_Spaces; - -- Skip past spaces - - ------------------ - -- Check_Spaces -- - ------------------ - - procedure Check_Spaces is - begin - if N > Buflen or else Buffer (N) /= ' ' then - FailN ("missing space for"); - end if; - - Skip_Spaces; - return; - end Check_Spaces; - - ----------- - -- FailN -- - ----------- - - procedure FailN (S : String) is - begin - Fail (S & " """ & Nam_Buf (1 .. Nam_Len) & """ in file " - & Target_Dependent_Info_Read_Name.all); - end FailN; - - -------------- - -- Get_Name -- - -------------- - - procedure Get_Name is - begin - Nam_Len := 0; - - -- Scan out name and put it in Nam_Buf - - loop - if N > Buflen or else Buffer (N) = ASCII.LF then - FailN ("incorrectly formatted line for"); - end if; - - -- Name is terminated by two blanks - - exit when N < Buflen and then Buffer (N .. N + 1) = " "; - - Nam_Len := Nam_Len + 1; - - if Nam_Len > Nam_Buf'Last then - Fail ("name too long"); - end if; - - Nam_Buf (Nam_Len) := Buffer (N); - N := N + 1; - end loop; - - Check_Spaces; - end Get_Name; - - ------------- - -- Get_Nat -- - ------------- - - function Get_Nat return Natural is - Result : Natural := 0; - - begin - loop - if N > Buflen - or else Buffer (N) not in '0' .. '9' - or else Result > 999 - then - FailN ("bad value for"); - end if; - - Result := Result * 10 + (Character'Pos (Buffer (N)) - 48); - N := N + 1; - - exit when N <= Buflen - and then (Buffer (N) = ASCII.LF or else Buffer (N) = ' '); - end loop; - - return Result; - end Get_Nat; - - ----------------- - -- Skip_Spaces -- - ----------------- - - procedure Skip_Spaces is - begin - while N <= Buflen and Buffer (N) = ' ' loop - N := N + 1; - end loop; - end Skip_Spaces; - - -- Start of processing for Read_Target_Dependent_Values + -- If the back-end comes with a target config file, then use it + -- to set the values + declare + Back_End_Config_File : constant String_Ptr := + Get_Back_End_Config_File; begin - File_Desc := Open_Read (Target_Dependent_Info_Read_Name.all, Text); + if Back_End_Config_File /= null then + Read_Target_Dependent_Values (Back_End_Config_File.all); - if File_Desc = Invalid_FD then - Fail ("cannot read file " & Target_Dependent_Info_Read_Name.all); - end if; + -- Otherwise we get all values from the back end directly - Buflen := Read (File_Desc, Buffer'Address, Buffer'Length); - - if Buflen = Buffer'Length then - Fail ("file is too long: " & Target_Dependent_Info_Read_Name.all); - end if; - - -- Scan through file for properly formatted entries in first section - - N := 1; - while N <= Buflen and then Buffer (N) /= ASCII.LF loop - Get_Name; - - -- Validate name and get corresponding value pointer - - VP := null; - - for J in DTN'Range loop - if DTN (J).all = Nam_Buf (1 .. Nam_Len) then - VP := To_ANat (DTV (J)); - DTR (J) := True; - exit; - end if; - end loop; - - if VP = null then - FailN ("unrecognized name"); - end if; - - -- Scan out value - - VP.all := Get_Nat; - - if N > Buflen or else Buffer (N) /= ASCII.LF then - FailN ("misformatted line for"); - end if; - - N := N + 1; -- skip LF - end loop; - - -- Fall through this loop when all lines in first section read. - -- Check that values have been supplied for all entries. - - for J in DTR'Range loop - if not DTR (J) then - Fail ("missing entry for " & DTN (J).all & " in file " - & Target_Dependent_Info_Read_Name.all); - end if; - end loop; - - -- Now acquire FPT entries - - if N >= Buflen then - Fail ("missing entries for FPT modes in file " - & Target_Dependent_Info_Read_Name.all); - end if; - - if Buffer (N) = ASCII.LF then - N := N + 1; else - Fail ("missing blank line in file " - & Target_Dependent_Info_Read_Name.all); + Bits_BE := Get_Bits_BE; + Bits_Per_Unit := Get_Bits_Per_Unit; + Bits_Per_Word := Get_Bits_Per_Word; + Bytes_BE := Get_Bytes_BE; + Char_Size := Get_Char_Size; + Double_Float_Alignment := Get_Double_Float_Alignment; + Double_Scalar_Alignment := Get_Double_Scalar_Alignment; + Double_Size := Get_Double_Size; + Float_Size := Get_Float_Size; + Float_Words_BE := Get_Float_Words_BE; + Int_Size := Get_Int_Size; + Long_Double_Size := Get_Long_Double_Size; + Long_Long_Size := Get_Long_Long_Size; + Long_Size := Get_Long_Size; + Maximum_Alignment := Get_Maximum_Alignment; + Max_Unaligned_Field := Get_Max_Unaligned_Field; + Pointer_Size := Get_Pointer_Size; + Short_Enums := Get_Short_Enums; + Short_Size := Get_Short_Size; + Strict_Alignment := Get_Strict_Alignment; + System_Allocator_Alignment := Get_System_Allocator_Alignment; + Wchar_T_Size := Get_Wchar_T_Size; + Words_BE := Get_Words_BE; + + -- Register floating-point types from the back end + + Register_Back_End_Types (Register_Float_Type'Access); end if; - - Num_FPT_Modes := 0; - while N <= Buflen loop - Get_Name; - - Num_FPT_Modes := Num_FPT_Modes + 1; - - declare - E : FPT_Mode_Entry renames FPT_Mode_Table (Num_FPT_Modes); - - begin - E.NAME := new String'(Nam_Buf (1 .. Nam_Len)); - - E.DIGS := Get_Nat; - Check_Spaces; - - case Buffer (N) is - when 'I' => - E.FLOAT_REP := IEEE_Binary; - when 'V' => - E.FLOAT_REP := VAX_Native; - when 'A' => - E.FLOAT_REP := AAMP; - when others => - FailN ("bad float rep field for"); - end case; - - N := N + 1; - Check_Spaces; - - E.PRECISION := Get_Nat; - Check_Spaces; - - E.ALIGNMENT := Get_Nat; - - if Buffer (N) /= ASCII.LF then - FailN ("junk at end of line for"); - end if; - - -- ??? We do not read E.SIZE, see Write_Target_Dependent_Values - - E.SIZE := - (E.PRECISION + E.ALIGNMENT - 1) / E.ALIGNMENT * E.ALIGNMENT; - - N := N + 1; - end; - end loop; - end Read_Target_Dependent_Values; + end; end if; end Set_Targ;