(:temp dst any-reg cfunc-offset)
(:temp temp descriptor-reg l0-offset)
-
+
;; These are needed so we can get at the register args.
(:temp a0 descriptor-reg a0-offset)
(:temp a1 descriptor-reg a1-offset)
(inst stw temp dst 0)
(inst addi dst dst n-word-bytes)
(inst bge loop)
-
+
(inst b done)
DEFAULT-A0-AND-ON
DEFAULT-A3-AND-ON
(inst mr a3 null-tn)
DONE
-
+
;; Clear the stack.
(move ocfp-tn cfp-tn)
(move cfp-tn ocfp)
(inst add csp-tn ocfp-tn nvals)
-
+
;; Return.
(lisp-return lra lip))
;; Calculate NARGS (as a fixnum)
(inst sub nargs csp-tn args)
-
+
;; Load the argument regs (must do this now, 'cause the blt might
;; trash these locations)
(inst lwz a0 args (* 0 n-word-bytes))
(inst addi src args (* n-word-bytes register-arg-count))
(inst ble done)
(inst addi dst cfp-tn (* n-word-bytes register-arg-count))
-
+
LOOP
;; Copy one arg.
(inst lwz temp src 0)
(inst addic. count count (fixnumize -1))
(inst addi dst dst n-word-bytes)
(inst bgt loop)
-
+
DONE
;; We are done. Do the jump.
(loadw temp lexenv closure-fun-slot fun-pointer-lowtag)
;;;; Non-local exit noise.
(define-assembly-routine (unwind
- (:return-style :none)
- (:translate %continue-unwind)
- (:policy :fast-safe))
- ((:arg block (any-reg descriptor-reg) a0-offset)
- (:arg start (any-reg descriptor-reg) ocfp-offset)
- (:arg count (any-reg descriptor-reg) nargs-offset)
- (:temp lra descriptor-reg lra-offset)
- (:temp lip interior-reg lip-offset)
- (:temp cur-uwp any-reg nl0-offset)
- (:temp next-uwp any-reg nl1-offset)
- (:temp target-uwp any-reg nl2-offset))
+ (:return-style :none)
+ (:translate %continue-unwind)
+ (:policy :fast-safe))
+ ((:arg block (any-reg descriptor-reg) a0-offset)
+ (:arg start (any-reg descriptor-reg) ocfp-offset)
+ (:arg count (any-reg descriptor-reg) nargs-offset)
+ (:temp lra descriptor-reg lra-offset)
+ (:temp lip interior-reg lip-offset)
+ (:temp cur-uwp any-reg nl0-offset)
+ (:temp next-uwp any-reg nl1-offset)
+ (:temp target-uwp any-reg nl2-offset))
(declare (ignore start count))
(let ((error (generate-error-code nil invalid-unwind-error)))
(inst cmpwi block 0)
(inst beq error))
-
+
(load-symbol-value cur-uwp *current-unwind-protect-block*)
(loadw target-uwp block unwind-block-current-uwp-slot)
(inst cmpw cur-uwp target-uwp)
(inst bne do-uwp)
-
+
(move cur-uwp block)
DO-EXIT
-
+
(loadw cfp-tn cur-uwp unwind-block-current-cont-slot)
(loadw code-tn cur-uwp unwind-block-current-code-slot)
(loadw lra cur-uwp unwind-block-entry-pc-slot)
(inst b do-exit))
(define-assembly-routine (throw
- (:return-style :none))
- ((:arg target descriptor-reg a0-offset)
- (:arg start any-reg ocfp-offset)
- (:arg count any-reg nargs-offset)
- (:temp catch any-reg a1-offset)
- (:temp tag descriptor-reg a2-offset))
-
+ (:return-style :none))
+ ((:arg target descriptor-reg a0-offset)
+ (:arg start any-reg ocfp-offset)
+ (:arg count any-reg nargs-offset)
+ (:temp catch any-reg a1-offset)
+ (:temp tag descriptor-reg a2-offset))
+
(declare (ignore start count))
(load-symbol-value catch *current-catch-block*)
-
+
loop
-
+
(let ((error (generate-error-code nil unseen-throw-tag-error target)))
(inst cmpwi catch 0)
(inst beq error))
-
+
(loadw tag catch catch-block-tag-slot)
(inst cmpw tag target)
(inst beq exit)
(loadw catch catch catch-block-previous-catch-slot)
(inst b loop)
-
- exit
-
- (move target catch)
- (inst ba (make-fixup 'unwind :assembly-routine)))
-
+ exit
+ (move target catch)
+ ;; reuse catch
+ (inst lr catch (make-fixup 'unwind :assembly-routine))
+ (inst mtlr catch)
+ (inst blr))