OSDN Git Service

* gcc-interface/trans.c (Call_to_gnu): Robustify test for function case
[pf3gnuchains/gcc-fork.git] / 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-2011, 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 is the Alpha/VMS version.
33
34 pragma Style_Checks (All_Checks);
35 --  Turn off alpha ordering check on subprograms, this unit is laid
36 --  out to correspond to the declarations in the DEC 83 System unit.
37
38 with System.Machine_Code; use System.Machine_Code;
39 package body System.Aux_DEC is
40
41    ------------------------
42    -- Fetch_From_Address --
43    ------------------------
44
45    function Fetch_From_Address (A : Address) return Target is
46       type T_Ptr is access all Target;
47       function To_T_Ptr is new Ada.Unchecked_Conversion (Address, T_Ptr);
48       Ptr : constant T_Ptr := To_T_Ptr (A);
49    begin
50       return Ptr.all;
51    end Fetch_From_Address;
52
53    -----------------------
54    -- Assign_To_Address --
55    -----------------------
56
57    procedure Assign_To_Address (A : Address; T : Target) is
58       type T_Ptr is access all Target;
59       function To_T_Ptr is new Ada.Unchecked_Conversion (Address, T_Ptr);
60       Ptr : constant T_Ptr := To_T_Ptr (A);
61    begin
62       Ptr.all := T;
63    end Assign_To_Address;
64
65    -----------------------
66    -- Clear_Interlocked --
67    -----------------------
68
69    procedure Clear_Interlocked
70      (Bit       : in out Boolean;
71       Old_Value : out Boolean)
72    is
73       use ASCII;
74       Clr_Bit : Boolean := Bit;
75       Old_Bit : Boolean;
76
77    begin
78       --  All these ASM sequences should be commented. I suggest defining
79       --  a constant called E which is LF & HT and then you have more space
80       --  for line by line comments ???
81
82       System.Machine_Code.Asm
83         (
84          "lda $16, %2"      & LF & HT &
85          "mb"               & LF & HT &
86          "sll $16, 3, $17 " & LF & HT &
87          "bis $31, 1, $1"   & LF & HT &
88          "and $17, 63, $18" & LF & HT &
89          "bic $17, 63, $17" & LF & HT &
90          "sra $17, 3, $17"  & LF & HT &
91          "bis $31, 1, %1"   & LF & HT &
92          "sll %1, $18, $18" & LF & HT &
93          "1:"               & LF & HT &
94          "ldq_l $1, 0($17)" & LF & HT &
95          "and $1, $18, %1"  & LF & HT &
96          "bic $1, $18, $1"  & LF & HT &
97          "stq_c $1, 0($17)" & LF & HT &
98          "cmpeq %1, 0, %1"  & LF & HT &
99          "beq $1, 1b"       & LF & HT &
100          "mb"               & LF & HT &
101          "xor %1, 1, %1"    & LF & HT &
102          "trapb",
103          Outputs  => (Boolean'Asm_Output ("=m", Clr_Bit),
104                       Boolean'Asm_Output ("=r", Old_Bit)),
105          Inputs   => Boolean'Asm_Input ("m", Clr_Bit),
106          Clobber  => "$1, $16, $17, $18",
107          Volatile => True);
108
109          Bit := Clr_Bit;
110          Old_Value := Old_Bit;
111    end Clear_Interlocked;
112
113    procedure Clear_Interlocked
114      (Bit          : in out Boolean;
115       Old_Value    : out Boolean;
116       Retry_Count  : Natural;
117       Success_Flag : out Boolean)
118    is
119       use ASCII;
120       Clr_Bit : Boolean := Bit;
121       Succ, Old_Bit : Boolean;
122
123    begin
124       System.Machine_Code.Asm
125         (
126          "lda $16, %3"      & LF & HT &
127          "mb"               & LF & HT &
128          "sll $16, 3, $18 " & LF & HT &
129          "bis $31, 1, %1"   & LF & HT &
130          "and $18, 63, $19" & LF & HT &
131          "bic $18, 63, $18" & LF & HT &
132          "sra $18, 3, $18"  & LF & HT &
133          "bis $31, %4, $17" & LF & HT &
134          "sll %1, $19, $19" & LF & HT &
135          "1:"               & LF & HT &
136          "ldq_l %2, 0($18)" & LF & HT &
137          "and %2, $19, %1"  & LF & HT &
138          "bic %2, $19, %2"  & LF & HT &
139          "stq_c %2, 0($18)" & LF & HT &
140          "beq %2, 2f"       & LF & HT &
141          "cmpeq %1, 0, %1"  & LF & HT &
142          "br 3f"            & LF & HT &
143          "2:"               & LF & HT &
144          "subq $17, 1, $17" & LF & HT &
145          "bgt $17, 1b"      & LF & HT &
146          "3:"               & LF & HT &
147          "mb"               & LF & HT &
148          "xor %1, 1, %1"    & LF & HT &
149          "trapb",
150          Outputs  => (Boolean'Asm_Output ("=m", Clr_Bit),
151                       Boolean'Asm_Output ("=r", Old_Bit),
152                       Boolean'Asm_Output ("=r", Succ)),
153          Inputs   => (Boolean'Asm_Input ("m", Clr_Bit),
154                       Natural'Asm_Input ("rJ", Retry_Count)),
155          Clobber  => "$16, $17, $18, $19",
156          Volatile => True);
157
158          Bit := Clr_Bit;
159          Old_Value := Old_Bit;
160          Success_Flag := Succ;
161    end Clear_Interlocked;
162
163    ---------------------
164    -- Set_Interlocked --
165    ---------------------
166
167    procedure Set_Interlocked
168      (Bit       : in out Boolean;
169       Old_Value : out Boolean)
170    is
171       use ASCII;
172       Set_Bit : Boolean := Bit;
173       Old_Bit : Boolean;
174
175    begin
176       --  Don't we need comments on these long asm sequences???
177
178       System.Machine_Code.Asm
179         (
180          "lda $16, %2"      & LF & HT &
181          "sll $16, 3, $17 " & LF & HT &
182          "bis $31, 1, $1"   & LF & HT &
183          "and $17, 63, $18" & LF & HT &
184          "mb"               & LF & HT &
185          "bic $17, 63, $17" & LF & HT &
186          "sra $17, 3, $17"  & LF & HT &
187          "bis $31, 1, %1"   & LF & HT &
188          "sll %1, $18, $18" & LF & HT &
189          "1:"               & LF & HT &
190          "ldq_l $1, 0($17)" & LF & HT &
191          "and $1, $18, %1"  & LF & HT &
192          "bis $1, $18, $1"  & LF & HT &
193          "stq_c $1, 0($17)" & LF & HT &
194          "cmovne %1, 1, %1" & LF & HT &
195          "beq $1, 1b"       & LF & HT &
196          "mb"               & LF & HT &
197          "trapb",
198          Outputs  => (Boolean'Asm_Output ("=m", Set_Bit),
199                       Boolean'Asm_Output ("=r", Old_Bit)),
200          Inputs   => Boolean'Asm_Input ("m", Set_Bit),
201          Clobber  => "$1, $16, $17, $18",
202          Volatile => True);
203
204          Bit := Set_Bit;
205          Old_Value := Old_Bit;
206    end Set_Interlocked;
207
208    procedure Set_Interlocked
209      (Bit          : in out Boolean;
210       Old_Value    : out Boolean;
211       Retry_Count  : Natural;
212       Success_Flag : out Boolean)
213    is
214       use ASCII;
215       Set_Bit : Boolean := Bit;
216       Succ, Old_Bit : Boolean;
217
218    begin
219       System.Machine_Code.Asm
220         (
221          "lda $16, %3"      & LF & HT &  --  Address of Bit
222          "mb"               & LF & HT &
223          "sll $16, 3, $18 " & LF & HT &  --  Byte address to bit address
224          "bis $31, 1, %1"   & LF & HT &  --  Set temp to 1 for the sll
225          "and $18, 63, $19" & LF & HT &  --  Quadword bit offset
226          "bic $18, 63, $18" & LF & HT &  --  Quadword bit address
227          "sra $18, 3, $18"  & LF & HT &  --  Quadword address
228          "bis $31, %4, $17" & LF & HT &  --  Retry_Count -> $17
229          "sll %1, $19, $19" & LF &       --  $19 = 1 << bit_offset
230          "1:"               & LF & HT &
231          "ldq_l %2, 0($18)" & LF & HT &  --  Load & lock
232          "and %2, $19, %1"  & LF & HT &  --  Previous value -> %1
233          "bis %2, $19, %2"  & LF & HT &  --  Set Bit
234          "stq_c %2, 0($18)" & LF & HT &  --  Store conditional
235          "beq %2, 2f"       & LF & HT &  --  Goto 2: if failed
236          "cmovne %1, 1, %1" & LF & HT &  --  Set Old_Bit
237          "br 3f"            & LF &
238          "2:"               & LF & HT &
239          "subq $17, 1, $17" & LF & HT &  --  Retry_Count - 1
240          "bgt $17, 1b"      & LF &       --  Retry ?
241          "3:"               & LF & HT &
242          "mb"               & LF & HT &
243          "trapb",
244          Outputs  => (Boolean'Asm_Output ("=m", Set_Bit),
245                       Boolean'Asm_Output ("=r", Old_Bit),
246                       Boolean'Asm_Output ("=r", Succ)),
247          Inputs   => (Boolean'Asm_Input ("m", Set_Bit),
248                       Natural'Asm_Input ("rJ", Retry_Count)),
249          Clobber  => "$16, $17, $18, $19",
250          Volatile => True);
251
252          Bit := Set_Bit;
253          Old_Value := Old_Bit;
254          Success_Flag := Succ;
255    end Set_Interlocked;
256
257    ---------------------
258    -- Add_Interlocked --
259    ---------------------
260
261    procedure Add_Interlocked
262      (Addend : Short_Integer;
263       Augend : in out Aligned_Word;
264       Sign   : out Integer)
265    is
266       use ASCII;
267       Overflowed : Boolean := False;
268
269    begin
270       System.Machine_Code.Asm
271         (
272          "lda $18, %0"         & LF & HT &
273          "bic $18, 6, $21"     & LF & HT &
274          "mb"                  & LF & HT &
275          "1:"                  & LF & HT &
276          "ldq_l $0, 0($21)"    & LF & HT &
277          "extwl $0, $18, $19"  & LF & HT &
278          "mskwl $0, $18, $0"   & LF & HT &
279          "addq $19, %3, $20"   & LF & HT &
280          "inswl $20, $18, $17" & LF & HT &
281          "xor $19, %3, $19"    & LF & HT &
282          "bis $17, $0, $0"     & LF & HT &
283          "stq_c $0, 0($21)"    & LF & HT &
284          "beq $0, 1b"          & LF & HT &
285          "srl $20, 16, $0"     & LF & HT &
286          "mb"                  & LF & HT &
287          "srl $20, 12, $21"    & LF & HT &
288          "zapnot $20, 3, $20"  & LF & HT &
289          "and $0, 1, $0"       & LF & HT &
290          "and $21, 8, $21"     & LF & HT &
291          "bis $21, $0, $0"     & LF & HT &
292          "cmpeq $20, 0, $21"   & LF & HT &
293          "xor $20, 2, $20"     & LF & HT &
294          "sll $21, 2, $21"     & LF & HT &
295          "bis $21, $0, $0"     & LF & HT &
296          "bic $20, $19, $21"   & LF & HT &
297          "srl $21, 14, $21"    & LF & HT &
298          "and $21, 2, $21"     & LF & HT &
299          "bis $21, $0, $0"     & LF & HT &
300          "and $0, 2, %2"       & LF & HT &
301          "bne %2, 2f"          & LF & HT &
302          "and $0, 4, %1"       & LF & HT &
303          "cmpeq %1, 0, %1"     & LF & HT &
304          "and $0, 8, $0"       & LF & HT &
305          "lda $16, -1"         & LF & HT &
306          "cmovne $0, $16, %1"  & LF & HT &
307          "2:",
308          Outputs  => (Aligned_Word'Asm_Output ("=m", Augend),
309                       Integer'Asm_Output ("=r", Sign),
310                       Boolean'Asm_Output ("=r", Overflowed)),
311          Inputs   => (Short_Integer'Asm_Input ("r", Addend),
312                       Aligned_Word'Asm_Input ("m", Augend)),
313          Clobber  => "$0, $1, $16, $17, $18, $19, $20, $21",
314          Volatile => True);
315
316          if Overflowed then
317             raise Constraint_Error;
318          end if;
319    end Add_Interlocked;
320
321    ----------------
322    -- Add_Atomic --
323    ----------------
324
325    procedure Add_Atomic
326      (To     : in out Aligned_Integer;
327       Amount : Integer)
328    is
329       use ASCII;
330
331    begin
332       System.Machine_Code.Asm
333         (
334          "mb"              & LF &
335          "1:"              & LF & HT &
336          "ldl_l $1, %0"    & LF & HT &
337          "addl $1, %2, $0" & LF & HT &
338          "stl_c $0, %1"    & LF & HT &
339          "beq $0, 1b"      & LF & HT &
340          "mb",
341          Outputs  => Aligned_Integer'Asm_Output ("=m", To),
342          Inputs   => (Aligned_Integer'Asm_Input ("m", To),
343                       Integer'Asm_Input ("rJ", Amount)),
344          Clobber  => "$0, $1",
345          Volatile => True);
346    end Add_Atomic;
347
348    procedure Add_Atomic
349      (To           : in out Aligned_Integer;
350       Amount       : Integer;
351       Retry_Count  : Natural;
352       Old_Value    : out Integer;
353       Success_Flag : out Boolean)
354    is
355       use ASCII;
356
357    begin
358       System.Machine_Code.Asm
359         (
360          "mb"               & LF & HT &
361          "bis $31, %5, $17" & LF &
362          "1:"               & LF & HT &
363          "ldl_l $1, %0"     & LF & HT &
364          "addl $1, %4, $0"  & LF & HT &
365          "stl_c $0, %3"     & LF & HT &
366          "beq $0, 2f"       & LF &
367          "3:"               & LF & HT &
368          "mb"               & LF & HT &
369          "stq $0, %2"       & LF & HT &
370          "stl $1, %1"       & LF & HT &
371          "br 4f"            & LF &
372          "2:"               & LF & HT &
373          "subq $17, 1, $17" & LF & HT &
374          "bgt $17, 1b"      & LF & HT &
375          "br 3b"            & LF &
376          "4:",
377          Outputs  => (Aligned_Integer'Asm_Output ("=m", To),
378                       Integer'Asm_Output ("=m", Old_Value),
379                       Boolean'Asm_Output ("=m", Success_Flag)),
380          Inputs   => (Aligned_Integer'Asm_Input ("m", To),
381                       Integer'Asm_Input ("rJ", Amount),
382                       Natural'Asm_Input ("rJ", Retry_Count)),
383          Clobber  => "$0, $1, $17",
384          Volatile => True);
385    end Add_Atomic;
386
387    procedure Add_Atomic
388      (To     : in out Aligned_Long_Integer;
389       Amount : Long_Integer)
390    is
391       use ASCII;
392
393    begin
394       System.Machine_Code.Asm
395         (
396          "mb"              & LF &
397          "1:"              & LF & HT &
398          "ldq_l $1, %0"    & LF & HT &
399          "addq $1, %2, $0" & LF & HT &
400          "stq_c $0, %1"    & LF & HT &
401          "beq $0, 1b"      & LF & HT &
402          "mb",
403          Outputs  => Aligned_Long_Integer'Asm_Output ("=m", To),
404          Inputs   => (Aligned_Long_Integer'Asm_Input ("m", To),
405                       Long_Integer'Asm_Input ("rJ", Amount)),
406          Clobber  => "$0, $1",
407          Volatile => True);
408    end Add_Atomic;
409
410    procedure Add_Atomic
411      (To           : in out Aligned_Long_Integer;
412       Amount       : Long_Integer;
413       Retry_Count  : Natural;
414       Old_Value    : out Long_Integer;
415       Success_Flag : out Boolean)
416    is
417       use ASCII;
418
419    begin
420       System.Machine_Code.Asm
421         (
422          "mb"               & LF & HT &
423          "bis $31, %5, $17" & LF &
424          "1:"               & LF & HT &
425          "ldq_l $1, %0"     & LF & HT &
426          "addq $1, %4, $0"  & LF & HT &
427          "stq_c $0, %3"     & LF & HT &
428          "beq $0, 2f"       & LF &
429          "3:"               & LF & HT &
430          "mb"               & LF & HT &
431          "stq $0, %2"       & LF & HT &
432          "stq $1, %1"       & LF & HT &
433          "br 4f"            & LF &
434          "2:"               & LF & HT &
435          "subq $17, 1, $17" & LF & HT &
436          "bgt $17, 1b"      & LF & HT &
437          "br 3b"            & LF &
438          "4:",
439          Outputs  => (Aligned_Long_Integer'Asm_Output ("=m", To),
440                       Long_Integer'Asm_Output ("=m", Old_Value),
441                       Boolean'Asm_Output ("=m", Success_Flag)),
442          Inputs   => (Aligned_Long_Integer'Asm_Input ("m", To),
443                       Long_Integer'Asm_Input ("rJ", Amount),
444                       Natural'Asm_Input ("rJ", Retry_Count)),
445          Clobber  => "$0, $1, $17",
446          Volatile => True);
447    end Add_Atomic;
448
449    ----------------
450    -- And_Atomic --
451    ----------------
452
453    procedure And_Atomic
454      (To   : in out Aligned_Integer;
455       From : Integer)
456    is
457       use ASCII;
458
459    begin
460       System.Machine_Code.Asm
461         (
462          "mb"             & LF &
463          "1:"             & LF & HT &
464          "ldl_l $1, %0"   & LF & HT &
465          "and $1, %2, $0" & LF & HT &
466          "stl_c $0, %1"   & LF & HT &
467          "beq $0, 1b"     & LF & HT &
468          "mb",
469          Outputs  => Aligned_Integer'Asm_Output ("=m", To),
470          Inputs   => (Aligned_Integer'Asm_Input ("m", To),
471                       Integer'Asm_Input ("rJ", From)),
472          Clobber  => "$0, $1",
473          Volatile => True);
474    end And_Atomic;
475
476    procedure And_Atomic
477      (To           : in out Aligned_Integer;
478       From         : Integer;
479       Retry_Count  : Natural;
480       Old_Value    : out Integer;
481       Success_Flag : out Boolean)
482    is
483       use ASCII;
484
485    begin
486       System.Machine_Code.Asm
487         (
488          "mb"               & LF & HT &
489          "bis $31, %5, $17" & LF &
490          "1:"               & LF & HT &
491          "ldl_l $1, %0"     & LF & HT &
492          "and $1, %4, $0"   & LF & HT &
493          "stl_c $0, %3"     & LF & HT &
494          "beq $0, 2f"       & LF &
495          "3:"               & LF & HT &
496          "mb"               & LF & HT &
497          "stq $0, %2"       & LF & HT &
498          "stl $1, %1"       & LF & HT &
499          "br 4f"            & LF &
500          "2:"               & LF & HT &
501          "subq $17, 1, $17" & LF & HT &
502          "bgt $17, 1b"      & LF & HT &
503          "br 3b"            & LF &
504          "4:",
505          Outputs  => (Aligned_Integer'Asm_Output ("=m", To),
506                       Integer'Asm_Output ("=m", Old_Value),
507                       Boolean'Asm_Output ("=m", Success_Flag)),
508          Inputs   => (Aligned_Integer'Asm_Input ("m", To),
509                       Integer'Asm_Input ("rJ", From),
510                       Natural'Asm_Input ("rJ", Retry_Count)),
511          Clobber  => "$0, $1, $17",
512          Volatile => True);
513    end And_Atomic;
514
515    procedure And_Atomic
516      (To   : in out Aligned_Long_Integer;
517       From : Long_Integer)
518    is
519       use ASCII;
520
521    begin
522       System.Machine_Code.Asm
523         (
524          "mb"             & LF &
525          "1:"             & LF & HT &
526          "ldq_l $1, %0"   & LF & HT &
527          "and $1, %2, $0" & LF & HT &
528          "stq_c $0, %1"   & LF & HT &
529          "beq $0, 1b"     & LF & HT &
530          "mb",
531          Outputs  => Aligned_Long_Integer'Asm_Output ("=m", To),
532          Inputs   => (Aligned_Long_Integer'Asm_Input ("m", To),
533                       Long_Integer'Asm_Input ("rJ", From)),
534          Clobber  => "$0, $1",
535          Volatile => True);
536    end And_Atomic;
537
538    procedure And_Atomic
539      (To           : in out Aligned_Long_Integer;
540       From         : Long_Integer;
541       Retry_Count  : Natural;
542       Old_Value    : out Long_Integer;
543       Success_Flag : out Boolean)
544    is
545       use ASCII;
546
547    begin
548       System.Machine_Code.Asm
549         (
550          "mb"               & LF & HT &
551          "bis $31, %5, $17" & LF &
552          "1:"               & LF & HT &
553          "ldq_l $1, %0"     & LF & HT &
554          "and $1, %4, $0"   & LF & HT &
555          "stq_c $0, %3"     & LF & HT &
556          "beq $0, 2f"       & LF &
557          "3:"               & LF & HT &
558          "mb"               & LF & HT &
559          "stq $0, %2"       & LF & HT &
560          "stq $1, %1"       & LF & HT &
561          "br 4f"            & LF &
562          "2:"               & LF & HT &
563          "subq $17, 1, $17" & LF & HT &
564          "bgt $17, 1b"      & LF & HT &
565          "br 3b"            & LF &
566          "4:",
567          Outputs  => (Aligned_Long_Integer'Asm_Output ("=m", To),
568                       Long_Integer'Asm_Output ("=m", Old_Value),
569                       Boolean'Asm_Output ("=m", Success_Flag)),
570          Inputs   => (Aligned_Long_Integer'Asm_Input ("m", To),
571                       Long_Integer'Asm_Input ("rJ", From),
572                       Natural'Asm_Input ("rJ", Retry_Count)),
573          Clobber  => "$0, $1, $17",
574          Volatile => True);
575    end And_Atomic;
576
577    ---------------
578    -- Or_Atomic --
579    ---------------
580
581    procedure Or_Atomic
582      (To   : in out Aligned_Integer;
583       From : Integer)
584    is
585       use ASCII;
586
587    begin
588       System.Machine_Code.Asm
589         (
590          "mb"             & LF &
591          "1:"             & LF & HT &
592          "ldl_l $1, %0"   & LF & HT &
593          "bis $1, %2, $0" & LF & HT &
594          "stl_c $0, %1"   & LF & HT &
595          "beq $0, 1b"     & LF & HT &
596          "mb",
597          Outputs  => Aligned_Integer'Asm_Output ("=m", To),
598          Inputs   => (Aligned_Integer'Asm_Input ("m", To),
599                       Integer'Asm_Input ("rJ", From)),
600          Clobber  => "$0, $1",
601          Volatile => True);
602    end Or_Atomic;
603
604    procedure Or_Atomic
605      (To           : in out Aligned_Integer;
606       From         : Integer;
607       Retry_Count  : Natural;
608       Old_Value    : out Integer;
609       Success_Flag : out Boolean)
610    is
611       use ASCII;
612
613    begin
614       System.Machine_Code.Asm
615         (
616          "mb"               & LF & HT &
617          "bis $31, %5, $17" & LF &
618          "1:"               & LF & HT &
619          "ldl_l $1, %0"     & LF & HT &
620          "bis $1, %4, $0"   & LF & HT &
621          "stl_c $0, %3"     & LF & HT &
622          "beq $0, 2f"       & LF &
623          "3:"               & LF & HT &
624          "mb"               & LF & HT &
625          "stq $0, %2"       & LF & HT &
626          "stl $1, %1"       & LF & HT &
627          "br 4f"            & LF &
628          "2:"               & LF & HT &
629          "subq $17, 1, $17" & LF & HT &
630          "bgt $17, 1b"      & LF & HT &
631          "br 3b"            & LF &
632          "4:",
633          Outputs  => (Aligned_Integer'Asm_Output ("=m", To),
634                       Integer'Asm_Output ("=m", Old_Value),
635                       Boolean'Asm_Output ("=m", Success_Flag)),
636          Inputs   => (Aligned_Integer'Asm_Input ("m", To),
637                       Integer'Asm_Input ("rJ", From),
638                       Natural'Asm_Input ("rJ", Retry_Count)),
639          Clobber  => "$0, $1, $17",
640          Volatile => True);
641    end Or_Atomic;
642
643    procedure Or_Atomic
644      (To   : in out Aligned_Long_Integer;
645       From : Long_Integer)
646    is
647       use ASCII;
648
649    begin
650       System.Machine_Code.Asm
651         (
652          "mb"             & LF &
653          "1:"             & LF & HT &
654          "ldq_l $1, %0"   & LF & HT &
655          "bis $1, %2, $0" & LF & HT &
656          "stq_c $0, %1"   & LF & HT &
657          "beq $0, 1b"     & LF & HT &
658          "mb",
659          Outputs  => Aligned_Long_Integer'Asm_Output ("=m", To),
660          Inputs   => (Aligned_Long_Integer'Asm_Input ("m", To),
661                       Long_Integer'Asm_Input ("rJ", From)),
662          Clobber  => "$0, $1",
663          Volatile => True);
664    end Or_Atomic;
665
666    procedure Or_Atomic
667      (To           : in out Aligned_Long_Integer;
668       From         : Long_Integer;
669       Retry_Count  : Natural;
670       Old_Value    : out Long_Integer;
671       Success_Flag : out Boolean)
672    is
673       use ASCII;
674
675    begin
676       System.Machine_Code.Asm
677         (
678          "mb"               & LF & HT &
679          "bis $31, %5, $17" & LF &
680          "1:"               & LF & HT &
681          "ldq_l $1, %0"     & LF & HT &
682          "bis $1, %4, $0"   & LF & HT &
683          "stq_c $0, %3"     & LF & HT &
684          "beq $0, 2f"       & LF &
685          "3:"               & LF & HT &
686          "mb"               & LF & HT &
687          "stq $0, %2"       & LF & HT &
688          "stq $1, %1"       & LF & HT &
689          "br 4f"            & LF &
690          "2:"               & LF & HT &
691          "subq $17, 1, $17" & LF & HT &
692          "bgt $17, 1b"      & LF & HT &
693          "br 3b"            & LF &
694          "4:",
695          Outputs  => (Aligned_Long_Integer'Asm_Output ("=m", To),
696                       Long_Integer'Asm_Output ("=m", Old_Value),
697                       Boolean'Asm_Output ("=m", Success_Flag)),
698          Inputs   => (Aligned_Long_Integer'Asm_Input ("m", To),
699                       Long_Integer'Asm_Input ("rJ", From),
700                       Natural'Asm_Input ("rJ", Retry_Count)),
701          Clobber  => "$0, $1, $17",
702          Volatile => True);
703    end Or_Atomic;
704
705    ------------
706    -- Insqhi --
707    ------------
708
709    procedure Insqhi
710      (Item   : Address;
711       Header : Address;
712       Status : out Insq_Status)
713    is
714       use ASCII;
715
716    begin
717       System.Machine_Code.Asm
718         (
719          "bis $31, %1, $17" & LF & HT &
720          "bis $31, %2, $16" & LF & HT &
721          "mb"               & LF & HT &
722          "call_pal 0x87"    & LF & HT &
723          "mb",
724          Outputs  => Insq_Status'Asm_Output ("=v", Status),
725          Inputs   => (Address'Asm_Input ("rJ", Item),
726                       Address'Asm_Input ("rJ", Header)),
727          Clobber  => "$16, $17",
728          Volatile => True);
729    end Insqhi;
730
731    ------------
732    -- Remqhi --
733    ------------
734
735    procedure Remqhi
736      (Header : Address;
737       Item   : out Address;
738       Status : out Remq_Status)
739    is
740       use ASCII;
741
742    begin
743       System.Machine_Code.Asm
744         (
745          "bis $31, %2, $16" & LF & HT &
746          "mb"               & LF & HT &
747          "call_pal 0x93"    & LF & HT &
748          "mb"               & LF & HT &
749          "bis $31, $1, %1",
750          Outputs  => (Remq_Status'Asm_Output ("=v", Status),
751                       Address'Asm_Output ("=r", Item)),
752          Inputs   => Address'Asm_Input ("rJ", Header),
753          Clobber  => "$1, $16",
754          Volatile => True);
755    end Remqhi;
756
757    ------------
758    -- Insqti --
759    ------------
760
761    procedure Insqti
762      (Item   : Address;
763       Header : Address;
764       Status : out Insq_Status)
765    is
766       use ASCII;
767
768    begin
769       System.Machine_Code.Asm
770         (
771          "bis $31, %1, $17" & LF & HT &
772          "bis $31, %2, $16" & LF & HT &
773          "mb"               & LF & HT &
774          "call_pal 0x88"    & LF & HT &
775          "mb",
776          Outputs  => Insq_Status'Asm_Output ("=v", Status),
777          Inputs   => (Address'Asm_Input ("rJ", Item),
778                       Address'Asm_Input ("rJ", Header)),
779          Clobber  => "$16, $17",
780          Volatile => True);
781    end Insqti;
782
783    ------------
784    -- Remqti --
785    ------------
786
787    procedure Remqti
788      (Header : Address;
789       Item   : out Address;
790       Status : out Remq_Status)
791    is
792       use ASCII;
793
794    begin
795       System.Machine_Code.Asm
796         (
797          "bis $31, %2, $16" & LF & HT &
798          "mb"               & LF & HT &
799          "call_pal 0x94"    & LF & HT &
800          "mb"               & LF & HT &
801          "bis $31, $1, %1",
802          Outputs  => (Remq_Status'Asm_Output ("=v", Status),
803                       Address'Asm_Output ("=r", Item)),
804          Inputs   => Address'Asm_Input ("rJ", Header),
805          Clobber  => "$1, $16",
806          Volatile => True);
807    end Remqti;
808
809 end System.Aux_DEC;