[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
This commit is contained in:
Arnaud Charlet 2013-10-14 15:20:51 +02:00
parent cf3b97ef62
commit c852a0a90d
6 changed files with 45 additions and 19 deletions

View File

@ -1,3 +1,16 @@
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>
* gnat_rm.texi: Library_Level attribute now applies to an

View File

@ -646,7 +646,7 @@ package body Exp_Prag is
-- alias to define the symbol.
Code :=
Unchecked_Convert_To (Standard_A_Char,
Unchecked_Convert_To (RTE (RE_Address),
Make_Integer_Literal (Loc,
Intval => Exception_Code (Id)));

View File

@ -430,19 +430,22 @@ __gnat_install_handler (void)
#pragma weak linux_sigaction
int linux_sigaction (int signum, const struct sigaction *act,
struct sigaction *oldact) {
struct sigaction *oldact)
{
return sigaction (signum, act, oldact);
}
#define sigaction(signum, act, oldact) linux_sigaction (signum, act, oldact)
#pragma weak fake_linux_sigfillset
void fake_linux_sigfillset (sigset_t *set) {
void fake_linux_sigfillset (sigset_t *set)
{
sigfillset (set);
}
#define sigfillset(set) fake_linux_sigfillset (set)
#pragma weak fake_linux_sigemptyset
void fake_linux_sigemptyset (sigset_t *set) {
void fake_linux_sigemptyset (sigset_t *set)
{
sigemptyset (set);
}
#define sigemptyset(set) fake_linux_sigemptyset (set)
@ -580,7 +583,7 @@ __gnat_install_handler (void)
/* 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
/* Set up signal handler to map synchronous signals to appropriate
@ -897,10 +900,10 @@ extern struct Exception_Data Layout_Error;
extern struct Exception_Data Non_Ada_Error;
#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
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
must be declared. */
@ -1033,8 +1036,7 @@ static const struct cond_except system_cond_except_table [] =
should be use with caution since the implementation has been kept
very simple. */
typedef int
resignal_predicate (int code);
typedef int resignal_predicate (int code);
static const int * const cond_resignal_table [] =
{
@ -1123,7 +1125,7 @@ copy_msg (struct descriptor_s *msgdesc, char *message)
/* Scan TABLE for a match for the condition contained in SIGARGS,
and return the entry, or the empty entry if no match found. */
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;
struct cond_except entry;
@ -1177,7 +1179,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
{
struct Exception_Data *exception = 0;
unsigned int needs_adjust = 0;
Exception_Code base_code;
void *base_code;
struct descriptor_s gnat_facility = {4, 0, "GNAT"};
char message [Default_Exception_Msg_Max_Length];
@ -1196,7 +1198,7 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
#ifdef IN_RTS
/* See if it's an imported exception. Beware that registered exceptions
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);
#endif

View File

@ -111,6 +111,7 @@ package body Prj.Attr is
"SVlibrary_auto_init#" &
"LVleading_library_options#" &
"LVlibrary_options#" &
"Lalibrary_rpath_options#" &
"SVlibrary_src_dir#" &
"SVlibrary_ali_dir#" &
"SVlibrary_gcc#" &

View File

@ -675,16 +675,26 @@ package Prj is
Clean_Object_Artifacts => No_Name_List,
Clean_Source_Artifacts => No_Name_List);
-- The following record ???
type Language_Data is record
Name : Name_Id := No_Name;
-- The name of the language in lower case
Display_Name : Name_Id := No_Name;
-- The name of the language, as found in attribute Languages
Config : Language_Config := No_Language_Config;
-- Configuration of the language
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_Htable.Nil;
-- Hash table containing the mapping of the sources to their path names
Next : Language_Ptr := No_Language_Index;
-- Next language of the project
end record;
No_Language_Data : constant Language_Data :=
@ -755,8 +765,7 @@ package Prj is
-- recursive notation <dir>/** is used in attribute Source_Dirs.
Language : Language_Ptr := No_Language_Index;
-- Index of the language. This is an index into
-- Project_Tree.Languages_Data.
-- Language of the source
In_Interfaces : Boolean := True;
-- False when the source is not included in interfaces, when attribute
@ -1259,7 +1268,6 @@ package Prj is
Languages : Language_Ptr := No_Language_Index;
-- 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
-- the project.

View File

@ -33,6 +33,7 @@
with System.HTable;
pragma Elaborate_All (System.HTable);
with System.Storage_Elements; use System.Storage_Elements;
package body System.VMS_Exception_Table is
@ -80,7 +81,7 @@ package body System.VMS_Exception_Table is
(Code : Exception_Code) return Exception_Code
is
begin
return Code and not 2#0111#;
return To_Address (To_Integer (Code) and not 2#0111#);
end Base_Code_In;
---------------------
@ -136,7 +137,8 @@ package body System.VMS_Exception_Table is
Exception_Code (HTable_Headers'Last - HTable_Headers'First + 1);
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;
----------------------------