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
 125                           (:temp eax unsigned-reg eax-offset)
 126                           (:temp ecx unsigned-reg ecx-offset))
 127   (inst test x fixnum-tag-mask)
 128   (inst jmp :z FIXNUM)
 129
 130   (inst push ebp-tn)
 131   (inst mov ebp-tn esp-tn)
 132   (inst sub esp-tn (fixnumize 1))
 133   (inst push (make-ea :dword :base ebp-tn
 134                       :disp (frame-byte-offset return-pc-save-offset)))
 135   (inst mov ecx (fixnumize 1))    ; arg count
 136   (inst jmp (make-ea :dword
 137                      :disp (+ nil-value (static-fun-offset '%negate))))
 138
 139   FIXNUM
 140   (move res x)
 141   (inst neg res)                        ; (- most-negative-fixnum) is BIGNUM
 142   (inst jmp :no OKAY)
 143   (inst shr res n-fixnum-tag-bits)      ; sign bit is data - remove type bits
 144   (move ecx res)
 145
 146   (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
 147     (storew ecx res bignum-digits-offset other-pointer-lowtag))
 148
 149   OKAY)
 150 \f
 151 ;;;; comparison
 152
 153 (macrolet ((define-cond-assem-rtn (name translate static-fn test)
 154              #+sb-assembling
 155              `(define-assembly-routine (,name
 156                                         (:return-style :none))
 157                 ((:arg x (descriptor-reg any-reg) edx-offset)
 158                  (:arg y (descriptor-reg any-reg) edi-offset)
 159
 160                  (:temp ecx unsigned-reg ecx-offset))
 161
 162                 (inst mov ecx x)
 163                 (inst or ecx y)
 164                 (inst test ecx fixnum-tag-mask)
 165                 (inst jmp :nz DO-STATIC-FUN)  ; are both fixnums?
 166
 167                 (inst cmp x y)
 168                 (inst ret)
 169
 170                 DO-STATIC-FUN
 171                 (inst push ebp-tn)
 172                 (inst mov ebp-tn esp-tn)
 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 pop ebp-tn)
 196                 (inst ret))
 197              #-sb-assembling
 198              `(define-vop (,name)
 199                 (:translate ,translate)
 200                 (:policy :safe)
 201                 (:save-p t)
 202                 (:args (x :scs (descriptor-reg any-reg) :target edx)
 203                        (y :scs (descriptor-reg any-reg) :target edi))
 204
 205                 (:temporary (:sc unsigned-reg :offset edx-offset
 206                                  :from (:argument 0))
 207                             edx)
 208                 (:temporary (:sc unsigned-reg :offset edi-offset
 209                                  :from (:argument 1))
 210                             edi)
 211                 (:conditional ,test)
 212                 (:generator 10
 213                    (move edx x)
 214                    (move edi y)
 215                    (inst call (make-fixup ',name :assembly-routine))))))
 216
 217   (define-cond-assem-rtn generic-< < two-arg-< :l)
 218   (define-cond-assem-rtn generic-> > two-arg-> :g))
 219
 220 #+sb-assembling
 221 (define-assembly-routine (generic-eql
 222                           (:return-style :none))
 223                          ((:arg x (descriptor-reg any-reg) edx-offset)
 224                           (:arg y (descriptor-reg any-reg) edi-offset)
 225
 226                           (:temp ecx unsigned-reg ecx-offset))
 227   (inst mov ecx x)
 228   (inst and ecx y)
 229   (inst and ecx lowtag-mask)
 230   (inst cmp ecx other-pointer-lowtag)
 231   (inst jmp :e DO-STATIC-FUN)
 232
 233   ;; At least one fixnum
 234   (inst cmp x y)
 235   RET
 236   (inst ret)
 237
 238   DO-STATIC-FUN
 239   ;; Might as well fast path that...
 240   (inst cmp x y)
 241   (inst jmp :e RET)
 242
 243   (inst push ebp-tn)
 244   (inst mov ebp-tn esp-tn)
 245   (inst sub esp-tn (fixnumize 3))
 246   (inst mov (make-ea :dword :base esp-tn
 247                      :disp (frame-byte-offset
 248                             (+ sp->fp-offset
 249                                -3
 250                                ocfp-save-offset)))
 251         ebp-tn)
 252   (inst lea ebp-tn (make-ea :dword :base esp-tn
 253                             :disp (frame-byte-offset
 254                                    (+ sp->fp-offset
 255                                       -3
 256                                       ocfp-save-offset))))
 257   (inst mov ecx (fixnumize 2))
 258   (inst call (make-ea :dword
 259                       :disp (+ nil-value (static-fun-offset 'eql))))
 260   (load-symbol y t)
 261   (inst cmp x y)
 262   (inst pop ebp-tn)
 263   (inst ret))
 264
 265 #-sb-assembling
 266 (define-vop (generic-eql)
 267   (:translate eql)
 268   (:policy :safe)
 269   (:save-p t)
 270   (:args (x :scs (descriptor-reg any-reg) :target edx)
 271          (y :scs (descriptor-reg any-reg) :target edi))
 272
 273   (:temporary (:sc unsigned-reg :offset edx-offset
 274                :from (:argument 0))
 275               edx)
 276   (:temporary (:sc unsigned-reg :offset edi-offset
 277                :from (:argument 1))
 278               edi)
 279
 280   (:conditional :e)
 281   (:generator 10
 282     (move edx x)
 283     (move edi y)
 284     (inst call (make-fixup 'generic-eql :assembly-routine))))
 285
 286 #+sb-assembling
 287 (define-assembly-routine (generic-=
 288                           (:return-style :none))
 289                          ((:arg x (descriptor-reg any-reg) edx-offset)
 290                           (:arg y (descriptor-reg any-reg) edi-offset)
 291
 292                           (:temp ecx unsigned-reg ecx-offset))
 293   (inst mov ecx x)
 294   (inst or ecx y)
 295   (inst test ecx fixnum-tag-mask)
 296   (inst jmp :nz DO-STATIC-FUN)
 297
 298   ;; Both fixnums
 299   (inst cmp x y)
 300   (inst ret)
 301
 302   DO-STATIC-FUN
 303   (inst push ebp-tn)
 304   (inst mov ebp-tn esp-tn)
 305   (inst sub esp-tn (fixnumize 3))
 306   (inst mov (make-ea :dword :base esp-tn
 307                      :disp (frame-byte-offset
 308                             (+ sp->fp-offset
 309                                -3
 310                                ocfp-save-offset)))
 311         ebp-tn)
 312   (inst lea ebp-tn (make-ea :dword :base esp-tn
 313                             :disp (frame-byte-offset
 314                                    (+ sp->fp-offset
 315                                       -3
 316                                       ocfp-save-offset))))
 317   (inst mov ecx (fixnumize 2))
 318   (inst call (make-ea :dword
 319                       :disp (+ nil-value (static-fun-offset 'two-arg-=))))
 320   (load-symbol y t)
 321   (inst cmp x y)
 322   (inst pop ebp-tn)
 323   (inst ret))
 324
 325 #-sb-assembling
 326 (define-vop (generic-=)
 327   (:translate =)
 328   (:policy :safe)
 329   (:save-p t)
 330   (:args (x :scs (descriptor-reg any-reg) :target edx)
 331          (y :scs (descriptor-reg any-reg) :target edi))
 332
 333   (:temporary (:sc unsigned-reg :offset edx-offset
 334                :from (:argument 0))
 335               edx)
 336   (:temporary (:sc unsigned-reg :offset edi-offset
 337                :from (:argument 1))
 338               edi)
 339
 340   (:conditional :e)
 341   (:generator 10
 342     (move edx x)
 343     (move edi y)
 344     (inst call (make-fixup 'generic-= :assembly-routine))))
 345
 346 \f
 347 ;;; Support for the Mersenne Twister, MT19937, random number generator
 348 ;;; due to Matsumoto and Nishimura.
 349 ;;;
 350 ;;; Makoto Matsumoto and T. Nishimura, "Mersenne twister: A
 351 ;;; 623-dimensionally equidistributed uniform pseudorandom number
 352 ;;; generator.", ACM Transactions on Modeling and Computer Simulation,
 353 ;;; 1997, to appear.
 354 ;;;
 355 ;;; State:
 356 ;;;  0-1:   Constant matrix A. [0, #x9908b0df] (not used here)
 357 ;;;  2:     Index; init. to 1.
 358 ;;;  3-626: State.
 359
 360 ;;; This assembly routine is called from the inline VOP and updates
 361 ;;; the state vector with new random numbers. The state vector is
 362 ;;; passed in the EAX register.
 363 #+sb-assembling ; We don't want a vop for this one.
 364 (define-assembly-routine
 365     (random-mt19937-update)
 366     ((:temp state unsigned-reg eax-offset)
 367      (:temp k unsigned-reg ebx-offset)
 368      (:temp y unsigned-reg ecx-offset)
 369      (:temp tmp unsigned-reg edx-offset))
 370
 371   ;; Save the temporary registers.
 372   (inst push k)
 373   (inst push y)
 374   (inst push tmp)
 375
 376   ;; Generate a new set of results.
 377   (inst xor k k)
 378   LOOP1
 379   (inst mov y (make-ea-for-vector-data state :index k :offset 3))
 380   (inst mov tmp (make-ea-for-vector-data state :index k :offset (+ 1 3)))
 381   (inst and y #x80000000)
 382   (inst and tmp #x7fffffff)
 383   (inst or y tmp)
 384   (inst shr y 1)
 385   (inst jmp :nc skip1)
 386   (inst xor y #x9908b0df)
 387   SKIP1
 388   (inst xor y (make-ea-for-vector-data state :index k :offset (+ 397 3)))
 389   (inst mov (make-ea-for-vector-data state :index k :offset 3) y)
 390   (inst inc k)
 391   (inst cmp k (- 624 397))
 392   (inst jmp :b loop1)
 393   LOOP2
 394   (inst mov y (make-ea-for-vector-data state :index k :offset 3))
 395   (inst mov tmp (make-ea-for-vector-data state :index k :offset (+ 1 3)))
 396   (inst and y #x80000000)
 397   (inst and tmp #x7fffffff)
 398   (inst or y tmp)
 399   (inst shr y 1)
 400   (inst jmp :nc skip2)
 401   (inst xor y #x9908b0df)
 402   SKIP2
 403   (inst xor y (make-ea-for-vector-data state :index k :offset (+ (- 397 624) 3)))
 404   (inst mov (make-ea-for-vector-data state :index k :offset 3) y)
 405   (inst inc k)
 406   (inst cmp k (- 624 1))
 407   (inst jmp :b loop2)
 408
 409   (inst mov y (make-ea-for-vector-data state :offset (+ (- 624 1) 3)))
 410   (inst mov tmp (make-ea-for-vector-data state :offset (+ 0 3)))
 411   (inst and y #x80000000)
 412   (inst and tmp #x7fffffff)
 413   (inst or y tmp)
 414   (inst shr y 1)
 415   (inst jmp :nc skip3)
 416   (inst xor y #x9908b0df)
 417   SKIP3
 418   (inst xor y (make-ea-for-vector-data state :offset (+ (- 397 1) 3)))
 419   (inst mov (make-ea-for-vector-data state :offset (+ (- 624 1) 3)) y)
 420
 421   ;; Restore the temporary registers and return.
 422   (inst pop tmp)
 423   (inst pop y)
 424   (inst pop k)
 425   (inst ret))