source: trunk/source/compiler/X86/x86-lapmacros.lisp @ 11056

Last change on this file since 11056 was 11056, checked in by gb, 12 years ago

Use an achored (out-of-line) UUO in trap-unless-typecode=.

Add SAVE-STACKARGS-FRAME, which does what the compiler does when a
known number of incoming args (and a reserved frame) were pushed
on the stack.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 17.6 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2005, Clozure Associates and contributors.
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17(in-package "CCL")
18
19;;; Comparisons make more sense if arg order is "dest, src", instead
20;;; of the gas/ATT arg order.
21
22(defx86lapmacro rcmp (src dest)
23  `(cmp ,dest ,src))
24
25(defx86lapmacro clrl (reg)
26  `(xorl (% ,reg) (% ,reg)))
27
28(defx86lapmacro clrq (reg)
29  `(xorq (% ,reg) (% ,reg)))
30
31(defx86lapmacro set-nargs (n)
32  (let* ((many (target-arch-case
33                (:x8632 32)
34                (:x8664 16))))
35    (cond ((>= n many) `(movl ($ ',n) (% nargs)))
36          ((= n 0) `(xorl (% nargs) (% nargs)))
37          (t `(progn
38                (xorl (% nargs) (% nargs))
39                (addl ($ ',n) (% nargs)))))))
40       
41
42(defx86lapmacro anchored-uuo (form)
43  `(progn
44    ,form
45    (:byte 0)))
46
47(defx86lapmacro check-nargs (min &optional (max min))
48  (let* ((anchor (gensym))
49         (bad (gensym)))
50    (if (and max (= max min))
51      `(progn
52        ,anchor
53        ,(if (eql min 0)
54             `(testl (% nargs) (% nargs))
55             `(rcmp (% nargs) ($ ',min)))
56        (jne ,bad)
57        (:anchored-uuo-section ,anchor)
58        ,bad
59        (anchored-uuo (uuo-error-wrong-number-of-args))
60        (:main-section nil))
61      (if (null max)
62        (unless (zerop min)
63          `(progn
64            ,anchor
65            (rcmp (% nargs) ($ ',min))
66            (jb ,bad)
67            (:anchored-uuo-section ,anchor)
68            ,bad
69            (anchored-uuo (uuo-error-too-few-args))
70            (:main-section nil)))
71        (if (zerop min)
72          `(progn
73            ,anchor
74            (rcmp (% nargs) ($ ',max))
75            (ja ,bad)
76            (:anchored-uuo-section ,anchor)
77            ,bad
78            (anchored-uuo (uuo-error-too-many-args))
79            (:main-section nil))
80          (let* ((toofew (gensym))
81                 (toomany (gensym)))
82            `(progn
83              ,anchor
84              (rcmp (% nargs) ($ ',min))
85              (jb ,toofew)
86              (rcmp (% nargs) ($ ',max))
87              (ja ,toomany)
88              (:anchored-uuo-section ,anchor)
89              ,toofew
90              (anchored-uuo (uuo-error-too-few-args))
91              (:anchored-uuo-section ,anchor)
92              ,toomany
93              (anchored-uuo (uuo-error-too-many-args)))))))))
94
95
96(defx86lapmacro extract-lisptag (node dest)
97  (target-arch-case
98   (:x8632
99    `(progn
100       (movl ($ x8632::tagmask) (% ,dest))
101       (andl (%l ,node) (%l ,dest))))
102   (:x8664
103    `(progn
104       (movb ($ x8664::tagmask) (%b ,dest))
105       (andb (%b ,node) (%b ,dest))))))
106
107(defx86lapmacro extract-fulltag (node dest)
108  (target-arch-case
109   (:x8632
110    `(progn
111       (movl ($ x8632::fulltagmask) (%l ,dest))
112       (andl (%l ,node) (%l ,dest))))
113   (:x8664
114    `(progn
115       (movb ($ x8664::fulltagmask) (%b ,dest))
116       (andb (%b ,node) (%b ,dest))))))
117
118(defx86lapmacro extract-subtag (node dest)
119  (target-arch-case
120   (:x8632
121    `(movb (@ x8632::misc-subtag-offset (% ,node)) (%b ,dest)))
122   (:x8664
123    `(movb (@ x8664::misc-subtag-offset (% ,node)) (%b ,dest)))))
124
125(defx86lapmacro extract-typecode (node dest)
126  ;;; In general, these things are only defined to affect the low
127  ;;; byte of the destination register.  This can also affect
128  ;;; the #xff00 byte.
129  (let* ((done (gensym)))
130    (target-arch-case
131     (:x8632
132      `(progn
133         (extract-lisptag ,node ,dest)
134         (rcmp (%b ,dest) ($ x8632::tag-misc))
135         (jne ,done)
136         (movb (@  x8632::misc-subtag-offset (% ,node)) (%b ,dest))
137         ,done))
138     (:x8664
139      `(progn
140         (extract-lisptag ,node ,dest)
141         (rcmp (%b ,dest) ($ x8664::tag-misc))
142         (jne ,done)
143         (movb (@  x8664::misc-subtag-offset (% ,node)) (%b ,dest))
144         ,done)))))
145
146(defx86lapmacro trap-unless-typecode= (node tag &optional (immreg 'imm0))
147  (let* ((bad (gensym))
148         (anchor (gensym)))
149           
150    `(progn
151      ,anchor
152      (extract-typecode ,node ,immreg)
153      (cmpb ($ ,tag) (%b ,immreg))
154      (jne ,bad)
155      (:anchored-uuo-section ,anchor)
156      ,bad
157      (:anchored-uuo (uuo-error-reg-not-tag (% ,node) ($ ,tag)))
158      (:main-section nil))))
159
160(defx86lapmacro trap-unless-fulltag= (node tag &optional (immreg 'imm0))
161  (let* ((ok (gensym)))
162    `(progn
163      (extract-fulltag ,node ,immreg)
164      (cmpb ($ ,tag) (%b ,immreg))
165      (je.pt ,ok)
166      (uuo-error-reg-not-tag (% ,node) ($ ,tag))
167      ,ok)))
168
169(defx86lapmacro trap-unless-lisptag= (node tag &optional (immreg 'imm0))
170  (let* ((ok (gensym)))
171    `(progn
172      (extract-lisptag ,node ,immreg)
173      (cmpb ($ ,tag) (%b ,immreg))
174      (je.pt ,ok)
175      (uuo-error-reg-not-tag (% ,node) ($ ,tag))
176      ,ok)))
177
178(defx86lapmacro trap-unless-fixnum (node)
179  (let* ((ok (gensym)))
180    (target-arch-case
181     (:x8632
182      `(progn
183         (test ($ x8632::tagmask) (% ,node))
184         (je.pt ,ok)
185         (uuo-error-reg-not-fixnum (% ,node))
186         ,ok))
187     (:x8664
188      `(progn
189         (testb ($ x8664::tagmask) (%b ,node))
190         (je.pt ,ok)
191         (uuo-error-reg-not-fixnum (% ,node))
192         ,ok)))))
193
194;;; On x8664, NIL has its own tag, so no other lisp object can
195;;; have the same low byte as NIL.  On x8632, NIL is a just
196;;; a distiguished CONS.
197(defx86lapmacro cmp-reg-to-nil (reg)
198  (target-arch-case
199   (:x8632
200    `(cmpl ($ (target-nil-value)) (%l ,reg)))
201   (:x8664
202    `(cmpb ($ (logand #xff (target-nil-value))) (%b ,reg)))))
203
204(defx86lapmacro unbox-fixnum (src dest)
205  (target-arch-case
206   (:x8632
207    `(progn
208       (mov (% ,src) (% ,dest))
209       (sar ($ x8632::fixnumshift) (% ,dest))))
210   (:x8664
211    `(progn
212       (mov (% ,src) (% ,dest))
213       (sar ($ x8664::fixnumshift) (% ,dest))))))
214
215(defx86lapmacro box-fixnum (src dest)
216  (target-arch-case
217   (:x8632
218    `(imull ($ x8632::fixnumone) (% ,src) (% ,dest)))
219   (:x8664
220    `(imulq ($ x8664::fixnumone) (% ,src) (% ,dest)))))
221
222(defx86lapmacro get-single-float (node dest)
223  (target-arch-case
224   (:x8632
225    `(movss (@ x8632::single-float.value (% ,node)) (% ,dest)))
226   (:x8664
227    `(progn
228       (movd (% ,node) (% ,dest))
229       (psrlq ($ 32) (% ,dest))))))
230
231;;; Note that this modifies the src argument in the x8664 case.
232(defx86lapmacro put-single-float (src node)
233  (target-arch-case
234   (:x8632
235    `(movss (% ,src) (@ x8632::single-float.value (% ,node))))
236   (:x8664
237    `(progn
238       (psllq ($ 32) (% ,src))
239       (movd (% ,src) (% ,node))
240       (movb ($ x8664::tag-single-float) (%b ,node))))))
241
242(defx86lapmacro get-double-float (src fpreg)
243  (target-arch-case
244   (:x8632
245    `(movsd (@ x8632::double-float.value (% ,src)) (% ,fpreg)))
246   (:x8664
247    `(movsd (@ x8664::double-float.value (% ,src)) (% ,fpreg)))))
248
249(defx86lapmacro put-double-float (fpreg dest)
250  (target-arch-case
251   (:x8632
252    `(movsd (% ,fpreg) (@ x8632::double-float.value (% ,dest))))
253   (:x8664
254    `(movsd (% ,fpreg) (@ x8664::double-float.value (% ,dest))))))
255 
256(defx86lapmacro getvheader (src dest)
257  (target-arch-case
258   (:x8632
259    `(movl (@ x8632::misc-header-offset (% ,src)) (% ,dest)))
260   (:x8664
261    `(movq (@ x8664::misc-header-offset (% ,src)) (% ,dest)))))
262
263;;; "Size" is unboxed element-count.  vheader and dest should
264;;; both be immediate registers
265(defx86lapmacro header-size (vheader dest)
266  (target-arch-case
267   (:x8632
268    `(progn
269       (mov (% ,vheader) (% ,dest))
270       (shr ($ x8632::num-subtag-bits) (% ,dest))))
271   (:x8664
272    `(progn
273       (mov (% ,vheader) (% ,dest))
274       (shr ($ x8664::num-subtag-bits) (% ,dest))))))
275
276;;; "Length" is fixnum element-count.
277(defx86lapmacro header-length (vheader dest)
278  (target-arch-case
279   (:x8632
280    `(progn
281       (movl ($ (lognot 255)) (% ,dest))
282       (andl (% ,vheader) (% ,dest))
283       (shr ($ (- x8632::num-subtag-bits x8632::fixnumshift)) (% ,dest))))
284   (:x8664
285    `(progn
286       (movq ($ (lognot 255)) (% ,dest))
287       (andq (% ,vheader) (% ,dest))
288       (shr ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% ,dest))))))
289
290(defx86lapmacro header-subtag[fixnum] (vheader dest)
291  `(progn
292    (lea (@ (% ,vheader) 8) (% ,dest))
293    (andl ($ '255) (%l ,dest))))
294
295(defx86lapmacro vector-size (vector vheader dest)
296  `(progn
297    (getvheader ,vector ,vheader)
298    (header-size ,vheader ,dest)))
299
300(defx86lapmacro vector-length (vector dest)
301  (target-arch-case
302   (:x8632
303    `(progn
304       (movl ($ (lognot 255)) (% ,dest))
305       (andl (@ x8632::misc-header-offset (% ,vector)) (% ,dest))
306       (shr ($ (- x8632::num-subtag-bits x8632::fixnumshift)) (% ,dest))))
307   (:x8664
308    `(progn
309       (movq ($ (lognot 255)) (% ,dest))
310       (andq (@ x8664::misc-header-offset (% ,vector)) (% ,dest))
311       (shr ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% ,dest))))))
312
313(defx86lapmacro int-to-double (int temp double)
314  (target-arch-case
315   (:x8632
316    `(progn
317       (unbox-fixnum  ,int ,temp)
318       (cvtsi2sdl (% ,temp) (% ,double))))
319   (:x8664
320    `(progn
321       (unbox-fixnum  ,int ,temp)
322       (cvtsi2sdq (% ,temp) (% ,double))))))
323
324(defx86lapmacro int-to-single (int temp single)
325  (target-arch-case
326   (:x8632
327    `(progn
328       (unbox-fixnum ,int ,temp)
329       (cvtsi2ssl (% ,temp) (% ,single))))
330   (:x8664
331    `(progn
332       (unbox-fixnum ,int ,temp)
333       (cvtsi2ssq (% ,temp) (% ,single))))))
334
335(defx86lapmacro ref-global (global reg)
336  (target-arch-case
337   (:x8632
338    `(movl (@ (+ (target-nil-value) ,(x8632::%kernel-global global))) (% ,reg)))
339   (:x8664
340    `(movq (@ (+ (target-nil-value) ,(x8664::%kernel-global global))) (% ,reg)))))
341
342(defx86lapmacro ref-global.l (global reg)
343  (target-arch-case
344   (:x8632
345    `(movl (@ (+ (target-nil-value) ,(x8632::%kernel-global global))) (%l ,reg)))
346   (:x8664
347    `(movl (@ (+ (target-nil-value) ,(x8664::%kernel-global global))) (%l ,reg)))))
348
349(defx86lapmacro set-global (reg global)
350  (target-arch-case
351   (:x8632
352    `(movl (% ,reg) (@ (+ (target-nil-value) ,(x8632::%kernel-global global)))))
353   (:x8664
354    `(movq (% ,reg) (@ (+ (target-nil-value) ,(x8664::%kernel-global global)))))))
355
356(defx86lapmacro macptr-ptr (src dest)
357  (target-arch-case
358   (:x8632
359    `(movl (@ x8632::macptr.address (% ,src)) (% ,dest)))
360   (:x8664
361    `(movq (@ x8664::macptr.address (% ,src)) (% ,dest)))))
362
363;;; CODE is unboxed char-code (in low 8 bits); CHAR needs to be boxed.
364(defx86lapmacro box-character (code char)
365  (target-arch-case
366   (:x8632
367    `(progn
368       (box-fixnum ,code ,char)
369       (shl ($ (- x8632::charcode-shift x8632::fixnumshift)) (% ,char))
370       (movb ($ x8632::subtag-character) (%b ,char))))
371   (:x8664
372    `(progn
373       (box-fixnum ,code ,char)
374       (shl ($ (- x8664::charcode-shift x8664::fixnumshift)) (% ,char))
375       (movb ($ x8664::subtag-character) (%b ,char))))))
376 
377;;; index is a constant
378(defx86lapmacro svref (vector index dest)
379  (target-arch-case
380   (:x8632
381    `(movl (@ (+ x8632::misc-data-offset (* ,index 4)) (% ,vector)) (% ,dest)))
382   (:x8664
383    `(movq (@ (+ x8664::misc-data-offset (* ,index 8)) (% ,vector)) (% ,dest)))))
384
385;;; Index is still a constant
386(defx86lapmacro svset (vector index new)
387  (target-arch-case
388   (:x8632
389    `(movl (% ,new) (@ (+ x8632::misc-data-offset (* ,index 4)) (% ,vector))))
390   (:x8664
391    `(movq (% ,new) (@ (+ x8664::misc-data-offset (* ,index 8)) (% ,vector))))))
392
393
394;;; Frames, function entry and exit.
395
396
397;;; Simple frame, since the caller didn't reserve space for it.
398(defx86lapmacro save-simple-frame ()
399  (target-arch-case
400   (:x8632
401    `(progn
402       (pushl (% ebp))
403       (movl (% esp) (% ebp))))
404   (:x8664
405    `(progn
406       (pushq (% rbp))
407       (movq (% rsp) (% rbp))))))
408
409(defx86lapmacro save-stackargs-frame (nstackargs)
410  (target-arch-case
411   (:x8632
412    `(progn
413      (movl (% ebp) (@ ,(* (1+ nstackargs) x8632::node-size) (% esp)))
414      (leal (@ ,(* (1+ nstackargs) x8632::node-size) (% esp)) (% ebp))
415      (popl (@ x8632::node-size (% ebp)))))
416   (:x8664
417    `(progn
418      (movq (% rbp) (@ ,(* (1+ nstackargs) x8664::node-size) (% rsp)))
419      (leaq (@ ,(* (1+ nstackargs) x8664::node-size) (% rsp)) (% rbp))
420      (popq (@ x8632::node-size (% rbp)))))))
421   
422 
423(defx86lapmacro save-frame-variable-arg-count ()
424  (let* ((push (gensym))
425         (done (gensym)))
426    (target-arch-case
427     (:x8632
428      `(progn
429         (movl (% nargs) (% imm0))
430         (subl ($ (* $numx8632argregs x8632::node-size)) (% imm0))
431         (jle ,push)
432         (movl (% ebp) (@ 4 (% esp) (% imm0)))
433         (leal (@ 4 (% esp) (% imm0)) (% ebp))
434         (popl (@ 4 (% ebp)))
435         (jmp ,done)
436         ,push
437         (save-simple-frame)
438         ,done))
439     (:x8664
440      `(progn
441         (movl (% nargs) (%l imm0))
442         (subq ($ (* $numx8664argregs x8664::node-size)) (% imm0))
443         (jle ,push)
444         (movq (% rbp) (@ 8 (% rsp) (% imm0)))
445         (leaq (@ 8 (% rsp) (% imm0)) (% rbp))
446         (popq (@ 8 (% rbp)))
447         (jmp ,done)
448         ,push
449         (save-simple-frame)
450         ,done)))))
451
452
453(defx86lapmacro restore-simple-frame ()
454  `(progn
455    (leave)))
456
457(defx86lapmacro discard-reserved-frame ()
458  (target-arch-case
459   (:x8632
460    `(add ($ '2) (% esp)))
461   (:x8664
462    `(add ($ '2) (% rsp)))))
463
464;;; Return to caller.
465(defx86lapmacro single-value-return (&optional (words-to-discard 0))
466  (target-arch-case
467   (:x8632
468    (if (zerop words-to-discard)
469        `(ret)
470        `(ret ($ ,(* x8632::node-size words-to-discard)))))
471   (:x8664
472    (if (zerop words-to-discard)
473        `(ret)
474        `(ret ($ ,(* x8664::node-size words-to-discard)))))))
475
476(defun x86-subprim-offset (name)
477  (let* ((info (find name (arch::target-subprims-table (backend-target-arch *target-backend*)) :test #'string-equal :key #'subprimitive-info-name))
478         (offset (when info 
479                   (subprimitive-info-offset info))))
480    (or offset     
481        (error "Unknown subprim: ~s" name))))
482
483(defx86lapmacro jmp-subprim (name)
484  `(jmp (@ ,(x86-subprim-offset name))))
485
486(defx86lapmacro recover-fn ()
487  `(movl ($ :self) (% fn)))
488
489(defx86lapmacro call-subprim (name)
490  (target-arch-case
491   (:x8632
492    `(progn
493       (:talign x8632::fulltag-tra)
494       (call (@ ,(x86-subprim-offset name)))
495       (recover-fn)))
496   (:x8664
497    `(progn
498       (:talign 4)
499       (call (@ ,(x86-subprim-offset name)))
500       (recover-fn-from-rip)))))
501
502 (defx86lapmacro %car (src dest)
503  (target-arch-case
504   (:x8632
505    `(movl (@ x8632::cons.car (% ,src)) (% ,dest)))
506   (:x8664
507    `(movq (@ x8664::cons.car (% ,src)) (% ,dest)))))
508
509(defx86lapmacro %cdr (src dest)
510  (target-arch-case
511   (:x8632
512    `(movl (@ x8632::cons.cdr (% ,src)) (% ,dest)))
513   (:x8664
514    `(movq (@ x8664::cons.cdr (% ,src)) (% ,dest)))))
515
516(defx86lapmacro stack-probe ()
517  (target-arch-case
518   (:x8632
519    (let* ((ok (gensym)))
520      `(progn
521         (rcmp (% esp) (@ (% rcontext) x8632::tcr.cs-limit))
522         (jae.pt ,ok)
523         (uuo-stack-overflow)
524         ,ok)))
525   (:x8664
526    (let* ((ok (gensym)))
527      `(progn
528         (rcmp (% rsp) (@ (% rcontext) x8664::tcr.cs-limit))
529         (jae.pt ,ok)
530         (uuo-stack-overflow)
531         ,ok)))))
532
533(defx86lapmacro load-constant (constant dest &optional (fn 'fn))
534  (target-arch-case
535   (:x8632
536    `(movl (@ ',constant (% ,fn)) (% ,dest)))
537   (:x8664
538    `(movq (@ ',constant (% ,fn)) (% ,dest)))))
539
540(defx86lapmacro recover-fn-from-rip ()
541  (let* ((next (gensym)))
542    `(progn
543      (lea (@ (- (:^ ,next)) (% rip)) (% fn))
544      ,next)))
545
546;;; call symbol named NAME, setting nargs to NARGS.  Do the TRA
547;;; hair.   Args should already be in arg regs, and we expect
548;;; to return a single value.
549(defx86lapmacro call-symbol (name nargs)
550  (target-arch-case
551   (:x8632
552    `(progn
553       (load-constant ,name fname)
554       (set-nargs ,nargs)
555       (:talign 5)
556       (call (@ x8632::symbol.fcell (% fname)))
557       (recover-fn)))
558   (:x8664
559    `(progn
560       (load-constant ,name fname)
561       (set-nargs ,nargs)
562       (:talign 4)
563       (call (@ x8664::symbol.fcell (% fname)))
564       (recover-fn-from-rip)))))
565
566
567;;;  tail call the function named by NAME with nargs NARGS.  %FN is
568;;;  the caller, which will be in %FN on entry to the callee.  For the
569;;;  couple of instructions where neither %RA0 or %FN point to the
570;;;  current function, ensure that %XFN does; this is necessary to
571;;;  prevent the current function from being GCed halfway through
572;;;  those couple of instructions.
573
574(defx86lapmacro jump-symbol (name nargs)
575  (target-arch-case
576   (:x8632
577    `(progn
578       (load-constant ,name fname)
579       (set-nargs ,nargs)
580       (jmp (@ x8632::symbol.fcell (% fname)))))
581   (:x8664
582    `(progn
583       (load-constant ,name fname)
584       (set-nargs ,nargs)
585       (jmp (@ x8664::symbol.fcell (% fname)))))))
586
587(defx86lapmacro push-argregs ()
588  (let* ((done (gensym))
589         (yz (gensym))
590         (z (gensym)))
591    (target-arch-case
592     (:x8632
593      `(progn
594         (testl (% nargs) (% nargs))
595         (je ,done)
596         (cmpl ($ '1) (% nargs))
597         (je ,z)
598         (push (% arg_y))
599         ,z
600         (push (% arg_z))
601         ,done))
602     (:x8664
603      `(progn
604         (testl (% nargs) (% nargs))
605         (je ,done)
606         (cmpl ($ '2) (% nargs))
607         (je ,yz)
608         (jb ,z)
609         (push (% arg_x))
610         ,yz
611         (push (% arg_y))
612         ,z
613         (push (% arg_z))
614         ,done)))))
615
616;;; clears reg
617(defx86lapmacro mark-as-node (reg)
618  (let* ((regnum (logand #x7 (x86::gpr-ordinal (string reg))))
619         (bit (ash 1 regnum)))
620    `(progn
621       (xorl (% ,reg) (% ,reg))
622       (orb ($ ,bit) (@ (% :rcontext) x8632::tcr.node-regs-mask)))))
623
624(defx86lapmacro mark-as-imm (reg)
625  (let* ((regnum (logand #x7 (x86::gpr-ordinal (string reg))))
626         (bit (ash 1 regnum)))
627    `(progn
628       (andb ($ (lognot ,bit)) (@ (% :rcontext) x8632::tcr.node-regs-mask)))))
629
630(defx86lapmacro compose-digit (high low dest)
631  (target-arch-case
632   (:x8632
633    `(progn
634       (unbox-fixnum ,low ,dest)
635       (andl ($ #xffff) (% ,dest))
636       (shll ($ (- 16 x8632::fixnumshift)) (% ,high))
637       (orl (% ,high) (% ,dest))))
638   (:x8664
639    (error "compose-digit on x8664?"))))
Note: See TracBrowser for help on using the repository browser.