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

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

New Japanese character encodings cp 932, eucjp from Yoshinori Tahara.
New x8632 large function support (from rme, mostly.)
The latter's a bit hard to bootstrap; new binaries, fasl/image versions
soon.

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