gcc/ada/s-auxdec-vms_64.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                       S Y S T E M . A U X _ D E C                        --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1996-2010, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 --  This package contains definitions that are designed to be compatible
  33 --  with the extra definitions in package System for DEC Ada implementations.
  34
  35 --  These definitions can be used directly by withing this package, or merged
  36 --  with System using pragma Extend_System (Aux_DEC)
  37
  38 --  This is the VMS 64 bit version
  39
  40 with Ada.Unchecked_Conversion;
  41
  42 package System.Aux_DEC is
  43    pragma Preelaborate;
  44
  45    type Short_Integer_Address is
  46      range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1;
  47    --  Integer literals cannot appear naked in an address context, as a
  48    --  result the bounds of Short_Address cannot be given simply as 2^32 etc.
  49
  50    subtype Short_Address is Address
  51      range Address (Short_Integer_Address'First) ..
  52            Address (Short_Integer_Address'Last);
  53    for Short_Address'Object_Size use 32;
  54    --  This subtype allows addresses to be converted from 64 bits to 32 bits
  55    --  with an appropriate range check. Note that since this is a subtype of
  56    --  type System.Address, the same limitations apply to this subtype. Namely
  57    --  there are no visible arithmetic operations, and integer literals are
  58    --  not available.
  59
  60    Short_Memory_Size : constant := 2 ** 32;
  61    --  Defined for convenience of porting
  62
  63    type Integer_8  is range -2 **  (8 - 1) .. +2 **  (8 - 1) - 1;
  64    for Integer_8'Size  use  8;
  65
  66    type Integer_16 is range -2 ** (16 - 1) .. +2 ** (16 - 1) - 1;
  67    for Integer_16'Size use 16;
  68
  69    type Integer_32 is range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1;
  70    for Integer_32'Size use 32;
  71
  72    type Integer_64 is range -2 ** (64 - 1) .. +2 ** (64 - 1) - 1;
  73    for Integer_64'Size use 64;
  74
  75    type Integer_8_Array  is array (Integer range <>) of Integer_8;
  76    type Integer_16_Array is array (Integer range <>) of Integer_16;
  77    type Integer_32_Array is array (Integer range <>) of Integer_32;
  78    type Integer_64_Array is array (Integer range <>) of Integer_64;
  79    --  These array types are not in all versions of DEC System, and in fact it
  80    --  is not quite clear why they are in some and not others, but since they
  81    --  definitely appear in some versions, we include them unconditionally.
  82
  83    type Largest_Integer is range Min_Int .. Max_Int;
  84
  85    type AST_Handler is private;
  86
  87    No_AST_Handler : constant AST_Handler;
  88
  89    type Type_Class is
  90      (Type_Class_Enumeration,
  91       Type_Class_Integer,
  92       Type_Class_Fixed_Point,
  93       Type_Class_Floating_Point,
  94       Type_Class_Array,
  95       Type_Class_Record,
  96       Type_Class_Access,
  97       Type_Class_Task,             -- also in Ada 95 protected
  98       Type_Class_Address);
  99
 100    function "not" (Left        : Largest_Integer) return Largest_Integer;
 101    function "and" (Left, Right : Largest_Integer) return Largest_Integer;
 102    function "or"  (Left, Right : Largest_Integer) return Largest_Integer;
 103    function "xor" (Left, Right : Largest_Integer) return Largest_Integer;
 104
 105    Address_Zero       : constant Address;
 106    No_Addr            : constant Address;
 107    Address_Size       : constant := Standard'Address_Size;
 108    Short_Address_Size : constant := 32;
 109
 110    function "+" (Left : Address; Right : Integer) return Address;
 111    function "+" (Left : Integer; Right : Address) return Address;
 112    function "-" (Left : Address; Right : Address) return Integer;
 113    function "-" (Left : Address; Right : Integer) return Address;
 114
 115    pragma Import (Intrinsic, "+");
 116    pragma Import (Intrinsic, "-");
 117
 118    generic
 119       type Target is private;
 120    function Fetch_From_Address (A : Address) return Target;
 121
 122    generic
 123       type Target is private;
 124    procedure Assign_To_Address (A : Address; T : Target);
 125
 126    --  Floating point type declarations for VAX floating point data types
 127
 128    pragma Warnings (Off);
 129    --  ??? needs comment
 130
 131    type F_Float is digits 6;
 132    pragma Float_Representation (VAX_Float, F_Float);
 133
 134    type D_Float is digits 9;
 135    pragma Float_Representation (Vax_Float, D_Float);
 136
 137    type G_Float is digits 15;
 138    pragma Float_Representation (Vax_Float, G_Float);
 139
 140    --  Floating point type declarations for IEEE floating point data types
 141
 142    type IEEE_Single_Float is digits 6;
 143    pragma Float_Representation (IEEE_Float, IEEE_Single_Float);
 144
 145    type IEEE_Double_Float is digits 15;
 146    pragma Float_Representation (IEEE_Float, IEEE_Double_Float);
 147
 148    pragma Warnings (On);
 149
 150    Non_Ada_Error : exception;
 151
 152    --  Hardware-oriented types and functions
 153
 154    type Bit_Array is array (Integer range <>) of Boolean;
 155    pragma Pack (Bit_Array);
 156
 157    subtype Bit_Array_8  is Bit_Array (0 ..  7);
 158    subtype Bit_Array_16 is Bit_Array (0 .. 15);
 159    subtype Bit_Array_32 is Bit_Array (0 .. 31);
 160    subtype Bit_Array_64 is Bit_Array (0 .. 63);
 161
 162    type Unsigned_Byte is range 0 .. 255;
 163    for  Unsigned_Byte'Size use 8;
 164
 165    function "not" (Left        : Unsigned_Byte) return Unsigned_Byte;
 166    function "and" (Left, Right : Unsigned_Byte) return Unsigned_Byte;
 167    function "or"  (Left, Right : Unsigned_Byte) return Unsigned_Byte;
 168    function "xor" (Left, Right : Unsigned_Byte) return Unsigned_Byte;
 169
 170    function To_Unsigned_Byte (X : Bit_Array_8) return Unsigned_Byte;
 171    function To_Bit_Array_8   (X : Unsigned_Byte) return Bit_Array_8;
 172
 173    type Unsigned_Byte_Array is array (Integer range <>) of Unsigned_Byte;
 174
 175    type Unsigned_Word is range 0 .. 65535;
 176    for  Unsigned_Word'Size use 16;
 177
 178    function "not" (Left        : Unsigned_Word) return Unsigned_Word;
 179    function "and" (Left, Right : Unsigned_Word) return Unsigned_Word;
 180    function "or"  (Left, Right : Unsigned_Word) return Unsigned_Word;
 181    function "xor" (Left, Right : Unsigned_Word) return Unsigned_Word;
 182
 183    function To_Unsigned_Word (X : Bit_Array_16) return Unsigned_Word;
 184    function To_Bit_Array_16  (X : Unsigned_Word) return Bit_Array_16;
 185
 186    type Unsigned_Word_Array is array (Integer range <>) of Unsigned_Word;
 187
 188    type Unsigned_Longword is range -2_147_483_648 .. 2_147_483_647;
 189    for  Unsigned_Longword'Size use 32;
 190
 191    function "not" (Left        : Unsigned_Longword) return Unsigned_Longword;
 192    function "and" (Left, Right : Unsigned_Longword) return Unsigned_Longword;
 193    function "or"  (Left, Right : Unsigned_Longword) return Unsigned_Longword;
 194    function "xor" (Left, Right : Unsigned_Longword) return Unsigned_Longword;
 195
 196    function To_Unsigned_Longword (X : Bit_Array_32) return Unsigned_Longword;
 197    function To_Bit_Array_32 (X : Unsigned_Longword) return Bit_Array_32;
 198
 199    type Unsigned_Longword_Array is
 200       array (Integer range <>) of Unsigned_Longword;
 201
 202    type Unsigned_32 is range 0 .. 4_294_967_295;
 203    for  Unsigned_32'Size use 32;
 204
 205    function "not" (Left        : Unsigned_32) return Unsigned_32;
 206    function "and" (Left, Right : Unsigned_32) return Unsigned_32;
 207    function "or"  (Left, Right : Unsigned_32) return Unsigned_32;
 208    function "xor" (Left, Right : Unsigned_32) return Unsigned_32;
 209
 210    function To_Unsigned_32 (X : Bit_Array_32) return Unsigned_32;
 211    function To_Bit_Array_32 (X : Unsigned_32) return Bit_Array_32;
 212
 213    type Unsigned_Quadword is record
 214       L0 : Unsigned_Longword;
 215       L1 : Unsigned_Longword;
 216    end record;
 217
 218    for Unsigned_Quadword'Size      use 64;
 219    for Unsigned_Quadword'Alignment use
 220      Integer'Min (8, Standard'Maximum_Alignment);
 221
 222    function "not" (Left        : Unsigned_Quadword) return Unsigned_Quadword;
 223    function "and" (Left, Right : Unsigned_Quadword) return Unsigned_Quadword;
 224    function "or"  (Left, Right : Unsigned_Quadword) return Unsigned_Quadword;
 225    function "xor" (Left, Right : Unsigned_Quadword) return Unsigned_Quadword;
 226
 227    function To_Unsigned_Quadword (X : Bit_Array_64) return Unsigned_Quadword;
 228    function To_Bit_Array_64 (X : Unsigned_Quadword) return Bit_Array_64;
 229
 230    type Unsigned_Quadword_Array is
 231       array (Integer range <>) of Unsigned_Quadword;
 232
 233    function To_Address      (X : Integer)           return Short_Address;
 234    pragma Pure_Function (To_Address);
 235
 236    function To_Address_Long (X : Unsigned_Longword) return Short_Address;
 237    pragma Pure_Function (To_Address_Long);
 238
 239    function To_Integer      (X : Short_Address)     return Integer;
 240
 241    function To_Unsigned_Longword (X : Short_Address) return Unsigned_Longword;
 242    function To_Unsigned_Longword (X : AST_Handler)   return Unsigned_Longword;
 243
 244    --  Conventional names for static subtypes of type UNSIGNED_LONGWORD
 245
 246    subtype Unsigned_1  is Unsigned_Longword range 0 .. 2** 1-1;
 247    subtype Unsigned_2  is Unsigned_Longword range 0 .. 2** 2-1;
 248    subtype Unsigned_3  is Unsigned_Longword range 0 .. 2** 3-1;
 249    subtype Unsigned_4  is Unsigned_Longword range 0 .. 2** 4-1;
 250    subtype Unsigned_5  is Unsigned_Longword range 0 .. 2** 5-1;
 251    subtype Unsigned_6  is Unsigned_Longword range 0 .. 2** 6-1;
 252    subtype Unsigned_7  is Unsigned_Longword range 0 .. 2** 7-1;
 253    subtype Unsigned_8  is Unsigned_Longword range 0 .. 2** 8-1;
 254    subtype Unsigned_9  is Unsigned_Longword range 0 .. 2** 9-1;
 255    subtype Unsigned_10 is Unsigned_Longword range 0 .. 2**10-1;
 256    subtype Unsigned_11 is Unsigned_Longword range 0 .. 2**11-1;
 257    subtype Unsigned_12 is Unsigned_Longword range 0 .. 2**12-1;
 258    subtype Unsigned_13 is Unsigned_Longword range 0 .. 2**13-1;
 259    subtype Unsigned_14 is Unsigned_Longword range 0 .. 2**14-1;
 260    subtype Unsigned_15 is Unsigned_Longword range 0 .. 2**15-1;
 261    subtype Unsigned_16 is Unsigned_Longword range 0 .. 2**16-1;
 262    subtype Unsigned_17 is Unsigned_Longword range 0 .. 2**17-1;
 263    subtype Unsigned_18 is Unsigned_Longword range 0 .. 2**18-1;
 264    subtype Unsigned_19 is Unsigned_Longword range 0 .. 2**19-1;
 265    subtype Unsigned_20 is Unsigned_Longword range 0 .. 2**20-1;
 266    subtype Unsigned_21 is Unsigned_Longword range 0 .. 2**21-1;
 267    subtype Unsigned_22 is Unsigned_Longword range 0 .. 2**22-1;
 268    subtype Unsigned_23 is Unsigned_Longword range 0 .. 2**23-1;
 269    subtype Unsigned_24 is Unsigned_Longword range 0 .. 2**24-1;
 270    subtype Unsigned_25 is Unsigned_Longword range 0 .. 2**25-1;
 271    subtype Unsigned_26 is Unsigned_Longword range 0 .. 2**26-1;
 272    subtype Unsigned_27 is Unsigned_Longword range 0 .. 2**27-1;
 273    subtype Unsigned_28 is Unsigned_Longword range 0 .. 2**28-1;
 274    subtype Unsigned_29 is Unsigned_Longword range 0 .. 2**29-1;
 275    subtype Unsigned_30 is Unsigned_Longword range 0 .. 2**30-1;
 276    subtype Unsigned_31 is Unsigned_Longword range 0 .. 2**31-1;
 277
 278    --  Function for obtaining global symbol values
 279
 280    function Import_Value         (Symbol : String) return Unsigned_Longword;
 281    function Import_Address       (Symbol : String) return Address;
 282    function Import_Largest_Value (Symbol : String) return Largest_Integer;
 283
 284    pragma Import (Intrinsic, Import_Value);
 285    pragma Import (Intrinsic, Import_Address);
 286    pragma Import (Intrinsic, Import_Largest_Value);
 287
 288    --  For the following declarations, note that the declaration without a
 289    --  Retry_Count parameter means to retry infinitely. A value of zero for
 290    --  the Retry_Count parameter means do not retry.
 291
 292    --  Interlocked-instruction procedures
 293
 294    procedure Clear_Interlocked
 295      (Bit       : in out Boolean;
 296       Old_Value : out Boolean);
 297
 298    procedure Set_Interlocked
 299      (Bit       : in out Boolean;
 300       Old_Value : out Boolean);
 301
 302    type Aligned_Word is record
 303       Value : Short_Integer;
 304    end record;
 305
 306    for Aligned_Word'Alignment use Integer'Min (2, Standard'Maximum_Alignment);
 307
 308    procedure Clear_Interlocked
 309      (Bit          : in out Boolean;
 310       Old_Value    : out Boolean;
 311       Retry_Count  : Natural;
 312       Success_Flag : out Boolean);
 313
 314    procedure Set_Interlocked
 315      (Bit          : in out Boolean;
 316       Old_Value    : out Boolean;
 317       Retry_Count  : Natural;
 318       Success_Flag : out Boolean);
 319
 320    procedure Add_Interlocked
 321      (Addend       : Short_Integer;
 322       Augend       : in out Aligned_Word;
 323       Sign         : out Integer);
 324
 325    type Aligned_Integer is record
 326       Value : Integer;
 327    end record;
 328
 329    for Aligned_Integer'Alignment use
 330      Integer'Min (4, Standard'Maximum_Alignment);
 331
 332    type Aligned_Long_Integer is record
 333       Value : Long_Integer;
 334    end record;
 335
 336    for Aligned_Long_Integer'Alignment use
 337      Integer'Min (8, Standard'Maximum_Alignment);
 338
 339    --  For the following declarations, note that the declaration without a
 340    --  Retry_Count parameter mean to retry infinitely. A value of zero for
 341    --  the Retry_Count means do not retry.
 342
 343    procedure Add_Atomic
 344      (To           : in out Aligned_Integer;
 345       Amount       : Integer);
 346
 347    procedure Add_Atomic
 348      (To           : in out Aligned_Integer;
 349       Amount       : Integer;
 350       Retry_Count  : Natural;
 351       Old_Value    : out Integer;
 352       Success_Flag : out Boolean);
 353
 354    procedure Add_Atomic
 355      (To           : in out Aligned_Long_Integer;
 356       Amount       : Long_Integer);
 357
 358    procedure Add_Atomic
 359      (To           : in out Aligned_Long_Integer;
 360       Amount       : Long_Integer;
 361       Retry_Count  : Natural;
 362       Old_Value    : out Long_Integer;
 363       Success_Flag : out Boolean);
 364
 365    procedure And_Atomic
 366      (To           : in out Aligned_Integer;
 367       From         : Integer);
 368
 369    procedure And_Atomic
 370      (To           : in out Aligned_Integer;
 371       From         : Integer;
 372       Retry_Count  : Natural;
 373       Old_Value    : out Integer;
 374       Success_Flag : out Boolean);
 375
 376    procedure And_Atomic
 377      (To           : in out Aligned_Long_Integer;
 378       From         : Long_Integer);
 379
 380    procedure And_Atomic
 381      (To           : in out Aligned_Long_Integer;
 382       From         : Long_Integer;
 383       Retry_Count  : Natural;
 384       Old_Value    : out Long_Integer;
 385       Success_Flag : out Boolean);
 386
 387    procedure Or_Atomic
 388      (To           : in out Aligned_Integer;
 389       From         : Integer);
 390
 391    procedure Or_Atomic
 392      (To           : in out Aligned_Integer;
 393       From         : Integer;
 394       Retry_Count  : Natural;
 395       Old_Value    : out Integer;
 396       Success_Flag : out Boolean);
 397
 398    procedure Or_Atomic
 399      (To           : in out Aligned_Long_Integer;
 400       From         : Long_Integer);
 401
 402    procedure Or_Atomic
 403      (To           : in out Aligned_Long_Integer;
 404       From         : Long_Integer;
 405       Retry_Count  : Natural;
 406       Old_Value    : out Long_Integer;
 407       Success_Flag : out Boolean);
 408
 409    type Insq_Status is (Fail_No_Lock, OK_Not_First, OK_First);
 410
 411    for Insq_Status use
 412      (Fail_No_Lock => -1,
 413       OK_Not_First =>  0,
 414       OK_First     => +1);
 415
 416    type Remq_Status is (
 417      Fail_No_Lock,
 418      Fail_Was_Empty,
 419      OK_Not_Empty,
 420      OK_Empty);
 421
 422    for Remq_Status use
 423      (Fail_No_Lock   => -1,
 424       Fail_Was_Empty =>  0,
 425       OK_Not_Empty   => +1,
 426       OK_Empty       => +2);
 427
 428    procedure Insqhi
 429      (Item   : Address;
 430       Header : Address;
 431       Status : out Insq_Status);
 432
 433    procedure Remqhi
 434      (Header : Address;
 435       Item   : out Address;
 436       Status : out Remq_Status);
 437
 438    procedure Insqti
 439      (Item   : Address;
 440       Header : Address;
 441       Status : out Insq_Status);
 442
 443    procedure Remqti
 444      (Header : Address;
 445       Item   : out Address;
 446       Status : out Remq_Status);
 447
 448 private
 449
 450    Address_Zero : constant Address := Null_Address;
 451    No_Addr      : constant Address := Null_Address;
 452
 453    --  An AST_Handler value is from a typing point of view simply a pointer
 454    --  to a procedure taking a single 64 bit parameter. However, this
 455    --  is a bit misleading, because the data that this pointer references is
 456    --  highly stylized. See body of System.AST_Handling for full details.
 457
 458    type AST_Handler is access procedure (Param : Long_Integer);
 459    No_AST_Handler : constant AST_Handler := null;
 460
 461    --  Other operators have incorrect profiles. It would be nice to make
 462    --  them intrinsic, since the backend can handle them, but the front
 463    --  end is not prepared to deal with them, so at least inline them.
 464
 465    pragma Import (Intrinsic, "not");
 466    pragma Import (Intrinsic, "and");
 467    pragma Import (Intrinsic, "or");
 468    pragma Import (Intrinsic, "xor");
 469
 470    --  Other inlined subprograms
 471
 472    pragma Inline_Always (Fetch_From_Address);
 473    pragma Inline_Always (Assign_To_Address);
 474
 475    --  Synchronization related subprograms. Mechanism is explicitly set
 476    --  so that the critical parameters are passed by reference.
 477    --  Without this, the parameters are passed by copy, creating load/store
 478    --  race conditions. We also inline them, since this seems more in the
 479    --  spirit of the original (hardware intrinsic) routines.
 480
 481    pragma Export_Procedure
 482      (Clear_Interlocked,
 483       External        => "system__aux_dec__clear_interlocked__1",
 484       Parameter_Types => (Boolean, Boolean),
 485       Mechanism       => (Reference, Reference));
 486    pragma Export_Procedure
 487      (Clear_Interlocked,
 488       External        => "system__aux_dec__clear_interlocked__2",
 489       Parameter_Types => (Boolean, Boolean, Natural, Boolean),
 490       Mechanism       => (Reference, Reference, Value, Reference));
 491    pragma Inline_Always (Clear_Interlocked);
 492
 493    pragma Export_Procedure
 494      (Set_Interlocked,
 495       External        => "system__aux_dec__set_interlocked__1",
 496       Parameter_Types => (Boolean, Boolean),
 497       Mechanism       => (Reference, Reference));
 498    pragma Export_Procedure
 499      (Set_Interlocked,
 500       External        => "system__aux_dec__set_interlocked__2",
 501       Parameter_Types => (Boolean, Boolean, Natural, Boolean),
 502       Mechanism       => (Reference, Reference, Value, Reference));
 503    pragma Inline_Always (Set_Interlocked);
 504
 505    pragma Export_Procedure
 506      (Add_Interlocked,
 507       External        => "system__aux_dec__add_interlocked__1",
 508       Mechanism       => (Value, Reference, Reference));
 509    pragma Inline_Always (Add_Interlocked);
 510
 511    pragma Export_Procedure
 512      (Add_Atomic,
 513       External        => "system__aux_dec__add_atomic__1",
 514       Parameter_Types => (Aligned_Integer, Integer),
 515       Mechanism       => (Reference, Value));
 516    pragma Export_Procedure
 517      (Add_Atomic,
 518       External        => "system__aux_dec__add_atomic__2",
 519       Parameter_Types => (Aligned_Integer, Integer, Natural, Integer, Boolean),
 520       Mechanism       => (Reference, Value, Value, Reference, Reference));
 521    pragma Export_Procedure
 522      (Add_Atomic,
 523       External        => "system__aux_dec__add_atomic__3",
 524       Parameter_Types => (Aligned_Long_Integer, Long_Integer),
 525       Mechanism       => (Reference, Value));
 526    pragma Export_Procedure
 527      (Add_Atomic,
 528       External        => "system__aux_dec__add_atomic__4",
 529       Parameter_Types => (Aligned_Long_Integer, Long_Integer, Natural,
 530                           Long_Integer, Boolean),
 531       Mechanism       => (Reference, Value, Value, Reference, Reference));
 532    pragma Inline_Always (Add_Atomic);
 533
 534    pragma Export_Procedure
 535      (And_Atomic,
 536       External        => "system__aux_dec__and_atomic__1",
 537       Parameter_Types => (Aligned_Integer, Integer),
 538       Mechanism       => (Reference, Value));
 539    pragma Export_Procedure
 540      (And_Atomic,
 541       External        => "system__aux_dec__and_atomic__2",
 542       Parameter_Types => (Aligned_Integer, Integer, Natural, Integer, Boolean),
 543       Mechanism       => (Reference, Value, Value, Reference, Reference));
 544    pragma Export_Procedure
 545      (And_Atomic,
 546       External        => "system__aux_dec__and_atomic__3",
 547       Parameter_Types => (Aligned_Long_Integer, Long_Integer),
 548       Mechanism       => (Reference, Value));
 549    pragma Export_Procedure
 550      (And_Atomic,
 551       External        => "system__aux_dec__and_atomic__4",
 552       Parameter_Types => (Aligned_Long_Integer, Long_Integer, Natural,
 553                           Long_Integer, Boolean),
 554       Mechanism       => (Reference, Value, Value, Reference, Reference));
 555    pragma Inline_Always (And_Atomic);
 556
 557    pragma Export_Procedure
 558      (Or_Atomic,
 559       External        => "system__aux_dec__or_atomic__1",
 560       Parameter_Types => (Aligned_Integer, Integer),
 561       Mechanism       => (Reference, Value));
 562    pragma Export_Procedure
 563      (Or_Atomic,
 564       External        => "system__aux_dec__or_atomic__2",
 565       Parameter_Types => (Aligned_Integer, Integer, Natural, Integer, Boolean),
 566       Mechanism       => (Reference, Value, Value, Reference, Reference));
 567    pragma Export_Procedure
 568      (Or_Atomic,
 569       External        => "system__aux_dec__or_atomic__3",
 570       Parameter_Types => (Aligned_Long_Integer, Long_Integer),
 571       Mechanism       => (Reference, Value));
 572    pragma Export_Procedure
 573      (Or_Atomic,
 574       External        => "system__aux_dec__or_atomic__4",
 575       Parameter_Types => (Aligned_Long_Integer, Long_Integer, Natural,
 576                           Long_Integer, Boolean),
 577       Mechanism       => (Reference, Value, Value, Reference, Reference));
 578    pragma Inline_Always (Or_Atomic);
 579
 580    --  Inline the VAX Queue Functions
 581
 582    pragma Inline_Always (Insqhi);
 583    pragma Inline_Always (Remqhi);
 584    pragma Inline_Always (Insqti);
 585    pragma Inline_Always (Remqti);
 586
 587    --  Provide proper unchecked conversion definitions for transfer
 588    --  functions. Note that we need this level of indirection because
 589    --  the formal parameter name is X and not Source (and this is indeed
 590    --  detectable by a program)
 591
 592    function To_Unsigned_Byte_A is new
 593      Ada.Unchecked_Conversion (Bit_Array_8, Unsigned_Byte);
 594
 595    function To_Unsigned_Byte (X : Bit_Array_8) return Unsigned_Byte
 596      renames To_Unsigned_Byte_A;
 597
 598    function To_Bit_Array_8_A is new
 599      Ada.Unchecked_Conversion (Unsigned_Byte, Bit_Array_8);
 600
 601    function To_Bit_Array_8 (X : Unsigned_Byte) return Bit_Array_8
 602      renames To_Bit_Array_8_A;
 603
 604    function To_Unsigned_Word_A is new
 605      Ada.Unchecked_Conversion (Bit_Array_16, Unsigned_Word);
 606
 607    function To_Unsigned_Word (X : Bit_Array_16) return Unsigned_Word
 608      renames To_Unsigned_Word_A;
 609
 610    function To_Bit_Array_16_A is new
 611      Ada.Unchecked_Conversion (Unsigned_Word, Bit_Array_16);
 612
 613    function To_Bit_Array_16 (X : Unsigned_Word) return Bit_Array_16
 614      renames To_Bit_Array_16_A;
 615
 616    function To_Unsigned_Longword_A is new
 617      Ada.Unchecked_Conversion (Bit_Array_32, Unsigned_Longword);
 618
 619    function To_Unsigned_Longword (X : Bit_Array_32) return Unsigned_Longword
 620      renames To_Unsigned_Longword_A;
 621
 622    function To_Bit_Array_32_A is new
 623      Ada.Unchecked_Conversion (Unsigned_Longword, Bit_Array_32);
 624
 625    function To_Bit_Array_32 (X : Unsigned_Longword) return Bit_Array_32
 626      renames To_Bit_Array_32_A;
 627
 628    function To_Unsigned_32_A is new
 629      Ada.Unchecked_Conversion (Bit_Array_32, Unsigned_32);
 630
 631    function To_Unsigned_32 (X : Bit_Array_32) return Unsigned_32
 632      renames To_Unsigned_32_A;
 633
 634    function To_Bit_Array_32_A is new
 635      Ada.Unchecked_Conversion (Unsigned_32, Bit_Array_32);
 636
 637    function To_Bit_Array_32 (X : Unsigned_32) return Bit_Array_32
 638      renames To_Bit_Array_32_A;
 639
 640    function To_Unsigned_Quadword_A is new
 641      Ada.Unchecked_Conversion (Bit_Array_64, Unsigned_Quadword);
 642
 643    function To_Unsigned_Quadword (X : Bit_Array_64) return Unsigned_Quadword
 644      renames To_Unsigned_Quadword_A;
 645
 646    function To_Bit_Array_64_A is new
 647      Ada.Unchecked_Conversion (Unsigned_Quadword, Bit_Array_64);
 648
 649    function To_Bit_Array_64 (X : Unsigned_Quadword) return Bit_Array_64
 650      renames To_Bit_Array_64_A;
 651
 652    pragma Warnings (Off);
 653    --  Turn warnings off. This is needed for systems with 64-bit integers,
 654    --  where some of these operations are of dubious meaning, but we do not
 655    --  want warnings when we compile on such systems.
 656
 657    function To_Address_A is new
 658      Ada.Unchecked_Conversion (Integer, Short_Address);
 659    pragma Pure_Function (To_Address_A);
 660
 661    function To_Address (X : Integer) return Short_Address
 662      renames To_Address_A;
 663    pragma Pure_Function (To_Address);
 664
 665    function To_Address_Long_A is new
 666      Ada.Unchecked_Conversion (Unsigned_Longword, Short_Address);
 667    pragma Pure_Function (To_Address_Long_A);
 668
 669    function To_Address_Long (X : Unsigned_Longword) return Short_Address
 670      renames To_Address_Long_A;
 671    pragma Pure_Function (To_Address_Long);
 672
 673    function To_Integer_A is new
 674      Ada.Unchecked_Conversion (Short_Address, Integer);
 675
 676    function To_Integer (X : Short_Address) return Integer
 677      renames To_Integer_A;
 678
 679    function To_Unsigned_Longword_A is new
 680      Ada.Unchecked_Conversion (Short_Address, Unsigned_Longword);
 681
 682    function To_Unsigned_Longword (X : Short_Address) return Unsigned_Longword
 683      renames To_Unsigned_Longword_A;
 684
 685    function To_Unsigned_Longword_A is new
 686      Ada.Unchecked_Conversion (AST_Handler, Unsigned_Longword);
 687
 688    function To_Unsigned_Longword (X : AST_Handler) return Unsigned_Longword
 689      renames To_Unsigned_Longword_A;
 690
 691    pragma Warnings (On);
 692
 693 end System.Aux_DEC;