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