Changeset 7428


Ignore:
Timestamp:
Oct 12, 2007, 6:12:05 PM (12 years ago)
Author:
rme
Message:

Implement assorted additional vinsns.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/ia32/compiler/X86/X8632/x8632-vinsns.lisp

    r7360 r7428  
    1313  (%define-vinsn *x8632-backend* vinsn-name results args temps body))
    1414
     15(define-x8632-vinsn scale-32bit-misc-index (((dest :u32))
     16                                            ((idx :imm) ; A fixnum
     17                                             )
     18                                            ())
     19  (movl (:%l idx) (:%l dest)))
    1520
    1621(define-x8632-vinsn scale-16bit-misc-index (((dest :u32))
     
    392397  ((:pred = intval 0)
    393398   (xorl (:%l dest) (:%l dest)))
    394   ((:and (:pred /= intval 0)
    395          (:pred >= intval  -2147483648)
    396          (:pred <= intval 2147483647))
     399  ((:not (:pred = intval 0))
    397400   (movl (:$l intval) (:%l dest))))
    398401
     
    912915  (negl (:% val)))
    913916
    914 ;;; set-bigits-and-header-for-fixnum-overflow
     917;;; This handles the 1-bit overflow from addition/subtraction/unary negation
     918(define-x8632-vinsn set-bigits-and-header-for-fixnum-overflow
     919    (()
     920     ((val :lisp)
     921      (no-overflow
     922       :label))
     923     ((imm (:u32 #.x8632::imm0))))
     924  (jno.pt no-overflow)
     925  (movl (:%l val) (:%l imm))
     926  (sarl (:$ub x8632::fixnumshift) (:%l imm))
     927  (xorl (:$l #xc0000000) (:%l imm))
     928  ;; stash bignum digit
     929  (movd (:%l imm) (:%mmx x8632::mm1))
     930  ;; set header
     931  (movl (:$l x8632::one-digit-bignum-header) (:%l imm))
     932  (movd (:%l imm) (:%mmx x8632::mm0))
     933  ;; need 8 bytes of aligned memory for 1 digit bignum
     934  (movl (:$l (- 8 x8632::fulltag-misc)) (:%l imm)))
     935
     936(define-x8632-vinsn set-bigits-after-fixnum-overflow (()
     937                                                      ((bignum :lisp)))
     938  (movd (:%mmx x8632::mm1) (:@ x8632::misc-data-offset (:%l bignum)))) 
     939
    915940
    916941(define-x8632-vinsn %set-z-flag-if-s32-fits-in-fixnum (((dest :imm))
     
    963988   (movl (:%l freeptr) (:%l dest))))
    964989
    965 (define-x8632-vinsn set-bigits-after-fixnum-overflow (()
    966                                                       ((bignum :lisp)))
    967   (movq (:%mmx x8632::mm0) (:@ x8632::misc-data-offset (:%l bignum))))
    968  
    969990(define-x8632-vinsn box-fixnum (((dest :imm))
    970991                                ((src :s32)))
     
    13331354
    13341355
    1335 ;; pass-multiple-values
     1356;;; It'd be good to have a variant that deals with a known function
     1357;;; as well as this.
     1358(define-x8632-vinsn pass-multiple-values (()
     1359                                          ()
     1360                                          ((tag :u8)))
     1361  (movb (:%b x8632::temp0) (:%b tag))
     1362  (andb (:$b x8632::tagmask) (:%b tag))
     1363  (cmpb (:$b x8632::tag-misc) (:%b tag))
     1364  (jne :bad)
     1365  (cmpb (:$b x8632::subtag-function) (:@ x8632::misc-subtag-offset (:%l x8632::temp0)))
     1366  (cmovel (:%l x8632::temp0) (:%l x8632::fn))
     1367  (je :go)
     1368  (cmpb (:$b x8632::subtag-symbol) (:@ x8632::misc-subtag-offset (:%l x8632::temp0)))
     1369  (cmovel (:@ x8632::symbol.fcell (:%l x8632::fname)) (:%l x8632::fn))
     1370  (jne :bad)
     1371  :go
     1372  (pushl (:@ (+ x8632::nil-value (x8632::%kernel-global 'x86::ret1valaddr))))
     1373  (jmp (:%l x8632::fn))
     1374  :bad
     1375  (uuo-error-not-callable)
     1376  ;; If we don't do this (and leave %fn as a TRA into itself), reporting
     1377  ;; the error is likely a little harder.  Tough.
     1378  ;; (leaq (@ (:apply - (:^ :bad)) (:%q x8664::rn)) (:%q x8664::fn))
     1379)
     1380
    13361381
    13371382(define-x8632-vinsn reserve-outgoing-frame (()
     
    13621407  :back
    13631408  (movl (:$self 0) (:%l x8632::fn)))
     1409
     1410(define-x8632-vinsn make-fixed-stack-gvector (((dest :lisp))
     1411                                              ((aligned-size :u32const)
     1412                                               (header :s32const))
     1413                                              ((tempa :imm)
     1414                                               (tempb :imm)))
     1415  ((:and (:pred >= (:apply + aligned-size x8632::dnode-size) -128)
     1416         (:pred <= (:apply + aligned-size x8632::dnode-size) 127))
     1417   (subl (:$b (:apply + aligned-size x8632::dnode-size))
     1418         (:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
     1419  ((:not (:and (:pred >= (:apply + aligned-size x8632::dnode-size) -128)
     1420               (:pred <= (:apply + aligned-size x8632::dnode-size) 127)))
     1421   (subl (:$l (:apply + aligned-size x8632::dnode-size))
     1422         (:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
     1423  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l tempb))
     1424  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l tempa))
     1425  (movd (:%l tempb) (:%mmx x8632::stack-temp))
     1426  :loop
     1427  (movapd (:%xmm x8632::fpzero) (:@ -16 (:%l tempb)))
     1428  (subl (:$b x8632::dnode-size) (:%l tempb))
     1429  (cmpl (:%l tempa) (:%l tempb))
     1430  (jnz :loop)
     1431  (movd (:%mmx x8632::stack-temp) (:@ (:%l tempa)))
     1432  (movl (:%l tempa) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
     1433  (movl (:$l header) (:@ x8632::dnode-size (:%l tempa)))
     1434  (leal (:@ (+ x8632::dnode-size x8632::fulltag-misc) (:%l tempa)) (:%l dest)))
     1435
     1436
     1437(define-x8632-subprim-lea-jmp-vinsn (list*) .SPconslist-star)
     1438
     1439(define-x8632-vinsn make-tsp-vcell (((dest :lisp))
     1440                                    ((closed :lisp))
     1441                                    ((temp :imm)))
     1442  (subl (:$b (+ x8632::value-cell.size x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
     1443  (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
     1444  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
     1445  (movapd (:%xmm x8632::fpzero) (:@ (:%l temp)))
     1446  (movapd (:%xmm x8632::fpzero) (:@ x8632::dnode-size (:%l temp)))
     1447  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
     1448  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp)) 
     1449  (movl (:$l x8632::value-cell-header) (:@ x8632::dnode-size (:%l temp)))
     1450  (movl (:%l closed) (:@ (+ x8632::dnode-size x8632::node-size) (:%l temp)))
     1451  (leal (:@ (+ x8632::dnode-size x8632::fulltag-misc) (:%l temp)) (:%l dest)))
    13641452
    13651453(define-x8632-vinsn make-tsp-cons (((dest :lisp))
     
    14601548(define-x8632-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
    14611549
     1550(define-x8632-vinsn (jump-return-pc :jumpLR) (()
     1551                                              ())
     1552  (ret))
     1553
    14621554;;; xxx
    14631555(define-x8632-vinsn (nmkcatchmv :call :subprim-call) (()
     
    14711563  (movl (:$self 0) (:%l x8632::fn)))
    14721564
     1565(define-x8632-vinsn (nmkcatch1v :call :subprim-call) (()
     1566                                                     ((lab :label))
     1567                                                     ((entry (:label 1))))
     1568  (leal (:@ (:^ lab)  (:%l x8632::fn)) (:%l x8632::xfn))
     1569  (:talign 5)
     1570  (call (:@ .SPmkcatch1v))
     1571  :back
     1572  (movl (:$self 0) (:%l x8632::fn)))
     1573
     1574
     1575(define-x8632-vinsn (make-simple-unwind :call :subprim-call) (()
     1576                                                     ((protform-lab :label)
     1577                                                      (cleanup-lab :label)))
     1578  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
     1579  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
     1580  (jmp (:@ .SPmkunwind)))
     1581
     1582(define-x8632-vinsn (nmkunwind :call :subprim-call) (()
     1583                                                     ((protform-lab :label)
     1584                                                      (cleanup-lab :label)))
     1585  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
     1586  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
     1587  (jmp (:@ .SPnmkunwind)))
     1588
    14731589
    14741590(define-x8632-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
     
    14941610  (movl (:@ x8632::arrayH.data-vector (:%l header)) (:%l dest)))
    14951611
     1612(define-x8632-vinsn set-z-flag-if-istruct-typep (()
     1613                                                 ((val :lisp)
     1614                                                  (type :lisp))
     1615                                                 ((tag :u8)
     1616                                                  (valtype :lisp)))
     1617  (xorl (:%l valtype) (:%l valtype))
     1618  (movl (:%l val) (:%l tag))
     1619  (andb (:$b x8632::tagmask) (:%b tag))
     1620  (cmpb (:$b x8632::tag-misc) (:%b tag))
     1621  (jne :have-tag)
     1622  (movb (:@ x8632::misc-subtag-offset (:%l val)) (:%b tag))
     1623  :have-tag
     1624  (cmpb (:$b x8632::subtag-istruct) (:%b tag))
     1625  (jne :do-compare)
     1626  (movl (:@ x8632::misc-data-offset (:%l val)) (:%l valtype))
     1627  :do-compare
     1628  (cmpl (:%l valtype) (:%l type)))
    14961629
    14971630(define-x8632-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
     
    15261659                                                   ((addr :s32const)))
    15271660  (movl (:@ addr) (:%l dest)))
     1661
     1662(define-x8632-vinsn misc-set-u32  (()
     1663                                   ((val :u32)
     1664                                    (v :lisp)
     1665                                    (scaled-idx :s32))
     1666                                   ())
     1667  (movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
     1668
     1669(define-x8632-vinsn %iasr-c (((dest :imm))
     1670                             ((count :u8const)
     1671                              (src :imm))
     1672                             ((temp :s32)))
     1673  (movl (:%l src) (:%l temp))
     1674  (sarl (:$ub count) (:%l temp))
     1675  (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
     1676  (movl (:%l temp) (:%l dest)))
     1677
     1678(define-x8632-vinsn %ilsr-c (((dest :imm))
     1679                             ((count :u8const)
     1680                              (src :imm))
     1681                             ((temp :s32)))
     1682  (movl (:%l src) (:%l temp))
     1683  (shrl (:$ub count) (:%l temp))
     1684  ;; xxx --- use :%acc
     1685  (andb (:$b (lognot x8632::fixnummask)) (:%b temp))
     1686  (movl (:%l temp) (:%l dest)))
     1687
     1688(define-x8632-vinsn %ilsl (((dest :imm))
     1689                           ((count :imm)
     1690                            (src :imm))
     1691                           ((temp (:s32 #.x8632::eax))
     1692                            (shiftcount (:s32 #.x8632::ecx))))
     1693  (movl (:%l count) (:%l temp))
     1694  (sarl (:$ub x8632::fixnumshift) (:%l temp))
     1695  (rcmpl (:%l temp) (:$l 31))
     1696  (cmovbw (:%w temp) (:%w shiftcount))
     1697  (movl (:%l src) (:%l temp))
     1698  (jae :shift-max)
     1699  (shll (:%shift x8632::cl) (:%l temp))
     1700  (jmp :done)
     1701  :shift-max
     1702  (xorl (:%l temp) (:%l temp))
     1703  :done
     1704  (movl (:%l temp) (:%l dest)))
     1705
     1706(define-x8632-vinsn %ilsl-c (((dest :imm))
     1707                             ((count :u8const)
     1708                              (src :imm)))
     1709  ((:not (:pred =
     1710                (:apply %hard-regspec-value src)
     1711                (:apply %hard-regspec-value dest)))
     1712   (movl (:%l src) (:%l dest)))
     1713  (shll (:$ub count) (:%l dest)))
     1714
     1715(define-x8632-vinsn require-fixnum (()
     1716                                    ((object :lisp)))
     1717  :again
     1718  ((:and (:pred > (:apply %hard-regspec-value object) x8632::eax)
     1719         (:pred <= (:apply %hard-regspec-value object) x8632::ebx))
     1720   (testb (:%b x8632::fixnummask) (:%b object)))
     1721  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
     1722   (testl (:$l x8632::fixnummask) (:%l object)))
     1723  (je.pt :got-it)
     1724  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-fixnum))
     1725  (jmp :again)
     1726  :got-it)
     1727
     1728(define-x8632-vinsn require-integer (()
     1729                                     ((object :lisp))
     1730                                     ((tag :u8)))
     1731  :again
     1732  (movl (:%l object) (:%l tag))
     1733  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
     1734   (andb (:$b x8632::fixnummask) (:%accb tag)))
     1735  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
     1736         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
     1737   (andb (:$b x8632::fixnummask) (:%b tag)))
     1738  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
     1739   (andl (:$l x8632::fixnummask) (:%l tag)))
     1740  (je.pt :got-it)
     1741  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
     1742   (cmpb (:$b x8632::tag-misc) (:%accb tag)))
     1743  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
     1744         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
     1745   (cmpb (:$b x8632::tag-misc) (:%b tag)))
     1746  ((:pred > (:apply %hard-regspec-value object) x8632::ebx)
     1747   (cmpl (:$l x8632::tag-misc) (:%l tag)))
     1748  (jne :bad)
     1749  (cmpb (:$b x8632::subtag-bignum) (:@ x8632::misc-subtag-offset (:%l object)))
     1750  (je :got-it)
     1751  :bad
     1752  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-integer))
     1753  (jmp :again)
     1754  :got-it)
     1755
     1756;;; naive
     1757(define-x8632-vinsn require-real (()
     1758                                    ((object :lisp))
     1759                                    ((tag :u8)))
     1760  :again
     1761  (movl (:%l object) (:%l tag))
     1762  (andb (:$b x8632::tagmask) (:%b tag))
     1763  (cmpb (:$b x8632::tag-fixnum) (:%b tag))
     1764  (je :good)
     1765  (cmpb (:$b x8632::tag-misc) (:%b tag))
     1766  (jne :bad)
     1767  (movb (:@ x8632::misc-subtag-offset (:%l object)) (:%b tag))
     1768  (cmpb (:$b x8632::subtag-single-float) (:%b tag))
     1769  (je :good)
     1770  (cmpb (:$b x8632::subtag-double-float) (:%b tag))
     1771  (je :good)
     1772  (cmpb (:$b x8632::subtag-bignum) (:%b tag))
     1773  (je :good)
     1774  (cmpb (:$b x8632::subtag-ratio) (:%b tag))
     1775  (je :good)
     1776  :bad
     1777  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-real))
     1778  (jmp :again)
     1779  :good)
     1780
     1781(define-x8632-vinsn require-symbol (()
     1782                                    ((object :lisp))
     1783                                    ((tag :u8)))
     1784  :again
     1785  (cmpl (:$l x8632::nil-value) (:%l object))
     1786  (je :got-it)
     1787  (movl (:%l object) (:%l tag))
     1788  (andb (:$b x8632::tagmask) (:%b tag))
     1789  (cmpb (:$b x8632::tag-misc) (:%b tag))
     1790  (jne :bad)
     1791  (cmpb (:$b x8632::subtag-symbol) (:@ x8632::misc-subtag-offset (:%l object)))
     1792  (je :got-it)
     1793  :bad
     1794  (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-symbol))
     1795  (jmp :again)
     1796  :got-it)
     1797
     1798(define-x8632-vinsn mask-base-char (((dest :u8))
     1799                                    ((src :lisp)))
     1800  (movzbl (:%b src) (:%l dest)))
    15281801
    15291802(define-x8632-vinsn event-poll (()
     
    16411914                                                ())
    16421915  (movss (:%xmm x8632::fpzero) (:%xmm dest)))
     1916
     1917(define-x8632-subprim-lea-jmp-vinsn (heap-rest-arg) .SPheap-rest-arg)
     1918(define-x8632-subprim-lea-jmp-vinsn (stack-rest-arg) .SPstack-rest-arg)
     1919(define-x8632-subprim-lea-jmp-vinsn (req-stack-rest-arg) .SPreq-stack-rest-arg)
     1920
    16431921
    16441922(define-x8632-subprim-call-vinsn (stack-misc-alloc) .SPstack-misc-alloc)
     
    17262004(define-x8632-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
    17272005
    1728 (define-x8632-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
     2006(define-x8632-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
     2007
     2008(define-x8632-subprim-lea-jmp-vinsn (make-stack-gvector)  .SPstkgvector)
     2009
     2010(define-x8632-vinsn load-character-constant (((dest :lisp))
     2011                                             ((code :u32const))
     2012                                             ())
     2013  (movl (:$l (:apply logior (:apply ash code 8) x8632::subtag-character))
     2014        (:%l dest)))
     2015
    17292016
    17302017(define-x8632-vinsn setup-double-float-allocation (()
     
    18272114                                  (closed :lisp)))
    18282115  (movl (:%l closed) (:@ x8632::value-cell.value (:%l vcell))))
     2116
     2117;;; "old" mkunwind.  Used by PROGV, since the binding of *interrupt-level*
     2118;;; on entry to the new mkunwind confuses the issue.
     2119
     2120(define-x8632-vinsn (mkunwind :call :subprim-call) (()
     2121                                                     ((protform-lab :label)
     2122                                                      (cleanup-lab :label)))
     2123  (leal (:@ (:^ protform-lab) (:%l x8632::fn)) (:%l x8632::ra0))
     2124  (leal (:@ (:^ cleanup-lab)  (:%l x8632::fn)) (:%l x8632::xfn))
     2125  (jmp (:@ .SPmkunwind)))
     2126
     2127
     2128;;; Funcall the function or symbol in temp0 and obtain the single
     2129;;; value that it returns.
     2130(define-x8632-vinsn funcall (()
     2131                             ()
     2132                             ((tag :u8)
     2133                              (entry (:label 1))))
     2134  (movl (:%l x8632::temp0) (:%l tag))
     2135  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
     2136   ;; accumulator
     2137   (andb (:$b x8632::tagmask) (:%accb tag))
     2138   (cmpb (:$b x8632::tag-misc) (:%accb tag)))
     2139  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
     2140         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
     2141   ;; other register that can be treated as a byte
     2142   (andb (:$b x8632::tagmask) (:%b tag))
     2143   (cmpb (:$b x8632::tag-misc) (:%b tag)))
     2144  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
     2145   ;; non-byte register
     2146   (andl (:$l x8632::tagmask) (:%l tag))
     2147   (cmpl (:$b x8632::tag-misc) (:%l tag)))
     2148  (jne :bad)
     2149  (movl (:@ x8632::misc-subtag-offset (:%l x8632::temp0)) (:%l tag))
     2150  (cmpl (:$b x8632::subtag-function) (:%l tag))
     2151  (cmovel (:%l x8632::temp0) (:%l x8632::xfn))
     2152  (je :call)
     2153  (cmpl (:$b x8632::subtag-symbol) (:%l tag))
     2154  (cmovel (:%l x8632::symbol.fcell (:%l x8632::fname)) (:%l x8632::xfn))
     2155  (jne :bad)
     2156  :call
     2157  (:talign 5)
     2158  (call (:%l x8632::xfn))
     2159  (movl (:$self 0) (:%l x8632::fn))
     2160  :bad
     2161  (uuo-error-not-callable))
     2162
     2163(define-x8632-vinsn tail-funcall (()
     2164                                  ()
     2165                                  ((tag :u8)))
     2166  (movl (:%l x8632::temp0) (:%l tag))
     2167  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
     2168   ;; accumulator
     2169   (andb (:$b x8632::tagmask) (:%accb tag))
     2170   (cmpb (:$b x8632::tag-misc) (:%accb tag)))
     2171  ((:and (:pred > (:apply %hard-regspec-value tag) x8632::eax)
     2172         (:pred <= (:apply %hard-regspec-value tag) x8632::ebx))
     2173   ;; other register that can be treated as a byte
     2174   (andb (:$b x8632::tagmask) (:%b tag))
     2175   (cmpb (:$b x8632::tag-misc) (:%b tag)))
     2176  ((:pred > (:apply %hard-regspec-value tag) x8632::ebx)
     2177   ;; non-byte register
     2178   (andl (:$l x8632::tagmask) (:%l tag))
     2179   (cmpl (:$b x8632::tag-misc) (:%l tag)))
     2180  (jne :bad)
     2181  (movl (:@ x8632::misc-subtag-offset (:%l x8632::temp0)) (:%l tag))
     2182  (cmpl (:$b x8632::subtag-function) (:%l tag))
     2183  (cmovel (:%l x8632::temp0) (:%l x8632::xfn))
     2184  (je :go)
     2185  (cmpl (:$b x8632::subtag-symbol) (:%l tag))
     2186  (cmovel (:%l x8632::symbol.fcell (:%l x8632::fname)) (:%l x8632::xfn))
     2187  (jne :bad)
     2188  :go
     2189  (jmp (:%l x8664::xfn))
     2190  :bad
     2191  (uuo-error-not-callable))
    18292192
    18302193;;; Magic numbers in here include the address of .SPcall-closure.
     
    18542217  (call (:@ .SPspecrefcheck))
    18552218  (movl (:$self 0) (:%l x8632::fn)))
     2219
     2220(define-x8632-vinsn %ref-symbol-value-inline (((dest :lisp))
     2221                                              ((src (:lisp (:ne dest))))
     2222                                              ((table :imm)
     2223                                               (idx :imm)))
     2224  (movl (:@ x8632::symbol.binding-index (:%l src)) (:%l idx))
     2225  (rcmpl (:%l idx) (:@ (:%seg :rcontext) x8632::tcr.tlb-limit))
     2226  (jae :symbol)
     2227  (addl (:@ (:%seg :rcontext) x8632::tcr.tlb-pointer) (:%l idx))
     2228  (movl (:@ (:%l idx)) (:%l dest))
     2229  (cmpl (:$l x8632::subtag-no-thread-local-binding) (:%l dest))
     2230  (jne :done)
     2231  :symbol
     2232  (movl (:@ x8632::symbol.vcell (:%l src)) (:%l dest))
     2233  :done)
    18562234
    18572235(define-x8632-subprim-lea-jmp-vinsn (bind-nil)  .SPbind-nil)
     
    18762254    (call (:@ .SPunbind)))
    18772255   (movl (:$self 0) (:%l x8632::fn))))
     2256
     2257(define-x8632-subprim-jump-vinsn (tail-call-sym-gen) .SPtcallsymgen)
     2258
     2259(define-x8632-subprim-call-vinsn (make-stack-list)  .Spmakestacklist)
     2260
     2261(define-x8632-vinsn node-slot-ref  (((dest :lisp))
     2262                                    ((node :lisp)
     2263                                     (cellno :u32const)))
     2264  (movl (:@ (:apply + x8632::misc-data-offset (:apply ash cellno 2))
     2265            (:%l node)) (:%l dest)))
     2266
     2267(define-x8632-subprim-lea-jmp-vinsn (stack-cons-list)  .SPstkconslist)
     2268
    18782269
    18792270(define-x8632-vinsn (setq-special :call :subprim-call)
     
    19092300  :ok)
    19102301
     2302(define-x8632-subprim-jump-vinsn (tail-call-fn-slide) .SPtcallnfnslide)
     2303
     2304(define-x8632-vinsn load-double-float-constant (((dest :double-float))
     2305                                                ((lab :label)))
     2306  (movsd (:@ (:^ lab) (:%l x8632::fn)) (:%xmm dest)))
     2307
     2308(define-x8632-vinsn load-single-float-constant (((dest :single-float))
     2309                                                ((lab :label)))
     2310  (movss (:@ (:^ lab) (:%l x8632::fn)) (:%xmm dest)))
     2311
     2312(define-x8632-subprim-call-vinsn (misc-set) .SPmisc-set)
     2313
     2314(define-x8632-subprim-lea-jmp-vinsn (slide-values) .SPmvslide)
     2315
     2316(define-x8632-subprim-lea-jmp-vinsn (spread-list)  .SPspreadargz)
     2317
     2318(define-x8632-vinsn unbox-base-char (((dest :u32))
     2319                                     ((src :lisp)))
     2320  (movl (:%l src) (:%l dest))
     2321  ((:pred = (:apply %hard-regspec-value dest) x8632::eax)
     2322   (cmpb (:$b x8632::subtag-character) (:%accb dest)))
     2323  ((:and (:pred > (:apply %hard-regspec-value dest) x8632::eax)
     2324         (:pred <= (:apply %hard-regspec-value dest) x8632::ebx))
     2325   (cmpb (:$b x8632::subtag-character) (:%b dest)))
     2326  ((:pred > (:apply %hard-regspec-value dest) x8632::ebx)
     2327   ;; very rare case, if even possible...
     2328   (andl (:$l #xff) (:%l dest))
     2329   (cmpl (:$b x8632::subtag-character) (:%l dest))
     2330   (cmovel (:%l src) (:%l dest)))
     2331  (je.pt ::got-it)
     2332  (uuo-error-reg-not-tag (:%l src) (:$ub x8632::subtag-character))
     2333  :got-it
     2334  (shrl (:$ub x8632::charcode-shift) (:%l dest)))
     2335
     2336(define-x8632-subprim-lea-jmp-vinsn (save-values) .SPsave-values)
     2337
     2338(define-x8632-subprim-lea-jmp-vinsn (recover-values)  .SPrecover-values)
     2339
     2340(define-x8632-subprim-lea-jmp-vinsn (recover-values-for-mvcall) .SPrecover-values-for-mvcall)
     2341
     2342(define-x8632-subprim-lea-jmp-vinsn (add-values) .SPadd-values)
     2343
     2344(define-x8632-subprim-call-vinsn (make-stack-block)  .SPmakestackblock)
     2345
     2346(define-x8632-subprim-call-vinsn (make-stack-block0)  .Spmakestackblock0)
     2347
     2348;;; "dest" is preallocated, presumably on a stack somewhere.
     2349(define-x8632-vinsn store-double (()
     2350                                  ((dest :lisp)
     2351                                   (source :double-float))
     2352                                  ())
     2353  (movsd (:%xmm source) (:@  x8632::double-float.value (:%l dest))))
     2354
     2355
     2356(define-x8632-subprim-jump-vinsn (tail-funcall-gen) .SPtfuncallgen)
     2357
     2358(define-x8632-vinsn %init-gvector (()
     2359                                   ((v :lisp)
     2360                                    (nbytes :u32const))
     2361                                   ((count :imm)))
     2362  (movl (:$l nbytes) (:%l count))
     2363  (jmp :test)
     2364  :loop
     2365  (popl (:@ x8632::misc-data-offset (:%l v) (:%l count)))
     2366  :test
     2367  (subl (:$b x8632::node-size) (:%l count))
     2368  (jge :loop))
     2369
     2370(define-x8632-subprim-jump-vinsn (tail-funcall-slide) .SPtfuncallslide)
     2371
     2372(define-x8632-vinsn nth-value (((result :lisp))
     2373                               ()
     2374                               ((temp :imm)))
     2375  (movzwl (:%w x8632::nargs) (:%l x8632::nargs))
     2376  (leal (:@ (:%l x8632::esp) (:%l x8632::nargs)) (:%l temp))
     2377  (subl (:@ (:%l temp)) (:%l x8632::nargs))
     2378  (movl (:$l x8632::nil-value) (:%l result))
     2379  (jle :done)
     2380  ;; I -think- that a CMOV would be safe here, assuming that N wasn't
     2381  ;; extremely large.  Don't know if we can assume that.
     2382  (movl (:@ (- x8632::node-size) (:%l x8632::esp) (:%l x8632::nargs)) (:%l result))
     2383  :done
     2384  (leal (:@ x8632::node-size (:%l temp)) (:%l x8632::esp)))
     2385
     2386
     2387(define-x8632-subprim-lea-jmp-vinsn (req-heap-rest-arg) .SPreq-heap-rest-arg)
     2388
     2389(define-x8632-subprim-call-vinsn (stack-misc-alloc-init)  .SPstack-misc-alloc-init)
     2390
     2391(define-x8632-vinsn fixnum->unsigned-natural (((dest :u32))
     2392                                              ((src :imm)))
     2393  (movl (:%l src) (:%l dest))
     2394  (shrl (:$ub x8632::fixnumshift) (:%l dest)))
     2395
     2396(define-x8632-vinsn %debug-trap (()
     2397                                 ())
     2398  (uuo-error-debug-trap))
     2399
     2400
     2401
     2402
     2403
    19112404(define-x8632-vinsn  %slot-ref (((dest :lisp))
    19122405                                ((instance (:lisp (:ne dest)))
     
    19252418              (:%l src)) (:%l dest)))
    19262419
     2420(define-x8632-subprim-call-vinsn (progvsave) .SPprogvsave)
     2421
     2422(define-x8632-subprim-jump-vinsn (progvrestore) .SPprogvrestore)
     2423
     2424(define-x8632-subprim-lea-jmp-vinsn (simple-keywords) .SPsimple-keywords)
     2425
     2426(define-x8632-subprim-lea-jmp-vinsn (keyword-args) .SPkeyword-args)
     2427
     2428(define-x8632-subprim-lea-jmp-vinsn (keyword-bind) .SPkeyword-bind)
     2429
    19272430(define-x8632-vinsn scale-nargs (()
    19282431                                 ((nfixed :s16const)))
     
    19302433   (addw (:$w (:apply - (:apply ash nfixed x8632::word-shift))) (:%w x8632::nargs))))
    19312434
    1932 ;; xxx wrong for sure
     2435
     2436;; num-opt in arg_z
     2437(define-x8632-vinsn opt-supplied-p (()
     2438                                    ())
     2439  (subw (:%w x8632::nargs) (:%w x8632::arg_z))
     2440  (jmp :push-t-test)
     2441  :push-t-loop
     2442  (pushl (:$l x8632::t-value))
     2443  :push-t-test
     2444  (subw (:$w x8632::node-size) (:%w x8632::nargs))
     2445  (jge :push-t-loop)
     2446  (jmp :push-nil-test)
     2447  :push-nil-loop
     2448  (pushl (:$l x8632::nil-value))
     2449  :push-nil-test
     2450  (subw (:$w x8632::node-size) (:%w x8632::arg_z))
     2451  (jge :push-nil-loop))
     2452
     2453(define-x8632-vinsn one-opt-supplied-p (()
     2454                                        ())
     2455  (testw (:%w x8664::nargs) (:%w x8664::nargs))
     2456  (je :one)
     2457  (pushl (:$l x8632::nil-value))
     2458  (jmp :done)
     2459  :one
     2460  (pushl (:$l x8632::t-value))
     2461  :done)
     2462
     2463;; needs some love
    19332464(define-x8632-vinsn two-opt-supplied-p (()
    1934                                         ()
    1935                                         ((temp0 :u32)
    1936                                          (temp1 :u32)))
    1937   (rcmpw (:%w x8632::nargs) (:$w x8632::node-size))
    1938   (setae (:%b temp0))
    1939   (seta (:%b temp1))
    1940   (negb (:%b temp0))
    1941   (negb (:%b temp1))
    1942   (andl (:$b x8632::t-offset) (:%l temp0))
    1943   (andl (:$b x8632::t-offset) (:%l temp1))
    1944   (addl (:$l x8632::nil-value) (:%l temp0))
    1945   (addl (:$l x8632::nil-value) (:%l temp1))
    1946   (pushl (:%l temp0))
    1947   (pushl (:%l temp1)))
     2465                                        ())
     2466  ;; note that nargs is imm0
     2467  (rcmpw (:%w x8632::nargs) (:$w (:apply ash 2 x8632::word-shift)))
     2468  (jge :two)
     2469  (rcmpw (:%w x8632::nargs) (:$w (:apply ash 1 x8632::word-shift)))
     2470  (je :one)
     2471  ;; none
     2472  (pushl (:$l x8632::nil-value))
     2473  (pushl (:$l x8632::nil-value))
     2474  (jmp :done)
     2475  :one
     2476  (pushl (:$l x8632::t-value))
     2477  (pushl (:$l x8632::nil-value))
     2478  (jmp :done)
     2479  :two
     2480  (pushl (:$l x8632::t-value))
     2481  (pushl (:$l x8632::t-value))
     2482  :done)
     2483
     2484(define-x8632-vinsn set-c-flag-if-constant-logbitp (()
     2485                                                    ((bit :u8const)
     2486                                                     (int :imm)))
     2487  (btl (:$ub bit) (:%l int)))
     2488
     2489(define-x8632-vinsn mark-as-imm (()
     2490                                 ((reg :lisp)))
     2491  (btrl (:$ub (:apply %hard-regspec-value reg)) (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
     2492
     2493(define-x8632-vinsn mark-as-node (()
     2494                                  ((reg :lisp)))
     2495  (xorl (:%l reg) (:%l reg))
     2496  (btsl (:$ub (:apply %hard-regspec-value reg)) (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
    19482497
    19492498(queue-fixup
Note: See TracChangeset for help on using the changeset viewer.