X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fhppa%2Fnlx.lisp;h=a890cdbb3bf37ac57c6a3462cf4dadfc0801a839;hb=9105a2e4a8701814db413aa9ac3c41fd79d5b4f1;hp=a9af9204961e492abe04e882bf3074c92748d959;hpb=8a19c6876412b8ad1cf729297c2a373d63a0d0ec;p=sbcl.git

diff --git a/src/compiler/hppa/nlx.lisp b/src/compiler/hppa/nlx.lisp
index a9af920..a890cdb 100644
--- a/src/compiler/hppa/nlx.lisp
+++ b/src/compiler/hppa/nlx.lisp
@@ -1,19 +1,13 @@
 (in-package "SB!VM")
 
-;;; MAKE-NLX-SP-TN  --  Interface
-;;;
-;;;    Make an environment-live stack TN for saving the SP for NLX entry.
-;;;
+;;; Make an environment-live stack TN for saving the SP for NLX entry.
 (!def-vm-support-routine make-nlx-sp-tn (env)
   (physenv-live-tn
    (make-representation-tn *fixnum-primitive-type* immediate-arg-scn)
    env))
 
-;;; Make-NLX-Entry-Argument-Start-Location  --  Interface
-;;;
-;;;    Make a TN for the argument count passing location for a
+;;; Make a TN for the argument count passing location for a
 ;;; non-local entry.
-;;;
 (!def-vm-support-routine make-nlx-entry-arg-start-location ()
   (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset))
 
@@ -27,37 +21,28 @@
 ;;; were any additional stacks, then this would be the place to restore the top
 ;;; pointers.
 
-
-;;; Make-Dynamic-State-TNs  --  Interface
-;;;
-;;;    Return a list of TNs that can be used to snapshot the dynamic state for
-;;; use with the Save/Restore-Dynamic-Environment VOPs.
-;;;
-(!def-vm-support-routine make-dynamic-state-tns ()
-  (make-n-tns 4 *backend-t-primitive-type*))
-
 (define-vop (save-dynamic-state)
   (:results (catch :scs (descriptor-reg))
-	    (nfp :scs (descriptor-reg))
-	    (nsp :scs (descriptor-reg)))
+            (nfp :scs (descriptor-reg))
+            (nsp :scs (descriptor-reg)))
   (:vop-var vop)
   (:generator 13
     (load-symbol-value catch *current-catch-block*)
     (let ((cur-nfp (current-nfp-tn vop)))
       (when cur-nfp
-	(move cur-nfp nfp)))
+        (move cur-nfp nfp)))
     (move nsp-tn nsp)))
 
 (define-vop (restore-dynamic-state)
   (:args (catch :scs (descriptor-reg))
-	 (nfp :scs (descriptor-reg))
-	 (nsp :scs (descriptor-reg)))
+         (nfp :scs (descriptor-reg))
+         (nsp :scs (descriptor-reg)))
   (:vop-var vop)
   (:generator 10
     (store-symbol-value catch *current-catch-block*)
     (let ((cur-nfp (current-nfp-tn vop)))
       (when cur-nfp
-	(move nfp cur-nfp)))
+        (move nfp cur-nfp)))
     (move nsp nsp-tn)))
 
 (define-vop (current-stack-pointer)
@@ -96,7 +81,7 @@
 ;;;
 (define-vop (make-catch-block)
   (:args (tn)
-	 (tag :scs (descriptor-reg)))
+         (tag :scs (any-reg descriptor-reg)))
   (:info entry-label)
   (:results (block :scs (any-reg) :from (:argument 0)))
   (:temporary (:scs (descriptor-reg)) temp)
@@ -151,9 +136,9 @@
 
 (define-vop (nlx-entry)
   (:args (sp) ; Note: we can't list an sc-restriction, 'cause any load vops
-	      ; would be inserted before the LRA.
-	 (start)
-	 (count))
+              ; would be inserted before the LRA.
+         (start)
+         (count))
   (:results (values :more t))
   (:temporary (:scs (descriptor-reg)) move-temp)
   (:info label nvals)
@@ -163,43 +148,43 @@
     (emit-return-pc label)
     (note-this-location vop :non-local-entry)
     (cond ((zerop nvals))
-	  ((= nvals 1)
-	   (inst comclr count zero-tn zero-tn :<>)
-	   (inst move null-tn (tn-ref-tn values) :tr)
-	   (loadw (tn-ref-tn values) start))
-	  (t
-	   (collect ((defaults))
-	     (do ((i 0 (1+ i))
-		  (tn-ref values (tn-ref-across tn-ref)))
-		 ((null tn-ref))
-	       (let ((default-lab (gen-label))
-		     (tn (tn-ref-tn tn-ref)))
-		 (defaults (cons default-lab tn))
-
-		 (inst bci := nil (fixnumize i) count default-lab)
-		 (sc-case tn
-		   ((descriptor-reg any-reg)
-		    (loadw tn start i))
-		   (control-stack
-		    (loadw move-temp start i)
-		    (store-stack-tn tn move-temp)))))
-	     
-	     (let ((defaulting-done (gen-label)))
-	       (emit-label defaulting-done)
-	       
-	       (assemble (*elsewhere*)
-		 (do ((defs (defaults) (cdr defs)))
-		     ((null defs))
-		   (let ((def (car defs)))
-		     (emit-label (car def))
-		     (unless (cdr defs)
-		       (inst b defaulting-done))
-		     (let ((tn (cdr def)))
-		       (sc-case tn
-			 ((descriptor-reg any-reg)
-			  (move null-tn tn))
-			 (control-stack
-			  (store-stack-tn tn null-tn)))))))))))
+          ((= nvals 1)
+           (inst comclr count zero-tn zero-tn :<>)
+           (inst move null-tn (tn-ref-tn values) :tr)
+           (loadw (tn-ref-tn values) start))
+          (t
+           (collect ((defaults))
+             (do ((i 0 (1+ i))
+                  (tn-ref values (tn-ref-across tn-ref)))
+                 ((null tn-ref))
+               (let ((default-lab (gen-label))
+                     (tn (tn-ref-tn tn-ref)))
+                 (defaults (cons default-lab tn))
+
+                 (inst bci := nil (fixnumize i) count default-lab)
+                 (sc-case tn
+                   ((descriptor-reg any-reg)
+                    (loadw tn start i))
+                   (control-stack
+                    (loadw move-temp start i)
+                    (store-stack-tn tn move-temp)))))
+
+             (let ((defaulting-done (gen-label)))
+               (emit-label defaulting-done)
+
+               (assemble (*elsewhere*)
+                 (do ((defs (defaults) (cdr defs)))
+                     ((null defs))
+                   (let ((def (car defs)))
+                     (emit-label (car def))
+                     (unless (cdr defs)
+                       (inst b defaulting-done))
+                     (let ((tn (cdr def)))
+                       (sc-case tn
+                         ((descriptor-reg any-reg)
+                          (move null-tn tn))
+                         (control-stack
+                          (store-stack-tn tn null-tn)))))))))))
     (load-stack-tn csp-tn sp)))