source: branches/arm/compiler/ARM/arm-vinsns.lisp @ 13751

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

Some stuff compiles; still a lot of work to do.
Try to reduce stack traffic in some simple cases by tracking which
registers contain copies of which stack locations. Should try to
exploit this further (and port to other platforms when it's working
reliably.)
Todo: well, a very long list of things, but one that seems obvious
is to try to use predication (at the vinsn level) to reduce the number
of conditional branches.

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