src/assembly/mips/arith.lisp

   1 (in-package "SB!VM")
   2
   3
   4 \f
   5 ;;;; Addition and subtraction.
   6
   7 ;;; static-fun-offset returns the address of the raw_addr slot of
   8 ;;; a static function's fdefn.
   9
  10 ;;; Note that there is only one use of static-fun-offset outside this
  11 ;;; file (in genesis.lisp)
  12
  13 (define-assembly-routine (generic-+
  14                           (:cost 10)
  15                           (:return-style :full-call)
  16                           (:translate +)
  17                           (:policy :safe)
  18                           (:save-p t))
  19                          ((:arg x (descriptor-reg any-reg) a0-offset)
  20                           (:arg y (descriptor-reg any-reg) a1-offset)
  21
  22                           (:res res (descriptor-reg any-reg) a0-offset)
  23
  24                           (:temp temp non-descriptor-reg nl0-offset)
  25                           (:temp temp1 non-descriptor-reg nl1-offset)
  26                           (:temp temp2 non-descriptor-reg nl2-offset)
  27                           (:temp pa-flag non-descriptor-reg nl4-offset)
  28                           (:temp lip interior-reg lip-offset)
  29                           (:temp nargs any-reg nargs-offset)
  30                           (:temp ocfp any-reg ocfp-offset))
  31   (inst or temp x y)
  32   (inst and temp fixnum-tag-mask)
  33   (inst beq temp DO-ADD)
  34   (inst sra temp1 x n-fixnum-tag-bits)
  35
  36   ;; DO-STATIC-FUN
  37   (inst lw lip null-tn (static-fun-offset 'two-arg-+))
  38   (inst li nargs (fixnumize 2))
  39   (move ocfp cfp-tn)
  40   (inst j lip)
  41   (move cfp-tn csp-tn t)
  42
  43   DO-ADD
  44   (inst sra temp2 y n-fixnum-tag-bits)
  45   (inst addu temp temp1 temp2)
  46   ;; check for overflow
  47   (inst sra temp1 temp (- n-word-bits n-lowtag-bits))
  48   (inst beq temp1 RETURN)
  49   (inst nor temp1 temp1)
  50   (inst beq temp1 RETURN)
  51   (inst nop)
  52   (with-fixed-allocation (res pa-flag temp2 bignum-widetag (1+ bignum-digits-offset))
  53     (storew temp res bignum-digits-offset other-pointer-lowtag))
  54   (inst b DONE)
  55   (inst nop)
  56
  57   RETURN
  58   (inst sll res temp n-fixnum-tag-bits)
  59
  60   DONE)
  61
  62
  63 (define-assembly-routine (generic--
  64                           (:cost 10)
  65                           (:return-style :full-call)
  66                           (:translate -)
  67                           (:policy :safe)
  68                           (:save-p t))
  69                          ((:arg x (descriptor-reg any-reg) a0-offset)
  70                           (:arg y (descriptor-reg any-reg) a1-offset)
  71
  72                           (:res res (descriptor-reg any-reg) a0-offset)
  73
  74                           (:temp temp non-descriptor-reg nl0-offset)
  75                           (:temp temp1 non-descriptor-reg nl1-offset)
  76                           (:temp temp2 non-descriptor-reg nl2-offset)
  77                           (:temp pa-flag non-descriptor-reg nl4-offset)
  78                           (:temp lip interior-reg lip-offset)
  79                           (:temp nargs any-reg nargs-offset)
  80                           (:temp ocfp any-reg ocfp-offset))
  81   (inst or temp x y)
  82   (inst and temp fixnum-tag-mask)
  83   (inst beq temp DO-SUB)
  84   (inst sra temp1 x n-fixnum-tag-bits)
  85
  86   ;; DO-STATIC-FUN
  87   (inst lw lip null-tn (static-fun-offset 'two-arg--))
  88   (inst li nargs (fixnumize 2))
  89   (move ocfp cfp-tn)
  90   (inst j lip)
  91   (move cfp-tn csp-tn t)
  92
  93   DO-SUB
  94   (inst sra temp2 y n-fixnum-tag-bits)
  95   (inst subu temp temp1 temp2)
  96   ;; check for overflow
  97   (inst sra temp1 temp (- n-word-bits n-lowtag-bits))
  98   (inst beq temp1 RETURN)
  99   (inst nor temp1 temp1)
 100   (inst beq temp1 RETURN)
 101   (inst nop)
 102   (with-fixed-allocation (res pa-flag temp2 bignum-widetag (1+ bignum-digits-offset))
 103     (storew temp res bignum-digits-offset other-pointer-lowtag))
 104   (inst b DONE)
 105   (inst nop)
 106
 107   RETURN
 108   (inst sll res temp n-fixnum-tag-bits)
 109
 110   DONE)
 111
 112
 113 \f
 114 ;;;; Multiplication
 115
 116
 117 (define-assembly-routine (generic-*
 118                           (:cost 25)
 119                           (:return-style :full-call)
 120                           (:translate *)
 121                           (:policy :safe)
 122                           (:save-p t))
 123                          ((:arg x (descriptor-reg any-reg) a0-offset)
 124                           (:arg y (descriptor-reg any-reg) a1-offset)
 125
 126                           (:res res (descriptor-reg any-reg) a0-offset)
 127
 128                           (:temp temp non-descriptor-reg nl0-offset)
 129                           (:temp lo non-descriptor-reg nl1-offset)
 130                           (:temp hi non-descriptor-reg nl2-offset)
 131                           (:temp pa-flag non-descriptor-reg nl4-offset)
 132                           (:temp lip interior-reg lip-offset)
 133                           (:temp nargs any-reg nargs-offset)
 134                           (:temp ocfp any-reg ocfp-offset))
 135   ;; If either arg is not a fixnum, call the static function.
 136   (inst or temp x y)
 137   (inst and temp fixnum-tag-mask)
 138   (inst bne temp DO-STATIC-FUN)
 139   ;; Remove the tag from one arg so that the result will have the correct
 140   ;; fixnum tag.
 141   (inst sra temp x n-fixnum-tag-bits)
 142   (inst mult temp y)
 143   (inst mflo res)
 144   (inst mfhi hi)
 145   ;; Check to see if the result will fit in a fixnum.  (I.e. the high word
 146   ;; is just 32 copies of the sign bit of the low word).
 147   (inst sra temp res 31)
 148   (inst beq temp hi DONE)
 149   ;; Shift the double word hi:res down two bits into hi:low to get rid of the
 150   ;; fixnum tag.
 151   (inst srl lo res n-fixnum-tag-bits)
 152   (inst sll temp hi (- n-word-bits n-fixnum-tag-bits))
 153   (inst or lo temp)
 154   (inst sra hi n-fixnum-tag-bits)
 155
 156   ;; Do we need one word or two?  Assume two.
 157   (inst sra temp lo 31)
 158   (inst bne temp hi TWO-WORDS)
 159   ;; Assume a two word header.
 160   (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
 161
 162   ;; Only need one word, fix the header.
 163   (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
 164
 165   (pseudo-atomic (pa-flag :extra (pad-data-block (+ 1 bignum-digits-offset)))
 166     (inst or res alloc-tn other-pointer-lowtag)
 167     (storew temp res 0 other-pointer-lowtag))
 168   (inst b DONE)
 169   (storew lo res bignum-digits-offset other-pointer-lowtag)
 170
 171   TWO-WORDS
 172   (pseudo-atomic (pa-flag :extra (pad-data-block (+ 2 bignum-digits-offset)))
 173     (inst or res alloc-tn other-pointer-lowtag)
 174     (storew temp res 0 other-pointer-lowtag))
 175
 176   (storew lo res bignum-digits-offset other-pointer-lowtag)
 177   (inst b DONE)
 178   (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
 179
 180   DO-STATIC-FUN
 181   (inst lw lip null-tn (static-fun-offset 'two-arg-*))
 182   (inst li nargs (fixnumize 2))
 183   (move ocfp cfp-tn)
 184   (inst j lip)
 185   (move cfp-tn csp-tn t)
 186
 187   DONE)
 188
 189
 190 \f
 191 ;;;; Comparison routines.
 192
 193 (macrolet
 194     ((define-cond-assem-rtn (name translate static-fn cmp)
 195        `(define-assembly-routine (,name
 196                                   (:cost 10)
 197                                   (:return-style :full-call)
 198                                   (:policy :safe)
 199                                   (:translate ,translate)
 200                                   (:save-p t))
 201                                  ((:arg x (descriptor-reg any-reg) a0-offset)
 202                                   (:arg y (descriptor-reg any-reg) a1-offset)
 203
 204                                   (:res res descriptor-reg a0-offset)
 205
 206                                   (:temp temp non-descriptor-reg nl0-offset)
 207                                   (:temp lip interior-reg lip-offset)
 208                                   (:temp nargs any-reg nargs-offset)
 209                                   (:temp ocfp any-reg ocfp-offset))
 210           (inst or temp x y)
 211           (inst and temp fixnum-tag-mask)
 212           (inst beq temp DO-COMPARE)
 213           ,cmp
 214
 215           ;; DO-STATIC-FUN
 216           (inst lw lip null-tn (static-fun-offset ',static-fn))
 217           (inst li nargs (fixnumize 2))
 218           (move ocfp cfp-tn)
 219           (inst j lip)
 220           (move cfp-tn csp-tn t)
 221
 222           DO-COMPARE
 223           (inst beq temp DONE)
 224           (move res null-tn t)
 225           (load-symbol res t)
 226
 227           DONE)))
 228
 229   (define-cond-assem-rtn generic-< < two-arg-< (inst slt temp x y))
 230   (define-cond-assem-rtn generic-> > two-arg-> (inst slt temp y x)))
 231
 232
 233 (define-assembly-routine (generic-eql
 234                           (:cost 10)
 235                           (:return-style :full-call)
 236                           (:policy :safe)
 237                           (:translate eql)
 238                           (:save-p t))
 239                          ((:arg x (descriptor-reg any-reg) a0-offset)
 240                           (:arg y (descriptor-reg any-reg) a1-offset)
 241
 242                           (:res res descriptor-reg a0-offset)
 243
 244                           (:temp temp non-descriptor-reg nl0-offset)
 245                           (:temp lip interior-reg lip-offset)
 246                           (:temp nargs any-reg nargs-offset)
 247                           (:temp ocfp any-reg ocfp-offset))
 248   (inst beq x y RETURN-T)
 249   (inst or temp x y)
 250   (inst and temp fixnum-tag-mask)
 251   (inst beq temp RETURN)
 252   (inst nop)
 253
 254   ;; DO-STATIC-FUN
 255   (inst lw lip null-tn (static-fun-offset 'eql))
 256   (inst li nargs (fixnumize 2))
 257   (move ocfp cfp-tn)
 258   (inst j lip)
 259   (move cfp-tn csp-tn t)
 260
 261   RETURN
 262   (inst bne x y DONE)
 263   (move res null-tn t)
 264
 265   RETURN-T
 266   (load-symbol res t)
 267
 268   DONE)
 269
 270
 271 (define-assembly-routine (generic-=
 272                           (:cost 10)
 273                           (:return-style :full-call)
 274                           (:policy :safe)
 275                           (:translate =)
 276                           (:save-p t))
 277                          ((:arg x (descriptor-reg any-reg) a0-offset)
 278                           (:arg y (descriptor-reg any-reg) a1-offset)
 279
 280                           (:res res descriptor-reg a0-offset)
 281
 282                           (:temp temp non-descriptor-reg nl0-offset)
 283                           (:temp lip interior-reg lip-offset)
 284                           (:temp nargs any-reg nargs-offset)
 285                           (:temp ocfp any-reg ocfp-offset))
 286   (inst or temp x y)
 287   (inst and temp fixnum-tag-mask)
 288   (inst beq temp RETURN)
 289   (inst nop)
 290
 291   ;; DO-STATIC-FUN
 292   (inst lw lip null-tn (static-fun-offset 'two-arg-=))
 293   (inst li nargs (fixnumize 2))
 294   (move ocfp cfp-tn)
 295   (inst j lip)
 296   (move cfp-tn csp-tn t)
 297
 298   RETURN
 299   (inst bne x y DONE)
 300   (move res null-tn t)
 301   (load-symbol res t)
 302
 303   DONE)
 304
 305
 306 (define-assembly-routine (generic-/=
 307                           (:cost 10)
 308                           (:return-style :full-call)
 309                           (:policy :safe)
 310                           (:translate /=)
 311                           (:save-p t))
 312                          ((:arg x (descriptor-reg any-reg) a0-offset)
 313                           (:arg y (descriptor-reg any-reg) a1-offset)
 314
 315                           (:res res descriptor-reg a0-offset)
 316
 317                           (:temp temp non-descriptor-reg nl0-offset)
 318                           (:temp lip interior-reg lip-offset)
 319                           (:temp nargs any-reg nargs-offset)
 320                           (:temp ocfp any-reg ocfp-offset))
 321   (inst or temp x y)
 322   (inst and temp fixnum-tag-mask)
 323   (inst beq temp RETURN)
 324   (inst nop)
 325
 326   ;; DO-STATIC-FUN
 327   (inst lw lip null-tn (static-fun-offset 'two-arg-/=))
 328   (inst li nargs (fixnumize 2))
 329   (move ocfp cfp-tn)
 330   (inst j lip)
 331   (move cfp-tn csp-tn t)
 332
 333   RETURN
 334   (inst beq x y DONE)
 335   (move res null-tn t)
 336   (load-symbol res t)
 337
 338   DONE)