source: trunk/source/compiler/PPC/PPC64/ppc64-vinsns.lisp @ 11317

Last change on this file since 11317 was 11317, checked in by gb, 11 years ago

SET-CONSTANT-PPC-BIT-TO-VARIABLE-VALUE - which can be invoked on (SETF
(SBIT V I) x), where I is a fixnum constant and x is unknown at
compile time - has been setting the wrong bit. Apparently for a long
time, on both ppc32 and ppc64. (The effect has been to always clear
the bit; there are cases in the test suite that expose this -
CL-TEST::PSETF.21, for instance.)

In PPC2-CONSTANT-VALUE-OK-FOR-TYPE-KEYWORD, use ACODE-UNWRAPPED-FORM.
(This will hide the bug described above in CL-TEST::PSETF.21, but
we really should recognize trivial bindings to constants ...)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 124.2 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2004-2005, Clozure Associates
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17
18(in-package "CCL")
19
20(eval-when (:compile-toplevel :load-toplevel :execute)
21  (require "VINSN")
22  (require "PPC64-BACKEND"))
23
24(eval-when (:compile-toplevel :execute)
25  (require "PPCENV"))
26
27(defmacro define-ppc64-vinsn (vinsn-name (results args &optional temps) &body body)
28  (%define-vinsn *ppc64-backend* vinsn-name results args temps body))
29
30
31;;; Index "scaling" and constant-offset misc-ref vinsns.
32
33
34(define-ppc64-vinsn scale-node-misc-index (((dest :u64))
35                                           ((idx :imm)  ; A fixnum
36                                            )
37                                           ())
38  (addi dest idx ppc64::misc-data-offset))
39
40(define-ppc64-vinsn scale-32bit-misc-index (((dest :u64))
41                                            ((idx :imm) ; A fixnum
42                                             )
43                                            ())
44  (srdi dest idx 1)
45  (addi dest dest ppc64::misc-data-offset))
46
47(define-ppc64-vinsn scale-16bit-misc-index (((dest :u64))
48                                            ((idx :imm) ; A fixnum
49                                             )
50                                            ())
51  (srdi dest idx 2)
52  (addi dest dest ppc64::misc-data-offset))
53
54(define-ppc64-vinsn scale-8bit-misc-index (((dest :u64))
55                                           ((idx :imm) ; A fixnum
56                                            )
57                                           ())
58  (srdi dest idx ppc64::word-shift)
59  (addi dest dest ppc64::misc-data-offset))
60
61
62(define-ppc64-vinsn scale-64bit-misc-index (((dest :u64))
63                                            ((idx :imm) ; A fixnum
64                                             )
65                                            ())
66  (addi dest idx ppc64::misc-data-offset))
67
68(define-ppc64-vinsn scale-1bit-misc-index (((word-index :s64)
69                                            (bitnum :u8)) ; (unsigned-byte 5)
70                                           ((idx :imm) ; A fixnum
71                                            )
72                                           )
73  (srdi word-index idx  (+ 5 ppc64::fixnum-shift))
74  (sldi word-index word-index 2)
75  (addi word-index word-index ppc64::misc-data-offset) ; Hmmm. Also one instruction, but less impressive somehow.
76  (extrwi bitnum idx 5 (- 32 (+ ppc64::fixnum-shift 5))))
77
78
79
80(define-ppc64-vinsn misc-ref-u64  (((dest :u64))
81                                   ((v :lisp)
82                                    (scaled-idx :u64))
83                                   ())
84  (ldx dest v scaled-idx))
85
86(define-ppc64-vinsn misc-ref-s64  (((dest :s64))
87                                   ((v :lisp)
88                                    (scaled-idx :u64))
89                                   ())
90  (ldx dest v scaled-idx))
91
92(define-ppc64-vinsn misc-ref-c-u64  (((dest :u64))
93                                     ((v :lisp)
94                                      (idx :u32const)) ; sic
95                                     ())
96  (ld dest (:apply + ppc64::misc-data-offset (:apply ash idx ppc64::word-shift)) v))
97
98(define-ppc64-vinsn misc-ref-c-s64  (((dest :s64))
99                                     ((v :lisp)
100                                      (idx :u32const)) ; sic
101                                     ())
102  (ld dest (:apply + ppc64::misc-data-offset (:apply ash idx ppc64::word-shift)) v))
103
104 
105(define-ppc64-vinsn misc-set-u64 (()
106                                  ((val :u64)
107                                   (v :lisp)
108                                   (scaled-idx :u64)))
109  (stdx val v scaled-idx))
110
111(define-ppc64-vinsn misc-set-c-u64 (()
112                                    ((val :u64)
113                                     (v :lisp)
114                                     (idx :u32const)))
115  (std val (:apply + ppc64::misc-data-offset (:apply ash idx 3)) v))
116
117(define-ppc64-vinsn misc-set-s64 (()
118                                  ((val :s64)
119                                   (v :lisp)
120                                   (scaled-idx :u64)))
121  (stdx val v scaled-idx))
122
123
124(define-ppc64-vinsn misc-set-c-s64 (()
125                                    ((val :s64)
126                                     (v :lisp)
127                                     (idx :u32const)))
128  (std val (:apply + ppc64::misc-data-offset (:apply ash idx 3)) v))
129
130(define-ppc64-vinsn misc-ref-u32  (((dest :u32))
131                                   ((v :lisp)
132                                    (scaled-idx :u64))
133                                   ())
134  (lwzx dest v scaled-idx))
135
136(define-ppc64-vinsn misc-ref-c-u32  (((dest :u32))
137                                     ((v :lisp)
138                                      (idx :u32const))
139                                     ())
140  (lwz dest (:apply + ppc64::misc-data-offset (:apply ash idx 2)) v))
141
142(define-ppc64-vinsn misc-ref-s32  (((dest :s32))
143                                   ((v :lisp)
144                                    (scaled-idx :u64))
145                                   ())
146  (lwax dest v scaled-idx))
147
148(define-ppc64-vinsn misc-ref-c-s32  (((dest :s32))
149                                     ((v :lisp)
150                                      (idx :u32const))
151                                     ())
152  (lwa dest (:apply + ppc64::misc-data-offset (:apply ash idx 2)) v))
153
154
155(define-ppc64-vinsn misc-set-c-u32 (()
156                                    ((val :u32)
157                                     (v :lisp)
158                                     (idx :u32const)))
159  (stw val (:apply + ppc64::misc-data-offset (:apply ash idx 2)) v))
160
161(define-ppc64-vinsn misc-set-u32 (()
162                                  ((val :u32)
163                                   (v :lisp)
164                                   (scaled-idx :u64)))
165  (stwx val v scaled-idx))
166
167(define-ppc64-vinsn misc-set-c-s32 (()
168                                    ((val :s32)
169                                     (v :lisp)
170                                     (idx :u32const)))
171  (stw val (:apply + ppc64::misc-data-offset (:apply ash idx 2)) v))
172
173(define-ppc64-vinsn misc-set-s32 (()
174                                  ((val :s32)
175                                   (v :lisp)
176                                   (scaled-idx :u64)))
177  (stwx val v scaled-idx))
178                             
179(define-ppc64-vinsn misc-ref-single-float  (((dest :single-float))
180                                            ((v :lisp)
181                                             (scaled-idx :u64))
182                                            ())
183  (lfsx dest v scaled-idx))
184
185(define-ppc64-vinsn misc-ref-c-single-float  (((dest :single-float))
186                                              ((v :lisp)
187                                               (idx :u32const))
188                                              ())
189  (lfs dest (:apply + ppc64::misc-data-offset (:apply ash idx 2)) v))
190
191(define-ppc64-vinsn misc-ref-double-float  (((dest :double-float))
192                                            ((v :lisp)
193                                             (scaled-idx :u32))
194                                            ())
195  (lfdx dest v scaled-idx))
196
197
198(define-ppc64-vinsn misc-ref-c-double-float  (((dest :double-float))
199                                              ((v :lisp)
200                                               (idx :u32const))
201                                              ())
202  (lfd dest (:apply + ppc64::misc-dfloat-offset (:apply ash idx 3)) v))
203
204(define-ppc64-vinsn misc-set-c-double-float (((val :double-float))
205                                             ((v :lisp)
206                                              (idx :u32const)))
207  (stfd val (:apply + ppc64::misc-dfloat-offset (:apply ash idx 3)) v))
208
209(define-ppc64-vinsn misc-set-double-float (()
210                                           ((val :double-float)
211                                            (v :lisp)
212                                            (scaled-idx :u32)))
213  (stfdx val v scaled-idx))
214
215(define-ppc64-vinsn misc-set-c-single-float (((val :single-float))
216                                             ((v :lisp)
217                                              (idx :u32const)))
218  (stfs val (:apply + ppc64::misc-data-offset (:apply ash idx 2)) v))
219
220(define-ppc64-vinsn misc-set-single-float (()
221                                           ((val :single-float)
222                                            (v :lisp)
223                                            (scaled-idx :u32)))
224  (stfsx val v scaled-idx))
225
226
227(define-ppc64-vinsn misc-ref-u16  (((dest :u16))
228                                   ((v :lisp)
229                                    (scaled-idx :u64))
230                                   ())
231  (lhzx dest v scaled-idx))
232
233(define-ppc64-vinsn misc-ref-c-u16  (((dest :u16))
234                                     ((v :lisp)
235                                      (idx :u32const))
236                                     ())
237  (lhz dest (:apply + ppc64::misc-data-offset (:apply ash idx 1)) v))
238
239(define-ppc64-vinsn misc-set-c-u16  (((val :u16))
240                                     ((v :lisp)
241                                      (idx :u32const))
242                                     ())
243  (sth val (:apply + ppc64::misc-data-offset (:apply ash idx 1)) v))
244
245(define-ppc64-vinsn misc-set-u16 (((val :u16))
246                                  ((v :lisp)
247                                   (scaled-idx :s64)))
248  (sthx val v scaled-idx))
249
250(define-ppc64-vinsn misc-ref-s16  (((dest :s16))
251                                   ((v :lisp)
252                                    (scaled-idx :s64))
253                                   ())
254  (lhax dest v scaled-idx))
255
256(define-ppc64-vinsn misc-ref-c-s16  (((dest :s16))
257                                     ((v :lisp)
258                                      (idx :u32const))
259                                     ())
260  (lha dest (:apply + ppc64::misc-data-offset (:apply ash idx 1)) v))
261
262(define-ppc64-vinsn misc-set-c-s16  (((val :s16))
263                                     ((v :lisp)
264                                      (idx :u32const))
265                                     ())
266  (sth val (:apply + ppc64::misc-data-offset (:apply ash idx 1)) v))
267
268(define-ppc64-vinsn misc-set-s16 (((val :s16))
269                                  ((v :lisp)
270                                   (scaled-idx :s64)))
271  (sthx val v scaled-idx))
272
273(define-ppc64-vinsn misc-ref-u8  (((dest :u8))
274                                  ((v :lisp)
275                                   (scaled-idx :u64))
276                                  ())
277  (lbzx dest v scaled-idx))
278
279(define-ppc64-vinsn misc-ref-c-u8  (((dest :u8))
280                                    ((v :lisp)
281                                     (idx :u32const))
282                                    ())
283  (lbz dest (:apply + ppc64::misc-data-offset idx) v))
284
285(define-ppc64-vinsn misc-set-c-u8  (((val :u8))
286                                    ((v :lisp)
287                                     (idx :u32const))
288                                    ())
289  (stb val (:apply + ppc64::misc-data-offset idx) v))
290
291(define-ppc64-vinsn misc-set-u8  (((val :u8))
292                                  ((v :lisp)
293                                   (scaled-idx :u64))
294                                  ())
295  (stbx val v scaled-idx))
296
297(define-ppc64-vinsn misc-ref-s8  (((dest :s8))
298                                  ((v :lisp)
299                                   (scaled-idx :u64))
300                                  ())
301  (lbzx dest v scaled-idx)
302  (extsb dest dest))
303
304(define-ppc64-vinsn misc-ref-c-s8  (((dest :s8))
305                                    ((v :lisp)
306                                     (idx :u32const))
307                                    ())
308  (lbz dest (:apply + ppc64::misc-data-offset idx) v)
309  (extsb dest dest))
310
311(define-ppc64-vinsn misc-set-c-s8  (((val :s8))
312                                    ((v :lisp)
313                                     (idx :u32const))
314                                    ())
315  (stb val (:apply + ppc64::misc-data-offset idx) v))
316
317(define-ppc64-vinsn misc-set-s8  (((val :s8))
318                                  ((v :lisp)
319                                   (scaled-idx :u64))
320                                  ())
321  (stbx val v scaled-idx))
322
323(define-ppc64-vinsn misc-ref-c-bit (((dest :u8))
324                                    ((v :lisp)
325                                     (idx :u32const))
326                                    ())
327  (lwz dest (:apply + ppc64::misc-data-offset (:apply ash idx -5)) v)
328  (rlwinm dest dest (:apply 1+ (:apply logand idx #x1f)) 31 31))
329
330(define-ppc64-vinsn misc-ref-c-bit-fixnum (((dest :imm))
331                                           ((v :lisp)
332                                            (idx :u32const))
333                                           ((temp :u32)))
334  (lwz temp (:apply + ppc64::misc-data-offset (:apply ash idx -5)) v)
335  (rlwinm dest 
336          temp
337          (:apply + 1 ppc64::fixnumshift (:apply logand idx #x1f)) 
338          (- ppc64::least-significant-bit ppc64::fixnumshift)
339          (- ppc64::least-significant-bit ppc64::fixnumshift)))
340
341
342(define-ppc64-vinsn misc-ref-node  (((dest :lisp))
343                                    ((v :lisp)
344                                     (scaled-idx :s64))
345                                    ())
346  (ldx dest v scaled-idx))
347
348(define-ppc64-vinsn misc-set-node (()
349                                   ((val :lisp)
350                                    (v :lisp)
351                                    (scaled-idx :s64))
352                                   ())
353  (stdx val v scaled-idx))
354
355
356
357
358(define-ppc64-vinsn misc-ref-c-node (((dest :lisp))
359                                     ((v :lisp)
360                                      (idx :s16const))
361                                     ())
362  (ld dest (:apply + ppc64::misc-data-offset (:apply ash idx 3)) v))
363
364(define-ppc64-vinsn misc-set-c-node (()
365                                     ((val :lisp)
366                                      (v :lisp)
367                                      (idx :s16const))
368                                     ())
369  (std val (:apply + ppc64::misc-data-offset (:apply ash idx 3)) v))
370
371
372(define-ppc64-vinsn misc-element-count-fixnum (((dest :imm))
373                                               ((v :lisp))
374                                               ((temp :u64)))
375  (ld temp ppc64::misc-header-offset v)
376  (srdi temp temp ppc64::num-subtag-bits)
377  (sldi dest temp ppc64::fixnumshift))
378
379(define-ppc64-vinsn check-misc-bound (()
380                                      ((idx :imm)
381                                       (v :lisp))
382                                      ((temp :u64)))
383  (ld temp ppc64::misc-header-offset v)
384  (srdi temp temp ppc64::num-subtag-bits)
385  (sldi temp temp ppc64::fixnumshift)
386  (tdlge idx temp))
387
388(define-ppc64-vinsn 2d-unscaled-index (((dest :imm)
389                                        (dim1 :u32))
390                                       ((dim1 :u32)
391                                        (i :imm)
392                                        (j :imm)))
393  (mulld dim1 i dim1)
394  (add dest dim1 j))
395
396
397;; dest <- (+ (* i dim1 dim2) (* j dim2) k)
398(define-ppc64-vinsn 3d-unscaled-index (((dest :imm)
399                                        (dim1 :u64)
400                                        (dim2 :u64))
401                                       ((dim1 :u64)
402                                        (dim2 :u64)
403                                        (i :imm)
404                                        (j :imm)
405                                        (k :imm)))
406  (mulld dim1 dim1 dim2)
407  (mulld dim2 j dim2)
408  (mulld dim1 i dim1)
409  (add dim2 dim1 dim2)
410  (add dest dim2 k))
411
412
413(define-ppc64-vinsn 2d-32-scaled-index (((dest :u64))
414                                        ((array :lisp)
415                                         (i :imm)
416                                         (j :imm)
417                                         (dim1 :u32)))
418  (mulld dest i dim1)
419  (add dest dest j)
420  (la dest ppc64::misc-data-offset dest))
421
422(define-ppc64-vinsn 2d-dim1 (((dest :u64))
423                             ((header :lisp)))
424  (ld dest (+ ppc64::misc-data-offset (* 8 (1+ ppc64::arrayH.dim0-cell))) header)
425  (sradi dest dest ppc64::fixnumshift))
426
427(define-ppc64-vinsn 3d-dims (((dim1 :u64)
428                              (dim2 :u64))
429                             ((header :lisp)))
430  (ld dim1 (+ ppc64::misc-data-offset (* 8 (1+ ppc64::arrayH.dim0-cell))) header)
431  (ld dim2 (+ ppc64::misc-data-offset (* 8 (+ 2 ppc64::arrayH.dim0-cell))) header)
432  (sradi dim1 dim1 ppc64::fixnumshift)
433  (sradi dim2 dim2 ppc64::fixnumshift))
434
435;;; Return dim1 (unboxed)
436(define-ppc64-vinsn check-2d-bound (((dim :u64))
437                                    ((i :imm)
438                                     (j :imm)
439                                     (header :lisp)))
440  (ld dim (+ ppc64::misc-data-offset (* 8 ppc64::arrayH.dim0-cell)) header)
441  (tdlge i dim)
442  (ld dim (+ ppc64::misc-data-offset (* 8 (1+ ppc64::arrayH.dim0-cell))) header)
443  (tdlge j dim)
444  (sradi dim dim ppc64::fixnumshift))
445
446(define-ppc64-vinsn check-3d-bound (((dim1 :u64)
447                                     (dim2 :u64))
448                                    ((i :imm)
449                                     (j :imm)
450                                     (k :imm)
451                                     (header :lisp)))
452  (ld dim1 (+ ppc64::misc-data-offset (* 8 ppc64::arrayH.dim0-cell)) header)
453  (tdlge i dim1)
454  (ld dim1 (+ ppc64::misc-data-offset (* 8 (1+ ppc64::arrayH.dim0-cell))) header)
455  (tdlge j dim1)
456  (ld dim2 (+ ppc64::misc-data-offset (* 8 (+ 2 ppc64::arrayH.dim0-cell))) header)
457  (tdlge k dim2)
458  (sradi dim1 dim1 ppc64::fixnumshift)
459  (sradi dim2 dim2 ppc64::fixnumshift))
460
461(define-ppc64-vinsn array-data-vector-ref (((dest :lisp))
462                                           ((header :lisp)))
463  (ld dest ppc64::arrayH.data-vector header))
464 
465
466(define-ppc64-vinsn check-arrayH-rank (()
467                                       ((header :lisp)
468                                        (expected :u32const))
469                                       ((rank :imm)))
470  (ld rank ppc64::arrayH.rank header)
471  (tdi 27 rank (:apply ash expected ppc64::fixnumshift)))
472
473(define-ppc64-vinsn check-arrayH-flags (()
474                                        ((header :lisp)
475                                         (expected :u16const))
476                                        ((flags :imm)
477                                         (xreg :u32)))
478  (lis xreg (:apply ldb (byte 16 16) (:apply ash expected ppc64::fixnumshift)))
479  (ori xreg xreg (:apply ldb (byte 16 0) (:apply ash expected ppc64::fixnumshift)))
480  (ld flags ppc64::arrayH.flags header)
481  (td 27 flags xreg))
482
483
484(define-ppc64-vinsn trap-unless-simple-array-2 (()
485                                               ((object :lisp)
486                                                (expected-flags :u64const)
487                                                (type-error :u8const))
488                                               ((tag :u8)
489                                                (flags :u64)
490                                                (crf :crf)))
491  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
492  (cmpdi crf tag ppc64::fulltag-misc)
493  (bne crf :bad)
494  (lbz tag ppc64::misc-subtag-offset object)
495  (cmpdi crf tag ppc64::subtag-arrayH)
496  (bne crf :bad) 
497  (ld tag ppc64::arrayH.rank object)
498  (cmpdi crf tag (ash 2 ppc64::fixnumshift))
499  (lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags ppc64::fixnumshift)))
500  (ld flags ppc64::arrayH.flags object)
501  (ori tag tag (:apply ldb (byte 16 0) (:apply ash expected-flags ppc64::fixnumshift)))
502  (bne crf :bad)
503  (cmpd crf tag flags)
504  (beq crf :good)
505  :bad
506  (uuo_interr type-error object)
507  :good)
508
509(define-ppc64-vinsn trap-unless-simple-array-3 (()
510                                               ((object :lisp)
511                                                (expected-flags :u64const)
512                                                (type-error :u8const))
513                                               ((tag :u8)
514                                                (flags :u64)
515                                                (crf :crf)))
516  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
517  (cmpdi crf tag ppc64::fulltag-misc)
518  (bne crf :bad)
519  (lbz tag ppc64::misc-subtag-offset object)
520  (cmpdi crf tag ppc64::subtag-arrayH)
521  (bne crf :bad) 
522  (ld tag ppc64::arrayH.rank object)
523  (cmpdi crf tag (ash 3 ppc64::fixnumshift))
524  (lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags ppc64::fixnumshift)))
525  (ld flags ppc64::arrayH.flags object)
526  (ori tag tag (:apply ldb (byte 16 0) (:apply ash expected-flags ppc64::fixnumshift)))
527  (bne crf :bad)
528  (cmpd crf tag flags)
529  (beq crf :good)
530  :bad
531  (uuo_interr type-error object)
532  :good)
533
534 
535(define-ppc64-vinsn node-slot-ref  (((dest :lisp))
536                                    ((node :lisp)
537                                     (cellno :u32const)))
538  (ld dest (:apply + ppc64::misc-data-offset (:apply ash cellno 3)) node))
539
540
541
542(define-ppc64-vinsn  %slot-ref (((dest :lisp))
543                                ((instance (:lisp (:ne dest)))
544                                 (index :lisp))
545                                ((scaled :s64)))
546  (la scaled ppc64::misc-data-offset index)
547  (ldx dest instance scaled)
548  (tdeqi dest ppc64::slot-unbound-marker))
549
550
551;;; Untagged memory reference & assignment.
552
553(define-ppc64-vinsn mem-ref-c-fullword (((dest :u32))
554                                        ((src :address)
555                                         (index :s16const)))
556  (lwz dest index src))
557
558(define-ppc64-vinsn mem-ref-c-signed-fullword (((dest :s32))
559                                               ((src :address)
560                                                (index :s16const)))
561  (lwa dest index src))
562
563(define-ppc64-vinsn mem-ref-c-doubleword (((dest :u64))
564                                          ((src :address)
565                                           (index :s16const)))
566  (ld dest index src))
567
568(define-ppc64-vinsn mem-ref-c-signed-doubleword (((dest :s64))
569                                                 ((src :address)
570                                                  (index :s16const)))
571  (ld dest index src))
572
573(define-ppc64-vinsn mem-ref-c-natural (((dest :u64))
574                                       ((src :address)
575                                        (index :s16const)))
576  (ld dest index src))
577
578(define-ppc64-vinsn mem-ref-fullword (((dest :u32))
579                                      ((src :address)
580                                       (index :s64)))
581  (lwzx dest src index))
582
583(define-ppc64-vinsn mem-ref-signed-fullword (((dest :s32))
584                                             ((src :address)
585                                              (index :s64)))
586  (lwax dest src index))
587
588(define-ppc64-vinsn mem-ref-doubleword (((dest :u64))
589                                        ((src :address)
590                                         (index :s64)))
591  (ldx dest src index))
592
593(define-ppc64-vinsn mem-ref-natural (((dest :u64))
594                                        ((src :address)
595                                         (index :s64)))
596  (ldx dest src index))
597
598(define-ppc64-vinsn mem-ref-signed-doubleword (((dest :s64))
599                                               ((src :address)
600                                                (index :s64)))
601  (ldx dest src index))
602
603(define-ppc64-vinsn mem-ref-c-u16 (((dest :u16))
604                                   ((src :address)
605                                    (index :s16const)))
606  (lhz dest index src))
607
608(define-ppc64-vinsn mem-ref-u16 (((dest :u16))
609                                 ((src :address)
610                                  (index :s32)))
611  (lhzx dest src index))
612
613
614(define-ppc64-vinsn mem-ref-c-s16 (((dest :s16))
615                                   ((src :address)
616                                    (index :s16const)))
617  (lha dest index src))
618
619(define-ppc64-vinsn mem-ref-s16 (((dest :s16))
620                                 ((src :address)
621                                  (index :s32)))
622  (lhax dest src index))
623
624(define-ppc64-vinsn mem-ref-c-u8 (((dest :u8))
625                                  ((src :address)
626                                   (index :s16const)))
627  (lbz dest index src))
628
629(define-ppc64-vinsn mem-ref-u8 (((dest :u8))
630                                ((src :address)
631                                 (index :s32)))
632  (lbzx dest src index))
633
634(define-ppc64-vinsn mem-ref-c-s8 (((dest :s8))
635                                  ((src :address)
636                                   (index :s16const)))
637  (lbz dest index src)
638  (extsb dest dest))
639
640(define-ppc64-vinsn mem-ref-s8 (((dest :s8))
641                                ((src :address)
642                                 (index :s32)))
643  (lbzx dest src index)
644  (extsb dest dest))
645
646(define-ppc64-vinsn mem-ref-c-bit (((dest :u8))
647                                   ((src :address)
648                                    (byte-index :s16const)
649                                    (bit-shift :u8const)))
650  (lbz dest byte-index src)
651  (rlwinm dest dest bit-shift 31 31))
652
653(define-ppc64-vinsn mem-ref-c-bit-fixnum (((dest :lisp))
654                                          ((src :address)
655                                           (byte-index :s16const)
656                                           (bit-shift :u8const))
657                                          ((byteval :u8)))
658  (lbz byteval byte-index src)
659  (rlwinm dest byteval bit-shift 29 29))
660
661(define-ppc64-vinsn mem-ref-bit (((dest :u8))
662                                 ((src :address)
663                                  (bit-index :lisp))
664                                 ((byte-index :s16)
665                                  (bit-shift :u8)))
666  (srwi byte-index bit-index (+ ppc64::fixnumshift 3))
667  (extrwi bit-shift bit-index 3 27)
668  (addi bit-shift bit-shift 29)
669  (lbzx dest src byte-index)
670  (rlwnm dest dest bit-shift 31 31))
671
672
673(define-ppc64-vinsn mem-ref-bit-fixnum (((dest :lisp))
674                                        ((src :address)
675                                         (bit-index :lisp))
676                                        ((byte-index :s16)
677                                         (bit-shift :u8)))
678  (srwi byte-index bit-index (+ ppc64::fixnumshift 3))
679  (extrwi bit-shift bit-index 3 27)
680  (addi bit-shift bit-shift 27)
681  (lbzx byte-index src byte-index)
682  (rlwnm dest
683         byte-index
684         bit-shift
685         (- ppc64::least-significant-bit ppc64::fixnum-shift)
686         (- ppc64::least-significant-bit ppc64::fixnum-shift)))
687
688(define-ppc64-vinsn mem-ref-c-double-float (((dest :double-float))
689                                            ((src :address)
690                                             (index :s16const)))
691  (lfd dest index src))
692
693(define-ppc64-vinsn mem-ref-double-float (((dest :double-float))
694                                          ((src :address)
695                                           (index :s32)))
696  (lfdx dest src index))
697
698(define-ppc64-vinsn mem-set-c-double-float (()
699                                            ((val :double-float)
700                                             (src :address)
701                                             (index :s16const)))
702  (stfd val index src))
703
704(define-ppc64-vinsn mem-set-double-float (()
705                                          ((val :double-float)
706                                           (src :address)
707                                           (index :s32)))
708  (stfdx val src index))
709
710(define-ppc64-vinsn mem-ref-c-single-float (((dest :single-float))
711                                            ((src :address)
712                                             (index :s16const)))
713  (lfs dest index src))
714
715(define-ppc64-vinsn mem-ref-single-float (((dest :single-float))
716                                          ((src :address)
717                                           (index :s32)))
718  (lfsx dest src index))
719
720(define-ppc64-vinsn mem-set-c-single-float (()
721                                            ((val :single-float)
722                                             (src :address)
723                                             (index :s16const)))
724  (stfs val index src))
725
726(define-ppc64-vinsn mem-set-single-float (()
727                                          ((val :single-float)
728                                           (src :address)
729                                           (index :s32)))
730  (stfsx val src index))
731
732
733(define-ppc64-vinsn mem-set-c-doubleword (()
734                                          ((val :u64)
735                                           (src :address)
736                                           (index :s16const)))
737  (std val index src))
738
739(define-ppc64-vinsn mem-set-doubleword (()
740                                        ((val :u64)
741                                         (src :address)
742                                         (index :s64)))
743  (stdx val index src))
744
745(define-ppc64-vinsn mem-set-c-address (()
746                                       ((val :address)
747                                        (src :address)
748                                        (index :s16const)))
749  (std val index src))
750
751(define-ppc64-vinsn mem-set-address (()
752                                     ((val :address)
753                                      (src :address)
754                                      (index :s64)))
755  (stdx val src index))
756
757(define-ppc64-vinsn mem-set-c-fullword (()
758                                        ((val :u32)
759                                         (src :address)
760                                         (index :s16const)))
761  (stw val index src))
762
763(define-ppc64-vinsn mem-set-fullword (()
764                                      ((val :u32)
765                                       (src :address)
766                                       (index :s32)))
767  (stwx val src index))
768
769(define-ppc64-vinsn mem-set-c-halfword (()
770                                        ((val :u16)
771                                         (src :address)
772                                         (index :s16const)))
773  (sth val index src))
774
775(define-ppc64-vinsn mem-set-halfword (()
776                                      ((val :u16)
777                                       (src :address)
778                                       (index :s32)))
779  (sthx val src index))
780
781(define-ppc64-vinsn mem-set-c-byte (()
782                                    ((val :u16)
783                                     (src :address)
784                                     (index :s16const)))
785  (stb val index src))
786
787(define-ppc64-vinsn mem-set-byte (()
788                                  ((val :u8)
789                                   (src :address)
790                                   (index :s32)))
791  (stbx val src index))
792
793(define-ppc64-vinsn mem-set-c-bit-0 (()
794                                     ((src :address)
795                                      (byte-index :s16const)
796                                      (mask-begin :u8const)
797                                      (mask-end :u8const))
798                                     ((val :u8)))
799  (lbz val byte-index src)
800  (rlwinm val val 0 mask-begin mask-end)
801  (stb val byte-index src))
802
803(define-ppc64-vinsn mem-set-c-bit-1 (()
804                                     ((src :address)
805                                      (byte-index :s16const)
806                                      (mask :u8const))
807                                     ((val :u8)))
808  (lbz val byte-index src)
809  (ori val val mask)
810  (stb val byte-index src))
811
812(define-ppc64-vinsn mem-set-c-bit (()
813                                   ((src :address)
814                                    (byte-index :s16const)
815                                    (bit-index :u8const)
816                                    (val :imm))
817                                   ((byteval :u8)))
818  (lbz byteval byte-index src)
819  (rlwimi byteval val (:apply logand 31 (:apply - 29 bit-index)) bit-index bit-index)
820  (stb byteval byte-index src))
821
822
823(define-ppc64-vinsn mem-set-bit (()
824                                 ((src :address)
825                                  (bit-index :lisp)
826                                  (val :lisp))
827                                 ((bit-shift :u32)
828                                  (mask :u32)
829                                  (byte-index :u32)
830                                  (crf :crf)))
831  (cmplwi crf val (ash 1 ppc64::fixnumshift))
832  (extrwi bit-shift bit-index 3 27)
833  (li mask #x80)
834  (srw mask mask bit-shift)
835  (ble+ crf :got-it)
836  (uuo_interr arch::error-object-not-bit src)
837  :got-it
838  (srwi bit-shift bit-index (+ 3 ppc64::fixnumshift))
839  (lbzx bit-shift src bit-shift)
840  (beq crf :set)
841  (andc mask bit-shift mask)
842  (b :done)
843  :set
844  (or mask bit-shift mask)
845  :done
846  (srwi bit-shift bit-index (+ 3 ppc64::fixnumshift))
847  (stbx mask src bit-shift))
848     
849;;; Tag and subtag extraction, comparison, checking, trapping ...
850
851(define-ppc64-vinsn extract-tag (((tag :u8)) 
852                                 ((object :lisp)) 
853                                 ())
854  (clrldi tag object (- ppc64::nbits-in-word ppc64::nlisptagbits)))
855
856(define-ppc64-vinsn extract-tag-fixnum (((tag :imm))
857                                        ((object :lisp)))
858  (clrlsldi tag object (- ppc64::nbits-in-word ppc64::nlisptagbits) ppc64::fixnum-shift))
859
860(define-ppc64-vinsn extract-fulltag (((tag :u8))
861                                     ((object :lisp))
862                                     ())
863  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits)))
864
865
866(define-ppc64-vinsn extract-fulltag-fixnum (((tag :imm))
867                                            ((object :lisp)))
868  (clrlsldi tag object (- ppc64::nbits-in-word ppc64::ntagbits) ppc64::fixnum-shift))
869
870
871(define-ppc64-vinsn extract-typecode (((code :u8))
872                                      ((object :lisp))
873                                      ((crf :crf)))
874  (clrldi code object (- ppc64::nbits-in-word ppc64::ntagbits))
875  (cmpdi crf code ppc64::fulltag-misc)
876  (clrldi code code (- ppc64::nbits-in-word ppc64::nlisptagbits))
877  (bne crf :not-misc)
878  (lbz code ppc64::misc-subtag-offset object)
879  :not-misc)
880
881(define-ppc64-vinsn extract-typecode-fixnum (((code :imm))
882                                             ((object (:lisp (:ne code))))
883                                             ((crf :crf) (subtag :u8)))
884  (clrldi subtag object (- ppc64::nbits-in-word ppc64::ntagbits))
885  (cmpdi crf subtag ppc64::fulltag-misc)
886  (clrldi subtag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
887  (bne crf :not-misc)
888  (lbz subtag ppc64::misc-subtag-offset object)
889  :not-misc
890  (sldi code subtag ppc64::fixnum-shift))
891
892
893(define-ppc64-vinsn require-fixnum (()
894                                    ((object :lisp))
895                                    ((crf0 (:crf 0))
896                                     (tag :u8)))
897  :again
898  (clrldi. tag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
899  (beq+ crf0 :got-it)
900  (uuo_intcerr arch::error-object-not-fixnum object)
901  (b :again)
902  :got-it)
903
904(define-ppc64-vinsn require-integer (()
905                                     ((object :lisp))
906                                     ((crf0 (:crf 0))
907                                      (tag :u8)))
908  :again
909  (clrldi. tag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
910  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
911  (beq+ crf0 :got-it)
912  (cmpdi crf0 tag ppc64::fulltag-misc)
913  (bne crf0 :no-got)
914  (lbz tag ppc64::misc-subtag-offset object)
915  (cmpdi crf0 tag ppc64::subtag-bignum)
916  (beq+ crf0 :got-it)
917  :no-got
918  (uuo_intcerr arch::error-object-not-integer object)
919  (b :again)
920  :got-it)
921
922(define-ppc64-vinsn require-simple-vector (()
923                                           ((object :lisp))
924                                           ((tag :u8)
925                                            (crf :crf)))
926  :again
927  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
928  (cmpdi crf tag ppc64::fulltag-misc)
929  (bne crf :no-got)
930  (lbz tag ppc64::misc-subtag-offset object)
931  (cmpdi crf tag ppc64::subtag-simple-vector)
932  (beq+ crf :got-it)
933  :no-got
934  (uuo_intcerr arch::error-object-not-simple-vector object)
935  (b :again)
936  :got-it)
937
938(define-ppc64-vinsn require-simple-string (()
939                                           ((object :lisp))
940                                           ((tag :u8)
941                                            (crf :crf)))
942  :again
943  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
944  (cmpdi crf tag ppc64::fulltag-misc)
945  (bne crf :no-got)
946  (lbz tag ppc64::misc-subtag-offset object)
947  (cmpdi crf tag ppc64::subtag-simple-base-string)
948  (beq+ crf :got-it)
949  :no-got
950  (uuo_intcerr arch::error-object-not-simple-string object)
951  (b :again)
952  :got-it)
953
954
955(define-ppc64-vinsn require-real (()
956                                  ((object :lisp))
957                                  ((crf0 (:crf 0))
958                                   (crf1 :crf)
959                                   (tag :u8)
960                                   (mask :u64)))
961  :again
962  (lis mask (ash 1 (- ppc64::subtag-double-float (+ 32 16))))
963  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
964  (ori mask mask (ash 1 (- ppc64::subtag-bignum 32)))
965  (cmpdi crf0 tag ppc64::fulltag-misc)
966  (sldi mask mask 32)
967  (bne crf0 :have-typecode)
968  (lbz tag ppc64::misc-subtag-offset object)
969  :have-typecode
970  (ori mask mask (logior (ash 1 ppc64::subtag-ratio)
971                         (ash 1 ppc64::fulltag-odd-fixnum)
972                         (ash 1 ppc64::subtag-single-float)
973                         (ash 1 ppc64::fulltag-even-fixnum)))
974  (cmpdi crf1 tag ppc64::subtag-double-float)
975  (srd mask mask tag)
976  (clrldi. mask mask 63)
977  (bgt crf1 :no-got)
978  (bne+ :got-it)
979  :no-got
980  (uuo_intcerr arch::error-object-not-real object)
981  (b :again)
982  :got-it)
983
984(define-ppc64-vinsn require-number (()
985                                    ((object :lisp))
986                                    ((crf0 (:crf 0))
987                                     (crf1 :crf)
988                                     (tag :u8)
989                                     (mask :u64)))
990  :again
991  (lis mask (ash 1 (- ppc64::subtag-double-float (+ 32 16))))
992  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
993  (ori mask mask (ash 1 (- ppc64::subtag-bignum 32)))
994  (cmpdi crf0 tag ppc64::fulltag-misc)
995  (sldi mask mask 32)
996  (bne crf0 :have-typecode)
997  (lbz tag ppc64::misc-subtag-offset object)
998  :have-typecode
999  (ori mask mask (logior (ash 1 ppc64::subtag-ratio)
1000                         (ash 1 ppc64::fulltag-odd-fixnum)
1001                         (ash 1 ppc64::subtag-single-float)
1002                         (ash 1 ppc64::fulltag-even-fixnum)))
1003  (cmpdi crf1 tag ppc64::subtag-double-float)
1004  (oris mask mask (ash 1 (- ppc64::subtag-complex 16)))
1005  (srd mask mask tag)
1006  (clrldi. mask mask 63)
1007  (bgt crf1 :no-got)
1008  (bne+ :got-it)
1009  :no-got
1010  (uuo_intcerr arch::error-object-not-number object)
1011  (b :again)
1012  :got-it)
1013
1014
1015(define-ppc64-vinsn require-list (()
1016                                  ((object :lisp))
1017                                  ((tag :u8)
1018                                   (crfx :crf)
1019                                   (crfy :crf)))
1020  :again
1021  (cmpdi crfx object (:apply target-nil-value))
1022  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1023  (cmpdi crfy tag ppc64::fulltag-cons)
1024  (beq crfx :got-it)
1025  (beq+ crfy :got-it)
1026  (uuo_intcerr arch::error-object-not-list object)
1027  (b :again)
1028  :got-it)
1029
1030(define-ppc64-vinsn require-symbol (()
1031                                    ((object :lisp))
1032                                    ((tag :u8)
1033                                     (crf :crf)))
1034  :again
1035  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1036  (cmpdi crf tag ppc64::fulltag-misc)
1037  (bne crf :no-got)
1038  (lbz tag ppc64::misc-subtag-offset object)
1039  (cmpdi crf tag ppc64::subtag-symbol)
1040  (beq+ crf :got-it)
1041  :no-got
1042  (uuo_intcerr arch::error-object-not-symbol object)
1043  (b :again)
1044  :got-it)
1045
1046(define-ppc64-vinsn require-character (()
1047                                       ((object :lisp))
1048                                       ((tag :u8)
1049                                        (crf :crf)))
1050  :again
1051  (clrldi tag object (- ppc64::nbits-in-word ppc64::num-subtag-bits))
1052  (cmpdi crf tag ppc64::subtag-character)
1053  (beq+ crf :got-it)
1054  (uuo_intcerr arch::error-object-not-character object)
1055  (b :again)
1056  :got-it)
1057
1058
1059(define-ppc64-vinsn require-s8 (()
1060                                ((object :lisp))
1061                                ((crf :crf)
1062                                 (tag :s64)))
1063  :again
1064  (sldi tag object (- ppc64::nbits-in-word (+ 8 ppc64::fixnumshift)))
1065  (sradi tag tag (- ppc64::nbits-in-word 8))
1066  (sldi tag tag ppc64::fixnumshift)
1067  (cmpd crf tag object)
1068  (beq+ crf :got-it)
1069  :bad
1070  (uuo_intcerr arch::error-object-not-signed-byte-8 object)
1071  (b :again)
1072  :got-it)
1073
1074(define-ppc64-vinsn require-u8 (()
1075                                ((object :lisp))
1076                                ((crf0 (:crf 0))
1077                                 (tag :u32)))
1078  :again
1079  ;; The bottom ppc64::fixnumshift bits and the top (- 64 (+
1080  ;; ppc64::fixnumshift 8)) must all be zero.
1081  (rldicr. tag object (- 64 ppc64::fixnumshift) 55)
1082  (beq+ crf0 :got-it)
1083  (uuo_intcerr arch::error-object-not-unsigned-byte-8 object)
1084  (b :again)
1085  :got-it)
1086
1087(define-ppc64-vinsn require-s16 (()
1088                                 ((object :lisp))
1089                                 ((crf :crf)
1090                                  (tag :s64)))
1091  :again
1092  (sldi tag object (- ppc64::nbits-in-word (+ 16 ppc64::fixnumshift)))
1093  (sradi tag tag (- ppc64::nbits-in-word 16))
1094  (sldi tag tag ppc64::fixnumshift)
1095  (cmpd crf tag object)
1096  (beq+ crf :got-it)
1097  :bad
1098  (uuo_intcerr arch::error-object-not-signed-byte-16 object)
1099  (b :again)
1100  :got-it)
1101
1102(define-ppc64-vinsn require-u16 (()
1103                                ((object :lisp))
1104                                ((crf0 (:crf 0))
1105                                 (tag :s64)))
1106  :again
1107  ;; The bottom ppc64::fixnumshift bits and the top (- 64 (+
1108  ;; ppc64::fixnumshift 8)) must all be zero.
1109  (rldicr. tag object (- 64 ppc64::fixnumshift) 47)
1110  (beq+ crf0 :got-it)
1111  (uuo_intcerr arch::error-object-not-unsigned-byte-16 object)
1112  (b :again)
1113  :got-it)
1114
1115(define-ppc64-vinsn require-s32 (()
1116                                 ((object :lisp))
1117                                 ((crf :crf)
1118                                  (tag :s64)))
1119  :again
1120  (sldi tag object (- ppc64::nbits-in-word (+ 32 ppc64::fixnumshift)))
1121  (sradi tag tag (- ppc64::nbits-in-word 32))
1122  (sldi tag tag ppc64::fixnumshift)
1123  (cmpd crf tag object)
1124  (beq+ crf :got-it)
1125  :bad
1126  (uuo_intcerr arch::error-object-not-signed-byte-32 object)
1127  (b :again)
1128  :got-it)
1129
1130(define-ppc64-vinsn require-u32 (()
1131                                ((object :lisp))
1132                                ((crf0 (:crf 0))
1133                                 (tag :s64)))
1134  :again
1135  ;; The bottom ppc64::fixnumshift bits and the top (- 64 (+
1136  ;; ppc64::fixnumshift 32)) must all be zero.
1137  (rldicr. tag object (- 64 ppc64::fixnumshift) 31)
1138  (beq+ crf0 :got-it)
1139  (uuo_intcerr arch::error-object-not-unsigned-byte-32 object)
1140  (b :again)
1141  :got-it)
1142
1143(define-ppc64-vinsn require-s64 (()
1144                                 ((object :lisp))
1145                                 ((crf0 (:crf 0))
1146                                  (crf1 :crf)
1147                                  (tag :s64)))
1148  :again
1149  (clrldi. tag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
1150  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1151  (beq+ crf0 :got-it)
1152  (cmpdi crf1 tag ppc64::fulltag-misc)
1153  (bne- crf1 :bad)
1154  (ld tag ppc64::misc-header-offset object)
1155  (cmpdi crf0 tag ppc64::two-digit-bignum-header)
1156  (beq+ crf0 :got-it)
1157  :bad
1158  (uuo_intcerr arch::error-object-not-signed-byte-64 object)
1159  (b :again)
1160  :got-it)
1161
1162(define-ppc64-vinsn require-u64 (()
1163                                 ((object :lisp))
1164                                 ((crf0 (:crf 0))
1165                                  (crf1 :crf)
1166                                  (crf2 :crf)
1167                                  (temp :u64)))
1168  (clrldi. temp object (- ppc64::nbits-in-word ppc64::fixnumshift))
1169  (clrldi temp object (- ppc64::nbits-in-word ppc64::ntagbits))
1170  (cmpdi crf1 temp ppc64::fulltag-misc)
1171  (sradi temp object ppc64::fixnumshift)
1172  (beq crf0 :good-if-positive)
1173  (bne crf1 :bad)
1174  (ld temp ppc64::misc-header-offset object)
1175  (cmpdi crf0 temp  ppc64::three-digit-bignum-header)
1176  (cmpdi crf2 temp ppc64::two-digit-bignum-header)
1177  (beq crf0 :three-digit)
1178  (bne crf2 :bad)
1179  ;; two-digit case.  Must be positive.
1180  (ld temp ppc64::misc-data-offset object)
1181  (rotldi temp temp 32)
1182  :good-if-positive
1183  (cmpdi crf1 temp 0)
1184  (bge crf1 :good)
1185  :bad
1186  (uuo_interr arch::error-object-not-unsigned-byte-64 object)
1187  :three-digit
1188  (lwz temp (+ ppc64::misc-data-offset 8) object)
1189  (cmpwi crf1 temp 0)
1190  (bne crf1 :bad)
1191  :good
1192  )
1193
1194
1195(define-ppc64-vinsn require-char-code (()
1196                                       ((object :lisp))
1197                                       ((crf0 (:crf 0))
1198                                        (crf1 :crf)
1199                                        (tag :u32)))
1200  :again
1201  (clrldi. tag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
1202  (lis tag (ash (ash #x110000 ppc64::fixnumshift) -16))
1203  (cmpld crf1 object tag)
1204  (bne crf0 :bad)
1205  (blt+ crf1 :got-it)
1206  :bad
1207  (uuo_intcerr arch::error-object-not-mod-char-code-limit object)
1208  (b :again)
1209  :got-it)
1210
1211
1212(define-ppc64-vinsn box-fixnum (((dest :imm))
1213                                ((src :s64)))
1214  (sldi dest src ppc64::fixnumshift))
1215
1216(define-ppc64-vinsn fixnum->signed-natural (((dest :s64))
1217                                            ((src :imm)))
1218  (sradi dest src ppc64::fixnumshift))
1219
1220(define-ppc64-vinsn fixnum->unsigned-natural (((dest :u64))
1221                                              ((src :imm)))
1222  (srdi dest src ppc64::fixnumshift))
1223
1224
1225
1226(define-ppc64-vinsn unbox-u64 (((dest :u64))
1227                               ((src :lisp))
1228                               ((crf0 (:crf 0))
1229                                (crf1 :crf)
1230                                (crf2 :crf)))
1231  (clrldi. dest src (- ppc64::nbits-in-word ppc64::fixnumshift))
1232  (clrldi dest src (- ppc64::nbits-in-word ppc64::ntagbits))
1233  (cmpdi crf1 dest ppc64::fulltag-misc)
1234  (sradi dest src ppc64::fixnumshift)
1235  (beq crf0 :good-if-positive)
1236  (bne crf1 :bad)
1237  (ld dest ppc64::misc-header-offset src)
1238  (cmpdi crf0 dest  ppc64::three-digit-bignum-header)
1239  (cmpdi crf2 dest ppc64::two-digit-bignum-header)
1240  (beq crf0 :three-digit)
1241  (bne crf2 :bad)
1242  ;; two-digit case.  Must be positive.
1243  (ld dest ppc64::misc-data-offset src)
1244  (rotldi dest dest 32)
1245  :good-if-positive
1246  (cmpdi crf1 dest 0)
1247  (bge crf1 :good)
1248  :bad
1249  (uuo_interr arch::error-object-not-unsigned-byte-64 src)
1250  :three-digit
1251  (lwz dest (+ ppc64::misc-data-offset 8) src)
1252  (cmpwi crf1 dest 0)
1253  (ld dest ppc64::misc-data-offset src)
1254  (rotldi dest dest 32)
1255  (bne crf1 :bad)
1256  :good
1257  )
1258
1259(define-ppc64-vinsn unbox-s64 (((dest :s64))
1260                               ((src :lisp))
1261                               ((crf0 :crf)
1262                                (crf1 :crf)
1263                                (tag :u64)))
1264 
1265  (clrldi. tag src (- ppc64::nbits-in-word ppc64::fixnumshift))
1266  (clrldi tag src (- ppc64::nbits-in-word ppc64::ntagbits))
1267  (cmpdi crf1 tag ppc64::fulltag-misc)
1268  (sradi dest src ppc64::fixnumshift)
1269  (beq+ crf0 :good)
1270  (beq+ crf1 :bignum)
1271  :bad
1272  (uuo_interr arch::error-object-not-signed-byte-64 src)
1273  :bignum
1274  (ld tag ppc64::misc-header-offset src)
1275  (ld dest ppc64::misc-data-offset src)
1276  (cmpdi crf0 tag ppc64::two-digit-bignum-header)
1277  (rotldi dest dest 32)
1278  (bne- crf0 :bad)
1279  :good
1280  )
1281
1282;;; An object is of type (UNSIGNED-BYTE 32) iff
1283;;;  a) it's of type (UNSIGNED-BYTE 32)
1284;;; That pretty much narrows it down.
1285 
1286(define-ppc64-vinsn unbox-u32 (((dest :u32))
1287                               ((src :lisp))
1288                               ((crf0 (:crf 0))))
1289  (rldicr. dest src (- 64 ppc64::fixnumshift) 31)
1290  (srdi dest src ppc64::fixnumshift)
1291  (beq crf0 :got-it)
1292  :bad
1293  (uuo_interr arch::error-object-not-unsigned-byte-32 src)
1294  :got-it)
1295
1296(define-ppc64-vinsn %unbox-u32 (((dest :u32))
1297                                ((src :lisp)))
1298  (rldicl dest src (- 64 ppc64::fixnumshift) 32))
1299
1300;;; an object is of type (SIGNED-BYTE 32) iff
1301;;; a) it's of type (SIGNED-BYTE 32)
1302;;; b) see (a).
1303
1304
1305(define-ppc64-vinsn unbox-s32 (((dest :s32))
1306                               ((src :lisp))
1307                               ((crf :crf)))
1308  (sldi dest src (- ppc64::nbits-in-word (+ 32 ppc64::fixnumshift)))
1309  (sradi dest dest (- ppc64::nbits-in-word 32))
1310  (sldi dest dest ppc64::fixnumshift)
1311  (cmpd crf dest src)
1312  (sradi dest src ppc64::fixnumshift)
1313  (beq crf :got-it)
1314  :bad
1315  (uuo_interr arch::error-object-not-signed-byte-32 src)
1316  :got-it)
1317
1318
1319(define-ppc64-vinsn unbox-u16 (((dest :u16))
1320                               ((src :lisp))
1321                               ((crf0 (:crf 0))))
1322  ;; The bottom ppc64::fixnumshift bits and the top (- 31 (+
1323  ;; ppc64::fixnumshift 16)) must all be zero.
1324  (rldicr. dest src (- 64 ppc64::fixnumshift) 47)
1325  (srdi dest src ppc64::fixnumshift)
1326  (beq+ crf0 :got-it)
1327  (uuo_interr arch::error-object-not-unsigned-byte-16 src)
1328  :got-it)
1329
1330(define-ppc64-vinsn unbox-s16 (((dest :s16))
1331                               ((src :lisp))
1332                               ((crf :crf)))
1333  (sldi dest src (- ppc64::nbits-in-word (+ 16 ppc64::fixnumshift)))
1334  (sradi dest dest (- ppc64::nbits-in-word 16))
1335  (sldi dest dest ppc64::fixnumshift)
1336  (cmpd crf dest src)
1337  (sradi dest src ppc64::fixnumshift)
1338  (beq+ crf :got-it)
1339  :bad
1340  (uuo_interr arch::error-object-not-signed-byte-16 src)
1341  :got-it)
1342
1343 
1344 
1345(define-ppc64-vinsn unbox-u8 (((dest :u8))
1346                              ((src :lisp))
1347                              ((crf0 (:crf 0))))
1348  ;; The bottom ppc64::fixnumshift bits and the top (- 63 (+
1349  ;; ppc64::fixnumshift 8)) must all be zero.
1350  (rldicr. dest src (- 64 ppc64::fixnumshift) 55)
1351  (srdi dest src ppc64::fixnumshift)
1352  (beq+ crf0 :got-it)
1353  (uuo_interr arch::error-object-not-unsigned-byte-8 src)
1354  :got-it)
1355
1356(define-ppc64-vinsn %unbox-u8 (((dest :u8))
1357                              ((src :lisp)))
1358  ;; The bottom ppc64::fixnumshift bits and the top (- 63 (+
1359  ;; ppc64::fixnumshift 8)) must all be zero.
1360  (rldicl dest src (- 64 ppc64::fixnumshift) 56))
1361
1362(define-ppc64-vinsn unbox-s8 (((dest :s8))
1363                              ((src :lisp))
1364                              ((crf :crf)))
1365  (sldi dest src (- ppc64::nbits-in-word (+ 8 ppc64::fixnumshift)))
1366  (sradi dest dest (- ppc64::nbits-in-word 8))
1367  (sldi dest dest ppc64::fixnumshift)
1368  (cmpd crf dest src)
1369  (sradi dest src ppc64::fixnumshift)
1370  (beq+ crf :got-it)
1371  :bad
1372  (uuo_interr arch::error-object-not-signed-byte-16 src)
1373  :got-it)
1374
1375(define-ppc64-vinsn unbox-base-char (((dest :u32))
1376                                     ((src :lisp))
1377                                     ((crf :crf)))
1378  (clrldi dest src (- 64 ppc64::num-subtag-bits))
1379  (cmpdi crf dest ppc64::subtag-character)
1380  (srdi dest src ppc64::charcode-shift)
1381  (beq+ crf :got-it)
1382  (uuo_interr arch::error-object-not-character src)
1383  :got-it)
1384
1385(define-ppc64-vinsn unbox-bit (((dest :u32))
1386                               ((src :lisp))
1387                               ((crf :crf)))
1388  (cmplwi crf src (ash 1 ppc64::fixnumshift))
1389  (srawi dest src ppc64::fixnumshift)
1390  (ble+ crf :got-it)
1391  (uuo_interr arch::error-object-not-bit src)
1392  :got-it)
1393
1394(define-ppc64-vinsn unbox-bit-bit0 (((dest :u32))
1395                                    ((src :lisp))
1396                                    ((crf :crf)))
1397  (cmplwi crf src (ash 1 ppc64::fixnumshift))
1398  (rlwinm dest src (- 32 (1+ ppc64::fixnumshift)) 0 0)
1399  (ble+ crf :got-it)
1400  (uuo_interr arch::error-object-not-bit src)
1401  :got-it)
1402
1403
1404
1405
1406(define-ppc64-vinsn shift-right-variable-word (((dest :u32))
1407                                               ((src :u32)
1408                                                (sh :u32)))
1409  (srw dest src sh))
1410
1411;;; These vinsns are used in bit extraction operations, which
1412;;; currently do 32-bit memory references on both platforms.
1413(define-ppc64-vinsn u32logandc2 (((dest :u32))
1414                                 ((x :u32)
1415                                  (y :u32)))
1416  (andc dest x y))
1417
1418(define-ppc64-vinsn u32logior (((dest :u32))
1419                               ((x :u32)
1420                                (y :u32)))
1421  (or dest x y))
1422
1423
1424(define-ppc64-vinsn trap-unless-fixnum (()
1425                                        ((object :lisp))
1426                                        ((tag :u8)))
1427  (clrldi tag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
1428  (tdnei tag ppc64::tag-fixnum))
1429
1430(define-ppc64-vinsn trap-unless-character (()
1431                                           ((object :lisp))
1432                                           ((tag :u8)))
1433  (clrldi tag object (- ppc64::nbits-in-word ppc64::num-subtag-bits))
1434  (tdnei tag ppc64::subtag-character))
1435
1436
1437(define-ppc64-vinsn trap-unless-cons (()
1438                                        ((object :lisp))
1439                                        ((tag :u8)))
1440  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1441  (tdnei tag ppc64::fulltag-cons))
1442
1443(define-ppc64-vinsn trap-unless-list (()
1444                                      ((object :lisp))
1445                                      ((tag :u8)
1446                                       (crf :crf)))
1447  (cmpldi crf object (:apply target-nil-value))
1448  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1449  (beq crf :ok)
1450  (tdi 3 tag ppc64::fulltag-cons)
1451  :ok)
1452
1453(define-ppc64-vinsn trap-unless-uvector (()
1454                                         ((object :lisp))
1455                                         ((tag :u8)))
1456  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1457  (tdnei tag ppc64::fulltag-misc))
1458
1459(define-ppc64-vinsn trap-unless-single-float (()
1460                                              ((object :lisp))
1461                                              ((tag :u8)))
1462  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1463  (tdnei tag ppc64::subtag-single-float))
1464
1465(define-ppc64-vinsn trap-unless-double-float (()
1466                                              ((object :lisp))
1467                                              ((tag :u8)
1468                                               (crf :crf)))
1469  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1470  (cmpdi crf tag ppc64::fulltag-misc)
1471  (bne crf :do-trap)
1472  (lbz tag ppc64::misc-subtag-offset object)
1473  :do-trap
1474  (tdnei tag ppc64::subtag-double-float))
1475
1476(define-ppc64-vinsn trap-unless-array-header (()
1477                                              ((object :lisp))
1478                                              ((tag :u8)
1479                                               (crf :crf)))
1480  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1481  (cmpdi crf tag ppc64::fulltag-misc)
1482  (bne crf :do-trap)
1483  (lbz tag ppc64::misc-subtag-offset object)
1484  :do-trap
1485  (tdnei tag ppc64::subtag-arrayH))
1486
1487(define-ppc64-vinsn trap-unless-macptr (()
1488                                        ((object :lisp))
1489                                        ((tag :u8)
1490                                         (crf :crf)))
1491  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1492  (cmpdi crf tag ppc64::fulltag-misc)
1493  (bne crf :do-trap)
1494  (lbz tag ppc64::misc-subtag-offset object)
1495  :do-trap
1496  (tdnei tag ppc64::subtag-macptr))
1497
1498
1499(define-ppc64-vinsn trap-unless-typecode= (()
1500                                           ((object :lisp)
1501                                            (tagval :u16const))
1502                                           ((tag :u8)
1503                                            (crf :crf)))
1504  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1505  (cmpdi crf tag ppc64::fulltag-misc)
1506  (clrldi tag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
1507  (bne crf :do-trap)
1508  (lbz tag ppc64::misc-subtag-offset object)
1509  :do-trap
1510  (tdnei tag tagval))
1511 
1512(define-ppc64-vinsn subtract-constant (((dest :imm))
1513                                       ((src :imm)
1514                                        (const :s16const)))
1515  (subi dest src const))
1516
1517
1518
1519
1520;;; Bit-extraction & boolean operations
1521
1522
1523;;; For some mind-numbing reason, IBM decided to call the most significant
1524;;; bit in a 32-bit word "bit 0" and the least significant bit "bit 31"
1525;;; (this despite the fact that it's essentially a big-endian architecture
1526;;; (it was exclusively big-endian when this decision was made.))
1527;;; We'll probably be least confused if we consistently use this backwards
1528;;; bit ordering (letting things that have a "sane" bit-number worry about
1529;;; it at compile-time or run-time (subtracting the "sane" bit number from
1530;;; 31.))
1531
1532(define-ppc64-vinsn extract-variable-bit (((dest :u8))
1533                                          ((src :u32)
1534                                           (bitnum :u8))
1535                                          ())
1536  (rotlw dest src bitnum)
1537  (extrwi dest dest 1 0))
1538
1539
1540(define-ppc64-vinsn extract-variable-bit-fixnum (((dest :imm))
1541                                                 ((src :u32)
1542                                                  (bitnum :u8))
1543                                                 ((temp :u32)))
1544  (rotlw temp src bitnum)
1545  (rlwinm dest
1546          temp 
1547          (1+ ppc64::fixnumshift) 
1548          (- ppc64::least-significant-bit ppc64::fixnumshift)
1549          (- ppc64::least-significant-bit ppc64::fixnumshift)))
1550
1551
1552(define-ppc64-vinsn lowbit->truth (((dest :lisp)
1553                                    (bits :u64))
1554                                   ((bits :u64))
1555                                   ())
1556  (mulli bits bits ppc64::t-offset)
1557  (addi dest bits (:apply target-nil-value)))
1558
1559(define-ppc64-vinsn invert-lowbit (((bits :u64))
1560                                   ((bits :u64))
1561                                   ())
1562  (xori bits bits 1))
1563
1564                           
1565
1566;;; Some of the obscure-looking instruction sequences - which map some
1567;;; relation to PPC bit 31 of some register - were found by the GNU
1568;;; SuperOptimizer.  Some of them use extended-precision instructions
1569;;; (which may cause interlocks on some superscalar PPCs, if I
1570;;; remember correctly.)  In general, sequences that GSO found that
1571;;; -don't- do extended precision are longer and/or use more
1572;;; temporaries.  On the 604, the penalty for using an instruction
1573;;; that uses the CA bit is "at least" one cycle: it can't complete
1574;;; execution until all "older" instructions have.  That's not
1575;;; horrible, especially given that the alternative is usually to use
1576;;; more instructions (and, more importantly, more temporaries) to
1577;;; avoid using extended-precision.
1578
1579
1580(define-ppc64-vinsn eq0->bit31 (((bits :u64))
1581                                ((src (t (:ne bits)))))
1582  (cntlzd bits src)
1583  (srdi bits bits 6))                   ; bits = 0000...000X
1584
1585(define-ppc64-vinsn ne0->bit31 (((bits :u64))
1586                                ((src (t (:ne bits)))))
1587  (cntlzd bits src)
1588  (sld bits src bits)
1589  (srdi bits bits 63))                  ; bits = 0000...000X
1590
1591(define-ppc64-vinsn lt0->bit31 (((bits :u64))
1592                                ((src (t (:ne bits)))))
1593  (srdi bits src 63))                   ; bits = 0000...000X
1594
1595
1596(define-ppc64-vinsn ge0->bit31 (((bits :u64))
1597                                ((src (t (:ne bits)))))
1598  (srdi bits src 63)       
1599  (xori bits bits 1))                   ; bits = 0000...000X
1600
1601
1602(define-ppc64-vinsn le0->bit31 (((bits :u64))
1603                                ((src (t (:ne bits)))))
1604  (neg bits src)
1605  (orc bits bits src)
1606  (srdi bits bits 63))                  ; bits = 0000...000X
1607
1608(define-ppc64-vinsn gt0->bit31 (((bits :u64))
1609                                ((src (t (:ne bits)))))
1610  (subi bits src 1)       
1611  (nor bits bits src)
1612  (srdi bits bits 63))                  ; bits = 0000...000X
1613
1614(define-ppc64-vinsn ne->bit31 (((bits :u64))
1615                               ((x t)
1616                                (y t))
1617                               ((temp :u64)))
1618  (subf temp x y)
1619  (cntlzd bits temp)
1620  (sld bits temp bits)
1621  (srdi bits bits 63))                  ; bits = 0000...000X
1622
1623(define-ppc64-vinsn fulltag->bit31 (((bits :u64))
1624                                    ((lispobj :lisp)
1625                                     (tagval :u8const))
1626                                    ())
1627  (clrldi bits lispobj (- ppc64::nbits-in-word ppc64::ntagbits))
1628  (subi bits bits tagval)
1629  (cntlzd bits bits)
1630  (srdi bits bits 6))
1631
1632
1633(define-ppc64-vinsn eq->bit31 (((bits :u64))
1634                               ((x t)
1635                                (y t)))
1636  (subf bits x y)
1637  (cntlzd bits bits)
1638  (srdi bits bits 6))                   ; bits = 0000...000X
1639
1640(define-ppc64-vinsn eqnil->bit31 (((bits :u64))
1641                                  ((x t)))
1642  (subi bits x (:apply target-nil-value))
1643  (cntlzd bits bits)
1644  (srdi bits bits 6))
1645
1646(define-ppc64-vinsn ne->bit31 (((bits :u64))
1647                               ((x t)
1648                                (y t)))
1649  (subf bits x y)
1650  (cntlzd bits bits)
1651  (srdi bits bits 6)
1652  (xori bits bits 1))
1653
1654(define-ppc64-vinsn nenil->bit31 (((bits :u64))
1655                                  ((x t)))
1656  (subi bits x (:apply target-nil-value))
1657  (cntlzd bits bits)
1658  (srdi bits bits 6)
1659  (xori bits bits 1))
1660
1661(define-ppc64-vinsn lt->bit31 (((bits :u64))
1662                               ((x (t (:ne bits)))
1663                                (y (t (:ne bits)))))
1664
1665  (xor bits x y)
1666  (sradi bits bits 63)
1667  (or bits bits x)
1668  (subf bits y bits)
1669  (srdi bits bits 63))                  ; bits = 0000...000X
1670
1671(define-ppc64-vinsn ltu->bit31 (((bits :u64))
1672                                ((x :u64)
1673                                 (y :u64)))
1674  (subfc bits y x)
1675  (subfe bits bits bits)
1676  (neg bits bits))
1677
1678(define-ppc64-vinsn le->bit31 (((bits :u64))
1679                               ((x (t (:ne bits)))
1680                                (y (t (:ne bits)))))
1681
1682  (xor bits x y)
1683  (sradi bits bits 63)
1684  (nor bits bits y)
1685  (add bits bits x)
1686  (srdi bits bits 63))                  ; bits = 0000...000X
1687
1688(define-ppc64-vinsn leu->bit31  (((bits :u32))
1689                                 ((x :u32)
1690                                  (y :u32)))
1691  (subfc bits x y)
1692  (addze bits ppc::rzero))
1693
1694(define-ppc64-vinsn gt->bit31 (((bits :u32))
1695                               ((x (t (:ne bits)))
1696                                (y (t (:ne bits)))))
1697
1698  (eqv bits x y)
1699  (sradi bits bits 63)
1700  (and bits bits x)
1701  (subf bits bits y)
1702  (srdi bits bits 63))                  ; bits = 0000...000X
1703
1704(define-ppc64-vinsn gtu->bit31 (((bits :u64))
1705                                ((x :u64)
1706                                 (y :u64)))
1707  (subfc bits x y)
1708  (subfe bits bits bits)
1709  (neg bits bits))
1710
1711(define-ppc64-vinsn ge->bit31 (((bits :u64))
1712                               ((x (t (:ne bits)))
1713                                (y (t (:ne bits)))))
1714  (eqv bits x y)
1715  (sradi bits bits 63)
1716  (andc bits bits x)
1717  (add bits bits y)
1718  (srdi bits bits 63))                  ; bits = 0000...000X
1719
1720(define-ppc64-vinsn geu->bit31 (((bits :u64))
1721                                ((x :u64)
1722                                 (y :u64)))
1723  (subfc bits y x)
1724  (addze bits ppc::rzero))
1725
1726
1727;;; there are big-time latencies associated with MFCR on more heavily
1728;;; pipelined processors; that implies that we should avoid this like
1729;;; the plague.
1730;;; GSO can't find anything much quicker for LT or GT, even though
1731;;; MFCR takes three cycles and waits for previous instructions to complete.
1732;;; Of course, using a CR field costs us something as well.
1733(define-ppc64-vinsn crbit->bit31 (((bits :u64))
1734                                  ((crf :crf)
1735                                   (bitnum :crbit))
1736                                  ())
1737  (mfcr bits)                           ; Suffer.
1738  (rlwinm bits bits (:apply + 1  bitnum (:apply ash crf 2)) 31 31)) ; bits = 0000...000X
1739
1740
1741(define-ppc64-vinsn compare (((crf :crf))
1742                             ((arg0 t)
1743                              (arg1 t))
1744                             ())
1745  (cmpd crf arg0 arg1))
1746
1747(define-ppc64-vinsn compare-to-nil (((crf :crf))
1748                                    ((arg0 t)))
1749  (cmpdi crf arg0 (:apply target-nil-value)))
1750
1751(define-ppc64-vinsn compare-logical (((crf :crf))
1752                                     ((arg0 t)
1753                                      (arg1 t))
1754                                     ())
1755  (cmpld crf arg0 arg1))
1756
1757(define-ppc64-vinsn double-float-compare (((crf :crf))
1758                                          ((arg0 :double-float)
1759                                           (arg1 :double-float))
1760                                          ())
1761  (fcmpo crf arg0 arg1))
1762             
1763
1764(define-ppc64-vinsn double-float+-2 (((result :double-float))
1765                                     ((x :double-float)
1766                                      (y :double-float))
1767                                     ((crf (:crf 4))))
1768  (fadd result x y))
1769
1770(define-ppc64-vinsn double-float--2 (((result :double-float))
1771                                     ((x :double-float)
1772                                      (y :double-float))
1773                                     ((crf (:crf 4))))
1774  (fsub result x y))
1775
1776(define-ppc64-vinsn double-float*-2 (((result :double-float))
1777                                     ((x :double-float)
1778                                      (y :double-float))
1779                                     ((crf (:crf 4))))
1780  (fmul result x y))
1781
1782(define-ppc64-vinsn double-float/-2 (((result :double-float))
1783                                     ((x :double-float)
1784                                      (y :double-float))
1785                                     ((crf (:crf 4))))
1786  (fdiv result x y))
1787
1788(define-ppc64-vinsn single-float+-2 (((result :single-float))
1789                                     ((x :single-float)
1790                                      (y :single-float))
1791                                     ((crf (:crf 4))))
1792  (fadds result x y))
1793
1794(define-ppc64-vinsn single-float--2 (((result :single-float))
1795                                     ((x :single-float)
1796                                      (y :single-float))
1797                                     ((crf (:crf 4))))
1798  (fsubs result x y))
1799
1800(define-ppc64-vinsn single-float*-2 (((result :single-float))
1801                                     ((x :single-float)
1802                                      (y :single-float))
1803                                     ((crf (:crf 4))))
1804  (fmuls result x y))
1805
1806(define-ppc64-vinsn single-float/-2 (((result :single-float))
1807                                     ((x :single-float)
1808                                      (y :single-float))
1809                                     ((crf (:crf 4))))
1810  (fdivs result x y))
1811
1812
1813
1814(define-ppc64-vinsn compare-signed-s16const (((crf :crf))
1815                                             ((arg0 :imm)
1816                                              (imm :s16const))
1817                                             ())
1818  (cmpdi crf arg0 imm))
1819
1820(define-ppc64-vinsn compare-unsigned-u16const (((crf :crf))
1821                                               ((arg0 :u32)
1822                                                (imm :u16const))
1823                                               ())
1824  (cmpldi crf arg0 imm))
1825
1826
1827
1828;;; Extract a constant bit (0-63) from src; make it be bit 63 of dest.
1829;;; Bitnum is treated mod 64. (This is used in LOGBITP).
1830(define-ppc64-vinsn extract-constant-ppc-bit (((dest :u64))
1831                                              ((src :imm)
1832                                               (bitnum :u16const))
1833                                              ())
1834  (rldicl dest src (:apply + 1 bitnum) 63))
1835
1836
1837(define-ppc64-vinsn set-constant-ppc-bit-to-variable-value (((dest :u32))
1838                                                            ((src :u32)
1839                                                             (bitval :u32) ; 0 or 1
1840                                                             (bitnum :u8const)))
1841  (rlwimi dest bitval (:apply - 32 bitnum) bitnum bitnum))
1842
1843(define-ppc64-vinsn set-constant-ppc-bit-to-1 (((dest :u32))
1844                                               ((src :u32)
1845                                                (bitnum :u8const)))
1846  ((:pred < bitnum 16)
1847   (oris dest src (:apply ash #x8000 (:apply - bitnum))))
1848  ((:pred >= bitnum 16)
1849   (ori dest src (:apply ash #x8000 (:apply - (:apply - bitnum 16))))))
1850
1851(define-ppc64-vinsn set-constant-ppc-bit-to-0 (((dest :u32))
1852                                               ((src :u32)
1853                                                (bitnum :u8const)))
1854  (rlwinm dest src 0 (:apply logand #x1f (:apply 1+ bitnum)) (:apply logand #x1f (:apply 1- bitnum))))
1855
1856 
1857(define-ppc64-vinsn insert-bit-0 (((dest :u32))
1858                                  ((src :u32)
1859                                   (val :u32)))
1860  (rlwimi dest val 0 0 0))
1861 
1862;;; The bit number is boxed and wants to think of the
1863;;; least-significant bit as 0.  Imagine that.  To turn the boxed,
1864;;; lsb-0 bitnumber into an unboxed, msb-0 rotate count, we
1865;;; (conceptually) unbox it, add ppc64::fixnumshift to it, subtract it
1866;;; from 31, and add one.  This can also be done as "unbox and
1867;;; subtract from 28", I think ...  Actually, it'd be "unbox, then
1868;;; subtract from 30".
1869(define-ppc64-vinsn extract-variable-non-insane-bit (((dest :u64))
1870                                                     ((src :imm)
1871                                                      (bit :imm))
1872                                                     ((temp :u64)))
1873  (srdi temp bit ppc64::fixnumshift)
1874  (subfic temp temp (- 64 ppc64::fixnumshift))
1875  (rldcl dest src temp 63))
1876                                               
1877;;; Operations on lists and cons cells
1878
1879(define-ppc64-vinsn %cdr (((dest :lisp))
1880                          ((src :lisp)))
1881  (ld dest ppc64::cons.cdr src))
1882
1883(define-ppc64-vinsn %car (((dest :lisp))
1884                          ((src :lisp)))
1885  (ld dest ppc64::cons.car src))
1886
1887(define-ppc64-vinsn %set-car (()
1888                              ((cell :lisp)
1889                               (new :lisp)))
1890  (std new ppc64::cons.car cell))
1891
1892(define-ppc64-vinsn %set-cdr (()
1893                              ((cell :lisp)
1894                               (new :lisp)))
1895  (std new ppc64::cons.cdr cell))
1896
1897(define-ppc64-vinsn load-adl (()
1898                              ((n :u32const)))
1899  (lis ppc::nargs (:apply ldb (byte 16 16) n))
1900  (ori ppc::nargs ppc::nargs (:apply ldb (byte 16 0) n)))
1901                           
1902(define-ppc64-vinsn set-nargs (()
1903                               ((n :s16const)))
1904  (li ppc::nargs (:apply ash n ppc64::word-shift)))
1905
1906(define-ppc64-vinsn scale-nargs (()
1907                                 ((nfixed :s16const)))
1908  ((:pred > nfixed 0)
1909   (la ppc::nargs (:apply - (:apply ash nfixed ppc64::word-shift)) ppc::nargs)))
1910                           
1911
1912
1913(define-ppc64-vinsn (vpush-register :push :node :vsp)
1914    (()
1915     ((reg :lisp)))
1916  (stdu reg -8 ppc::vsp))
1917
1918(define-ppc64-vinsn (vpush-register-arg :push :node :vsp :outgoing-argument)
1919    (()
1920     ((reg :lisp)))
1921  (stdu reg -8 ppc::vsp))
1922
1923(define-ppc64-vinsn (vpop-register :pop :node :vsp)
1924    (((dest :lisp))
1925     ())
1926  (ld dest 0 ppc::vsp)
1927  (la ppc::vsp ppc64::word-size-in-bytes ppc::vsp))
1928
1929
1930(define-ppc64-vinsn copy-node-gpr (((dest :lisp))
1931                                   ((src :lisp)))
1932  ((:not (:pred =
1933                (:apply %hard-regspec-value dest)
1934                (:apply %hard-regspec-value src)))
1935   (mr dest src)))
1936
1937(define-ppc64-vinsn copy-gpr (((dest t))
1938                              ((src t)))
1939  ((:not (:pred =
1940                (:apply %hard-regspec-value dest)
1941                (:apply %hard-regspec-value src)))
1942   (mr dest src)))
1943
1944
1945(define-ppc64-vinsn copy-fpr (((dest :double-float))
1946                              ((src :double-float)))
1947  ((:not (:pred =
1948                (:apply %hard-regspec-value dest)
1949                (:apply %hard-regspec-value src)))
1950   (fmr dest src)))
1951
1952(define-ppc64-vinsn vcell-ref (((dest :lisp))
1953                               ((vcell :lisp)))
1954  (ld dest ppc64::misc-data-offset vcell))
1955
1956(define-ppc64-vinsn vcell-set (()
1957                               ((vcell :lisp)
1958                                (value :lisp)))
1959  (std value ppc64::misc-data-offset vcell))
1960
1961
1962(define-ppc64-vinsn make-vcell (((dest :lisp))
1963                                ((closed (:lisp :ne dest)))
1964                                ((header :u64)))
1965  (li header ppc64::value-cell-header)
1966  (la ppc::allocptr (- ppc64::fulltag-misc ppc64::value-cell.size) ppc::allocptr)
1967  (tdlt ppc::allocptr ppc::allocbase)
1968  (std header ppc64::misc-header-offset ppc::allocptr)
1969  (mr dest ppc::allocptr)
1970  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
1971  (std closed ppc64::value-cell.value dest))
1972
1973(define-ppc64-vinsn make-tsp-vcell (((dest :lisp))
1974                                    ((closed :lisp))
1975                                    ((header :u64)))
1976  (li header ppc64::value-cell-header)
1977  (stdu ppc::tsp -32 ppc::tsp)
1978  (std ppc::tsp 8 ppc::tsp)
1979  (stfd ppc::fp-zero 16 ppc::tsp)
1980  (stfd ppc::fp-zero 24 ppc::tsp)
1981  (std ppc::rzero 8 ppc::tsp)
1982  (std header (+ 16 ppc64::fulltag-misc ppc64::value-cell.header) ppc::tsp)
1983  (std closed (+ 16 ppc64::fulltag-misc ppc64::value-cell.value) ppc::tsp)
1984  (la dest (+ 16 ppc64::fulltag-misc) ppc::tsp))
1985
1986(define-ppc64-vinsn make-tsp-cons (((dest :lisp))
1987                                   ((car :lisp) (cdr :lisp))
1988                                   ())
1989  (stdu ppc::tsp -32 ppc::tsp)
1990  (std ppc::tsp 8 ppc::tsp)
1991  (stfd ppc::fp-zero 16 ppc::tsp)
1992  (stfd ppc::fp-zero 24 ppc::tsp)
1993  (std ppc::rzero 8 ppc::tsp)
1994  (std car (+ 16 ppc64::fulltag-cons ppc64::cons.car) ppc::tsp)
1995  (std cdr (+ 16 ppc64::fulltag-cons ppc64::cons.cdr) ppc::tsp)
1996  (la dest (+ 16 ppc64::fulltag-cons) ppc::tsp))
1997
1998
1999(define-ppc64-vinsn %closure-code% (((dest :lisp))
2000                                    ())
2001  (ld dest (:apply + ppc64::symbol.vcell (ppc64::nrs-offset %closure-code%) (:apply target-nil-value)) 0))
2002
2003(define-ppc64-vinsn single-float-bits (((dest :u32))
2004                                       ((src :lisp)))
2005  (srdi dest  src 32))
2006
2007(define-ppc64-vinsn (call-subprim :call :subprim-call) (()
2008                                                        ((spno :s32const)))
2009  (bla spno))
2010
2011(define-ppc64-vinsn (jump-subprim :jumpLR) (()
2012                                            ((spno :s32const)))
2013  (ba spno))
2014
2015;;; Same as "call-subprim", but gives us a place to
2016;;; track args, results, etc.
2017(define-ppc64-vinsn (call-subprim-0 :call :subprim-call) (((dest t))
2018                                                          ((spno :s32const)))
2019  (bla spno))
2020
2021(define-ppc64-vinsn (call-subprim-1 :call :subprim-call) (((dest t))
2022                                                          ((spno :s32const)
2023                                                           (z t)))
2024  (bla spno))
2025 
2026(define-ppc64-vinsn (call-subprim-2 :call :subprim-call) (((dest t))
2027                                                          ((spno :s32const)
2028                                                           (y t)
2029                                                           (z t)))
2030  (bla spno))
2031
2032(define-ppc64-vinsn (call-subprim-3 :call :subprim-call) (((dest t))
2033                                                          ((spno :s32const)
2034                                                           (x t)
2035                                                           (y t)
2036                                                           (z t)))
2037  (bla spno))
2038
2039(define-ppc64-vinsn event-poll (()
2040                                ()
2041                                ((crf :crf)))
2042  (ld ppc::nargs ppc64::tcr.tlb-pointer ppc64::rcontext)
2043  (ld ppc::nargs ppc64::interrupt-level-binding-index ppc::nargs)
2044  (cmpdi crf ppc::nargs 0)
2045  (blt crf :done)
2046  (bgt crf :trap)
2047  (ld ppc::nargs ppc64::tcr.interrupt-pending ppc64::rcontext)
2048  :trap
2049  (tdgti ppc::nargs 0)
2050  :done)
2051
2052(define-ppc64-vinsn ref-interrupt-level (((dest :imm))
2053                                         ()
2054                                         ((temp :u64)))
2055  (ld temp ppc64::tcr.tlb-pointer ppc64::rcontext)
2056  (ld dest ppc64::INTERRUPT-LEVEL-BINDING-INDEX temp))
2057                         
2058;;; Unconditional (pc-relative) branch
2059(define-ppc64-vinsn (jump :jump)
2060    (()
2061     ((label :label)))
2062  (b label))
2063
2064(define-ppc64-vinsn (call-label :call) (()
2065                                        ((label :label)))
2066  (bl label))
2067
2068;;; just like JUMP, only (implicitly) asserts that the following
2069;;; code is somehow reachable.
2070(define-ppc64-vinsn (non-barrier-jump :xref) (()
2071                                              ((label :label)))
2072  (b label))
2073
2074
2075(define-ppc64-vinsn (cbranch-true :branch) (()
2076                                            ((label :label)
2077                                             (crf :crf)
2078                                             (crbit :u8const)))
2079  (bt (:apply + crf crbit) label))
2080
2081(define-ppc64-vinsn (cbranch-false :branch) (()
2082                                             ((label :label)
2083                                              (crf :crf)
2084                                              (crbit :u8const)))
2085  (bf (:apply + crf crbit) label))
2086
2087(define-ppc64-vinsn check-trap-error (()
2088                                      ())
2089  (beq+ 0 :no-error)
2090  (uuo_interr arch::error-reg-regnum ppc::arg_z)
2091  :no-error)
2092
2093
2094(define-ppc64-vinsn lisp-word-ref (((dest t))
2095                                   ((base t)
2096                                    (offset t)))
2097  (ldx dest base offset))
2098
2099(define-ppc64-vinsn lisp-word-ref-c (((dest t))
2100                                     ((base t)
2101                                      (offset :s16const)))
2102  (ld dest offset base))
2103
2104
2105(define-ppc64-vinsn (lri :constant-ref) (((dest :imm))
2106                                         ((intval :u64const))
2107                                         ())
2108  ((:or (:pred = (:apply ash intval -15) #x1FFFFFFFFFFFF)
2109        (:pred = (:apply ash intval -15) 0))
2110   (li dest (:apply %word-to-int (:apply logand #xffff intval))))
2111  ((:not
2112    (:or (:pred = (:apply ash intval -15) #x1FFFFFFFFFFFF)
2113         (:pred = (:apply ash intval -15) 0)))
2114   ((:or (:pred = (:apply ash intval -31) 0)
2115         (:pred = (:apply ash intval -31) #x1ffffffff))
2116    (lis dest (:apply %word-to-int (:apply ldb (:apply byte 16 16) intval)))
2117    ((:not (:pred = (:apply ldb (:apply byte 16 0) intval) 0))
2118     (ori dest dest (:apply ldb (:apply byte 16 0) intval))))
2119   ((:not (:or (:pred = (:apply ash intval -31) 0)
2120               (:pred = (:apply ash intval -31) #x1ffffffff)))
2121    ((:pred = (:apply ash intval -32) 0)
2122     (oris dest ppc::rzero (:apply ldb (:apply byte 16 16) intval))
2123     ((:not (:pred = (:apply ldb (:apply byte 16 0) intval) 0))
2124      (ori dest dest (:apply ldb (:apply byte 16 0) intval))))
2125    ((:not (:pred = (:apply ash intval -32) 0))
2126     ;; This is the general case, where all halfwords are significant.
2127     ;; Hopefully, something above catches lots of other cases.
2128     (lis dest (:apply %word-to-int (:apply ldb (:apply byte 16 48) intval)))
2129     ((:not (:pred = (:apply ldb (:apply byte 16 32) intval) 0))
2130      (ori dest dest (:apply ldb (:apply byte 16 32) intval)))
2131     (sldi dest dest 32)
2132     ((:not (:pred = (:apply ldb (:apply byte 16 16) intval) 0))
2133      (oris dest dest (:apply ldb (:apply byte 16 16) intval)))
2134     ((:not (:pred = (:apply ldb (:apply byte 16 0) intval) 0))
2135      (ori dest dest (:apply ldb (:apply byte 16 0) intval)))))))
2136
2137
2138(define-ppc64-vinsn discard-temp-frame (()
2139                                        ())
2140  (ld ppc::tsp 0 ppc::tsp))
2141
2142
2143;;; Somewhere, deep inside the "OS_X_PPC_RuntimeConventions.pdf"
2144;;; document, they bother to document the fact that SP should
2145;;; maintain 32-byte alignment on OSX.  (The example prologue
2146;;; code in that document incorrectly assumes 8-byte alignment.
2147;;; Or something.  It's wrong in a number of other ways.)
2148;;; The caller always has to reserve a 24-byte linkage area
2149;;; (large chunks of which are unused).
2150(define-ppc64-vinsn alloc-c-frame (()
2151                                   ((n-c-args :u16const)))
2152  ;; Always reserve space for at least 8 args and space for a lisp
2153  ;; frame (for the kernel) underneath it.
2154  ;; Zero the c-frame's savelr field, not that the GC cares ..
2155  ((:pred <= n-c-args 10)
2156   (stdu ppc::sp (- (+ 16 ppc64::c-frame.size ppc64::lisp-frame.size)) ppc::sp))
2157  ((:pred > n-c-args 10)
2158   ;; A normal C frame has room for 10 args (when padded out to
2159   ;; 32-byte alignment. Add enough double words to accomodate the
2160   ;; remaining args, in multiples of 4.
2161   (stdu ppc::sp (:apply - (:apply +
2162                                   16
2163                                   (+ ppc64::c-frame.size ppc64::lisp-frame.size)
2164                                   (:apply ash
2165                                           (:apply logand
2166                                                   (lognot 7)
2167                                                   (:apply
2168                                                    +
2169                                                    7
2170                                                    (:apply - n-c-args 10)))
2171                                           3)))
2172         ppc::sp))
2173  (std ppc::rzero ppc64::c-frame.savelr ppc::sp))
2174
2175
2176(define-ppc64-vinsn alloc-variable-c-frame (()
2177                                            ((n-c-args :lisp))
2178                                            ((crf :crf)
2179                                             (size :s64)))
2180  (cmpdi crf n-c-args (ash 10 ppc64::fixnumshift))
2181  (subi size n-c-args (ash 10 ppc64::fixnumshift))
2182  (bgt :variable)
2183  ;; Always reserve space for at least 8 args and space for a lisp
2184  ;; frame (for the kernel) underneath it.
2185  (stdu ppc::sp (- (+ 16 ppc64::c-frame.size ppc64::lisp-frame.size)) ppc::sp)
2186  (b :done)
2187  :variable
2188  (addi size size (+  (+ 16 ppc64::c-frame.size ppc64::lisp-frame.size) (ash 3 ppc64::fixnumshift)))
2189  (clrrdi size size 4)
2190  (neg size size)
2191  (stdux ppc::sp ppc::sp size)
2192  :done
2193  (stw ppc::rzero ppc64::c-frame.savelr ppc::sp))
2194
2195;;; We should rarely have to do this.  It's easier to just generate code
2196;;; to do the memory reference than it would be to keep track of the size
2197;;; of each frame.
2198(define-ppc64-vinsn discard-c-frame (()
2199                                     ())
2200  (ld ppc::sp 0 ppc::sp))
2201
2202
2203
2204
2205(define-ppc64-vinsn set-c-arg (()
2206                               ((argval :u32)
2207                                (argnum :u16const)))
2208  (std argval (:apply + ppc64::c-frame.param0 (:apply ash argnum ppc64::word-shift)) ppc::sp))
2209
2210(define-ppc64-vinsn set-single-c-arg (()
2211                                      ((argval :single-float)
2212                                       (argnum :u16const)))
2213  (stfs argval (:apply + ppc64::c-frame.param0 4 (:apply ash argnum ppc64::word-shift)) ppc::sp))
2214
2215(define-ppc64-vinsn set-double-c-arg (()
2216                                      ((argval :double-float)
2217                                       (argnum :u16const)))
2218  (stfd argval (:apply + ppc64::c-frame.param0 (:apply ash argnum ppc64::word-shift)) ppc::sp))
2219
2220(define-ppc64-vinsn reload-single-c-arg (((argval :single-float))
2221                                         ((argnum :u16const)))
2222  (lfs argval (:apply + ppc64::c-frame.param0 4 (:apply ash argnum ppc64::word-shift)) ppc::sp))
2223
2224(define-ppc64-vinsn reload-single-c-arg-high (((argval :single-float))
2225                                              ((argnum :u16const)))
2226  (lfs argval (:apply + ppc64::c-frame.param0 (:apply ash argnum ppc64::word-shift)) ppc::sp))
2227
2228(define-ppc64-vinsn reload-double-c-arg (((argval :double-float))
2229                                         ((argnum :u16const)))
2230  (lfd argval (:apply + ppc64::c-frame.param0 (:apply ash argnum ppc64::word-shift)) ppc::sp))
2231
2232(define-ppc64-vinsn (load-nil :constant-ref) (((dest t))
2233                                              ())
2234  (li dest (:apply target-nil-value)))
2235
2236
2237(define-ppc64-vinsn (load-t :constant-ref) (((dest t))
2238                                            ())
2239  (li dest (:apply + ppc64::t-offset (:apply target-nil-value))))
2240
2241(define-ppc64-vinsn set-eq-bit (((dest :crf))
2242                                ())
2243  (creqv (:apply + ppc::ppc-eq-bit dest)
2244         (:apply + ppc::ppc-eq-bit dest)
2245         (:apply + ppc::ppc-eq-bit dest)))
2246
2247(define-ppc64-vinsn (ref-constant :constant-ref) (((dest :lisp))
2248                                                  ((src :s16const)))
2249  (ld dest (:apply + ppc64::misc-data-offset (:apply ash (:apply 1+ src) 3)) ppc::fn))
2250
2251(define-ppc64-vinsn ref-indexed-constant (((dest :lisp))
2252                                          ((idxreg :s64)))
2253  (ldx dest ppc::fn idxreg))
2254
2255
2256(define-ppc64-vinsn cons (((dest :lisp))
2257                          ((newcar :lisp)
2258                           (newcdr :lisp)))
2259  (la ppc::allocptr (- ppc64::fulltag-cons ppc64::cons.size) ppc::allocptr)
2260  (tdlt ppc::allocptr ppc::allocbase)
2261  (std newcdr ppc64::cons.cdr ppc::allocptr)
2262  (std newcar ppc64::cons.car ppc::allocptr)
2263  (mr dest ppc::allocptr)
2264  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits)))
2265
2266
2267
2268;;; subtag had better be a PPC-NODE-SUBTAG of some sort!
2269(define-ppc64-vinsn %ppc-gvector (((dest :lisp))
2270                                  ((Rheader :u32) 
2271                                   (nbytes :u32const))
2272                                  ((immtemp0 :u32)
2273                                   (nodetemp :lisp)
2274                                   (crf :crf)))
2275  (la ppc::allocptr (:apply - ppc64::fulltag-misc
2276                            (:apply logand (lognot 15)
2277                                    (:apply + (+ 15 8) nbytes)))
2278      ppc::allocptr)
2279  (tdlt ppc::allocptr ppc::allocbase)
2280  (std Rheader ppc64::misc-header-offset ppc::allocptr)
2281  (mr dest ppc::allocptr)
2282  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
2283  ((:not (:pred = nbytes 0))
2284   (li immtemp0 (:apply + ppc64::misc-data-offset nbytes))
2285   :loop
2286   (subi immtemp0 immtemp0 8)
2287   (cmpdi crf immtemp0 ppc64::misc-data-offset)
2288   (ld nodetemp 0 ppc::vsp)
2289   (la ppc::vsp 8 ppc::vsp)
2290   (stdx nodetemp dest immtemp0)
2291   (bne crf :loop)))
2292
2293;;; allocate a small (phys size <= 32K bytes) misc obj of known size/subtag
2294(define-ppc64-vinsn %alloc-misc-fixed (((dest :lisp))
2295                                       ((Rheader :u64)
2296                                        (nbytes :u32const)))
2297  (la ppc::allocptr (:apply - ppc64::fulltag-misc
2298                            (:apply logand (lognot 15)
2299                                    (:apply + (+ 15 8) nbytes)))
2300      ppc::allocptr)
2301  (tdlt ppc::allocptr ppc::allocbase)
2302  (std Rheader ppc64::misc-header-offset ppc::allocptr)
2303  (mr dest ppc::allocptr)
2304  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits)))
2305
2306(define-ppc64-vinsn vstack-discard (()
2307                                    ((nwords :u32const)))
2308  ((:not (:pred = nwords 0))
2309   (la ppc::vsp (:apply ash nwords ppc64::word-shift) ppc::vsp)))
2310
2311
2312(define-ppc64-vinsn lcell-load (((dest :lisp))
2313                                ((cell :lcell)
2314                                 (top :lcell)))
2315  (ld dest (:apply - 
2316                   (:apply - (:apply calc-lcell-depth top) ppc64::word-size-in-bytes)
2317                   (:apply calc-lcell-offset cell)) ppc::vsp))
2318
2319(define-ppc64-vinsn vframe-load (((dest :lisp))
2320                                 ((frame-offset :u16const)
2321                                  (cur-vsp :u16const)))
2322  (ld dest (:apply - (:apply - cur-vsp ppc64::word-size-in-bytes) frame-offset) ppc::vsp))
2323
2324(define-ppc64-vinsn lcell-store (()
2325                                 ((src :lisp)
2326                                  (cell :lcell)
2327                                  (top :lcell)))
2328  (stw src (:apply - 
2329                   (:apply - (:apply calc-lcell-depth top) 4)
2330                   (:apply calc-lcell-offset cell)) ppc::vsp))
2331
2332(define-ppc64-vinsn vframe-store (()
2333                                  ((src :lisp)
2334                                   (frame-offset :u16const)
2335                                   (cur-vsp :u16const)))
2336  (std src (:apply - (:apply - cur-vsp 8) frame-offset) ppc::vsp))
2337
2338(define-ppc64-vinsn load-vframe-address (((dest :imm))
2339                                         ((offset :s16const)))
2340  (la dest offset ppc::vsp))
2341
2342(define-ppc64-vinsn copy-lexpr-argument (()
2343                                         ()
2344                                         ((temp :lisp)))
2345  (ldx temp ppc::vsp ppc::nargs)
2346  (stdu temp -8 ppc::vsp))
2347
2348;;; Boxing/unboxing of integers.
2349
2350;;; Treat the low 8 bits of VAL as an unsigned integer; set RESULT to
2351;;; the equivalent fixnum.
2352(define-ppc64-vinsn u8->fixnum (((result :imm)) 
2353                                ((val :u8)) 
2354                                ())
2355  (clrlsldi result val (- ppc64::nbits-in-word 8) ppc64::fixnumshift))
2356
2357;;; Treat the low 8 bits of VAL as a signed integer; set RESULT to the
2358;;; equivalent fixnum.
2359(define-ppc64-vinsn s8->fixnum (((result :imm)) 
2360                                ((val :s8)) 
2361                                ())
2362  (sldi result val (- ppc64::nbits-in-word 8))
2363  (sradi result result (- (- ppc64::nbits-in-word 8) ppc64::fixnumshift)))
2364
2365
2366;;; Treat the low 16 bits of VAL as an unsigned integer; set RESULT to
2367;;; the equivalent fixnum.
2368(define-ppc64-vinsn u16->fixnum (((result :imm)) 
2369                                 ((val :u16)) 
2370                                 ())
2371  (clrlsldi result val (- ppc64::nbits-in-word 16) ppc64::fixnumshift))
2372
2373;;; Treat the low 16 bits of VAL as a signed integer; set RESULT to
2374;;; the equivalent fixnum.
2375(define-ppc64-vinsn s16->fixnum (((result :imm)) 
2376                                 ((val :s16)) 
2377                                 ())
2378  (sldi result val (- ppc64::nbits-in-word 16))
2379  (sradi result result (- (- ppc64::nbits-in-word 16) ppc64::fixnumshift)))
2380
2381(define-ppc64-vinsn fixnum->s16 (((result :s16))
2382                                 ((src :imm)))
2383  (sradi result src ppc64::fixnumshift))
2384
2385(define-ppc64-vinsn s32->integer (((result :lisp))
2386                                  ((src :s32))
2387                                  ((temp :s64)))
2388  (extsw temp src)
2389  (sldi result temp ppc64::fixnumshift))
2390
2391
2392;;; A signed 64-bit untagged value can be at worst a 2-digit
2393;;; (minimal-sized) bignum.  There should be something very much like
2394;;; this that takes a stack-consed bignum result ...
2395(define-ppc64-vinsn s64->integer (((result :lisp))
2396                                  ((src :s64))
2397                                  ((crf (:crf 0)) ; a casualty
2398                                   (temp :s64)
2399                                   (header :s64)))
2400  (addo temp src src)
2401  (addo temp temp temp)
2402  (addo. result temp temp)
2403  (rotldi temp src 32)
2404  (bns+ :done)
2405  (mtxer ppc::rzero)
2406  (li header ppc64::two-digit-bignum-header)
2407  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2408  (tdlt ppc::allocptr ppc::allocbase)
2409  (std header ppc64::misc-header-offset ppc::allocptr)
2410  (mr result ppc::allocptr)
2411  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
2412  (std temp ppc64::misc-data-offset result)
2413  :done)
2414
2415
2416;;; An unsigned 32-bit untagged value is a fixnum.
2417(define-ppc64-vinsn u32->integer (((result :lisp))
2418                                  ((src :u32)))
2419  (sldi result src ppc64::fixnumshift))
2420
2421;;; An unsigned 64-bit untagged value is either a fixnum, a 2 (32-bit)
2422;;; digit bignum, or a 3 (32-bit) digit bignum.
2423(define-ppc64-vinsn u64->integer (((result :lisp))
2424                                  ((src :u64))
2425                                  ((temp :u64)
2426                                   (header :u64)
2427                                   (crf0 (:crf 0))
2428                                   (crf1 :crf)))
2429  (clrrdi. temp src (- 63 ppc64::nfixnumtagbits))
2430  (cmpdi crf1 src 0)
2431  (sldi result src ppc64::fixnumshift)
2432  (beq crf0 :done)
2433  (rotldi temp src 32)
2434  (li header ppc64::two-digit-bignum-header)
2435  (blt crf1 :three)
2436  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2437  (tdlt ppc::allocptr ppc::allocbase)
2438  (std header ppc64::misc-header-offset ppc::allocptr)
2439  (mr result ppc::allocptr)
2440  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
2441  (b :store)
2442  :three
2443  (la ppc::allocptr (- ppc64::fulltag-misc 32) ppc::allocptr)
2444  (tdlt ppc::allocptr ppc::allocbase)
2445  (std header ppc64::misc-header-offset ppc::allocptr)
2446  (mr result ppc::allocptr)
2447  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
2448  :store
2449  (std temp ppc64::misc-data-offset result)
2450  :done)
2451
2452(define-ppc64-vinsn u16->u32 (((dest :u32))
2453                              ((src :u16)))
2454  (clrlwi dest src 16))
2455
2456(define-ppc64-vinsn u8->u32 (((dest :u32))
2457                             ((src :u8)))
2458  (clrlwi dest src 24))
2459
2460
2461(define-ppc64-vinsn s16->s32 (((dest :s32))
2462                              ((src :s16)))
2463  (extsh dest src))
2464
2465(define-ppc64-vinsn s8->s32 (((dest :s32))
2466                             ((src :s8)))
2467  (extsb dest src))
2468
2469
2470;;; ... of floats ...
2471
2472;;; Heap-cons a double-float to store contents of FPREG.  Hope that we
2473;;; don't do this blindly.
2474(define-ppc64-vinsn double->heap (((result :lisp)) ; tagged as a double-float
2475                                  ((fpreg :double-float)) 
2476                                  ((header-temp :u32)))
2477  (li header-temp (arch::make-vheader ppc64::double-float.element-count ppc64::subtag-double-float))
2478  (la ppc::allocptr (- ppc64::fulltag-misc ppc64::double-float.size) ppc::allocptr)
2479  (tdlt ppc::allocptr ppc::allocbase)
2480  (std header-temp ppc64::misc-header-offset ppc::allocptr)
2481  (mr result ppc::allocptr)
2482  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
2483  (stfd fpreg ppc64::double-float.value result)  )
2484
2485
2486(define-ppc64-vinsn single->node (((result :lisp)) ; tagged as a single-float
2487                                  ((fpreg :single-float)))
2488  (stfs fpreg ppc64::tcr.single-float-convert ppc64::rcontext)
2489  (ld result  ppc64::tcr.single-float-convert ppc64::rcontext))
2490
2491
2492;;; "dest" is preallocated, presumably on a stack somewhere.
2493(define-ppc64-vinsn store-double (()
2494                                  ((dest :lisp)
2495                                   (source :double-float))
2496                                  ())
2497  (stfd source ppc64::double-float.value dest))
2498
2499(define-ppc64-vinsn get-double (((target :double-float))
2500                                ((source :lisp))
2501                                ())
2502  (lfd target ppc64::double-float.value source))
2503
2504;;; Extract a double-float value, typechecking in the process.
2505;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
2506;;; instead of replicating it ..
2507
2508(define-ppc64-vinsn get-double? (((target :double-float))
2509                                 ((source :lisp))
2510                                 ((tag :u8)
2511                                  (crf :crf)))
2512  (clrldi tag source (- ppc64::nbits-in-word ppc64::ntagbits))
2513  (cmpdi crf tag ppc64::fulltag-misc)
2514  (bne crf :do-trap)
2515  (lbz tag ppc64::misc-subtag-offset source)
2516  :do-trap
2517  (tdnei tag ppc64::subtag-double-float)
2518  (lfd target ppc64::double-float.value source))
2519
2520(define-ppc64-vinsn double-to-single (((result :single-float))
2521                                       ((arg :double-float)))
2522  (frsp result arg))
2523
2524
2525(define-ppc64-vinsn store-single (()
2526                                  ((dest :lisp)
2527                                   (source :single-float))
2528                                  ())
2529  (stfs source ppc64::tcr.single-float-convert ppc64::rcontext)
2530  (ld dest ppc64::tcr.single-float-convert ppc64::rcontext))
2531
2532(define-ppc64-vinsn get-single (((target :single-float))
2533                                ((source :lisp)))
2534  (std source ppc64::tcr.single-float-convert ppc64::rcontext)
2535  (lfs target ppc64::tcr.single-float-convert ppc64::rcontext))
2536
2537;;; ... of characters ...
2538(define-ppc64-vinsn charcode->u16 (((dest :u16))
2539                                   ((src :imm))
2540                                   ())
2541  (srdi dest src ppc64::charcode-shift))
2542
2543(define-ppc64-vinsn character->fixnum (((dest :lisp))
2544                                       ((src :lisp))
2545                                       ())
2546  (srdi dest src (- ppc64::charcode-shift ppc64::fixnumshift)))
2547
2548(define-ppc64-vinsn character->code (((dest :u32))
2549                                     ((src :lisp)))
2550  (srdi dest src ppc64::charcode-shift))
2551
2552
2553(define-ppc64-vinsn fixnum->char (((dest :lisp))
2554                                  ((src :imm))
2555                                  ((temp :u64)
2556                                   (crf0 (:crf 0))))
2557  (srdi temp src (+ ppc64::fixnumshift 1))
2558  (cmpldi temp (ash #xffff -1))
2559  (srdi temp src (+ ppc64::fixnumshift 11))
2560  (beq :bad)
2561  (cmpdi temp 27)
2562  (sldi dest src (- ppc64::charcode-shift ppc64::fixnumshift))
2563  (bne+ :ok)
2564  :bad
2565  (li dest (:apply target-nil-value))
2566  (b :done)
2567  :ok
2568  (addi dest dest ppc64::subtag-character)
2569  :done)
2570
2571(define-ppc64-vinsn code-char->char (((dest :lisp))
2572                                     ((src :imm))
2573                               ())
2574  (sldi dest src (- ppc64::charcode-shift ppc64::fixnumshift))
2575  (ori dest dest ppc64::subtag-character))
2576
2577
2578(define-ppc64-vinsn u32->char (((dest :lisp))
2579                              ((src :u32))
2580                               ())
2581  (sldi dest src ppc64::charcode-shift)
2582  (ori dest dest ppc64::subtag-character))
2583
2584;;; ... Macptrs ...
2585
2586(define-ppc64-vinsn deref-macptr (((addr :address))
2587                                  ((src :lisp))
2588                                  ())
2589  (ld addr ppc64::macptr.address src))
2590
2591(define-ppc64-vinsn set-macptr-address (()
2592                                        ((addr :address)
2593                                         (src :lisp))
2594                                        ())
2595  (std addr ppc64::macptr.address src))
2596
2597
2598(define-ppc64-vinsn macptr->heap (((dest :lisp))
2599                                  ((address :address))
2600                                  ((header :u64)))
2601  (li header (logior (ash ppc64::macptr.element-count ppc64::num-subtag-bits) ppc64::subtag-macptr))
2602  (la ppc::allocptr (- ppc64::fulltag-misc ppc64::macptr.size) ppc::allocptr)
2603  (tdlt ppc::allocptr ppc::allocbase)
2604  (std header ppc64::misc-header-offset ppc::allocptr)
2605  (mr dest ppc::allocptr)
2606  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
2607  ;; It's not necessary to zero out the domain/type fields, since newly
2608  ;; heap-allocated memory's guaranteed to be 0-filled.
2609  (std address ppc64::macptr.address dest))
2610
2611(define-ppc64-vinsn macptr->stack (((dest :lisp))
2612                                   ((address :address))
2613                                   ((header :u64)))
2614  (li header ppc64::macptr-header)
2615  (stdu ppc::tsp (- (+ 16 ppc64::macptr.size)) ppc::tsp)
2616  (std ppc::tsp 8 ppc::tsp)
2617  (std header (+ 16 ppc64::fulltag-misc ppc64::macptr.header) ppc::tsp)
2618  (std address (+ 16 ppc64::fulltag-misc ppc64::macptr.address) ppc::tsp)
2619  ;; It -is- necessary to zero out the domain/type fields here, since
2620  ;; stack-allocated memory isn't guaranteed to be 0-filled.
2621  (std ppc::rzero (+ 16 ppc64::fulltag-misc ppc64::macptr.domain) ppc::tsp)
2622  (std ppc::rzero (+ 16 ppc64::fulltag-misc ppc64::macptr.type) ppc::tsp)
2623  (la dest (+ 16 ppc64::fulltag-misc) ppc::tsp))
2624
2625 
2626(define-ppc64-vinsn adjust-stack-register (()
2627                                           ((reg t)
2628                                            (amount :s16const)))
2629  (la reg amount reg))
2630
2631(define-ppc64-vinsn adjust-vsp (()
2632                                ((amount :s16const)))
2633  (la ppc::vsp amount ppc::vsp))
2634
2635(define-ppc64-vinsn adjust-sp (()
2636                               ((amount :s16const)))
2637  (la ppc::sp amount ppc::sp))
2638
2639;;; Arithmetic on fixnums & unboxed numbers
2640
2641(define-ppc64-vinsn u64-lognot (((dest :u64))
2642                                ((src :u64))
2643                                ())
2644  (not dest src))
2645
2646(define-ppc64-vinsn fixnum-lognot (((dest :imm))
2647                                   ((src :imm))
2648                                   ((temp :u64)))
2649  (not temp src)
2650  (rldicr dest temp 0 (- 63 ppc64::nfixnumtagbits)))
2651
2652
2653(define-ppc64-vinsn negate-fixnum-overflow-inline (((dest :lisp))
2654                                                   ((src :imm))
2655                                                   ((unboxed :s64)
2656                                                    (header :u64)))
2657  (nego. dest src)
2658  (bns+ :done)
2659  (mtxer ppc::rzero)
2660  (sradi unboxed dest ppc64::fixnumshift)
2661  (li header ppc64::two-digit-bignum-header)
2662  (rotldi unboxed unboxed 32)
2663  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 ppc64::fixnumshift))))
2664  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2665  (tdlt ppc::allocptr ppc::allocbase)
2666  (std header ppc64::misc-header-offset ppc::allocptr)
2667  (mr dest ppc::allocptr)
2668  (clrrdi ppc::allocptr ppc::allocptr ppc64::ntagbits)
2669  (std unboxed ppc64::misc-data-offset dest)
2670  :done)
2671
2672(define-ppc64-vinsn negate-fixnum-overflow-ool (()
2673                                                ((src :imm))
2674                                                )
2675  (nego. ppc::arg_z src)
2676  (bsola- .SPfix-overflow)
2677  :done)
2678 
2679                                                 
2680                                       
2681(define-ppc64-vinsn negate-fixnum-no-ovf (((dest :lisp))
2682                                          ((src :imm)))
2683 
2684  (neg dest src))
2685 
2686
2687(define-ppc64-vinsn logior-high (((dest :imm))
2688                                 ((src :imm)
2689                                  (high :u16const)))
2690  (oris dest src high))
2691
2692(define-ppc64-vinsn logior-low (((dest :imm))
2693                                ((src :imm)
2694                                 (low :u16const)))
2695  (ori dest src low))
2696
2697                           
2698                           
2699(define-ppc64-vinsn %logior2 (((dest :imm))
2700                              ((x :imm)
2701                               (y :imm))
2702                              ())
2703  (or dest x y))
2704
2705(define-ppc64-vinsn logand-high (((dest :imm))
2706                                 ((src :imm)
2707                                  (high :u16const))
2708                                 ((crf0 (:crf 0))))
2709  (andis. dest src high))
2710
2711(define-ppc64-vinsn logand-low (((dest :imm))
2712                                ((src :imm)
2713                                 (low :u16const))
2714                                ((crf0 (:crf 0))))
2715  (andi. dest src low))
2716
2717
2718(define-ppc64-vinsn %logand2 (((dest :imm))
2719                              ((x :imm)
2720                               (y :imm))
2721                              ())
2722  (and dest x y))
2723
2724(define-ppc64-vinsn clear-left (((dest :imm))
2725                                ((src :imm)
2726                                 (nbits :s8const)))
2727  (rldicl dest src 0 (:apply 1+ nbits)))
2728
2729(define-ppc64-vinsn clear-right (((dest :imm))
2730                                 ((src :imm)
2731                                  (nbits :s8const)))
2732  (rldicr dest src 0 (:apply - 63 nbits)))
2733
2734(define-ppc64-vinsn logxor-high (((dest :imm))
2735                                 ((src :imm)
2736                                  (high :u16const)))
2737  (xoris dest src high))
2738
2739(define-ppc64-vinsn logxor-low (((dest :imm))
2740                                ((src :imm)
2741                                 (low :u16const)))
2742  (xori dest src low))
2743
2744                           
2745
2746(define-ppc64-vinsn %logxor2 (((dest :imm))
2747                              ((x :imm)
2748                               (y :imm))
2749                              ())
2750  (xor dest x y))
2751
2752(define-ppc64-vinsn %ilsl (((dest :imm))
2753                           ((count :imm)
2754                            (src :imm))
2755                           ((temp :u32)
2756                            (crx :crf)))
2757  (cmpdi crx count (ash 63 ppc64::fixnumshift))
2758  (srdi temp count ppc64::fixnumshift)
2759  (sld dest src temp)
2760  (ble+ crx :foo)
2761  (li dest 0)
2762  :foo)
2763
2764(define-ppc64-vinsn %ilsl-c (((dest :imm))
2765                             ((count :u8const)
2766                              (src :imm)))
2767  ;; Hard to use ppcmacroinstructions that expand into expressions
2768  ;; involving variables.
2769  (rldicr dest src count (:apply - ppc64::least-significant-bit count)))
2770
2771
2772(define-ppc64-vinsn %ilsr-c (((dest :imm))
2773                             ((count :u8const)
2774                              (src :imm))
2775                             ((temp :s64)))
2776  (rldicl temp src (:apply - 64 count) count)
2777  (rldicr dest temp 0 (- 63 ppc64::fixnumshift)))
2778
2779
2780
2781;;; 68k did the right thing for counts < 64 - fixnumshift but not if greater
2782;;; so load-byte fails in 3.0 also
2783
2784
2785(define-ppc64-vinsn %iasr (((dest :imm))
2786                           ((count :imm)
2787                            (src :imm))
2788                           ((temp :s32)
2789                            (crx :crf)))
2790  (cmpdi crx count (ash 63 ppc64::fixnumshift))
2791  (sradi temp count ppc64::fixnumshift)
2792  (srad temp src temp)
2793  (ble+ crx :foo)
2794  (sradi temp src 63)
2795  :foo
2796  (rldicr dest temp 0 (- 63 ppc64::fixnumshift)))
2797
2798(define-ppc64-vinsn %iasr-c (((dest :imm))
2799                             ((count :u8const)
2800                              (src :imm))
2801                             ((temp :s32)))
2802  (sradi temp src count)
2803  (rldicr dest temp 0 (- 63 ppc64::fixnumshift)))
2804
2805(define-ppc64-vinsn %ilsr (((dest :imm))
2806                           ((count :imm)
2807                            (src :imm))
2808                           ((temp :s32)
2809                            (crx :crf)))
2810  (cmpdi crx count (ash 63 ppc64::fixnumshift))
2811  (srdi temp count ppc64::fixnumshift)
2812  (srd temp src temp)
2813  (rldicr dest temp 0 (- 63 ppc64::fixnumshift))
2814  (ble+ crx :foo)
2815  (li dest 0)
2816  :foo 
2817  )
2818
2819(define-ppc64-vinsn natural-shift-left (((dest :u64))
2820                                        ((src :u64)
2821                                         (count :u8const)))
2822  (rldicr dest src count  (:apply - 63 count)))
2823
2824(define-ppc64-vinsn natural-shift-right (((dest :u64))
2825                                         ((src :u64)
2826                                          (count :u8const)))
2827  (rldicr dest src (:apply - 64 count) count))
2828
2829(define-ppc64-vinsn sign-extend-halfword (((dest :imm))
2830                                          ((src :imm)))
2831  (sldi dest src (- 48 ppc64::fixnumshift))
2832  (sradi dest dest (- 48 ppc64::fixnumshift)))
2833
2834
2835
2836(define-ppc64-vinsn fixnum-add (((dest t))
2837                                ((x t)
2838                                 (y t)))
2839  (add dest x y))
2840
2841
2842(define-ppc64-vinsn fixnum-add-overflow-ool (()
2843                                             ((x :imm)
2844                                              (y :imm))
2845                                             ((cr0 (:crf 0))))
2846  (addo. ppc::arg_z x y)
2847  (bsola- .SPfix-overflow))
2848
2849(define-ppc64-vinsn fixnum-add-overflow-inline (((dest :lisp))
2850                                                ((x :imm)
2851                                                 (y :imm))
2852                                                ((cr0 (:crf 0))
2853                                                 (unboxed :s64)
2854                                                 (header :u64)))
2855  (addo. dest x y)
2856  (bns+ cr0 :done)
2857  (mtxer ppc::rzero)
2858  (sradi unboxed dest ppc64::fixnumshift)
2859  (li header ppc64::two-digit-bignum-header)
2860  (rotldi unboxed unboxed 32)
2861  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 ppc64::fixnumshift))))
2862  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2863  (tdlt ppc::allocptr ppc::allocbase)
2864  (std header ppc64::misc-header-offset ppc::allocptr)
2865  (mr dest ppc::allocptr)
2866  (clrrdi ppc::allocptr ppc::allocptr ppc64::ntagbits)
2867  (std unboxed ppc64::misc-data-offset dest)
2868  :done)
2869
2870(define-ppc64-vinsn fixnum-add-overflow-inline-skip (((dest :lisp))
2871                                                     ((x :imm)
2872                                                      (y :imm)
2873                                                      (done :label))
2874                                                     ((cr0 (:crf 0))
2875                                                      (unboxed :s64)
2876                                                      (header :u64)))
2877  (addo. dest x y)
2878  (bns+ cr0 done)
2879  (mtxer ppc::rzero)
2880  (sradi unboxed dest ppc64::fixnumshift)
2881  (li header ppc64::two-digit-bignum-header)
2882  (rotldi unboxed unboxed 32)
2883  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 ppc64::fixnumshift))))
2884  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2885  (tdlt ppc::allocptr ppc::allocbase)
2886  (std header ppc64::misc-header-offset ppc::allocptr)
2887  (mr dest ppc::allocptr)
2888  (clrrdi ppc::allocptr ppc::allocptr ppc64::ntagbits)
2889  (std unboxed ppc64::misc-data-offset dest)
2890  (b done))
2891 
2892
2893 
2894
2895;;;  (setq dest (- x y))
2896(define-ppc64-vinsn fixnum-sub (((dest t))
2897                                ((x t)
2898                                 (y t)))
2899  (subf dest y x))
2900
2901(define-ppc64-vinsn fixnum-sub-from-constant (((dest :imm))
2902                                              ((x :s16const)
2903                                               (y :imm)))
2904  (subfic dest y (:apply ash x ppc64::fixnumshift)))
2905
2906
2907
2908
2909(define-ppc64-vinsn fixnum-sub-overflow-ool (()
2910                                             ((x :imm)
2911                                              (y :imm)))
2912  (subo. ppc::arg_z x y)
2913  (bsola- .SPfix-overflow))
2914
2915(define-ppc64-vinsn fixnum-sub-overflow-inline (((dest :lisp))
2916                                                ((x :imm)
2917                                                 (y :imm))
2918                                                ((cr0 (:crf 0))
2919                                                 (unboxed :s64)
2920                                                 (header :u64)))
2921  (subo. dest x y)
2922  (bns+ cr0 :done)
2923  (mtxer ppc::rzero)
2924  (sradi unboxed dest ppc64::fixnumshift)
2925  (li header ppc64::two-digit-bignum-header)
2926  (rotldi unboxed unboxed 32)
2927  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 ppc64::fixnumshift))))
2928  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2929  (tdlt ppc::allocptr ppc::allocbase)
2930  (std header ppc64::misc-header-offset ppc::allocptr)
2931  (mr dest ppc::allocptr)
2932  (clrrdi ppc::allocptr ppc::allocptr ppc64::ntagbits)
2933  (std unboxed ppc64::misc-data-offset dest)
2934  :done)
2935
2936(define-ppc64-vinsn fixnum-sub-overflow-inline-skip (((dest :lisp))
2937                                                     ((x :imm)
2938                                                      (y :imm)
2939                                                      (done :label))
2940                                                     ((cr0 (:crf 0))
2941                                                      (unboxed :s64)
2942                                                      (header :u64)))
2943  (subo. dest x y)
2944  (bns+ cr0 done)
2945  (mtxer ppc::rzero)
2946  (sradi unboxed dest ppc64::fixnumshift)
2947  (li header ppc64::two-digit-bignum-header)
2948  (rotldi unboxed unboxed 32)
2949  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 ppc64::fixnumshift))))
2950  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2951  (tdlt ppc::allocptr ppc::allocbase)
2952  (std header ppc64::misc-header-offset ppc::allocptr)
2953  (mr dest ppc::allocptr)
2954  (clrrdi ppc::allocptr ppc::allocptr ppc64::ntagbits)
2955  (std unboxed ppc64::misc-data-offset dest)
2956  (b done))
2957
2958;;; This is, of course, also "subtract-immediate."
2959(define-ppc64-vinsn add-immediate (((dest t))
2960                                   ((src t)
2961                                    (upper :u32const)
2962                                    (lower :u32const)))
2963  ((:not (:pred = upper 0))
2964   (addis dest src upper)
2965   ((:not (:pred = lower 0))
2966    (addi dest dest lower)))
2967  ((:and (:pred = upper 0) (:not (:pred = lower 0)))
2968   (addi dest src lower)))
2969
2970;This must unbox one reg, but hard to tell which is better.
2971;(The one with the smaller absolute value might be)
2972(define-ppc64-vinsn multiply-fixnums (((dest :imm))
2973                                      ((a :imm)
2974                                       (b :imm))
2975                                      ((unboxed :s32)))
2976  (sradi unboxed b ppc64::fixnumshift)
2977  (mulld dest a unboxed))
2978
2979(define-ppc64-vinsn multiply-immediate (((dest :imm))
2980                                        ((boxed :imm)
2981                                         (const :s16const)))
2982  (mulli dest boxed const))
2983
2984;;; Mask out the code field of a base character; the result
2985;;; should be EXACTLY = to subtag-base-char
2986(define-ppc64-vinsn mask-base-char (((dest :u32))
2987                                    ((src :imm)))
2988  (clrldi dest src (- ppc64::nbits-in-word ppc64::num-subtag-bits)))
2989
2990;;; Set dest (of type :s64!) to 0 iff VAL is an istruct of type TYPE
2991(define-ppc64-vinsn istruct-typep (((dest :s64))
2992                                   ((val :lisp)
2993                                    (type :lisp))
2994                                   ((crf :crf)
2995                                    (temp :lisp)))
2996  (clrldi dest val (- ppc64::nbits-in-word ppc64::ntagbits))
2997  (cmpdi crf dest ppc64::fulltag-misc)
2998  (li dest -1)
2999  (bne crf :done)
3000  (lbz dest ppc64::misc-subtag-offset val)
3001  (cmpdi crf dest ppc64::subtag-istruct)
3002  (bne crf :done)
3003  (ld temp ppc64::misc-data-offset val)
3004  (subf dest type temp)
3005  :done)
3006                             
3007;;; Boundp, fboundp stuff.
3008(define-ppc64-vinsn (ref-symbol-value :call :subprim-call)
3009    (((val :lisp))
3010     ((sym (:lisp (:ne val)))))
3011  (bla .SPspecrefcheck))
3012
3013(define-ppc64-vinsn ref-symbol-value-inline (((dest :lisp))
3014                                              ((src (:lisp (:ne dest))))
3015                                              ((table :imm)
3016                                               (idx :imm)))
3017  (ld idx ppc64::symbol.binding-index src)
3018  (ld table ppc64::tcr.tlb-limit ppc64::rcontext)
3019  (cmpd idx table)
3020  (ld table ppc64::tcr.tlb-pointer ppc64::rcontext)
3021  (bge :symbol)
3022  (ldx dest table idx)
3023  (cmpdi dest ppc64::subtag-no-thread-local-binding)
3024  (bne :done)
3025  :symbol
3026  (ld dest ppc64::symbol.vcell src)
3027  :done
3028  (tdeqi dest ppc64::unbound-marker))
3029
3030(define-ppc64-vinsn (%ref-symbol-value :call :subprim-call)
3031    (((val :lisp))
3032     ((sym (:lisp (:ne val)))))
3033  (bla .SPspecref))
3034
3035(define-ppc64-vinsn %ref-symbol-value-inline (((dest :lisp))
3036                                              ((src (:lisp (:ne dest))))
3037                                              ((table :imm)
3038                                               (idx :imm)))
3039  (ld idx ppc64::symbol.binding-index src)
3040  (ld table ppc64::tcr.tlb-limit ppc64::rcontext)
3041  (cmpd idx table)
3042  (ld table ppc64::tcr.tlb-pointer ppc64::rcontext)
3043  (bge :symbol)
3044  (ldx dest table idx)
3045  (cmpdi dest ppc64::subtag-no-thread-local-binding)
3046  (bne :done)
3047  :symbol
3048  (ld dest ppc64::symbol.vcell src)
3049  :done
3050  )
3051
3052(define-ppc64-vinsn (setq-special :call :subprim-call)
3053    (()
3054     ((sym :lisp)
3055      (val :lisp)))
3056  (bla .SPspecset))
3057
3058
3059(define-ppc64-vinsn symbol-function (((val :lisp))
3060                                     ((sym (:lisp (:ne val))))
3061                                     ((crf :crf)
3062                                      (tag :u32)))
3063  (ld val ppc64::symbol.fcell sym)
3064  (clrldi tag val (- 64 ppc64::ntagbits))
3065  (cmpdi crf tag ppc64::fulltag-misc)
3066  (bne- crf :bad)
3067  (lbz tag ppc64::misc-subtag-offset val)
3068  (cmpdi crf tag ppc64::subtag-function)
3069  (beq+ crf :good)
3070  :bad 
3071  (uuo_interr arch::error-udf sym)
3072  :good)
3073
3074(define-ppc64-vinsn (temp-push-unboxed-word :push :word :tsp)
3075    (()
3076     ((w :u64)))
3077  (stdu ppc::tsp -32 ppc::tsp)
3078  (std ppc::tsp 8 ppc::tsp)
3079  (std w 16 ppc::tsp))
3080
3081(define-ppc64-vinsn (temp-pop-unboxed-word :pop :word :tsp)
3082    (((w :u64))
3083     ())
3084  (ld w 16 ppc::tsp)
3085  (la ppc::tsp 32 ppc::tsp))
3086
3087(define-ppc64-vinsn (temp-push-double-float :push :doubleword :tsp)
3088    (((d :double-float))
3089     ())
3090  (stdu ppc::tsp -32 ppc::tsp)
3091  (std ppc::tsp 8 ppc::tsp)
3092  (stfd d 16 ppc::tsp))
3093
3094(define-ppc64-vinsn (temp-pop-double-float :pop :doubleword :tsp)
3095    (()
3096     ((d :double-float)))
3097  (lfd d 16 ppc::tsp)
3098  (la ppc::tsp 32 ppc::tsp))
3099
3100(define-ppc64-vinsn (temp-push-single-float :push :word :tsp)
3101    (((s :single-float))
3102     ())
3103  (stdu ppc::tsp -32 ppc::tsp)
3104  (std ppc::tsp 8 ppc::tsp)
3105  (stfs s 16 ppc::tsp))
3106
3107(define-ppc64-vinsn (temp-pop-single-float :pop :word :tsp)
3108    (()
3109     ((s :single-float)))
3110  (lfs s 16 ppc::tsp)
3111  (la ppc::tsp 32 ppc::tsp))
3112
3113
3114(define-ppc64-vinsn (save-nvrs-individually :push :node :vsp :multiple)
3115    (()
3116     ((first :u8const)))
3117  (stdu ppc::save0 -8 ppc::vsp)
3118  ((:pred <= first ppc::save1)
3119   (stdu ppc::save1 -8 ppc::vsp)
3120   ((:pred <= first ppc::save2)
3121    (stdu ppc::save2 -8 ppc::vsp)
3122    ((:pred <= first ppc::save3)
3123     (stdu ppc::save3 -8 ppc::vsp)
3124     ((:pred <= first ppc::save4)
3125      (stdu ppc::save4 -8 ppc::vsp)
3126      ((:pred <= first ppc::save5)
3127       (stdu ppc::save5 -8 ppc::vsp)
3128       ((:pred <= first ppc::save6)
3129        (stdu ppc::save6 -8 ppc::vsp)
3130        ((:pred = first ppc::save7)
3131         (stdu ppc::save7 -8 ppc::vsp)))))))))
3132
3133(define-ppc64-vinsn (save-nvrs :push :node :vsp :multiple)
3134    (()
3135     ((first :u8const)))
3136  ;; There's no "stmd" instruction.
3137  (stdu ppc::save0 -8 ppc::vsp)
3138  ((:pred <= first ppc::save1)
3139   (stdu ppc::save1 -8 ppc::vsp)
3140   ((:pred <= first ppc::save2)
3141    (stdu ppc::save2 -8 ppc::vsp)
3142    ((:pred <= first ppc::save3)
3143     (stdu ppc::save3 -8 ppc::vsp)
3144     ((:pred <= first ppc::save4)
3145      (stdu ppc::save4 -8 ppc::vsp)
3146      ((:pred <= first ppc::save5)
3147       (stdu ppc::save5 -8 ppc::vsp)
3148       ((:pred <= first ppc::save6)
3149        (stdu ppc::save6 -8 ppc::vsp)
3150        ((:pred = first ppc::save7)
3151         (stdu ppc::save7 -8 ppc::vsp)))))))))
3152
3153
3154(define-ppc64-vinsn (restore-nvrs :pop :node :vsp :multiple)
3155    (()
3156     ((firstreg :u8const)
3157      (basereg :imm)
3158      (offset :s16const)))
3159  ((:pred = firstreg ppc::save7)
3160   (ld ppc::save7 offset basereg)
3161   (ld ppc::save6 (:apply + offset 8) basereg)
3162   (ld ppc::save5 (:apply + offset 16) basereg)
3163   (ld ppc::save4 (:apply + offset 24) basereg)
3164   (ld ppc::save3 (:apply + offset 32) basereg)
3165   (ld ppc::save2 (:apply + offset 40) basereg)
3166   (ld ppc::save1 (:apply + offset 48) basereg)
3167   (ld ppc::save0 (:apply + offset 56) basereg))
3168  ((:pred = firstreg ppc::save6)
3169   (ld ppc::save6 offset basereg)
3170   (ld ppc::save5 (:apply + offset 8) basereg)
3171   (ld ppc::save4 (:apply + offset 16) basereg)
3172   (ld ppc::save3 (:apply + offset 24) basereg)
3173   (ld ppc::save2 (:apply + offset 32) basereg)
3174   (ld ppc::save1 (:apply + offset 40) basereg)
3175   (ld ppc::save0 (:apply + offset 48) basereg))
3176  ((:pred = firstreg ppc::save5)
3177   (ld ppc::save5 offset basereg)
3178   (ld ppc::save4 (:apply + offset 8) basereg)
3179   (ld ppc::save3 (:apply + offset 16) basereg)
3180   (ld ppc::save2 (:apply + offset 24) basereg)
3181   (ld ppc::save1 (:apply + offset 32) basereg)
3182   (ld ppc::save0 (:apply + offset 40) basereg))
3183  ((:pred = firstreg ppc::save4)
3184   (ld ppc::save4 offset basereg)
3185   (ld ppc::save3 (:apply + offset 8) basereg)
3186   (ld ppc::save2 (:apply + offset 16) basereg)
3187   (ld ppc::save1 (:apply + offset 24) basereg)
3188   (ld ppc::save0 (:apply + offset 32) basereg))
3189  ((:pred = firstreg ppc::save3)
3190   (ld ppc::save3 offset basereg)
3191   (ld ppc::save2 (:apply + offset 8) basereg)
3192   (ld ppc::save1 (:apply + offset 16) basereg)
3193   (ld ppc::save0 (:apply + offset 24) basereg))
3194  ((:pred = firstreg ppc::save2)
3195   (ld ppc::save2 offset basereg)
3196   (ld ppc::save1 (:apply + offset 8) basereg)
3197   (ld ppc::save0 (:apply + offset 16) basereg))
3198  ((:pred = firstreg ppc::save1)
3199   (ld ppc::save1 offset basereg)
3200   (ld ppc::save0 (:apply + offset 8) basereg))
3201  ((:pred = firstreg ppc::save0)
3202   (ld ppc::save0 offset basereg)))
3203
3204(define-ppc64-vinsn %current-frame-ptr (((dest :imm))
3205                                        ())
3206  (mr dest ppc::sp))
3207
3208(define-ppc64-vinsn %current-tcr (((dest :imm))
3209                                  ())
3210  (mr dest ppc64::rcontext))
3211
3212(define-ppc64-vinsn (dpayback :call :subprim-call) (()
3213                                                    ((n :s16const))
3214                                                    ((temp (:u32 #.ppc::imm0))))
3215  ((:pred > n 1)
3216   (li temp n)
3217   (bla .SPunbind-n))
3218  ((:pred = n 1)
3219   (bla .SPunbind)))
3220
3221(define-ppc64-vinsn zero-double-float-register 
3222    (((dest :double-float))
3223     ())
3224  (fmr dest ppc::fp-zero))
3225
3226(define-ppc64-vinsn zero-single-float-register 
3227    (((dest :single-float))
3228     ())
3229  (fmr dest ppc::fp-zero))
3230
3231(define-ppc64-vinsn load-double-float-constant
3232    (((dest :double-float))
3233     ((high :u32)
3234      (low :u32)))
3235  (stw high -8 ppc::sp)
3236  (stw low -4 ppc::sp)
3237  (lfd dest -8 ppc::sp))
3238
3239(define-ppc64-vinsn load-single-float-constant
3240    (((dest :single-float))
3241     ((src t)))
3242  (stw src -4 ppc::sp)
3243  (lfs dest -4 ppc::sp))
3244
3245(define-ppc64-vinsn load-indexed-node (((node :lisp))
3246                                       ((base :lisp)
3247                                        (offset :s16const)))
3248  (ld node offset base))
3249
3250(define-ppc64-vinsn recover-saved-vsp (((dest :imm))
3251                                       ())
3252  (ld dest ppc64::lisp-frame.savevsp ppc::sp))
3253
3254
3255(define-ppc64-vinsn check-exact-nargs (()
3256                                       ((n :u16const)))
3257  (tdnei ppc::nargs (:apply ash n ppc64::word-shift)))
3258
3259(define-ppc64-vinsn check-min-nargs (()
3260                                     ((min :u16const)))
3261  (tdllti ppc::nargs (:apply ash min ppc64::word-shift)))
3262
3263(define-ppc64-vinsn check-max-nargs (()
3264                                     ((max :u16const)))
3265  (tdlgti ppc::nargs (:apply ash max ppc64::word-shift)))
3266
3267;;; Save context and establish FN.  The current VSP is the the
3268;;; same as the caller's, e.g., no arguments were vpushed.
3269(define-ppc64-vinsn save-lisp-context-vsp (()
3270                                           ()
3271                                           ((imm :u64)))
3272  (stdu ppc::sp (- ppc64::lisp-frame.size) ppc::sp)
3273  (std ppc::fn ppc64::lisp-frame.savefn ppc::sp)
3274  (std ppc::loc-pc ppc64::lisp-frame.savelr ppc::sp)
3275  (std ppc::vsp ppc64::lisp-frame.savevsp ppc::sp)
3276  (mr ppc::fn ppc::nfn)
3277  ;; Do a stack-probe ...
3278  (ld imm ppc64::tcr.cs-limit ppc64::rcontext)
3279  (tdllt ppc::sp imm))
3280
3281;;; Do the same thing via a subprim call.
3282(define-ppc64-vinsn (save-lisp-context-vsp-ool :call :subprim-call)
3283    (()
3284     ()
3285     ((imm (:u64 #.ppc::imm0))))
3286  (bla .SPsavecontextvsp))
3287
3288(define-ppc64-vinsn save-lisp-context-offset (()
3289                                              ((nbytes-vpushed :u16const))
3290                                              ((imm :u64)))
3291  (la imm nbytes-vpushed ppc::vsp)
3292  (stdu ppc::sp (- ppc64::lisp-frame.size) ppc::sp)
3293  (std ppc::fn ppc64::lisp-frame.savefn ppc::sp)
3294  (std ppc::loc-pc ppc64::lisp-frame.savelr ppc::sp)
3295  (std imm ppc64::lisp-frame.savevsp ppc::sp)
3296  (mr ppc::fn ppc::nfn)
3297  ;; Do a stack-probe ...
3298  (ld imm ppc64::tcr.cs-limit ppc64::rcontext)
3299  (tdllt ppc::sp imm))
3300
3301(define-ppc64-vinsn save-lisp-context-offset-ool (()
3302                                                  ((nbytes-vpushed :u16const))
3303                                                  ((imm (:u64 #.ppc::imm0))))
3304  (li imm nbytes-vpushed)
3305  (bla .SPsavecontext0))
3306
3307
3308(define-ppc64-vinsn save-lisp-context-lexpr (()
3309                                             ()
3310                                             ((imm :u64)))
3311  (stdu ppc::sp (- ppc64::lisp-frame.size) ppc::sp)
3312  (std ppc::rzero ppc64::lisp-frame.savefn ppc::sp)
3313  (std ppc::loc-pc ppc64::lisp-frame.savelr ppc::sp)
3314  (std ppc::vsp ppc64::lisp-frame.savevsp ppc::sp)
3315  (mr ppc::fn ppc::nfn)
3316  ;; Do a stack-probe ...
3317  (ld imm ppc64::tcr.cs-limit ppc64::rcontext)
3318  (tdllt ppc::sp imm))
3319 
3320(define-ppc64-vinsn save-cleanup-context (()
3321                                          ())
3322  ;; SP was this deep just a second ago, so no need to do a stack-probe.
3323  (mflr ppc::loc-pc)
3324  (stdu ppc::sp (- ppc64::lisp-frame.size) ppc::sp)
3325  (std ppc::rzero ppc64::lisp-frame.savefn ppc::sp)
3326  (std ppc::loc-pc ppc64::lisp-frame.savelr ppc::sp)
3327  (std ppc::vsp ppc64::lisp-frame.savevsp ppc::sp))
3328
3329;;; Vpush the argument registers.  We got at least "min-fixed" args;
3330;;; that knowledge may help us generate better code.
3331(define-ppc64-vinsn (save-lexpr-argregs :call :subprim-call)
3332    (()
3333     ((min-fixed :u16const))
3334     ((crfx :crf)
3335      (crfy :crf)
3336      (entry-vsp (:u64 #.ppc::imm0))
3337      (arg-temp :u64)))
3338  ((:pred >= min-fixed $numppcargregs)
3339   (stdu ppc::arg_x -8 ppc::vsp)
3340   (stdu ppc::arg_y -8 ppc::vsp)
3341   (stdu ppc::arg_z -8 ppc::vsp))
3342  ((:pred = min-fixed 2)                ; at least 2 args
3343   (cmpldi crfx ppc::nargs (ash 2 ppc64::word-shift))
3344   (beq crfx :yz2)                      ; skip arg_x if exactly 2
3345   (stdu ppc::arg_x -8 ppc::vsp)
3346   :yz2
3347   (stdu ppc::arg_y -8 ppc::vsp)
3348   (stdu ppc::arg_z -8 ppc::vsp))
3349  ((:pred = min-fixed 1)                ; at least one arg
3350   (cmpldi crfx ppc::nargs (ash 2 ppc64::word-shift))
3351   (blt crfx :z1)                       ; branch if exactly one
3352   (beq crfx :yz1)                      ; branch if exactly two
3353   (stdu ppc::arg_x -8 ppc::vsp)
3354   :yz1
3355   (stdu ppc::arg_y -8 ppc::vsp)
3356   :z1
3357   (stdu ppc::arg_z -8 ppc::vsp))
3358  ((:pred = min-fixed 0)
3359   (cmpldi crfx ppc::nargs (ash 2 ppc64::word-shift))
3360   (cmpldi crfy ppc::nargs 0)
3361   (beq crfx :yz0)                      ; exactly two
3362   (beq crfy :none)                     ; exactly zero
3363   (blt crfx :z0)                       ; one
3364                                        ; Three or more ...
3365   (stdu ppc::arg_x -8 ppc::vsp)
3366   :yz0
3367   (stdu ppc::arg_y -8 ppc::vsp)
3368   :z0
3369   (stdu ppc::arg_z -8 ppc::vsp)
3370   :none
3371   )
3372  ((:pred = min-fixed 0)
3373   (stdu ppc::nargs -8 ppc::vsp))
3374  ((:not (:pred = min-fixed 0))
3375   (subi arg-temp ppc::nargs (:apply ash min-fixed ppc64::word-shift))
3376   (stdu arg-temp -8 ppc::vsp))
3377  (add entry-vsp ppc::vsp ppc::nargs)
3378  (la entry-vsp 8 entry-vsp)
3379  (bla .SPlexpr-entry))
3380
3381
3382(define-ppc64-vinsn (jump-return-pc :jumpLR)
3383    (()
3384     ())
3385  (blr))
3386
3387(define-ppc64-vinsn (restore-full-lisp-context :lispcontext :pop :csp :lrRestore)
3388    (()
3389     ())
3390  (ld ppc::loc-pc ppc64::lisp-frame.savelr ppc::sp)
3391  (ld ppc::vsp ppc64::lisp-frame.savevsp ppc::sp)
3392  (ld ppc::fn ppc64::lisp-frame.savefn ppc::sp)
3393  (mtlr ppc::loc-pc)
3394  (la ppc::sp ppc64::lisp-frame.size ppc::sp))
3395
3396(define-ppc64-vinsn (restore-full-lisp-context-ool :lispcontext :pop :csp :lrRestore)
3397    (()
3398     ())
3399  (bla .SPrestorecontext)
3400  (mtlr ppc::loc-pc))
3401
3402(define-ppc64-vinsn (popj :lispcontext :pop :csp :lrRestore :jumpLR)
3403    (() 
3404     ())
3405  (ba .SPpopj))
3406
3407;;; Exiting from an UNWIND-PROTECT cleanup is similar to
3408;;; (and a little simpler than) returning from a function.
3409(define-ppc64-vinsn restore-cleanup-context (()
3410                                             ())
3411  (ld ppc::loc-pc ppc64::lisp-frame.savelr ppc::sp)
3412  (mtlr ppc::loc-pc)
3413  (la ppc::sp ppc64::lisp-frame.size ppc::sp))
3414
3415
3416
3417(define-ppc64-vinsn default-1-arg (()
3418                                   ((min :u16const))
3419                                   ((crf :crf)))
3420  (cmpldi crf ppc::nargs (:apply ash min ppc64::word-shift))
3421  (bne crf :done)
3422  ((:pred >= min 3)
3423   (stdu ppc::arg_x -8 ppc::vsp))
3424  ((:pred >= min 2)
3425   (mr ppc::arg_x ppc::arg_y))
3426  ((:pred >= min 1)
3427   (mr ppc::arg_y ppc::arg_z))
3428  (li ppc::arg_z (:apply target-nil-value))
3429  :done)
3430
3431(define-ppc64-vinsn default-2-args (()
3432                                    ((min :u16const))
3433                                    ((crf :crf)))
3434  (cmpldi crf ppc::nargs (:apply ash (:apply 1+ min) ppc64::word-shift))
3435  (bgt crf :done)
3436  (beq crf :one)
3437  ;; We got "min" args; arg_y & arg_z default to nil
3438  ((:pred >= min 3)
3439   (stdu ppc::arg_x -8 ppc::vsp))   
3440  ((:pred >= min 2)
3441   (stdu ppc::arg_y -8 ppc::vsp))
3442  ((:pred >= min 1)
3443   (mr ppc::arg_x ppc::arg_z))
3444  (li ppc::arg_y (:apply target-nil-value))
3445  (b :last)
3446  :one
3447  ;; We got min+1 args: arg_y was supplied, arg_z defaults to nil.
3448  ((:pred >= min 2)
3449   (stdu ppc::arg_x -8 ppc::vsp))
3450  ((:pred >= min 1)
3451   (mr ppc::arg_x ppc::arg_y))
3452  (mr ppc::arg_y ppc::arg_z)
3453  :last
3454  (li ppc::arg_z (:apply target-nil-value))
3455  :done)
3456
3457(define-ppc64-vinsn default-3-args (()
3458                                    ((min :u16const))
3459                                    ((crfx :crf)
3460                                     (crfy :crf)))
3461  (cmpldi crfx ppc::nargs (:apply ash (:apply + 2 min) ppc64::word-shift))
3462  (cmpldi crfy ppc::nargs (:apply ash min ppc64::word-shift))
3463  (bgt crfx :done)
3464  (beq crfx :two)
3465  (beq crfy :none)
3466  ;; The first (of three) &optional args was supplied.
3467  ((:pred >= min 2)
3468   (stdu ppc::arg_x -8 ppc::vsp))
3469  ((:pred >= min 1)
3470   (stdu ppc::arg_y -8 ppc::vsp))
3471  (mr ppc::arg_x ppc::arg_z)
3472  (b :last-2)
3473  :two
3474  ;; The first two (of three) &optional args were supplied.
3475  ((:pred >= min 1)
3476   (stdu ppc::arg_x -8 ppc::vsp))
3477  (mr ppc::arg_x ppc::arg_y)
3478  (mr ppc::arg_y ppc::arg_z)
3479  (b :last-1)
3480  ;; None of the three &optional args was provided.
3481  :none
3482  ((:pred >= min 3)
3483   (stdu ppc::arg_x -8 ppc::vsp))
3484  ((:pred >= min 2)
3485   (stdu ppc::arg_y -8 ppc::vsp))
3486  ((:pred >= min 1)
3487   (stdu ppc::arg_z -8 ppc::vsp))
3488  (li ppc::arg_x (:apply target-nil-value))
3489  :last-2
3490  (li ppc::arg_y (:apply target-nil-value))
3491  :last-1
3492  (li ppc::arg_z (:apply target-nil-value))
3493  :done)
3494
3495(define-ppc64-vinsn save-lr (()
3496                             ())
3497  (mflr ppc::loc-pc))
3498
3499;;; "n" is the sum of the number of required args +
3500;;; the number of &optionals. 
3501(define-ppc64-vinsn (default-optionals :call :subprim-call) (()
3502                                                             ((n :u16const)))
3503  (li ppc::imm0 (:apply ash n ppc64::word-shift))
3504  (bla .SPdefault-optional-args))
3505
3506;;; fname contains a known symbol
3507(define-ppc64-vinsn (call-known-symbol :call) (((result (:lisp ppc::arg_z)))
3508                                               ())
3509  (ld ppc::nfn ppc64::symbol.fcell ppc::fname)
3510  (ld ppc::temp0 ppc64::misc-data-offset ppc::nfn)
3511  (mtctr ppc::temp0)
3512  (bctrl))
3513
3514(define-ppc64-vinsn (jump-known-symbol :jumplr) (()
3515                                                 ())
3516  (ld ppc::nfn ppc64::symbol.fcell ppc::fname)
3517  (ld ppc::temp0 ppc64::misc-data-offset ppc::nfn)
3518  (mtctr ppc::temp0)
3519  (bctr))
3520
3521(define-ppc64-vinsn (call-known-function :call) (()
3522                                                 ())
3523  (ld ppc::temp0 ppc64::misc-data-offset ppc::nfn)
3524  (mtctr ppc::temp0)
3525  (bctrl))
3526
3527(define-ppc64-vinsn (jump-known-function :jumplr) (()
3528                                                   ())
3529  (ld ppc::temp0 ppc64::misc-data-offset ppc::nfn)
3530  (mtctr ppc::temp0)
3531  (bctr))
3532
3533(define-ppc64-vinsn %schar8 (((char :imm))
3534                             ((str :lisp)
3535                              (idx :imm))
3536                             ((imm :u32)
3537                              (cr0 (:crf 0))))
3538  (srdi imm idx ppc64::fixnumshift)
3539  (addi imm imm ppc64::misc-data-offset)
3540  (lbzx imm str imm)
3541  (rldicr imm imm ppc64::charcode-shift (- 63 ppc64::charcode-shift))
3542  (ori char imm ppc64::subtag-character))
3543
3544(define-ppc64-vinsn %schar32 (((char :imm))
3545                              ((str :lisp)
3546                               (idx :imm))
3547                              ((imm :u32)
3548                               (cr0 (:crf 0))))
3549  (srdi imm idx 1)
3550  (addi imm imm ppc64::misc-data-offset)
3551  (lwzx imm str imm)
3552  (rldicr imm imm ppc64::charcode-shift (- 63 ppc64::charcode-shift))
3553  (ori char imm ppc64::subtag-character))
3554
3555(define-ppc64-vinsn %set-schar8 (()
3556                                ((str :lisp)
3557                                 (idx :imm)
3558                                 (char :imm))
3559                                ((imm :u64)
3560                                 (imm1 :u64)
3561                                 (cr0 (:crf 0))))
3562  (srdi imm idx ppc64::fixnumshift)
3563  (addi imm imm ppc64::misc-data-offset)
3564  (srdi imm1 char ppc64::charcode-shift)
3565  (stbx imm1 str imm)
3566  )
3567
3568(define-ppc64-vinsn %set-schar32 (()
3569                                ((str :lisp)
3570                                 (idx :imm)
3571                                 (char :imm))
3572                                ((imm :u64)
3573                                 (imm1 :u64)
3574                                 (cr0 (:crf 0))))
3575  (srdi imm idx 1)
3576  (addi imm imm ppc64::misc-data-offset)
3577  (srdi imm1 char ppc64::charcode-shift)
3578  (stwx imm1 str imm)
3579  )
3580
3581(define-ppc64-vinsn %set-scharcode8 (()
3582                                     ((str :lisp)
3583                                      (idx :imm)
3584                                      (code :imm))
3585                                     ((imm :u64)
3586                                      (imm1 :u64)
3587                                      (cr0 (:crf 0))))
3588  (srdi imm idx ppc64::fixnumshift)
3589  (addi imm imm ppc64::misc-data-offset)
3590  (srdi imm1 code ppc64::fixnumshift)
3591  (stbx imm1 str imm)
3592  )
3593
3594(define-ppc64-vinsn %set-scharcode32 (()
3595                                      ((str :lisp)
3596                                       (idx :imm)
3597                                       (code :imm))
3598                                      ((imm :u64)
3599                                       (imm1 :u64)
3600                                       (cr0 (:crf 0))))
3601  (srdi imm idx 1)
3602  (addi imm imm ppc64::misc-data-offset)
3603  (srdi imm1 code ppc64::fixnumshift)
3604  (stwx imm1 str imm)
3605  )
3606
3607
3608(define-ppc64-vinsn %scharcode8 (((code :imm))
3609                                 ((str :lisp)
3610                                  (idx :imm))
3611                                 ((imm :u64)
3612                                  (cr0 (:crf 0))))
3613  (srdi imm idx ppc64::fixnumshift)
3614  (addi imm imm ppc64::misc-data-offset)
3615  (lbzx imm str imm)
3616  (sldi code imm ppc64::fixnumshift))
3617
3618(define-ppc64-vinsn %scharcode32 (((code :imm))
3619                                  ((str :lisp)
3620                                   (idx :imm))
3621                                  ((imm :u64)
3622                                   (cr0 (:crf 0))))
3623  (srdi imm idx 1)
3624  (addi imm imm ppc64::misc-data-offset)
3625  (lwzx imm str imm)
3626  (sldi code imm ppc64::fixnumshift))
3627
3628;;; Clobbers LR
3629(define-ppc64-vinsn (%debug-trap :call :subprim-call) (()
3630                                                       ())
3631  (bla .SPbreakpoint)
3632  )
3633
3634
3635(define-ppc64-vinsn eep.address (((dest t))
3636                                 ((src (:lisp (:ne dest )))))
3637  (ld dest (+ (ash 1 ppc64::word-shift) ppc64::misc-data-offset) src)
3638  (tdeqi dest (:apply target-nil-value)))
3639
3640(define-ppc64-vinsn %natural+ (((dest :u64))
3641                               ((x :u64) (y :u64)))
3642  (add dest x y))
3643
3644(define-ppc64-vinsn %natural+-c (((dest :u64))
3645                                 ((x :u64) (y :u16const)))
3646  (addi dest x y))
3647
3648(define-ppc64-vinsn %natural- (((dest :u64))
3649                               ((x :u64) (y :u64)))
3650  (sub dest x y))
3651
3652(define-ppc64-vinsn %natural--c (((dest :u64))
3653                                 ((x :u64) (y :u16const)))
3654  (subi dest x y))
3655
3656(define-ppc64-vinsn %natural-logior (((dest :u64))
3657                                     ((x :u64) (y :u64)))
3658  (or dest x y))
3659
3660(define-ppc64-vinsn %natural-logior-c (((dest :u64))
3661                                   ((x :u64) (high :u16const) (low :u16const)))
3662  ((:not (:pred = high 0))
3663   (oris dest x high))
3664  ((:not (:pred = low 0))
3665   (ori dest x low)))
3666
3667(define-ppc64-vinsn %natural-logxor (((dest :u64))
3668                                     ((x :u64) (y :u64)))
3669  (xor dest x y))
3670
3671(define-ppc64-vinsn %natural-logxor-c (((dest :u64))
3672                                       ((x :u64) (high :u16const) (low :u16const)))
3673  ((:not (:pred = high 0))
3674   (xoris dest x high))
3675  ((:not (:pred = low 0))
3676   (xori dest x low)))
3677
3678(define-ppc64-vinsn %natural-logand (((dest :u64))
3679                                     ((x :u64) (y :u64)))
3680  (and dest x y))
3681
3682(define-ppc64-vinsn %natural-logand-high-c (((dest :u64))
3683                                            ((x :u64) (high :u16const))
3684                                            ((cr0 (:crf 0))))
3685  (andis. dest x high))
3686
3687(define-ppc64-vinsn %natural-logand-low-c (((dest :u64))
3688                                           ((x :u64) (low :u16const))
3689                                           ((cr0 (:crf 0))))
3690  (andi. dest x low))
3691
3692(define-ppc64-vinsn %natural-logand-mask-c (((dest :u32))
3693                                            ((x :u32)
3694                                             (start :u8const)
3695                                             (end :u8const)))
3696  (rlwinm dest x 0 start end))
3697
3698(define-ppc64-vinsn disable-interrupts (((dest :lisp))
3699                                        ()
3700                                        ((temp :imm)
3701                                         (temp2 :imm)))
3702  (ld temp2 ppc64::tcr.tlb-pointer ppc64::rcontext)
3703  (li temp -8)
3704  (ld dest ppc64::interrupt-level-binding-index temp2)
3705  (std temp ppc64::interrupt-level-binding-index temp2))
3706
3707(define-ppc64-vinsn load-character-constant (((dest :lisp))
3708                                             ((code :u32const))
3709                                             ())
3710  (ori dest ppc::rzero (:apply logior (:apply ash (:apply logand #xff code) 8) ppc64::subtag-character))
3711  ((:not (:pred = 0 (:apply ldb (byte 16 8) code)))
3712   (oris dest dest (:apply ldb (byte 16 8) code))))
3713
3714
3715(define-ppc64-vinsn %symbol->symptr (((dest :lisp))
3716                                     ((src :lisp))
3717                                     ((tag :u8)
3718                                      (crf0 :crf)))
3719  (clrldi tag src (- ppc64::nbits-in-word ppc64::ntagbits))
3720  (cmpdi crf0 tag ppc64::fulltag-misc)
3721  (bne crf0 :do-trap)
3722  (lbz tag ppc64::misc-subtag-offset src)
3723  :do-trap
3724  (tdnei tag ppc64::subtag-symbol)
3725  ((:not (:pred =
3726                (:apply %hard-regspec-value dest)
3727                (:apply %hard-regspec-value src)))
3728   (mr dest src)))
3729
3730
3731
3732;;; Subprim calls.  Done this way for the benefit of VINSN-OPTIMIZE.
3733(defmacro define-ppc64-subprim-call-vinsn ((name &rest other-attrs) spno)
3734  `(define-ppc64-vinsn (,name :call :subprim-call ,@other-attrs) (() ())
3735    (bla ,spno)))
3736
3737(defmacro define-ppc64-subprim-jump-vinsn ((name &rest other-attrs) spno)
3738  `(define-ppc64-vinsn (,name :jumpLR ,@other-attrs) (() ())
3739    (ba ,spno)))
3740
3741(define-ppc64-subprim-jump-vinsn (restore-interrupt-level) .SPrestoreintlevel)
3742
3743(define-ppc64-subprim-call-vinsn (save-values) .SPsave-values)
3744
3745(define-ppc64-subprim-call-vinsn (recover-values)  .SPrecover-values)
3746
3747(define-ppc64-subprim-call-vinsn (add-values) .SPadd-values)
3748
3749(define-ppc64-subprim-jump-vinsn (jump-known-symbol-ool) .SPjmpsym)
3750
3751(define-ppc64-subprim-call-vinsn (call-known-symbol-ool)  .SPjmpsym)
3752
3753(define-ppc64-subprim-call-vinsn (pass-multiple-values)  .SPmvpass)
3754
3755(define-ppc64-subprim-call-vinsn (pass-multiple-values-symbol) .SPmvpasssym)
3756
3757(define-ppc64-subprim-jump-vinsn (tail-call-sym-gen) .SPtcallsymgen)
3758
3759(define-ppc64-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
3760
3761(define-ppc64-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide)
3762
3763(define-ppc64-subprim-jump-vinsn (tail-call-fn-slide) .SPtcallnfnslide)
3764
3765(define-ppc64-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
3766
3767(define-ppc64-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
3768
3769(define-ppc64-subprim-call-vinsn (funcall)  .SPfuncall)
3770
3771(define-ppc64-subprim-jump-vinsn (tail-funcall-gen) .SPtfuncallgen)
3772
3773(define-ppc64-subprim-jump-vinsn (tail-funcall-slide) .SPtfuncallslide)
3774
3775(define-ppc64-subprim-jump-vinsn (tail-funcall-vsp) .SPtfuncallvsp)
3776
3777(define-ppc64-subprim-call-vinsn (spread-lexpr)  .SPspread-lexpr-z)
3778
3779(define-ppc64-subprim-call-vinsn (spread-list)  .SPspreadargz)
3780
3781(define-ppc64-subprim-call-vinsn (pop-argument-registers)  .SPvpopargregs)
3782
3783(define-ppc64-subprim-call-vinsn (getxlong)  .SPgetXlong)
3784
3785(define-ppc64-subprim-call-vinsn (stack-cons-list)  .SPstkconslist)
3786
3787(define-ppc64-subprim-call-vinsn (list) .SPconslist)
3788
3789(define-ppc64-subprim-call-vinsn (stack-cons-list*)  .SPstkconslist-star)
3790
3791(define-ppc64-subprim-call-vinsn (list*) .SPconslist-star)
3792
3793(define-ppc64-subprim-call-vinsn (make-stack-block)  .SPmakestackblock)
3794
3795(define-ppc64-subprim-call-vinsn (make-stack-block0)  .Spmakestackblock0)
3796
3797(define-ppc64-subprim-call-vinsn (make-stack-list)  .Spmakestacklist)
3798
3799(define-ppc64-subprim-call-vinsn (make-stack-vector)  .SPmkstackv)
3800
3801(define-ppc64-subprim-call-vinsn (make-stack-gvector)  .SPstkgvector)
3802
3803(define-ppc64-subprim-call-vinsn (stack-misc-alloc)  .SPstack-misc-alloc)
3804
3805(define-ppc64-subprim-call-vinsn (stack-misc-alloc-init)  .SPstack-misc-alloc-init)
3806
3807(define-ppc64-subprim-call-vinsn (bind-nil)  .SPbind-nil)
3808
3809(define-ppc64-subprim-call-vinsn (bind-self)  .SPbind-self)
3810
3811(define-ppc64-subprim-call-vinsn (bind-self-boundp-check)  .SPbind-self-boundp-check)
3812
3813(define-ppc64-subprim-call-vinsn (bind)  .SPbind)
3814
3815(define-ppc64-subprim-jump-vinsn (nvalret :jumpLR) .SPnvalret)
3816
3817(define-ppc64-subprim-call-vinsn (nthrowvalues) .SPnthrowvalues)
3818
3819(define-ppc64-subprim-call-vinsn (nthrow1value) .SPnthrow1value)
3820
3821(define-ppc64-subprim-call-vinsn (slide-values) .SPmvslide)
3822
3823(define-ppc64-subprim-call-vinsn (macro-bind) .SPmacro-bind)
3824
3825(define-ppc64-subprim-call-vinsn (destructuring-bind-inner) .SPdestructuring-bind-inner)
3826
3827(define-ppc64-subprim-call-vinsn (destructuring-bind) .SPdestructuring-bind)
3828
3829(define-ppc64-subprim-call-vinsn (simple-keywords) .SPsimple-keywords)
3830
3831(define-ppc64-subprim-call-vinsn (keyword-args) .SPkeyword-args)
3832
3833(define-ppc64-subprim-call-vinsn (keyword-bind) .SPkeyword-bind)
3834
3835(define-ppc64-subprim-call-vinsn (stack-rest-arg) .SPstack-rest-arg)
3836
3837(define-ppc64-subprim-call-vinsn (req-stack-rest-arg) .SPreq-stack-rest-arg)
3838
3839(define-ppc64-subprim-call-vinsn (stack-cons-rest-arg) .SPstack-cons-rest-arg)
3840
3841(define-ppc64-subprim-call-vinsn (heap-rest-arg) .SPheap-rest-arg)
3842
3843(define-ppc64-subprim-call-vinsn (req-heap-rest-arg) .SPreq-heap-rest-arg)
3844
3845(define-ppc64-subprim-call-vinsn (heap-cons-rest-arg) .SPheap-cons-rest-arg)
3846
3847(define-ppc64-subprim-call-vinsn (opt-supplied-p) .SPopt-supplied-p)
3848
3849(define-ppc64-subprim-call-vinsn (gvector) .SPgvector)
3850
3851(define-ppc64-vinsn (nth-value :call :subprim-call) (((result :lisp))
3852                                                     ())
3853  (bla .SPnthvalue))
3854
3855(define-ppc64-subprim-call-vinsn (fitvals) .SPfitvals)
3856
3857(define-ppc64-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
3858
3859(define-ppc64-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
3860
3861(define-ppc64-subprim-call-vinsn (integer-sign) .SPinteger-sign)
3862
3863;;; Even though it's implemented by calling a subprim, THROW is really
3864;;; a JUMP (to a possibly unknown destination).  If the destination's
3865;;; really known, it should probably be inlined (stack-cleanup, value
3866;;; transfer & jump ...)
3867(define-ppc64-vinsn (throw :jump-unknown) (()
3868                                                 ())
3869  (bla .SPthrow))
3870
3871(define-ppc64-subprim-call-vinsn (mkcatchmv) .SPmkcatchmv)
3872
3873(define-ppc64-subprim-call-vinsn (mkcatch1v) .SPmkcatch1v)
3874
3875(define-ppc64-subprim-call-vinsn (setqsym) .SPsetqsym)
3876
3877(define-ppc64-subprim-call-vinsn (ksignalerr) .SPksignalerr)
3878
3879(define-ppc64-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
3880
3881(define-ppc64-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
3882
3883(define-ppc64-subprim-call-vinsn (mkunwind) .SPmkunwind)
3884(define-ppc64-subprim-call-vinsn (nmkunwind) .SPnmkunwind)
3885
3886(define-ppc64-subprim-call-vinsn (progvsave) .SPprogvsave)
3887
3888(define-ppc64-subprim-jump-vinsn (progvrestore) .SPprogvrestore)
3889
3890(define-ppc64-subprim-call-vinsn (eabi-syscall) .SPeabi-syscall)
3891
3892(define-ppc64-subprim-call-vinsn (misc-ref) .SPmisc-ref)
3893
3894(define-ppc64-subprim-call-vinsn (misc-set) .SPmisc-set)
3895
3896(define-ppc64-subprim-call-vinsn (gets64) .SPgets64)
3897
3898(define-ppc64-subprim-call-vinsn (getu64) .SPgetu64)
3899
3900(define-ppc64-subprim-call-vinsn (makeu64) .SPmakeu64)
3901
3902(define-ppc64-subprim-call-vinsn (makes64) .SPmakes64)
3903
3904(define-ppc64-vinsn (poweropen-syscall :call :subprim-call) (()
3905                                                          ())
3906  (stw ppc::rzero ppc64::c-frame.crsave ppc::sp)
3907  (bla .SPpoweropen-syscall))
3908
3909(define-ppc64-vinsn (poweropen-syscall-s64 :call :subprim-call) (()
3910                                                              ())
3911  (std ppc::sp ppc64::c-frame.crsave ppc::sp)
3912  (bla .SPpoweropen-syscall))
3913
3914(define-ppc64-subprim-call-vinsn (eabi-ff-call) .SPeabi-ff-call)
3915
3916(define-ppc64-subprim-call-vinsn (poweropen-ff-call) .SPpoweropen-ffcall)
3917
3918(define-ppc64-subprim-call-vinsn (poweropen-ff-call-regs) .SPpoweropen-ffcall-return-registers)
3919
3920(define-ppc64-subprim-call-vinsn (poweropen-ff-callX) .SPpoweropen-ffcallX)
3921
3922(define-ppc64-subprim-call-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
3923
3924(define-ppc64-vinsn bind-interrupt-level-0-inline (()
3925                                                   ()
3926                                                   ((tlb :imm)
3927                                                    (value :imm)
3928                                                    (link :imm)
3929                                                    (temp :imm)))
3930  (ld tlb ppc64::tcr.tlb-pointer ppc64::rcontext)
3931  (ld value ppc64::interrupt-level-binding-index tlb)
3932  (ld link ppc64::tcr.db-link ppc64::rcontext)
3933  (cmpdi value 0)
3934  (li temp ppc64::interrupt-level-binding-index)
3935  (stdu value -8 ppc::vsp)
3936  (stdu temp -8 ppc::vsp)
3937  (stdu link -8 ppc::vsp)
3938  (std ppc::rzero ppc64::interrupt-level-binding-index tlb)
3939  (std ppc::vsp  ppc64::tcr.db-link ppc64::rcontext)
3940  (beq+ :done)
3941  (mr ppc::nargs value)
3942  (bgt :do-trap)
3943  (ld ppc::nargs ppc64::tcr.interrupt-pending ppc64::rcontext)
3944  :do-trap
3945  (tdgti ppc::nargs 0)
3946  :done)
3947
3948(define-ppc64-subprim-call-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
3949
3950(define-ppc64-vinsn bind-interrupt-level-m1-inline (()
3951                                                   ()
3952                                                   ((tlb :imm)
3953                                                    (oldvalue :imm)
3954                                                    (link :imm)
3955                                                    (newvalue :imm)
3956                                                    (idx :imm)))
3957  (li newvalue (ash -1 ppc64::fixnumshift))
3958  (li idx ppc64::interrupt-level-binding-index)
3959  (ld tlb ppc64::tcr.tlb-pointer ppc64::rcontext)
3960  (ld oldvalue ppc64::interrupt-level-binding-index tlb)
3961  (ld link ppc64::tcr.db-link ppc64::rcontext)
3962  (stdu oldvalue -8 ppc::vsp)
3963  (stdu idx -8 ppc::vsp)
3964  (stdu link -8 ppc::vsp)
3965  (std newvalue ppc64::interrupt-level-binding-index tlb)
3966  (std ppc::vsp  ppc64::tcr.db-link ppc64::rcontext)
3967  :done)
3968
3969(define-ppc64-subprim-call-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
3970
3971(define-ppc64-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
3972
3973(define-ppc64-vinsn unbind-interrupt-level-inline (()
3974                                                   ()
3975                                                   ((tlb :imm)
3976                                                    (link :imm)
3977                                                    (value :imm)
3978                                                    (save-nargs :u32)
3979                                                    (crf0 :crf)
3980                                                    (crf1 :crf)))
3981  (ld tlb ppc64::tcr.tlb-pointer ppc64::rcontext)
3982  (ld value ppc64::interrupt-level-binding-index tlb)
3983  (ld link ppc64::tcr.db-link ppc64::rcontext)
3984  (cmpdi crf1 value 0)
3985  (ld value 16 link)
3986  (ld link 0 link)
3987  (cmpdi crf0 value 0)
3988  (std value ppc64::interrupt-level-binding-index tlb)
3989  (std link ppc64::tcr.db-link ppc64::rcontext)
3990  (bge crf1 :done)
3991  (blt crf0 :done)
3992  (mr save-nargs ppc::nargs)
3993  (ld ppc::nargs ppc64::tcr.interrupt-pending ppc64::rcontext)
3994  (tdgti ppc::nargs 0)
3995  (mr ppc::nargs save-nargs)
3996  :done)
3997
3998(define-ppc64-vinsn fixnum->fpr (((f :double-float))
3999                                          ((fixnum :imm))
4000                                          ((imm :s64)))
4001  (srawi imm fixnum ppc64::fixnumshift)
4002  (std imm -8 ppc::sp)
4003  (lfd f -8 ppc::sp)
4004  (fcfid f f))
4005
4006(define-ppc64-vinsn branch-unless-arg-fixnum (()
4007                                              ((arg :lisp)
4008                                               (lab :label))
4009                                              ((cr0 (:crf 0))
4010                                               (tag :u8)))
4011  (clrldi. tag arg (- ppc64::nbits-in-word ppc64::nlisptagbits))
4012  (bne cr0 lab))
4013
4014(define-ppc64-vinsn branch-unless-both-args-fixnums (()
4015                                              ((arg0 :lisp)
4016                                               (arg1 :lisp)
4017                                               (lab :label))
4018                                              ((cr0 (:crf 0))
4019                                               (tag :u8)))
4020  (clrldi tag arg0 (- ppc64::nbits-in-word ppc64::nlisptagbits))
4021  (rldimi. tag arg1 ppc64::nlisptagbits 58)
4022  (bne cr0 lab))
4023 
4024                                             
4025                                           
4026
4027;;; In case ppc64::*ppc-opcodes* was changed since this file was compiled.
4028(queue-fixup
4029 (fixup-vinsn-templates *ppc64-vinsn-templates* ppc::*ppc-opcode-numbers*))
4030
4031(provide "PPC64-VINSNS")
Note: See TracBrowser for help on using the repository browser.