Changeset 6990


Ignore:
Timestamp:
Aug 3, 2007, 12:54:10 AM (13 years ago)
Author:
rme
Message:

Sprinkle target-arch-case all over the place.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/ia32/compiler/X86/x86-lapmacros.lisp

    r6469 r6990  
    2222(defx86lapmacro rcmp (src dest)
    2323  `(cmp ,dest ,src))
     24
     25(defx86lapmacro clrl (reg)
     26  `(xorl (% ,reg) (% ,reg)))
    2427
    2528(defx86lapmacro clrq (reg)
     
    6467
    6568
    66 
    6769(defx86lapmacro extract-lisptag (node dest)
    68   `(progn
    69     (movb ($ x8664::tagmask) (%b ,dest))
    70     (andb (%b ,node) (%b ,dest))))
     70  (target-arch-case
     71   (:x8632
     72    `(progn
     73       (movb ($ x8632::tagmask) (%b ,dest))
     74       (andb (%b ,node) (%b ,dest))))
     75   (:x8664
     76    `(progn
     77       (movb ($ x8664::tagmask) (%b ,dest))
     78       (andb (%b ,node) (%b ,dest))))))
    7179
    7280(defx86lapmacro extract-fulltag (node dest)
    73   `(progn
    74     (movb ($ x8664::fulltagmask) (%b ,dest))
    75     (andb (%b ,node) (%b ,dest))))
     81  (target-arch-case
     82   (:x8632
     83    `(progn
     84       (movb ($ x8632::fulltagmask) (%b ,dest))
     85       (andb (%b ,node) (%b ,dest))))
     86   (:x8664
     87    `(progn
     88       (movb ($ x8664::fulltagmask) (%b ,dest))
     89       (andb (%b ,node) (%b ,dest))))))
    7690
    7791(defx86lapmacro extract-subtag (node dest)
    78   `(movb (@ x8664::misc-subtag-offset (% ,node)) (%b ,dest)))
     92  (target-arch-case
     93   (:x8632
     94    `(movb (@ x8632::misc-subtag-offset (% ,node)) (%b ,dest)))
     95   (:x8664
     96    `(movb (@ x8664::misc-subtag-offset (% ,node)) (%b ,dest)))))
    7997
    8098(defx86lapmacro extract-typecode (node dest)
     
    83101  ;;; the #xff00 byte.
    84102  (let* ((done (gensym)))
    85     `(progn
    86       (extract-lisptag ,node ,dest)
    87       (rcmp (%b ,dest) ($ x8664::tag-misc))
    88       (jne ,done)
    89       (movb (@  x8664::misc-subtag-offset (% ,node)) (%b ,dest))
    90       ,done)))
     103    (target-arch-case
     104     (:x8632
     105      `(progn
     106         (extract-lisptag ,node ,dest)
     107         (rcmp (%b ,dest) ($ x8632::tag-misc))
     108         (jne ,done)
     109         (movb (@  x8632::misc-subtag-offset (% ,node)) (%b ,dest))
     110         ,done))
     111     (:x8664
     112      `(progn
     113         (extract-lisptag ,node ,dest)
     114         (rcmp (%b ,dest) ($ x8664::tag-misc))
     115         (jne ,done)
     116         (movb (@  x8664::misc-subtag-offset (% ,node)) (%b ,dest))
     117         ,done)))))
    91118
    92119(defx86lapmacro trap-unless-typecode= (node tag &optional (immreg 'imm0))
     
    119146(defx86lapmacro trap-unless-fixnum (node)
    120147  (let* ((ok (gensym)))
    121     `(progn
    122       (testb ($ x8664::tagmask) (%b ,node))
    123       (je.pt ,ok)
    124       (uuo-error-reg-not-fixnum (% ,node))
    125       ,ok)))
     148    (target-arch-case
     149     (:x8632
     150      `(progn
     151         (testb ($ x8632::tagmask) (%b ,node))
     152         (je.pt ,ok)
     153         (uuo-error-reg-not-fixnum (% ,node))
     154         ,ok))
     155     (:x8664
     156      `(progn
     157         (testb ($ x8664::tagmask) (%b ,node))
     158         (je.pt ,ok)
     159         (uuo-error-reg-not-fixnum (% ,node))
     160         ,ok)))))
    126161
    127162;;; On x8664, NIL has its own tag, so no other lisp object can
    128 ;;; have the same low byte as NIL.  (That probably won't be
    129 ;;; true on x8632.)
     163;;; have the same low byte as NIL.  On x8632, NIL is a just
     164;;; a distiguished CONS.
    130165(defx86lapmacro cmp-reg-to-nil (reg)
    131   `(cmpb ($ (logand #xff x8664::nil-value)) (%b ,reg)))
    132 
     166  (target-arch-case
     167   (:x8632
     168    `(cmpl ($ x8632::nil-value) (%l ,reg)))
     169   (:x8664
     170    `(cmpb ($ (logand #xff x8664::nil-value)) (%b ,reg)))))
    133171
    134172(defx86lapmacro unbox-fixnum (src dest)
    135   `(progn
    136     (mov (% ,src) (% ,dest))
    137     (sar ($ x8664::fixnumshift) (% ,dest))))
     173  (target-arch-case
     174   (:x8632
     175    `(progn
     176       (mov (% ,src) (% ,dest))
     177       (sar ($ x8632::fixnumshift) (% ,dest))))
     178   (:x8664
     179    `(progn
     180       (mov (% ,src) (% ,dest))
     181       (sar ($ x8664::fixnumshift) (% ,dest))))))
    138182
    139183(defx86lapmacro box-fixnum (src dest)
    140   `(imulq ($ x8664::fixnumone) (% ,src) (% ,dest)))
    141 
     184  (target-arch-case
     185   (:x8632
     186    `(imull ($ x8632::fixnumone) (% ,src) (% ,dest)))
     187   (:x8664
     188    `(imulq ($ x8664::fixnumone) (% ,src) (% ,dest)))))
    142189
    143190(defx86lapmacro get-single-float (node dest)
     
    155202
    156203(defx86lapmacro get-double-float (src fpreg)
    157   `(movsd (@ x8664::double-float.value (% ,src)) (% ,fpreg)))
     204  (target-arch-case
     205   (:x8632
     206    `(movsd (@ x8632::double-float.value (% ,src)) (% ,fpreg)))
     207   (:x8664
     208    `(movsd (@ x8664::double-float.value (% ,src)) (% ,fpreg)))))
    158209
    159210(defx86lapmacro put-double-float (fpreg dest)
    160   `(movsd (% ,fpreg) (@ x8664::double-float.value (% ,dest))))
    161  
    162 
    163  
     211  (target-arch-case
     212   (:x8632
     213    `(movsd (% ,fpreg) (@ x8632::double-float.value (% ,dest))))
     214   (:x8664
     215    `(movsd (% ,fpreg) (@ x8664::double-float.value (% ,dest))))))
     216 
    164217(defx86lapmacro getvheader (src dest)
    165   `(movq (@ x8664::misc-header-offset (% ,src)) (% ,dest)))
     218  (target-arch-case
     219   (:x8632
     220    `(movl (@ x8632::misc-header-offset (% ,src)) (% ,dest)))
     221   (:x8664
     222    `(movq (@ x8664::misc-header-offset (% ,src)) (% ,dest)))))
    166223
    167224;;; "Size" is unboxed element-count.  vheader and dest should
    168225;;; both be immediate registers
    169226(defx86lapmacro header-size (vheader dest)
    170   `(progn
    171     (mov (% ,vheader) (% ,dest))
    172     (shr ($ x8664::num-subtag-bits) (% ,dest))))
    173 
     227  (target-arch-case
     228   (:x8632
     229    `(progn
     230       (mov (% ,vheader) (% ,dest))
     231       (shr ($ x8632::num-subtag-bits) (% ,dest))))
     232   (:x8664
     233    `(progn
     234       (mov (% ,vheader) (% ,dest))
     235       (shr ($ x8664::num-subtag-bits) (% ,dest))))))
    174236
    175237;;; "Length" is fixnum element-count.
    176238(defx86lapmacro header-length (vheader dest)
    177   `(progn
    178     (movq ($ (lognot 255)) (% ,dest))
    179     (andq (% ,vheader) (% ,dest))
    180     (shr ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% ,dest))))
     239  (target-arch-case
     240   (:x8632
     241    `(progn
     242       (movl ($ (lognot 255)) (% ,dest))
     243       (andl (% ,vheader) (% ,dest))
     244       (shr ($ (- x8632::num-subtag-bits x8632::fixnumshift)) (% ,dest))))
     245   (:x8664
     246    `(progn
     247       (movq ($ (lognot 255)) (% ,dest))
     248       (andq (% ,vheader) (% ,dest))
     249       (shr ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% ,dest))))))
    181250
    182251(defx86lapmacro header-subtag[fixnum] (vheader dest)
     
    191260
    192261(defx86lapmacro vector-length (vector dest)
    193   `(progn
    194     (movq ($ (lognot 255)) (% ,dest))
    195     (andq (@ x8664::misc-header-offset (% ,vector)) (% ,dest))
    196     (shr ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% ,dest)))) 
    197 
     262  (target-arch-case
     263   (:x8632
     264    `(progn
     265       (movq ($ (lognot 255)) (% ,dest))
     266       (andq (@ x8632::misc-header-offset (% ,vector)) (% ,dest))
     267       (shr ($ (- x8632::num-subtag-bits x8632::fixnumshift)) (% ,dest))))
     268   (:x8664
     269    `(progn
     270       (movq ($ (lognot 255)) (% ,dest))
     271       (andq (@ x8664::misc-header-offset (% ,vector)) (% ,dest))
     272       (shr ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% ,dest))))))
    198273
    199274(defx86lapmacro int-to-double (int temp double)
     
    208283
    209284(defx86lapmacro ref-global (global reg)
    210   `(movq (@ (+ x8664::nil-value ,(x8664::%kernel-global global))) (% ,reg)))
     285  (target-arch-case
     286   (:x8632
     287    `(movl (@ (+ x8632::nil-value ,(x8632::%kernel-global global))) (% ,reg)))
     288   (:x8664
     289    `(movq (@ (+ x8664::nil-value ,(x8664::%kernel-global global))) (% ,reg)))))
    211290
    212291(defx86lapmacro ref-global.l (global reg)
    213   `(movl (@ (+ x8664::nil-value ,(x8664::%kernel-global global))) (%l ,reg)))
     292  (target-arch-case
     293   (:x8632
     294    `(movl (@ (+ x8632::nil-value ,(x8632::%kernel-global global))) (%l ,reg)))
     295   (:x8664
     296    `(movl (@ (+ x8664::nil-value ,(x8664::%kernel-global global))) (%l ,reg)))))
    214297
    215298(defx86lapmacro set-global (reg global)
    216   `(movq (% ,reg) (@ (+ x8664::nil-value ,(x8664::%kernel-global global)))))
     299  (target-arch-case
     300   (:x8632
     301    `(movl (% ,reg) (@ (+ x8632::nil-value ,(x8632::%kernel-global global)))))
     302   (:x8664
     303    `(movq (% ,reg) (@ (+ x8664::nil-value ,(x8664::%kernel-global global)))))))
    217304
    218305(defx86lapmacro macptr-ptr (src dest)
    219   `(movq (@ x8664::macptr.address (% ,src)) (% ,dest)))
     306  (target-arch-case
     307   (:x8632
     308    `(movl (@ x8632::macptr.address (% ,src)) (% ,dest)))
     309   (:x8664
     310    `(movq (@ x8664::macptr.address (% ,src)) (% ,dest)))))
    220311
    221312;;; CODE is unboxed char-code (in low 8 bits); CHAR needs to be boxed.
    222313(defx86lapmacro box-character (code char)
    223   `(progn
    224     (box-fixnum ,code ,char)
    225     (shl ($ (- x8664::charcode-shift x8664::fixnumshift)) (% ,char))
    226     (movb ($ x8664::subtag-character) (%b ,char))))
    227 
     314  (target-arch-case
     315   (:x8632
     316    `(progn
     317       (box-fixnum ,code ,char)
     318       (shl ($ (- x8632::charcode-shift x8632::fixnumshift)) (% ,char))
     319       (movb ($ x8632::subtag-character) (%b ,char))))
     320   (:x8664
     321    `(progn
     322       (box-fixnum ,code ,char)
     323       (shl ($ (- x8664::charcode-shift x8664::fixnumshift)) (% ,char))
     324       (movb ($ x8664::subtag-character) (%b ,char))))))
    228325 
    229326;;; index is a constant
    230327(defx86lapmacro svref (vector index dest)
    231   `(movq (@ (+ x8664::misc-data-offset (* ,index 8)) (% ,vector)) (% ,dest)))
     328  (target-arch-case
     329   (:x8632
     330    `(movl (@ (+ x8632::misc-data-offset (* ,index 4)) (% ,vector)) (% ,dest)))
     331   (:x8664
     332    `(movq (@ (+ x8664::misc-data-offset (* ,index 8)) (% ,vector)) (% ,dest)))))
    232333
    233334;;; Index is still a constant
    234335(defx86lapmacro svset (vector index new)
    235   `(movq (% ,new) (@ (+ x8664::misc-data-offset (* ,index 8)) (% ,vector))))
    236 
     336  (target-arch-case
     337   (:x8632
     338    `(movl (% ,new) (@ (+ x8632::misc-data-offset (* ,index 4)) (% ,vector))))
     339   (:x8664
     340    `(movq (% ,new) (@ (+ x8664::misc-data-offset (* ,index 8)) (% ,vector))))))
    237341
    238342
     
    242346;;; Simple frame, since the caller didn't reserve space for it.
    243347(defx86lapmacro save-simple-frame ()
    244   `(progn
    245     (pushq (% rbp))
    246     (movq (% rsp) (% rbp))))
    247 
     348  (target-arch-case
     349   (:x8632
     350    `(progn
     351       (pushl (% ebp))
     352       (movl (% esp) (% ebp))))
     353   (:x8664
     354    `(progn
     355       (pushq (% rbp))
     356       (movq (% rsp) (% rbp))))))
     357
     358;;; need better understanding than just a vague notion
     359;;; of what is going on here
    248360(defx86lapmacro save-frame-variable-arg-count ()
    249361  (let* ((push (gensym))
    250362         (done (gensym)))
    251   `(progn
    252     (movzwl (% nargs) (%l imm0))
    253     (subq ($ (* $numx8664argregs x8664::node-size)) (% imm0))
    254     (jle ,push)
    255     (movq (% rbp) (@ 8 (% rsp) (% imm0)))
    256     (leaq (@ 8 (% rsp) (% imm0)) (% rbp))
    257     (popq (@ 8 (% rbp)))
    258     (jmp ,done)
    259     ,push
    260     (save-simple-frame)
    261     ,done)))
     363    (target-arch-case
     364     (:x8632
     365      `(progn
     366         (movzxwl (% nargs) (% imm0))
     367         (subl ($ (* $numx8632argregs x8632::node-size)) (% imm0))
     368         (jle ,push)
     369         (movl (% ebp) (@ 4 (% esp) (% imm0)))
     370         (leaq (@ 4 (% esp) (% imm0)) (% ebp))
     371         (popl (@ (% ebp)))
     372         (jmp ,done)
     373         ,push
     374         (save-simple-frame)
     375         ,done))
     376     (:x8664
     377      `(progn
     378         (movzwl (% nargs) (%l imm0))
     379         (subq ($ (* $numx8664argregs x8664::node-size)) (% imm0))
     380         (jle ,push)
     381         (movq (% rbp) (@ 8 (% rsp) (% imm0)))
     382         (leaq (@ 8 (% rsp) (% imm0)) (% rbp))
     383         (popq (@ 8 (% rbp)))
     384         (jmp ,done)
     385         ,push
     386         (save-simple-frame)
     387         ,done)))))
    262388
    263389
     
    266392    (leave)))
    267393
    268 
    269 
     394;;; not sure about this
    270395(defx86lapmacro discard-reserved-frame ()
    271   `(add ($ '2) (% rsp)))
     396  (target-arch-case
     397   (:x8632
     398    `(add ($ '2) (% esp)))
     399   (:x8664
     400    `(add ($ '2) (% rsp)))))
    272401
    273402;;; Return to caller.
    274403(defx86lapmacro single-value-return (&optional (words-to-discard 0))
    275   (if (zerop words-to-discard)
    276     `(ret)
    277     `(ret ($ ,(* x8664::node-size words-to-discard)))))
    278 
     404  (target-arch-case
     405   (:x8632
     406    (if (zerop words-to-discard)
     407        `(ret)
     408        `(ret ($ ,(* x8632::node-size words-to-discard)))))
     409   (:x8664
     410    (if (zerop words-to-discard)
     411        `(ret)
     412        `(ret ($ ,(* x8664::node-size words-to-discard)))))))
     413
     414;;; xxx add ia32 version
    279415;;; Using *x8664-backend* here is wrong but expedient.
     416;;; Using *x8632-backend* makes it doubly wrong, I guess.
    280417(defun x86-subprim-offset (name)
    281   (let* ((info (find name (arch::target-subprims-table (backend-target-arch *x8664-backend*)) :test #'string-equal :key #'subprimitive-info-name))
    282          (offset (when info
    283                    (subprimitive-info-offset info))))
    284     (or offset     
    285       (error "Unknown subprim: ~s" name))))
     418  (let (info
     419        offset)
     420    (target-arch-case
     421     (:x8632
     422      (setf info (find name (arch::target-subprims-table (backend-target-arch *x8632-backend*)) :test #'string-equal :key #'subprimitive-info-name))
     423      (setf offset (when info
     424                     (subprimitive-info-offset info))))
     425     (:x8664
     426      (setf info (find name (arch::target-subprims-table (backend-target-arch *x8664-backend*)) :test #'string-equal :key #'subprimitive-info-name))
     427      (setf offset (when info
     428                     (subprimitive-info-offset info))))
     429      (or offset     
     430          (error "Unknown subprim: ~s" name)))))
    286431
    287432(defx86lapmacro jmp-subprim (name)
    288433  `(jmp (@ ,(x86-subprim-offset name))))
    289434
     435(defx86lapmacro recover-fn ()
     436  `(movl ($ :self) (% fn)))
     437
    290438(defx86lapmacro call-subprim (name)
    291   `(progn
    292     (:talign 4)
    293     (call (@ ,(x86-subprim-offset name)))
    294     (recover-fn-from-rip)))
    295 
    296      
    297 (defx86lapmacro %car (src dest)
    298   `(movq (@ x8664::cons.car (% ,src)) (% ,dest)))
     439  (target-arch-case
     440   (:x8632
     441    `(progn
     442       (:talign x8632::fulltag-tra)
     443       (call (@ ,(x86-subprim-offset name)))
     444       (recover-fn)))
     445   (:x8664
     446    `(progn
     447       (:talign 4)
     448       (call (@ ,(x86-subprim-offset name)))
     449       (recover-fn-from-rip)))))
     450
     451 (defx86lapmacro %car (src dest)
     452  (target-arch-case
     453   (:x8632
     454    `(movl (@ x8632::cons.car (% ,src)) (% ,dest)))
     455   (:x8664
     456    `(movq (@ x8664::cons.car (% ,src)) (% ,dest)))))
    299457
    300458(defx86lapmacro %cdr (src dest)
    301   `(movq (@ x8664::cons.cdr (% ,src)) (% ,dest)))
     459  (target-arch-case
     460   (:x8632
     461    `(movl (@ x8632::cons.cdr (% ,src)) (% ,dest)))
     462   (:x8664
     463    `(movq (@ x8664::cons.cdr (% ,src)) (% ,dest)))))
    302464
    303465(defx86lapmacro stack-probe ()
    304   (let* ((ok (gensym)))
    305     `(progn
    306       (rcmp (% rsp) (@ (% rcontext) x8664::tcr.cs-limit))
    307       (jae.pt ,ok)
    308       (uuo-stack-overflow)
    309       ,ok)))
     466  (target-arch-case
     467   (:x8632
     468    (let* ((ok (gensym)))
     469      `(progn
     470         (rcmp (% esp) (@ (% rcontext) x8632::tcr.cs-limit))
     471         (jae.pt ,ok)
     472         (uuo-stack-overflow)
     473         ,ok)))
     474   (:x8664
     475    (let* ((ok (gensym)))
     476      `(progn
     477         (rcmp (% rsp) (@ (% rcontext) x8664::tcr.cs-limit))
     478         (jae.pt ,ok)
     479         (uuo-stack-overflow)
     480         ,ok)))))
    310481
    311482(defx86lapmacro load-constant (constant dest &optional (fn 'fn))
    312   `(movq (@ ',constant (% ,fn)) (% ,dest)))
     483  (target-arch-case
     484   (:x8632
     485    `(movl (@ ',constant (% ,fn)) (% ,dest)))
     486   (:x8664
     487    `(movq (@ ',constant (% ,fn)) (% ,dest)))))
    313488
    314489(defx86lapmacro recover-fn-from-rip ()
     
    322497;;; to return a single value.
    323498(defx86lapmacro call-symbol (name nargs)
    324   `(progn
    325     (load-constant ,name fname)
    326     (set-nargs ,nargs)
    327     (:talign 4)
    328     (call (@ x8664::symbol.fcell (% fname)))
    329     (recover-fn-from-rip)))
     499  (target-arch-case
     500   (:x8632
     501    `(progn
     502       (load-constant ,name fname)
     503       (set-nargs ,nargs)
     504       (:talign 5)
     505       (call (@ x8632::symbol.fcell (% fname)))
     506       (recover-fn)))
     507   (:x8664
     508    `(progn
     509       (load-constant ,name fname)
     510       (set-nargs ,nargs)
     511       (:talign 4)
     512       (call (@ x8664::symbol.fcell (% fname)))
     513       (recover-fn-from-rip)))))
    330514
    331515
     
    336520;;;  prevent the current function from being GCed halfway through
    337521;;;  those couple of instructions.
     522
     523;;; The above comment appears to be stale.
     524;;; %fn (which is distinct from %fname) will be pointing to
     525;;; the current function, so it won't get GCed out from under us.
    338526(defx86lapmacro jump-symbol (name nargs)
    339527  `(progn
    340528    (load-constant ,name fname)
    341529    (set-nargs ,nargs)
    342     (jmp (@ x8664::symbol.fcell (% fname)))))
     530    (target-arch-case
     531     (:x8632
     532      (jmp (@ x8632::symbol.fcell (% fname))))
     533     (:x8664
     534      (jmp (@ x8664::symbol.fcell (% fname)))))))
    343535
    344536(defx86lapmacro push-argregs ()
     
    346538         (yz (gensym))
    347539         (z (gensym)))
    348   `(progn
    349     (testw (% nargs) (% nargs))
    350     (je ,done)
    351     (cmpw ($ '2) (% nargs))
    352     (je ,yz)
    353     (jb ,z)
    354     (push (% arg_x))
    355     ,yz
    356     (push (% arg_y))
    357     ,z
    358     (push (% arg_z))
    359     ,done)))
     540    (target-arch-case
     541     (:x8632
     542      `(progn
     543         (testw (% nargs) (% nargs))
     544         (je ,done)
     545         (cmpw ($ '1) (% nargs))
     546         (je ,z)
     547         (push (% arg_y))
     548         ,z
     549         (push (% arg_z))
     550         ,done))
     551     (:x8664
     552      `(progn
     553         (testw (% nargs) (% nargs))
     554         (je ,done)
     555         (cmpw ($ '2) (% nargs))
     556         (je ,yz)
     557         (jb ,z)
     558         (push (% arg_x))
     559         ,yz
     560         (push (% arg_y))
     561         ,z
     562         (push (% arg_z))
     563         ,done)))))
    360564   
Note: See TracChangeset for help on using the changeset viewer.