gcc/ada/s-auxdec-vms-alpha.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                       S Y S T E M . A U X _ D E C                        --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-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 pragma Style_Checks (All_Checks);
  33 --  Turn off alpha ordering check on subprograms, this unit is laid
  34 --  out to correspond to the declarations in the DEC 83 System unit.
  35
  36 with System.Machine_Code; use System.Machine_Code;
  37 package body System.Aux_DEC is
  38
  39    -----------------------------------
  40    -- Operations on Largest_Integer --
  41    -----------------------------------
  42
  43    --  It would be nice to replace these with intrinsics, but that does
  44    --  not work yet (the back end would be ok, but GNAT itself objects)
  45
  46    type LIU is mod 2 ** Largest_Integer'Size;
  47    --  Unsigned type of same length as Largest_Integer
  48
  49    function To_LI   is new Ada.Unchecked_Conversion (LIU, Largest_Integer);
  50    function From_LI is new Ada.Unchecked_Conversion (Largest_Integer, LIU);
  51
  52    function "not" (Left : Largest_Integer) return Largest_Integer is
  53    begin
  54       return To_LI (not From_LI (Left));
  55    end "not";
  56
  57    function "and" (Left, Right : Largest_Integer) return Largest_Integer is
  58    begin
  59       return To_LI (From_LI (Left) and From_LI (Right));
  60    end "and";
  61
  62    function "or"  (Left, Right : Largest_Integer) return Largest_Integer is
  63    begin
  64       return To_LI (From_LI (Left) or From_LI (Right));
  65    end "or";
  66
  67    function "xor" (Left, Right : Largest_Integer) return Largest_Integer is
  68    begin
  69       return To_LI (From_LI (Left) xor From_LI (Right));
  70    end "xor";
  71
  72    --------------------------------------
  73    -- Arithmetic Operations on Address --
  74    --------------------------------------
  75
  76    --  It would be nice to replace these with intrinsics, but that does
  77    --  not work yet (the back end would be ok, but GNAT itself objects)
  78
  79    Asiz : constant Integer := Integer (Address'Size) - 1;
  80
  81    type SA is range -(2 ** Asiz) .. 2 ** Asiz - 1;
  82    --  Signed type of same size as Address
  83
  84    function To_A   is new Ada.Unchecked_Conversion (SA, Address);
  85    function From_A is new Ada.Unchecked_Conversion (Address, SA);
  86
  87    function "+" (Left : Address; Right : Integer) return Address is
  88    begin
  89       return To_A (From_A (Left) + SA (Right));
  90    end "+";
  91
  92    function "+" (Left : Integer; Right : Address) return Address is
  93    begin
  94       return To_A (SA (Left) + From_A (Right));
  95    end "+";
  96
  97    function "-" (Left : Address; Right : Address) return Integer is
  98       pragma Unsuppress (All_Checks);
  99       --  Because this can raise Constraint_Error for 64-bit addresses
 100    begin
 101       return Integer (From_A (Left) - From_A (Right));
 102    end "-";
 103
 104    function "-" (Left : Address; Right : Integer) return Address is
 105    begin
 106       return To_A (From_A (Left) - SA (Right));
 107    end "-";
 108
 109    ------------------------
 110    -- Fetch_From_Address --
 111    ------------------------
 112
 113    function Fetch_From_Address (A : Address) return Target is
 114       type T_Ptr is access all Target;
 115       function To_T_Ptr is new Ada.Unchecked_Conversion (Address, T_Ptr);
 116       Ptr : constant T_Ptr := To_T_Ptr (A);
 117    begin
 118       return Ptr.all;
 119    end Fetch_From_Address;
 120
 121    -----------------------
 122    -- Assign_To_Address --
 123    -----------------------
 124
 125    procedure Assign_To_Address (A : Address; T : Target) is
 126       type T_Ptr is access all Target;
 127       function To_T_Ptr is new Ada.Unchecked_Conversion (Address, T_Ptr);
 128       Ptr : constant T_Ptr := To_T_Ptr (A);
 129    begin
 130       Ptr.all := T;
 131    end Assign_To_Address;
 132
 133    ---------------------------------
 134    -- Operations on Unsigned_Byte --
 135    ---------------------------------
 136
 137    --  It would be nice to replace these with intrinsics, but that does
 138    --  not work yet (the back end would be ok, but GNAT itself objects) ???
 139
 140    type BU is mod 2 ** Unsigned_Byte'Size;
 141    --  Unsigned type of same length as Unsigned_Byte
 142
 143    function To_B   is new Ada.Unchecked_Conversion (BU, Unsigned_Byte);
 144    function From_B is new Ada.Unchecked_Conversion (Unsigned_Byte, BU);
 145
 146    function "not" (Left : Unsigned_Byte) return Unsigned_Byte is
 147    begin
 148       return To_B (not From_B (Left));
 149    end "not";
 150
 151    function "and" (Left, Right : Unsigned_Byte) return Unsigned_Byte is
 152    begin
 153       return To_B (From_B (Left) and From_B (Right));
 154    end "and";
 155
 156    function "or"  (Left, Right : Unsigned_Byte) return Unsigned_Byte is
 157    begin
 158       return To_B (From_B (Left) or From_B (Right));
 159    end "or";
 160
 161    function "xor" (Left, Right : Unsigned_Byte) return Unsigned_Byte is
 162    begin
 163       return To_B (From_B (Left) xor From_B (Right));
 164    end "xor";
 165
 166    ---------------------------------
 167    -- Operations on Unsigned_Word --
 168    ---------------------------------
 169
 170    --  It would be nice to replace these with intrinsics, but that does
 171    --  not work yet (the back end would be ok, but GNAT itself objects) ???
 172
 173    type WU is mod 2 ** Unsigned_Word'Size;
 174    --  Unsigned type of same length as Unsigned_Word
 175
 176    function To_W   is new Ada.Unchecked_Conversion (WU, Unsigned_Word);
 177    function From_W is new Ada.Unchecked_Conversion (Unsigned_Word, WU);
 178
 179    function "not" (Left : Unsigned_Word) return Unsigned_Word is
 180    begin
 181       return To_W (not From_W (Left));
 182    end "not";
 183
 184    function "and" (Left, Right : Unsigned_Word) return Unsigned_Word is
 185    begin
 186       return To_W (From_W (Left) and From_W (Right));
 187    end "and";
 188
 189    function "or"  (Left, Right : Unsigned_Word) return Unsigned_Word is
 190    begin
 191       return To_W (From_W (Left) or From_W (Right));
 192    end "or";
 193
 194    function "xor" (Left, Right : Unsigned_Word) return Unsigned_Word is
 195    begin
 196       return To_W (From_W (Left) xor From_W (Right));
 197    end "xor";
 198
 199    -------------------------------------
 200    -- Operations on Unsigned_Longword --
 201    -------------------------------------
 202
 203    --  It would be nice to replace these with intrinsics, but that does
 204    --  not work yet (the back end would be ok, but GNAT itself objects) ???
 205
 206    type LWU is mod 2 ** Unsigned_Longword'Size;
 207    --  Unsigned type of same length as Unsigned_Longword
 208
 209    function To_LW   is new Ada.Unchecked_Conversion (LWU, Unsigned_Longword);
 210    function From_LW is new Ada.Unchecked_Conversion (Unsigned_Longword, LWU);
 211
 212    function "not" (Left : Unsigned_Longword) return Unsigned_Longword is
 213    begin
 214       return To_LW (not From_LW (Left));
 215    end "not";
 216
 217    function "and" (Left, Right : Unsigned_Longword) return Unsigned_Longword is
 218    begin
 219       return To_LW (From_LW (Left) and From_LW (Right));
 220    end "and";
 221
 222    function "or"  (Left, Right : Unsigned_Longword) return Unsigned_Longword is
 223    begin
 224       return To_LW (From_LW (Left) or From_LW (Right));
 225    end "or";
 226
 227    function "xor" (Left, Right : Unsigned_Longword) return Unsigned_Longword is
 228    begin
 229       return To_LW (From_LW (Left) xor From_LW (Right));
 230    end "xor";
 231
 232    -------------------------------
 233    -- Operations on Unsigned_32 --
 234    -------------------------------
 235
 236    --  It would be nice to replace these with intrinsics, but that does
 237    --  not work yet (the back end would be ok, but GNAT itself objects) ???
 238
 239    type U32 is mod 2 ** Unsigned_32'Size;
 240    --  Unsigned type of same length as Unsigned_32
 241
 242    function To_U32   is new Ada.Unchecked_Conversion (U32, Unsigned_32);
 243    function From_U32 is new Ada.Unchecked_Conversion (Unsigned_32, U32);
 244
 245    function "not" (Left : Unsigned_32) return Unsigned_32 is
 246    begin
 247       return To_U32 (not From_U32 (Left));
 248    end "not";
 249
 250    function "and" (Left, Right : Unsigned_32) return Unsigned_32 is
 251    begin
 252       return To_U32 (From_U32 (Left) and From_U32 (Right));
 253    end "and";
 254
 255    function "or"  (Left, Right : Unsigned_32) return Unsigned_32 is
 256    begin
 257       return To_U32 (From_U32 (Left) or From_U32 (Right));
 258    end "or";
 259
 260    function "xor" (Left, Right : Unsigned_32) return Unsigned_32 is
 261    begin
 262       return To_U32 (From_U32 (Left) xor From_U32 (Right));
 263    end "xor";
 264
 265    -------------------------------------
 266    -- Operations on Unsigned_Quadword --
 267    -------------------------------------
 268
 269    --  It would be nice to replace these with intrinsics, but that does
 270    --  not work yet (the back end would be ok, but GNAT itself objects) ???
 271
 272    type QWU is mod 2 ** 64;  -- 64 = Unsigned_Quadword'Size
 273    --  Unsigned type of same length as Unsigned_Quadword
 274
 275    function To_QW   is new Ada.Unchecked_Conversion (QWU, Unsigned_Quadword);
 276    function From_QW is new Ada.Unchecked_Conversion (Unsigned_Quadword, QWU);
 277
 278    function "not" (Left : Unsigned_Quadword) return Unsigned_Quadword is
 279    begin
 280       return To_QW (not From_QW (Left));
 281    end "not";
 282
 283    function "and" (Left, Right : Unsigned_Quadword) return Unsigned_Quadword is
 284    begin
 285       return To_QW (From_QW (Left) and From_QW (Right));
 286    end "and";
 287
 288    function "or"  (Left, Right : Unsigned_Quadword) return Unsigned_Quadword is
 289    begin
 290       return To_QW (From_QW (Left) or From_QW (Right));
 291    end "or";
 292
 293    function "xor" (Left, Right : Unsigned_Quadword) return Unsigned_Quadword is
 294    begin
 295       return To_QW (From_QW (Left) xor From_QW (Right));
 296    end "xor";
 297
 298    -----------------------
 299    -- Clear_Interlocked --
 300    -----------------------
 301
 302    procedure Clear_Interlocked
 303      (Bit       : in out Boolean;
 304       Old_Value : out Boolean)
 305    is
 306       use ASCII;
 307       Clr_Bit : Boolean := Bit;
 308       Old_Bit : Boolean;
 309
 310    begin
 311       --  All these ASM sequences should be commented. I suggest definining
 312       --  a constant called E which is LF & HT and then you have more space
 313       --  for line by line comments ???
 314
 315       System.Machine_Code.Asm
 316         (
 317          "lda $16, %2"      & LF & HT &
 318          "mb"               & LF & HT &
 319          "sll $16, 3, $17 " & LF & HT &
 320          "bis $31, 1, $1"   & LF & HT &
 321          "and $17, 63, $18" & LF & HT &
 322          "bic $17, 63, $17" & LF & HT &
 323          "sra $17, 3, $17"  & LF & HT &
 324          "bis $31, 1, %1"   & LF & HT &
 325          "sll %1, $18, $18" & LF & HT &
 326          "1:"               & LF & HT &
 327          "ldq_l $1, 0($17)" & LF & HT &
 328          "and $1, $18, %1"  & LF & HT &
 329          "bic $1, $18, $1"  & LF & HT &
 330          "stq_c $1, 0($17)" & LF & HT &
 331          "cmpeq %1, 0, %1"  & LF & HT &
 332          "beq $1, 1b"       & LF & HT &
 333          "mb"               & LF & HT &
 334          "xor %1, 1, %1"    & LF & HT &
 335          "trapb",
 336          Outputs  => (Boolean'Asm_Output ("=m", Clr_Bit),
 337                       Boolean'Asm_Output ("=r", Old_Bit)),
 338          Inputs   => Boolean'Asm_Input ("m", Clr_Bit),
 339          Clobber  => "$1, $16, $17, $18",
 340          Volatile => True);
 341
 342          Bit := Clr_Bit;
 343          Old_Value := Old_Bit;
 344    end Clear_Interlocked;
 345
 346    procedure Clear_Interlocked
 347      (Bit          : in out Boolean;
 348       Old_Value    : out Boolean;
 349       Retry_Count  : Natural;
 350       Success_Flag : out Boolean)
 351    is
 352       use ASCII;
 353       Clr_Bit : Boolean := Bit;
 354       Succ, Old_Bit : Boolean;
 355
 356    begin
 357       System.Machine_Code.Asm
 358         (
 359          "lda $16, %3"      & LF & HT &
 360          "mb"               & LF & HT &
 361          "sll $16, 3, $18 " & LF & HT &
 362          "bis $31, 1, %1"   & LF & HT &
 363          "and $18, 63, $19" & LF & HT &
 364          "bic $18, 63, $18" & LF & HT &
 365          "sra $18, 3, $18"  & LF & HT &
 366          "bis $31, %4, $17" & LF & HT &
 367          "sll %1, $19, $19" & LF & HT &
 368          "1:"               & LF & HT &
 369          "ldq_l %2, 0($18)" & LF & HT &
 370          "and %2, $19, %1"  & LF & HT &
 371          "bic %2, $19, %2"  & LF & HT &
 372          "stq_c %2, 0($18)" & LF & HT &
 373          "beq %2, 2f"       & LF & HT &
 374          "cmpeq %1, 0, %1"  & LF & HT &
 375          "br 3f"            & LF & HT &
 376          "2:"               & LF & HT &
 377          "subq $17, 1, $17" & LF & HT &
 378          "bgt $17, 1b"      & LF & HT &
 379          "3:"               & LF & HT &
 380          "mb"               & LF & HT &
 381          "xor %1, 1, %1"    & LF & HT &
 382          "trapb",
 383          Outputs  => (Boolean'Asm_Output ("=m", Clr_Bit),
 384                       Boolean'Asm_Output ("=r", Old_Bit),
 385                       Boolean'Asm_Output ("=r", Succ)),
 386          Inputs   => (Boolean'Asm_Input ("m", Clr_Bit),
 387                       Natural'Asm_Input ("rJ", Retry_Count)),
 388          Clobber  => "$16, $17, $18, $19",
 389          Volatile => True);
 390
 391          Bit := Clr_Bit;
 392          Old_Value := Old_Bit;
 393          Success_Flag := Succ;
 394    end Clear_Interlocked;
 395
 396    ---------------------
 397    -- Set_Interlocked --
 398    ---------------------
 399
 400    procedure Set_Interlocked
 401      (Bit       : in out Boolean;
 402       Old_Value : out Boolean)
 403    is
 404       use ASCII;
 405       Set_Bit : Boolean := Bit;
 406       Old_Bit : Boolean;
 407
 408    begin
 409       --  Don't we need comments on these long asm sequences???
 410
 411       System.Machine_Code.Asm
 412         (
 413          "lda $16, %2"      & LF & HT &
 414          "sll $16, 3, $17 " & LF & HT &
 415          "bis $31, 1, $1"   & LF & HT &
 416          "and $17, 63, $18" & LF & HT &
 417          "mb"               & LF & HT &
 418          "bic $17, 63, $17" & LF & HT &
 419          "sra $17, 3, $17"  & LF & HT &
 420          "bis $31, 1, %1"   & LF & HT &
 421          "sll %1, $18, $18" & LF & HT &
 422          "1:"               & LF & HT &
 423          "ldq_l $1, 0($17)" & LF & HT &
 424          "and $1, $18, %1"  & LF & HT &
 425          "bis $1, $18, $1"  & LF & HT &
 426          "stq_c $1, 0($17)" & LF & HT &
 427          "cmovne %1, 1, %1" & LF & HT &
 428          "beq $1, 1b"       & LF & HT &
 429          "mb"               & LF & HT &
 430          "trapb",
 431          Outputs  => (Boolean'Asm_Output ("=m", Set_Bit),
 432                       Boolean'Asm_Output ("=r", Old_Bit)),
 433          Inputs   => Boolean'Asm_Input ("m", Set_Bit),
 434          Clobber  => "$1, $16, $17, $18",
 435          Volatile => True);
 436
 437          Bit := Set_Bit;
 438          Old_Value := Old_Bit;
 439    end Set_Interlocked;
 440
 441    procedure Set_Interlocked
 442      (Bit          : in out Boolean;
 443       Old_Value    : out Boolean;
 444       Retry_Count  : Natural;
 445       Success_Flag : out Boolean)
 446    is
 447       use ASCII;
 448       Set_Bit : Boolean := Bit;
 449       Succ, Old_Bit : Boolean;
 450
 451    begin
 452       System.Machine_Code.Asm
 453         (
 454          "lda $16, %3"      & LF & HT &
 455          "mb"               & LF & HT &
 456          "sll $16, 3, $18 " & LF & HT &
 457          "bis $31, 1, %1"   & LF & HT &
 458          "and $18, 63, $19" & LF & HT &
 459          "bic $18, 63, $18" & LF & HT &
 460          "sra $18, 3, $18"  & LF & HT &
 461          "bis $31, %4, $17" & LF & HT &
 462          "sll %1, $19, $19" & LF & HT &
 463          "1:"               & LF & HT &
 464          "ldq_l %2, 0($18)" & LF & HT &
 465          "and %2, $19, %1"  & LF & HT &
 466          "bis %2, $19, %2"  & LF & HT &
 467          "stq_c %2, 0($18)" & LF & HT &
 468          "beq %2, 2f"       & LF & HT &
 469          "cmovne %1, 1, %1" & LF & HT &
 470          "br 3f"            & LF & HT &
 471          "2:"               & LF & HT &
 472          "subq $17, 1, $17" & LF & HT &
 473          "bgt $17, 1b"      & LF & HT &
 474          "3:"               & LF & HT &
 475          "mb"               & LF & HT &
 476          "trapb",
 477          Outputs  => (Boolean'Asm_Output ("=m", Set_Bit),
 478                       Boolean'Asm_Output ("=r", Old_Bit),
 479                       Boolean'Asm_Output ("=r", Succ)),
 480          Inputs   => (Boolean'Asm_Input ("m", Set_Bit),
 481                       Natural'Asm_Input ("rJ", Retry_Count)),
 482          Clobber  => "$16, $17, $18, $19",
 483          Volatile => True);
 484
 485          Bit := Set_Bit;
 486          Old_Value := Old_Bit;
 487          Success_Flag := Succ;
 488    end Set_Interlocked;
 489
 490    ---------------------
 491    -- Add_Interlocked --
 492    ---------------------
 493
 494    procedure Add_Interlocked
 495      (Addend : Short_Integer;
 496       Augend : in out Aligned_Word;
 497       Sign   : out Integer)
 498    is
 499       use ASCII;
 500       Overflowed : Boolean := False;
 501
 502    begin
 503       System.Machine_Code.Asm
 504         (
 505          "lda $18, %0"         & LF & HT &
 506          "bic $18, 6, $21"     & LF & HT &
 507          "mb"                  & LF & HT &
 508          "1:"                  & LF & HT &
 509          "ldq_l $0, 0($21)"    & LF & HT &
 510          "extwl $0, $18, $19"  & LF & HT &
 511          "mskwl $0, $18, $0"   & LF & HT &
 512          "addq $19, %3, $20"   & LF & HT &
 513          "inswl $20, $18, $17" & LF & HT &
 514          "xor $19, %3, $19"    & LF & HT &
 515          "bis $17, $0, $0"     & LF & HT &
 516          "stq_c $0, 0($21)"    & LF & HT &
 517          "beq $0, 1b"          & LF & HT &
 518          "srl $20, 16, $0"     & LF & HT &
 519          "mb"                  & LF & HT &
 520          "srl $20, 12, $21"    & LF & HT &
 521          "zapnot $20, 3, $20"  & LF & HT &
 522          "and $0, 1, $0"       & LF & HT &
 523          "and $21, 8, $21"     & LF & HT &
 524          "bis $21, $0, $0"     & LF & HT &
 525          "cmpeq $20, 0, $21"   & LF & HT &
 526          "xor $20, 2, $20"     & LF & HT &
 527          "sll $21, 2, $21"     & LF & HT &
 528          "bis $21, $0, $0"     & LF & HT &
 529          "bic $20, $19, $21"   & LF & HT &
 530          "srl $21, 14, $21"    & LF & HT &
 531          "and $21, 2, $21"     & LF & HT &
 532          "bis $21, $0, $0"     & LF & HT &
 533          "and $0, 2, %2"       & LF & HT &
 534          "bne %2, 2f"          & LF & HT &
 535          "and $0, 4, %1"       & LF & HT &
 536          "cmpeq %1, 0, %1"     & LF & HT &
 537          "and $0, 8, $0"       & LF & HT &
 538          "lda $16, -1"         & LF & HT &
 539          "cmovne $0, $16, %1"  & LF & HT &
 540          "2:",
 541          Outputs  => (Aligned_Word'Asm_Output ("=m", Augend),
 542                       Integer'Asm_Output ("=r", Sign),
 543                       Boolean'Asm_Output ("=r", Overflowed)),
 544          Inputs   => (Short_Integer'Asm_Input ("r", Addend),
 545                       Aligned_Word'Asm_Input ("m", Augend)),
 546          Clobber  => "$0, $1, $16, $17, $18, $19, $20, $21",
 547          Volatile => True);
 548
 549          if Overflowed then
 550             raise Constraint_Error;
 551          end if;
 552    end Add_Interlocked;
 553
 554    ----------------
 555    -- Add_Atomic --
 556    ----------------
 557
 558    procedure Add_Atomic
 559      (To     : in out Aligned_Integer;
 560       Amount : Integer)
 561    is
 562       use ASCII;
 563
 564    begin
 565       System.Machine_Code.Asm
 566         (
 567          "mb"              & LF & HT &
 568          "1:"              & LF & HT &
 569          "ldl_l $1, %0"    & LF & HT &
 570          "addl $1, %2, $0" & LF & HT &
 571          "stl_c $0, %1"    & LF & HT &
 572          "beq $0, 1b"      & LF & HT &
 573          "mb",
 574          Outputs  => Aligned_Integer'Asm_Output ("=m", To),
 575          Inputs   => (Aligned_Integer'Asm_Input ("m", To),
 576                       Integer'Asm_Input ("rJ", Amount)),
 577          Clobber  => "$0, $1",
 578          Volatile => True);
 579    end Add_Atomic;
 580
 581    procedure Add_Atomic
 582      (To           : in out Aligned_Integer;
 583       Amount       : Integer;
 584       Retry_Count  : Natural;
 585       Old_Value    : out Integer;
 586       Success_Flag : out Boolean)
 587    is
 588       use ASCII;
 589
 590    begin
 591       System.Machine_Code.Asm
 592         (
 593          "mb"               & LF & HT &
 594          "bis $31, %5, $17" & LF & HT &
 595          "1:"               & LF & HT &
 596          "ldl_l $1, %0"     & LF & HT &
 597          "addl $1, %4, $0"  & LF & HT &
 598          "stl_c $0, %3"     & LF & HT &
 599          "beq $0, 2f"       & LF & HT &
 600          "3:"               & LF & HT &
 601          "mb"               & LF & HT &
 602          "stq $0, %2"       & LF & HT &
 603          "stl $1, %1"       & LF & HT &
 604          "br 4f"            & LF & HT &
 605          "2:"               & LF & HT &
 606          "subq $17, 1, $17" & LF & HT &
 607          "bgt $17, 1b"      & LF & HT &
 608          "br 3b"            & LF & HT &
 609          "4:",
 610          Outputs  => (Aligned_Integer'Asm_Output ("=m", To),
 611                       Integer'Asm_Output ("=m", Old_Value),
 612                       Boolean'Asm_Output ("=m", Success_Flag)),
 613          Inputs   => (Aligned_Integer'Asm_Input ("m", To),
 614                       Integer'Asm_Input ("rJ", Amount),
 615                       Natural'Asm_Input ("rJ", Retry_Count)),
 616          Clobber  => "$0, $1, $17",
 617          Volatile => True);
 618    end Add_Atomic;
 619
 620    procedure Add_Atomic
 621      (To     : in out Aligned_Long_Integer;
 622       Amount : Long_Integer)
 623    is
 624       use ASCII;
 625
 626    begin
 627       System.Machine_Code.Asm
 628         (
 629          "mb"              & LF & HT &
 630          "1:"              & LF & HT &
 631          "ldq_l $1, %0"    & LF & HT &
 632          "addq $1, %2, $0" & LF & HT &
 633          "stq_c $0, %1"    & LF & HT &
 634          "beq $0, 1b"      & LF & HT &
 635          "mb",
 636          Outputs  => Aligned_Long_Integer'Asm_Output ("=m", To),
 637          Inputs   => (Aligned_Long_Integer'Asm_Input ("m", To),
 638                       Long_Integer'Asm_Input ("rJ", Amount)),
 639          Clobber  => "$0, $1",
 640          Volatile => True);
 641    end Add_Atomic;
 642
 643    procedure Add_Atomic
 644      (To           : in out Aligned_Long_Integer;
 645       Amount       : Long_Integer;
 646       Retry_Count  : Natural;
 647       Old_Value    : out Long_Integer;
 648       Success_Flag : out Boolean)
 649    is
 650       use ASCII;
 651
 652    begin
 653       System.Machine_Code.Asm
 654         (
 655          "mb"               & LF & HT &
 656          "bis $31, %5, $17" & LF & HT &
 657          "1:"               & LF & HT &
 658          "ldq_l $1, %0"     & LF & HT &
 659          "addq $1, %4, $0"  & LF & HT &
 660          "stq_c $0, %3"     & LF & HT &
 661          "beq $0, 2f"       & LF & HT &
 662          "3:"               & LF & HT &
 663          "mb"               & LF & HT &
 664          "stq $0, %2"       & LF & HT &
 665          "stq $1, %1"       & LF & HT &
 666          "br 4f"            & LF & HT &
 667          "2:"               & LF & HT &
 668          "subq $17, 1, $17" & LF & HT &
 669          "bgt $17, 1b"      & LF & HT &
 670          "br 3b"            & LF & HT &
 671          "4:",
 672          Outputs  => (Aligned_Long_Integer'Asm_Output ("=m", To),
 673                       Long_Integer'Asm_Output ("=m", Old_Value),
 674                       Boolean'Asm_Output ("=m", Success_Flag)),
 675          Inputs   => (Aligned_Long_Integer'Asm_Input ("m", To),
 676                       Long_Integer'Asm_Input ("rJ", Amount),
 677                       Natural'Asm_Input ("rJ", Retry_Count)),
 678          Clobber  => "$0, $1, $17",
 679          Volatile => True);
 680    end Add_Atomic;
 681
 682    ----------------
 683    -- And_Atomic --
 684    ----------------
 685
 686    procedure And_Atomic
 687      (To   : in out Aligned_Integer;
 688       From : Integer)
 689    is
 690       use ASCII;
 691
 692    begin
 693       System.Machine_Code.Asm
 694         (
 695          "mb"             & LF & HT &
 696          "1:"             & LF & HT &
 697          "ldl_l $1, %0"   & LF & HT &
 698          "and $1, %2, $0" & LF & HT &
 699          "stl_c $0, %1"   & LF & HT &
 700          "beq $0, 1b"     & LF & HT &
 701          "mb",
 702          Outputs  => Aligned_Integer'Asm_Output ("=m", To),
 703          Inputs   => (Aligned_Integer'Asm_Input ("m", To),
 704                       Integer'Asm_Input ("rJ", From)),
 705          Clobber  => "$0, $1",
 706          Volatile => True);
 707    end And_Atomic;
 708
 709    procedure And_Atomic
 710      (To           : in out Aligned_Integer;
 711       From         : Integer;
 712       Retry_Count  : Natural;
 713       Old_Value    : out Integer;
 714       Success_Flag : out Boolean)
 715    is
 716       use ASCII;
 717
 718    begin
 719       System.Machine_Code.Asm
 720         (
 721          "mb"               & LF & HT &
 722          "bis $31, %5, $17" & LF & HT &
 723          "1:"               & LF & HT &
 724          "ldl_l $1, %0"     & LF & HT &
 725          "and $1, %4, $0"   & LF & HT &
 726          "stl_c $0, %3"     & LF & HT &
 727          "beq $0, 2f"       & LF & HT &
 728          "3:"               & LF & HT &
 729          "mb"               & LF & HT &
 730          "stq $0, %2"       & LF & HT &
 731          "stl $1, %1"       & LF & HT &
 732          "br 4f"            & LF & HT &
 733          "2:"               & LF & HT &
 734          "subq $17, 1, $17" & LF & HT &
 735          "bgt $17, 1b"      & LF & HT &
 736          "br 3b"            & LF & HT &
 737          "4:",
 738          Outputs  => (Aligned_Integer'Asm_Output ("=m", To),
 739                       Integer'Asm_Output ("=m", Old_Value),
 740                       Boolean'Asm_Output ("=m", Success_Flag)),
 741          Inputs   => (Aligned_Integer'Asm_Input ("m", To),
 742                       Integer'Asm_Input ("rJ", From),
 743                       Natural'Asm_Input ("rJ", Retry_Count)),
 744          Clobber  => "$0, $1, $17",
 745          Volatile => True);
 746    end And_Atomic;
 747
 748    procedure And_Atomic
 749      (To   : in out Aligned_Long_Integer;
 750       From : Long_Integer)
 751    is
 752       use ASCII;
 753
 754    begin
 755       System.Machine_Code.Asm
 756         (
 757          "mb"             & LF & HT &
 758          "1:"             & LF & HT &
 759          "ldq_l $1, %0"   & LF & HT &
 760          "and $1, %2, $0" & LF & HT &
 761          "stq_c $0, %1"   & LF & HT &
 762          "beq $0, 1b"     & LF & HT &
 763          "mb",
 764          Outputs  => Aligned_Long_Integer'Asm_Output ("=m", To),
 765          Inputs   => (Aligned_Long_Integer'Asm_Input ("m", To),
 766                       Long_Integer'Asm_Input ("rJ", From)),
 767          Clobber  => "$0, $1",
 768          Volatile => True);
 769    end And_Atomic;
 770
 771    procedure And_Atomic
 772      (To           : in out Aligned_Long_Integer;
 773       From         : Long_Integer;
 774       Retry_Count  : Natural;
 775       Old_Value    : out Long_Integer;
 776       Success_Flag : out Boolean)
 777    is
 778       use ASCII;
 779
 780    begin
 781       System.Machine_Code.Asm
 782         (
 783          "mb"               & LF & HT &
 784          "bis $31, %5, $17" & LF & HT &
 785          "1:"               & LF & HT &
 786          "ldq_l $1, %0"     & LF & HT &
 787          "and $1, %4, $0"   & LF & HT &
 788          "stq_c $0, %3"     & LF & HT &
 789          "beq $0, 2f"       & LF & HT &
 790          "3:"               & LF & HT &
 791          "mb"               & LF & HT &
 792          "stq $0, %2"       & LF & HT &
 793          "stq $1, %1"       & LF & HT &
 794          "br 4f"            & LF & HT &
 795          "2:"               & LF & HT &
 796          "subq $17, 1, $17" & LF & HT &
 797          "bgt $17, 1b"      & LF & HT &
 798          "br 3b"            & LF & HT &
 799          "4:",
 800          Outputs  => (Aligned_Long_Integer'Asm_Output ("=m", To),
 801                       Long_Integer'Asm_Output ("=m", Old_Value),
 802                       Boolean'Asm_Output ("=m", Success_Flag)),
 803          Inputs   => (Aligned_Long_Integer'Asm_Input ("m", To),
 804                       Long_Integer'Asm_Input ("rJ", From),
 805                       Natural'Asm_Input ("rJ", Retry_Count)),
 806          Clobber  => "$0, $1, $17",
 807          Volatile => True);
 808    end And_Atomic;
 809
 810    ---------------
 811    -- Or_Atomic --
 812    ---------------
 813
 814    procedure Or_Atomic
 815      (To   : in out Aligned_Integer;
 816       From : Integer)
 817    is
 818       use ASCII;
 819
 820    begin
 821       System.Machine_Code.Asm
 822         (
 823          "mb"             & LF & HT &
 824          "1:"             & LF & HT &
 825          "ldl_l $1, %0"   & LF & HT &
 826          "bis $1, %2, $0" & LF & HT &
 827          "stl_c $0, %1"   & LF & HT &
 828          "beq $0, 1b"     & LF & HT &
 829          "mb",
 830          Outputs  => Aligned_Integer'Asm_Output ("=m", To),
 831          Inputs   => (Aligned_Integer'Asm_Input ("m", To),
 832                       Integer'Asm_Input ("rJ", From)),
 833          Clobber  => "$0, $1",
 834          Volatile => True);
 835    end Or_Atomic;
 836
 837    procedure Or_Atomic
 838      (To           : in out Aligned_Integer;
 839       From         : Integer;
 840       Retry_Count  : Natural;
 841       Old_Value    : out Integer;
 842       Success_Flag : out Boolean)
 843    is
 844       use ASCII;
 845
 846    begin
 847       System.Machine_Code.Asm
 848         (
 849          "mb"               & LF & HT &
 850          "bis $31, %5, $17" & LF & HT &
 851          "1:"               & LF & HT &
 852          "ldl_l $1, %0"     & LF & HT &
 853          "bis $1, %4, $0"   & LF & HT &
 854          "stl_c $0, %3"     & LF & HT &
 855          "beq $0, 2f"       & LF & HT &
 856          "3:"               & LF & HT &
 857          "mb"               & LF & HT &
 858          "stq $0, %2"       & LF & HT &
 859          "stl $1, %1"       & LF & HT &
 860          "br 4f"            & LF & HT &
 861          "2:"               & LF & HT &
 862          "subq $17, 1, $17" & LF & HT &
 863          "bgt $17, 1b"      & LF & HT &
 864          "br 3b"            & LF & HT &
 865          "4:",
 866          Outputs  => (Aligned_Integer'Asm_Output ("=m", To),
 867                       Integer'Asm_Output ("=m", Old_Value),
 868                       Boolean'Asm_Output ("=m", Success_Flag)),
 869          Inputs   => (Aligned_Integer'Asm_Input ("m", To),
 870                       Integer'Asm_Input ("rJ", From),
 871                       Natural'Asm_Input ("rJ", Retry_Count)),
 872          Clobber  => "$0, $1, $17",
 873          Volatile => True);
 874    end Or_Atomic;
 875
 876    procedure Or_Atomic
 877      (To   : in out Aligned_Long_Integer;
 878       From : Long_Integer)
 879    is
 880       use ASCII;
 881
 882    begin
 883       System.Machine_Code.Asm
 884         (
 885          "mb"             & LF & HT &
 886          "1:"             & LF & HT &
 887          "ldq_l $1, %0"   & LF & HT &
 888          "bis $1, %2, $0" & LF & HT &
 889          "stq_c $0, %1"   & LF & HT &
 890          "beq $0, 1b"     & LF & HT &
 891          "mb",
 892          Outputs  => Aligned_Long_Integer'Asm_Output ("=m", To),
 893          Inputs   => (Aligned_Long_Integer'Asm_Input ("m", To),
 894                       Long_Integer'Asm_Input ("rJ", From)),
 895          Clobber  => "$0, $1",
 896          Volatile => True);
 897    end Or_Atomic;
 898
 899    procedure Or_Atomic
 900      (To           : in out Aligned_Long_Integer;
 901       From         : Long_Integer;
 902       Retry_Count  : Natural;
 903       Old_Value    : out Long_Integer;
 904       Success_Flag : out Boolean)
 905    is
 906       use ASCII;
 907
 908    begin
 909       System.Machine_Code.Asm
 910         (
 911          "mb"               & LF & HT &
 912          "bis $31, %5, $17" & LF & HT &
 913          "1:"               & LF & HT &
 914          "ldq_l $1, %0"     & LF & HT &
 915          "bis $1, %4, $0"   & LF & HT &
 916          "stq_c $0, %3"     & LF & HT &
 917          "beq $0, 2f"       & LF & HT &
 918          "3:"               & LF & HT &
 919          "mb"               & LF & HT &
 920          "stq $0, %2"       & LF & HT &
 921          "stq $1, %1"       & LF & HT &
 922          "br 4f"            & LF & HT &
 923          "2:"               & LF & HT &
 924          "subq $17, 1, $17" & LF & HT &
 925          "bgt $17, 1b"      & LF & HT &
 926          "br 3b"            & LF & HT &
 927          "4:",
 928          Outputs  => (Aligned_Long_Integer'Asm_Output ("=m", To),
 929                       Long_Integer'Asm_Output ("=m", Old_Value),
 930                       Boolean'Asm_Output ("=m", Success_Flag)),
 931          Inputs   => (Aligned_Long_Integer'Asm_Input ("m", To),
 932                       Long_Integer'Asm_Input ("rJ", From),
 933                       Natural'Asm_Input ("rJ", Retry_Count)),
 934          Clobber  => "$0, $1, $17",
 935          Volatile => True);
 936    end Or_Atomic;
 937
 938    ------------
 939    -- Insqhi --
 940    ------------
 941
 942    procedure Insqhi
 943      (Item   : Address;
 944       Header : Address;
 945       Status : out Insq_Status)
 946    is
 947       use ASCII;
 948
 949    begin
 950       System.Machine_Code.Asm
 951         (
 952          "bis $31, %1, $17" & LF & HT &
 953          "bis $31, %2, $16" & LF & HT &
 954          "mb"               & LF & HT &
 955          "call_pal 0x87"    & LF & HT &
 956          "mb",
 957          Outputs  => Insq_Status'Asm_Output ("=v", Status),
 958          Inputs   => (Address'Asm_Input ("rJ", Item),
 959                       Address'Asm_Input ("rJ", Header)),
 960          Clobber  => "$16, $17",
 961          Volatile => True);
 962    end Insqhi;
 963
 964    ------------
 965    -- Remqhi --
 966    ------------
 967
 968    procedure Remqhi
 969      (Header : Address;
 970       Item   : out Address;
 971       Status : out Remq_Status)
 972    is
 973       use ASCII;
 974
 975    begin
 976       System.Machine_Code.Asm
 977         (
 978          "bis $31, %2, $16" & LF & HT &
 979          "mb"               & LF & HT &
 980          "call_pal 0x93"    & LF & HT &
 981          "mb"               & LF & HT &
 982          "bis $31, $1, %1",
 983          Outputs  => (Remq_Status'Asm_Output ("=v", Status),
 984                       Address'Asm_Output ("=r", Item)),
 985          Inputs   => Address'Asm_Input ("rJ", Header),
 986          Clobber  => "$1, $16",
 987          Volatile => True);
 988    end Remqhi;
 989
 990    ------------
 991    -- Insqti --
 992    ------------
 993
 994    procedure Insqti
 995      (Item   : Address;
 996       Header : Address;
 997       Status : out Insq_Status)
 998    is
 999       use ASCII;
1000
1001    begin
1002       System.Machine_Code.Asm
1003         (
1004          "bis $31, %1, $17" & LF & HT &
1005          "bis $31, %2, $16" & LF & HT &
1006          "mb"               & LF & HT &
1007          "call_pal 0x88"    & LF & HT &
1008          "mb",
1009          Outputs  => Insq_Status'Asm_Output ("=v", Status),
1010          Inputs   => (Address'Asm_Input ("rJ", Item),
1011                       Address'Asm_Input ("rJ", Header)),
1012          Clobber  => "$16, $17",
1013          Volatile => True);
1014    end Insqti;
1015
1016    ------------
1017    -- Remqti --
1018    ------------
1019
1020    procedure Remqti
1021      (Header : Address;
1022       Item   : out Address;
1023       Status : out Remq_Status)
1024    is
1025       use ASCII;
1026
1027    begin
1028       System.Machine_Code.Asm
1029         (
1030          "bis $31, %2, $16" & LF & HT &
1031          "mb"               & LF & HT &
1032          "call_pal 0x94"    & LF & HT &
1033          "mb"               & LF & HT &
1034          "bis $31, $1, %1",
1035          Outputs  => (Remq_Status'Asm_Output ("=v", Status),
1036                       Address'Asm_Output ("=r", Item)),
1037          Inputs   => Address'Asm_Input ("rJ", Header),
1038          Clobber  => "$1, $16",
1039          Volatile => True);
1040    end Remqti;
1041
1042 end System.Aux_DEC;