Skip to content
Snippets Groups Projects
Commit e86b4304 authored by wlott's avatar wlott
Browse files

Initial cut at rewrite for mips. Not finished, but at least the VOPs will

be there.
parent 168d60f7
No related branches found
No related tags found
No related merge requests found
......@@ -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))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment