summaryrefslogtreecommitdiff
path: root/gcc/ada/s-auxdec-vms-alpha.adb
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2010-06-17 13:14:44 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2010-06-17 13:14:44 +0000
commit14d22a3f062f8a069588a4485ebaa28756a7530c (patch)
tree43db9e38c43410e0eeefdcaa7825c5d85ca120ee /gcc/ada/s-auxdec-vms-alpha.adb
parentdf0c9c1a9edfae572198616adc60aa18779e6d54 (diff)
downloadgcc-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.adb237
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 --
-----------------------