1.0.5.53: cleanup LOAD-TYPE macros

[sbcl.git] / src / compiler / hppa / nlx.lisp

diff --git a/src/compiler/hppa/nlx.lisp b/src/compiler/hppa/nlx.lisp
index a9af920..a890cdb 100644 (file)
--- 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)))