+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
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);
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;
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
-- 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
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)))
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
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))
}
/* 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:
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
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;
-- 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
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);
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;
projects / thirdparty / gcc.git / commitdiff
