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

Last change on this file since 14942 was 14942, checked in by gb, 9 years ago

%FIXNUM-{REF|SET}-DOUBLE-FLOAT support in PPC backends.

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