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-no-return)
  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) edi-offset)
  25
  26                  (:res res (descriptor-reg any-reg) edx-offset)
  27
  28                  ,@(if (eq fun '*)
  29                        '((:temp eax unsigned-reg eax-offset)))
  30                  (:temp ecx unsigned-reg ecx-offset))
  31
  32                 ,@(multiple-value-bind (reg byte)
  33                       (if (eq fun '*) (values 'eax 'al-tn) (values 'ecx 'cl-tn))
  34                     `((inst mov ,reg x)
  35                       (inst or ,reg y)
  36                       (inst test ,byte fixnum-tag-mask))) ; both fixnums?
  37
  38                 (inst jmp :nz DO-STATIC-FUN)     ; no - do generic
  39
  40                 ,@body
  41                 (inst clc) ; single-value return
  42                 (inst ret)
  43
  44                 DO-STATIC-FUN
  45                 ;; Same as: (inst enter (fixnumize 1))
  46                 (inst push ebp-tn)
  47                 (inst mov ebp-tn esp-tn)
  48                 (inst sub esp-tn (fixnumize 1))
  49                 (inst push (make-ea :dword :base ebp-tn
  50                             :disp (frame-byte-offset return-pc-save-offset)))
  51                 (inst mov ecx (fixnumize 2)) ; arg count
  52                 (inst jmp
  53                       (make-ea :dword
  54                                :disp (+ nil-value
  55                                         (static-fun-offset
  56                                          ',(symbolicate "TWO-ARG-" fun))))))))
  57
  58   (define-generic-arith-routine (+ 10)
  59     (move res x)
  60     (inst add res y)
  61     (inst jmp :no OKAY)
  62     (inst rcr res 1)                  ; carry has correct sign
  63     (inst sar res 1)                  ; remove type bits
  64
  65     (move ecx res)
  66
  67     (alloc-other res bignum-widetag (1+ bignum-digits-offset) nil)
  68     (storew ecx res bignum-digits-offset other-pointer-lowtag)
  69
  70     OKAY)
  71
  72   (define-generic-arith-routine (- 10)
  73     (move res x)
  74     (inst sub res y)
  75     (inst jmp :no OKAY)
  76     (inst cmc)                        ; carry has correct sign now
  77     (inst rcr res 1)
  78     (inst sar res 1)                  ; remove type bits
  79
  80     (move ecx res)
  81
  82     (alloc-other res bignum-widetag (1+ bignum-digits-offset) nil)
  83     (storew ecx res bignum-digits-offset other-pointer-lowtag)
  84     OKAY)
  85
  86   (define-generic-arith-routine (* 30)
  87     (move eax x)                          ; must use eax for 64-bit result
  88     (inst sar eax n-fixnum-tag-bits)      ; remove *4 fixnum bias
  89     (inst imul y)                         ; result in edx:eax
  90     (inst jmp :no OKAY)                   ; still fixnum
  91
  92     ;; zzz jrd changed edx to ebx in here, as edx isn't listed as a temp, above
  93     ;;     pfw says that loses big -- edx is target for arg x and result res
  94     ;;     note that 'edx' is not defined -- using x
  95     (inst shrd eax x n-fixnum-tag-bits)    ; high bits from edx
  96     (inst sar x n-fixnum-tag-bits)         ; now shift edx too
  97
  98     (move ecx x)                           ; save high bits from cdq
  99     (inst cdq)                             ; edx:eax <- sign-extend of eax
 100     (inst cmp x ecx)
 101     (inst jmp :e SINGLE-WORD-BIGNUM)
 102
 103     (alloc-other res bignum-widetag (+ bignum-digits-offset 2) nil)
 104     (storew eax res bignum-digits-offset other-pointer-lowtag)
 105     (storew ecx res (1+ bignum-digits-offset) other-pointer-lowtag)
 106     (inst jmp DONE)
 107
 108     SINGLE-WORD-BIGNUM
 109
 110     (alloc-other res bignum-widetag (1+ bignum-digits-offset) nil)
 111     (storew eax res bignum-digits-offset other-pointer-lowtag)
 112     (inst jmp DONE)
 113
 114     OKAY
 115     (move res eax)
 116     DONE))
 117 \f
 118 ;;;; negation
 119
 120 (define-assembly-routine (generic-negate
 121                           (:cost 10)
 122                           (:return-style :full-call)
 123                           (:policy :safe)
 124                           (:translate %negate)
 125                           (:save-p t))
 126                          ((:arg x (descriptor-reg any-reg) edx-offset)
 127                           (:res res (descriptor-reg any-reg) edx-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   (alloc-other res bignum-widetag (1+ bignum-digits-offset) nil)
 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              `(define-assembly-routine (,name
 157                                         (:translate ,translate)
 158                                         (:policy :safe)
 159                                         (:save-p t)
 160                                         (:conditional ,test)
 161                                         (:cost 10))
 162                 ((:arg x (descriptor-reg any-reg) edx-offset)
 163                  (:arg y (descriptor-reg any-reg) edi-offset)
 164
 165                  (:temp ecx unsigned-reg ecx-offset))
 166
 167                 (inst mov ecx x)
 168                 (inst or ecx y)
 169                 (inst test ecx fixnum-tag-mask)
 170                 (inst jmp :nz DO-STATIC-FUN)  ; are both fixnums?
 171
 172                 (inst cmp x y)
 173                 (inst ret)
 174
 175                 DO-STATIC-FUN
 176                 (inst push ebp-tn)
 177                 (inst mov ebp-tn esp-tn)
 178                 (inst sub esp-tn (fixnumize 3))
 179                 (inst mov (make-ea :dword :base esp-tn
 180                                    :disp (frame-byte-offset
 181                                           (+ sp->fp-offset
 182                                              -3
 183                                              ocfp-save-offset)))
 184                       ebp-tn)
 185                 (inst lea ebp-tn (make-ea :dword :base esp-tn
 186                                           :disp (frame-byte-offset
 187                                           (+ sp->fp-offset
 188                                              -3
 189                                              ocfp-save-offset))))
 190                 (inst mov ecx (fixnumize 2))
 191                 (inst call (make-ea :dword
 192                                     :disp (+ nil-value
 193                                              (static-fun-offset ',static-fn))))
 194                 ;; HACK: We depend on NIL having the lowest address of all
 195                 ;; static symbols (including T)
 196                 ,@(ecase test
 197                     (:l `((inst mov y (1+ nil-value))
 198                           (inst cmp y x)))
 199                     (:g `((inst cmp x (1+ nil-value)))))
 200                 (inst pop ebp-tn))))
 201   (define-cond-assem-rtn generic-< < two-arg-< :l)
 202   (define-cond-assem-rtn generic-> > two-arg-> :g))
 203
 204 (define-assembly-routine (generic-eql
 205                           (:translate eql)
 206                           (:policy :safe)
 207                           (:save-p t)
 208                           (:conditional :e)
 209                           (:cost 10))
 210                          ((:arg x (descriptor-reg any-reg) edx-offset)
 211                           (:arg y (descriptor-reg any-reg) edi-offset)
 212
 213                           (:temp ecx unsigned-reg ecx-offset))
 214   (inst mov ecx x)
 215   (inst and ecx y)
 216   (inst and ecx lowtag-mask)
 217   (inst cmp ecx other-pointer-lowtag)
 218   (inst jmp :e DO-STATIC-FUN)
 219
 220   ;; At least one fixnum
 221   (inst cmp x y)
 222   RET
 223   (inst ret)
 224
 225   DO-STATIC-FUN
 226   ;; Might as well fast path that...
 227   (inst cmp x y)
 228   (inst jmp :e RET)
 229
 230   (inst push ebp-tn)
 231   (inst mov ebp-tn esp-tn)
 232   (inst sub esp-tn (fixnumize 3))
 233   (inst mov (make-ea :dword :base esp-tn
 234                      :disp (frame-byte-offset
 235                             (+ sp->fp-offset
 236                                -3
 237                                ocfp-save-offset)))
 238         ebp-tn)
 239   (inst lea ebp-tn (make-ea :dword :base esp-tn
 240                             :disp (frame-byte-offset
 241                                    (+ sp->fp-offset
 242                                       -3
 243                                       ocfp-save-offset))))
 244   (inst mov ecx (fixnumize 2))
 245   (inst call (make-ea :dword
 246                       :disp (+ nil-value (static-fun-offset 'eql))))
 247   (load-symbol y t)
 248   (inst cmp x y)
 249   (inst pop ebp-tn))
 250
 251 (define-assembly-routine (generic-=
 252                           (:translate =)
 253                           (:policy :safe)
 254                           (:save-p t)
 255                           (:conditional :e)
 256                           (:cost 10))
 257                          ((:arg x (descriptor-reg any-reg) edx-offset)
 258                           (:arg y (descriptor-reg any-reg) edi-offset)
 259
 260                           (:temp ecx unsigned-reg ecx-offset))
 261   (inst mov ecx x)
 262   (inst or ecx y)
 263   (inst test ecx fixnum-tag-mask)
 264   (inst jmp :nz DO-STATIC-FUN)
 265
 266   ;; Both fixnums
 267   (inst cmp x y)
 268   (inst ret)
 269
 270   DO-STATIC-FUN
 271   (inst push ebp-tn)
 272   (inst mov ebp-tn esp-tn)
 273   (inst sub esp-tn (fixnumize 3))
 274   (inst mov (make-ea :dword :base esp-tn
 275                      :disp (frame-byte-offset
 276                             (+ sp->fp-offset
 277                                -3
 278                                ocfp-save-offset)))
 279         ebp-tn)
 280   (inst lea ebp-tn (make-ea :dword :base esp-tn
 281                             :disp (frame-byte-offset
 282                                    (+ sp->fp-offset
 283                                       -3
 284                                       ocfp-save-offset))))
 285   (inst mov ecx (fixnumize 2))
 286   (inst call (make-ea :dword
 287                       :disp (+ nil-value (static-fun-offset 'two-arg-=))))
 288   (load-symbol y t)
 289   (inst cmp x y)
 290   (inst pop ebp-tn))
 291
 292 \f
 293 ;;; Support for the Mersenne Twister, MT19937, random number generator
 294 ;;; due to Matsumoto and Nishimura.
 295 ;;;
 296 ;;; Makoto Matsumoto and T. Nishimura, "Mersenne twister: A
 297 ;;; 623-dimensionally equidistributed uniform pseudorandom number
 298 ;;; generator.", ACM Transactions on Modeling and Computer Simulation,
 299 ;;; 1997, to appear.
 300 ;;;
 301 ;;; State:
 302 ;;;  0-1:   Constant matrix A. [0, #x9908b0df] (not used here)
 303 ;;;  2:     Index; init. to 1.
 304 ;;;  3-626: State.
 305
 306 ;;; This assembly routine is called from the inline VOP and updates
 307 ;;; the state vector with new random numbers. The state vector is
 308 ;;; passed in the EAX register.
 309 #+sb-assembling ; We don't want a vop for this one.
 310 (define-assembly-routine
 311     (random-mt19937-update)
 312     ((:temp state unsigned-reg eax-offset)
 313      (:temp k unsigned-reg ebx-offset)
 314      (:temp y unsigned-reg ecx-offset)
 315      (:temp tmp unsigned-reg edx-offset))
 316
 317   ;; Save the temporary registers.
 318   (inst push k)
 319   (inst push y)
 320   (inst push tmp)
 321
 322   ;; Generate a new set of results.
 323   (inst xor k k)
 324   LOOP1
 325   (inst mov y (make-ea-for-vector-data state :index k :offset 3))
 326   (inst mov tmp (make-ea-for-vector-data state :index k :offset (+ 1 3)))
 327   (inst and y #x80000000)
 328   (inst and tmp #x7fffffff)
 329   (inst or y tmp)
 330   (inst shr y 1)
 331   (inst jmp :nc skip1)
 332   (inst xor y #x9908b0df)
 333   SKIP1
 334   (inst xor y (make-ea-for-vector-data state :index k :offset (+ 397 3)))
 335   (inst mov (make-ea-for-vector-data state :index k :offset 3) y)
 336   (inst inc k)
 337   (inst cmp k (- 624 397))
 338   (inst jmp :b loop1)
 339   LOOP2
 340   (inst mov y (make-ea-for-vector-data state :index k :offset 3))
 341   (inst mov tmp (make-ea-for-vector-data state :index k :offset (+ 1 3)))
 342   (inst and y #x80000000)
 343   (inst and tmp #x7fffffff)
 344   (inst or y tmp)
 345   (inst shr y 1)
 346   (inst jmp :nc skip2)
 347   (inst xor y #x9908b0df)
 348   SKIP2
 349   (inst xor y (make-ea-for-vector-data state :index k :offset (+ (- 397 624) 3)))
 350   (inst mov (make-ea-for-vector-data state :index k :offset 3) y)
 351   (inst inc k)
 352   (inst cmp k (- 624 1))
 353   (inst jmp :b loop2)
 354
 355   (inst mov y (make-ea-for-vector-data state :offset (+ (- 624 1) 3)))
 356   (inst mov tmp (make-ea-for-vector-data state :offset (+ 0 3)))
 357   (inst and y #x80000000)
 358   (inst and tmp #x7fffffff)
 359   (inst or y tmp)
 360   (inst shr y 1)
 361   (inst jmp :nc skip3)
 362   (inst xor y #x9908b0df)
 363   SKIP3
 364   (inst xor y (make-ea-for-vector-data state :offset (+ (- 397 1) 3)))
 365   (inst mov (make-ea-for-vector-data state :offset (+ (- 624 1) 3)) y)
 366
 367   ;; Restore the temporary registers and return.
 368   (inst pop tmp)
 369   (inst pop y)
 370   (inst pop k))