From e7b2d6bcdbfae9edf7a2aa223b4d11067d9ef48d Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 10 Nov 2003 17:30:00 +0000 Subject: 2003-11-10 Ed Falis * 5ytiitho.adb: (procStartHookAdd): Definition and call deleted * 5zinit.adb: (Install_Handler): Moved back to spec (Install_Signal_Handlers): Deleted * 5zthrini.adb: Added context clause for System.Storage_Elements (Register): Only handles creation of taskVar; initialization moved to Thread_Body_Enter. (Reset_TSD): Deleted; replaced by Thread_Body_Enter Added declaration of environment task secondary stack and initialization. * s-thread.adb: Implement bodies for thread body processing * s-thread.ads: Added comment identifying supported targets for pragma Thread_Body. 2003-11-10 Pascal Obry * adaint.c (_gnat_stat) [WIN32]: Check if name is not bigger than GNAT_MAX_PATH_LEN. * s-fileio.adb: (Open): Properly check for string length before copying into the buffer. Raises Name_Error if buffer is too small. Note that this was a potential buffer overflow. 2003-11-10 Arnaud Charlet * bindgen.adb, comperr.adb: Code clean ups. * gnatvsn.ads, gnatvsn.adb (Get_Gnat_Version_Type): New function. 2003-11-10 Sergey Rybin * gnat1drv.adb: Add call to Sem_Elim.Initialize. 2003-11-10 Vincent Celier * gprcmd.adb: (Gprcmd): Add new command "prefix" to get the prefix of the GNAT installation. * make.adb (Scan_Make_Arg): Transmit -nostdlib to the compiler * prj.adb: (Project_Empty): Add new boolean component Virtual * prj.ads: (Virtual_Prefix): New constant string (Project_Data): New boolean component Virtual * prj-nmsc.adb (Language_Independent_Check): Adjust error message when a library project is extended by a virtual extending project. * prj-part.adb: Modifications throughout to implement extending-all project, including: (Virtual_Hash, Processed_Hash): New hash tables (Create_Virtual_Extending_Project): New procedure (Look_For_Virtual_Projects_For): New procedure * prj-proc.adb: (Process): After checking the projects, if main project is an extending-all project, set the object directory of all virtual extending project to the object directory of the main project. Adjust error message when a virtual extending project has the same object directory as an project being extended. (Recursive_Process): If name starts with the virtual prefix, set Virtual to True in the project data. * prj-tree.adb: (Default_Project_Node): Add new boolean component Extending_All (Is_Extending_All): New function (Set_Is_Extending_All): New procedure * prj-tree.ads: (Is_Extending_All): New function (Set_Is_Extending_All): New procedure (Project_Node_Record): New boolean component Extending_All * switch-c.adb: (Scan_Front_End_Switches): Process -nostdlib * vms_data.ads: Add qualifier /NOSTD_LIBRARIES (-nostdlib) for the compiler * bld.adb (Recursive_Process): If MAKE_ROOT is not defined, call "gprcmd prefix" to define it. 2003-11-10 Thomas Quinot * einfo.ads: Fix a typo and remove an extraneous word in comments. * lib-load.adb: (Create_Dummy_Package_Unit): Set the scope of the entity for the created dummy package to Standard_Standard, not to itself, to defend other parts of the front-end against encoutering a cycle in the scope chain. * sem_ch10.adb: (Analyze_With_Clause): When setting the entities for the successive N_Expanded_Names that constitute the name of a child unit, do not attempt to go further than Standard_Standard in the chain of scopes. This case arises from the placeholder units created by Create_Dummy_Package_Unit in the case of a with_clause for a nonexistent child unit. 2003-11-10 Ed Schonberg * exp_ch6.adb: (Expand_Thread_Body): Place subprogram on scope stack, so that new declarations are given the proper scope. * sem_ch13.adb: (Check_Expr_Constants): Reject an expression that contains a constant created during expansion, and that appears after the object to which the address clause applies. * sem_ch5.adb (Check_Controlled_Array_Attribute): Subsidiary of Analyze_Iteration_Scheme, to rewrite a loop parameter specification that uses 'Range of a function call with controlled components, so that the function result can be finalized before starting the loop. * sem_ch8.adb: (Find_Selected_Component): Improve error message when prefix is an implicit dereference of an incomplete type. 2003-11-10 Robert Dewar * opt.ads: New Print_Standard flag for -gnatS switch * sem_ch13.adb: Remove some additional checks for unaligned arrays * cstand.adb (Create_Standard): Print out package standard if -gnatS switch set * debug.adb: Update doc for -gnatds to discuss relationship with new -gnatS flag * sinfo.adb: Add new field Entity_Or_Associated_Node * sinfo.ads: Add new field Entity_Or_Associated_Node Update documentation for Associated_Node and Entity fields to clarify relationship and usage. * sprint.adb: (Write_Id): Properly process Associated_Node field in generic template * switch-c.adb: Recognize new -gnatS switch for printing package Standard This replaces gnatpsta * usage.adb: Add line for new -gnatS switch for printing package Standard This replaces gnatpsta git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@73423 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/cstand.adb | 253 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 253 insertions(+) (limited to 'gcc/ada/cstand.adb') diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 93b84a86f27..9cad4bea44d 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -33,6 +33,7 @@ with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; with Opt; use Opt; +with Output; use Output; with Targparm; use Targparm; with Tbuild; use Tbuild; with Ttypes; use Ttypes; @@ -120,6 +121,9 @@ package body CStand is return Entity_Id; -- Builds a new entity for Standard + procedure Print_Standard; + -- Print representation of package Standard if switch set + procedure Set_Integer_Bounds (Id : Entity_Id; Typ : Entity_Id; @@ -1243,6 +1247,12 @@ package body CStand is -- The Error node has an Etype of Any_Type to help error recovery Set_Etype (Error, Any_Type); + + -- Print representation of standard if switch set + + if Opt.Print_Standard then + Print_Standard; + end if; end Create_Standard; ------------------------------------ @@ -1417,6 +1427,249 @@ package body CStand is return E; end New_Standard_Entity; + -------------------- + -- Print_Standard -- + -------------------- + + procedure Print_Standard is + + procedure P (Item : String) renames Output.Write_Line; + -- Short-hand, since we do a lot of line writes here! + + procedure P_Int_Range (Size : Pos); + -- Prints the range of an integer based on its Size + + procedure P_Float_Range (Id : Entity_Id); + -- Prints the bounds range for the given float type entity + + ------------------- + -- P_Float_Range -- + ------------------- + + procedure P_Float_Range (Id : Entity_Id) is + Digs : constant Nat := UI_To_Int (Digits_Value (Id)); + + begin + Write_Str (" range "); + + if Vax_Float (Id) then + if Digs = VAXFF_Digits then + Write_Str (VAXFF_First'Universal_Literal_String); + Write_Str (" .. "); + Write_Str (VAXFF_Last'Universal_Literal_String); + + elsif Digs = VAXDF_Digits then + Write_Str (VAXDF_First'Universal_Literal_String); + Write_Str (" .. "); + Write_Str (VAXDF_Last'Universal_Literal_String); + + else + pragma Assert (Digs = VAXGF_Digits); + + Write_Str (VAXGF_First'Universal_Literal_String); + Write_Str (" .. "); + Write_Str (VAXGF_Last'Universal_Literal_String); + end if; + + elsif Is_AAMP_Float (Id) then + if Digs = AAMPS_Digits then + Write_Str (AAMPS_First'Universal_Literal_String); + Write_Str (" .. "); + Write_Str (AAMPS_Last'Universal_Literal_String); + + else + pragma Assert (Digs = AAMPL_Digits); + Write_Str (AAMPL_First'Universal_Literal_String); + Write_Str (" .. "); + Write_Str (AAMPL_Last'Universal_Literal_String); + end if; + + elsif Digs = IEEES_Digits then + Write_Str (IEEES_First'Universal_Literal_String); + Write_Str (" .. "); + Write_Str (IEEES_Last'Universal_Literal_String); + + + elsif Digs = IEEEL_Digits then + Write_Str (IEEEL_First'Universal_Literal_String); + Write_Str (" .. "); + Write_Str (IEEEL_Last'Universal_Literal_String); + + else + pragma Assert (Digs = IEEEX_Digits); + + Write_Str (IEEEX_First'Universal_Literal_String); + Write_Str (" .. "); + Write_Str (IEEEX_Last'Universal_Literal_String); + end if; + + Write_Str (";"); + Write_Eol; + end P_Float_Range; + + ----------------- + -- P_Int_Range -- + ----------------- + + procedure P_Int_Range (Size : Pos) is + begin + Write_Str (" is range -(2 **"); + Write_Int (Size - 1); + Write_Str (")"); + Write_Str (" .. +(2 **"); + Write_Int (Size - 1); + Write_Str (" - 1);"); + Write_Eol; + end P_Int_Range; + + -- Start of processing for Print_Standard + + begin + P ("-- Representation of package Standard"); + Write_Eol; + P ("-- This is not accurate Ada, since new base types cannot be "); + P ("-- created, but the listing shows the target dependent"); + P ("-- characteristics of the Standard types for this compiler"); + Write_Eol; + + P ("package Standard is"); + P ("pragma Pure(Standard);"); + Write_Eol; + + P (" type Boolean is (False, True);"); + P (" for Boolean'Size use 1;"); + P (" for Boolean use (False => 0, True => 1);"); + Write_Eol; + + -- Integer types + + Write_Str (" type Integer"); + P_Int_Range (Standard_Integer_Size); + Write_Str (" for Integer'Size use "); + Write_Int (Standard_Integer_Size); + P (";"); + Write_Eol; + + P (" subtype Natural is Integer range 0 .. Integer'Last;"); + P (" subtype Positive is Integer range 1 .. Integer'Last;"); + Write_Eol; + + Write_Str (" type Short_Short_Integer"); + P_Int_Range (Standard_Short_Short_Integer_Size); + Write_Str (" for Short_Short_Integer'Size use "); + Write_Int (Standard_Short_Short_Integer_Size); + P (";"); + Write_Eol; + + Write_Str (" type Short_Integer"); + P_Int_Range (Standard_Short_Integer_Size); + Write_Str (" for Short_Integer'Size use "); + Write_Int (Standard_Short_Integer_Size); + P (";"); + Write_Eol; + + Write_Str (" type Long_Integer"); + P_Int_Range (Standard_Long_Integer_Size); + Write_Str (" for Long_Integer'Size use "); + Write_Int (Standard_Long_Integer_Size); + P (";"); + Write_Eol; + + Write_Str (" type Long_Long_Integer"); + P_Int_Range (Standard_Long_Long_Integer_Size); + Write_Str (" for Long_Long_Integer'Size use "); + Write_Int (Standard_Long_Long_Integer_Size); + P (";"); + Write_Eol; + + -- Floating point types + + Write_Str (" type Short_Float is digits "); + Write_Int (Standard_Short_Float_Digits); + Write_Eol; + P_Float_Range (Standard_Short_Float); + Write_Str (" for Short_Float'Size use "); + Write_Int (Standard_Short_Float_Size); + P (";"); + Write_Eol; + + Write_Str (" type Float is digits "); + Write_Int (Standard_Float_Digits); + Write_Eol; + P_Float_Range (Standard_Float); + Write_Str (" for Float'Size use "); + Write_Int (Standard_Float_Size); + P (";"); + Write_Eol; + + Write_Str (" type Long_Float is digits "); + Write_Int (Standard_Long_Float_Digits); + Write_Eol; + P_Float_Range (Standard_Long_Float); + Write_Str (" for Long_Float'Size use "); + Write_Int (Standard_Long_Float_Size); + P (";"); + Write_Eol; + + Write_Str (" type Long_Long_Float is digits "); + Write_Int (Standard_Long_Long_Float_Digits); + Write_Eol; + P_Float_Range (Standard_Long_Long_Float); + Write_Str (" for Long_Long_Float'Size use "); + Write_Int (Standard_Long_Long_Float_Size); + P (";"); + Write_Eol; + + P (" type Character is (...)"); + Write_Str (" for Character'Size use "); + Write_Int (Standard_Character_Size); + P (";"); + P (" -- See RM A.1(35) for details of this type"); + Write_Eol; + + P (" type Wide_Character is (...)"); + Write_Str (" for Wide_Character'Size use "); + Write_Int (Standard_Wide_Character_Size); + P (";"); + P (" -- See RM A.1(36) for details of this type"); + Write_Eol; + + P (" type String is array (Positive range <>) of Character;"); + P (" pragma Pack (String);"); + Write_Eol; + + P (" type Wide_String is array (Positive range <>)" & + " of Wide_Character;"); + P (" pragma Pack (Wide_String);"); + Write_Eol; + + -- Here it's OK to use the Duration type of the host compiler since + -- the implementation of Duration in GNAT is target independent. + + if Duration_32_Bits_On_Target then + P (" type Duration is delta 0.020"); + P (" range -((2 ** 31 - 1) * 0.020) .."); + P (" +((2 ** 31 - 1) * 0.020);"); + P (" for Duration'Small use 0.020;"); + else + P (" type Duration is delta 0.000000001"); + P (" range -((2 ** 63 - 1) * 0.000000001) .."); + P (" +((2 ** 63 - 1) * 0.000000001);"); + P (" for Duration'Small use 0.000000001;"); + end if; + + Write_Eol; + + P (" Constraint_Error : exception;"); + P (" Program_Error : exception;"); + P (" Storage_Error : exception;"); + P (" Tasking_Error : exception;"); + P (" Numeric_Error : exception renames Constraint_Error;"); + Write_Eol; + + P ("end Standard;"); + end Print_Standard; + ---------------------- -- Set_Float_Bounds -- ---------------------- -- cgit v1.2.1