Commit c852a0a9 by Arnaud Charlet

[multiple changes]

2013-10-14  Tristan Gingold  <gingold@adacore.com>

	* exp_prag.adb (Expand_Pragma_Import_Export_Exception): Fix
	target type for code of VMS imported exception.
	* init.c: Replace Exception_Code by void *.
	* s-vmexta.adb (Hash, Base_Code_In): Adjust code after changing
	the type of Exception_Code.

2013-10-14  Vincent Celier  <celier@adacore.com>

	* prj.ads: Minor comment updates.
	* prj-attr.adb: New attribute Library_Rpath_Options.

From-SVN: r203544
parent cf3b97ef
2013-10-14 Tristan Gingold <gingold@adacore.com>
* exp_prag.adb (Expand_Pragma_Import_Export_Exception): Fix
target type for code of VMS imported exception.
* init.c: Replace Exception_Code by void *.
* s-vmexta.adb (Hash, Base_Code_In): Adjust code after changing
the type of Exception_Code.
2013-10-14 Vincent Celier <celier@adacore.com>
* prj.ads: Minor comment updates.
* prj-attr.adb: New attribute Library_Rpath_Options.
2013-10-14 Robert Dewar <dewar@adacore.com> 2013-10-14 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Library_Level attribute now applies to an * gnat_rm.texi: Library_Level attribute now applies to an
......
...@@ -646,7 +646,7 @@ package body Exp_Prag is ...@@ -646,7 +646,7 @@ package body Exp_Prag is
-- alias to define the symbol. -- alias to define the symbol.
Code := Code :=
Unchecked_Convert_To (Standard_A_Char, Unchecked_Convert_To (RTE (RE_Address),
Make_Integer_Literal (Loc, Make_Integer_Literal (Loc,
Intval => Exception_Code (Id))); Intval => Exception_Code (Id)));
......
...@@ -430,19 +430,22 @@ __gnat_install_handler (void) ...@@ -430,19 +430,22 @@ __gnat_install_handler (void)
#pragma weak linux_sigaction #pragma weak linux_sigaction
int linux_sigaction (int signum, const struct sigaction *act, int linux_sigaction (int signum, const struct sigaction *act,
struct sigaction *oldact) { struct sigaction *oldact)
{
return sigaction (signum, act, oldact); return sigaction (signum, act, oldact);
} }
#define sigaction(signum, act, oldact) linux_sigaction (signum, act, oldact) #define sigaction(signum, act, oldact) linux_sigaction (signum, act, oldact)
#pragma weak fake_linux_sigfillset #pragma weak fake_linux_sigfillset
void fake_linux_sigfillset (sigset_t *set) { void fake_linux_sigfillset (sigset_t *set)
{
sigfillset (set); sigfillset (set);
} }
#define sigfillset(set) fake_linux_sigfillset (set) #define sigfillset(set) fake_linux_sigfillset (set)
#pragma weak fake_linux_sigemptyset #pragma weak fake_linux_sigemptyset
void fake_linux_sigemptyset (sigset_t *set) { void fake_linux_sigemptyset (sigset_t *set)
{
sigemptyset (set); sigemptyset (set);
} }
#define sigemptyset(set) fake_linux_sigemptyset (set) #define sigemptyset(set) fake_linux_sigemptyset (set)
...@@ -580,7 +583,7 @@ __gnat_install_handler (void) ...@@ -580,7 +583,7 @@ __gnat_install_handler (void)
/* Turn the current Linux task into a native Xenomai task */ /* Turn the current Linux task into a native Xenomai task */
rt_task_shadow(&main_task, "environment_task", prio, T_FPU); rt_task_shadow (&main_task, "environment_task", prio, T_FPU);
#endif #endif
/* Set up signal handler to map synchronous signals to appropriate /* Set up signal handler to map synchronous signals to appropriate
...@@ -897,10 +900,10 @@ extern struct Exception_Data Layout_Error; ...@@ -897,10 +900,10 @@ extern struct Exception_Data Layout_Error;
extern struct Exception_Data Non_Ada_Error; extern struct Exception_Data Non_Ada_Error;
#define Coded_Exception system__vms_exception_table__coded_exception #define Coded_Exception system__vms_exception_table__coded_exception
extern struct Exception_Data *Coded_Exception (Exception_Code); extern struct Exception_Data *Coded_Exception (void *);
#define Base_Code_In system__vms_exception_table__base_code_in #define Base_Code_In system__vms_exception_table__base_code_in
extern Exception_Code Base_Code_In (Exception_Code); extern void *Base_Code_In (void *);
/* DEC Ada exceptions are not defined in a header file, so they /* DEC Ada exceptions are not defined in a header file, so they
must be declared. */ must be declared. */
...@@ -1033,8 +1036,7 @@ static const struct cond_except system_cond_except_table [] = ...@@ -1033,8 +1036,7 @@ static const struct cond_except system_cond_except_table [] =
should be use with caution since the implementation has been kept should be use with caution since the implementation has been kept
very simple. */ very simple. */
typedef int typedef int resignal_predicate (int code);
resignal_predicate (int code);
static const int * const cond_resignal_table [] = static const int * const cond_resignal_table [] =
{ {
...@@ -1123,7 +1125,7 @@ copy_msg (struct descriptor_s *msgdesc, char *message) ...@@ -1123,7 +1125,7 @@ copy_msg (struct descriptor_s *msgdesc, char *message)
/* Scan TABLE for a match for the condition contained in SIGARGS, /* Scan TABLE for a match for the condition contained in SIGARGS,
and return the entry, or the empty entry if no match found. */ and return the entry, or the empty entry if no match found. */
static const struct cond_except * static const struct cond_except *
scan_conditions ( int *sigargs, const struct cond_except *table []) scan_conditions ( int *sigargs, const struct cond_except *table [])
{ {
int i; int i;
struct cond_except entry; struct cond_except entry;
...@@ -1177,7 +1179,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs) ...@@ -1177,7 +1179,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
{ {
struct Exception_Data *exception = 0; struct Exception_Data *exception = 0;
unsigned int needs_adjust = 0; unsigned int needs_adjust = 0;
Exception_Code base_code; void *base_code;
struct descriptor_s gnat_facility = {4, 0, "GNAT"}; struct descriptor_s gnat_facility = {4, 0, "GNAT"};
char message [Default_Exception_Msg_Max_Length]; char message [Default_Exception_Msg_Max_Length];
...@@ -1196,7 +1198,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs) ...@@ -1196,7 +1198,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
#ifdef IN_RTS #ifdef IN_RTS
/* See if it's an imported exception. Beware that registered exceptions /* See if it's an imported exception. Beware that registered exceptions
are bound to their base code, with the severity bits masked off. */ are bound to their base code, with the severity bits masked off. */
base_code = Base_Code_In ((Exception_Code) sigargs[1]); base_code = Base_Code_In ((void *) sigargs[1]);
exception = Coded_Exception (base_code); exception = Coded_Exception (base_code);
#endif #endif
......
...@@ -111,6 +111,7 @@ package body Prj.Attr is ...@@ -111,6 +111,7 @@ package body Prj.Attr is
"SVlibrary_auto_init#" & "SVlibrary_auto_init#" &
"LVleading_library_options#" & "LVleading_library_options#" &
"LVlibrary_options#" & "LVlibrary_options#" &
"Lalibrary_rpath_options#" &
"SVlibrary_src_dir#" & "SVlibrary_src_dir#" &
"SVlibrary_ali_dir#" & "SVlibrary_ali_dir#" &
"SVlibrary_gcc#" & "SVlibrary_gcc#" &
......
...@@ -675,16 +675,26 @@ package Prj is ...@@ -675,16 +675,26 @@ package Prj is
Clean_Object_Artifacts => No_Name_List, Clean_Object_Artifacts => No_Name_List,
Clean_Source_Artifacts => No_Name_List); Clean_Source_Artifacts => No_Name_List);
-- The following record ???
type Language_Data is record type Language_Data is record
Name : Name_Id := No_Name; Name : Name_Id := No_Name;
-- The name of the language in lower case
Display_Name : Name_Id := No_Name; Display_Name : Name_Id := No_Name;
-- The name of the language, as found in attribute Languages
Config : Language_Config := No_Language_Config; Config : Language_Config := No_Language_Config;
-- Configuration of the language
First_Source : Source_Id := No_Source; First_Source : Source_Id := No_Source;
-- Head of the list of sources of the language in the project
Mapping_Files : Mapping_Files_Htable.Instance := Mapping_Files : Mapping_Files_Htable.Instance :=
Mapping_Files_Htable.Nil; Mapping_Files_Htable.Nil;
-- Hash table containing the mapping of the sources to their path names
Next : Language_Ptr := No_Language_Index; Next : Language_Ptr := No_Language_Index;
-- Next language of the project
end record; end record;
No_Language_Data : constant Language_Data := No_Language_Data : constant Language_Data :=
...@@ -755,8 +765,7 @@ package Prj is ...@@ -755,8 +765,7 @@ package Prj is
-- recursive notation <dir>/** is used in attribute Source_Dirs. -- recursive notation <dir>/** is used in attribute Source_Dirs.
Language : Language_Ptr := No_Language_Index; Language : Language_Ptr := No_Language_Index;
-- Index of the language. This is an index into -- Language of the source
-- Project_Tree.Languages_Data.
In_Interfaces : Boolean := True; In_Interfaces : Boolean := True;
-- False when the source is not included in interfaces, when attribute -- False when the source is not included in interfaces, when attribute
...@@ -1259,7 +1268,6 @@ package Prj is ...@@ -1259,7 +1268,6 @@ package Prj is
Languages : Language_Ptr := No_Language_Index; Languages : Language_Ptr := No_Language_Index;
-- First index of the language data in the project. -- First index of the language data in the project.
-- This is an index into the project_tree_data.languages_data.
-- Traversing the list gives access to all the languages supported by -- Traversing the list gives access to all the languages supported by
-- the project. -- the project.
......
...@@ -33,6 +33,7 @@ ...@@ -33,6 +33,7 @@
with System.HTable; with System.HTable;
pragma Elaborate_All (System.HTable); pragma Elaborate_All (System.HTable);
with System.Storage_Elements; use System.Storage_Elements;
package body System.VMS_Exception_Table is package body System.VMS_Exception_Table is
...@@ -80,7 +81,7 @@ package body System.VMS_Exception_Table is ...@@ -80,7 +81,7 @@ package body System.VMS_Exception_Table is
(Code : Exception_Code) return Exception_Code (Code : Exception_Code) return Exception_Code
is is
begin begin
return Code and not 2#0111#; return To_Address (To_Integer (Code) and not 2#0111#);
end Base_Code_In; end Base_Code_In;
--------------------- ---------------------
...@@ -136,7 +137,8 @@ package body System.VMS_Exception_Table is ...@@ -136,7 +137,8 @@ package body System.VMS_Exception_Table is
Exception_Code (HTable_Headers'Last - HTable_Headers'First + 1); Exception_Code (HTable_Headers'Last - HTable_Headers'First + 1);
begin begin
return HTable_Headers (F mod Headers_Magnitude + 1); return HTable_Headers
(To_Address ((To_Integer (F) mod To_Integer (Headers_Magnitude)) + 1));
end Hash; end Hash;
---------------------------- ----------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment