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