[multiple changes]
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). From-SVN: r78164
This commit is contained in:
Arnaud Charlet
parent
d80d3d9622
commit
6e059adb24
7 changed files with 122 additions and 83 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -454,19 +454,20 @@ begin
|
|||
Dir : constant String := Argument (2);
|
||||
|
||||
begin
|
||||
-- Loop to remove quotes that may have been added around arguments
|
||||
|
||||
for J in 3 .. Argument_Count loop
|
||||
|
||||
-- Remove quotes that may have been added around each argument
|
||||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue