1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . A U X _ D E C --
9 -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 -- This is the Alpha/VMS version.
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.
38 with System
.Machine_Code
; use System
.Machine_Code
;
39 package body System
.Aux_DEC
is
41 ------------------------
42 -- Fetch_From_Address --
43 ------------------------
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
);
51 end Fetch_From_Address
;
53 -----------------------
54 -- Assign_To_Address --
55 -----------------------
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
);
63 end Assign_To_Address
;
65 -----------------------
66 -- Clear_Interlocked --
67 -----------------------
69 procedure Clear_Interlocked
70 (Bit
: in out Boolean;
71 Old_Value
: out Boolean)
74 Clr_Bit
: Boolean := Bit
;
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 ???
82 System
.Machine_Code
.Asm
84 "lda $16, %2" & 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
&
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
&
101 "xor %1, 1, %1" & LF
& HT
&
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",
110 Old_Value
:= Old_Bit
;
111 end Clear_Interlocked
;
113 procedure Clear_Interlocked
114 (Bit
: in out Boolean;
115 Old_Value
: out Boolean;
116 Retry_Count
: Natural;
117 Success_Flag
: out Boolean)
120 Clr_Bit
: Boolean := Bit
;
121 Succ
, Old_Bit
: Boolean;
124 System
.Machine_Code
.Asm
126 "lda $16, %3" & 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
&
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
&
144 "subq $17, 1, $17" & LF
& HT
&
145 "bgt $17, 1b" & LF
& HT
&
148 "xor %1, 1, %1" & LF
& HT
&
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",
159 Old_Value
:= Old_Bit
;
160 Success_Flag
:= Succ
;
161 end Clear_Interlocked
;
163 ---------------------
164 -- Set_Interlocked --
165 ---------------------
167 procedure Set_Interlocked
168 (Bit
: in out Boolean;
169 Old_Value
: out Boolean)
172 Set_Bit
: Boolean := Bit
;
176 -- Don't we need comments on these long asm sequences???
178 System
.Machine_Code
.Asm
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
&
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
&
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
&
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",
205 Old_Value
:= Old_Bit
;
208 procedure Set_Interlocked
209 (Bit
: in out Boolean;
210 Old_Value
: out Boolean;
211 Retry_Count
: Natural;
212 Success_Flag
: out Boolean)
215 Set_Bit
: Boolean := Bit
;
216 Succ
, Old_Bit
: Boolean;
219 System
.Machine_Code
.Asm
221 "lda $16, %3" & LF
& HT
& -- Address of Bit
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
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
239 "subq $17, 1, $17" & LF
& HT
& -- Retry_Count - 1
240 "bgt $17, 1b" & LF
& -- Retry ?
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",
253 Old_Value
:= Old_Bit
;
254 Success_Flag
:= Succ
;
257 ---------------------
258 -- Add_Interlocked --
259 ---------------------
261 procedure Add_Interlocked
262 (Addend
: Short_Integer;
263 Augend
: in out Aligned_Word
;
267 Overflowed
: Boolean := False;
270 System
.Machine_Code
.Asm
272 "lda $18, %0" & LF
& HT
&
273 "bic $18, 6, $21" & 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
&
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
&
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",
317 raise Constraint_Error
;
326 (To
: in out Aligned_Integer
;
332 System
.Machine_Code
.Asm
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
&
341 Outputs
=> Aligned_Integer
'Asm_Output ("=m", To
),
342 Inputs
=> (Aligned_Integer
'Asm_Input ("m", To
),
343 Integer'Asm_Input ("rJ", Amount
)),
349 (To
: in out Aligned_Integer
;
351 Retry_Count
: Natural;
352 Old_Value
: out Integer;
353 Success_Flag
: out Boolean)
358 System
.Machine_Code
.Asm
361 "bis $31, %5, $17" & LF
&
363 "ldl_l $1, %0" & LF
& HT
&
364 "addl $1, %4, $0" & LF
& HT
&
365 "stl_c $0, %3" & LF
& HT
&
369 "stq $0, %2" & LF
& HT
&
370 "stl $1, %1" & LF
& HT
&
373 "subq $17, 1, $17" & LF
& HT
&
374 "bgt $17, 1b" & LF
& HT
&
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",
388 (To
: in out Aligned_Long_Integer
;
389 Amount
: Long_Integer)
394 System
.Machine_Code
.Asm
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
&
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
)),
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)
420 System
.Machine_Code
.Asm
423 "bis $31, %5, $17" & LF
&
425 "ldq_l $1, %0" & LF
& HT
&
426 "addq $1, %4, $0" & LF
& HT
&
427 "stq_c $0, %3" & LF
& HT
&
431 "stq $0, %2" & LF
& HT
&
432 "stq $1, %1" & LF
& HT
&
435 "subq $17, 1, $17" & LF
& HT
&
436 "bgt $17, 1b" & LF
& HT
&
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",
454 (To
: in out Aligned_Integer
;
460 System
.Machine_Code
.Asm
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
&
469 Outputs
=> Aligned_Integer
'Asm_Output ("=m", To
),
470 Inputs
=> (Aligned_Integer
'Asm_Input ("m", To
),
471 Integer'Asm_Input ("rJ", From
)),
477 (To
: in out Aligned_Integer
;
479 Retry_Count
: Natural;
480 Old_Value
: out Integer;
481 Success_Flag
: out Boolean)
486 System
.Machine_Code
.Asm
489 "bis $31, %5, $17" & LF
&
491 "ldl_l $1, %0" & LF
& HT
&
492 "and $1, %4, $0" & LF
& HT
&
493 "stl_c $0, %3" & LF
& HT
&
497 "stq $0, %2" & LF
& HT
&
498 "stl $1, %1" & LF
& HT
&
501 "subq $17, 1, $17" & LF
& HT
&
502 "bgt $17, 1b" & LF
& HT
&
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",
516 (To
: in out Aligned_Long_Integer
;
522 System
.Machine_Code
.Asm
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
&
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
)),
539 (To
: in out Aligned_Long_Integer
;
541 Retry_Count
: Natural;
542 Old_Value
: out Long_Integer;
543 Success_Flag
: out Boolean)
548 System
.Machine_Code
.Asm
551 "bis $31, %5, $17" & LF
&
553 "ldq_l $1, %0" & LF
& HT
&
554 "and $1, %4, $0" & LF
& HT
&
555 "stq_c $0, %3" & LF
& HT
&
559 "stq $0, %2" & LF
& HT
&
560 "stq $1, %1" & LF
& HT
&
563 "subq $17, 1, $17" & LF
& HT
&
564 "bgt $17, 1b" & LF
& HT
&
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",
582 (To
: in out Aligned_Integer
;
588 System
.Machine_Code
.Asm
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
&
597 Outputs
=> Aligned_Integer
'Asm_Output ("=m", To
),
598 Inputs
=> (Aligned_Integer
'Asm_Input ("m", To
),
599 Integer'Asm_Input ("rJ", From
)),
605 (To
: in out Aligned_Integer
;
607 Retry_Count
: Natural;
608 Old_Value
: out Integer;
609 Success_Flag
: out Boolean)
614 System
.Machine_Code
.Asm
617 "bis $31, %5, $17" & LF
&
619 "ldl_l $1, %0" & LF
& HT
&
620 "bis $1, %4, $0" & LF
& HT
&
621 "stl_c $0, %3" & LF
& HT
&
625 "stq $0, %2" & LF
& HT
&
626 "stl $1, %1" & LF
& HT
&
629 "subq $17, 1, $17" & LF
& HT
&
630 "bgt $17, 1b" & LF
& HT
&
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",
644 (To
: in out Aligned_Long_Integer
;
650 System
.Machine_Code
.Asm
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
&
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
)),
667 (To
: in out Aligned_Long_Integer
;
669 Retry_Count
: Natural;
670 Old_Value
: out Long_Integer;
671 Success_Flag
: out Boolean)
676 System
.Machine_Code
.Asm
679 "bis $31, %5, $17" & LF
&
681 "ldq_l $1, %0" & LF
& HT
&
682 "bis $1, %4, $0" & LF
& HT
&
683 "stq_c $0, %3" & LF
& HT
&
687 "stq $0, %2" & LF
& HT
&
688 "stq $1, %1" & LF
& HT
&
691 "subq $17, 1, $17" & LF
& HT
&
692 "bgt $17, 1b" & LF
& HT
&
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",
712 Status
: out Insq_Status
)
717 System
.Machine_Code
.Asm
719 "bis $31, %1, $17" & LF
& HT
&
720 "bis $31, %2, $16" & LF
& HT
&
722 "call_pal 0x87" & LF
& HT
&
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",
738 Status
: out Remq_Status
)
743 System
.Machine_Code
.Asm
745 "bis $31, %2, $16" & LF
& HT
&
747 "call_pal 0x93" & LF
& HT
&
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",
764 Status
: out Insq_Status
)
769 System
.Machine_Code
.Asm
771 "bis $31, %1, $17" & LF
& HT
&
772 "bis $31, %2, $16" & LF
& HT
&
774 "call_pal 0x88" & LF
& HT
&
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",
790 Status
: out Remq_Status
)
795 System
.Machine_Code
.Asm
797 "bis $31, %2, $16" & LF
& HT
&
799 "call_pal 0x94" & LF
& HT
&
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",