diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 22 | ||||
| -rw-r--r-- | gcc/ada/bld.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 64 | ||||
| -rw-r--r-- | gcc/ada/gprcmd.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/init.c | 81 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 14 |
7 files changed, 122 insertions, 83 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 28a8259..4605412 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2004-02-20 Robert Dewar <dewar@gnat.com> + + * bld.adb, exp_util.adb, gprcmd.adb: Minor reformatting + +2004-02-20 Ed Schonberg <schonberg@gnat.com> + + * freeze.adb (Freeze_Record_Type): Generalize mechanism that generates + itype references for the constrained designated type of a component + whose base type is already frozen. + +2004-02-20 Arnaud Charlet <charlet@act-europe.fr> + + * init.c (__gnat_error_handler [tru64]): Rewrite previous change to + avoid GCC warnings. + +2004-02-20 Sergey Rybin <rybin@act-europe.fr> + + * sem_ch12.adb (Analyze_Formal_Package): Create a new defining + identifier for a phantom package that rewrites the formal package + declaration with a box. The Add semantic decorations for the defining + identifier from the original node (that represents the formal package). + 2004-02-19 Matt Kraai <kraai@alumni.cmu.edu> * Make-lang.in (ada/stamp-sdefault): Use the top level diff --git a/gcc/ada/bld.adb b/gcc/ada/bld.adb index fef76a0..59a4ac0 100644 --- a/gcc/ada/bld.adb +++ b/gcc/ada/bld.adb @@ -1972,16 +1972,16 @@ package body Bld is elsif Pkg = Snames.Name_Linker then if Item_Name = Snames.Name_Linker_Options then - -- Only add linker options if this is not the root - -- project. + + -- Only add linker options if this is not the + -- root project. Put ("ifeq ($("); Put (Project_Name); Put (".root),False)"); New_Line; - -- Add the linker options to FLDFLAGS, in reverse - -- order. + -- Add linker options to FLDFLAGS in reverse order Put (" FLDFLAGS:=$(shell gprcmd linkopts $("); Put (Project_Name); @@ -1994,10 +1994,10 @@ package body Bld is Put ("endif"); New_Line; - else - -- Other attribute are of no interest; suppress - -- their declarations. + -- Other attributes are of no interest. Suppress + -- their declarations. + else Put_Declaration := False; end if; end if; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index d5a7a41..1abb7a2 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -3353,8 +3353,7 @@ package body Exp_Util is when N_Character_Literal | N_Integer_Literal | N_Real_Literal | - N_String_Literal - => + N_String_Literal => return True; -- We consider that anything else has side effects. This is a bit diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 90f4e64..73861b7 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1473,6 +1473,41 @@ package body Freeze is -- Set True if we find at least one component with a component -- clause (used to warn about useless Bit_Order pragmas). + procedure Check_Itype (Desig : Entity_Id); + -- If the component subtype is an access to a constrained subtype + -- of an already frozen type, make the subtype frozen as well. It + -- might otherwise be frozen in the wrong scope, and a freeze node + -- on subtype has no effect. + + procedure Check_Itype (Desig : Entity_Id) is + begin + if not Is_Frozen (Desig) + and then Is_Frozen (Base_Type (Desig)) + then + Set_Is_Frozen (Desig); + + -- In addition, add an Itype_Reference to ensure that the + -- access subtype is elaborated early enough. This cannot + -- be done if the subtype may depend on discriminants. + + if Ekind (Comp) = E_Component + and then Is_Itype (Etype (Comp)) + and then not Has_Discriminants (Rec) + then + IR := Make_Itype_Reference (Sloc (Comp)); + Set_Itype (IR, Desig); + + if No (Result) then + Result := New_List (IR); + else + Append (IR, Result); + end if; + end if; + end if; + end Check_Itype; + + -- Start of processing for Freeze_Record_Type + begin -- If this is a subtype of a controlled type, declared without -- a constraint, the _controller may not appear in the component @@ -1548,40 +1583,19 @@ package body Freeze is Loc, Result); end if; + elsif Is_Itype (Designated_Type (Etype (Comp))) then + Check_Itype (Designated_Type (Etype (Comp))); + else Freeze_And_Append (Designated_Type (Etype (Comp)), Loc, Result); end if; end; - -- If this is a constrained subtype of an already frozen type, - -- make the subtype frozen as well. It might otherwise be frozen - -- in the wrong scope, and a freeze node on subtype has no effect. - elsif Is_Access_Type (Etype (Comp)) - and then not Is_Frozen (Designated_Type (Etype (Comp))) and then Is_Itype (Designated_Type (Etype (Comp))) - and then Is_Frozen (Base_Type (Designated_Type (Etype (Comp)))) then - Set_Is_Frozen (Designated_Type (Etype (Comp))); - - -- In addition, add an Itype_Reference to ensure that the - -- access subtype is elaborated early enough. This cannot - -- be done if the subtype may depend on discriminants. - - if Ekind (Comp) = E_Component - and then Is_Itype (Etype (Comp)) - and then not Has_Discriminants (Rec) - then - IR := Make_Itype_Reference (Sloc (Comp)); - Set_Itype (IR, Designated_Type (Etype (Comp))); - - if No (Result) then - Result := New_List (IR); - else - Append (IR, Result); - end if; - end if; + Check_Itype (Designated_Type (Etype (Comp))); elsif Is_Array_Type (Etype (Comp)) and then Is_Access_Type (Component_Type (Etype (Comp))) diff --git a/gcc/ada/gprcmd.adb b/gcc/ada/gprcmd.adb index 9c4dea3..b6658e1 100644 --- a/gcc/ada/gprcmd.adb +++ b/gcc/ada/gprcmd.adb @@ -454,19 +454,20 @@ begin Dir : constant String := Argument (2); begin - for J in 3 .. Argument_Count loop - - -- Remove quotes that may have been added around each argument + -- Loop to remove quotes that may have been added around arguments + for J in 3 .. Argument_Count loop declare Arg : constant String := Argument (J); First : Natural := Arg'First; Last : Natural := Arg'Last; + begin if Arg (First) = '"' and then Arg (Last) = '"' then First := First + 1; Last := Last - 1; end if; + if Is_Absolute_Path (Arg (First .. Last)) then Extend (Format_Pathname (Arg (First .. Last), UNIX)); else diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 7db7f1f..f160255 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -388,6 +388,7 @@ __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context) static int recurse = 0; struct sigcontext *mstate; const char *msg; + jmp_buf handler_jmpbuf; /* If this was an explicit signal from a "kill", just resignal it. */ if (SI_FROMUSER (sip)) @@ -397,6 +398,43 @@ __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context) } /* Otherwise, treat it as something we handle. */ + + /* We are now going to raise the exception corresponding to the signal we + caught, which may eventually end up resuming the application code if the + exception is handled. + + When the exception is handled, merely arranging for the *exception* + handler's context (stack pointer, program counter, other registers, ...) + to be installed is *not* enough to let the kernel think we've left the + *signal* handler. This has annoying implications if an alternate stack + has been setup for this *signal* handler, because the kernel thinks we + are still running on that alternate stack even after the jump, which + causes trouble at least as soon as another signal is raised. + + We deal with this by forcing a "local" longjmp within the signal handler + below, forcing the "on alternate stack" indication to be reset (kernel + wise) on the way. If no alternate stack has been setup, this should be a + neutral operation. Otherwise, we will be in a delicate situation for a + short while because we are going to run the exception propagation code + within the alternate stack area (that is, with the stack pointer inside + the alternate stack bounds), but with the corresponding flag off from the + kernel's standpoint. We expect this to be ok as long as the propagation + code does not trigger a signal itself, which is expected. + + ??? A better approach would be to at least delay this operation until the + last second, that is, until just before we jump to the exception handler, + if any. */ + + if (setjmp (handler_jmpbuf) == 0) + { +#define JB_ONSIGSTK 0 + + /* Arrange for the "on alternate stack" flag to be reset. See the + comments around "jmp_buf offsets" in /usr/include/setjmp.h. */ + handler_jmpbuf [JB_ONSIGSTK] = 0; + longjmp (handler_jmpbuf, 1); + } + switch (sig) { case SIGSEGV: @@ -448,48 +486,7 @@ __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context) if (mstate != 0) *mstate = *context; - /* We are now going to raise the exception corresponding to the signal we - caught, which may eventually end up resuming the application code if the - exception is handled. - - When the exception is handled, merely arranging for the *exception* - handler's context (stack pointer, program counter, other registers, ...) - to be installed is *not* enough to let the kernel think we've left the - *signal* handler. This has annoying implications if an alternate stack - has been setup for this *signal* handler, because the kernel thinks we - are still running on that alternate stack even after the jump, which - causes trouble at least as soon as another signal is raised. - - We deal with this by forcing a "local" longjmp within the signal handler - below, forcing the "on alternate stack" indication to be reset (kernel - wise) on the way. If no alternate stack has been setup, this should be a - neutral operation. Otherwise, we will be in a delicate situation for a - short while because we are going to run the exception propagation code - within the alternate stack area (that is, with the stack pointer inside - the alternate stack bounds), but with the corresponding flag off from the - kernel's standpoint. We expect this to be ok as long as the propagation - code does not trigger a signal itself, which is expected. - - ??? A better approach would be to at least delay this operation until the - last second, that is, until just before we jump to the exception handler, - if any. */ - { - jmp_buf handler_jmpbuf; - - if (setjmp (handler_jmpbuf) != 0) - Raise_From_Signal_Handler (exception, (char *) msg); - else - { - /* Arrange for the "on alternate stack" flag to be reset. See the - comments around "jmp_buf offsets" in /usr/include/setjmp.h. */ - struct sigcontext * handler_context - = (struct sigcontext *) & handler_jmpbuf; - - handler_context->sc_onstack = 0; - - longjmp (handler_jmpbuf, 1); - } - } + Raise_From_Signal_Handler (exception, (char *) msg); } void diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 4b233df..4a83b46 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1578,7 +1578,8 @@ package body Sem_Ch12 is procedure Analyze_Formal_Package (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); - Formal : constant Entity_Id := Defining_Identifier (N); + Pack_Id : constant Entity_Id := Defining_Identifier (N); + Formal : Entity_Id; Gen_Id : constant Node_Id := Name (N); Gen_Decl : Node_Id; Gen_Unit : Entity_Id; @@ -1653,8 +1654,6 @@ package body Sem_Ch12 is -- and analyze it like a regular package, except that we treat the -- formals as additional visible components. - Set_Instance_Env (Gen_Unit, Formal); - Gen_Decl := Unit_Declaration_Node (Gen_Unit); if In_Extended_Main_Source_Unit (N) then @@ -1662,11 +1661,13 @@ package body Sem_Ch12 is Generate_Reference (Gen_Unit, N); end if; + Formal := New_Copy (Pack_Id); New_N := Copy_Generic_Node (Original_Node (Gen_Decl), Empty, Instantiating => True); - Set_Defining_Unit_Name (Specification (New_N), Formal); Rewrite (N, New_N); + Set_Defining_Unit_Name (Specification (New_N), Formal); + Set_Instance_Env (Gen_Unit, Formal); Enter_Name (Formal); Set_Ekind (Formal, E_Generic_Package); @@ -1728,6 +1729,11 @@ package body Sem_Ch12 is Set_Ekind (Formal, E_Package); Set_Generic_Parent (Specification (N), Gen_Unit); Set_Has_Completion (Formal, True); + + Set_Ekind (Pack_Id, E_Package); + Set_Etype (Pack_Id, Standard_Void_Type); + Set_Scope (Pack_Id, Scope (Formal)); + Set_Has_Completion (Pack_Id, True); end if; end Analyze_Formal_Package; |