src/assembly/mips/assem-rtns.lisp

   1 (in-package "SB!VM")
   2
   3 \f
   4 ;;;; Return-multiple with other than one value
   5
   6 #+sb-assembling ;; we don't want a vop for this one.
   7 (define-assembly-routine
   8     (return-multiple
   9      (:return-style :none))
  10
  11      ;; These four are really arguments.
  12     ((:temp nvals any-reg nargs-offset)
  13      (:temp vals any-reg nl0-offset)
  14      (:temp ocfp any-reg nl1-offset)
  15      (:temp lra descriptor-reg lra-offset)
  16
  17      ;; These are just needed to facilitate the transfer
  18      (:temp lip interior-reg lip-offset)
  19      (:temp count any-reg nl2-offset)
  20      (:temp dst any-reg nl4-offset)
  21      (:temp temp descriptor-reg l0-offset)
  22
  23      ;; These are needed so we can get at the register args.
  24      (:temp a0 descriptor-reg a0-offset)
  25      (:temp a1 descriptor-reg a1-offset)
  26      (:temp a2 descriptor-reg a2-offset)
  27      (:temp a3 descriptor-reg a3-offset)
  28      (:temp a4 descriptor-reg a4-offset)
  29      (:temp a5 descriptor-reg a5-offset))
  30
  31   ;; Note, because of the way the return-multiple vop is written, we can
  32   ;; assume that we are never called with nvals == 1 and that a0 has already
  33   ;; been loaded.
  34   (inst blez nvals default-a0-and-on)
  35   (inst subu count nvals (fixnumize 2))
  36   (inst blez count default-a2-and-on)
  37   (inst lw a1 vals (* 1 n-word-bytes))
  38   (inst subu count (fixnumize 1))
  39   (inst blez count default-a3-and-on)
  40   (inst lw a2 vals (* 2 n-word-bytes))
  41   (inst subu count (fixnumize 1))
  42   (inst blez count default-a4-and-on)
  43   (inst lw a3 vals (* 3 n-word-bytes))
  44   (inst subu count (fixnumize 1))
  45   (inst blez count default-a5-and-on)
  46   (inst lw a4 vals (* 4 n-word-bytes))
  47   (inst subu count (fixnumize 1))
  48   (inst blez count done)
  49   (inst lw a5 vals (* 5 n-word-bytes))
  50
  51   ;; Copy the remaining args to the top of the stack.
  52   (inst addu vals vals (* 6 n-word-bytes))
  53   (inst addu dst cfp-tn (* 6 n-word-bytes))
  54
  55   LOOP
  56   (inst lw temp vals)
  57   (inst addu vals n-word-bytes)
  58   (inst sw temp dst)
  59   (inst subu count (fixnumize 1))
  60   (inst bne count zero-tn loop)
  61   (inst addu dst n-word-bytes)
  62
  63   (inst b done)
  64   (inst nop)
  65
  66   DEFAULT-A0-AND-ON
  67   (inst move a0 null-tn)
  68   (inst move a1 null-tn)
  69   DEFAULT-A2-AND-ON
  70   (inst move a2 null-tn)
  71   DEFAULT-A3-AND-ON
  72   (inst move a3 null-tn)
  73   DEFAULT-A4-AND-ON
  74   (inst move a4 null-tn)
  75   DEFAULT-A5-AND-ON
  76   (inst move a5 null-tn)
  77   DONE
  78
  79   ;; Clear the stack.
  80   (move ocfp-tn cfp-tn)
  81   (move cfp-tn ocfp)
  82   (inst addu csp-tn ocfp-tn nvals)
  83
  84   ;; Return.
  85   (lisp-return lra lip))
  86
  87 \f
  88 ;;;; tail-call-variable.
  89
  90 #+sb-assembling ;; no vop for this one either.
  91 (define-assembly-routine
  92     (tail-call-variable
  93      (:return-style :none))
  94
  95     ;; These are really args.
  96     ((:temp args any-reg nl0-offset)
  97      (:temp lexenv descriptor-reg lexenv-offset)
  98
  99      ;; We need to compute this
 100      (:temp nargs any-reg nargs-offset)
 101
 102      ;; These are needed by the blitting code.
 103      (:temp src any-reg nl1-offset)
 104      (:temp dst any-reg nl2-offset)
 105      (:temp count any-reg cfunc-offset)
 106      (:temp temp descriptor-reg l0-offset)
 107
 108      ;; Needed for the jump
 109      (:temp lip interior-reg lip-offset)
 110
 111      ;; These are needed so we can get at the register args.
 112      (:temp a0 descriptor-reg a0-offset)
 113      (:temp a1 descriptor-reg a1-offset)
 114      (:temp a2 descriptor-reg a2-offset)
 115      (:temp a3 descriptor-reg a3-offset)
 116      (:temp a4 descriptor-reg a4-offset)
 117      (:temp a5 descriptor-reg a5-offset))
 118
 119
 120   ;; Calculate NARGS (as a fixnum)
 121   (inst subu nargs csp-tn args)
 122
 123   ;; Load the argument regs (must do this now, 'cause the blt might
 124   ;; trash these locations)
 125   (inst lw a0 args (* 0 n-word-bytes))
 126   (inst lw a1 args (* 1 n-word-bytes))
 127   (inst lw a2 args (* 2 n-word-bytes))
 128   (inst lw a3 args (* 3 n-word-bytes))
 129   (inst lw a4 args (* 4 n-word-bytes))
 130   (inst lw a5 args (* 5 n-word-bytes))
 131
 132   ;; Calc SRC, DST, and COUNT
 133   (inst addu count nargs (fixnumize (- register-arg-count)))
 134   (inst blez count done)
 135   (inst addu src args (* n-word-bytes register-arg-count))
 136   (inst addu dst cfp-tn (* n-word-bytes register-arg-count))
 137
 138   LOOP
 139   ;; Copy one arg.
 140   (inst lw temp src)
 141   (inst addu src src n-word-bytes)
 142   (inst sw temp dst)
 143   (inst addu count (fixnumize -1))
 144   (inst bgtz count loop)
 145   (inst addu dst dst n-word-bytes)
 146
 147   DONE
 148   ;; We are done.  Do the jump.
 149   (progn
 150     (loadw temp lexenv closure-fun-slot fun-pointer-lowtag)
 151     (lisp-jump temp lip)))
 152
 153 \f
 154 ;;;; Non-local exit noise.
 155
 156 (define-assembly-routine
 157     (unwind
 158      (:translate %continue-unwind)
 159      (:policy :fast-safe))
 160     ((:arg block (any-reg descriptor-reg) a0-offset)
 161      (:arg start (any-reg descriptor-reg) ocfp-offset)
 162      (:arg count (any-reg descriptor-reg) nargs-offset)
 163      (:temp lip interior-reg lip-offset)
 164      (:temp lra descriptor-reg lra-offset)
 165      (:temp cur-uwp any-reg nl0-offset)
 166      (:temp next-uwp any-reg nl1-offset)
 167      (:temp target-uwp any-reg nl2-offset))
 168   (declare (ignore start count))
 169
 170   (let ((error (generate-error-code nil invalid-unwind-error)))
 171     (inst beq block zero-tn error))
 172
 173   (load-symbol-value cur-uwp *current-unwind-protect-block*)
 174   (loadw target-uwp block unwind-block-current-uwp-slot)
 175   (inst bne cur-uwp target-uwp do-uwp)
 176   (inst nop)
 177
 178   (move cur-uwp block)
 179
 180   do-exit
 181
 182   (loadw cfp-tn cur-uwp unwind-block-current-cont-slot)
 183   (loadw code-tn cur-uwp unwind-block-current-code-slot)
 184   (progn
 185     (loadw lra cur-uwp unwind-block-entry-pc-slot)
 186     (lisp-return lra lip :frob-code nil))
 187
 188   do-uwp
 189
 190   (loadw next-uwp cur-uwp unwind-block-current-uwp-slot)
 191   (inst b do-exit)
 192   (store-symbol-value next-uwp *current-unwind-protect-block*))
 193
 194 (define-assembly-routine
 195     throw
 196     ((:arg target descriptor-reg a0-offset)
 197      (:arg start any-reg ocfp-offset)
 198      (:arg count any-reg nargs-offset)
 199      (:temp catch any-reg a1-offset)
 200      (:temp tag descriptor-reg a2-offset))
 201
 202   (progn start count) ; We just need them in the registers.
 203
 204   (load-symbol-value catch *current-catch-block*)
 205
 206   loop
 207
 208   (let ((error (generate-error-code nil unseen-throw-tag-error target)))
 209     (inst beq catch zero-tn error)
 210     (inst nop))
 211
 212   (loadw tag catch catch-block-tag-slot)
 213   (inst beq tag target exit)
 214   (inst nop)
 215   (loadw catch catch catch-block-previous-catch-slot)
 216   (inst b loop)
 217   (inst nop)
 218
 219   exit
 220
 221   (move target catch)
 222   (inst j (make-fixup 'unwind :assembly-routine))
 223   (inst nop))