+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.
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 -------------------- */
}
HANDLES_LIST[plist_length] = h;
- PID_LIST[plist_length] = GetProcessId (h);
+ PID_LIST[plist_length] = pid;
++plist_length;
(*Unlock_Task) ();
/* -------------------- 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;
if (result == TRUE)
{
CloseHandle (PI.hThread);
- return PI.hProcess;
+ *h = PI.hProcess;
+ *pid = PI.dwProcessId;
}
else
- return NULL;
+ {
+ *h = NULL;
+ *pid = 0;
+ }
}
static int
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);
#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;
(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;
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 = \
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
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
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
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
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;
-- --
------------------------------------------------------------------------------
+-- 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.
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 --
------------------------
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 --
-----------------------
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;
-- 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
--------------
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,
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;
--
-- 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
OSDN Git Service
