diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-06-17 13:14:44 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-06-17 13:14:44 +0000 |
commit | 14d22a3f062f8a069588a4485ebaa28756a7530c (patch) | |
tree | 43db9e38c43410e0eeefdcaa7825c5d85ca120ee /gcc/ada/s-auxdec-vms-alpha.adb | |
parent | df0c9c1a9edfae572198616adc60aa18779e6d54 (diff) | |
download | gcc-14d22a3f062f8a069588a4485ebaa28756a7530c.tar.gz |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@160911 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/s-auxdec-vms-alpha.adb')
-rw-r--r-- | gcc/ada/s-auxdec-vms-alpha.adb | 237 |
1 files changed, 2 insertions, 235 deletions
diff --git a/gcc/ada/s-auxdec-vms-alpha.adb b/gcc/ada/s-auxdec-vms-alpha.adb index 294eb1d844b..063b296f3ac 100644 --- a/gcc/ada/s-auxdec-vms-alpha.adb +++ b/gcc/ada/s-auxdec-vms-alpha.adb @@ -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 -- ----------------------- |