src/assembly/x86/arith.lisp

   1 ;;;; simple cases for generic arithmetic
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!VM")
  13 \f
  14 ;;;; addition, subtraction, and multiplication
  15
  16 (macrolet ((define-generic-arith-routine ((fun cost) &body body)
  17              `(define-assembly-routine (,(symbolicate "GENERIC-" fun)
  18                                         (:cost ,cost)
  19                                         (:return-style :full-call)
  20                                         (:translate ,fun)
  21                                         (:policy :safe)
  22                                         (:save-p t))
  23                 ((:arg x (descriptor-reg any-reg) edx-offset)
  24                  (:arg y (descriptor-reg any-reg)
  25                        ;; this seems wrong esi-offset -- FIXME: What's it mean?
  26                        edi-offset)
  27
  28                  (:res res (descriptor-reg any-reg) edx-offset)
  29
  30                  (:temp eax unsigned-reg eax-offset)
  31                  (:temp ecx unsigned-reg ecx-offset))
  32
  33                 (inst mov ecx x)
  34                 (inst or ecx y)
  35                 (inst test ecx fixnum-tag-mask)  ; both fixnums?
  36                 (inst jmp :nz DO-STATIC-FUN)     ; no - do generic
  37
  38                 ,@body
  39                 (inst clc) ; single-value return
  40                 (inst ret)
  41
  42                 DO-STATIC-FUN
  43                 ;; Same as: (inst enter (fixnumize 1))
  44                 (inst push ebp-tn)
  45                 (inst mov ebp-tn esp-tn)
  46                 (inst sub esp-tn (fixnumize 1))
  47                 (inst push (make-ea :dword :base ebp-tn
  48                             :disp (frame-byte-offset return-pc-save-offset)))
  49                 (inst mov ecx (fixnumize 2)) ; arg count
  50                 (inst jmp
  51                       (make-ea :dword
  52                                :disp (+ nil-value
  53                                         (static-fun-offset
  54                                          ',(symbolicate "TWO-ARG-" fun))))))))
  55
  56   (define-generic-arith-routine (+ 10)
  57     (move res x)
  58     (inst add res y)
  59     (inst jmp :no OKAY)
  60     (inst rcr res 1)                  ; carry has correct sign
  61     (inst sar res 1)                  ; remove type bits
  62
  63     (move ecx res)
  64
  65     (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
  66       (storew ecx res bignum-digits-offset other-pointer-lowtag))
  67
  68     OKAY)
  69
  70   (define-generic-arith-routine (- 10)
  71     (move res x)
  72     (inst sub res y)
  73     (inst jmp :no OKAY)
  74     (inst cmc)                        ; carry has correct sign now
  75     (inst rcr res 1)
  76     (inst sar res 1)                  ; remove type bits
  77
  78     (move ecx res)
  79
  80     (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
  81       (storew ecx res bignum-digits-offset other-pointer-lowtag))
  82     OKAY)
  83
  84   (define-generic-arith-routine (* 30)
  85     (move eax x)                          ; must use eax for 64-bit result
  86     (inst sar eax n-fixnum-tag-bits)      ; remove *4 fixnum bias
  87     (inst imul y)                         ; result in edx:eax
  88     (inst jmp :no OKAY)                   ; still fixnum
  89
  90     ;; zzz jrd changed edx to ebx in here, as edx isn't listed as a temp, above
  91     ;;     pfw says that loses big -- edx is target for arg x and result res
  92     ;;     note that 'edx' is not defined -- using x
  93     (inst shrd eax x n-fixnum-tag-bits)    ; high bits from edx
  94     (inst sar x n-fixnum-tag-bits)         ; now shift edx too
  95
  96     (move ecx x)                           ; save high bits from cdq
  97     (inst cdq)                             ; edx:eax <- sign-extend of eax
  98     (inst cmp x ecx)
  99     (inst jmp :e SINGLE-WORD-BIGNUM)
 100
 101     (with-fixed-allocation (res bignum-widetag (+ bignum-digits-offset 2))
 102       (storew eax res bignum-digits-offset other-pointer-lowtag)
 103       (storew ecx res (1+ bignum-digits-offset) other-pointer-lowtag))
 104     (inst jmp DONE)
 105
 106     SINGLE-WORD-BIGNUM
 107
 108     (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
 109       (storew eax res bignum-digits-offset other-pointer-lowtag))
 110     (inst jmp DONE)
 111
 112     OKAY
 113     (move res eax)
 114     DONE))
 115 \f
 116 ;;;; negation
 117
 118 (define-assembly-routine (generic-negate
 119                           (:cost 10)
 120                           (:return-style :full-call)
 121                           (:policy :safe)
 122                           (:translate %negate)
 123                           (:save-p t))
 124                          ((:arg x (descriptor-reg any-reg) edx-offset)
 125                           (:res res (descriptor-reg any-reg) edx-offset)
 126
 127                           (:temp eax unsigned-reg eax-offset)
 128                           (:temp ecx unsigned-reg ecx-offset))
 129   (inst test x fixnum-tag-mask)
 130   (inst jmp :z FIXNUM)
 131
 132   (inst push ebp-tn)
 133   (inst mov ebp-tn esp-tn)
 134   (inst sub esp-tn (fixnumize 1))
 135   (inst push (make-ea :dword :base ebp-tn
 136                       :disp (frame-byte-offset return-pc-save-offset)))
 137   (inst mov ecx (fixnumize 1))    ; arg count
 138   (inst jmp (make-ea :dword
 139                      :disp (+ nil-value (static-fun-offset '%negate))))
 140
 141   FIXNUM
 142   (move res x)
 143   (inst neg res)                        ; (- most-negative-fixnum) is BIGNUM
 144   (inst jmp :no OKAY)
 145   (inst shr res n-fixnum-tag-bits)      ; sign bit is data - remove type bits
 146   (move ecx res)
 147
 148   (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
 149     (storew ecx res bignum-digits-offset other-pointer-lowtag))
 150
 151   OKAY)
 152 \f
 153 ;;;; comparison
 154
 155 (macrolet ((define-cond-assem-rtn (name translate static-fn test)
 156              #+sb-assembling
 157              `(define-assembly-routine (,name
 158                                         (:return-style :none))
 159                 ((:arg x (descriptor-reg any-reg) edx-offset)
 160                  (:arg y (descriptor-reg any-reg) edi-offset)
 161
 162                  (:temp ecx unsigned-reg ecx-offset))
 163
 164                 (inst mov ecx x)
 165                 (inst or ecx y)
 166                 (inst test ecx fixnum-tag-mask)
 167                 (inst jmp :nz DO-STATIC-FUN)  ; are both fixnums?
 168
 169                 (inst cmp x y)
 170                 (inst ret)
 171
 172                 DO-STATIC-FUN
 173                 (inst sub esp-tn (fixnumize 3))
 174                 (inst mov (make-ea :dword :base esp-tn
 175                                    :disp (frame-byte-offset
 176                                           (+ sp->fp-offset
 177                                              -3
 178                                              ocfp-save-offset)))
 179                       ebp-tn)
 180                 (inst lea ebp-tn (make-ea :dword :base esp-tn
 181                                           :disp (frame-byte-offset
 182                                           (+ sp->fp-offset
 183                                              -3
 184                                              ocfp-save-offset))))
 185                 (inst mov ecx (fixnumize 2))
 186                 (inst call (make-ea :dword
 187                                     :disp (+ nil-value
 188                                              (static-fun-offset ',static-fn))))
 189                 ;; HACK: We depend on NIL having the lowest address of all
 190                 ;; static symbols (including T)
 191                 ,@(ecase test
 192                     (:l `((inst mov y (1+ nil-value))
 193                           (inst cmp y x)))
 194                     (:g `((inst cmp x (1+ nil-value)))))
 195                 (inst ret))
 196              #-sb-assembling
 197              `(define-vop (,name)
 198                 (:translate ,translate)
 199                 (:policy :safe)
 200                 (:save-p t)
 201                 (:args (x :scs (descriptor-reg any-reg) :target edx)
 202                        (y :scs (descriptor-reg any-reg) :target edi))
 203
 204                 (:temporary (:sc unsigned-reg :offset edx-offset
 205                                  :from (:argument 0))
 206                             edx)
 207                 (:temporary (:sc unsigned-reg :offset edi-offset
 208                                  :from (:argument 1))
 209                             edi)
 210
 211                 (:temporary (:sc unsigned-reg :offset ecx-offset
 212                                  :from :eval)
 213                             ecx)
 214                 (:conditional ,test)
 215                 (:generator 10
 216                    (move edx x)
 217                    (move edi y)
 218                    (inst lea ecx (make-ea :dword
 219                                           :disp (make-fixup ',name :assembly-routine)))
 220                    (inst call ecx)))))
 221
 222   (define-cond-assem-rtn generic-< < two-arg-< :l)
 223   (define-cond-assem-rtn generic-> > two-arg-> :g))
 224
 225 #+sb-assembling
 226 (define-assembly-routine (generic-eql
 227                           (:return-style :none))
 228                          ((:arg x (descriptor-reg any-reg) edx-offset)
 229                           (:arg y (descriptor-reg any-reg) edi-offset)
 230
 231                           (:temp ecx unsigned-reg ecx-offset))
 232   (inst mov ecx x)
 233   (inst and ecx y)
 234   (inst and ecx lowtag-mask)
 235   (inst cmp ecx other-pointer-lowtag)
 236   (inst jmp :e DO-STATIC-FUN)
 237
 238   ;; At least one fixnum
 239   (inst cmp x y)
 240   RET
 241   (inst ret)
 242
 243   DO-STATIC-FUN
 244   ;; Might as well fast path that...
 245   (inst cmp x y)
 246   (inst jmp :e RET)
 247
 248   (inst sub esp-tn (fixnumize 3))
 249   (inst mov (make-ea :dword :base esp-tn
 250                      :disp (frame-byte-offset
 251                             (+ sp->fp-offset
 252                                -3
 253                                ocfp-save-offset)))
 254         ebp-tn)
 255   (inst lea ebp-tn (make-ea :dword :base esp-tn
 256                             :disp (frame-byte-offset
 257                                    (+ sp->fp-offset
 258                                       -3
 259                                       ocfp-save-offset))))
 260   (inst mov ecx (fixnumize 2))
 261   (inst call (make-ea :dword
 262                       :disp (+ nil-value (static-fun-offset 'eql))))
 263   (load-symbol y t)
 264   (inst cmp x y)
 265   (inst ret))
 266
 267 #-sb-assembling
 268 (define-vop (generic-eql)
 269   (:translate eql)
 270   (:policy :safe)
 271   (:save-p t)
 272   (:args (x :scs (descriptor-reg any-reg) :target edx)
 273          (y :scs (descriptor-reg any-reg) :target edi))
 274
 275   (:temporary (:sc unsigned-reg :offset edx-offset
 276                :from (:argument 0))
 277               edx)
 278   (:temporary (:sc unsigned-reg :offset edi-offset
 279                :from (:argument 1))
 280               edi)
 281
 282   (:temporary (:sc unsigned-reg :offset ecx-offset
 283                :from :eval)
 284               ecx)
 285   (:conditional :e)
 286   (:generator 10
 287     (move edx x)
 288     (move edi y)
 289     (inst lea ecx (make-ea :dword
 290                            :disp (make-fixup 'generic-eql :assembly-routine)))
 291     (inst call ecx)))
 292
 293 #+sb-assembling
 294 (define-assembly-routine (generic-=
 295                           (:return-style :none))
 296                          ((:arg x (descriptor-reg any-reg) edx-offset)
 297                           (:arg y (descriptor-reg any-reg) edi-offset)
 298
 299                           (:temp ecx unsigned-reg ecx-offset))
 300   (inst mov ecx x)
 301   (inst or ecx y)
 302   (inst test ecx fixnum-tag-mask)
 303   (inst jmp :nz DO-STATIC-FUN)
 304
 305   ;; Both fixnums
 306   (inst cmp x y)
 307   (inst ret)
 308
 309   DO-STATIC-FUN
 310   (inst sub esp-tn (fixnumize 3))
 311   (inst mov (make-ea :dword :base esp-tn
 312                      :disp (frame-byte-offset
 313                             (+ sp->fp-offset
 314                                -3
 315                                ocfp-save-offset)))
 316         ebp-tn)
 317   (inst lea ebp-tn (make-ea :dword :base esp-tn
 318                             :disp (frame-byte-offset
 319                                    (+ sp->fp-offset
 320                                       -3
 321                                       ocfp-save-offset))))
 322   (inst mov ecx (fixnumize 2))
 323   (inst call (make-ea :dword
 324                       :disp (+ nil-value (static-fun-offset 'two-arg-=))))
 325   (load-symbol y t)
 326   (inst cmp x y)
 327   (inst ret))
 328
 329 #-sb-assembling
 330 (define-vop (generic-=)
 331   (:translate =)
 332   (:policy :safe)
 333   (:save-p t)
 334   (:args (x :scs (descriptor-reg any-reg) :target edx)
 335          (y :scs (descriptor-reg any-reg) :target edi))
 336
 337   (:temporary (:sc unsigned-reg :offset edx-offset
 338                :from (:argument 0))
 339               edx)
 340   (:temporary (:sc unsigned-reg :offset edi-offset
 341                :from (:argument 1))
 342               edi)
 343
 344   (:temporary (:sc unsigned-reg :offset ecx-offset
 345                :from :eval)
 346               ecx)
 347   (:conditional :e)
 348   (:generator 10
 349     (move edx x)
 350     (move edi y)
 351     (inst lea ecx (make-ea :dword
 352                            :disp (make-fixup 'generic-= :assembly-routine)))
 353     (inst call ecx)))
 354
 355 \f
 356 ;;; Support for the Mersenne Twister, MT19937, random number generator
 357 ;;; due to Matsumoto and Nishimura.
 358 ;;;
 359 ;;; Makoto Matsumoto and T. Nishimura, "Mersenne twister: A
 360 ;;; 623-dimensionally equidistributed uniform pseudorandom number
 361 ;;; generator.", ACM Transactions on Modeling and Computer Simulation,
 362 ;;; 1997, to appear.
 363 ;;;
 364 ;;; State:
 365 ;;;  0-1:   Constant matrix A. [0, #x9908b0df] (not used here)
 366 ;;;  2:     Index; init. to 1.
 367 ;;;  3-626: State.
 368
 369 ;;; This assembly routine is called from the inline VOP and updates
 370 ;;; the state vector with new random numbers. The state vector is
 371 ;;; passed in the EAX register.
 372 #+sb-assembling ; We don't want a vop for this one.
 373 (define-assembly-routine
 374     (random-mt19937-update)
 375     ((:temp state unsigned-reg eax-offset)
 376      (:temp k unsigned-reg ebx-offset)
 377      (:temp y unsigned-reg ecx-offset)
 378      (:temp tmp unsigned-reg edx-offset))
 379
 380   ;; Save the temporary registers.
 381   (inst push k)
 382   (inst push y)
 383   (inst push tmp)
 384
 385   ;; Generate a new set of results.
 386   (inst xor k k)
 387   LOOP1
 388   (inst mov y (make-ea-for-vector-data state :index k :offset 3))
 389   (inst mov tmp (make-ea-for-vector-data state :index k :offset (+ 1 3)))
 390   (inst and y #x80000000)
 391   (inst and tmp #x7fffffff)
 392   (inst or y tmp)
 393   (inst shr y 1)
 394   (inst jmp :nc skip1)
 395   (inst xor y #x9908b0df)
 396   SKIP1
 397   (inst xor y (make-ea-for-vector-data state :index k :offset (+ 397 3)))
 398   (inst mov (make-ea-for-vector-data state :index k :offset 3) y)
 399   (inst inc k)
 400   (inst cmp k (- 624 397))
 401   (inst jmp :b loop1)
 402   LOOP2
 403   (inst mov y (make-ea-for-vector-data state :index k :offset 3))
 404   (inst mov tmp (make-ea-for-vector-data state :index k :offset (+ 1 3)))
 405   (inst and y #x80000000)
 406   (inst and tmp #x7fffffff)
 407   (inst or y tmp)
 408   (inst shr y 1)
 409   (inst jmp :nc skip2)
 410   (inst xor y #x9908b0df)
 411   SKIP2
 412   (inst xor y (make-ea-for-vector-data state :index k :offset (+ (- 397 624) 3)))
 413   (inst mov (make-ea-for-vector-data state :index k :offset 3) y)
 414   (inst inc k)
 415   (inst cmp k (- 624 1))
 416   (inst jmp :b loop2)
 417
 418   (inst mov y (make-ea-for-vector-data state :offset (+ (- 624 1) 3)))
 419   (inst mov tmp (make-ea-for-vector-data state :offset (+ 0 3)))
 420   (inst and y #x80000000)
 421   (inst and tmp #x7fffffff)
 422   (inst or y tmp)
 423   (inst shr y 1)
 424   (inst jmp :nc skip3)
 425   (inst xor y #x9908b0df)
 426   SKIP3
 427   (inst xor y (make-ea-for-vector-data state :offset (+ (- 397 1) 3)))
 428   (inst mov (make-ea-for-vector-data state :offset (+ (- 624 1) 3)) y)
 429
 430   ;; Restore the temporary registers and return.
 431   (inst pop tmp)
 432   (inst pop y)
 433   (inst pop k)
 434   (inst ret))