mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-25 01:20:52 +08:00
[multiple changes]
2010-06-17 Vincent Celier <celier@adacore.com> * gnatcmd.adb (Non_VMS_Usage): Do not issue usage for gnat sync. Update the last line of the usage, indicating what commands do not accept project file switches. * vms_conv.adb: Do not issue usage line for GNAT SYNC * vms_data.ads: Fix errors in the qualifiers /LOGFILE and /MAIN of GNAT ELIM. * gnat_ugn.texi: Document the relaxed rules for library directories in externally built library projects. 2010-06-17 Doug Rupp <rupp@adacore.com> * s-auxdec-vms_64.ads: Make boolean and arithmetic operations intrinsic where possible. * s-auxdec-vms-alpha.adb: Remove kludges for aforemention. * gcc-interface/Makefile.in: Update VMS target pairs. 2010-06-17 Vasiliy Fofanov <fofanov@adacore.com> * adaint.c: Reorganized in order to avoid use of GetProcessId to stay compatible with Windows NT 4.0 which doesn't provide this function. 2010-06-17 Vincent Celier <celier@adacore.com> * ali-util.adb (Time_Stamp_Mismatch): In Verbose mode, if there is different timestamps but the checksum is the same, issue a short message saying so. 2010-06-17 Arnaud Charlet <charlet@adacore.com> * s-interr.adb (Finalize): If the Abort_Task signal is set to system, it means that we cannot reset interrupt handlers since this would require potentially sending the abort signal to the Server_Task. From-SVN: r160911
This commit is contained in:
parent
498c378f90
commit
aa9ea6a1ac
@ -1,3 +1,38 @@
|
||||
2010-06-17 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* gnatcmd.adb (Non_VMS_Usage): Do not issue usage for gnat sync.
|
||||
Update the last line of the usage, indicating what commands do not
|
||||
accept project file switches.
|
||||
* vms_conv.adb: Do not issue usage line for GNAT SYNC
|
||||
* vms_data.ads: Fix errors in the qualifiers /LOGFILE and /MAIN of
|
||||
GNAT ELIM.
|
||||
* gnat_ugn.texi: Document the relaxed rules for library directories in
|
||||
externally built library projects.
|
||||
|
||||
2010-06-17 Doug Rupp <rupp@adacore.com>
|
||||
|
||||
* s-auxdec-vms_64.ads: Make boolean and arithmetic operations intrinsic
|
||||
where possible.
|
||||
* s-auxdec-vms-alpha.adb: Remove kludges for aforemention.
|
||||
* gcc-interface/Makefile.in: Update VMS target pairs.
|
||||
|
||||
2010-06-17 Vasiliy Fofanov <fofanov@adacore.com>
|
||||
|
||||
* adaint.c: Reorganized in order to avoid use of GetProcessId to stay
|
||||
compatible with Windows NT 4.0 which doesn't provide this function.
|
||||
|
||||
2010-06-17 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* ali-util.adb (Time_Stamp_Mismatch): In Verbose mode, if there is
|
||||
different timestamps but the checksum is the same, issue a short
|
||||
message saying so.
|
||||
|
||||
2010-06-17 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* s-interr.adb (Finalize): If the Abort_Task signal is set to system,
|
||||
it means that we cannot reset interrupt handlers since this would
|
||||
require potentially sending the abort signal to the Server_Task.
|
||||
|
||||
2010-06-17 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_ch4.adb: expand NOT for VMS types.
|
||||
|
@ -2474,7 +2474,7 @@ static HANDLE *HANDLES_LIST = NULL;
|
||||
static int *PID_LIST = NULL, plist_length = 0, plist_max_length = 0;
|
||||
|
||||
static void
|
||||
add_handle (HANDLE h)
|
||||
add_handle (HANDLE h, int pid)
|
||||
{
|
||||
|
||||
/* -------------------- critical section -------------------- */
|
||||
@ -2490,7 +2490,7 @@ add_handle (HANDLE h)
|
||||
}
|
||||
|
||||
HANDLES_LIST[plist_length] = h;
|
||||
PID_LIST[plist_length] = GetProcessId (h);
|
||||
PID_LIST[plist_length] = pid;
|
||||
++plist_length;
|
||||
|
||||
(*Unlock_Task) ();
|
||||
@ -2521,8 +2521,8 @@ __gnat_win32_remove_handle (HANDLE h, int pid)
|
||||
/* -------------------- critical section -------------------- */
|
||||
}
|
||||
|
||||
static HANDLE
|
||||
win32_no_block_spawn (char *command, char *args[])
|
||||
static void
|
||||
win32_no_block_spawn (char *command, char *args[], HANDLE *h, int *pid)
|
||||
{
|
||||
BOOL result;
|
||||
STARTUPINFO SI;
|
||||
@ -2587,10 +2587,14 @@ win32_no_block_spawn (char *command, char *args[])
|
||||
if (result == TRUE)
|
||||
{
|
||||
CloseHandle (PI.hThread);
|
||||
return PI.hProcess;
|
||||
*h = PI.hProcess;
|
||||
*pid = PI.dwProcessId;
|
||||
}
|
||||
else
|
||||
return NULL;
|
||||
{
|
||||
*h = NULL;
|
||||
*pid = 0;
|
||||
}
|
||||
}
|
||||
|
||||
static int
|
||||
@ -2627,7 +2631,7 @@ win32_wait (int *status)
|
||||
h = hl[res - WAIT_OBJECT_0];
|
||||
|
||||
GetExitCodeProcess (h, &exitcode);
|
||||
pid = GetProcessId (h);
|
||||
pid = PID_LIST [res - WAIT_OBJECT_0];
|
||||
__gnat_win32_remove_handle (h, -1);
|
||||
|
||||
free (hl);
|
||||
@ -2661,12 +2665,13 @@ __gnat_portable_no_block_spawn (char *args[])
|
||||
#elif defined (_WIN32)
|
||||
|
||||
HANDLE h = NULL;
|
||||
int pid;
|
||||
|
||||
h = win32_no_block_spawn (args[0], args);
|
||||
win32_no_block_spawn (args[0], args, &h, &pid);
|
||||
if (h != NULL)
|
||||
{
|
||||
add_handle (h);
|
||||
return GetProcessId (h);
|
||||
add_handle (h, pid);
|
||||
return pid;
|
||||
}
|
||||
else
|
||||
return -1;
|
||||
|
@ -481,6 +481,14 @@ package body ALI.Util is
|
||||
(Get_File_Checksum (Sdep.Table (D).Sfile),
|
||||
Source.Table (Src).Checksum)
|
||||
then
|
||||
if Verbose_Mode then
|
||||
Write_Str (" ");
|
||||
Write_Str (Get_Name_String (Sdep.Table (D).Sfile));
|
||||
Write_Str (": up to date, different timestamps " &
|
||||
"but same checksum");
|
||||
Write_Eol;
|
||||
end if;
|
||||
|
||||
Sdep.Table (D).Stamp := Source.Table (Src).Stamp;
|
||||
end if;
|
||||
|
||||
|
@ -1476,11 +1476,10 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
|
||||
g-enblsp.adb<g-enblsp-vms-ia64.adb \
|
||||
g-trasym.adb<g-trasym-vms-ia64.adb \
|
||||
s-asthan.adb<s-asthan-vms-ia64.adb \
|
||||
s-auxdec.adb<s-auxdec-vms-ia64.adb \
|
||||
s-osinte.adb<s-osinte-vms-ia64.adb \
|
||||
s-osinte.ads<s-osinte-vms-ia64.ads \
|
||||
s-vaflop.adb<s-vaflop-vms-ia64.adb \
|
||||
g-trasym.ads<g-trasym-unimplemented.ads \
|
||||
g-trasym.adb<g-trasym-unimplemented.adb \
|
||||
system.ads<system-vms-ia64.ads
|
||||
|
||||
LIBGNAT_TARGET_PAIRS_AUX2 = \
|
||||
@ -1491,12 +1490,12 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
|
||||
LIBGNAT_TARGET_PAIRS_AUX1 = \
|
||||
g-enblsp.adb<g-enblsp-vms-alpha.adb \
|
||||
g-trasym.adb<g-trasym-vms-alpha.adb \
|
||||
s-auxdec.adb<s-auxdec-vms-alpha.adb \
|
||||
s-traent.adb<s-traent-vms.adb \
|
||||
s-traent.ads<s-traent-vms.ads \
|
||||
s-asthan.adb<s-asthan-vms-alpha.adb \
|
||||
s-auxdec.adb<s-auxdec-vms-alpha.adb \
|
||||
s-osinte.adb<s-osinte-vms.adb \
|
||||
s-osinte.ads<s-osinte-vms.ads \
|
||||
s-traent.adb<s-traent-vms.adb \
|
||||
s-traent.ads<s-traent-vms.ads \
|
||||
s-vaflop.adb<s-vaflop-vms-alpha.adb \
|
||||
system.ads<system-vms_64.ads
|
||||
|
||||
|
@ -14048,9 +14048,9 @@ to be acceptable on all platforms.
|
||||
|
||||
The @code{Library_Dir} attribute has a string value that designates the path
|
||||
(absolute or relative) of the directory where the library will reside.
|
||||
It must designate an existing directory, and this directory must be writable,
|
||||
different from the project's object directory and from any source directory
|
||||
in the project tree.
|
||||
It must designate an existing directory. When the project is not externally
|
||||
built, this directory must be writable, different from the project's object
|
||||
directory and from any source directory in the project tree.
|
||||
|
||||
If both @code{Library_Name} and @code{Library_Dir} are specified and
|
||||
are legal, then the project file defines a library project. The optional
|
||||
@ -14073,9 +14073,10 @@ to indicate what kind of library should be build.
|
||||
The @code{Library_ALI_Dir} attribute may be specified to indicate the
|
||||
directory where the ALI files of the library will be copied. When it is
|
||||
not specified, the ALI files are copied to the directory specified in
|
||||
attribute @code{Library_Dir}. The directory specified by @code{Library_ALI_Dir}
|
||||
must be writable and different from the project's object directory and from
|
||||
any source directory in the project tree.
|
||||
attribute @code{Library_Dir}. Except when the project is externally built, the
|
||||
directory specified by @code{Library_ALI_Dir} must be writable and different
|
||||
from the project's object directory and from any source directory in the
|
||||
project tree.
|
||||
|
||||
The @code{Library_Version} attribute has a string value whose interpretation
|
||||
is platform dependent. It has no effect on VMS and Windows. On Unix, it is
|
||||
|
@ -1272,7 +1272,10 @@ procedure GNATCmd is
|
||||
New_Line;
|
||||
|
||||
for C in Command_List'Range loop
|
||||
if not Command_List (C).VMS_Only then
|
||||
|
||||
-- No usage for VMS only command or for Sync
|
||||
|
||||
if (not Command_List (C).VMS_Only) and then C /= Sync then
|
||||
if Targparm.AAMP_On_Target then
|
||||
Put ("gnaampcmd ");
|
||||
else
|
||||
@ -1306,7 +1309,7 @@ procedure GNATCmd is
|
||||
end loop;
|
||||
|
||||
New_Line;
|
||||
Put_Line ("Commands find, list, metric, pretty, stack, stub and xref " &
|
||||
Put_Line ("All commands except chop, krunch and preprocess " &
|
||||
"accept project file switches -vPx, -Pprj and -Xnam=val");
|
||||
New_Line;
|
||||
end Non_VMS_Usage;
|
||||
|
@ -29,6 +29,8 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This is the Alpha/VMS version.
|
||||
|
||||
pragma Style_Checks (All_Checks);
|
||||
-- Turn off alpha ordering check on subprograms, this unit is laid
|
||||
-- out to correspond to the declarations in the DEC 83 System unit.
|
||||
@ -36,76 +38,6 @@ pragma Style_Checks (All_Checks);
|
||||
with System.Machine_Code; use System.Machine_Code;
|
||||
package body System.Aux_DEC is
|
||||
|
||||
-----------------------------------
|
||||
-- Operations on Largest_Integer --
|
||||
-----------------------------------
|
||||
|
||||
-- It would be nice to replace these with intrinsics, but that does
|
||||
-- not work yet (the back end would be ok, but GNAT itself objects)
|
||||
|
||||
type LIU is mod 2 ** Largest_Integer'Size;
|
||||
-- Unsigned type of same length as Largest_Integer
|
||||
|
||||
function To_LI is new Ada.Unchecked_Conversion (LIU, Largest_Integer);
|
||||
function From_LI is new Ada.Unchecked_Conversion (Largest_Integer, LIU);
|
||||
|
||||
function "not" (Left : Largest_Integer) return Largest_Integer is
|
||||
begin
|
||||
return To_LI (not From_LI (Left));
|
||||
end "not";
|
||||
|
||||
function "and" (Left, Right : Largest_Integer) return Largest_Integer is
|
||||
begin
|
||||
return To_LI (From_LI (Left) and From_LI (Right));
|
||||
end "and";
|
||||
|
||||
function "or" (Left, Right : Largest_Integer) return Largest_Integer is
|
||||
begin
|
||||
return To_LI (From_LI (Left) or From_LI (Right));
|
||||
end "or";
|
||||
|
||||
function "xor" (Left, Right : Largest_Integer) return Largest_Integer is
|
||||
begin
|
||||
return To_LI (From_LI (Left) xor From_LI (Right));
|
||||
end "xor";
|
||||
|
||||
--------------------------------------
|
||||
-- Arithmetic Operations on Address --
|
||||
--------------------------------------
|
||||
|
||||
-- It would be nice to replace these with intrinsics, but that does
|
||||
-- not work yet (the back end would be ok, but GNAT itself objects)
|
||||
|
||||
Asiz : constant Integer := Integer (Address'Size) - 1;
|
||||
|
||||
type SA is range -(2 ** Asiz) .. 2 ** Asiz - 1;
|
||||
-- Signed type of same size as Address
|
||||
|
||||
function To_A is new Ada.Unchecked_Conversion (SA, Address);
|
||||
function From_A is new Ada.Unchecked_Conversion (Address, SA);
|
||||
|
||||
function "+" (Left : Address; Right : Integer) return Address is
|
||||
begin
|
||||
return To_A (From_A (Left) + SA (Right));
|
||||
end "+";
|
||||
|
||||
function "+" (Left : Integer; Right : Address) return Address is
|
||||
begin
|
||||
return To_A (SA (Left) + From_A (Right));
|
||||
end "+";
|
||||
|
||||
function "-" (Left : Address; Right : Address) return Integer is
|
||||
pragma Unsuppress (All_Checks);
|
||||
-- Because this can raise Constraint_Error for 64-bit addresses
|
||||
begin
|
||||
return Integer (From_A (Left) - From_A (Right));
|
||||
end "-";
|
||||
|
||||
function "-" (Left : Address; Right : Integer) return Address is
|
||||
begin
|
||||
return To_A (From_A (Left) - SA (Right));
|
||||
end "-";
|
||||
|
||||
------------------------
|
||||
-- Fetch_From_Address --
|
||||
------------------------
|
||||
@ -130,171 +62,6 @@ package body System.Aux_DEC is
|
||||
Ptr.all := T;
|
||||
end Assign_To_Address;
|
||||
|
||||
---------------------------------
|
||||
-- Operations on Unsigned_Byte --
|
||||
---------------------------------
|
||||
|
||||
-- It would be nice to replace these with intrinsics, but that does
|
||||
-- not work yet (the back end would be ok, but GNAT itself objects) ???
|
||||
|
||||
type BU is mod 2 ** Unsigned_Byte'Size;
|
||||
-- Unsigned type of same length as Unsigned_Byte
|
||||
|
||||
function To_B is new Ada.Unchecked_Conversion (BU, Unsigned_Byte);
|
||||
function From_B is new Ada.Unchecked_Conversion (Unsigned_Byte, BU);
|
||||
|
||||
function "not" (Left : Unsigned_Byte) return Unsigned_Byte is
|
||||
begin
|
||||
return To_B (not From_B (Left));
|
||||
end "not";
|
||||
|
||||
function "and" (Left, Right : Unsigned_Byte) return Unsigned_Byte is
|
||||
begin
|
||||
return To_B (From_B (Left) and From_B (Right));
|
||||
end "and";
|
||||
|
||||
function "or" (Left, Right : Unsigned_Byte) return Unsigned_Byte is
|
||||
begin
|
||||
return To_B (From_B (Left) or From_B (Right));
|
||||
end "or";
|
||||
|
||||
function "xor" (Left, Right : Unsigned_Byte) return Unsigned_Byte is
|
||||
begin
|
||||
return To_B (From_B (Left) xor From_B (Right));
|
||||
end "xor";
|
||||
|
||||
---------------------------------
|
||||
-- Operations on Unsigned_Word --
|
||||
---------------------------------
|
||||
|
||||
-- It would be nice to replace these with intrinsics, but that does
|
||||
-- not work yet (the back end would be ok, but GNAT itself objects) ???
|
||||
|
||||
type WU is mod 2 ** Unsigned_Word'Size;
|
||||
-- Unsigned type of same length as Unsigned_Word
|
||||
|
||||
function To_W is new Ada.Unchecked_Conversion (WU, Unsigned_Word);
|
||||
function From_W is new Ada.Unchecked_Conversion (Unsigned_Word, WU);
|
||||
|
||||
function "not" (Left : Unsigned_Word) return Unsigned_Word is
|
||||
begin
|
||||
return To_W (not From_W (Left));
|
||||
end "not";
|
||||
|
||||
function "and" (Left, Right : Unsigned_Word) return Unsigned_Word is
|
||||
begin
|
||||
return To_W (From_W (Left) and From_W (Right));
|
||||
end "and";
|
||||
|
||||
function "or" (Left, Right : Unsigned_Word) return Unsigned_Word is
|
||||
begin
|
||||
return To_W (From_W (Left) or From_W (Right));
|
||||
end "or";
|
||||
|
||||
function "xor" (Left, Right : Unsigned_Word) return Unsigned_Word is
|
||||
begin
|
||||
return To_W (From_W (Left) xor From_W (Right));
|
||||
end "xor";
|
||||
|
||||
-------------------------------------
|
||||
-- Operations on Unsigned_Longword --
|
||||
-------------------------------------
|
||||
|
||||
-- It would be nice to replace these with intrinsics, but that does
|
||||
-- not work yet (the back end would be ok, but GNAT itself objects) ???
|
||||
|
||||
type LWU is mod 2 ** Unsigned_Longword'Size;
|
||||
-- Unsigned type of same length as Unsigned_Longword
|
||||
|
||||
function To_LW is new Ada.Unchecked_Conversion (LWU, Unsigned_Longword);
|
||||
function From_LW is new Ada.Unchecked_Conversion (Unsigned_Longword, LWU);
|
||||
|
||||
function "not" (Left : Unsigned_Longword) return Unsigned_Longword is
|
||||
begin
|
||||
return To_LW (not From_LW (Left));
|
||||
end "not";
|
||||
|
||||
function "and" (Left, Right : Unsigned_Longword) return Unsigned_Longword is
|
||||
begin
|
||||
return To_LW (From_LW (Left) and From_LW (Right));
|
||||
end "and";
|
||||
|
||||
function "or" (Left, Right : Unsigned_Longword) return Unsigned_Longword is
|
||||
begin
|
||||
return To_LW (From_LW (Left) or From_LW (Right));
|
||||
end "or";
|
||||
|
||||
function "xor" (Left, Right : Unsigned_Longword) return Unsigned_Longword is
|
||||
begin
|
||||
return To_LW (From_LW (Left) xor From_LW (Right));
|
||||
end "xor";
|
||||
|
||||
-------------------------------
|
||||
-- Operations on Unsigned_32 --
|
||||
-------------------------------
|
||||
|
||||
-- It would be nice to replace these with intrinsics, but that does
|
||||
-- not work yet (the back end would be ok, but GNAT itself objects) ???
|
||||
|
||||
type U32 is mod 2 ** Unsigned_32'Size;
|
||||
-- Unsigned type of same length as Unsigned_32
|
||||
|
||||
function To_U32 is new Ada.Unchecked_Conversion (U32, Unsigned_32);
|
||||
function From_U32 is new Ada.Unchecked_Conversion (Unsigned_32, U32);
|
||||
|
||||
function "not" (Left : Unsigned_32) return Unsigned_32 is
|
||||
begin
|
||||
return To_U32 (not From_U32 (Left));
|
||||
end "not";
|
||||
|
||||
function "and" (Left, Right : Unsigned_32) return Unsigned_32 is
|
||||
begin
|
||||
return To_U32 (From_U32 (Left) and From_U32 (Right));
|
||||
end "and";
|
||||
|
||||
function "or" (Left, Right : Unsigned_32) return Unsigned_32 is
|
||||
begin
|
||||
return To_U32 (From_U32 (Left) or From_U32 (Right));
|
||||
end "or";
|
||||
|
||||
function "xor" (Left, Right : Unsigned_32) return Unsigned_32 is
|
||||
begin
|
||||
return To_U32 (From_U32 (Left) xor From_U32 (Right));
|
||||
end "xor";
|
||||
|
||||
-------------------------------------
|
||||
-- Operations on Unsigned_Quadword --
|
||||
-------------------------------------
|
||||
|
||||
-- It would be nice to replace these with intrinsics, but that does
|
||||
-- not work yet (the back end would be ok, but GNAT itself objects) ???
|
||||
|
||||
type QWU is mod 2 ** 64; -- 64 = Unsigned_Quadword'Size
|
||||
-- Unsigned type of same length as Unsigned_Quadword
|
||||
|
||||
function To_QW is new Ada.Unchecked_Conversion (QWU, Unsigned_Quadword);
|
||||
function From_QW is new Ada.Unchecked_Conversion (Unsigned_Quadword, QWU);
|
||||
|
||||
function "not" (Left : Unsigned_Quadword) return Unsigned_Quadword is
|
||||
begin
|
||||
return To_QW (not From_QW (Left));
|
||||
end "not";
|
||||
|
||||
function "and" (Left, Right : Unsigned_Quadword) return Unsigned_Quadword is
|
||||
begin
|
||||
return To_QW (From_QW (Left) and From_QW (Right));
|
||||
end "and";
|
||||
|
||||
function "or" (Left, Right : Unsigned_Quadword) return Unsigned_Quadword is
|
||||
begin
|
||||
return To_QW (From_QW (Left) or From_QW (Right));
|
||||
end "or";
|
||||
|
||||
function "xor" (Left, Right : Unsigned_Quadword) return Unsigned_Quadword is
|
||||
begin
|
||||
return To_QW (From_QW (Left) xor From_QW (Right));
|
||||
end "xor";
|
||||
|
||||
-----------------------
|
||||
-- Clear_Interlocked --
|
||||
-----------------------
|
||||
|
@ -107,10 +107,13 @@ package System.Aux_DEC is
|
||||
Address_Size : constant := Standard'Address_Size;
|
||||
Short_Address_Size : constant := 32;
|
||||
|
||||
function "+" (Left : Address; Right : Integer) return Address;
|
||||
function "+" (Left : Integer; Right : Address) return Address;
|
||||
function "-" (Left : Address; Right : Address) return Integer;
|
||||
function "-" (Left : Address; Right : Integer) return Address;
|
||||
function "+" (Left : Address; Right : Long_Integer) return Address;
|
||||
function "+" (Left : Long_Integer; Right : Address) return Address;
|
||||
function "-" (Left : Address; Right : Address) return Long_Integer;
|
||||
function "-" (Left : Address; Right : Long_Integer) return Address;
|
||||
|
||||
pragma Import (Intrinsic, "+");
|
||||
pragma Import (Intrinsic, "-");
|
||||
|
||||
generic
|
||||
type Target is private;
|
||||
@ -461,12 +464,10 @@ private
|
||||
-- them intrinsic, since the backend can handle them, but the front
|
||||
-- end is not prepared to deal with them, so at least inline them.
|
||||
|
||||
pragma Inline_Always ("+");
|
||||
pragma Inline_Always ("-");
|
||||
pragma Inline_Always ("not");
|
||||
pragma Inline_Always ("and");
|
||||
pragma Inline_Always ("or");
|
||||
pragma Inline_Always ("xor");
|
||||
pragma Import (Intrinsic, "not");
|
||||
pragma Import (Intrinsic, "and");
|
||||
pragma Import (Intrinsic, "or");
|
||||
pragma Import (Intrinsic, "xor");
|
||||
|
||||
-- Other inlined subprograms
|
||||
|
||||
|
@ -367,11 +367,27 @@ package body System.Interrupts is
|
||||
--------------
|
||||
|
||||
procedure Finalize (Object : in out Static_Interrupt_Protection) is
|
||||
function State
|
||||
(Int : System.Interrupt_Management.Interrupt_ID) return Character;
|
||||
pragma Import (C, State, "__gnat_get_interrupt_state");
|
||||
-- Get interrupt state for interrupt number Int. Defined in init.c
|
||||
|
||||
Default : constant Character := 's';
|
||||
-- 's' Interrupt_State pragma set state to System (use "default"
|
||||
-- system handler)
|
||||
|
||||
begin
|
||||
-- ??? loop to be executed only when we're not doing library level
|
||||
-- finalization, since in this case all interrupt tasks are gone.
|
||||
|
||||
if not Interrupt_Manager'Terminated then
|
||||
-- If the Abort_Task signal is set to system, it means that we cannot
|
||||
-- reset interrupt handlers since this would require sending the abort
|
||||
-- signal to the Server_Task
|
||||
|
||||
if not Interrupt_Manager'Terminated
|
||||
and then State (System.Interrupt_Management.Abort_Task_Interrupt)
|
||||
/= Default
|
||||
then
|
||||
for N in reverse Object.Previous_Handlers'Range loop
|
||||
Interrupt_Manager.Attach_Handler
|
||||
(New_Handler => Object.Previous_Handlers (N).Handler,
|
||||
|
@ -2274,9 +2274,15 @@ package body VMS_Conv is
|
||||
New_Line;
|
||||
|
||||
while Commands /= null loop
|
||||
Put (Commands.Usage.all);
|
||||
Set_Col (53);
|
||||
Put_Line (Commands.Unix_String.all);
|
||||
|
||||
-- No usage for GNAT SYNC
|
||||
|
||||
if Commands.Command /= Sync then
|
||||
Put (Commands.Usage.all);
|
||||
Set_Col (53);
|
||||
Put_Line (Commands.Unix_String.all);
|
||||
end if;
|
||||
|
||||
Commands := Commands.Next;
|
||||
end loop;
|
||||
|
||||
|
@ -3637,14 +3637,14 @@ package VMS_Data is
|
||||
--
|
||||
-- Duplicate all the output sent to Stderr into a default log file.
|
||||
|
||||
S_Elim_Logfile : aliased constant S := "/LOGFILE=@ " &
|
||||
S_Elim_Logfile : aliased constant S := "/LOGFILE=@" &
|
||||
"-l@";
|
||||
|
||||
-- /LOGFILE=logfilename
|
||||
--
|
||||
-- Duplicate all the output sent to Stderr into a specified log file.
|
||||
|
||||
S_Elim_Main : aliased constant S := "/MAIN=@ " &
|
||||
S_Elim_Main : aliased constant S := "/MAIN=@" &
|
||||
"-main=@";
|
||||
|
||||
-- /MAIN=filename
|
||||
|
Loading…
x
Reference in New Issue
Block a user