Changeset 7963 for branches/ia32/level-0


Ignore:
Timestamp:
Dec 28, 2007, 5:41:58 AM (13 years ago)
Author:
rme
Message:

Checkpoint.

Location:
branches/ia32/level-0/X86/X8632
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/ia32/level-0/X86/X8632/x8632-bignum.lisp

    r7916 r7963  
    66;;; The easiest thing to do is to store the 32 raw bits in two fixnums
    77;;; and return multiple values.
     8;;;
    89;;; XXX -- figure out how we're going to handle multiple-values...
    910(defx8632lapfunction %bignum-ref ((bignum arg_y) (i arg_z))
    … …  
    9394(defx8632lapfunction %add-with-carry ((r 20) (k 16) (c 12) (a 8) (i 4) #|(ra 0)|# (b arg_y) (j arg_z))
    9495  (mark-as-imm temp0)
    95   (unbox-fixnum b imm0)                 ;assume that j is going to be nil
    96   (cmpl ($ x8632::nil-value) (% j))     ;is j in fact nil?
    97   (jne @got-b)
    98   (movl (@ x8632::misc-data-offset (% b) (% j)) (% imm0))
    99   @got-b
     96  (unbox-fixnum b imm0)
     97  (cmpl ($ x8632::nil-value) (% j))
     98  ;; if j not nil, get b[j]
     99  (cmovnel (@ x8632::misc-data-offset (% b) (% j)) (% imm0))
    100100  (movl (@ a (% esp)) (% arg_y))
    101   (unbox-fixnum arg_y temp0)            ;assume that i is going be nil
     101  (unbox-fixnum arg_y temp0)
    102102  (movl (@ i (% esp)) (% arg_z))
    103   (cmpl ($ x8632::nil-value) (% arg_z)) ;is i in fact nil?
    104   (jne @got-a)
    105   (movl (@ x8632::misc-data-offset (% arg_y) (% arg_z)) (% temp0))
    106   @got-a
    107   ;; unboxed a or a[i] now in temp0
    108   ;; unboxed b or b[j] now in imm0
     103  (cmpl ($ x8632::nil-value) (% arg_z))
     104  ;; if i not nil, get a[i]
     105  (cmovnel (@ x8632::misc-data-offset (% arg_y) (% arg_z)) (% temp0))
    109106  (movl ($ '1) (% arg_z))               ;for outgoing carry
    110   (movl (@ c (% esp)) (% arg_y))
    111   (testl (% arg_y) (% arg_y))           ;clears carry flag
    112   (jz @add)
    113107  (xorl (% arg_y) (% arg_y))
    114   (stc)
    115   @add
    116   ;; arg_y = 0, arg_z = fixnum 1
     108  ;; I can't think of a better way to set CF at the moment.
     109  ;; NEG would be ideal, but we don't have a free imm reg.
     110  (btl ($ x8632::fixnumshift) (@ c (% esp))) ;CF = lsb of carry fixnum
    117111  (adc (% temp0) (% imm0))
     112  (mark-as-node temp0)
    118113  (movl (@ r (% esp)) (% temp0))
    119114  (movl (@ k (% esp)) (% temp1))
    120115  (movl (% imm0) (@ x8632::misc-data-offset (% temp0) (% temp1)))
    121   (cmovnc (% arg_y) (% arg_z))          ;zero outgoing carry if no carry
    122   (mark-as-node temp0)
     116  (cmovnc (% arg_y) (% arg_z))          ;zero outgoing carry if CF = 0
    123117  (single-value-return 7))
     118
     119;;; Add the digits A[I] and B[J], and the incoming carry C (a fixnum).
     120;;; Store the result in R[K], and return the outgoing carry.  If I is
     121;;; NIL, A is a fixnum.  If J is NIL, B is a fixnum.
     122#+sse2
     123(defx8632lapfunction %add-with-carry ((r 20) (k 16) (c 12) (a 8) (i 4) #|(ra 0)|# (b arg_y) (j arg_z))
     124  (let ((aa mm2)
     125        (bb mm3)
     126        (cc mm4))
     127    (unbox-fixnum b imm0)               ;assume j will be nil
     128    (cmpl ($ x8632::nil-value) (% j))
     129    ;; if j not nil, get b[j]
     130    (cmovnel (@ x8632::misc-data-offset (% b) (% j)) (% imm0))
     131    (movd (% imm0) (% bb))
     132    (movl (@ a (% esp)) (% arg_y))
     133    (movl (@ i (% esp)) (% arg_z))
     134    (movl (@ c (% esp)) (% temp0))
     135    (unbox-fixnum arg_y imm0)           ;assume i will be nil
     136    (cmpl ($ x8632::nil-value) (% arg_z))
     137    ;; if i not nil, get a[i]
     138    (cmovnel (@ x8632::misc-data-offset (% arg_y) (% arg_z)) (% imm0))
     139    (movd (% imm0) (% aa))
     140    (unbox-fixnum temp0 imm0)
     141    (movd (% imm0) (% cc))
     142    (paddq (% xx) (% yy))
     143    (paddq (% cc) (% yy))
     144    (movl (@ r (% esp)) (% temp0))
     145    (movl (@ k (% esp)) (% temp1))
     146    (movd (% yy) (@ x8632::misc-data-offset (% temp0) (% temp1)))
     147    (psrlq ($ 32) (% yy))               ;carry bit
     148    (movd (% yy) (% imm0))
     149    (box-fixnum imm0 arg_z)
     150    (single-value-return 7)))
    124151
    125152;;; Store the result of A[I] - B[J] - borrow into R[K], returning the borrow.
    126153;;; If I is NIL, A is a fixnum; likewise for J and B.
     154;;;
     155;;; (a - b) - (1 - borrow), or equivalently, (a - b) + borrow - 1
     156;;;
     157;;; Note: borrow is 1 for no borrow and 0 for a borrow.
    127158(defx8632lapfunction %subtract-with-borrow ((r 20) (k 16) (borrow 12) (a 8) (i 4) #|(ra 0)|# (b arg_y) (j arg_z))
    128159  (mark-as-imm temp0)
    129   (unbox-fixnum b imm0)                 ;assume that j is going to be nil
    130   (cmpl ($ x8632::nil-value) (% j))     ;is j in fact nil?
    131   (jne @got-b)
    132   (movl (@ x8632::misc-data-offset (% b) (% j)) (% imm0))
    133   @got-b
     160  (unbox-fixnum b imm0)
     161  (cmpl ($ x8632::nil-value) (% j))
     162  (cmovnel (@ x8632::misc-data-offset (% b) (% j)) (% imm0))
    134163  (movl (@ a (% esp)) (% arg_y))
    135   (unbox-fixnum arg_y temp0)            ;assume that i is going be nil
     164  (unbox-fixnum arg_y temp0)
    136165  (movl (@ i (% esp)) (% arg_z))
    137   (cmpl ($ x8632::nil-value) (% arg_z)) ;is i in fact nil?
    138   (jne @got-a)
    139   (movl (@ x8632::misc-data-offset (% arg_y) (% arg_z)) (% temp0))
    140   @got-a
    141   ;; unboxed a or a[i] now in temp0
    142   ;; unboxed b or b[j] now in imm0
    143   (movl ($ '1) (% arg_z))               ;for outgoing carry
    144   (movl (@ borrow (% esp)) (% arg_y))
    145   (testl (% arg_y) (% arg_y))           ;clears carry flag
    146   (jz @sub)
    147   (xorl (% arg_y) (% arg_y))
    148   (stc)
    149   @sub
    150   ;; arg_y = 0, arg_z = fixnum 1
     166  (cmpl ($ x8632::nil-value) (% arg_z))
     167  (cmovnel (@ x8632::misc-data-offset (% arg_y) (% arg_z)) (% temp0))
     168  ;; unboxed a or a[i] in temp0, unboxed b or b[j] in imm0
     169  (cmpl ($ '1) (@ borrow (% esp)))      ;CF = 1 if borrow is 0 else CF = 0
    151170  (sbb (% imm0) (% temp0))
     171  (movl ($ 1) (% imm0))
     172  (sbb ($ 0) (% imm0))
     173  (box-fixnum imm0 arg_z)
     174  (movl (% temp0) (% imm0))
     175  (mark-as-node temp0)
    152176  (movl (@ r (% esp)) (% temp0))
    153177  (movl (@ k (% esp)) (% temp1))
    154178  (movl (% imm0) (@ x8632::misc-data-offset (% temp0) (% temp1)))
    155   (cmovnc (% arg_y) (% arg_z))          ;zero outgoing carry if no carry
    156   (mark-as-node temp0)
    157179  (single-value-return 7))
     180
     181#+sse2
     182(defx8632lapfunction %subtract-with-borrow ((r 20) (k 16) (borrow 12) (a 8) (i 4) #|(ra 0)|# (b arg_y) (j arg_z))
     183  (let ((aa mm2)
     184        (bb mm3)
     185        (ww mm4))
     186    (unbox-fixnum b imm0)
     187    (cmpl ($ x8632::nil-value) (% j))
     188    ;; if j not nil, get b[j]
     189    (cmovnel (@ x8632::misc-data-offset (% b) (% j)) (% imm0))
     190    (movd (% imm0) (% bb))
     191    (movl (@ a (% esp)) (% arg_y))
     192    (movl (@ i (% esp)) (% arg_z))
     193    (movl (@ borrow (% esp)) (% temp0))
     194    (unbox-fixnum arg_y imm0)
     195    (cmpl ($ x8632::nil-value) (% arg_z))
     196    ;; if i not nil, get a[i]
     197    (cmovnel (@ x8632::misc-data-offset (% arg_y) (% arg_z)) (% imm0))
     198    (movd (% imm0) (% aa))
     199    (unbox-fixnum temp0 imm0)
     200    (subl ($ 1) (% imm0))
     201    (movd (% imm0) (% ww))
     202    (psubq (% bb) (% aa))
     203    (paddq (% ww) (% aa))
     204    (movl (@ r (% esp)) (% temp0))
     205    (movl (@ k (% esp)) (% temp1))
     206    (movd (% aa) (@ x8632::misc-data-offset (% temp0) (% temp1)))
     207    (psrlq ($ 32) (% aa))               ;carry digit
     208    (movd (% aa) (% imm0))
     209    (xorl (% arg_z) (% arg_z))
     210    (test ($ 1) (% imm0))
     211    (cmovzl ($ '1) (% arg_z))
     212    (single-value-return 7)))
     213
     214(defx8632lapfunction %subtract-one ((high arg_y) (low arg_z))
     215  (mark-as-imm temp0)
     216  (unbox-fixnum low imm0)
     217  (movl (% high) (% temp0))
     218  (shll ($ (- 16 x8632::fixnumshift)) (% temp0))
     219  (orl (% imm0) (% temp0))
     220  (subl ($ 1) (% temp0))
     221  (movzwl (% temp0.w) (% imm0))
     222  (box-fixnum imm0 low)
     223  (sarl ($ 16) (% temp0))
     224  (box-fixnum temp0 high)
     225  (mark-as-node temp0)
     226  (push (% high))
     227  (push (% low))
     228  (movl (% esp) (% temp0))
     229  (jmp-subprim .SPvalues))
     230
     231;;; %SUBTRACT-WITH-BORROW -- Internal.
     232;;;
     233;;; This should be in assembler, and should not cons intermediate results.  It
     234;;; returns a 32bit digit and a borrow resulting from subtracting b from a, and
     235;;; subtracting a possible incoming borrow.
     236;;;
     237;;; We really do:  a - b - 1 + borrow, where borrow is either 0 or 1.
     238;;;
     239
     240(defx8632lapfunction %subtract-with-borrow-1 ((a-h 12) (a-l 8) (b-h 4) #|(ra 0)|# (b-l arg_y) (borrow arg_z))
     241  (mark-as-imm temp0)
     242  (mark-as-imm temp1)
     243  (unbox-fixnum b-l temp0)
     244  (movl (@ b-h (% esp)) (% imm0))
     245  (unbox-fixnum imm0 imm0)
     246  (shll ($ 16) (% imm0))
     247  (orl (% imm0) (% temp0))
     248  (movl (@ a-l (% esp)) (% temp1))
     249  (unbox-fixnum temp1 temp1)
     250  (movl (@ a-h (% esp)) (% imm0))
     251  (unbox-fixnum imm0 imm0)
     252  (shll ($ 16) (% imm0))
     253  (orl (% imm0) (% temp1))
     254  (cmpl ($ '1) (@ borrow (% esp)))      ;CF = 1 if borrow is 0 else CF = 0
     255  (sbbl (% temp0) (% temp1))
     256  (movl ($ 1) (% imm0))
     257  (subb ($ 0) (% imm0))
     258  (box-fixnum imm0 arg_z)
     259  (movzwl (% temp1.w) (% imm0))
     260  (box-fixnum imm0 imm0)
     261  (push (% imm0))                       ;high
     262  (sarl ($ 16) (% temp1))
     263  (box-fixnum temp1 imm0)
     264  (mark-as-node temp0)
     265  (mark-as-node temp1)
     266  (push (% imm0))                       ;low
     267  (push (% arg_z))                      ;borrow
     268  (set-nargs 3)
     269  (popl (@ 16 (% esp)))                 ;relocate return addr
     270  (addl ($ '4) (% esp))                 ;discard args, part of saved frame
     271  (movl (% esp) (% temp0))
     272  (jmp-subprim .SPvalues))
     273 
    158274
    159275;;; To normalize a bignum is to drop "trailing" digits which are
    … …  
    183299    (je @adjust-length)
    184300    (movl (% next) (% sign))
    185     ;; (bignum-ref bignum (- len 2)), i.e., next-to-last digit
     301    ;; (bignum-ref bignum (- len 2))
    186302    (movl (@ (- x8632::misc-data-offset 8) (% bignum) (% len)) (% next))
    187303    @test
    188304    (movl (% next) (% imm0))
    189305    (sarl ($ 31) (% imm0))              ;propagate sign bit
    190     (xorl (% sign) (% imm0))
    191     (testl (% imm0) (% imm0))           ;whole digit only sign?
     306    (xorl (% sign) (% imm0))            ;whole digit only sign?
    192307    (jz @loop)
    193308    ;; New length now in len.
    … …  
    196311    (cmpl (% len) (% imm0))
    197312    ;; If the new length is the same as the original length, we know
    198     ;; that the bignum is at least two digits long, and will never fit
    199     ;; in a fixnum.  Therefore, there's no need to do either of the
    200     ;; tests at @maybe-return-fixnum.
     313    ;; that the bignum is at least two digits long (because if it was
     314    ;; shorter, we would have branched directly to
     315    ;; @maybe-return-fixnum), and thus won't fit in a fixnum.
     316    ;; Therefore, there's no need to do either of the tests at
     317    ;; @maybe-return-fixnum.
    201318    (je @done)
    202319    (movl (% len) (% imm0))
    … …  
    206323    @maybe-return-fixnum
    207324    ;; could use SETcc here to avoid one branch
    208     (pop (% return-fixnum-p))
    209325    (cmpl ($ x8632::nil-value) (@ 0 (% esp))) ;return-fixnum-p
    210326    (je @done)
    … …  
    222338    (mark-as-node temp1)
    223339    (single-value-return)))
     340
     341;;; Multiply X[I] by the unboxed value of the (non-negative) fixnum Y;
     342;;; add the incoming carry from CARRY[0] to the 64-bit product.  Store
     343;;; the low word of the 64-bit sum in R[0] and the high word in
     344;;; CARRY[0].
     345(defx8632lapfunction %multiply-and-add ((r 12) (carry 8) (x 4) #|(ra 0)|# (i arg_y) (y arg_z))
     346  (let ((xx mm2)
     347        (yy mm3)
     348        (cc mm4))
     349    (movl (@ x (% esp)) (% imm0))
     350    (movd (@ x8632::misc-data-offset (% imm0) (% i)) (% xx))
     351    (unbox-fixnum y imm0)
     352    (movd (% imm0) (% yy))
     353    (pmuludq (% xx) (% yy))             ;64 bit product
     354    (movl (@ carry (% esp)) (% arg_y))
     355    (movd (@ x8632::misc-data-offset (% arg_y)) (% cc))
     356    (paddq (% cc) (% yy))               ;add in 32 bit carry digit
     357    (movl (@ r (% esp)) (% arg_z))
     358    (movd (% yy) (@ x8632::misc-data-offset (% arg_z)))
     359    (psrlq ($ 32) (% yy))
     360    (movd (% yy) (@ x8632::misc-data-offset (% arg_y)))
     361    (single-value-return 5)))
     362
     363;; multiply x[i] by y and add to result starting at digit i
     364(defx8632lapfunction %multiply-and-add-harder-loop-2
     365    ((x 12) (y 8) (r 4) #|(ra 0)|# (i arg_y) (ylen arg_z))
     366  (let ((cc mm2)
     367        (xx mm3)
     368        (yy mm4)
     369        (j imm0))
     370    (movl (@ x (% esp)) (% temp0))
     371    (movd (@ x8632::misc-data-offset (% temp0) (% i)) (% xx)) ;x[i]
     372    (movl (@ y (% esp)) (% temp0))
     373    (movl (@ r (% esp)) (% temp1))
     374    (pxor (% cc) (% cc))
     375    (xorl (% j) (% j))
     376    @loop
     377    (movd (@ x8632::misc-data-offset (% temp0) (% j)) (% yy)) ;y[j]
     378    (pmuludq (% xx) (% yy))
     379    (paddq (% cc) (% yy))
     380    (movd (% yy) (@ x8632::misc-data-offset (% temp1) (% i))) ;store r[i]
     381    (movq (% yy) (% cc))
     382    (psrlq ($ 32) (% cc))               ;carry high digit
     383    (addl ($ '1) (% i))
     384    (addl ($ '1) (% j))
     385    (subl ($ '1) (% ylen))
     386    (jg @loop)
     387    (movd (% cc) (@ x8632::misc-data-offset (% temp1) (% i)))
     388    (single-value-return 5)))
     389
     390;; this is silly 
     391(defx8632lapfunction %add-the-carry ((high 4) #|(ra 0)|# (low arg_y) (c arg_z))
     392  (mark-as-imm temp0)
     393  (unbox-fixnum low imm0)
     394  (movl (@ high (% esp)) (% temp0))
     395  (shll ($ (- 16 x8632::fixnumshift)) (% temp0))
     396  (orl (% imm0) (% temp0))
     397  (unbox-fixnum c imm0)
     398  (addl (% imm0) (% temp0))
     399  (movzwl (% temp0.w) (% imm0))
     400  (box-fixnum imm0 temp1)
     401  (sarl ($ 16) (% temp0))
     402  (box-fixnum temp0 temp0)
     403  (push (% temp0))                      ;high
     404  (push (% temp1))                      ;low
     405  (set-nargs 2)
     406  (mark-as-node temp0)
     407  (movl (% esp) (% temp0))
     408  (jmp-subprim .SPvalues))
     409
     410(defx8632lapfunction %bignum-count-trailing-zero-bits ((bignum arg_z))
     411  (let ((i arg_y)
     412        (len temp0)
     413        (zeros temp1))
     414    (vector-length bignum temp0)
     415    (xorl (% i) (% i))
     416    (movl ($ '32) (% zeros))
     417    @loop
     418    (movl (@ x8632::misc-data-offset (% bignum) (% i)) (% imm0))
     419    (addl ($ '1) (% i))
     420    (addl ($ '32) (% zeros))
     421    (testl (% imm0) (% imm0))
     422    (jz @loop)
     423    ;; now count zero bits in digit
     424    (bsrl (% imm0) (% imm0))
     425    (box-fixnum imm0 imm0)
     426    (addl (% imm0) (% zeros))
     427    (movl (% zeros) (% arg_z))
     428    (single-value-return)))
     429
     430;;; dest[i] = (logand x[i] y[i])
     431(defx8632lapfunction %bignum-logand ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
     432  (let ((i temp0)
     433        (xx temp1)
     434        (yy arg_y))
     435    (movl (@ idx (% esp)) (% i))
     436    (movl (@ x (% esp)) (% xx))
     437    (movl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
     438    (andl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
     439    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
     440    (single-value-return 4)))
     441
     442;;; dest[i] = (logandc1 x[i] y[i])
     443(defx8632lapfunction %bignum-logandc1 ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
     444  (let ((i temp0)
     445        (xx temp1)
     446        (yy arg_y))
     447    (movl (@ idx (% esp)) (% i))
     448    (movl (@ x (% esp)) (% xx))
     449    (movl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
     450    (not (% imm0))
     451    (andl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
     452    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
     453    (single-value-return 4)))
     454
     455;;; dest[i] = (logandc2 x[i] y[i])
     456(defx8632lapfunction %bignum-logandc2 ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
     457  (let ((i temp0)
     458        (xx temp1)
     459        (yy arg_y))
     460    (movl (@ idx (% esp)) (% i))
     461    (movl (@ x (% esp)) (% xx))
     462    (movl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
     463    (not (% imm0))
     464    (andl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
     465    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
     466    (single-value-return 4)))
     467
     468;;; dest[i] = (logior x[i] y[i])
     469(defx8632lapfunction %bignum-logior ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
     470  (let ((i temp0)
     471        (xx temp1)
     472        (yy arg_y))
     473    (movl (@ idx (% esp)) (% i))
     474    (movl (@ x (% esp)) (% xx))
     475    (movl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
     476    (orl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
     477    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
     478    (single-value-return 4)))
     479
     480;;; dest[i] = (lognot x[i])
     481(defx8632lapfunction %bignum-logior ((idx 4) #|(ra 0)|# (x arg_y) (dest arg_z))
     482  (let ((i temp0))
     483    (movl (@ idx (% esp)) (% i))
     484    (movl (@ x8632::misc-data-offset (% x) (% i)) (% imm0))
     485    (not (% imm0))
     486    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
     487    (single-value-return 3)))
     488
     489;;; dest[i] = (logxor x[i] y[i])
     490(defx8632lapfunction %bignum-logxor ((idx 8) (x 4) #|(ra 0)|# (y arg_y) (dest arg_z))
     491  (let ((i temp0)
     492        (xx temp1)
     493        (yy arg_y))
     494    (movl (@ idx (% esp)) (% i))
     495    (movl (@ x (% esp)) (% xx))
     496    (movl (@ x8632::misc-data-offset (% xx) (% i)) (% imm0))
     497    (xorl (@ x8632::misc-data-offset (% yy) (% i)) (% imm0))
     498    (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% i)))
     499    (single-value-return 4)))
     500
     501(defx8632lapfunction %compare-digits ((a 4) #|(ra 0)|# (b arg_y) (i arg_z))
     502  (movl (@ a (% esp)) (% temp0))
     503  (movl (@ x8632::misc-data-offset (% temp0) (% i)) (% imm0))
     504  (xorl (% temp0) (% temp0))
     505  (movl ($ '1) (% temp1))
     506  (movl ($ '-1) (% arg_y))
     507  (cmpl (@ x8632::misc-data-offset (% b) (% i)) (% imm0))
     508  (cmovzl (% temp0) (% arg_z))
     509  (cmovgl (% temp1) (% arg_z))
     510  (cmovll (% arg_y) (% arg_z))
     511  (single-value-return 3))
     512
     513;; returns number of bits in digit-hi,digit-lo that are sign bits
     514;; 32 - digits-sign-bits is integer-length
     515(defx8632lapfunction %digits-sign-bits ((hi arg_y) (lo arg_z))
     516  (mark-as-imm temp0)
     517  (shll ($ (- 16 x8632::fixnumshift)) (% hi))
     518  (unbox-fixnum lo imm0)
     519  (orl (% hi) (% imm0))
     520  (movl (% imm0) (% temp0))
     521  (not (% imm0))
     522  (testl (% temp0) (% temp0))
     523  (js @wasneg)
     524  (not (% imm0))
     525  @wasneg
     526  (bsrl (% imm0) (% imm0))
     527  (sete (% temp0.b))
     528  (xorl ($ 31) (% imm0))
     529  (addb (% temp0.b) (% imm0.b))
     530  (box-fixnum imm0 arg_z)
     531  (mark-as-node temp0)
     532  (single-value-return))
     533
     534; if dest not nil store unboxed result in dest(0), else return a fixnum
     535(defx8632lapfunction fix-digit-logandc2 ((fix 4) #|(ra 0)|# (big arg_y) (dest arg_z)) ; index 0
     536  (mark-as-imm temp0)
     537  (movl (@ fix (% esp)) (% temp0))
     538  (unbox-fixnum temp0 temp0)
     539  (movl (@ x8632::misc-data-offset (% big)) (% imm0))
     540  (not (% imm0))
     541  (andl (% temp0) (% imm0))
     542  (mark-as-node temp0)
     543  (cmpl ($ x8632::nil-value) (% dest))
     544  (jne @store)
     545  (box-fixnum imm0 arg_z)
     546  (single-value-return 3)
     547  @store
     548  (movl (% imm0) (@ x8632::misc-data-offset (% dest)))
     549  (single-value-return 3))
     550
     551(defx8632lapfunction digit-lognot-move ((index 4) #|(ra 0)|# (source arg_y) (dest arg_z))
     552  (movl (@ index (% esp)) (% temp0))
     553  (movl (@ x8632::misc-data-offset (% source) (% temp0)) (% imm0))
     554  (not (% imm0))
     555  (movl (% imm0) (@ x8632::misc-data-offset (% dest) (% temp0)))
     556  (single-value-return 3))
     557
     558;; Add b to a starting at a[i]
     559;; might want not to use SSE2 for this.  use lea to update loop counter
     560;; variables so that the flags don't get set.
     561(defx8632lapfunction bignum-add-loop-+ ((i 8) (a 4) #|(ra 0)|# (b arg_y) (blen arg_z))
     562  (let ((aa mm2)
     563        (bb mm3)
     564        (cc mm4))
     565    (movl (@ a (% esp)) (% temp0))
     566    (movl (@ i (% esp)) (% temp1))
     567    (xorl (% imm0) (% imm0))
     568    (pxor (% cc) (% cc))
     569    @loop
     570    (movd (@ x8632::misc-data-offset (% temp0) (% temp1)) (% aa))
     571    (movd (@ x8632::misc-data-offset (% b) (% imm0)) (% bb))
     572    (paddq (% bb) (% aa))
     573    (paddq (% cc) (% aa))
     574    (movd (% aa) (@ x8632::misc-data-offset (% temp0) (% temp1)))
     575    (psrlq ($ 32) (% aa))
     576    (movq (% aa) (% cc))
     577    (addl ($ '1) (% temp1))
     578    (addl ($ '1) (% imm0))
     579    (subl ($ '1) (% blen))
     580    (jg @loop)
     581    ;; add in final carry
     582    (movd (% cc) (% imm0))
     583    (addl (% imm0) (@ x8632::misc-data-offset (% temp0) (% temp1)))
     584    (single-value-return 4)))
     585
     586(defx8632lapfunction bignum-logtest-loop ((count 4) #|(ra 0)|# (s1 arg_y) (s2 arg_z))
     587  (let ((i temp1)
     588        (c temp0))
     589    (movl (@ count (% esp)) (% c))
     590    (xorl (% i) (% i))
     591    @loop
     592    (movl (@ x8632::misc-data-offset (% s1) (% i)) (% imm0))
     593    (test (@ x8632::misc-data-offset (% s2) (% i)) (% imm0))
     594    (jnz @true)
     595    (addl ($ '1) (% i))
     596    (cmpl (% i) (% c))
     597    (jg @loop)
     598    (movl ($ x8632::nil-value) (% arg_z))
     599    (single-value-return 3)
     600    @true
     601    (movl ($ x8632::t-value) (% arg_z))
     602    (single-value-return 3)))
     603
     604;;; called from bignum-ashift-left-unaligned
     605(defx8632lapfunction bignum-shift-left-loop ((nbits 12) (result 8) (bignum 4) #|(ra 0)|# (res-len-1 arg_y) (j arg_z))
     606  (let ((r temp0)
     607        (b temp1)
     608        (bb mm2)
     609        (bits mm3)
     610        (tt mm4)
     611        (remaining-bits mm5))
     612    (movl (% j) (% imm0))
     613    (subl ($ '1) (% imm0))
     614    (pushl (% imm0))                    ;digits
     615    (movl (@ nbits (% esp)) (% imm0))
     616    (unbox-fixnum imm0 imm0)
     617    (movd (% imm0) (% bits))            ;shift count
     618    (negl (% imm0))
     619    (addl ($ 32) (% imm0))
     620    (movd (% imm0) (% remaining-bits))
     621    (movl (@ result (% esp)) (% r))
     622    (movl (@ bignum (% esp)) (% b))
     623    (xorl (% imm0) (% imm0))
     624    @loop
     625    ;; bignum[i]
     626    (movd (@ x8632::misc-data-offset (% b) (% imm0)) (% bb))
     627    (psrlq (% remaining-bits) (% bb))
     628    ;; bignum[i+1]
     629    (movd (@ (+ x8632::misc-data-offset 4) (% b) (% imm0)) (% tt))
     630    (psllq (% bits) (% tt))
     631    (por (% tt) (% bb))
     632    (movd (% bb) (@ x8632::misc-data-offset (% r) (% j)))
     633    (addl ($ '1) (% imm0))
     634    (addl ($ '1) (% j))
     635    (cmpl (% j) (% res-len-1))
     636    (jne @loop)
     637    (movd (@ x8632::misc-data-offset (% bignum)) (% bb)) ;bignum[0]
     638    (psllq (% bits) (% bb))
     639    (popl (% arg_y))                    ;digits
     640    (movd (% bb) (@ x8632::misc-data-offset (% r) (% arg_y)))
     641    (movd (@ x8632::misc-data-offset (% bignum) (% imm0)) (% bb)) ;bignum[i]
     642    (psrlq (% remaining-bits) (% bb))
     643    (movd (% bb) (@ x8632::misc-data-offset (% r) (% j)))
     644    (single-value-return 5)))
     645
     646(defx8632lapfunction %logcount-complement ((bignum arg_y) (i arg_z))
     647  (mark-as-imm temp0)
     648  (let ((rshift imm0)
     649        (temp temp0))
     650    (movl (@ x8632::misc-data-offset (% bignum) (% i)) (% rshift))
     651    (notl (% rshift))
     652    (xorl (% arg_z) (% arg_z))
     653    (testl (% rshift) (% rshift))
     654    (jmp @test)
     655    @next
     656    (lea (@ -1 (% rshift)) (% temp))
     657    (and (% temp) (% rshift))           ;sets flags
     658    (lea (@ '1 (% arg_z)) (% arg_z))    ;doesn't set flags
     659    @test
     660    (jne @next)
     661    (mark-as-node temp0)
     662    (single-value-return)))
     663
     664(defx8632lapfunction %logcount ((bignum arg_y) (i arg_z))
     665  (mark-as-imm temp0)
     666  (let ((rshift imm0)
     667        (temp temp0))
     668    (movl (@ x8632::misc-data-offset (% bignum) (% i)) (% rshift))
     669    (xorl (% arg_z) (% arg_z))
     670    (testl (% rshift) (% rshift))
     671    (jmp @test)
     672    @next
     673    (lea (@ -1 (% rshift)) (% temp))
     674    (and (% temp) (% rshift))           ;sets flags
     675    (lea (@ '1 (% arg_z)) (% arg_z))    ;doesn't set flags
     676    @test
     677    (jne @next)
     678    (mark-as-node temp0)
     679    (single-value-return)))
     680
     681
     682;;; floor: given x and y, producing q and r, q * y + r = x.
     683
     684;;; Divide bignum x by single digit y (passed as two halves).
     685;;; The quotient in stored in q, and the remainder is returned
     686;;; in two halves.
     687(defx8632lapfunction %floor-loop-quo ((x 8) (q 4) #|(ra 0)|# (yhi arg_y) (ylo arg_z))
     688  )
     689
     690
     691

  • branches/ia32/level-0/X86/X8632/x8632-def.lisp

    r7430 r7963  
    1717(in-package "CCL")
    1818
    19 (defx86lapfunction %function-vector-to-function ((arg arg_z))
    20   (single-value-return))
    21 
    22 (defx86lapfunction %function-to-function-vector  ((arg arg_z))
    23   (single-value-return))
    24 
    25 (defx86lapfunction %function-code-words ((fun arg_z))
     19(defx8632lapfunction %function-vector-to-function ((arg arg_z))
     20  (single-value-return))
     21
     22(defx8632lapfunction %function-to-function-vector  ((arg arg_z))
     23  (single-value-return))
     24
     25(defx8632lapfunction %function-code-words ((fun arg_z))
    2626  (trap-unless-typecode= fun x8632::subtag-function)
    2727  (movzwl (@ x8632::misc-data-offset (% fun)) (% imm0))
    … …  
    2929  (single-value-return))
    3030
    31 (defx86lapfunction %nth-immediate ((fun arg_y) (n arg_z))
     31(defx8632lapfunction %nth-immediate ((fun arg_y) (n arg_z))
    3232  (trap-unless-typecode= fun x8632::subtag-function)
    3333  (movzwl (@ x8632::misc-data-offset (% fun)) (% imm0))
    … …  
    3636  (single-value-return))
    3737
    38 (defx86lapfunction %set-nth-immediate ((fun 4) #|(ra 0)|# (n arg_y) (new arg_z))
    39   (movl (@ fun (% esp)) (% temp0))
     38(defx8632lapfunction %set-nth-immediate ((fun 4) #|(ra 0)|# (n arg_y) (new arg_z))
     39  (popl (@ 8 (% esp)))
     40  (popl (% temp0))
     41  (addl ($ 4) (% esp))
    4042  (trap-unless-typecode= temp0 x8632::subtag-function)
    41   (movl (@ x8632::misc-data-offset (% temp0)) (% imm0))
     43  (movzwl (@ x8632::misc-data-offset (% temp0)) (% imm0))
    4244  (lea (@ (% n) (% imm0) 4) (% arg_y))
    4345  ;; expects gvector in temp0
    4446  (jmp-subprim .SPgvset))
    4547
    46 (defx86lapfunction %function-code-byte ((fun arg_y) (pc arg_z))
     48(defx8632lapfunction %function-code-byte ((fun arg_y) (pc arg_z))
    4749  (unbox-fixnum pc imm0)
    4850  (movzbl (@ (% fun) (% imm0)) (% imm0))
    … …  
    5052  (single-value-return))
    5153
    52 ;;; ----
    53 
    54 
    55 ;;; Returns 3 values: mask of registers used in the function, stack location
    56 ;;; from which they'd be restored, relative PC at which they're saved. If
    57 ;;; the mask is 0, the values NIL NIL NIL are returned. If either the stack
    58 ;;; location or relative PC is #xff, both of those values will be returned
    59 ;;; as NIL.
    60 (defx86lapfunction %function-register-usage ((f arg_z))
    61   (check-nargs 1)
    62   (trap-unless-fulltag= f x8664::fulltag-function)
    63   (movzbl (@ -1 (% f)) (% imm0.l))
    64   (shll ($ 8) (% imm0.l))
    65   (box-fixnum imm0 arg_x)
    66   (movq (% rsp) (% temp0))
    67   (set-nargs 3)
    68   (je @no-regs)
    69   (movzbl (@ -2 (% f)) (% imm0.l))
    70   (movzbl (@ -3 (% f)) (% imm1.l))
    71   (cmpb ($ #xff) (% imm0.b))
    72   (je @unencodable)
    73   (cmpb ($ #xff) (% imm1.b))
    74   (je @unencodable)
     54;;; Use the offsets in the self-reference table to replace the :self
     55;;; in (movl ($ :self) (% fn)) with the function's actual address.
     56(defx8632lapfunction %make-code-executable ((f arg_z))
     57  (movzwl (@ x8632::misc-data-offset (% f)) (% imm0))
    7558  (box-fixnum imm0 arg_y)
    76   (box-fixnum imm1 arg_z)
    77   (push (% arg_x))
    78   (push (% arg_y))
    79   (push (% arg_z))
    80   (jmp-subprim .SPvalues)
    81   @unencodable
    82   (push (% arg_x))
    83   (pushq ($ nil))
    84   (pushq ($ nil))
    85   (jmp-subprim .SPvalues)
    86   @no-regs
    87   (pushq ($ nil))
    88   (pushq ($ nil))
    89   (pushq ($ nil))
    90   (jmp-subprim .SPvalues))
    91  
    92        
    93 
    94 (defx86lapfunction %make-code-executable ((codev arg_z))
    95   (single-value-return))
    96 
    97          
    98 
    99 (defx86lapfunction %get-kernel-global-from-offset ((offset arg_z))
     59  (jmp @test)
     60  @loop
     61  (movl (% f) (@ (% f) (% imm0)))
     62  (subl ($ '1) (% arg_y))
     63  @test
     64  (movl (@ -4 (% f) (% arg_y)) (% imm0))
     65  (testl (% imm0) (% imm0))
     66  (jnz @loop)
     67  (single-value-return))
     68
     69(defx8632lapfunction %get-kernel-global-from-offset ((offset arg_z))
    10070  (check-nargs 1)
    10171  (unbox-fixnum offset imm0)
    102   (movq (@ target::nil-value (% imm0)) (% arg_z))
    103   (single-value-return))
    104 
    105 (defx86lapfunction %set-kernel-global-from-offset ((offset arg_y) (new-value arg_z))
     72  (movl (@ x8632::nil-value (% imm0)) (% arg_z))
     73  (single-value-return))
     74
     75(defx8632lapfunction %set-kernel-global-from-offset ((offset arg_y)
     76                                                     (new-value arg_z))
    10677  (check-nargs 2)
    10778  (unbox-fixnum offset imm0)
    108   (movq (% arg_z) (@ target::nil-value (% imm0)))
    109   (single-value-return))
    110 
    111 
    112 (defx86lapfunction %get-kernel-global-ptr-from-offset ((offset arg_y)
    113                                                        (ptr arg_z))
     79  (movl (% arg_z) (@ x8632::nil-value (% imm0)))
     80  (single-value-return))
     81
     82(defx8632lapfunction %get-kernel-global-ptr-from-offset ((offset arg_y)
     83                                                         (ptr arg_z))
    11484  (check-nargs 2)
    11585  (unbox-fixnum offset imm0)
    116   (movq (@ target::nil-value (% imm0)) (% imm0))
    117   (movq (% imm0) (@ x8664::macptr.address (% ptr)))
    118   (single-value-return))
    119 
    120 
    121 
    122 
    123 (defx86lapfunction %fixnum-ref ((fixnum arg_y) #| &optional |# (offset arg_z))
     86  (movl (@ x8632::nil-value (% imm0)) (% imm0))
     87  (movl (% imm0) (@ x8632::macptr.address (% ptr)))
     88  (single-value-return))
     89
     90(defx8632lapfunction %fixnum-ref ((fixnum arg_y) #| &optional |# (offset arg_z))
    12491  (:arglist (fixnum &optional offset))
    12592  (check-nargs 1 2)
    126   (cmpw ($ x8664::fixnumone) (% nargs))
     93  (cmpw ($ x8632::fixnumone) (% nargs))
    12794  (jne @2-args)
    128   (movq (% offset) (% fixnum))
     95  (movl (% offset) (% fixnum))
    12996  (xorl (%l offset) (%l offset))
    13097  @2-args
    13198  (unbox-fixnum offset imm0)
    132   (movq (@ (% fixnum) (% imm0)) (% arg_z))
    133   (single-value-return))
    134 
    135 (defx86lapfunction %fixnum-ref-natural ((fixnum arg_y) #| &optional |# (offset arg_z))
     99  (movl (@ (% fixnum) (% imm0)) (% arg_z))
     100  (single-value-return))
     101
     102(defx8632lapfunction %fixnum-ref-natural ((fixnum arg_y) #| &optional |# (offset arg_z))
    136103  (:arglist (fixnum &optional offset))
    137104  (check-nargs 1 2)
    138   (cmpw ($ x8664::fixnumone) (% nargs))
     105  (cmpw ($ x8632::fixnumone) (% nargs))
    139106  (jne @2-args)
    140   (movq (% offset) (% fixnum))
     107  (movl (% offset) (% fixnum))
    141108  (xorl (%l offset) (%l offset))
    142109  @2-args
    143110  (unbox-fixnum offset imm0)
    144   (movq (@ (% fixnum) (% imm0)) (% imm0))
    145   (jmp-subprim .SPmakeu64))
    146 
    147 (defx86lapfunction %fixnum-set ((fixnum arg_x) (offset arg_y) #| &optional |# (new-value arg_z))
     111  (movl (@ (% fixnum) (% imm0)) (% imm0))
     112  (jmp-subprim .SPmakeu32))
     113
     114(defx8632lapfunction %fixnum-set ((fixnum 4) #|(ra 0)|# (offset arg_y) #| &optional |# (new-value arg_z))
    148115  (:arglist (fixnum offset &optional newval))
    149116  (check-nargs 2 3)
     117  (movl (@ fixnum (% esp)) (% temp0))
    150118  (cmpw ($ '2) (% nargs))
    151119  (jne @3-args)
    152   (movq (% offset) (% fixnum))
     120  (movl (% offset) (% temp0))
    153121  (xorl (%l offset) (%l offset))
    154122  @3-args
    155123  (unbox-fixnum offset imm0)
    156   (movq (% new-value) (@ (% fixnum) (% imm0)))
    157   (movq (% new-value) (% arg_z))
    158   (single-value-return))
    159 
    160 
    161 (defx86lapfunction %fixnum-set-natural ((fixnum arg_x) (offset arg_y) #| &optional |# (new-value arg_z))
     124  (movl (% new-value) (@ (% temp0) (% imm0)))
     125  (movl (% new-value) (% arg_z))
     126  (single-value-return 3))
     127
     128
     129(defx8632lapfunction %fixnum-set-natural ((fixnum 4) #|(ra 0)|# (offset arg_y) #| &optional |# (new-value arg_z))
    162130  (:arglist (fixnum offset &optional newval))
    163131  (check-nargs 2 3)
     132  (movl (@ fixnum (% esp)) (% temp0))
    164133  (save-simple-frame)
    165134  (cmpw ($ '2) (% nargs))
    166135  (jne @3-args)
    167   (movq (% offset) (% fixnum))
     136  (movl (% offset) (% temp0))
    168137  (xorl (%l offset) (%l offset))
    169138  @3-args
    170   (call-subprim .SPgetu64)
    171   (unbox-fixnum offset imm1)
    172   (movq (% imm0) (@ (% fixnum) (% imm1)))
     139  (call-subprim .SPgetu32)              ;puts u32 in imm0
     140  (mark-as-imm temp1)
     141  (unbox-fixnum offset temp1)
     142  (movl (% imm0) (@ (% temp0) (% temp1)))
     143  (mark-as-node temp1)
    173144  (restore-simple-frame)
    174145  (single-value-return))
    175146
    176147
    177 (defx86lapfunction %current-frame-ptr ()
     148(defx8632lapfunction %current-frame-ptr ()
    178149  (check-nargs 0)
    179   (movq (% rbp) (% arg_z))
    180   (single-value-return))
    181 
    182 
    183 (defx86lapfunction %current-tsp ()
     150  (movl (% ebp) (% arg_z))
     151  (single-value-return))
     152
     153
     154(defx8632lapfunction %current-tsp ()
    184155  (check-nargs 0)
    185   (movq (@ (% :rcontext) x8664::tcr.save-tsp) (% arg_z))
    186   (single-value-return))
    187 
    188 
    189 (defx86lapfunction %%frame-backlink ((p arg_z))
     156  (movl (@ (% :rcontext) x8632::tcr.save-tsp) (% arg_z))
     157  (single-value-return))
     158
     159
     160(defx8632lapfunction %%frame-backlink ((p arg_z))
    190161  (check-nargs 1)
    191   (movq (@ (% arg_z)) (% arg_z))
    192   (single-value-return))
    193 
    194 ;;; Look for "lea -nnnn(%rip),%fn" AT the tra; if that's present, use
    195 ;;; the dispacement -nnnn to find the function.  The end of the
    196 ;;; encoded displacement is
    197 ;;; x8664::recover-fn-from-rip-disp-offset (= 7) bytes from the tra.
    198 (defx86lapfunction %return-address-function ((r arg_z))
     162  (movl (@ (% arg_z)) (% arg_z))
     163  (single-value-return))
     164
     165;;; Look for "movl $imm32,%fn at the tra;  if present, then $imm32 is
     166;;; the address of the function.
     167;;;
     168;;; That is: #b10111111 <imm32>
     169;;;                ^^^^
     170;;;   operand size || register number (%fn/%edi)
     171
     172(defx8632lapfunction %return-address-function ((r arg_z))
    199173  (extract-lisptag r imm0)
    200   (cmpb ($ x8664::tag-tra) (% imm0.b))
     174  (cmpb ($ x8632::fulltag-tra) (% imm0.b))
    201175  (jne @fail)
    202   (cmpw ($ x8664::recover-fn-from-rip-word0) (@ (% r)))
     176  (cmpb ($ x8632::recover-fn-opcode-byte) (@ (% r)))
    203177  (jne @fail)
    204   (cmpb ($ x8664::recover-fn-from-rip-byte2) (@ 2 (% r)))
    205   (movslq (@ x8664::recover-fn-from-rip-disp-offset (% r)) (% imm0))
    206   (jne @fail)
    207   (lea (@ x8664::recover-fn-from-rip-length (% imm0) (% r)) (% arg_z))
     178  (movl (@ x8632::recover-fn-address-offset (% r)) (% arg_z))
    208179  (single-value-return)
    209180  @fail
    210   (movl ($ x8664::nil-value) (% arg_z.l))
    211   (single-value-return))
    212 
    213 (defx86lapfunction %return-address-offset ((r arg_z))
     181  (movl ($ x8632::nil-value) (% arg_z))
     182  (single-value-return))
     183
     184;;; xxx this may need twiddling to refer to the right place
     185(defx8632lapfunction %return-address-offset ((r arg_z))
    214186  (extract-lisptag r imm0)
    215   (cmpb ($ x8664::tag-tra) (% imm0.b))
     187  (cmpb ($ x8632::fulltag-tra) (% imm0.b))
    216188  (jne @fail)
    217   (cmpw ($ x8664::recover-fn-from-rip-word0) (@ (% r)))
     189  (cmpb ($ x8632::recover-fn-opcode-byte) (@ (% r)))
    218190  (jne @fail)
    219   (cmpb ($ x8664::recover-fn-from-rip-byte2) (@ 2 (% r)))
    220   (movslq (@ x8664::recover-fn-from-rip-disp-offset (% r)) (% imm0))
    221   (jne @fail)
    222   (negq (% imm0))
    223   (leaq (@ (- (ash x8664::recover-fn-from-rip-length x8664::fixnumshift)) (% imm0) 8) (% arg_z))
    224   (single-value-return)
     191  (movl (@ x8632::recover-fn-address-offset (% r)) (% imm0))
     192  (subl (% arg_z) (% imm0))             ;offset = tra - fn
     193  (box-fixnum imm0 arg_z)
    225194  @fail
    226   (movl ($ x8664::nil-value) (% arg_z.l))
     195  (movl ($ x8632::nil-value) (% arg_z))
    227196  (single-value-return))
    228197
    … …  
    230199;;; frame pointer is the caller of the function that "uses" that frame.
    231200(defun %cfp-lfun (p)
    232   (let* ((ra (%fixnum-ref p x8664::lisp-frame.return-address)))
     201  (let* ((ra (%fixnum-ref p x8632::lisp-frame.return-address)))
    233202    (if (eq ra (%get-kernel-global ret1valaddr))
    234       (setq ra (%fixnum-ref p x8664::lisp-frame.xtra)))
     203      (setq ra (%fixnum-ref p x8632::lisp-frame.xtra)))
    235204    (values (%return-address-function ra) (%return-address-offset ra))))
    236205
    237 
    238 
    239 (defx86lapfunction %uvector-data-fixnum ((uv arg_z))
     206(defx8632lapfunction %uvector-data-fixnum ((uv arg_z))
    240207  (check-nargs 1)
    241   (trap-unless-fulltag= arg_z x8664::fulltag-misc)
    242   (addq ($ x8664::misc-data-offset) (% arg_z))
    243   (single-value-return))
    244 
    245 (defx86lapfunction %catch-top ((tcr arg_z))
     208  (trap-unless-fulltag= arg_z x8632::fulltag-misc)
     209  (addl ($ x8632::misc-data-offset) (% arg_z))
     210  (single-value-return))
     211
     212(defx8632lapfunction %catch-top ((tcr arg_z))
    246213  (check-nargs 1)
    247   (movl ($ x8664::nil-value) (%l arg_y))
    248   (movq (@ (% :rcontext) x8664::tcr.catch-top) (% arg_z))
     214  (movl ($ x8632::nil-value) (% arg_y))
     215  (movl (@ (% :rcontext) x8632::tcr.catch-top) (% arg_z))
    249216  (testb (%b arg_z) (%b arg_z))
    250   (cmoveq (% arg_y) (% arg_z))
    251   (single-value-return))
    252 
    253 (defx86lapfunction %catch-tsp ((catch arg_z))
     217  (cmovel (% arg_y) (% arg_z))
     218  (single-value-return))
     219
     220(defx8632lapfunction %catch-tsp ((catch arg_z))
    254221  (check-nargs 1)
    255   (lea (@  (- (+ target::fulltag-misc
    256                                  (ash 1 (1+ target::word-shift)))) (% arg_z))
     222  (lea (@  (- (+ x8632::fulltag-misc
     223                 (ash 1 (1+ x8632::word-shift)))) (% arg_z))
    257224       (% arg_z))
    258225  (single-value-return))
    259 
    260 
    261226
    262227;;; Same as %address-of, but doesn't cons any bignums
    263228;;; It also left shift fixnums just like everything else.
    264 (defx86lapfunction %fixnum-address-of ((x arg_z))
     229(defx8632lapfunction %fixnum-address-of ((x arg_z))
    265230  (check-nargs 1)
    266231  (box-fixnum x arg_z)
    267232  (single-value-return))
    268233
    269 (defx86lapfunction %save-standard-binding-list ((bindings arg_z))
    270   (movq (@ (% :rcontext) x8664::tcr.vs-area) (% imm0))
    271   (movq (@ x8664::area.high (% imm0)) (% imm1))
    272   (subq ($ x8664::node-size) (% imm1))
    273   (movq (% bindings) (@ (% imm1)))
    274   (single-value-return))
    275 
    276 (defx86lapfunction %saved-bindings-address ()
    277   (movq (@ (% :rcontext) x8664::tcr.vs-area) (% imm0))
    278   (movq (@ x8664::area.high (% imm0)) (% imm1))
    279   (lea (@ (- x8664::node-size) (% imm1)) (% arg_z))
    280   (single-value-return))
    281 
    282 (defx86lapfunction %get-object ((macptr arg_y) (offset arg_z))
     234(defx8632lapfunction %save-standard-binding-list ((bindings arg_z))
     235  (mark-as-imm temp0)
     236  (movl (@ (% :rcontext) x8632::tcr.vs-area) (% imm0))
     237  (movl (@ x8632::area.high (% imm0)) (% temp0))
     238  (subl ($ x8632::node-size) (% temp0))
     239  (movl (% bindings) (@ (% temp0)))
     240  (mark-as-node temp0)
     241  (single-value-return))
     242
     243(defx8632lapfunction %saved-bindings-address ()
     244  (mark-as-imm temp0)
     245  (movl (@ (% :rcontext) x8632::tcr.vs-area) (% imm0))
     246  (movl (@ x8632::area.high (% imm0)) (% temp0))
     247  (leal (@ (- x8632::node-size) (% temp0)) (% arg_z))
     248  (mark-as-node temp0)
     249  (single-value-return))
     250
     251(defx8632lapfunction %get-object ((macptr arg_y) (offset arg_z))
    283252  (check-nargs 2)
    284   (trap-unless-typecode= macptr x8664::subtag-macptr)
     253  (trap-unless-typecode= macptr x8632::subtag-macptr)
     254  (trap-unless-lisptag= offset x8632::tag-fixnum)
    285255  (macptr-ptr macptr imm0)
    286   (trap-unless-lisptag= offset target::tag-fixnum imm1)
    287   (unbox-fixnum offset imm1)
    288   (movq (@ (% imm0) (% imm1)) (% arg_z))
    289   (single-value-return))
    290 
    291 
    292 (defx86lapfunction %set-object ((macptr arg_x) (offset arg_y) (value arg_z))
     256  (mark-as-imm temp0)
     257  (unbox-fixnum offset temp0)
     258  (movl (@ (% imm0) (% temp0)) (% arg_z))
     259  (mark-as-node temp0)
     260  (single-value-return))
     261
     262(defx8632lapfunction %set-object ((macptr 4) #|(ra 0)|# (offset arg_y) (value arg_z))
    293263  (check-nargs 3)
    294   (trap-unless-typecode= macptr target::subtag-macptr)
    295   (macptr-ptr macptr imm0)
    296   (trap-unless-lisptag= offset target::tag-fixnum imm1)
    297   (unbox-fixnum offset imm1)
    298   (movq (% arg_z) (@ (% imm0) (% imm1)))
    299   (single-value-return))
    300 
    301 (defx86lapfunction %apply-lexpr-with-method-context ((magic arg_x)
    302                                                      (function arg_y)
    303                                                      (args arg_z))
     264  (movl (@ macptr (% esp)) (% temp1))
     265  (trap-unless-typecode= temp1 x8632::subtag-macptr)
     266  (trap-unless-lisptag= offset x8632::tag-fixnum)
     267  (macptr-ptr temp1 imm0)
     268  (mark-as-imm temp0)
     269  (unbox-fixnum offset temp0)
     270  (movl (% arg_z) (@ (% imm0) (% temp0)))
     271  (mark-as-node temp0)
     272  (single-value-return))
     273
     274(defx8632lapfunction %apply-lexpr-with-method-context ((magic 4)
     275                                                       #|(ra 0)|#
     276                                                       (function arg_y)
     277                                                       (args arg_z))
    304278  ;; Somebody's called (or tail-called) us.
    305   ;; Put magic arg in x8664::next-method-context (= x8664::temp0).
    306   ;; Put function in x8664::xfn until we're ready to jump to it.
    307   ;; Set nargs to 0, then spread "args" on stack (clobbers arg_x, arg_y, arg_z,
    308   ;;   but preserves x866::xfn/x8664::next-method-context.
    309   ;; Jump to the function in x8664::xfn.
    310   (popq (% ra0))
    311   (movq (% magic) (% next-method-context))
    312   (movq (% function) (% xfn))
    313   (set-nargs 0)
    314   (movq (@ (% args)) (% imm0))          ;lexpr-count
    315   (movw (% imm0.w) (% nargs))
    316   (leaq (@ x8664::node-size (% arg_z) (% imm0)) (% imm1))
    317   (subw ($ '3) (% imm0.w))
     279  ;; * Put magic arg in x8632::next-method-context (= x8632::temp0).
     280  ;; * Put function in x8632::xfn ( = x8632::temp1) until we're ready to
     281  ;;   jump to it.
     282  ;; * Set nargs to 0, then spread "args" on stack (clobbers arg_y,
     283  ;;   arg_z, but preserves x8632::xfn/x8632::next-method-context. Note
     284  ;;   that nargs and imm0 are the same register on x8632.
     285  ;; * Jump to the function in x8632::xfn.
     286  ;; These steps are done in a mixed up order on x8632 because of
     287  ;; the small number of registers.
     288  (popl (@ (% :rcontext) x8632::tcr.save0))     ;save return address
     289  (popl (@ (% :rcontext) x8632::tcr.save1))     ; and magic arg in the spill area
     290  (movl (% function) (% xfn))           ;aka temp1
     291  (movl (@ (% args)) (% imm0))          ;lexpr-count
     292  (movd (% imm0) (% mm0))               ;save nargs
     293  (mark-as-imm temp0)
     294  (leal (@ x8632::node-size (% arg_z) (% imm0)) (% temp0))
     295  (subl ($ '2) (% imm0))
    318296  (jbe @reg-only)
    319   ;; Some args will be pushed; reserve a frame
    320   (pushq ($ x8664::reserved-frame-marker))
    321   (pushq ($ x8664::reserved-frame-marker))
     297  ;; Some args will be pushed; reserve a frame.
     298  (pushl ($ x8632::reserved-frame-marker))
     299  (pushl ($ x8632::reserved-frame-marker))
    322300  @pushloop
    323   (pushq (@ (- x8664::node-size) (% imm1)))
    324   (subq ($ x8664::node-size) (% imm1))
    325   (subq ($ x8664::node-size) (% imm0))
     301  (pushl (@ (- x8632::node-size) (% temp0)))
     302  (subl ($ x8632::node-size) (% temp0))
     303  (subl ($ x8632::node-size) (% imm0))
    326304  (jne @pushloop)
    327   @three
    328   (movq (@ (* x8664::node-size 3) (% arg_z)) (% arg_x))
    329305  @two
    330   (movq (@ (* x8664::node-size 2) (% arg_z)) (% arg_y))
     306  (movl (@ (* x8632::node-size 2) (% arg_z)) (% arg_y))
    331307  @one
    332   (movq (@ (* x8664::node-size 1) (% arg_z)) (% arg_z))
     308  (movl (@ (* x8632::node-size 1) (% arg_z)) (% arg_z))
    333309  (jmp @go)
    334310  @reg-only
    335   (testw (% nargs) (% nargs))
    336   (je @go)
    337   (rcmpw (% nargs) ($ '2))
    338   (je @two)
    339   (jb @one)
    340   (jmp @three)
     311  (movd (% mm0) (% imm0))               ;note that imm0 is nargs
     312  (rcmp (% nargs) ($ '1))
     313  (je @one)
     314  (jb @go)
     315  (jmp @two)
    341316  @go
    342   (push (% ra0))
     317  (mark-as-node temp0)
     318  (movl (@ (% :rcontext) x8632::tcr.save1) (% next-method-context)) ;aka temp0
     319  (pushl (@ (% :rcontext) x8632::tcr.save0))     ;return address
     320  (movapd (% fpzero) (@ (% :rcontext) x8632::tcr.save0)) ;clear out spill area
     321  ;; magic arg in next-method-context: check
     322  ;; function in xfn: check
     323  ;; nargs/imm0 set: check
    343324  (jmp (% xfn)))
    344325
    345 (defx86lapfunction %apply-with-method-context ((magic arg_x)
    346                                                (function arg_y)
    347                                                (args arg_z))
    348   ;; Somebody's called (or tail-called) us.
    349   ;; Put magic arg in x8664::next-method-context (= x8664::temp0).
    350   ;; Put function in x8664::xfn (= x8664::temp1).
    351   ;; Set nargs to 0, then spread "args" on stack (clobbers arg_x, arg_y, arg_z,
    352   ;;   but preserves x8664::xfn/x8664::next-method-context.
    353   ;; Jump to the function in x8664::xfn.
    354   (pop (% ra0)) 
    355   (movq (% magic) (% x8664::next-method-context))
    356   (movq (% function) (% x8664::xfn))
    357   (movq (% args) (% arg_y))             ; in case of error
    358   (set-nargs 0)
    359   (xorl (% imm0.l) (% imm0.l))
    360   (push (% imm0))                       ; reserve frame (might discard
    361   (push (% imm0))                       ; it if nothing is passed on stack.)
     326(defx8632lapfunction %apply-with-method-context ((magic 4)
     327                                                 #|(ra 0)|#
     328                                                 (function arg_y)
     329                                                 (args arg_z))
     330  ;; Similar to above.
     331  (popl (@ (% :rcontext) x8632::tcr.save0))     ;save return address
     332  (popl (@ (% :rcontext) x8632::tcr.save1))     ; and magic arg in the spill area
     333  (movl (% args) (@ (% :rcontext) x8632::tcr.save2))    ;in case of error
     334  (xorl (% imm0) (% imm0))
     335  (push (% imm0))               ;reserve frame (might discard it
     336  (push (% imm0))               ;if nothing is passed on stack)
    362337  (cmp-reg-to-nil arg_z)
    363338  (je @done)
     339  (mark-as-imm temp0)
    364340  @loop
    365   (extract-fulltag arg_z imm1)
    366   (cmpb ($ x8664::fulltag-cons) (%b imm1))
    367   (jne @bad)
    368   (%car arg_z arg_x)
     341  (extract-fulltag arg_z temp0)
     342  (cmpb ($ x8632::fulltag-cons) (% temp0.b)) ;nil is a cons on x8632, but we
     343  (jne @bad)                                 ; checked for it already.
     344  (%car arg_z temp1)
    369345  (%cdr arg_z arg_z)
    370   (lea (@ x8664::node-size (% imm0)) (% imm0))
     346  (add ($ '1) (% imm0))                 ;shorter than lea (imm0 is eax)
    371347  (cmp-reg-to-nil arg_z)
    372   (push (% arg_x))
     348  (push (% temp1))
    373349  (jne @loop)
     350  (mark-as-node temp0)
    374351  @done
    375   (addw (% imm0.w) (% nargs))
     352  ;; arg_y about to get clobbered; put function into xfn.
     353  (movl (% function) (% xfn))           ;aka temp1
     354  ;; imm0 (aka nargs) contains number of args just pushed
     355  (test (% imm0) (% imm0))
    376356  (jne @pop)
    377357  @discard-and-go
    … …  
    379359  (jmp @go)
    380360  @pop
    381   (cmpw ($ '1) (% nargs))
     361  (cmpl ($ '1) (% nargs))
    382362  (pop (% arg_z))
    383363  (je @discard-and-go)
    384   (cmpw ($ '2) (% nargs))
     364  (cmpl ($ '2) (% nargs))
    385365  (pop (% arg_y))
    386366  (je @discard-and-go)
    387   (cmpw ($ '3) (% nargs))
    388   (pop (% arg_x))
    389   (je @discard-and-go)
    390367  @go
    391   (push (% ra0))
    392   (jmp (% xfn))
     368  (pushl (@ (% :rcontext) x8632::tcr.save0))     ;return address
     369  (movl (@ (% :rcontext) x8632::tcr.save1) (% next-method-context)) ;aka temp0
     370  (movapd (% fpzero) (@ (% :rcontext) x8632::tcr.save0)) ;clear out spill area
     371  (jmp (% xfn))                          ;aka temp1
    393372  @bad
    394   (addq (% imm0) (% rsp))
    395   (movq (% arg_y) (% arg_z))
    396   (movq ($ (ash $XNOSPREAD x8664::fixnumshift)) (% arg_y))
     373  (mark-as-node temp0)
     374  (addl (% imm0) (% esp))
     375  (movl (@ (% :rcontext) x8632::tcr.save1) (% arg_z)) ;saved args
     376  (movapd (% fpzero) (@ (% :rcontext) x8632::tcr.save0)) ;clear out spill area
     377  (movl ($ '#.$XNOSPREAD) (% arg_y))
    397378  (set-nargs 2)
    398379  (jmp-subprim .SPksignalerr))
    399 
    400380
    401381;;; The idea here is to call METHOD in the same stack frame in
    … …  
    404384;;; must have been tail-called, and the frame built on lexpr
    405385;;; entry must be in %rbp.
    406 (defx86lapfunction %apply-lexpr-tail-wise ((method arg_y) (args arg_z))
    407   (addq ($ x8664::node-size) (% rsp))   ; discard extra return address
    408   (movq (% method) (% xfn))
    409   (movq (% args) (% rsp))
    410   (pop (%q nargs))
    411   (movq (@ x8664::lisp-frame.return-address (% rbp)) (% ra0))
    412   (movq (@ 0 (% rbp)) (% rbp))
    413   (rcmpw (% nargs) ($ '3))
     386(defx8632lapfunction %apply-lexpr-tail-wise ((method arg_y) (args arg_z))
     387  (addl ($ x8632::node-size) (% esp))   ; discard extra return address
     388  (movl (% method) (% xfn))             ;temp1
     389  (movl (% args) (% esp))
     390  (popl (% imm0))                       ;nargs
     391  (movl (@ x8632::lisp-frame.return-address (% ebp)) (% temp0))
     392  (movl (@ 0 (% ebp)) (% ebp))
     393  (rcmpw (% nargs) ($ '2))
    414394  (jbe @pop-regs)
    415   ;; More than 3 args; some must have been pushed by caller,
     395  ;; More than 2 args; some must have been pushed by caller,
    416396  ;; so retain the reserved frame.
    417397  (pop (% arg_z))
    418398  (pop (% arg_y))
    419   (pop (% arg_x))
    420399  (jmp @popped)
    421400  @pop-regs
    422   (je @pop3)
    423401  (rcmpw (% nargs) ($ '1))
    424402  (jb @discard)
    425403  (ja @pop2)
    426404  (pop (% arg_z))
    427   (jmp @discard)
    428   @pop3
    429   (pop (% arg_z))
    430   (pop (% arg_y))
    431   (pop (% arg_x))
    432405  (jmp @discard)
    433406  @pop2
    … …  
    437410  (discard-reserved-frame)
    438411  @popped
    439   (push (% ra0))
     412  (push (% temp0))                      ;return address
    440413  (jmp (% xfn)))
    441414
    442 
    443 
     415(defun closure-function (fun)
     416  (while (and (functionp fun) (not (compiled-function-p fun)))
     417    (setq fun (%nth-immediate fun 0))
     418    (when (vectorp fun)
     419      (setq fun (svref fun 0))))
     420  fun)
    444421
    445422;;; For use by (setf (apply ...) ...)
    … …  
    450427   (:arglist (function arg1 arg2 &rest other-args))
    451428   (check-nargs 3 nil)
    452    (cmpw ($ '3) (% nargs))
    453    (pop (% ra0))
    454    (ja @no-frame)
    455    (pushq ($ x8664::reserved-frame-marker))
    456    (pushq ($ x8664::reserved-frame-marker))
    457 @no-frame         
    458    (push (% arg_x))
    459    (movq (% arg_z) (% temp0))           ; last
    460    (movq (% arg_y) (% arg_z))           ; butlast
     429   (popl (@ (% :rcontext) x8632::tcr.save0))    ;save return address
     430   ;; only two arg regs on x8632, so the caller will always push a frame
     431   (movl (% arg_z) (% temp0))           ; last
     432   (movl (% arg_y) (% arg_z))           ; butlast
    461433   (subw ($ '2) (% nargs))              ; remove count for butlast & last
     434   (movd (% imm0) (% mm0))              ;save nargs (aka imm0) for later
    462435   ;; Do .SPspreadargz inline here
    463436   (xorl (%l imm0) (%l imm0))
    464    (movq (% arg_z) (% arg_y))          ; save in case of error
     437   (movl (% arg_z) (@ (% :rcontext) x8632::tcr.save1)) ; save in case of error
    465438   (cmp-reg-to-nil arg_z)
    466439   (je @done)
     440   (mark-as-imm temp1)
    467441   @loop
    468    (extract-fulltag arg_z imm1)
    469    (cmpb ($ x8664::fulltag-cons) (%b imm1))
     442   (extract-fulltag arg_z temp1)
     443   (cmpb ($ x8664::fulltag-cons) (%b temp1))
    470444   (jne @bad)
    471    (%car arg_z arg_x)
     445   (%car arg_z arg_y)
    472446   (%cdr arg_z arg_z)
    473447   (addl ($ '1) (%l imm0))
    474448   (cmp-reg-to-nil arg_z)   
    475    (push (% arg_x))
     449   (push (% arg_y))
    476450   (jne @loop)
     451   (mark-as-node temp1)
    477452   @done
    478453   ;; nargs was at least 1 when we started spreading, and can't have gotten
    479454   ;; any smaller.
    480    (addw (%w imm0) (% nargs))
    481    (movq (% temp0) (% arg_z))
     455   (movd (% mm0) (% arg_y))             ;nargs from before loop
     456   (addl (% arg_y) (% imm0))            ;did I mention nargs is imm0?
     457   (movl (% temp0) (% arg_z))
    482458   (pop (% arg_y))
    483    (pop (% arg_x))
    484459   (addw ($ '1) (% nargs))
    485    (cmpw ($ '3) (% nargs))
    486    (jne @no-discard)
    487    (discard-reserved-frame)
    488    @no-discard
    489460   (load-constant funcall temp0)
    490    (push (% ra0))
     461   (pushl (@ (% :rcontext) x8632::tcr.save0))   ;return address
     462   (movapd (% fpzero) (@ (% :rcontext) x8632::tcr.save0)) ;clear out spill area
    491463   (jmp-subprim .SPfuncall)
    492464   @bad                                 ; error spreading list.
    493    (add (% imm0) (% rsp))               ; discard whatever's been pushed
    494    (movq (% arg_y) (% arg_z))
    495    (movl ($ '#.$XNOSPREAD) (%l arg_y))
     465   (mark-as-node temp1)
     466   (add (% imm0) (% esp))               ; discard whatever's been pushed
     467   (movl (@ (% :rcontext) x8632::tcr.save1) (% arg_z))
     468   (movl ($ '#.$XNOSPREAD) (% arg_y))
    496469   (set-nargs 2)
    497470   (jmp-subprim .SPksignalerr) ))
    … …  
    505478;;; (c) re-establish the same foreign stack frame and store the result regs
    506479;;;     (%rax/%xmm0) there
     480#+notyet
    507481(defx86lapfunction %do-ff-call ((nfp 0) (frame arg_x) (fp-regs arg_y) (entry arg_z))
    508482  (popq (% ra0))
    … …  
    531505  (single-value-return))
    532506 
    533 
     507#+notyet
    534508(defun %ff-call (entry &rest specs-and-vals)
    535509  (declare (dynamic-extent specs-and-vals))
Note: See TracChangeset for help on using the changeset viewer.