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

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

Replace uses of target::nil-value with (CCL::TARGET-NIL-VALUE) and
target::t-value with (CCL::TARGET-T-VALUE).

This was very slightly hard to bootstrap (the new backend-lowmem-bias
had to be in effect and typically 0), so I'll start checking in images
in a minute.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 124.0 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 (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;;; an object is of type (SIGNED-BYTE 32) iff
1297;;; a) it's of type (SIGNED-BYTE 32)
1298;;; b) see (a).
1299
1300
1301(define-ppc64-vinsn unbox-s32 (((dest :s32))
1302                               ((src :lisp))
1303                               ((crf :crf)))
1304  (sldi dest src (- ppc64::nbits-in-word (+ 32 ppc64::fixnumshift)))
1305  (sradi dest dest (- ppc64::nbits-in-word 32))
1306  (sldi dest dest ppc64::fixnumshift)
1307  (cmpd crf dest src)
1308  (sradi dest src ppc64::fixnumshift)
1309  (beq crf :got-it)
1310  :bad
1311  (uuo_interr arch::error-object-not-signed-byte-32 src)
1312  :got-it)
1313
1314
1315(define-ppc64-vinsn unbox-u16 (((dest :u16))
1316                               ((src :lisp))
1317                               ((crf0 (:crf 0))))
1318  ;; The bottom ppc64::fixnumshift bits and the top (- 31 (+
1319  ;; ppc64::fixnumshift 16)) must all be zero.
1320  (rldicr. dest src (- 64 ppc64::fixnumshift) 47)
1321  (srdi dest src ppc64::fixnumshift)
1322  (beq+ crf0 :got-it)
1323  (uuo_interr arch::error-object-not-unsigned-byte-16 src)
1324  :got-it)
1325
1326(define-ppc64-vinsn unbox-s16 (((dest :s16))
1327                               ((src :lisp))
1328                               ((crf :crf)))
1329  (sldi dest src (- ppc64::nbits-in-word (+ 16 ppc64::fixnumshift)))
1330  (sradi dest dest (- ppc64::nbits-in-word 16))
1331  (sldi dest dest ppc64::fixnumshift)
1332  (cmpd crf dest src)
1333  (sradi dest src ppc64::fixnumshift)
1334  (beq+ crf :got-it)
1335  :bad
1336  (uuo_interr arch::error-object-not-signed-byte-16 src)
1337  :got-it)
1338
1339 
1340 
1341(define-ppc64-vinsn unbox-u8 (((dest :u8))
1342                              ((src :lisp))
1343                              ((crf0 (:crf 0))))
1344  ;; The bottom ppc64::fixnumshift bits and the top (- 63 (+
1345  ;; ppc64::fixnumshift 8)) must all be zero.
1346  (rldicr. dest src (- 64 ppc64::fixnumshift) 55)
1347  (srdi dest src ppc64::fixnumshift)
1348  (beq+ crf0 :got-it)
1349  (uuo_interr arch::error-object-not-unsigned-byte-8 src)
1350  :got-it)
1351
1352(define-ppc64-vinsn %unbox-u8 (((dest :u8))
1353                              ((src :lisp)))
1354  ;; The bottom ppc64::fixnumshift bits and the top (- 63 (+
1355  ;; ppc64::fixnumshift 8)) must all be zero.
1356  (rldicl dest src (- 64 ppc64::fixnumshift) 56))
1357
1358(define-ppc64-vinsn unbox-s8 (((dest :s8))
1359                              ((src :lisp))
1360                              ((crf :crf)))
1361  (sldi dest src (- ppc64::nbits-in-word (+ 8 ppc64::fixnumshift)))
1362  (sradi dest dest (- ppc64::nbits-in-word 8))
1363  (sldi dest dest ppc64::fixnumshift)
1364  (cmpd crf dest src)
1365  (sradi dest src ppc64::fixnumshift)
1366  (beq+ crf :got-it)
1367  :bad
1368  (uuo_interr arch::error-object-not-signed-byte-16 src)
1369  :got-it)
1370
1371(define-ppc64-vinsn unbox-base-char (((dest :u32))
1372                                     ((src :lisp))
1373                                     ((crf :crf)))
1374  (clrldi dest src (- 64 ppc64::num-subtag-bits))
1375  (cmpdi crf dest ppc64::subtag-character)
1376  (srdi dest src ppc64::charcode-shift)
1377  (beq+ crf :got-it)
1378  (uuo_interr arch::error-object-not-character src)
1379  :got-it)
1380
1381(define-ppc64-vinsn unbox-bit (((dest :u32))
1382                               ((src :lisp))
1383                               ((crf :crf)))
1384  (cmplwi crf src (ash 1 ppc64::fixnumshift))
1385  (srawi dest src ppc64::fixnumshift)
1386  (ble+ crf :got-it)
1387  (uuo_interr arch::error-object-not-bit src)
1388  :got-it)
1389
1390(define-ppc64-vinsn unbox-bit-bit0 (((dest :u32))
1391                                    ((src :lisp))
1392                                    ((crf :crf)))
1393  (cmplwi crf src (ash 1 ppc64::fixnumshift))
1394  (rlwinm dest src (- 32 (1+ ppc64::fixnumshift)) 0 0)
1395  (ble+ crf :got-it)
1396  (uuo_interr arch::error-object-not-bit src)
1397  :got-it)
1398
1399
1400
1401
1402(define-ppc64-vinsn shift-right-variable-word (((dest :u32))
1403                                               ((src :u32)
1404                                                (sh :u32)))
1405  (srw dest src sh))
1406
1407;;; These vinsns are used in bit extraction operations, which
1408;;; currently do 32-bit memory references on both platforms.
1409(define-ppc64-vinsn u32logandc2 (((dest :u32))
1410                                 ((x :u32)
1411                                  (y :u32)))
1412  (andc dest x y))
1413
1414(define-ppc64-vinsn u32logior (((dest :u32))
1415                               ((x :u32)
1416                                (y :u32)))
1417  (or dest x y))
1418
1419
1420(define-ppc64-vinsn trap-unless-fixnum (()
1421                                        ((object :lisp))
1422                                        ((tag :u8)))
1423  (clrldi tag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
1424  (tdnei tag ppc64::tag-fixnum))
1425
1426(define-ppc64-vinsn trap-unless-character (()
1427                                           ((object :lisp))
1428                                           ((tag :u8)))
1429  (clrldi tag object (- ppc64::nbits-in-word ppc64::num-subtag-bits))
1430  (tdnei tag ppc64::subtag-character))
1431
1432
1433(define-ppc64-vinsn trap-unless-cons (()
1434                                        ((object :lisp))
1435                                        ((tag :u8)))
1436  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1437  (tdnei tag ppc64::fulltag-cons))
1438
1439(define-ppc64-vinsn trap-unless-list (()
1440                                      ((object :lisp))
1441                                      ((tag :u8)
1442                                       (crf :crf)))
1443  (cmpldi crf object (target-nil-value))
1444  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1445  (beq crf :ok)
1446  (tdi 3 tag ppc64::fulltag-cons)
1447  :ok)
1448
1449(define-ppc64-vinsn trap-unless-uvector (()
1450                                         ((object :lisp))
1451                                         ((tag :u8)))
1452  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1453  (tdnei tag ppc64::fulltag-misc))
1454
1455(define-ppc64-vinsn trap-unless-single-float (()
1456                                              ((object :lisp))
1457                                              ((tag :u8)))
1458  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1459  (tdnei tag ppc64::subtag-single-float))
1460
1461(define-ppc64-vinsn trap-unless-double-float (()
1462                                              ((object :lisp))
1463                                              ((tag :u8)
1464                                               (crf :crf)))
1465  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1466  (cmpdi crf tag ppc64::fulltag-misc)
1467  (bne crf :do-trap)
1468  (lbz tag ppc64::misc-subtag-offset object)
1469  :do-trap
1470  (tdnei tag ppc64::subtag-double-float))
1471
1472(define-ppc64-vinsn trap-unless-array-header (()
1473                                              ((object :lisp))
1474                                              ((tag :u8)
1475                                               (crf :crf)))
1476  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1477  (cmpdi crf tag ppc64::fulltag-misc)
1478  (bne crf :do-trap)
1479  (lbz tag ppc64::misc-subtag-offset object)
1480  :do-trap
1481  (tdnei tag ppc64::subtag-arrayH))
1482
1483(define-ppc64-vinsn trap-unless-macptr (()
1484                                        ((object :lisp))
1485                                        ((tag :u8)
1486                                         (crf :crf)))
1487  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1488  (cmpdi crf tag ppc64::fulltag-misc)
1489  (bne crf :do-trap)
1490  (lbz tag ppc64::misc-subtag-offset object)
1491  :do-trap
1492  (tdnei tag ppc64::subtag-macptr))
1493
1494
1495(define-ppc64-vinsn trap-unless-typecode= (()
1496                                           ((object :lisp)
1497                                            (tagval :u16const))
1498                                           ((tag :u8)
1499                                            (crf :crf)))
1500  (clrldi tag object (- ppc64::nbits-in-word ppc64::ntagbits))
1501  (cmpdi crf tag ppc64::fulltag-misc)
1502  (clrldi tag object (- ppc64::nbits-in-word ppc64::nlisptagbits))
1503  (bne crf :do-trap)
1504  (lbz tag ppc64::misc-subtag-offset object)
1505  :do-trap
1506  (tdnei tag tagval))
1507 
1508(define-ppc64-vinsn subtract-constant (((dest :imm))
1509                                       ((src :imm)
1510                                        (const :s16const)))
1511  (subi dest src const))
1512
1513
1514
1515
1516;;; Bit-extraction & boolean operations
1517
1518
1519;;; For some mind-numbing reason, IBM decided to call the most significant
1520;;; bit in a 32-bit word "bit 0" and the least significant bit "bit 31"
1521;;; (this despite the fact that it's essentially a big-endian architecture
1522;;; (it was exclusively big-endian when this decision was made.))
1523;;; We'll probably be least confused if we consistently use this backwards
1524;;; bit ordering (letting things that have a "sane" bit-number worry about
1525;;; it at compile-time or run-time (subtracting the "sane" bit number from
1526;;; 31.))
1527
1528(define-ppc64-vinsn extract-variable-bit (((dest :u8))
1529                                          ((src :u32)
1530                                           (bitnum :u8))
1531                                          ())
1532  (rotlw dest src bitnum)
1533  (extrwi dest dest 1 0))
1534
1535
1536(define-ppc64-vinsn extract-variable-bit-fixnum (((dest :imm))
1537                                                 ((src :u32)
1538                                                  (bitnum :u8))
1539                                                 ((temp :u32)))
1540  (rotlw temp src bitnum)
1541  (rlwinm dest
1542          temp 
1543          (1+ ppc64::fixnumshift) 
1544          (- ppc64::least-significant-bit ppc64::fixnumshift)
1545          (- ppc64::least-significant-bit ppc64::fixnumshift)))
1546
1547
1548(define-ppc64-vinsn lowbit->truth (((dest :lisp)
1549                                    (bits :u64))
1550                                   ((bits :u64))
1551                                   ())
1552  (mulli bits bits ppc64::t-offset)
1553  (addi dest bits (target-nil-value)))
1554
1555(define-ppc64-vinsn invert-lowbit (((bits :u64))
1556                                   ((bits :u64))
1557                                   ())
1558  (xori bits bits 1))
1559
1560                           
1561
1562;;; Some of the obscure-looking instruction sequences - which map some
1563;;; relation to PPC bit 31 of some register - were found by the GNU
1564;;; SuperOptimizer.  Some of them use extended-precision instructions
1565;;; (which may cause interlocks on some superscalar PPCs, if I
1566;;; remember correctly.)  In general, sequences that GSO found that
1567;;; -don't- do extended precision are longer and/or use more
1568;;; temporaries.  On the 604, the penalty for using an instruction
1569;;; that uses the CA bit is "at least" one cycle: it can't complete
1570;;; execution until all "older" instructions have.  That's not
1571;;; horrible, especially given that the alternative is usually to use
1572;;; more instructions (and, more importantly, more temporaries) to
1573;;; avoid using extended-precision.
1574
1575
1576(define-ppc64-vinsn eq0->bit31 (((bits :u64))
1577                                ((src (t (:ne bits)))))
1578  (cntlzd bits src)
1579  (srdi bits bits 6))                   ; bits = 0000...000X
1580
1581(define-ppc64-vinsn ne0->bit31 (((bits :u64))
1582                                ((src (t (:ne bits)))))
1583  (cntlzd bits src)
1584  (sld bits src bits)
1585  (srdi bits bits 63))                  ; bits = 0000...000X
1586
1587(define-ppc64-vinsn lt0->bit31 (((bits :u64))
1588                                ((src (t (:ne bits)))))
1589  (srdi bits src 63))                   ; bits = 0000...000X
1590
1591
1592(define-ppc64-vinsn ge0->bit31 (((bits :u64))
1593                                ((src (t (:ne bits)))))
1594  (srdi bits src 63)       
1595  (xori bits bits 1))                   ; bits = 0000...000X
1596
1597
1598(define-ppc64-vinsn le0->bit31 (((bits :u64))
1599                                ((src (t (:ne bits)))))
1600  (neg bits src)
1601  (orc bits bits src)
1602  (srdi bits bits 63))                  ; bits = 0000...000X
1603
1604(define-ppc64-vinsn gt0->bit31 (((bits :u64))
1605                                ((src (t (:ne bits)))))
1606  (subi bits src 1)       
1607  (nor bits bits src)
1608  (srdi bits bits 63))                  ; bits = 0000...000X
1609
1610(define-ppc64-vinsn ne->bit31 (((bits :u64))
1611                               ((x t)
1612                                (y t))
1613                               ((temp :u64)))
1614  (subf temp x y)
1615  (cntlzd bits temp)
1616  (sld bits temp bits)
1617  (srdi bits bits 63))                  ; bits = 0000...000X
1618
1619(define-ppc64-vinsn fulltag->bit31 (((bits :u64))
1620                                    ((lispobj :lisp)
1621                                     (tagval :u8const))
1622                                    ())
1623  (clrldi bits lispobj (- ppc64::nbits-in-word ppc64::ntagbits))
1624  (subi bits bits tagval)
1625  (cntlzd bits bits)
1626  (srdi bits bits 6))
1627
1628
1629(define-ppc64-vinsn eq->bit31 (((bits :u64))
1630                               ((x t)
1631                                (y t)))
1632  (subf bits x y)
1633  (cntlzd bits bits)
1634  (srdi bits bits 6))                   ; bits = 0000...000X
1635
1636(define-ppc64-vinsn eqnil->bit31 (((bits :u64))
1637                                  ((x t)))
1638  (subi bits x (target-nil-value))
1639  (cntlzd bits bits)
1640  (srdi bits bits 6))
1641
1642(define-ppc64-vinsn ne->bit31 (((bits :u64))
1643                               ((x t)
1644                                (y t)))
1645  (subf bits x y)
1646  (cntlzd bits bits)
1647  (srdi bits bits 6)
1648  (xori bits bits 1))
1649
1650(define-ppc64-vinsn nenil->bit31 (((bits :u64))
1651                                  ((x t)))
1652  (subi bits x (target-nil-value))
1653  (cntlzd bits bits)
1654  (srdi bits bits 6)
1655  (xori bits bits 1))
1656
1657(define-ppc64-vinsn lt->bit31 (((bits :u64))
1658                               ((x (t (:ne bits)))
1659                                (y (t (:ne bits)))))
1660
1661  (xor bits x y)
1662  (sradi bits bits 63)
1663  (or bits bits x)
1664  (subf bits y bits)
1665  (srdi bits bits 63))                  ; bits = 0000...000X
1666
1667(define-ppc64-vinsn ltu->bit31 (((bits :u64))
1668                                ((x :u64)
1669                                 (y :u64)))
1670  (subfc bits y x)
1671  (subfe bits bits bits)
1672  (neg bits bits))
1673
1674(define-ppc64-vinsn le->bit31 (((bits :u64))
1675                               ((x (t (:ne bits)))
1676                                (y (t (:ne bits)))))
1677
1678  (xor bits x y)
1679  (sradi bits bits 63)
1680  (nor bits bits y)
1681  (add bits bits x)
1682  (srdi bits bits 63))                  ; bits = 0000...000X
1683
1684(define-ppc64-vinsn leu->bit31  (((bits :u32))
1685                                 ((x :u32)
1686                                  (y :u32)))
1687  (subfc bits x y)
1688  (addze bits ppc::rzero))
1689
1690(define-ppc64-vinsn gt->bit31 (((bits :u32))
1691                               ((x (t (:ne bits)))
1692                                (y (t (:ne bits)))))
1693
1694  (eqv bits x y)
1695  (sradi bits bits 63)
1696  (and bits bits x)
1697  (subf bits bits y)
1698  (srdi bits bits 63))                  ; bits = 0000...000X
1699
1700(define-ppc64-vinsn gtu->bit31 (((bits :u64))
1701                                ((x :u64)
1702                                 (y :u64)))
1703  (subfc bits x y)
1704  (subfe bits bits bits)
1705  (neg bits bits))
1706
1707(define-ppc64-vinsn ge->bit31 (((bits :u64))
1708                               ((x (t (:ne bits)))
1709                                (y (t (:ne bits)))))
1710  (eqv bits x y)
1711  (sradi bits bits 63)
1712  (andc bits bits x)
1713  (add bits bits y)
1714  (srdi bits bits 63))                  ; bits = 0000...000X
1715
1716(define-ppc64-vinsn geu->bit31 (((bits :u64))
1717                                ((x :u64)
1718                                 (y :u64)))
1719  (subfc bits y x)
1720  (addze bits ppc::rzero))
1721
1722
1723;;; there are big-time latencies associated with MFCR on more heavily
1724;;; pipelined processors; that implies that we should avoid this like
1725;;; the plague.
1726;;; GSO can't find anything much quicker for LT or GT, even though
1727;;; MFCR takes three cycles and waits for previous instructions to complete.
1728;;; Of course, using a CR field costs us something as well.
1729(define-ppc64-vinsn crbit->bit31 (((bits :u64))
1730                                  ((crf :crf)
1731                                   (bitnum :crbit))
1732                                  ())
1733  (mfcr bits)                           ; Suffer.
1734  (rlwinm bits bits (:apply + 1  bitnum (:apply ash crf 2)) 31 31)) ; bits = 0000...000X
1735
1736
1737(define-ppc64-vinsn compare (((crf :crf))
1738                             ((arg0 t)
1739                              (arg1 t))
1740                             ())
1741  (cmpd crf arg0 arg1))
1742
1743(define-ppc64-vinsn compare-to-nil (((crf :crf))
1744                                    ((arg0 t)))
1745  (cmpdi crf arg0 (target-nil-value)))
1746
1747(define-ppc64-vinsn compare-logical (((crf :crf))
1748                                     ((arg0 t)
1749                                      (arg1 t))
1750                                     ())
1751  (cmpld crf arg0 arg1))
1752
1753(define-ppc64-vinsn double-float-compare (((crf :crf))
1754                                          ((arg0 :double-float)
1755                                           (arg1 :double-float))
1756                                          ())
1757  (fcmpo crf arg0 arg1))
1758             
1759
1760(define-ppc64-vinsn double-float+-2 (((result :double-float))
1761                                     ((x :double-float)
1762                                      (y :double-float))
1763                                     ((crf (:crf 4))))
1764  (fadd result x y))
1765
1766(define-ppc64-vinsn double-float--2 (((result :double-float))
1767                                     ((x :double-float)
1768                                      (y :double-float))
1769                                     ((crf (:crf 4))))
1770  (fsub result x y))
1771
1772(define-ppc64-vinsn double-float*-2 (((result :double-float))
1773                                     ((x :double-float)
1774                                      (y :double-float))
1775                                     ((crf (:crf 4))))
1776  (fmul result x y))
1777
1778(define-ppc64-vinsn double-float/-2 (((result :double-float))
1779                                     ((x :double-float)
1780                                      (y :double-float))
1781                                     ((crf (:crf 4))))
1782  (fdiv result x y))
1783
1784(define-ppc64-vinsn single-float+-2 (((result :single-float))
1785                                     ((x :single-float)
1786                                      (y :single-float))
1787                                     ((crf (:crf 4))))
1788  (fadds result x y))
1789
1790(define-ppc64-vinsn single-float--2 (((result :single-float))
1791                                     ((x :single-float)
1792                                      (y :single-float))
1793                                     ((crf (:crf 4))))
1794  (fsubs result x y))
1795
1796(define-ppc64-vinsn single-float*-2 (((result :single-float))
1797                                     ((x :single-float)
1798                                      (y :single-float))
1799                                     ((crf (:crf 4))))
1800  (fmuls result x y))
1801
1802(define-ppc64-vinsn single-float/-2 (((result :single-float))
1803                                     ((x :single-float)
1804                                      (y :single-float))
1805                                     ((crf (:crf 4))))
1806  (fdivs result x y))
1807
1808
1809
1810(define-ppc64-vinsn compare-signed-s16const (((crf :crf))
1811                                             ((arg0 :imm)
1812                                              (imm :s16const))
1813                                             ())
1814  (cmpdi crf arg0 imm))
1815
1816(define-ppc64-vinsn compare-unsigned-u16const (((crf :crf))
1817                                               ((arg0 :u32)
1818                                                (imm :u16const))
1819                                               ())
1820  (cmpldi crf arg0 imm))
1821
1822
1823
1824;;; Extract a constant bit (0-63) from src; make it be bit 63 of dest.
1825;;; Bitnum is treated mod 64. (This is used in LOGBITP).
1826(define-ppc64-vinsn extract-constant-ppc-bit (((dest :u64))
1827                                              ((src :imm)
1828                                               (bitnum :u16const))
1829                                              ())
1830  (rldicl dest src (:apply + 1 bitnum) 63))
1831
1832
1833(define-ppc64-vinsn set-constant-ppc-bit-to-variable-value (((dest :u32))
1834                                                            ((src :u32)
1835                                                             (bitval :u32) ; 0 or 1
1836                                                             (bitnum :u8const)))
1837  (rlwimi dest bitval (:apply - 31 bitnum) bitnum bitnum))
1838
1839(define-ppc64-vinsn set-constant-ppc-bit-to-1 (((dest :u32))
1840                                               ((src :u32)
1841                                                (bitnum :u8const)))
1842  ((:pred < bitnum 16)
1843   (oris dest src (:apply ash #x8000 (:apply - bitnum))))
1844  ((:pred >= bitnum 16)
1845   (ori dest src (:apply ash #x8000 (:apply - (:apply - bitnum 16))))))
1846
1847(define-ppc64-vinsn set-constant-ppc-bit-to-0 (((dest :u32))
1848                                               ((src :u32)
1849                                                (bitnum :u8const)))
1850  (rlwinm dest src 0 (:apply logand #x1f (:apply 1+ bitnum)) (:apply logand #x1f (:apply 1- bitnum))))
1851
1852 
1853(define-ppc64-vinsn insert-bit-0 (((dest :u32))
1854                                  ((src :u32)
1855                                   (val :u32)))
1856  (rlwimi dest val 0 0 0))
1857 
1858;;; The bit number is boxed and wants to think of the
1859;;; least-significant bit as 0.  Imagine that.  To turn the boxed,
1860;;; lsb-0 bitnumber into an unboxed, msb-0 rotate count, we
1861;;; (conceptually) unbox it, add ppc64::fixnumshift to it, subtract it
1862;;; from 31, and add one.  This can also be done as "unbox and
1863;;; subtract from 28", I think ...  Actually, it'd be "unbox, then
1864;;; subtract from 30".
1865(define-ppc64-vinsn extract-variable-non-insane-bit (((dest :u64))
1866                                                     ((src :imm)
1867                                                      (bit :imm))
1868                                                     ((temp :u64)))
1869  (srdi temp bit ppc64::fixnumshift)
1870  (subfic temp temp (- 64 ppc64::fixnumshift))
1871  (rldcl dest src temp 63))
1872                                               
1873;;; Operations on lists and cons cells
1874
1875(define-ppc64-vinsn %cdr (((dest :lisp))
1876                          ((src :lisp)))
1877  (ld dest ppc64::cons.cdr src))
1878
1879(define-ppc64-vinsn %car (((dest :lisp))
1880                          ((src :lisp)))
1881  (ld dest ppc64::cons.car src))
1882
1883(define-ppc64-vinsn %set-car (()
1884                              ((cell :lisp)
1885                               (new :lisp)))
1886  (std new ppc64::cons.car cell))
1887
1888(define-ppc64-vinsn %set-cdr (()
1889                              ((cell :lisp)
1890                               (new :lisp)))
1891  (std new ppc64::cons.cdr cell))
1892
1893(define-ppc64-vinsn load-adl (()
1894                              ((n :u32const)))
1895  (lis ppc::nargs (:apply ldb (byte 16 16) n))
1896  (ori ppc::nargs ppc::nargs (:apply ldb (byte 16 0) n)))
1897                           
1898(define-ppc64-vinsn set-nargs (()
1899                               ((n :s16const)))
1900  (li ppc::nargs (:apply ash n ppc64::word-shift)))
1901
1902(define-ppc64-vinsn scale-nargs (()
1903                                 ((nfixed :s16const)))
1904  ((:pred > nfixed 0)
1905   (la ppc::nargs (:apply - (:apply ash nfixed ppc64::word-shift)) ppc::nargs)))
1906                           
1907
1908
1909(define-ppc64-vinsn (vpush-register :push :node :vsp)
1910    (()
1911     ((reg :lisp)))
1912  (stdu reg -8 ppc::vsp))
1913
1914(define-ppc64-vinsn (vpush-register-arg :push :node :vsp :outgoing-argument)
1915    (()
1916     ((reg :lisp)))
1917  (stdu reg -8 ppc::vsp))
1918
1919(define-ppc64-vinsn (vpop-register :pop :node :vsp)
1920    (((dest :lisp))
1921     ())
1922  (ld dest 0 ppc::vsp)
1923  (la ppc::vsp ppc64::word-size-in-bytes ppc::vsp))
1924
1925
1926(define-ppc64-vinsn copy-node-gpr (((dest :lisp))
1927                                   ((src :lisp)))
1928  ((:not (:pred =
1929                (:apply %hard-regspec-value dest)
1930                (:apply %hard-regspec-value src)))
1931   (mr dest src)))
1932
1933(define-ppc64-vinsn copy-gpr (((dest t))
1934                              ((src t)))
1935  ((:not (:pred =
1936                (:apply %hard-regspec-value dest)
1937                (:apply %hard-regspec-value src)))
1938   (mr dest src)))
1939
1940
1941(define-ppc64-vinsn copy-fpr (((dest :double-float))
1942                              ((src :double-float)))
1943  ((:not (:pred =
1944                (:apply %hard-regspec-value dest)
1945                (:apply %hard-regspec-value src)))
1946   (fmr dest src)))
1947
1948(define-ppc64-vinsn vcell-ref (((dest :lisp))
1949                               ((vcell :lisp)))
1950  (ld dest ppc64::misc-data-offset vcell))
1951
1952(define-ppc64-vinsn vcell-set (()
1953                               ((vcell :lisp)
1954                                (value :lisp)))
1955  (std value ppc64::misc-data-offset vcell))
1956
1957
1958(define-ppc64-vinsn make-vcell (((dest :lisp))
1959                                ((closed (:lisp :ne dest)))
1960                                ((header :u64)))
1961  (li header ppc64::value-cell-header)
1962  (la ppc::allocptr (- ppc64::fulltag-misc ppc64::value-cell.size) ppc::allocptr)
1963  (tdlt ppc::allocptr ppc::allocbase)
1964  (std header ppc64::misc-header-offset ppc::allocptr)
1965  (mr dest ppc::allocptr)
1966  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
1967  (std closed ppc64::value-cell.value dest))
1968
1969(define-ppc64-vinsn make-tsp-vcell (((dest :lisp))
1970                                    ((closed :lisp))
1971                                    ((header :u64)))
1972  (li header ppc64::value-cell-header)
1973  (stdu ppc::tsp -32 ppc::tsp)
1974  (std ppc::tsp 8 ppc::tsp)
1975  (stfd ppc::fp-zero 16 ppc::tsp)
1976  (stfd ppc::fp-zero 24 ppc::tsp)
1977  (std ppc::rzero 8 ppc::tsp)
1978  (std header (+ 16 ppc64::fulltag-misc ppc64::value-cell.header) ppc::tsp)
1979  (std closed (+ 16 ppc64::fulltag-misc ppc64::value-cell.value) ppc::tsp)
1980  (la dest (+ 16 ppc64::fulltag-misc) ppc::tsp))
1981
1982(define-ppc64-vinsn make-tsp-cons (((dest :lisp))
1983                                   ((car :lisp) (cdr :lisp))
1984                                   ())
1985  (stdu ppc::tsp -32 ppc::tsp)
1986  (std ppc::tsp 8 ppc::tsp)
1987  (stfd ppc::fp-zero 16 ppc::tsp)
1988  (stfd ppc::fp-zero 24 ppc::tsp)
1989  (std ppc::rzero 8 ppc::tsp)
1990  (std car (+ 16 ppc64::fulltag-cons ppc64::cons.car) ppc::tsp)
1991  (std cdr (+ 16 ppc64::fulltag-cons ppc64::cons.cdr) ppc::tsp)
1992  (la dest (+ 16 ppc64::fulltag-cons) ppc::tsp))
1993
1994
1995(define-ppc64-vinsn %closure-code% (((dest :lisp))
1996                                    ())
1997  (ld dest (+ ppc64::symbol.vcell (ppc64::nrs-offset %closure-code%) (target-nil-value)) 0))
1998
1999(define-ppc64-vinsn single-float-bits (((dest :u32))
2000                                       ((src :lisp)))
2001  (srdi dest  src 32))
2002
2003(define-ppc64-vinsn (call-subprim :call :subprim-call) (()
2004                                                        ((spno :s32const)))
2005  (bla spno))
2006
2007(define-ppc64-vinsn (jump-subprim :jumpLR) (()
2008                                            ((spno :s32const)))
2009  (ba spno))
2010
2011;;; Same as "call-subprim", but gives us a place to
2012;;; track args, results, etc.
2013(define-ppc64-vinsn (call-subprim-0 :call :subprim-call) (((dest t))
2014                                                          ((spno :s32const)))
2015  (bla spno))
2016
2017(define-ppc64-vinsn (call-subprim-1 :call :subprim-call) (((dest t))
2018                                                          ((spno :s32const)
2019                                                           (z t)))
2020  (bla spno))
2021 
2022(define-ppc64-vinsn (call-subprim-2 :call :subprim-call) (((dest t))
2023                                                          ((spno :s32const)
2024                                                           (y t)
2025                                                           (z t)))
2026  (bla spno))
2027
2028(define-ppc64-vinsn (call-subprim-3 :call :subprim-call) (((dest t))
2029                                                          ((spno :s32const)
2030                                                           (x t)
2031                                                           (y t)
2032                                                           (z t)))
2033  (bla spno))
2034
2035(define-ppc64-vinsn event-poll (()
2036                                ()
2037                                ((crf :crf)))
2038  (ld ppc::nargs ppc64::tcr.tlb-pointer ppc64::rcontext)
2039  (ld ppc::nargs ppc64::interrupt-level-binding-index ppc::nargs)
2040  (cmpdi crf ppc::nargs 0)
2041  (blt crf :done)
2042  (bgt crf :trap)
2043  (ld ppc::nargs ppc64::tcr.interrupt-pending ppc64::rcontext)
2044  :trap
2045  (tdgti ppc::nargs 0)
2046  :done)
2047
2048(define-ppc64-vinsn ref-interrupt-level (((dest :imm))
2049                                         ()
2050                                         ((temp :u64)))
2051  (ld temp ppc64::tcr.tlb-pointer ppc64::rcontext)
2052  (ld dest ppc64::INTERRUPT-LEVEL-BINDING-INDEX temp))
2053                         
2054;;; Unconditional (pc-relative) branch
2055(define-ppc64-vinsn (jump :jump)
2056    (()
2057     ((label :label)))
2058  (b label))
2059
2060(define-ppc64-vinsn (call-label :call) (()
2061                                        ((label :label)))
2062  (bl label))
2063
2064;;; just like JUMP, only (implicitly) asserts that the following
2065;;; code is somehow reachable.
2066(define-ppc64-vinsn (non-barrier-jump :xref) (()
2067                                              ((label :label)))
2068  (b label))
2069
2070
2071(define-ppc64-vinsn (cbranch-true :branch) (()
2072                                            ((label :label)
2073                                             (crf :crf)
2074                                             (crbit :u8const)))
2075  (bt (:apply + crf crbit) label))
2076
2077(define-ppc64-vinsn (cbranch-false :branch) (()
2078                                             ((label :label)
2079                                              (crf :crf)
2080                                              (crbit :u8const)))
2081  (bf (:apply + crf crbit) label))
2082
2083(define-ppc64-vinsn check-trap-error (()
2084                                      ())
2085  (beq+ 0 :no-error)
2086  (uuo_interr arch::error-reg-regnum ppc::arg_z)
2087  :no-error)
2088
2089
2090(define-ppc64-vinsn lisp-word-ref (((dest t))
2091                                   ((base t)
2092                                    (offset t)))
2093  (ldx dest base offset))
2094
2095(define-ppc64-vinsn lisp-word-ref-c (((dest t))
2096                                     ((base t)
2097                                      (offset :s16const)))
2098  (ld dest offset base))
2099
2100
2101(define-ppc64-vinsn (lri :constant-ref) (((dest :imm))
2102                                         ((intval :u64const))
2103                                         ())
2104  ((:or (:pred = (:apply ash intval -15) #x1FFFFFFFFFFFF)
2105        (:pred = (:apply ash intval -15) 0))
2106   (li dest (:apply %word-to-int (:apply logand #xffff intval))))
2107  ((:not
2108    (:or (:pred = (:apply ash intval -15) #x1FFFFFFFFFFFF)
2109         (:pred = (:apply ash intval -15) 0)))
2110   ((:or (:pred = (:apply ash intval -31) 0)
2111         (:pred = (:apply ash intval -31) #x1ffffffff))
2112    (lis dest (:apply %word-to-int (:apply ldb (:apply byte 16 16) intval)))
2113    ((:not (:pred = (:apply ldb (:apply byte 16 0) intval) 0))
2114     (ori dest dest (:apply ldb (:apply byte 16 0) intval))))
2115   ((:not (:or (:pred = (:apply ash intval -31) 0)
2116               (:pred = (:apply ash intval -31) #x1ffffffff)))
2117    ((:pred = (:apply ash intval -32) 0)
2118     (oris dest ppc::rzero (:apply ldb (:apply byte 16 16) intval))
2119     ((:not (:pred = (:apply ldb (:apply byte 16 0) intval) 0))
2120      (ori dest dest (:apply ldb (:apply byte 16 0) intval))))
2121    ((:not (:pred = (:apply ash intval -32) 0))
2122     ;; This is the general case, where all halfwords are significant.
2123     ;; Hopefully, something above catches lots of other cases.
2124     (lis dest (:apply %word-to-int (:apply ldb (:apply byte 16 48) intval)))
2125     ((:not (:pred = (:apply ldb (:apply byte 16 32) intval) 0))
2126      (ori dest dest (:apply ldb (:apply byte 16 32) intval)))
2127     (sldi dest dest 32)
2128     ((:not (:pred = (:apply ldb (:apply byte 16 16) intval) 0))
2129      (oris dest dest (:apply ldb (:apply byte 16 16) intval)))
2130     ((:not (:pred = (:apply ldb (:apply byte 16 0) intval) 0))
2131      (ori dest dest (:apply ldb (:apply byte 16 0) intval)))))))
2132
2133
2134(define-ppc64-vinsn discard-temp-frame (()
2135                                        ())
2136  (ld ppc::tsp 0 ppc::tsp))
2137
2138
2139;;; Somewhere, deep inside the "OS_X_PPC_RuntimeConventions.pdf"
2140;;; document, they bother to document the fact that SP should
2141;;; maintain 32-byte alignment on OSX.  (The example prologue
2142;;; code in that document incorrectly assumes 8-byte alignment.
2143;;; Or something.  It's wrong in a number of other ways.)
2144;;; The caller always has to reserve a 24-byte linkage area
2145;;; (large chunks of which are unused).
2146(define-ppc64-vinsn alloc-c-frame (()
2147                                   ((n-c-args :u16const)))
2148  ;; Always reserve space for at least 8 args and space for a lisp
2149  ;; frame (for the kernel) underneath it.
2150  ;; Zero the c-frame's savelr field, not that the GC cares ..
2151  ((:pred <= n-c-args 10)
2152   (stdu ppc::sp (- (+ 16 ppc64::c-frame.size ppc64::lisp-frame.size)) ppc::sp))
2153  ((:pred > n-c-args 10)
2154   ;; A normal C frame has room for 10 args (when padded out to
2155   ;; 32-byte alignment. Add enough double words to accomodate the
2156   ;; remaining args, in multiples of 4.
2157   (stdu ppc::sp (:apply - (:apply +
2158                                   16
2159                                   (+ ppc64::c-frame.size ppc64::lisp-frame.size)
2160                                   (:apply ash
2161                                           (:apply logand
2162                                                   (lognot 7)
2163                                                   (:apply
2164                                                    +
2165                                                    7
2166                                                    (:apply - n-c-args 10)))
2167                                           3)))
2168         ppc::sp))
2169  (std ppc::rzero ppc64::c-frame.savelr ppc::sp))
2170
2171
2172(define-ppc64-vinsn alloc-variable-c-frame (()
2173                                            ((n-c-args :lisp))
2174                                            ((crf :crf)
2175                                             (size :s64)))
2176  (cmpdi crf n-c-args (ash 10 ppc64::fixnumshift))
2177  (subi size n-c-args (ash 10 ppc64::fixnumshift))
2178  (bgt :variable)
2179  ;; Always reserve space for at least 8 args and space for a lisp
2180  ;; frame (for the kernel) underneath it.
2181  (stdu ppc::sp (- (+ 16 ppc64::c-frame.size ppc64::lisp-frame.size)) ppc::sp)
2182  (b :done)
2183  :variable
2184  (addi size size (+  (+ 16 ppc64::c-frame.size ppc64::lisp-frame.size) (ash 3 ppc64::fixnumshift)))
2185  (clrrdi size size 4)
2186  (neg size size)
2187  (stdux ppc::sp ppc::sp size)
2188  :done
2189  (stw ppc::rzero ppc64::c-frame.savelr ppc::sp))
2190
2191;;; We should rarely have to do this.  It's easier to just generate code
2192;;; to do the memory reference than it would be to keep track of the size
2193;;; of each frame.
2194(define-ppc64-vinsn discard-c-frame (()
2195                                     ())
2196  (ld ppc::sp 0 ppc::sp))
2197
2198
2199
2200
2201(define-ppc64-vinsn set-c-arg (()
2202                               ((argval :u32)
2203                                (argnum :u16const)))
2204  (std argval (:apply + ppc64::c-frame.param0 (:apply ash argnum ppc64::word-shift)) ppc::sp))
2205
2206(define-ppc64-vinsn set-single-c-arg (()
2207                                      ((argval :single-float)
2208                                       (argnum :u16const)))
2209  (stfs argval (:apply + ppc64::c-frame.param0 4 (:apply ash argnum ppc64::word-shift)) ppc::sp))
2210
2211(define-ppc64-vinsn set-double-c-arg (()
2212                                      ((argval :double-float)
2213                                       (argnum :u16const)))
2214  (stfd argval (:apply + ppc64::c-frame.param0 (:apply ash argnum ppc64::word-shift)) ppc::sp))
2215
2216(define-ppc64-vinsn reload-single-c-arg (((argval :single-float))
2217                                         ((argnum :u16const)))
2218  (lfs argval (:apply + ppc64::c-frame.param0 4 (:apply ash argnum ppc64::word-shift)) ppc::sp))
2219
2220(define-ppc64-vinsn reload-single-c-arg-high (((argval :single-float))
2221                                              ((argnum :u16const)))
2222  (lfs argval (:apply + ppc64::c-frame.param0 (:apply ash argnum ppc64::word-shift)) ppc::sp))
2223
2224(define-ppc64-vinsn reload-double-c-arg (((argval :double-float))
2225                                         ((argnum :u16const)))
2226  (lfd argval (:apply + ppc64::c-frame.param0 (:apply ash argnum ppc64::word-shift)) ppc::sp))
2227
2228(define-ppc64-vinsn (load-nil :constant-ref) (((dest t))
2229                                              ())
2230  (li dest (target-nil-value)))
2231
2232
2233(define-ppc64-vinsn (load-t :constant-ref) (((dest t))
2234                                            ())
2235  (li dest (+ ppc64::t-offset (target-nil-value))))
2236
2237(define-ppc64-vinsn set-eq-bit (((dest :crf))
2238                                ())
2239  (creqv (:apply + ppc::ppc-eq-bit dest)
2240         (:apply + ppc::ppc-eq-bit dest)
2241         (:apply + ppc::ppc-eq-bit dest)))
2242
2243(define-ppc64-vinsn (ref-constant :constant-ref) (((dest :lisp))
2244                                                  ((src :s16const)))
2245  (ld dest (:apply + ppc64::misc-data-offset (:apply ash (:apply 1+ src) 3)) ppc::fn))
2246
2247(define-ppc64-vinsn ref-indexed-constant (((dest :lisp))
2248                                          ((idxreg :s64)))
2249  (ldx dest ppc::fn idxreg))
2250
2251
2252(define-ppc64-vinsn cons (((dest :lisp))
2253                          ((newcar :lisp)
2254                           (newcdr :lisp)))
2255  (la ppc::allocptr (- ppc64::fulltag-cons ppc64::cons.size) ppc::allocptr)
2256  (tdlt ppc::allocptr ppc::allocbase)
2257  (std newcdr ppc64::cons.cdr ppc::allocptr)
2258  (std newcar ppc64::cons.car ppc::allocptr)
2259  (mr dest ppc::allocptr)
2260  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits)))
2261
2262
2263
2264;;; subtag had better be a PPC-NODE-SUBTAG of some sort!
2265(define-ppc64-vinsn %ppc-gvector (((dest :lisp))
2266                                  ((Rheader :u32) 
2267                                   (nbytes :u32const))
2268                                  ((immtemp0 :u32)
2269                                   (nodetemp :lisp)
2270                                   (crf :crf)))
2271  (la ppc::allocptr (:apply - ppc64::fulltag-misc
2272                            (:apply logand (lognot 15)
2273                                    (:apply + (+ 15 8) nbytes)))
2274      ppc::allocptr)
2275  (tdlt ppc::allocptr ppc::allocbase)
2276  (std Rheader ppc64::misc-header-offset ppc::allocptr)
2277  (mr dest ppc::allocptr)
2278  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
2279  ((:not (:pred = nbytes 0))
2280   (li immtemp0 (:apply + ppc64::misc-data-offset nbytes))
2281   :loop
2282   (subi immtemp0 immtemp0 8)
2283   (cmpdi crf immtemp0 ppc64::misc-data-offset)
2284   (ld nodetemp 0 ppc::vsp)
2285   (la ppc::vsp 8 ppc::vsp)
2286   (stdx nodetemp dest immtemp0)
2287   (bne crf :loop)))
2288
2289;;; allocate a small (phys size <= 32K bytes) misc obj of known size/subtag
2290(define-ppc64-vinsn %alloc-misc-fixed (((dest :lisp))
2291                                       ((Rheader :u64)
2292                                        (nbytes :u32const)))
2293  (la ppc::allocptr (:apply - ppc64::fulltag-misc
2294                            (:apply logand (lognot 15)
2295                                    (:apply + (+ 15 8) nbytes)))
2296      ppc::allocptr)
2297  (tdlt ppc::allocptr ppc::allocbase)
2298  (std Rheader ppc64::misc-header-offset ppc::allocptr)
2299  (mr dest ppc::allocptr)
2300  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits)))
2301
2302(define-ppc64-vinsn vstack-discard (()
2303                                    ((nwords :u32const)))
2304  ((:not (:pred = nwords 0))
2305   (la ppc::vsp (:apply ash nwords ppc64::word-shift) ppc::vsp)))
2306
2307
2308(define-ppc64-vinsn lcell-load (((dest :lisp))
2309                                ((cell :lcell)
2310                                 (top :lcell)))
2311  (ld dest (:apply - 
2312                   (:apply - (:apply calc-lcell-depth top) ppc64::word-size-in-bytes)
2313                   (:apply calc-lcell-offset cell)) ppc::vsp))
2314
2315(define-ppc64-vinsn vframe-load (((dest :lisp))
2316                                 ((frame-offset :u16const)
2317                                  (cur-vsp :u16const)))
2318  (ld dest (:apply - (:apply - cur-vsp ppc64::word-size-in-bytes) frame-offset) ppc::vsp))
2319
2320(define-ppc64-vinsn lcell-store (()
2321                                 ((src :lisp)
2322                                  (cell :lcell)
2323                                  (top :lcell)))
2324  (stw src (:apply - 
2325                   (:apply - (:apply calc-lcell-depth top) 4)
2326                   (:apply calc-lcell-offset cell)) ppc::vsp))
2327
2328(define-ppc64-vinsn vframe-store (()
2329                                  ((src :lisp)
2330                                   (frame-offset :u16const)
2331                                   (cur-vsp :u16const)))
2332  (std src (:apply - (:apply - cur-vsp 8) frame-offset) ppc::vsp))
2333
2334(define-ppc64-vinsn load-vframe-address (((dest :imm))
2335                                         ((offset :s16const)))
2336  (la dest offset ppc::vsp))
2337
2338(define-ppc64-vinsn copy-lexpr-argument (()
2339                                         ()
2340                                         ((temp :lisp)))
2341  (ldx temp ppc::vsp ppc::nargs)
2342  (stdu temp -8 ppc::vsp))
2343
2344;;; Boxing/unboxing of integers.
2345
2346;;; Treat the low 8 bits of VAL as an unsigned integer; set RESULT to
2347;;; the equivalent fixnum.
2348(define-ppc64-vinsn u8->fixnum (((result :imm)) 
2349                                ((val :u8)) 
2350                                ())
2351  (clrlsldi result val (- ppc64::nbits-in-word 8) ppc64::fixnumshift))
2352
2353;;; Treat the low 8 bits of VAL as a signed integer; set RESULT to the
2354;;; equivalent fixnum.
2355(define-ppc64-vinsn s8->fixnum (((result :imm)) 
2356                                ((val :s8)) 
2357                                ())
2358  (sldi result val (- ppc64::nbits-in-word 8))
2359  (sradi result result (- (- ppc64::nbits-in-word 8) ppc64::fixnumshift)))
2360
2361
2362;;; Treat the low 16 bits of VAL as an unsigned integer; set RESULT to
2363;;; the equivalent fixnum.
2364(define-ppc64-vinsn u16->fixnum (((result :imm)) 
2365                                 ((val :u16)) 
2366                                 ())
2367  (clrlsldi result val (- ppc64::nbits-in-word 16) ppc64::fixnumshift))
2368
2369;;; Treat the low 16 bits of VAL as a signed integer; set RESULT to
2370;;; the equivalent fixnum.
2371(define-ppc64-vinsn s16->fixnum (((result :imm)) 
2372                                 ((val :s16)) 
2373                                 ())
2374  (sldi result val (- ppc64::nbits-in-word 16))
2375  (sradi result result (- (- ppc64::nbits-in-word 16) ppc64::fixnumshift)))
2376
2377(define-ppc64-vinsn fixnum->s16 (((result :s16))
2378                                 ((src :imm)))
2379  (sradi result src ppc64::fixnumshift))
2380
2381(define-ppc64-vinsn s32->integer (((result :lisp))
2382                                  ((src :s32))
2383                                  ((temp :s64)))
2384  (extsw temp src)
2385  (sldi result temp ppc64::fixnumshift))
2386
2387
2388;;; A signed 64-bit untagged value can be at worst a 2-digit
2389;;; (minimal-sized) bignum.  There should be something very much like
2390;;; this that takes a stack-consed bignum result ...
2391(define-ppc64-vinsn s64->integer (((result :lisp))
2392                                  ((src :s64))
2393                                  ((crf (:crf 0)) ; a casualty
2394                                   (temp :s64)
2395                                   (header :s64)))
2396  (addo temp src src)
2397  (addo temp temp temp)
2398  (addo. result temp temp)
2399  (rotldi temp src 32)
2400  (bns+ :done)
2401  (mtxer ppc::rzero)
2402  (li header ppc64::two-digit-bignum-header)
2403  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2404  (tdlt ppc::allocptr ppc::allocbase)
2405  (std header ppc64::misc-header-offset ppc::allocptr)
2406  (mr result ppc::allocptr)
2407  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
2408  (std temp ppc64::misc-data-offset result)
2409  :done)
2410
2411
2412;;; An unsigned 32-bit untagged value is a fixnum.
2413(define-ppc64-vinsn u32->integer (((result :lisp))
2414                                  ((src :u32)))
2415  (sldi result src ppc64::fixnumshift))
2416
2417;;; An unsigned 64-bit untagged value is either a fixnum, a 2 (32-bit)
2418;;; digit bignum, or a 3 (32-bit) digit bignum.
2419(define-ppc64-vinsn u64->integer (((result :lisp))
2420                                  ((src :u64))
2421                                  ((temp :u64)
2422                                   (header :u64)
2423                                   (crf0 (:crf 0))
2424                                   (crf1 :crf)))
2425  (clrrdi. temp src (- 63 ppc64::nfixnumtagbits))
2426  (cmpdi crf1 src 0)
2427  (sldi result src ppc64::fixnumshift)
2428  (beq crf0 :done)
2429  (rotldi temp src 32)
2430  (li header ppc64::two-digit-bignum-header)
2431  (blt crf1 :three)
2432  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2433  (tdlt ppc::allocptr ppc::allocbase)
2434  (std header ppc64::misc-header-offset ppc::allocptr)
2435  (mr result ppc::allocptr)
2436  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
2437  (b :store)
2438  :three
2439  (la ppc::allocptr (- ppc64::fulltag-misc 32) ppc::allocptr)
2440  (tdlt ppc::allocptr ppc::allocbase)
2441  (std header ppc64::misc-header-offset ppc::allocptr)
2442  (mr result ppc::allocptr)
2443  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
2444  :store
2445  (std temp ppc64::misc-data-offset result)
2446  :done)
2447
2448(define-ppc64-vinsn u16->u32 (((dest :u32))
2449                              ((src :u16)))
2450  (clrlwi dest src 16))
2451
2452(define-ppc64-vinsn u8->u32 (((dest :u32))
2453                             ((src :u8)))
2454  (clrlwi dest src 24))
2455
2456
2457(define-ppc64-vinsn s16->s32 (((dest :s32))
2458                              ((src :s16)))
2459  (extsh dest src))
2460
2461(define-ppc64-vinsn s8->s32 (((dest :s32))
2462                             ((src :s8)))
2463  (extsb dest src))
2464
2465
2466;;; ... of floats ...
2467
2468;;; Heap-cons a double-float to store contents of FPREG.  Hope that we
2469;;; don't do this blindly.
2470(define-ppc64-vinsn double->heap (((result :lisp)) ; tagged as a double-float
2471                                  ((fpreg :double-float)) 
2472                                  ((header-temp :u32)))
2473  (li header-temp (arch::make-vheader ppc64::double-float.element-count ppc64::subtag-double-float))
2474  (la ppc::allocptr (- ppc64::fulltag-misc ppc64::double-float.size) ppc::allocptr)
2475  (tdlt ppc::allocptr ppc::allocbase)
2476  (std header-temp ppc64::misc-header-offset ppc::allocptr)
2477  (mr result ppc::allocptr)
2478  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
2479  (stfd fpreg ppc64::double-float.value result)  )
2480
2481
2482(define-ppc64-vinsn single->node (((result :lisp)) ; tagged as a single-float
2483                                  ((fpreg :single-float)))
2484  (stfs fpreg ppc64::tcr.single-float-convert ppc64::rcontext)
2485  (ld result  ppc64::tcr.single-float-convert ppc64::rcontext))
2486
2487
2488;;; "dest" is preallocated, presumably on a stack somewhere.
2489(define-ppc64-vinsn store-double (()
2490                                  ((dest :lisp)
2491                                   (source :double-float))
2492                                  ())
2493  (stfd source ppc64::double-float.value dest))
2494
2495(define-ppc64-vinsn get-double (((target :double-float))
2496                                ((source :lisp))
2497                                ())
2498  (lfd target ppc64::double-float.value source))
2499
2500;;; Extract a double-float value, typechecking in the process.
2501;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
2502;;; instead of replicating it ..
2503
2504(define-ppc64-vinsn get-double? (((target :double-float))
2505                                 ((source :lisp))
2506                                 ((tag :u8)
2507                                  (crf :crf)))
2508  (clrldi tag source (- ppc64::nbits-in-word ppc64::ntagbits))
2509  (cmpdi crf tag ppc64::fulltag-misc)
2510  (bne crf :do-trap)
2511  (lbz tag ppc64::misc-subtag-offset source)
2512  :do-trap
2513  (tdnei tag ppc64::subtag-double-float)
2514  (lfd target ppc64::double-float.value source))
2515
2516(define-ppc64-vinsn double-to-single (((result :single-float))
2517                                       ((arg :double-float)))
2518  (frsp result arg))
2519
2520
2521(define-ppc64-vinsn store-single (()
2522                                  ((dest :lisp)
2523                                   (source :single-float))
2524                                  ())
2525  (stfs source ppc64::tcr.single-float-convert ppc64::rcontext)
2526  (ld dest ppc64::tcr.single-float-convert ppc64::rcontext))
2527
2528(define-ppc64-vinsn get-single (((target :single-float))
2529                                ((source :lisp)))
2530  (std source ppc64::tcr.single-float-convert ppc64::rcontext)
2531  (lfs target ppc64::tcr.single-float-convert ppc64::rcontext))
2532
2533;;; ... of characters ...
2534(define-ppc64-vinsn charcode->u16 (((dest :u16))
2535                                   ((src :imm))
2536                                   ())
2537  (srdi dest src ppc64::charcode-shift))
2538
2539(define-ppc64-vinsn character->fixnum (((dest :lisp))
2540                                       ((src :lisp))
2541                                       ())
2542  (srdi dest src (- ppc64::charcode-shift ppc64::fixnumshift)))
2543
2544(define-ppc64-vinsn character->code (((dest :u32))
2545                                     ((src :lisp)))
2546  (srdi dest src ppc64::charcode-shift))
2547
2548
2549(define-ppc64-vinsn fixnum->char (((dest :lisp))
2550                                  ((src :imm))
2551                                  ((temp :u64)
2552                                   (crf0 (:crf 0))))
2553  (srdi temp src (+ ppc64::fixnumshift 1))
2554  (cmpldi temp (ash #xffff -1))
2555  (srdi temp src (+ ppc64::fixnumshift 11))
2556  (beq :bad)
2557  (cmpdi temp 27)
2558  (sldi dest src (- ppc64::charcode-shift ppc64::fixnumshift))
2559  (bne+ :ok)
2560  :bad
2561  (li dest (target-nil-value))
2562  (b :done)
2563  :ok
2564  (addi dest dest ppc64::subtag-character)
2565  :done)
2566
2567(define-ppc64-vinsn code-char->char (((dest :lisp))
2568                                     ((src :imm))
2569                               ())
2570  (sldi dest src (- ppc64::charcode-shift ppc64::fixnumshift))
2571  (ori dest dest ppc64::subtag-character))
2572
2573
2574(define-ppc64-vinsn u32->char (((dest :lisp))
2575                              ((src :u32))
2576                               ())
2577  (sldi dest src ppc64::charcode-shift)
2578  (ori dest dest ppc64::subtag-character))
2579
2580;;; ... Macptrs ...
2581
2582(define-ppc64-vinsn deref-macptr (((addr :address))
2583                                  ((src :lisp))
2584                                  ())
2585  (ld addr ppc64::macptr.address src))
2586
2587(define-ppc64-vinsn set-macptr-address (()
2588                                        ((addr :address)
2589                                         (src :lisp))
2590                                        ())
2591  (std addr ppc64::macptr.address src))
2592
2593
2594(define-ppc64-vinsn macptr->heap (((dest :lisp))
2595                                  ((address :address))
2596                                  ((header :u64)))
2597  (li header (logior (ash ppc64::macptr.element-count ppc64::num-subtag-bits) ppc64::subtag-macptr))
2598  (la ppc::allocptr (- ppc64::fulltag-misc ppc64::macptr.size) ppc::allocptr)
2599  (tdlt ppc::allocptr ppc::allocbase)
2600  (std header ppc64::misc-header-offset ppc::allocptr)
2601  (mr dest ppc::allocptr)
2602  (rldicr ppc::allocptr ppc::allocptr 0 (- 63 ppc64::ntagbits))
2603  ;; It's not necessary to zero out the domain/type fields, since newly
2604  ;; heap-allocated memory's guaranteed to be 0-filled.
2605  (std address ppc64::macptr.address dest))
2606
2607(define-ppc64-vinsn macptr->stack (((dest :lisp))
2608                                   ((address :address))
2609                                   ((header :u64)))
2610  (li header ppc64::macptr-header)
2611  (stdu ppc::tsp (- (+ 16 ppc64::macptr.size)) ppc::tsp)
2612  (std ppc::tsp 8 ppc::tsp)
2613  (std header (+ 16 ppc64::fulltag-misc ppc64::macptr.header) ppc::tsp)
2614  (std address (+ 16 ppc64::fulltag-misc ppc64::macptr.address) ppc::tsp)
2615  ;; It -is- necessary to zero out the domain/type fields here, since
2616  ;; stack-allocated memory isn't guaranteed to be 0-filled.
2617  (std ppc::rzero (+ 16 ppc64::fulltag-misc ppc64::macptr.domain) ppc::tsp)
2618  (std ppc::rzero (+ 16 ppc64::fulltag-misc ppc64::macptr.type) ppc::tsp)
2619  (la dest (+ 16 ppc64::fulltag-misc) ppc::tsp))
2620
2621 
2622(define-ppc64-vinsn adjust-stack-register (()
2623                                           ((reg t)
2624                                            (amount :s16const)))
2625  (la reg amount reg))
2626
2627(define-ppc64-vinsn adjust-vsp (()
2628                                ((amount :s16const)))
2629  (la ppc::vsp amount ppc::vsp))
2630
2631(define-ppc64-vinsn adjust-sp (()
2632                               ((amount :s16const)))
2633  (la ppc::sp amount ppc::sp))
2634
2635;;; Arithmetic on fixnums & unboxed numbers
2636
2637(define-ppc64-vinsn u64-lognot (((dest :u64))
2638                                ((src :u64))
2639                                ())
2640  (not dest src))
2641
2642(define-ppc64-vinsn fixnum-lognot (((dest :imm))
2643                                   ((src :imm))
2644                                   ((temp :u64)))
2645  (not temp src)
2646  (rldicr dest temp 0 (- 63 ppc64::nfixnumtagbits)))
2647
2648
2649(define-ppc64-vinsn negate-fixnum-overflow-inline (((dest :lisp))
2650                                                   ((src :imm))
2651                                                   ((unboxed :s64)
2652                                                    (header :u64)))
2653  (nego. dest src)
2654  (bns+ :done)
2655  (mtxer ppc::rzero)
2656  (sradi unboxed dest ppc64::fixnumshift)
2657  (li header ppc64::two-digit-bignum-header)
2658  (rotldi unboxed unboxed 32)
2659  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 ppc64::fixnumshift))))
2660  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2661  (tdlt ppc::allocptr ppc::allocbase)
2662  (std header ppc64::misc-header-offset ppc::allocptr)
2663  (mr dest ppc::allocptr)
2664  (clrrdi ppc::allocptr ppc::allocptr ppc64::ntagbits)
2665  (std unboxed ppc64::misc-data-offset dest)
2666  :done)
2667
2668(define-ppc64-vinsn negate-fixnum-overflow-ool (()
2669                                                ((src :imm))
2670                                                )
2671  (nego. ppc::arg_z src)
2672  (bsola- .SPfix-overflow)
2673  :done)
2674 
2675                                                 
2676                                       
2677(define-ppc64-vinsn negate-fixnum-no-ovf (((dest :lisp))
2678                                          ((src :imm)))
2679 
2680  (neg dest src))
2681 
2682
2683(define-ppc64-vinsn logior-high (((dest :imm))
2684                                 ((src :imm)
2685                                  (high :u16const)))
2686  (oris dest src high))
2687
2688(define-ppc64-vinsn logior-low (((dest :imm))
2689                                ((src :imm)
2690                                 (low :u16const)))
2691  (ori dest src low))
2692
2693                           
2694                           
2695(define-ppc64-vinsn %logior2 (((dest :imm))
2696                              ((x :imm)
2697                               (y :imm))
2698                              ())
2699  (or dest x y))
2700
2701(define-ppc64-vinsn logand-high (((dest :imm))
2702                                 ((src :imm)
2703                                  (high :u16const))
2704                                 ((crf0 (:crf 0))))
2705  (andis. dest src high))
2706
2707(define-ppc64-vinsn logand-low (((dest :imm))
2708                                ((src :imm)
2709                                 (low :u16const))
2710                                ((crf0 (:crf 0))))
2711  (andi. dest src low))
2712
2713
2714(define-ppc64-vinsn %logand2 (((dest :imm))
2715                              ((x :imm)
2716                               (y :imm))
2717                              ())
2718  (and dest x y))
2719
2720(define-ppc64-vinsn clear-left (((dest :imm))
2721                                ((src :imm)
2722                                 (nbits :s8const)))
2723  (rldicl dest src 0 (:apply 1+ nbits)))
2724
2725(define-ppc64-vinsn clear-right (((dest :imm))
2726                                 ((src :imm)
2727                                  (nbits :s8const)))
2728  (rldicr dest src 0 (:apply - 63 nbits)))
2729
2730(define-ppc64-vinsn logxor-high (((dest :imm))
2731                                 ((src :imm)
2732                                  (high :u16const)))
2733  (xoris dest src high))
2734
2735(define-ppc64-vinsn logxor-low (((dest :imm))
2736                                ((src :imm)
2737                                 (low :u16const)))
2738  (xori dest src low))
2739
2740                           
2741
2742(define-ppc64-vinsn %logxor2 (((dest :imm))
2743                              ((x :imm)
2744                               (y :imm))
2745                              ())
2746  (xor dest x y))
2747
2748(define-ppc64-vinsn %ilsl (((dest :imm))
2749                           ((count :imm)
2750                            (src :imm))
2751                           ((temp :u32)
2752                            (crx :crf)))
2753  (cmpdi crx count (ash 63 ppc64::fixnumshift))
2754  (srdi temp count ppc64::fixnumshift)
2755  (sld dest src temp)
2756  (ble+ crx :foo)
2757  (li dest 0)
2758  :foo)
2759
2760(define-ppc64-vinsn %ilsl-c (((dest :imm))
2761                             ((count :u8const)
2762                              (src :imm)))
2763  ;; Hard to use ppcmacroinstructions that expand into expressions
2764  ;; involving variables.
2765  (rldicr dest src count (:apply - ppc64::least-significant-bit count)))
2766
2767
2768(define-ppc64-vinsn %ilsr-c (((dest :imm))
2769                             ((count :u8const)
2770                              (src :imm))
2771                             ((temp :s64)))
2772  (rldicl temp src (:apply - 64 count) count)
2773  (rldicr dest temp 0 (- 63 ppc64::fixnumshift)))
2774
2775
2776
2777;;; 68k did the right thing for counts < 64 - fixnumshift but not if greater
2778;;; so load-byte fails in 3.0 also
2779
2780
2781(define-ppc64-vinsn %iasr (((dest :imm))
2782                           ((count :imm)
2783                            (src :imm))
2784                           ((temp :s32)
2785                            (crx :crf)))
2786  (cmpdi crx count (ash 63 ppc64::fixnumshift))
2787  (sradi temp count ppc64::fixnumshift)
2788  (srad temp src temp)
2789  (ble+ crx :foo)
2790  (sradi temp src 63)
2791  :foo
2792  (rldicr dest temp 0 (- 63 ppc64::fixnumshift)))
2793
2794(define-ppc64-vinsn %iasr-c (((dest :imm))
2795                             ((count :u8const)
2796                              (src :imm))
2797                             ((temp :s32)))
2798  (sradi temp src count)
2799  (rldicr dest temp 0 (- 63 ppc64::fixnumshift)))
2800
2801(define-ppc64-vinsn %ilsr (((dest :imm))
2802                           ((count :imm)
2803                            (src :imm))
2804                           ((temp :s32)
2805                            (crx :crf)))
2806  (cmpdi crx count (ash 63 ppc64::fixnumshift))
2807  (srdi temp count ppc64::fixnumshift)
2808  (srd temp src temp)
2809  (rldicr dest temp 0 (- 63 ppc64::fixnumshift))
2810  (ble+ crx :foo)
2811  (li dest 0)
2812  :foo 
2813  )
2814
2815(define-ppc64-vinsn natural-shift-left (((dest :u64))
2816                                        ((src :u64)
2817                                         (count :u8const)))
2818  (rldicr dest src count  (:apply - 63 count)))
2819
2820(define-ppc64-vinsn natural-shift-right (((dest :u64))
2821                                         ((src :u64)
2822                                          (count :u8const)))
2823  (rldicr dest src (:apply - 64 count) count))
2824
2825(define-ppc64-vinsn sign-extend-halfword (((dest :imm))
2826                                          ((src :imm)))
2827  (sldi dest src (- 48 ppc64::fixnumshift))
2828  (sradi dest dest (- 48 ppc64::fixnumshift)))
2829
2830
2831
2832(define-ppc64-vinsn fixnum-add (((dest t))
2833                                ((x t)
2834                                 (y t)))
2835  (add dest x y))
2836
2837
2838(define-ppc64-vinsn fixnum-add-overflow-ool (()
2839                                             ((x :imm)
2840                                              (y :imm))
2841                                             ((cr0 (:crf 0))))
2842  (addo. ppc::arg_z x y)
2843  (bsola- .SPfix-overflow))
2844
2845(define-ppc64-vinsn fixnum-add-overflow-inline (((dest :lisp))
2846                                                ((x :imm)
2847                                                 (y :imm))
2848                                                ((cr0 (:crf 0))
2849                                                 (unboxed :s64)
2850                                                 (header :u64)))
2851  (addo. dest x y)
2852  (bns+ cr0 :done)
2853  (mtxer ppc::rzero)
2854  (sradi unboxed dest ppc64::fixnumshift)
2855  (li header ppc64::two-digit-bignum-header)
2856  (rotldi unboxed unboxed 32)
2857  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 ppc64::fixnumshift))))
2858  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2859  (tdlt ppc::allocptr ppc::allocbase)
2860  (std header ppc64::misc-header-offset ppc::allocptr)
2861  (mr dest ppc::allocptr)
2862  (clrrdi ppc::allocptr ppc::allocptr ppc64::ntagbits)
2863  (std unboxed ppc64::misc-data-offset dest)
2864  :done)
2865
2866(define-ppc64-vinsn fixnum-add-overflow-inline-skip (((dest :lisp))
2867                                                     ((x :imm)
2868                                                      (y :imm)
2869                                                      (done :label))
2870                                                     ((cr0 (:crf 0))
2871                                                      (unboxed :s64)
2872                                                      (header :u64)))
2873  (addo. dest x y)
2874  (bns+ cr0 done)
2875  (mtxer ppc::rzero)
2876  (sradi unboxed dest ppc64::fixnumshift)
2877  (li header ppc64::two-digit-bignum-header)
2878  (rotldi unboxed unboxed 32)
2879  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 ppc64::fixnumshift))))
2880  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2881  (tdlt ppc::allocptr ppc::allocbase)
2882  (std header ppc64::misc-header-offset ppc::allocptr)
2883  (mr dest ppc::allocptr)
2884  (clrrdi ppc::allocptr ppc::allocptr ppc64::ntagbits)
2885  (std unboxed ppc64::misc-data-offset dest)
2886  (b done))
2887 
2888
2889 
2890
2891;;;  (setq dest (- x y))
2892(define-ppc64-vinsn fixnum-sub (((dest t))
2893                                ((x t)
2894                                 (y t)))
2895  (subf dest y x))
2896
2897(define-ppc64-vinsn fixnum-sub-from-constant (((dest :imm))
2898                                              ((x :s16const)
2899                                               (y :imm)))
2900  (subfic dest y (:apply ash x ppc64::fixnumshift)))
2901
2902
2903
2904
2905(define-ppc64-vinsn fixnum-sub-overflow-ool (()
2906                                             ((x :imm)
2907                                              (y :imm)))
2908  (subo. ppc::arg_z x y)
2909  (bsola- .SPfix-overflow))
2910
2911(define-ppc64-vinsn fixnum-sub-overflow-inline (((dest :lisp))
2912                                                ((x :imm)
2913                                                 (y :imm))
2914                                                ((cr0 (:crf 0))
2915                                                 (unboxed :s64)
2916                                                 (header :u64)))
2917  (subo. dest x y)
2918  (bns+ cr0 :done)
2919  (mtxer ppc::rzero)
2920  (sradi unboxed dest ppc64::fixnumshift)
2921  (li header ppc64::two-digit-bignum-header)
2922  (rotldi unboxed unboxed 32)
2923  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 ppc64::fixnumshift))))
2924  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2925  (tdlt ppc::allocptr ppc::allocbase)
2926  (std header ppc64::misc-header-offset ppc::allocptr)
2927  (mr dest ppc::allocptr)
2928  (clrrdi ppc::allocptr ppc::allocptr ppc64::ntagbits)
2929  (std unboxed ppc64::misc-data-offset dest)
2930  :done)
2931
2932(define-ppc64-vinsn fixnum-sub-overflow-inline-skip (((dest :lisp))
2933                                                     ((x :imm)
2934                                                      (y :imm)
2935                                                      (done :label))
2936                                                     ((cr0 (:crf 0))
2937                                                      (unboxed :s64)
2938                                                      (header :u64)))
2939  (subo. dest x y)
2940  (bns+ cr0 done)
2941  (mtxer ppc::rzero)
2942  (sradi unboxed dest ppc64::fixnumshift)
2943  (li header ppc64::two-digit-bignum-header)
2944  (rotldi unboxed unboxed 32)
2945  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 ppc64::fixnumshift))))
2946  (la ppc::allocptr (- ppc64::fulltag-misc 16) ppc::allocptr)
2947  (tdlt ppc::allocptr ppc::allocbase)
2948  (std header ppc64::misc-header-offset ppc::allocptr)
2949  (mr dest ppc::allocptr)
2950  (clrrdi ppc::allocptr ppc::allocptr ppc64::ntagbits)
2951  (std unboxed ppc64::misc-data-offset dest)
2952  (b done))
2953
2954;;; This is, of course, also "subtract-immediate."
2955(define-ppc64-vinsn add-immediate (((dest t))
2956                                   ((src t)
2957                                    (upper :u32const)
2958                                    (lower :u32const)))
2959  ((:not (:pred = upper 0))
2960   (addis dest src upper)
2961   ((:not (:pred = lower 0))
2962    (addi dest dest lower)))
2963  ((:and (:pred = upper 0) (:not (:pred = lower 0)))
2964   (addi dest src lower)))
2965
2966;This must unbox one reg, but hard to tell which is better.
2967;(The one with the smaller absolute value might be)
2968(define-ppc64-vinsn multiply-fixnums (((dest :imm))
2969                                      ((a :imm)
2970                                       (b :imm))
2971                                      ((unboxed :s32)))
2972  (sradi unboxed b ppc64::fixnumshift)
2973  (mulld dest a unboxed))
2974
2975(define-ppc64-vinsn multiply-immediate (((dest :imm))
2976                                        ((boxed :imm)
2977                                         (const :s16const)))
2978  (mulli dest boxed const))
2979
2980;;; Mask out the code field of a base character; the result
2981;;; should be EXACTLY = to subtag-base-char
2982(define-ppc64-vinsn mask-base-char (((dest :u32))
2983                                    ((src :imm)))
2984  (clrldi dest src (- ppc64::nbits-in-word ppc64::num-subtag-bits)))
2985
2986;;; Set dest (of type :s64!) to 0 iff VAL is an istruct of type TYPE
2987(define-ppc64-vinsn istruct-typep (((dest :s64))
2988                                   ((val :lisp)
2989                                    (type :lisp))
2990                                   ((crf :crf)
2991                                    (temp :lisp)))
2992  (clrldi dest val (- ppc64::nbits-in-word ppc64::ntagbits))
2993  (cmpdi crf dest ppc64::fulltag-misc)
2994  (li dest -1)
2995  (bne crf :done)
2996  (lbz dest ppc64::misc-subtag-offset val)
2997  (cmpdi crf dest ppc64::subtag-istruct)
2998  (bne crf :done)
2999  (ld temp ppc64::misc-data-offset val)
3000  (subf dest type temp)
3001  :done)
3002                             
3003;;; Boundp, fboundp stuff.
3004(define-ppc64-vinsn (ref-symbol-value :call :subprim-call)
3005    (((val :lisp))
3006     ((sym (:lisp (:ne val)))))
3007  (bla .SPspecrefcheck))
3008
3009(define-ppc64-vinsn ref-symbol-value-inline (((dest :lisp))
3010                                              ((src (:lisp (:ne dest))))
3011                                              ((table :imm)
3012                                               (idx :imm)))
3013  (ld idx ppc64::symbol.binding-index src)
3014  (ld table ppc64::tcr.tlb-limit ppc64::rcontext)
3015  (cmpd idx table)
3016  (ld table ppc64::tcr.tlb-pointer ppc64::rcontext)
3017  (bge :symbol)
3018  (ldx dest table idx)
3019  (cmpdi dest ppc64::subtag-no-thread-local-binding)
3020  (bne :done)
3021  :symbol
3022  (ld dest ppc64::symbol.vcell src)
3023  :done
3024  (tdeqi dest ppc64::unbound-marker))
3025
3026(define-ppc64-vinsn (%ref-symbol-value :call :subprim-call)
3027    (((val :lisp))
3028     ((sym (:lisp (:ne val)))))
3029  (bla .SPspecref))
3030
3031(define-ppc64-vinsn %ref-symbol-value-inline (((dest :lisp))
3032                                              ((src (:lisp (:ne dest))))
3033                                              ((table :imm)
3034                                               (idx :imm)))
3035  (ld idx ppc64::symbol.binding-index src)
3036  (ld table ppc64::tcr.tlb-limit ppc64::rcontext)
3037  (cmpd idx table)
3038  (ld table ppc64::tcr.tlb-pointer ppc64::rcontext)
3039  (bge :symbol)
3040  (ldx dest table idx)
3041  (cmpdi dest ppc64::subtag-no-thread-local-binding)
3042  (bne :done)
3043  :symbol
3044  (ld dest ppc64::symbol.vcell src)
3045  :done
3046  )
3047
3048(define-ppc64-vinsn (setq-special :call :subprim-call)
3049    (()
3050     ((sym :lisp)
3051      (val :lisp)))
3052  (bla .SPspecset))
3053
3054
3055(define-ppc64-vinsn symbol-function (((val :lisp))
3056                                     ((sym (:lisp (:ne val))))
3057                                     ((crf :crf)
3058                                      (tag :u32)))
3059  (ld val ppc64::symbol.fcell sym)
3060  (clrldi tag val (- 64 ppc64::ntagbits))
3061  (cmpdi crf tag ppc64::fulltag-misc)
3062  (bne- crf :bad)
3063  (lbz tag ppc64::misc-subtag-offset val)
3064  (cmpdi crf tag ppc64::subtag-function)
3065  (beq+ crf :good)
3066  :bad 
3067  (uuo_interr arch::error-udf sym)
3068  :good)
3069
3070(define-ppc64-vinsn (temp-push-unboxed-word :push :word :tsp)
3071    (()
3072     ((w :u64)))
3073  (stdu ppc::tsp -32 ppc::tsp)
3074  (std ppc::tsp 8 ppc::tsp)
3075  (std w 16 ppc::tsp))
3076
3077(define-ppc64-vinsn (temp-pop-unboxed-word :pop :word :tsp)
3078    (((w :u64))
3079     ())
3080  (ld w 16 ppc::tsp)
3081  (la ppc::tsp 32 ppc::tsp))
3082
3083(define-ppc64-vinsn (temp-push-double-float :push :doubleword :tsp)
3084    (((d :double-float))
3085     ())
3086  (stdu ppc::tsp -32 ppc::tsp)
3087  (std ppc::tsp 8 ppc::tsp)
3088  (stfd d 16 ppc::tsp))
3089
3090(define-ppc64-vinsn (temp-pop-double-float :pop :doubleword :tsp)
3091    (()
3092     ((d :double-float)))
3093  (lfd d 16 ppc::tsp)
3094  (la ppc::tsp 32 ppc::tsp))
3095
3096(define-ppc64-vinsn (temp-push-single-float :push :word :tsp)
3097    (((s :single-float))
3098     ())
3099  (stdu ppc::tsp -32 ppc::tsp)
3100  (std ppc::tsp 8 ppc::tsp)
3101  (stfs s 16 ppc::tsp))
3102
3103(define-ppc64-vinsn (temp-pop-single-float :pop :word :tsp)
3104    (()
3105     ((s :single-float)))
3106  (lfs s 16 ppc::tsp)
3107  (la ppc::tsp 32 ppc::tsp))
3108
3109
3110(define-ppc64-vinsn (save-nvrs-individually :push :node :vsp :multiple)
3111    (()
3112     ((first :u8const)))
3113  (stdu ppc::save0 -8 ppc::vsp)
3114  ((:pred <= first ppc::save1)
3115   (stdu ppc::save1 -8 ppc::vsp)
3116   ((:pred <= first ppc::save2)
3117    (stdu ppc::save2 -8 ppc::vsp)
3118    ((:pred <= first ppc::save3)
3119     (stdu ppc::save3 -8 ppc::vsp)
3120     ((:pred <= first ppc::save4)
3121      (stdu ppc::save4 -8 ppc::vsp)
3122      ((:pred <= first ppc::save5)
3123       (stdu ppc::save5 -8 ppc::vsp)
3124       ((:pred <= first ppc::save6)
3125        (stdu ppc::save6 -8 ppc::vsp)
3126        ((:pred = first ppc::save7)
3127         (stdu ppc::save7 -8 ppc::vsp)))))))))
3128
3129(define-ppc64-vinsn (save-nvrs :push :node :vsp :multiple)
3130    (()
3131     ((first :u8const)))
3132  ;; There's no "stmd" instruction.
3133  (stdu ppc::save0 -8 ppc::vsp)
3134  ((:pred <= first ppc::save1)
3135   (stdu ppc::save1 -8 ppc::vsp)
3136   ((:pred <= first ppc::save2)
3137    (stdu ppc::save2 -8 ppc::vsp)
3138    ((:pred <= first ppc::save3)
3139     (stdu ppc::save3 -8 ppc::vsp)
3140     ((:pred <= first ppc::save4)
3141      (stdu ppc::save4 -8 ppc::vsp)
3142      ((:pred <= first ppc::save5)
3143       (stdu ppc::save5 -8 ppc::vsp)
3144       ((:pred <= first ppc::save6)
3145        (stdu ppc::save6 -8 ppc::vsp)
3146        ((:pred = first ppc::save7)
3147         (stdu ppc::save7 -8 ppc::vsp)))))))))
3148
3149
3150(define-ppc64-vinsn (restore-nvrs :pop :node :vsp :multiple)
3151    (()
3152     ((firstreg :u8const)
3153      (basereg :imm)
3154      (offset :s16const)))
3155  ((:pred = firstreg ppc::save7)
3156   (ld ppc::save7 offset basereg)
3157   (ld ppc::save6 (:apply + offset 8) basereg)
3158   (ld ppc::save5 (:apply + offset 16) basereg)
3159   (ld ppc::save4 (:apply + offset 24) basereg)
3160   (ld ppc::save3 (:apply + offset 32) basereg)
3161   (ld ppc::save2 (:apply + offset 40) basereg)
3162   (ld ppc::save1 (:apply + offset 48) basereg)
3163   (ld ppc::save0 (:apply + offset 56) basereg))
3164  ((:pred = firstreg ppc::save6)
3165   (ld ppc::save6 offset basereg)
3166   (ld ppc::save5 (:apply + offset 8) basereg)
3167   (ld ppc::save4 (:apply + offset 16) basereg)
3168   (ld ppc::save3 (:apply + offset 24) basereg)
3169   (ld ppc::save2 (:apply + offset 32) basereg)
3170   (ld ppc::save1 (:apply + offset 40) basereg)
3171   (ld ppc::save0 (:apply + offset 48) basereg))
3172  ((:pred = firstreg ppc::save5)
3173   (ld ppc::save5 offset basereg)
3174   (ld ppc::save4 (:apply + offset 8) basereg)
3175   (ld ppc::save3 (:apply + offset 16) basereg)
3176   (ld ppc::save2 (:apply + offset 24) basereg)
3177   (ld ppc::save1 (:apply + offset 32) basereg)
3178   (ld ppc::save0 (:apply + offset 40) basereg))
3179  ((:pred = firstreg ppc::save4)
3180   (ld ppc::save4 offset basereg)
3181   (ld ppc::save3 (:apply + offset 8) basereg)
3182   (ld ppc::save2 (:apply + offset 16) basereg)
3183   (ld ppc::save1 (:apply + offset 24) basereg)
3184   (ld ppc::save0 (:apply + offset 32) basereg))
3185  ((:pred = firstreg ppc::save3)
3186   (ld ppc::save3 offset basereg)
3187   (ld ppc::save2 (:apply + offset 8) basereg)
3188   (ld ppc::save1 (:apply + offset 16) basereg)
3189   (ld ppc::save0 (:apply + offset 24) basereg))
3190  ((:pred = firstreg ppc::save2)
3191   (ld ppc::save2 offset basereg)
3192   (ld ppc::save1 (:apply + offset 8) basereg)
3193   (ld ppc::save0 (:apply + offset 16) basereg))
3194  ((:pred = firstreg ppc::save1)
3195   (ld ppc::save1 offset basereg)
3196   (ld ppc::save0 (:apply + offset 8) basereg))
3197  ((:pred = firstreg ppc::save0)
3198   (ld ppc::save0 offset basereg)))
3199
3200(define-ppc64-vinsn %current-frame-ptr (((dest :imm))
3201                                        ())
3202  (mr dest ppc::sp))
3203
3204(define-ppc64-vinsn %current-tcr (((dest :imm))
3205                                  ())
3206  (mr dest ppc64::rcontext))
3207
3208(define-ppc64-vinsn (dpayback :call :subprim-call) (()
3209                                                    ((n :s16const))
3210                                                    ((temp (:u32 #.ppc::imm0))))
3211  ((:pred > n 1)
3212   (li temp n)
3213   (bla .SPunbind-n))
3214  ((:pred = n 1)
3215   (bla .SPunbind)))
3216
3217(define-ppc64-vinsn zero-double-float-register 
3218    (((dest :double-float))
3219     ())
3220  (fmr dest ppc::fp-zero))
3221
3222(define-ppc64-vinsn zero-single-float-register 
3223    (((dest :single-float))
3224     ())
3225  (fmr dest ppc::fp-zero))
3226
3227(define-ppc64-vinsn load-double-float-constant
3228    (((dest :double-float))
3229     ((high :u32)
3230      (low :u32)))
3231  (stw high -8 ppc::sp)
3232  (stw low -4 ppc::sp)
3233  (lfd dest -8 ppc::sp))
3234
3235(define-ppc64-vinsn load-single-float-constant
3236    (((dest :single-float))
3237     ((src t)))
3238  (stw src -4 ppc::sp)
3239  (lfs dest -4 ppc::sp))
3240
3241(define-ppc64-vinsn load-indexed-node (((node :lisp))
3242                                       ((base :lisp)
3243                                        (offset :s16const)))
3244  (ld node offset base))
3245
3246(define-ppc64-vinsn recover-saved-vsp (((dest :imm))
3247                                       ())
3248  (ld dest ppc64::lisp-frame.savevsp ppc::sp))
3249
3250
3251(define-ppc64-vinsn check-exact-nargs (()
3252                                       ((n :u16const)))
3253  (tdnei ppc::nargs (:apply ash n ppc64::word-shift)))
3254
3255(define-ppc64-vinsn check-min-nargs (()
3256                                     ((min :u16const)))
3257  (tdllti ppc::nargs (:apply ash min ppc64::word-shift)))
3258
3259(define-ppc64-vinsn check-max-nargs (()
3260                                     ((max :u16const)))
3261  (tdlgti ppc::nargs (:apply ash max ppc64::word-shift)))
3262
3263;;; Save context and establish FN.  The current VSP is the the
3264;;; same as the caller's, e.g., no arguments were vpushed.
3265(define-ppc64-vinsn save-lisp-context-vsp (()
3266                                           ()
3267                                           ((imm :u64)))
3268  (stdu ppc::sp (- ppc64::lisp-frame.size) ppc::sp)
3269  (std ppc::fn ppc64::lisp-frame.savefn ppc::sp)
3270  (std ppc::loc-pc ppc64::lisp-frame.savelr ppc::sp)
3271  (std ppc::vsp ppc64::lisp-frame.savevsp ppc::sp)
3272  (mr ppc::fn ppc::nfn)
3273  ;; Do a stack-probe ...
3274  (ld imm ppc64::tcr.cs-limit ppc64::rcontext)
3275  (tdllt ppc::sp imm))
3276
3277;;; Do the same thing via a subprim call.
3278(define-ppc64-vinsn (save-lisp-context-vsp-ool :call :subprim-call)
3279    (()
3280     ()
3281     ((imm (:u64 #.ppc::imm0))))
3282  (bla .SPsavecontextvsp))
3283
3284(define-ppc64-vinsn save-lisp-context-offset (()
3285                                              ((nbytes-vpushed :u16const))
3286                                              ((imm :u64)))
3287  (la imm nbytes-vpushed ppc::vsp)
3288  (stdu ppc::sp (- ppc64::lisp-frame.size) ppc::sp)
3289  (std ppc::fn ppc64::lisp-frame.savefn ppc::sp)
3290  (std ppc::loc-pc ppc64::lisp-frame.savelr ppc::sp)
3291  (std imm ppc64::lisp-frame.savevsp ppc::sp)
3292  (mr ppc::fn ppc::nfn)
3293  ;; Do a stack-probe ...
3294  (ld imm ppc64::tcr.cs-limit ppc64::rcontext)
3295  (tdllt ppc::sp imm))
3296
3297(define-ppc64-vinsn save-lisp-context-offset-ool (()
3298                                                  ((nbytes-vpushed :u16const))
3299                                                  ((imm (:u64 #.ppc::imm0))))
3300  (li imm nbytes-vpushed)
3301  (bla .SPsavecontext0))
3302
3303
3304(define-ppc64-vinsn save-lisp-context-lexpr (()
3305                                             ()
3306                                             ((imm :u64)))
3307  (stdu ppc::sp (- ppc64::lisp-frame.size) ppc::sp)
3308  (std ppc::rzero ppc64::lisp-frame.savefn ppc::sp)
3309  (std ppc::loc-pc ppc64::lisp-frame.savelr ppc::sp)
3310  (std ppc::vsp ppc64::lisp-frame.savevsp ppc::sp)
3311  (mr ppc::fn ppc::nfn)
3312  ;; Do a stack-probe ...
3313  (ld imm ppc64::tcr.cs-limit ppc64::rcontext)
3314  (tdllt ppc::sp imm))
3315 
3316(define-ppc64-vinsn save-cleanup-context (()
3317                                          ())
3318  ;; SP was this deep just a second ago, so no need to do a stack-probe.
3319  (mflr ppc::loc-pc)
3320  (stdu ppc::sp (- ppc64::lisp-frame.size) ppc::sp)
3321  (std ppc::rzero ppc64::lisp-frame.savefn ppc::sp)
3322  (std ppc::loc-pc ppc64::lisp-frame.savelr ppc::sp)
3323  (std ppc::vsp ppc64::lisp-frame.savevsp ppc::sp))
3324
3325;;; Vpush the argument registers.  We got at least "min-fixed" args;
3326;;; that knowledge may help us generate better code.
3327(define-ppc64-vinsn (save-lexpr-argregs :call :subprim-call)
3328    (()
3329     ((min-fixed :u16const))
3330     ((crfx :crf)
3331      (crfy :crf)
3332      (entry-vsp (:u64 #.ppc::imm0))
3333      (arg-temp :u64)))
3334  ((:pred >= min-fixed $numppcargregs)
3335   (stdu ppc::arg_x -8 ppc::vsp)
3336   (stdu ppc::arg_y -8 ppc::vsp)
3337   (stdu ppc::arg_z -8 ppc::vsp))
3338  ((:pred = min-fixed 2)                ; at least 2 args
3339   (cmpldi crfx ppc::nargs (ash 2 ppc64::word-shift))
3340   (beq crfx :yz2)                      ; skip arg_x if exactly 2
3341   (stdu ppc::arg_x -8 ppc::vsp)
3342   :yz2
3343   (stdu ppc::arg_y -8 ppc::vsp)
3344   (stdu ppc::arg_z -8 ppc::vsp))
3345  ((:pred = min-fixed 1)                ; at least one arg
3346   (cmpldi crfx ppc::nargs (ash 2 ppc64::word-shift))
3347   (blt crfx :z1)                       ; branch if exactly one
3348   (beq crfx :yz1)                      ; branch if exactly two
3349   (stdu ppc::arg_x -8 ppc::vsp)
3350   :yz1
3351   (stdu ppc::arg_y -8 ppc::vsp)
3352   :z1
3353   (stdu ppc::arg_z -8 ppc::vsp))
3354  ((:pred = min-fixed 0)
3355   (cmpldi crfx ppc::nargs (ash 2 ppc64::word-shift))
3356   (cmpldi crfy ppc::nargs 0)
3357   (beq crfx :yz0)                      ; exactly two
3358   (beq crfy :none)                     ; exactly zero
3359   (blt crfx :z0)                       ; one
3360                                        ; Three or more ...
3361   (stdu ppc::arg_x -8 ppc::vsp)
3362   :yz0
3363   (stdu ppc::arg_y -8 ppc::vsp)
3364   :z0
3365   (stdu ppc::arg_z -8 ppc::vsp)
3366   :none
3367   )
3368  ((:pred = min-fixed 0)
3369   (stdu ppc::nargs -8 ppc::vsp))
3370  ((:not (:pred = min-fixed 0))
3371   (subi arg-temp ppc::nargs (:apply ash min-fixed ppc64::word-shift))
3372   (stdu arg-temp -8 ppc::vsp))
3373  (add entry-vsp ppc::vsp ppc::nargs)
3374  (la entry-vsp 8 entry-vsp)
3375  (bla .SPlexpr-entry))
3376
3377
3378(define-ppc64-vinsn (jump-return-pc :jumpLR)
3379    (()
3380     ())
3381  (blr))
3382
3383(define-ppc64-vinsn (restore-full-lisp-context :lispcontext :pop :csp :lrRestore)
3384    (()
3385     ())
3386  (ld ppc::loc-pc ppc64::lisp-frame.savelr ppc::sp)
3387  (ld ppc::vsp ppc64::lisp-frame.savevsp ppc::sp)
3388  (ld ppc::fn ppc64::lisp-frame.savefn ppc::sp)
3389  (mtlr ppc::loc-pc)
3390  (la ppc::sp ppc64::lisp-frame.size ppc::sp))
3391
3392(define-ppc64-vinsn (restore-full-lisp-context-ool :lispcontext :pop :csp :lrRestore)
3393    (()
3394     ())
3395  (bla .SPrestorecontext)
3396  (mtlr ppc::loc-pc))
3397
3398(define-ppc64-vinsn (popj :lispcontext :pop :csp :lrRestore :jumpLR)
3399    (() 
3400     ())
3401  (ba .SPpopj))
3402
3403;;; Exiting from an UNWIND-PROTECT cleanup is similar to
3404;;; (and a little simpler than) returning from a function.
3405(define-ppc64-vinsn restore-cleanup-context (()
3406                                             ())
3407  (ld ppc::loc-pc ppc64::lisp-frame.savelr ppc::sp)
3408  (mtlr ppc::loc-pc)
3409  (la ppc::sp ppc64::lisp-frame.size ppc::sp))
3410
3411
3412
3413(define-ppc64-vinsn default-1-arg (()
3414                                   ((min :u16const))
3415                                   ((crf :crf)))
3416  (cmpldi crf ppc::nargs (:apply ash min ppc64::word-shift))
3417  (bne crf :done)
3418  ((:pred >= min 3)
3419   (stdu ppc::arg_x -8 ppc::vsp))
3420  ((:pred >= min 2)
3421   (mr ppc::arg_x ppc::arg_y))
3422  ((:pred >= min 1)
3423   (mr ppc::arg_y ppc::arg_z))
3424  (li ppc::arg_z (target-nil-value))
3425  :done)
3426
3427(define-ppc64-vinsn default-2-args (()
3428                                    ((min :u16const))
3429                                    ((crf :crf)))
3430  (cmpldi crf ppc::nargs (:apply ash (:apply 1+ min) ppc64::word-shift))
3431  (bgt crf :done)
3432  (beq crf :one)
3433  ;; We got "min" args; arg_y & arg_z default to nil
3434  ((:pred >= min 3)
3435   (stdu ppc::arg_x -8 ppc::vsp))   
3436  ((:pred >= min 2)
3437   (stdu ppc::arg_y -8 ppc::vsp))
3438  ((:pred >= min 1)
3439   (mr ppc::arg_x ppc::arg_z))
3440  (li ppc::arg_y (target-nil-value))
3441  (b :last)
3442  :one
3443  ;; We got min+1 args: arg_y was supplied, arg_z defaults to nil.
3444  ((:pred >= min 2)
3445   (stdu ppc::arg_x -8 ppc::vsp))
3446  ((:pred >= min 1)
3447   (mr ppc::arg_x ppc::arg_y))
3448  (mr ppc::arg_y ppc::arg_z)
3449  :last
3450  (li ppc::arg_z (target-nil-value))
3451  :done)
3452
3453(define-ppc64-vinsn default-3-args (()
3454                                    ((min :u16const))
3455                                    ((crfx :crf)
3456                                     (crfy :crf)))
3457  (cmpldi crfx ppc::nargs (:apply ash (:apply + 2 min) ppc64::word-shift))
3458  (cmpldi crfy ppc::nargs (:apply ash min ppc64::word-shift))
3459  (bgt crfx :done)
3460  (beq crfx :two)
3461  (beq crfy :none)
3462  ;; The first (of three) &optional args was supplied.
3463  ((:pred >= min 2)
3464   (stdu ppc::arg_x -8 ppc::vsp))
3465  ((:pred >= min 1)
3466   (stdu ppc::arg_y -8 ppc::vsp))
3467  (mr ppc::arg_x ppc::arg_z)
3468  (b :last-2)
3469  :two
3470  ;; The first two (of three) &optional args were supplied.
3471  ((:pred >= min 1)
3472   (stdu ppc::arg_x -8 ppc::vsp))
3473  (mr ppc::arg_x ppc::arg_y)
3474  (mr ppc::arg_y ppc::arg_z)
3475  (b :last-1)
3476  ;; None of the three &optional args was provided.
3477  :none
3478  ((:pred >= min 3)
3479   (stdu ppc::arg_x -8 ppc::vsp))
3480  ((:pred >= min 2)
3481   (stdu ppc::arg_y -8 ppc::vsp))
3482  ((:pred >= min 1)
3483   (stdu ppc::arg_z -8 ppc::vsp))
3484  (li ppc::arg_x (target-nil-value))
3485  :last-2
3486  (li ppc::arg_y (target-nil-value))
3487  :last-1
3488  (li ppc::arg_z (target-nil-value))
3489  :done)
3490
3491(define-ppc64-vinsn save-lr (()
3492                             ())
3493  (mflr ppc::loc-pc))
3494
3495;;; "n" is the sum of the number of required args +
3496;;; the number of &optionals. 
3497(define-ppc64-vinsn (default-optionals :call :subprim-call) (()
3498                                                             ((n :u16const)))
3499  (li ppc::imm0 (:apply ash n ppc64::word-shift))
3500  (bla .SPdefault-optional-args))
3501
3502;;; fname contains a known symbol
3503(define-ppc64-vinsn (call-known-symbol :call) (((result (:lisp ppc::arg_z)))
3504                                               ())
3505  (ld ppc::nfn ppc64::symbol.fcell ppc::fname)
3506  (ld ppc::temp0 ppc64::misc-data-offset ppc::nfn)
3507  (mtctr ppc::temp0)
3508  (bctrl))
3509
3510(define-ppc64-vinsn (jump-known-symbol :jumplr) (()
3511                                                 ())
3512  (ld ppc::nfn ppc64::symbol.fcell ppc::fname)
3513  (ld ppc::temp0 ppc64::misc-data-offset ppc::nfn)
3514  (mtctr ppc::temp0)
3515  (bctr))
3516
3517(define-ppc64-vinsn (call-known-function :call) (()
3518                                                 ())
3519  (ld ppc::temp0 ppc64::misc-data-offset ppc::nfn)
3520  (mtctr ppc::temp0)
3521  (bctrl))
3522
3523(define-ppc64-vinsn (jump-known-function :jumplr) (()
3524                                                   ())
3525  (ld ppc::temp0 ppc64::misc-data-offset ppc::nfn)
3526  (mtctr ppc::temp0)
3527  (bctr))
3528
3529(define-ppc64-vinsn %schar8 (((char :imm))
3530                             ((str :lisp)
3531                              (idx :imm))
3532                             ((imm :u32)
3533                              (cr0 (:crf 0))))
3534  (srdi imm idx ppc64::fixnumshift)
3535  (addi imm imm ppc64::misc-data-offset)
3536  (lbzx imm str imm)
3537  (rldicr imm imm ppc64::charcode-shift (- 63 ppc64::charcode-shift))
3538  (ori char imm ppc64::subtag-character))
3539
3540(define-ppc64-vinsn %schar32 (((char :imm))
3541                              ((str :lisp)
3542                               (idx :imm))
3543                              ((imm :u32)
3544                               (cr0 (:crf 0))))
3545  (srdi imm idx 1)
3546  (addi imm imm ppc64::misc-data-offset)
3547  (lwzx imm str imm)
3548  (rldicr imm imm ppc64::charcode-shift (- 63 ppc64::charcode-shift))
3549  (ori char imm ppc64::subtag-character))
3550
3551(define-ppc64-vinsn %set-schar8 (()
3552                                ((str :lisp)
3553                                 (idx :imm)
3554                                 (char :imm))
3555                                ((imm :u64)
3556                                 (imm1 :u64)
3557                                 (cr0 (:crf 0))))
3558  (srdi imm idx ppc64::fixnumshift)
3559  (addi imm imm ppc64::misc-data-offset)
3560  (srdi imm1 char ppc64::charcode-shift)
3561  (stbx imm1 str imm)
3562  )
3563
3564(define-ppc64-vinsn %set-schar32 (()
3565                                ((str :lisp)
3566                                 (idx :imm)
3567                                 (char :imm))
3568                                ((imm :u64)
3569                                 (imm1 :u64)
3570                                 (cr0 (:crf 0))))
3571  (srdi imm idx 1)
3572  (addi imm imm ppc64::misc-data-offset)
3573  (srdi imm1 char ppc64::charcode-shift)
3574  (stwx imm1 str imm)
3575  )
3576
3577(define-ppc64-vinsn %set-scharcode8 (()
3578                                     ((str :lisp)
3579                                      (idx :imm)
3580                                      (code :imm))
3581                                     ((imm :u64)
3582                                      (imm1 :u64)
3583                                      (cr0 (:crf 0))))
3584  (srdi imm idx ppc64::fixnumshift)
3585  (addi imm imm ppc64::misc-data-offset)
3586  (srdi imm1 code ppc64::fixnumshift)
3587  (stbx imm1 str imm)
3588  )
3589
3590(define-ppc64-vinsn %set-scharcode32 (()
3591                                      ((str :lisp)
3592                                       (idx :imm)
3593                                       (code :imm))
3594                                      ((imm :u64)
3595                                       (imm1 :u64)
3596                                       (cr0 (:crf 0))))
3597  (srdi imm idx 1)
3598  (addi imm imm ppc64::misc-data-offset)
3599  (srdi imm1 code ppc64::fixnumshift)
3600  (stwx imm1 str imm)
3601  )
3602
3603
3604(define-ppc64-vinsn %scharcode8 (((code :imm))
3605                                 ((str :lisp)
3606                                  (idx :imm))
3607                                 ((imm :u64)
3608                                  (cr0 (:crf 0))))
3609  (srdi imm idx ppc64::fixnumshift)
3610  (addi imm imm ppc64::misc-data-offset)
3611  (lbzx imm str imm)
3612  (sldi code imm ppc64::fixnumshift))
3613
3614(define-ppc64-vinsn %scharcode32 (((code :imm))
3615                                  ((str :lisp)
3616                                   (idx :imm))
3617                                  ((imm :u64)
3618                                   (cr0 (:crf 0))))
3619  (srdi imm idx 1)
3620  (addi imm imm ppc64::misc-data-offset)
3621  (lwzx imm str imm)
3622  (sldi code imm ppc64::fixnumshift))
3623
3624;;; Clobbers LR
3625(define-ppc64-vinsn (%debug-trap :call :subprim-call) (()
3626                                                       ())
3627  (bla .SPbreakpoint)
3628  )
3629
3630
3631(define-ppc64-vinsn eep.address (((dest t))
3632                                 ((src (:lisp (:ne dest )))))
3633  (ld dest (+ (ash 1 ppc64::word-shift) ppc64::misc-data-offset) src)
3634  (tdeqi dest (target-nil-value)))
3635
3636(define-ppc64-vinsn %natural+ (((dest :u64))
3637                               ((x :u64) (y :u64)))
3638  (add dest x y))
3639
3640(define-ppc64-vinsn %natural+-c (((dest :u64))
3641                                 ((x :u64) (y :u16const)))
3642  (addi dest x y))
3643
3644(define-ppc64-vinsn %natural- (((dest :u64))
3645                               ((x :u64) (y :u64)))
3646  (sub dest x y))
3647
3648(define-ppc64-vinsn %natural--c (((dest :u64))
3649                                 ((x :u64) (y :u16const)))
3650  (subi dest x y))
3651
3652(define-ppc64-vinsn %natural-logior (((dest :u64))
3653                                     ((x :u64) (y :u64)))
3654  (or dest x y))
3655
3656(define-ppc64-vinsn %natural-logior-c (((dest :u64))
3657                                   ((x :u64) (high :u16const) (low :u16const)))
3658  ((:not (:pred = high 0))
3659   (oris dest x high))
3660  ((:not (:pred = low 0))
3661   (ori dest x low)))
3662
3663(define-ppc64-vinsn %natural-logxor (((dest :u64))
3664                                     ((x :u64) (y :u64)))
3665  (xor dest x y))
3666
3667(define-ppc64-vinsn %natural-logxor-c (((dest :u64))
3668                                       ((x :u64) (high :u16const) (low :u16const)))
3669  ((:not (:pred = high 0))
3670   (xoris dest x high))
3671  ((:not (:pred = low 0))
3672   (xori dest x low)))
3673
3674(define-ppc64-vinsn %natural-logand (((dest :u64))
3675                                     ((x :u64) (y :u64)))
3676  (and dest x y))
3677
3678(define-ppc64-vinsn %natural-logand-high-c (((dest :u64))
3679                                            ((x :u64) (high :u16const))
3680                                            ((cr0 (:crf 0))))
3681  (andis. dest x high))
3682
3683(define-ppc64-vinsn %natural-logand-low-c (((dest :u64))
3684                                           ((x :u64) (low :u16const))
3685                                           ((cr0 (:crf 0))))
3686  (andi. dest x low))
3687
3688(define-ppc64-vinsn %natural-logand-mask-c (((dest :u32))
3689                                            ((x :u32)
3690                                             (start :u8const)
3691                                             (end :u8const)))
3692  (rlwinm dest x 0 start end))
3693
3694(define-ppc64-vinsn disable-interrupts (((dest :lisp))
3695                                        ()
3696                                        ((temp :imm)
3697                                         (temp2 :imm)))
3698  (ld temp2 ppc64::tcr.tlb-pointer ppc64::rcontext)
3699  (li temp -8)
3700  (ld dest ppc64::interrupt-level-binding-index temp2)
3701  (std temp ppc64::interrupt-level-binding-index temp2))
3702
3703(define-ppc64-vinsn load-character-constant (((dest :lisp))
3704                                             ((code :u32const))
3705                                             ())
3706  (ori dest ppc::rzero (:apply logior (:apply ash (:apply logand #xff code) 8) ppc64::subtag-character))
3707  ((:not (:pred = 0 (:apply ldb (byte 16 8) code)))
3708   (oris dest dest (:apply ldb (byte 16 8) code))))
3709
3710
3711(define-ppc64-vinsn %symbol->symptr (((dest :lisp))
3712                                     ((src :lisp))
3713                                     ((tag :u8)
3714                                      (crf0 :crf)))
3715  (clrldi tag src (- ppc64::nbits-in-word ppc64::ntagbits))
3716  (cmpdi crf0 tag ppc64::fulltag-misc)
3717  (bne crf0 :do-trap)
3718  (lbz tag ppc64::misc-subtag-offset src)
3719  :do-trap
3720  (tdnei tag ppc64::subtag-symbol)
3721  ((:not (:pred =
3722                (:apply %hard-regspec-value dest)
3723                (:apply %hard-regspec-value src)))
3724   (mr dest src)))
3725
3726
3727
3728;;; Subprim calls.  Done this way for the benefit of VINSN-OPTIMIZE.
3729(defmacro define-ppc64-subprim-call-vinsn ((name &rest other-attrs) spno)
3730  `(define-ppc64-vinsn (,name :call :subprim-call ,@other-attrs) (() ())
3731    (bla ,spno)))
3732
3733(defmacro define-ppc64-subprim-jump-vinsn ((name &rest other-attrs) spno)
3734  `(define-ppc64-vinsn (,name :jumpLR ,@other-attrs) (() ())
3735    (ba ,spno)))
3736
3737(define-ppc64-subprim-jump-vinsn (restore-interrupt-level) .SPrestoreintlevel)
3738
3739(define-ppc64-subprim-call-vinsn (save-values) .SPsave-values)
3740
3741(define-ppc64-subprim-call-vinsn (recover-values)  .SPrecover-values)
3742
3743(define-ppc64-subprim-call-vinsn (add-values) .SPadd-values)
3744
3745(define-ppc64-subprim-jump-vinsn (jump-known-symbol-ool) .SPjmpsym)
3746
3747(define-ppc64-subprim-call-vinsn (call-known-symbol-ool)  .SPjmpsym)
3748
3749(define-ppc64-subprim-call-vinsn (pass-multiple-values)  .SPmvpass)
3750
3751(define-ppc64-subprim-call-vinsn (pass-multiple-values-symbol) .SPmvpasssym)
3752
3753(define-ppc64-subprim-jump-vinsn (tail-call-sym-gen) .SPtcallsymgen)
3754
3755(define-ppc64-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
3756
3757(define-ppc64-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide)
3758
3759(define-ppc64-subprim-jump-vinsn (tail-call-fn-slide) .SPtcallnfnslide)
3760
3761(define-ppc64-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
3762
3763(define-ppc64-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
3764
3765(define-ppc64-subprim-call-vinsn (funcall)  .SPfuncall)
3766
3767(define-ppc64-subprim-jump-vinsn (tail-funcall-gen) .SPtfuncallgen)
3768
3769(define-ppc64-subprim-jump-vinsn (tail-funcall-slide) .SPtfuncallslide)
3770
3771(define-ppc64-subprim-jump-vinsn (tail-funcall-vsp) .SPtfuncallvsp)
3772
3773(define-ppc64-subprim-call-vinsn (spread-lexpr)  .SPspread-lexpr-z)
3774
3775(define-ppc64-subprim-call-vinsn (spread-list)  .SPspreadargz)
3776
3777(define-ppc64-subprim-call-vinsn (pop-argument-registers)  .SPvpopargregs)
3778
3779(define-ppc64-subprim-call-vinsn (getxlong)  .SPgetXlong)
3780
3781(define-ppc64-subprim-call-vinsn (stack-cons-list)  .SPstkconslist)
3782
3783(define-ppc64-subprim-call-vinsn (list) .SPconslist)
3784
3785(define-ppc64-subprim-call-vinsn (stack-cons-list*)  .SPstkconslist-star)
3786
3787(define-ppc64-subprim-call-vinsn (list*) .SPconslist-star)
3788
3789(define-ppc64-subprim-call-vinsn (make-stack-block)  .SPmakestackblock)
3790
3791(define-ppc64-subprim-call-vinsn (make-stack-block0)  .Spmakestackblock0)
3792
3793(define-ppc64-subprim-call-vinsn (make-stack-list)  .Spmakestacklist)
3794
3795(define-ppc64-subprim-call-vinsn (make-stack-vector)  .SPmkstackv)
3796
3797(define-ppc64-subprim-call-vinsn (make-stack-gvector)  .SPstkgvector)
3798
3799(define-ppc64-subprim-call-vinsn (stack-misc-alloc)  .SPstack-misc-alloc)
3800
3801(define-ppc64-subprim-call-vinsn (stack-misc-alloc-init)  .SPstack-misc-alloc-init)
3802
3803(define-ppc64-subprim-call-vinsn (bind-nil)  .SPbind-nil)
3804
3805(define-ppc64-subprim-call-vinsn (bind-self)  .SPbind-self)
3806
3807(define-ppc64-subprim-call-vinsn (bind-self-boundp-check)  .SPbind-self-boundp-check)
3808
3809(define-ppc64-subprim-call-vinsn (bind)  .SPbind)
3810
3811(define-ppc64-subprim-jump-vinsn (nvalret :jumpLR) .SPnvalret)
3812
3813(define-ppc64-subprim-call-vinsn (nthrowvalues) .SPnthrowvalues)
3814
3815(define-ppc64-subprim-call-vinsn (nthrow1value) .SPnthrow1value)
3816
3817(define-ppc64-subprim-call-vinsn (slide-values) .SPmvslide)
3818
3819(define-ppc64-subprim-call-vinsn (macro-bind) .SPmacro-bind)
3820
3821(define-ppc64-subprim-call-vinsn (destructuring-bind-inner) .SPdestructuring-bind-inner)
3822
3823(define-ppc64-subprim-call-vinsn (destructuring-bind) .SPdestructuring-bind)
3824
3825(define-ppc64-subprim-call-vinsn (simple-keywords) .SPsimple-keywords)
3826
3827(define-ppc64-subprim-call-vinsn (keyword-args) .SPkeyword-args)
3828
3829(define-ppc64-subprim-call-vinsn (keyword-bind) .SPkeyword-bind)
3830
3831(define-ppc64-subprim-call-vinsn (stack-rest-arg) .SPstack-rest-arg)
3832
3833(define-ppc64-subprim-call-vinsn (req-stack-rest-arg) .SPreq-stack-rest-arg)
3834
3835(define-ppc64-subprim-call-vinsn (stack-cons-rest-arg) .SPstack-cons-rest-arg)
3836
3837(define-ppc64-subprim-call-vinsn (heap-rest-arg) .SPheap-rest-arg)
3838
3839(define-ppc64-subprim-call-vinsn (req-heap-rest-arg) .SPreq-heap-rest-arg)
3840
3841(define-ppc64-subprim-call-vinsn (heap-cons-rest-arg) .SPheap-cons-rest-arg)
3842
3843(define-ppc64-subprim-call-vinsn (opt-supplied-p) .SPopt-supplied-p)
3844
3845(define-ppc64-subprim-call-vinsn (gvector) .SPgvector)
3846
3847(define-ppc64-vinsn (nth-value :call :subprim-call) (((result :lisp))
3848                                                     ())
3849  (bla .SPnthvalue))
3850
3851(define-ppc64-subprim-call-vinsn (fitvals) .SPfitvals)
3852
3853(define-ppc64-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
3854
3855(define-ppc64-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
3856
3857(define-ppc64-subprim-call-vinsn (integer-sign) .SPinteger-sign)
3858
3859;;; Even though it's implemented by calling a subprim, THROW is really
3860;;; a JUMP (to a possibly unknown destination).  If the destination's
3861;;; really known, it should probably be inlined (stack-cleanup, value
3862;;; transfer & jump ...)
3863(define-ppc64-vinsn (throw :jump-unknown) (()
3864                                                 ())
3865  (bla .SPthrow))
3866
3867(define-ppc64-subprim-call-vinsn (mkcatchmv) .SPmkcatchmv)
3868
3869(define-ppc64-subprim-call-vinsn (mkcatch1v) .SPmkcatch1v)
3870
3871(define-ppc64-subprim-call-vinsn (setqsym) .SPsetqsym)
3872
3873(define-ppc64-subprim-call-vinsn (ksignalerr) .SPksignalerr)
3874
3875(define-ppc64-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
3876
3877(define-ppc64-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
3878
3879(define-ppc64-subprim-call-vinsn (mkunwind) .SPmkunwind)
3880(define-ppc64-subprim-call-vinsn (nmkunwind) .SPnmkunwind)
3881
3882(define-ppc64-subprim-call-vinsn (progvsave) .SPprogvsave)
3883
3884(define-ppc64-subprim-jump-vinsn (progvrestore) .SPprogvrestore)
3885
3886(define-ppc64-subprim-call-vinsn (eabi-syscall) .SPeabi-syscall)
3887
3888(define-ppc64-subprim-call-vinsn (misc-ref) .SPmisc-ref)
3889
3890(define-ppc64-subprim-call-vinsn (misc-set) .SPmisc-set)
3891
3892(define-ppc64-subprim-call-vinsn (gets64) .SPgets64)
3893
3894(define-ppc64-subprim-call-vinsn (getu64) .SPgetu64)
3895
3896(define-ppc64-subprim-call-vinsn (makeu64) .SPmakeu64)
3897
3898(define-ppc64-subprim-call-vinsn (makes64) .SPmakes64)
3899
3900(define-ppc64-vinsn (poweropen-syscall :call :subprim-call) (()
3901                                                          ())
3902  (stw ppc::rzero ppc64::c-frame.crsave ppc::sp)
3903  (bla .SPpoweropen-syscall))
3904
3905(define-ppc64-vinsn (poweropen-syscall-s64 :call :subprim-call) (()
3906                                                              ())
3907  (std ppc::sp ppc64::c-frame.crsave ppc::sp)
3908  (bla .SPpoweropen-syscall))
3909
3910(define-ppc64-subprim-call-vinsn (eabi-ff-call) .SPeabi-ff-call)
3911
3912(define-ppc64-subprim-call-vinsn (poweropen-ff-call) .SPpoweropen-ffcall)
3913
3914(define-ppc64-subprim-call-vinsn (poweropen-ff-call-regs) .SPpoweropen-ffcall-return-registers)
3915
3916(define-ppc64-subprim-call-vinsn (poweropen-ff-callX) .SPpoweropen-ffcallX)
3917
3918(define-ppc64-subprim-call-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
3919
3920(define-ppc64-vinsn bind-interrupt-level-0-inline (()
3921                                                   ()
3922                                                   ((tlb :imm)
3923                                                    (value :imm)
3924                                                    (link :imm)
3925                                                    (temp :imm)))
3926  (ld tlb ppc64::tcr.tlb-pointer ppc64::rcontext)
3927  (ld value ppc64::interrupt-level-binding-index tlb)
3928  (ld link ppc64::tcr.db-link ppc64::rcontext)
3929  (cmpdi value 0)
3930  (li temp ppc64::interrupt-level-binding-index)
3931  (stdu value -8 ppc::vsp)
3932  (stdu temp -8 ppc::vsp)
3933  (stdu link -8 ppc::vsp)
3934  (std ppc::rzero ppc64::interrupt-level-binding-index tlb)
3935  (std ppc::vsp  ppc64::tcr.db-link ppc64::rcontext)
3936  (beq+ :done)
3937  (mr ppc::nargs value)
3938  (bgt :do-trap)
3939  (ld ppc::nargs ppc64::tcr.interrupt-pending ppc64::rcontext)
3940  :do-trap
3941  (tdgti ppc::nargs 0)
3942  :done)
3943
3944(define-ppc64-subprim-call-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
3945
3946(define-ppc64-vinsn bind-interrupt-level-m1-inline (()
3947                                                   ()
3948                                                   ((tlb :imm)
3949                                                    (oldvalue :imm)
3950                                                    (link :imm)
3951                                                    (newvalue :imm)
3952                                                    (idx :imm)))
3953  (li newvalue (ash -1 ppc64::fixnumshift))
3954  (li idx ppc64::interrupt-level-binding-index)
3955  (ld tlb ppc64::tcr.tlb-pointer ppc64::rcontext)
3956  (ld oldvalue ppc64::interrupt-level-binding-index tlb)
3957  (ld link ppc64::tcr.db-link ppc64::rcontext)
3958  (stdu oldvalue -8 ppc::vsp)
3959  (stdu idx -8 ppc::vsp)
3960  (stdu link -8 ppc::vsp)
3961  (std newvalue ppc64::interrupt-level-binding-index tlb)
3962  (std ppc::vsp  ppc64::tcr.db-link ppc64::rcontext)
3963  :done)
3964
3965(define-ppc64-subprim-call-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
3966
3967(define-ppc64-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
3968
3969(define-ppc64-vinsn unbind-interrupt-level-inline (()
3970                                                   ()
3971                                                   ((tlb :imm)
3972                                                    (link :imm)
3973                                                    (value :imm)
3974                                                    (save-nargs :u32)
3975                                                    (crf0 :crf)
3976                                                    (crf1 :crf)))
3977  (ld tlb ppc64::tcr.tlb-pointer ppc64::rcontext)
3978  (ld value ppc64::interrupt-level-binding-index tlb)
3979  (ld link ppc64::tcr.db-link ppc64::rcontext)
3980  (cmpdi crf1 value 0)
3981  (ld value 16 link)
3982  (ld link 0 link)
3983  (cmpdi crf0 value 0)
3984  (std value ppc64::interrupt-level-binding-index tlb)
3985  (std link ppc64::tcr.db-link ppc64::rcontext)
3986  (bge crf1 :done)
3987  (blt crf0 :done)
3988  (mr save-nargs ppc::nargs)
3989  (ld ppc::nargs ppc64::tcr.interrupt-pending ppc64::rcontext)
3990  (tdgti ppc::nargs 0)
3991  (mr ppc::nargs save-nargs)
3992  :done)
3993
3994(define-ppc64-vinsn fixnum->fpr (((f :double-float))
3995                                          ((fixnum :imm))
3996                                          ((imm :s64)))
3997  (srawi imm fixnum ppc64::fixnumshift)
3998  (std imm -8 ppc::sp)
3999  (lfd f -8 ppc::sp)
4000  (fcfid f f))
4001
4002(define-ppc64-vinsn branch-unless-arg-fixnum (()
4003                                              ((arg :lisp)
4004                                               (lab :label))
4005                                              ((cr0 (:crf 0))
4006                                               (tag :u8)))
4007  (clrldi. tag arg (- ppc64::nbits-in-word ppc64::nlisptagbits))
4008  (bne cr0 lab))
4009
4010(define-ppc64-vinsn branch-unless-both-args-fixnums (()
4011                                              ((arg0 :lisp)
4012                                               (arg1 :lisp)
4013                                               (lab :label))
4014                                              ((cr0 (:crf 0))
4015                                               (tag :u8)))
4016  (clrldi tag arg0 (- ppc64::nbits-in-word ppc64::nlisptagbits))
4017  (rldimi. tag arg1 ppc64::nlisptagbits 58)
4018  (bne cr0 lab))
4019 
4020                                             
4021                                           
4022
4023;;; In case ppc64::*ppc-opcodes* was changed since this file was compiled.
4024(queue-fixup
4025 (fixup-vinsn-templates *ppc64-vinsn-templates* ppc::*ppc-opcode-numbers*))
4026
4027(provide "PPC64-VINSNS")
Note: See TracBrowser for help on using the repository browser.