1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S Y S T E M . A U X _ D E C --
9 -- Copyright (C) 1992-2010, 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 &
223 "sll $16, 3, $18 " & LF & HT &
224 "bis $31, 1, %1" & LF & HT &
225 "and $18, 63, $19" & LF & HT &
226 "bic $18, 63, $18" & LF & HT &
227 "sra $18, 3, $18" & LF & HT &
228 "bis $31, %4, $17" & LF & HT &
229 "sll %1, $19, $19" & LF & HT &
231 "ldq_l %2, 0($18)" & LF & HT &
232 "and %2, $19, %1" & LF & HT &
233 "bis %2, $19, %2" & LF & HT &
234 "stq_c %2, 0($18)" & LF & HT &
235 "beq %2, 2f" & LF & HT &
236 "cmovne %1, 1, %1" & LF & HT &
239 "subq $17, 1, $17" & LF & HT &
240 "bgt $17, 1b" & LF & HT &
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 & 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 & 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 & 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 & 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 & 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 & 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 & 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 & 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 & 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 & 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 & 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 & 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",