src/assembly/mips/arith.lisp

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