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

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

%unbox-u8, u8-vref stuff.

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