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

Last change on this file since 5091 was 5091, checked in by gb, 14 years ago

Conditionalize for #-target-8-bit-chars.

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