diff --git a/compiler/mips/nlx.lisp b/compiler/mips/nlx.lisp index f7564441ad420f7c05ab6f012d506dfa44740397..45f83087fa4b05301c5964a267de9ff529051950 100644 --- a/compiler/mips/nlx.lisp +++ b/compiler/mips/nlx.lisp @@ -7,6 +7,8 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/nlx.lisp,v 1.2 1990/02/27 00:12:10 wlott Exp $ +;;; ;;; This file contains the definitions of VOPs used for non-local exit ;;; (throw, lexical exit, etc.) ;;; @@ -31,53 +33,133 @@ ;;; use with the Save/Restore-Dynamic-Environment VOPs. ;;; (defun make-dynamic-state-tns () - (make-n-tns 3 *any-primitive-type*)) + (make-n-tns 4 *any-primitive-type*)) (define-vop (save-dynamic-state) (:results (catch :scs (descriptor-reg)) (special :scs (descriptor-reg)) + (number :scs (descriptor-reg)) (eval :scs (descriptor-reg))) - #+nil (:generator 13 - (load-global catch clc::current-catch-block) - (inst lr special bs-tn) - (inst cau eval zero-tn clc::t-16) - (inst l eval eval (+ clc::*eval-stack-top*-offset clc::symbol-value)))) + (load-symbol-value catch lisp::*current-catch-block*) + (move special bsp-tn) + (move number nsp-tn) + (load-symbol-value eval lisp::*eval-stack-top*))) -(define-vop (restore-dynamic-state one-arg-no-value-miscop) +(define-vop (restore-dynamic-state) (:args (catch :scs (descriptor-reg)) - (special :scs (descriptor-reg) :target a0) + (special :scs (descriptor-reg)) + (number :scs (descriptor-reg)) (eval :scs (descriptor-reg))) - (:temporary (:scs (descriptor-reg)) temp) - (:variant-vars) - #+nil + (:temporary (:scs (descriptor-reg)) symbol value) (:generator 10 - (store-global catch clc::current-catch-block temp) - (inst cau temp zero-tn clc::t-16) - (inst st eval temp (+ clc::*eval-stack-top*-offset clc::symbol-value)) - (let ((skip (gen-label))) - (inst c special bs-tn) - (inst bb :eq skip) - (unless (location= special a0) - (inst lr a0 special)) - (inst miscop 'clc::unbind-to-here) - (emit-label skip)))) + (let ((done (gen-label)) + (skip (gen-label)) + (loop (gen-label))) + + (store-symbol-value catch lisp::*current-catch-block*) + (store-symbol-value eval lisp::*eval-stack-top*) + (move nsp-tn number) + + (inst beq special bsp-tn done) + (nop) + + (emit-label loop) + (loadw symbol bsp-tn (- binding-symbol-slot binding-size)) + (inst beq symbol zero-tn skip) + (loadw value bsp-tn (- binding-value-slot binding-size)) + (storew value symbol vm:symbol-value-slot vm:other-pointer-type) + (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) + (emit-label skip) + (inst addiu bsp-tn bsp-tn (* -2 vm:word-bytes)) + (inst bne bsp-tn special loop) + (nop) + + (emit-label done)))) (define-vop (current-stack-pointer) (:results (res :scs (any-reg descriptor-reg))) - #+nil (:generator 1 - (inst lr res sp-tn))) + (move res csp-tn))) ;;;; Unwind miscop VOPs: -(define-vop (unwind three-arg-no-value-miscop) - (:variant 'clc::unwind) - (:translate %continue-unwind)) +(define-vop (unwind) + (:translate %continue-unwind) + (:args (block-arg :target block) + (start :target args) + (count :target nargs)) + (:temporary (:sc any-reg :offset (first register-arg-offsets) + :from (:argument 0)) block) + (:temporary (:sc any-reg :offset args-offset :from (:argument 1)) args) + (:temporary (:sc any-reg :offset nargs-offset :from (:argument 2)) nargs) + (:temporary (:scs (any-reg) :type fixnum) cur-uwp target-uwp next-uwp) + (:temporary (:scs (descriptor-reg)) return-pc) + (:temporary (:scs (interior-reg) :type interior) lip) + (:node-var node) + (:generator 0 + (let ((error (generate-error-code node di:invalid-unwind-error)) + (do-uwp (gen-label)) + (do-exit (gen-label))) + (move block block-arg) + (inst beq block zero-tn error) + + (move args start) + (move nargs count) + + (load-symbol-value cur-uwp lisp::*current-unwind-protect-block*) + (loadw target-uwp block vm:unwind-block-current-uwp-slot) + (inst bne cur-uwp target-uwp do-uwp) + (nop) + + (move cur-uwp block) + + (emit-label do-exit) + + (loadw cont-tn cur-uwp vm:unwind-block-current-cont-slot) + (loadw code-tn cur-uwp vm:unwind-block-current-code-slot) + (loadw return-pc cur-uwp vm:unwind-block-entry-pc-slot) + (lisp-return return-pc lip) + + (emit-label do-uwp) + + (loadw next-uwp cur-uwp vm:unwind-block-current-uwp-slot) + (b do-exit) + (store-symbol-value next-uwp lisp::*current-unwind-protect-block*)))) + + +(define-vop (throw) + (:args (target) + (start) + (count)) + (:temporary (:scs (any-reg) :type fixnum) + catch) + (:temporary (:scs (descriptor-reg)) + tag) + (:node-var node) + (:generator 0 + (let ((loop (gen-label)) + (exit (gen-label)) + (error (generate-error-code node di:unseen-throw-tag-error target))) + (load-symbol-value catch lisp::*current-catch-block*) + + (emit-label loop) + + (inst bne catch zero-tn error) + + (loadw tag catch vm:catch-block-tag-slot) + (inst beq tag target exit) + (nop) + (b loop) + (loadw catch catch vm:catch-block-previous-catch-slot) + + (emit-label exit) + + ;; ### Need to call unwind somehow. + + ))) -(define-vop (throw three-arg-no-value-miscop) - (:variant 'clc::throw)) ;;;; Unwind block hackery: @@ -91,16 +173,14 @@ (:results (block :scs (descriptor-reg))) (:temporary (:scs (descriptor-reg)) temp) (:temporary (:scs (descriptor-reg) :target block) result) - #+nil (:generator 22 - (inst ai result cont-tn (* (tn-offset tn) 4)) - (load-global temp clc::current-unwind-protect-block) - (storew temp result system:%unwind-block-current-uwp) - (storew cont-tn result system:%unwind-block-current-cont) - (storew env-tn result system:%unwind-block-current-env) - (storew entry-offset result system:%unwind-block-entry-pc) - (unless (location= result block) - (inst lr block result)))) + (inst addiu result cont-tn (* (tn-offset tn) vm:word-bytes)) + (load-symbol-value temp lisp::*current-unwind-protect-block*) + (storew temp result vm:unwind-block-current-uwp-slot) + (storew cont-tn result vm:unwind-block-current-cont-slot) + (storew code-tn result vm:unwind-block-current-code-slot) + (storew entry-offset result vm:unwind-block-entry-pc-slot) + (move block result))) ;;; Like Make-Unwind-Block, except that we also store in the specified tag, and @@ -113,22 +193,20 @@ (:results (block :scs (descriptor-reg))) (:temporary (:scs (descriptor-reg)) temp) (:temporary (:scs (descriptor-reg) :target block) result) - #+nil (:generator 44 - (inst ai result cont-tn (* (tn-offset tn) 4)) - (load-global temp clc::current-unwind-protect-block) - (storew temp result system:%unwind-block-current-uwp) - (storew cont-tn result system:%unwind-block-current-cont) - (storew env-tn result system:%unwind-block-current-env) - (storew entry-offset result system:%unwind-block-entry-pc) - - (storew tag result system:%catch-block-tag) - (load-global temp clc::current-catch-block) - (storew temp result system:%catch-block-previous-catch) - (store-global result clc::current-catch-block temp) - - (unless (location= result block) - (inst lr block result)))) + (inst addiu result cont-tn (* (tn-offset tn) vm:word-bytes)) + (load-symbol-value temp lisp::*current-unwind-protect-block*) + (storew temp result vm:catch-block-current-uwp-slot) + (storew cont-tn result vm:catch-block-current-cont-slot) + (storew code-tn result vm:catch-block-current-code-slot) + (storew entry-offset result vm:catch-block-entry-pc-slot) + + (storew tag result vm:catch-block-tag-slot) + (load-symbol-value temp lisp::*current-catch-block-slot*) + (storew temp result vm:catch-block-previous-catch-slot) + (store-symbol-value result lisp::*current-catch-block*) + + (move block result))) ;;; Just set the current unwind-protect to TN's address. This instantiates an @@ -136,30 +214,29 @@ ;;; (define-vop (set-unwind-protect) (:args (tn)) - (:temporary (:scs (descriptor-reg)) temp new-uwp) - #+nil + (:temporary (:scs (descriptor-reg)) new-uwp) (:generator 7 - (inst ai new-uwp cont-tn (* (tn-offset tn) 4)) - (store-global new-uwp clc::current-unwind-protect-block temp))) + (inst addiu new-uwp cont-tn (* (tn-offset tn) vm:word-bytes)) + (store-symbol-value new-uwp lisp::*current-unwind-protect-block*))) -(define-vop (unlink-unwind-block) - (:temporary (:scs (descriptor-reg)) block temp) - (:variant-vars global slot) +(define-vop (unlink-catch-block) + (:temporary (:scs (descriptor-reg)) block) (:policy :fast-safe) - #+nil + (:translate %catch-breakup) (:generator 17 - (load-global block global) - (loadw block block slot) - (store-global block global temp))) - -(define-vop (unlink-catch-block unlink-unwind-block) - (:variant clc::current-catch-block system:%catch-block-previous-catch) - (:translate %catch-breakup)) + (load-symbol-value block lisp::*current-catch-block*) + (loadw block block vm:catch-block-previous-catch-slot) + (store-symbol-value block lisp::*current-catch-block*))) -(define-vop (unlink-unwind-protect unlink-unwind-block) - (:variant clc::current-unwind-protect-block system:%unwind-block-current-uwp) - (:translate %unwind-protect-breakup)) +(define-vop (unlink-unwind-protect) + (:temporary (:scs (descriptor-reg)) block) + (:policy :fast-safe) + (:translate %unwind-protect-breakup) + (:generator 17 + (load-symbol-value block lisp::*current-unwind-protect-block*) + (loadw block block vm:unwind-block-current-uwp-slot) + (store-symbol-value block lisp::*current-unwind-protect-block*))) ;;;; NLX entry VOPs: @@ -168,15 +245,12 @@ ;;; operands. ;;; -(define-vop (nlx-entry two-arg-no-value-miscop) - (:args (top :scs (descriptor-reg) - :target a0) +(define-vop (nlx-entry) + (:args (top :scs (descriptor-reg)) (start) (count)) (:results (values :more t)) (:info nvals) - (:ignore start count values nl0 nl1 a2 a3 misc-pc) - (:variant-vars) (:save-p :force-to-stack) #+nil (:generator 30 @@ -186,13 +260,10 @@ (inst cal a1 zero-tn nvals))) -(define-vop (nlx-entry-multiple two-arg-two-value-miscop) - (:args (top :scs (descriptor-reg) - :target a0) +(define-vop (nlx-entry-multiple) + (:args (top :scs (descriptor-reg)) (start) (count)) - (:ignore start count nl0 nl1 a2 a3 misc-pc) - (:variant-vars) (:save-p :force-to-stack) #+nil (:generator 30 @@ -211,5 +282,4 @@ (:save-p :force-to-stack) (:results (block) (start) (count)) (:ignore block start count) - #+nil (:generator 0))