+2012-07-17 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch9.adb: Minor code reorganization.
+ * exp_ch3.adb: Minor code improvement.
+
+2012-07-17 Tristan Gingold <gingold@adacore.com>
+
+ * seh_init.c (__gnat_SEH_error_handler): Not compiled anymore
+ on Windows 64 (+ SEH), as it is unused.
+
+2012-07-17 Tristan Gingold <gingold@adacore.com>
+
+ * treepr.ads (psloc): Declare.
+ * treepr.adb (psloc): New debug procedure to print a sloc.
+ (Print_Sloc): New procedure, from ...
+ (Print_Node_Subtree): ... this. Call Print_Sloc.
+
+2012-07-17 Javier Miranda <miranda@adacore.com>
+
+ * sem_prag.adb (CPP_Class): Transform obsolescent pragma CPP_Class into
+ CPP convention automatically.
+
2012-07-16 Tristan Gingold <gingold@adacore.com>
* gcc-interface/decl.c (intrin_return_compatible_p): Map Address to
-- to make it a valid Ada tree.
if Is_Empty_List (Stmts) then
- Append (New_Node (N_Null_Statement, Loc), Stmts);
+ Append (Make_Null_Statement (Loc), Stmts);
end if;
return Stmts;
procedure Ensure_Statement_Present (Loc : Source_Ptr; Alt : Node_Id) is
begin
if Opt.Suppress_Control_Flow_Optimizations
- and then Is_Empty_List (Statements (Alt))
+ and then Is_Empty_List (Statements (Alt))
then
Set_Statements (Alt, New_List (Make_Null_Statement (Loc)));
end if;
if Present (Unpack) then
Append_To (Conc_Typ_Stmts,
Make_Implicit_If_Statement (N,
-
Condition =>
Make_Or_Else (Loc,
Left_Opnd =>
Right_Opnd =>
New_Reference_To (RTE (
RE_POK_Protected_Entry), Loc)),
+
Right_Opnd =>
Make_Op_Eq (Loc,
Left_Opnd =>
Right_Opnd =>
New_Reference_To (RTE (RE_POK_Task_Entry), Loc))),
- Then_Statements =>
- Unpack));
+ Then_Statements => Unpack));
end if;
-- Generate:
Index : Int;
Proc : Node_Id)
is
- Choices : List_Id := No_List;
Astmt : constant Node_Id := Accept_Statement (Alt);
+ Choices : List_Id;
Alt_Stats : List_Id;
begin
Adjust_Condition (Condition (Alt));
- Alt_Stats := No_List;
+ Choices := New_List (Make_Integer_Literal (Loc, Index));
- if Present (Handled_Statement_Sequence (Astmt)) then
- Choices := New_List (
- Make_Integer_Literal (Loc, Index));
-
- Alt_Stats := New_List (
- Make_Procedure_Call_Statement (Sloc (Proc),
- Name => New_Reference_To (
- Defining_Unit_Name (Specification (Proc)), Sloc (Proc))));
- end if;
+ -- Accept with body
- if No (Alt_Stats) then
-
- -- Accept with no body, followed by trailing statements
+ if Present (Handled_Statement_Sequence (Astmt)) then
+ Alt_Stats :=
+ New_List (
+ Make_Procedure_Call_Statement (Sloc (Proc),
+ Name =>
+ New_Reference_To
+ (Defining_Unit_Name (Specification (Proc)),
+ Sloc (Proc))));
- Choices := New_List (Make_Integer_Literal (Loc, Index));
+ -- Accept with no body (followed by trailing statements)
- Alt_Stats := New_List;
+ else
+ Alt_Stats := Empty_List;
end if;
Ensure_Statement_Present (Sloc (Astmt), Alt);
Append_To (Trailing_List,
Make_Goto_Statement (Loc,
Name => New_Copy (Identifier (End_Lab))));
+
else
Lab := End_Lab;
end if;
}
}
+#if !(defined (_WIN64) && defined (__SEH__))
+
EXCEPTION_DISPOSITION
__gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
- void *EstablisherFrame,
+ void *EstablisherFrame ATTRIBUTE_UNUSED,
struct _CONTEXT* ContextRecord ATTRIBUTE_UNUSED,
void *DispatcherContext ATTRIBUTE_UNUSED)
{
if (exception == NULL)
{
-#if defined (_WIN64) && defined (__SEH__)
- /* On Windows x64, do not transform other exception as they could
- be caught by user (when SEH is used to propagate exceptions). */
- return;
-#else
exception = &program_error;
msg = "unhandled signal";
-#endif
}
#if ! defined (_WIN64)
Raise_From_Signal_Handler (exception, msg);
return 0; /* This is never reached, avoid compiler warning */
}
+#endif /* !(defined (_WIN64) && defined (__SEH__)) */
#if defined (_WIN64)
/* On x86_64 windows exception mechanism is no more based on a chained list
("'G'N'A'T pragma cpp'_class is now obsolete and has no " &
"effect; replace it by pragma import?", N);
end if;
+
+ Check_Arg_Count (1);
+
+ Rewrite (N,
+ Make_Pragma (Loc,
+ Chars => Name_Import,
+ Pragma_Argument_Associations =>
+ New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Make_Identifier (Loc, Name_CPP)),
+ New_Copy
+ (First (Pragma_Argument_Associations (N))))));
+ Analyze (N);
end CPP_Class;
---------------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
-- level and the bars used to link list elements). In addition, for lines
-- other than the first, an additional character Prefix_Char is output.
+ procedure Print_Sloc (Loc : Source_Ptr);
+ -- Print the human readable representation of Loc
+
function Serial_Number (Id : Int) return Nat;
-- Given a Node_Id, List_Id or Elist_Id, returns the previously assigned
-- serial number, or zero if no serial number has yet been assigned.
Field_To_Be_Printed : Boolean;
Prefix_Str_Char : String (Prefix_Str'First .. Prefix_Str'Last + 1);
- Sfile : Source_File_Index;
Fmt : UI_Format;
begin
Print_Str (Prefix_Str_Char);
Print_Str ("Sloc = ");
- if Sloc (N) = Standard_Location then
- Print_Str ("Standard_Location");
-
- elsif Sloc (N) = Standard_ASCII_Location then
- Print_Str ("Standard_ASCII_Location");
-
- else
- Sfile := Get_Source_File_Index (Sloc (N));
- Print_Int (Int (Sloc (N)) - Int (Source_Text (Sfile)'First));
- Write_Str (" ");
- Write_Location (Sloc (N));
- end if;
-
- Print_Eol;
+ Print_Sloc (Sloc (N));
end if;
-- Print Chars field if present
Print_Term;
end Print_Node_Subtree;
+ ----------------
+ -- Print_Sloc --
+ ----------------
+
+ procedure Print_Sloc (Loc : Source_Ptr) is
+ Sfile : Source_File_Index;
+
+ begin
+ if Loc = Standard_Location then
+ Print_Str ("Standard_Location");
+
+ elsif Loc = Standard_ASCII_Location then
+ Print_Str ("Standard_ASCII_Location");
+
+ else
+ Sfile := Get_Source_File_Index (Loc);
+ Print_Int (Int (Loc) - Int (Source_Text (Sfile)'First));
+ Write_Str (" ");
+ Write_Location (Loc);
+ end if;
+
+ Print_Eol;
+ end Print_Sloc;
+
---------------
-- Print_Str --
---------------
Print_Node (N, Label, ' ');
end Print_Tree_Node;
+ -----------
+ -- psloc --
+ -----------
+
+ procedure psloc (Loc : Source_Ptr) is
+ begin
+ Phase := Printing;
+ Print_Sloc (Loc);
+ end psloc;
+
--------
-- pt --
--------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
pragma Export (Ada, ppp);
-- Same as Print_Node_Subtree
+ procedure psloc (Loc : Source_Ptr);
+ pragma Export (Ada, psloc);
+ -- Prints the sloc Loc
+
-- The following are no longer needed; you can use pp or ppp instead
procedure pe (E : Elist_Id);
projects / thirdparty / gcc.git / commitdiff
