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