diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 22 | ||||
| -rw-r--r-- | gcc/ada/atree.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 17 | ||||
| -rw-r--r-- | gcc/ada/exp_unst.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/frontend.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/gnat1drv.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/osint-c.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/osint-c.ads | 22 | ||||
| -rw-r--r-- | gcc/ada/osint.ads | 11 | ||||
| -rw-r--r-- | gcc/ada/sem.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 37 |
14 files changed, 133 insertions, 44 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cdc6c04..e2b22dd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2015-05-22 Robert Dewar <dewar@adacore.com> + + * debug.adb: Update documentation. + * einfo.ads, einfo.adb (Needs_Typedef): New flag + * exp_unst.adb (Unnest_Subprogram): Mark AREC types as needing + typedef's in C. + * frontend.adb: Update comments. + * gnat1drv.adb (Adjust_Global_Switches): Set all needed flags + for -gnatd.V + * opt.ads (Generate_C_Code): New switch. + * osint-c.adb (Write_C_File_Info): Removed, not used + (Write_H_File_Info): Removed, not used + * osint-c.ads (Write_C_File_Info): Removed, not used + (Write_H_File_Info): Removed, not used + * osint.ads (Write_Info): Minor comment updates. + (Output_FD): Moved from private part to public part of spec. + * sem.adb (Semantics): Force expansion on if in Generate_C_Code + mode. + * atree.ads: minor typo in comment. + * sem_prag.adb (Process_Atomic_Independent_Shared_Volatile): + Do not allow VFA on composite object with aliased component. + 2015-05-22 Arnaud Charlet <charlet@adacore.com> * osint-c.adb, osint-c.ads (Set_File_Name): Move back to spec. diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index e217ca0..7ed476f 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -4138,7 +4138,7 @@ package Atree is -- These flags are used in the usual manner in Sinfo and Einfo Is_Ignored_Ghost_Node : Boolean; - -- Flag denothing whether the node is subject to pragma Ghost with + -- Flag denoting whether the node is subject to pragma Ghost with -- policy Ignore. The name of the flag should be Flag4, however this -- requires changing the names of all remaining 300+ flags. diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 116fcfc..d338074 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -689,11 +689,11 @@ package body Debug is -- the order in which units are walked. This is primarily for use in -- debugging CodePeer mode. - -- d.X A previous version of GNAT allowed indexing aspects to be - -- redefined on derived container types, while the default iterator - -- was inherited from the aprent type. This non-standard extension - -- is preserved temporarily for use by the modelling project under - -- debug flag d.X. + -- d.X A previous version of GNAT allowed indexing aspects to be redefined + -- on derived container types, while the default iterator was + -- inherited from the aprent type. This non-standard extension is + -- preserved temporarily for use by the modelling project under debug + -- flag d.X. -- d.Z Normally we always enable expansion in configurable run-time mode -- to make sure we get error messages about unsupported features even diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 78ad3dc..0243356 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -592,8 +592,8 @@ package body Einfo is -- Is_Uplevel_Referenced_Entity Flag283 -- Is_Unimplemented Flag284 -- Has_Volatile_Full_Access Flag285 + -- Needs_Typedef Flag286 - -- (unused) Flag286 -- (unused) Flag287 -- (unused) Flag288 -- (unused) Flag289 @@ -2644,6 +2644,12 @@ package body Einfo is return Flag22 (Id); end Needs_No_Actuals; + function Needs_Typedef (Id : E) return B is + begin + pragma Assert (Is_Type (Id)); + return Flag286 (Id); + end Needs_Typedef; + function Never_Set_In_Source (Id : E) return B is begin return Flag115 (Id); @@ -5601,6 +5607,12 @@ package body Einfo is Set_Flag22 (Id, V); end Set_Needs_No_Actuals; + procedure Set_Needs_Typedef (Id : E; V : B := True) is + begin + pragma Assert (Is_Type (Id)); + Set_Flag286 (Id, V); + end Set_Needs_Typedef; + procedure Set_Never_Set_In_Source (Id : E; V : B := True) is begin Set_Flag115 (Id, V); @@ -8834,6 +8846,7 @@ package body Einfo is W ("Must_Have_Preelab_Init", Flag208 (Id)); W ("Needs_Debug_Info", Flag147 (Id)); W ("Needs_No_Actuals", Flag22 (Id)); + W ("Needs_Typedef", Flag286 (Id)); W ("Never_Set_In_Source", Flag115 (Id)); W ("No_Dynamic_Predicate_On_actual", Flag276 (Id)); W ("No_Pool_Assigned", Flag131 (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index f687d3d..5fe5da8 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1405,7 +1405,9 @@ package Einfo is -- Has_Aliased_Components (Flag135) [implementation base type only] -- Defined in array type entities. Indicates that the component type --- of the array is aliased. +-- of the array is aliased. Should this also be set for records to +-- indicate that at least one component is aliased (see processing in +-- Sem_Prag.Process_Atomic_Independent_Shared_Volatile???) -- Has_Alignment_Clause (Flag46) -- Defined in all type entities and objects. Indicates if an alignment @@ -3348,6 +3350,14 @@ package Einfo is -- interpreted as an indexing of the result of the call. It is also -- used to resolve various cases of entry calls. +-- Needs_Typedef (Flag286) +-- Defined for all types and subtypes. Set if it is essential to generate +-- a typedef when we are generating C code from Cprint. Normally we +-- generate typedef's only for source entities, and not for internally +-- generated types, but there are cases, notably the AREC types generated +-- in Exp_Unst when we are unnesting subprograms where we must generate +-- typedef's for non-source types. + -- Never_Set_In_Source (Flag115) -- Defined in all entities, but can be set only for variables and -- parameters. This flag is set if the object is never assigned a value @@ -5441,6 +5451,7 @@ package Einfo is -- May_Inherit_Delayed_Rep_Aspects (Flag262) -- Must_Be_On_Byte_Boundary (Flag183) -- Must_Have_Preelab_Init (Flag208) + -- Needs_Typedef (Flag286) -- Optimize_Alignment_Space (Flag241) -- Optimize_Alignment_Time (Flag242) -- Partial_View_Has_Unknown_Discr (Flag280) @@ -6965,6 +6976,7 @@ package Einfo is function Must_Have_Preelab_Init (Id : E) return B; function Needs_Debug_Info (Id : E) return B; function Needs_No_Actuals (Id : E) return B; + function Needs_Typedef (Id : E) return B; function Never_Set_In_Source (Id : E) return B; function Next_Inlined_Subprogram (Id : E) return E; function No_Dynamic_Predicate_On_Actual (Id : E) return B; @@ -7622,6 +7634,7 @@ package Einfo is procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True); procedure Set_Needs_Debug_Info (Id : E; V : B := True); procedure Set_Needs_No_Actuals (Id : E; V : B := True); + procedure Set_Needs_Typedef (Id : E; V : B := True); procedure Set_Never_Set_In_Source (Id : E; V : B := True); procedure Set_Next_Inlined_Subprogram (Id : E; V : E); procedure Set_No_Dynamic_Predicate_On_Actual (Id : E; V : B := True); @@ -8433,6 +8446,7 @@ package Einfo is pragma Inline (Must_Have_Preelab_Init); pragma Inline (Needs_Debug_Info); pragma Inline (Needs_No_Actuals); + pragma Inline (Needs_Typedef); pragma Inline (Never_Set_In_Source); pragma Inline (Next_Index); pragma Inline (Next_Inlined_Subprogram); @@ -8890,6 +8904,7 @@ package Einfo is pragma Inline (Set_Must_Have_Preelab_Init); pragma Inline (Set_Needs_Debug_Info); pragma Inline (Set_Needs_No_Actuals); + pragma Inline (Set_Needs_Typedef); pragma Inline (Set_Never_Set_In_Source); pragma Inline (Set_Next_Inlined_Subprogram); pragma Inline (Set_No_Dynamic_Predicate_On_Actual); diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index a857259..94f2969 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -1327,6 +1327,11 @@ package body Exp_Unst is Analyze (Decl_ARECnP, Suppress => All_Checks); Pop_Scope; + -- Mark the types as needing typedefs + + Set_Needs_Typedef (STJ.ARECnT); + Set_Needs_Typedef (STJ.ARECnPT); + -- Next step, for each uplevel referenced entity, add -- assignment operations to set the component in the -- activation record. diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index ba90379..b3c85f1 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -482,8 +482,8 @@ begin Sprint.Source_Dump; - -- Check again for configuration pragmas that appear in the context of - -- the main unit. These pragmas only affect the main unit, and the + -- Check again for configuration pragmas that appear in the context + -- of the main unit. These pragmas only affect the main unit, and the -- corresponding flag is reset after each call to Semantics, but they -- may affect the generated ali for the unit, and therefore the flag -- must be set properly after compilation. Currently we only check for diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 9a11a52..06d30ff 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -142,6 +142,13 @@ procedure Gnat1drv is Modify_Tree_For_C := True; end if; + -- Other flags set if we are generating C code + + if Debug_Flag_Dot_VV then + Generate_C_Code := True; + Unnest_Subprogram_Mode := True; + end if; + -- -gnatd.E sets Error_To_Warning mode, causing selected error messages -- to be treated as warnings instead of errors. diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 7fd019a..3a75e36 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -694,6 +694,11 @@ package Opt is -- the name is of the form .xxx, then to name.xxx where name is the source -- file name with extension stripped. + Generate_C_Code : Boolean := False; + -- GNAT + -- If True, the Cprint circuitry to generate C code output is activated. + -- Set True by use of -gnatd.V. + Generate_CodePeer_Messages : Boolean := False; -- GNAT -- Generate CodePeer messages. Ignored if CodePeer_Mode is false. This is diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb index 33e0a92..dcbace2 100644 --- a/gcc/ada/osint-c.adb +++ b/gcc/ada/osint-c.adb @@ -518,23 +518,11 @@ package body Osint.C is end Tree_Create; ----------------------- - -- Write_C_File_Info -- - ----------------------- - - procedure Write_C_File_Info (Info : String) renames Write_Info; - - ----------------------- -- Write_Debug_Info -- ----------------------- procedure Write_Debug_Info (Info : String) renames Write_Info; - ----------------------- - -- Write_H_File_Info -- - ----------------------- - - procedure Write_H_File_Info (Info : String) renames Write_Info; - ------------------------ -- Write_Library_Info -- ------------------------ diff --git a/gcc/ada/osint-c.ads b/gcc/ada/osint-c.ads index 177d1f1..afd4e84 100644 --- a/gcc/ada/osint-c.ads +++ b/gcc/ada/osint-c.ads @@ -108,6 +108,12 @@ package Osint.C is -- Close current debug file created by the most recent call to -- Create_Repinfo_File. + procedure Set_File_Name (Ext : String); + -- Sets a default file name from the main compiler source name. Ext is the + -- extension, e.g. "ali" for a library information file. The name is in + -- Name_Buffer (with length in Name_Len) on return. This is visible in + -- the spec since it used directly by clients in the .Net case. + -------------------------------- -- Library Information Output -- -------------------------------- @@ -127,11 +133,6 @@ package Osint.C is -- returned by Next_Main_Source) for appending. This is used to append -- the globals computed in flow analysis in gnatprove mode. - procedure Set_File_Name (Ext : String); - -- Sets a default file name from the main compiler source name. Ext is - -- the extension, e.g. "ali" for a library information file. - -- The name is in Name_Buffer (with length in Name_Len) on return. - procedure Write_Library_Info (Info : String); -- Writes the contents of the referenced string to the library information -- file for the main source file currently being compiled (i.e. the file @@ -161,7 +162,8 @@ package Osint.C is -- These routines are used by the compiler when the C translation option -- is activated to write *.c and *.h files to the current object directory. -- Each routine exists in a C and an H form for the two kinds of files. - -- Only one of these files can be written at a time. + -- Only one of these files can be written at a time. Note that the files + -- are written via the Output package routines, using Output_FD. procedure Create_C_File; procedure Create_H_File; @@ -169,14 +171,6 @@ package Osint.C is -- being compiled (i.e. the file which was most recently returned by -- Next_Main_Source). - procedure Write_C_File_Info (Info : String); - procedure Write_H_File_Info (Info : String); - -- Writes the contents of the referenced string to the *.c or *.h file for - -- the main source file currently being compiled (i.e. the file which was - -- most recently opened with a call to Read_Next_File). Info represents - -- a line in the file with a line termination character at the end (which - -- is not present in the info string). - procedure Close_C_File; procedure Close_H_File; -- Closes the file created by Create_C_File or Create_H file, flushing any diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index 5d25798..6347e4d 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -52,6 +52,10 @@ package Osint is Project_Include_Path_File : constant String := "ADA_PRJ_INCLUDE_FILE"; Project_Objects_Path_File : constant String := "ADA_PRJ_OBJECTS_FILE"; + Output_FD : File_Descriptor; + -- File descriptor for current library info, list, tree, C, H, or binder + -- output. Only one of these is open at a time, so we need only one FD. + procedure Initialize; -- Initialize internal tables @@ -692,10 +696,6 @@ private Target_Object_Suffix : constant String := Get_Target_Object_Suffix.all; -- The suffix used for the target object files - Output_FD : File_Descriptor; - -- File descriptor for current library info, list, tree, C, H, or binder - -- output. Only one of these is open at a time, so we need only one FD. - Output_File_Name : File_Name_Type; -- File_Name_Type for name of open file whose FD is in Output_FD, the name -- stored does not include the trailing NUL character. @@ -760,8 +760,7 @@ private -- for this file. This routine merely constructs the name. procedure Write_Info (Info : String); - -- Implement Write_Binder_Info, Write_Debug_Info, Write_C_File_Info, - -- Write_H_File_Info, and Write_Library_Info (identical) + -- Implement Write_Binder_Info, Write_Debug_Info, and Write_Library_Info procedure Write_With_Check (A : Address; N : Integer); -- Writes N bytes from buffer starting at address A to file whose FD is diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 4451add..0f8f173 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -1440,10 +1440,14 @@ package body Sem is (Operating_Mode = Generate_Code - -- or if special debug flag -gnatdx is set + -- Or if special debug flag -gnatdx is set or else Debug_Flag_X + -- Or if we are generating C code + + or else Generate_C_Code + -- Or if in configuration run-time mode. We do this so we get -- error messages about missing entities in the run-time even -- if we are compiling in -gnatc (no code generation) mode. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 6d4ef45..43c1305 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5898,6 +5898,43 @@ package body Sem_Prag is ("cannot have Volatile_Full_Access and Atomic for same entity"); end if; + -- Check for applying VFA to an entity which has volatile component + + if Prag_Id = Pragma_Volatile_Full_Access then + declare + Comp : Entity_Id; + Aliased_Comp : Boolean := False; + -- Set True if aliased component present + + begin + if Is_Array_Type (Etype (E)) then + Aliased_Comp := Has_Aliased_Components (Etype (E)); + + -- Record case, too bad Has_Aliased_Components is not also + -- set for records, should it be ??? + + elsif Is_Record_Type (Etype (E)) then + Comp := First_Component_Or_Discriminant (Etype (E)); + while Present (Comp) loop + if Is_Aliased (Comp) + or else Is_Aliased (Etype (Comp)) + then + Aliased_Comp := True; + exit; + end if; + + Next_Component_Or_Discriminant (Comp); + end loop; + end if; + + if Aliased_Comp then + Error_Pragma + ("cannot apply Volatile_Full_Access (aliased component " + & "present)"); + end if; + end; + end if; + -- Now check appropriateness of the entity if Is_Type (E) then |