Index: /trunk/source/compiler/ARM/arm2.lisp
===================================================================
--- /trunk/source/compiler/ARM/arm2.lisp	(revision 14981)
+++ /trunk/source/compiler/ARM/arm2.lisp	(revision 14982)
@@ -355,5 +355,9 @@
     (#.arm::arm-cond-le arm::arm-cond-ge)
     (#.arm::arm-cond-gt arm::arm-cond-lt)
-    (#.arm::arm-cond-ge arm::arm-cond-le)))
+    (#.arm::arm-cond-ge arm::arm-cond-le)
+    (#.arm::arm-cond-lo arm::arm-cond-hi)
+    (#.arm::arm-cond-ls arm::arm-cond-hs)
+    (#.arm::arm-cond-hi arm::arm-cond-lo)
+    (#.arm::arm-cond-hs arm::arm-cond-ls)))
 
     
@@ -2366,5 +2370,5 @@
   (when (and rest (not key-p) (not (cadr auxen)) rest-values)
     (when (eq (logand (the fixnum (nx-var-bits rest))
-                      (logior $vsetqmask (ash -1 $vbitspecial)
+                      (logior (ash -1 $vbitspecial)
                               (ash 1 $vbitclosed) (ash 1 $vbitsetq) (ash 1 $vbitcloseddownward)))
               0)               ; Nothing but simple references
@@ -3020,5 +3024,6 @@
       (values aalready balready)
       (with-arm-local-vinsn-macros (seg)
-        (let* ((avar (arm2-lexical-reference-p aform))
+        (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
+               (avar (arm2-lexical-reference-p aform))
                (adest areg)
                (bdest breg)
@@ -3032,4 +3037,6 @@
                 (progn
                   (setq adest (arm2-one-untargeted-reg-form seg aform areg))
+                  (when (imm-reg-p adest)
+                    (use-imm-temp (%hard-regspec-value adest)))
                   (when (same-arm-reg-p adest breg)
                     (setq breg areg)))
@@ -3040,5 +3047,8 @@
               (setq bdest (arm2-one-untargeted-reg-form seg bform breg)))
             (if aconst
-              (setq adest (arm2-one-untargeted-reg-form seg aform areg))
+              (progn
+                (if (imm-reg-p bdest)
+                  (use-imm-temp (%hard-regspec-value bdest)))
+                (setq adest (arm2-one-untargeted-reg-form seg aform areg)))
               (if apushed
                 (arm2-elide-pushes seg apushed (arm2-pop-register seg areg)))))
@@ -3358,10 +3368,12 @@
   arglist)
 
-(defun arm2-constant-for-compare-p (form)
+(defun arm2-constant-for-compare-p (form &optional unboxed)
   (setq form (acode-unwrapped-form form))
   (when (acode-p form)
     (let* ((op (acode-operator form)))
       (if (eql op (%nx1-operator fixnum))
-        (let* ((val (ash (cadr form) arm::fixnumshift)))
+        (let* ((val (if unboxed
+                      (cadr form)
+                      (ash (cadr form) arm::fixnumshift))))
           (if (or (arm::encode-arm-immediate val)
                   (arm::encode-arm-immediate (- val)))
@@ -3440,4 +3452,31 @@
               (multiple-value-bind (ireg jreg) (arm2-two-untargeted-reg-forms seg i arm::arg_y j arm::arg_z)
                 (arm2-compare-registers seg vreg xfer ireg jreg cr-bit true-p)))))))))
+
+(defun arm2-natural-compare (seg vreg xfer i j cr-bit true-p)
+  (with-arm-local-vinsn-macros (seg vreg xfer)
+    (let* ((jconst (arm2-constant-for-compare-p j t))
+           (iconst (arm2-constant-for-compare-p i t))
+           (boolean (backend-crf-p vreg)))
+          (if (and boolean (or iconst jconst))
+            (let* ((reg (arm2-one-untargeted-reg-form seg (if jconst i j) ($ arm::imm0 :mode :u32))))
+              (! compare-immediate vreg reg (or jconst iconst))
+              (unless (or jconst (eq cr-bit arm::arm-cond-eq))
+                (setq cr-bit (arm2-cr-bit-for-reversed-comparison cr-bit)))
+              (^ cr-bit true-p))
+            (if (and (eq cr-bit arm::arm-cond-eq) 
+                     (or jconst iconst))
+              (arm2-test-reg-%izerop 
+               seg 
+               vreg 
+               xfer 
+               (arm2-one-untargeted-reg-form 
+                seg 
+                (if jconst i j) 
+                ($ arm::imm0 :mode :u32))
+               cr-bit 
+               true-p 
+               (or jconst iconst))
+              (multiple-value-bind (ireg jreg) (arm2-two-untargeted-reg-forms seg i ($ arm::imm0 :mode :u32)  j ($ arm::imm1 :mode :u32))
+                (arm2-compare-registers seg vreg xfer ireg jreg cr-bit true-p)))))))
 
 
@@ -3889,5 +3928,11 @@
               (progn
                 (nx-set-var-bits var (%ilogior (%ilsl $vbitpunted 1) bits))
-                (nx2-replace-var-refs var puntval)
+                (let* ((type (var-inittype var)))
+                  (if (and type (not (eq t type)))
+                    (nx2-replace-var-refs var
+                                          (make-acode (%nx1-operator typed-form)
+                                                      type
+                                                      puntval))
+                    (nx2-replace-var-refs var puntval)))
                 (arm2-set-var-ea seg var puntval))
               (progn
@@ -6014,4 +6059,5 @@
     (arm2-compare seg vreg xfer form1 form2 cr-bit true-p)))
 
+
 (defarm2 arm2-numcmp numcmp (seg vreg xfer cc form1 form2)
   (or (acode-optimize-numcmp seg vreg xfer cc form1 form2 *arm2-trust-declarations*)
@@ -7080,5 +7126,5 @@
   (multiple-value-bind (cr-bit true-p) (acode-condition-to-arm-cr-bit cc)
     (setq cr-bit (arm-cr-bit-to-arm-unsigned-cr-bit cr-bit))
-    (arm2-compare seg vreg xfer form1 form2 cr-bit true-p)))
+    (arm2-natural-compare seg vreg xfer form1 form2 cr-bit true-p)))
 
 (defarm2 arm2-double-float-compare double-float-compare (seg vreg xfer cc form1 form2)
Index: /trunk/source/compiler/PPC/ppc2.lisp
===================================================================
--- /trunk/source/compiler/PPC/ppc2.lisp	(revision 14981)
+++ /trunk/source/compiler/PPC/ppc2.lisp	(revision 14982)
@@ -2201,5 +2201,5 @@
   (when (and rest (not key-p) (not (cadr auxen)) rest-values)
     (when (eq (logand (the fixnum (nx-var-bits rest))
-                      (logior $vsetqmask (ash -1 $vbitspecial)
+                      (logior (ash -1 $vbitspecial)
                               (ash 1 $vbitclosed) (ash 1 $vbitsetq) (ash 1 $vbitcloseddownward)))
               0)               ; Nothing but simple references
Index: /trunk/source/compiler/X86/x862.lisp
===================================================================
--- /trunk/source/compiler/X86/x862.lisp	(revision 14981)
+++ /trunk/source/compiler/X86/x862.lisp	(revision 14982)
@@ -2724,5 +2724,5 @@
   (when (and rest (not key-p) (not (cadr auxen)) rest-values)
     (when (eq (logand (the fixnum (nx-var-bits rest))
-                      (logior $vsetqmask (ash -1 $vbitspecial)
+                      (logior (ash -1 $vbitspecial)
                               (ash 1 $vbitclosed) (ash 1 $vbitsetq) (ash 1 $vbitcloseddownward)))
               0)               ; Nothing but simple references
Index: /trunk/source/compiler/backend.lisp
===================================================================
--- /trunk/source/compiler/backend.lisp	(revision 14981)
+++ /trunk/source/compiler/backend.lisp	(revision 14982)
@@ -151,4 +151,8 @@
        (= (get-regspec-mode reg) hard-reg-class-gpr-mode-node)))
 
+(defun imm-reg-p (reg)
+  (and (= (hard-regspec-class reg) hard-reg-class-gpr)
+       (/= (get-regspec-mode reg) hard-reg-class-gpr-mode-node))) 
+
 (defun node-reg-value (reg)
   (if (node-reg-p reg)
Index: /trunk/source/compiler/nx-basic.lisp
===================================================================
--- /trunk/source/compiler/nx-basic.lisp	(revision 14981)
+++ /trunk/source/compiler/nx-basic.lisp	(revision 14982)
@@ -512,5 +512,5 @@
  
 (defun nx-cons-var (name &optional (bits 0))
-  (%istruct 'var name bits nil nil nil nil 0 nil nil))
+  (%istruct 'var name bits nil nil nil nil 0 nil nil 0 0 nil))
 
 
Index: /trunk/source/compiler/nx0.lisp
===================================================================
--- /trunk/source/compiler/nx0.lisp	(revision 14981)
+++ /trunk/source/compiler/nx0.lisp	(revision 14982)
@@ -491,5 +491,5 @@
                                              (punted (logbitp $vbitpunted bits)))
                                         (if (or punted
-                                                (eql 0 (%ilogand $vsetqmask bits)))
+                                                (eql 0 (nx-var-root-nsetqs var)))
                                           (var-inittype var)))))
                                   (if (or (eq op (%nx1-operator %aref1))
@@ -1007,5 +1007,5 @@
         (or ignored ignoreunused 
             (progn (and (consp expansion) (eq (car expansion) :symbol-macro) (setq sym (list :symbol-macro sym))) (nx1-whine :unused sym)))
-        (when (%izerop (%ilogand bits (%ilogior $vrefmask $vsetqmask)))
+        (when (eql 0 (logior (nx-var-root-nrefs var) (nx-var-root-nsetqs var)))
           (nx-set-var-bits var (%ilogior (%ilsl $vbitignore 1) bits)))))))
 
@@ -1045,4 +1045,5 @@
 ;;; setq'ed, and the old guy wasn't setq'ed in the body, the binding
 ;;; can be punted.
+
 (defun nx1-note-var-binding (var initform)
   (let* ((inittype (nx-acode-form-type initform *nx-lexical-environment*))
@@ -1056,7 +1057,6 @@
         (if (eq op (%nx1-operator lexical-reference))
           (let* ((target (%cadr init))
-                 (setq-count (%ilsr 8 (%ilogand $vsetqmask (nx-var-bits target)))))
-            (unless (eq setq-count (%ilsr 8 $vsetqmask))
-              (cons var (cons setq-count target))))
+                 (setq-count (nx-var-root-nsetqs var)))
+            (cons var (cons setq-count target)))
           (if (and (%ilogbitp $vbitdynamicextent bits)
                    (or (eq op (%nx1-operator closed-function))
@@ -1099,6 +1099,6 @@
                    (%ilogand
                      (%ilogior (%ilsl $vbitsetq 1) (%ilsl $vbitclosed 1))
-                     target-bits))
-               (neq (%ilsr 8 (%ilogand $vsetqmask target-bits)) (cadr pair)))
+                     target-bits))               
+               (neq (nx-var-root-nsetqs target) (cadr pair)))
              (push (cons var target) *nx-punted-vars*)))))
 
@@ -1106,5 +1106,5 @@
   (let* ((bits (nx-var-bits var))
          (mask (%ilogior (%ilsl $vbitsetq 1) (ash -1 $vbitspecial) (%ilsl $vbitclosed 1)))
-         (nrefs (%ilogand $vrefmask bits))
+         (nrefs (nx-var-root-nrefs var))
          (val (nx-untyped-form initform))
          (op (if (acode-p val) (acode-operator val))))
@@ -1207,8 +1207,4 @@
           (setf (lexenv.lambda (setq result (new-lexical-environment result))) fn))))))
 
-(defun nx-root-var (v)
-  (do* ((v v bits)
-        (bits (var-bits v) (var-bits v)))
-       ((fixnump bits) v)))
 
 (defun nx-reconcile-inherited-vars (more)
@@ -1345,29 +1341,27 @@
       (declare (fixnum varbits boundtobits))
       (unless (eq (%ilogior
+                   (%ilsl $vbitsetq 1)
+                   (%ilsl $vbitclosed 1))
+                  (%ilogand
+                   (%ilogior
                     (%ilsl $vbitsetq 1)
                     (%ilsl $vbitclosed 1))
-                  (%ilogand
-                    (%ilogior
-                      (%ilsl $vbitsetq 1)
-                      (%ilsl $vbitclosed 1))
-                    boundtobits))
+                   boundtobits))
         ;; Can't happen -
         (unless (%izerop (%ilogand (%ilogior
-                                     (%ilsl $vbitsetq 1) 
-                                     (ash -1 $vbitspecial)
-                                     (%ilsl $vbitclosed 1)) varbits))
+                                    (%ilsl $vbitsetq 1) 
+                                    (ash -1 $vbitspecial)
+                                    (%ilsl $vbitclosed 1)) varbits))
           (error "Bug-o-rama - \"punted\" var had bogus bits. ~
 Or something. Right? ~s ~s" var varbits))
-        (let* ((varcount     (%ilogand $vrefmask varbits)) 
-               (boundtocount (%ilogand $vrefmask boundtobits)))
+        (let* ((varcount     (nx-var-root-nrefs var))
+               (boundtocount (nx-var-root-nrefs boundto)))
           (nx-set-var-bits var (%ilogior
-                                 (%ilsl $vbitpuntable 1)
-                                 (%i- varbits varcount)))
-          (setf (var-refs var) (+ (var-refs var) (var-refs boundto)))
-          (nx-set-var-bits
-           boundto
-           (%i+ (%i- boundtobits boundtocount)
-                (%ilogand $vrefmask
-                          (%i+ (%i- boundtocount 1) varcount)))))))))
+                                (%ilsl $vbitpuntable 1)
+                                varbits))
+          (setf (var-refs var) 0
+                (var-refs boundto) (+ (var-refs var) (var-refs boundto)))
+          (nx-set-var-root-nrefs boundto
+                                 (+ (1- boundtocount) varcount)))))))
 
 ;;; Home-baked handler-case replacement.  About 10 times as fast as full handler-case.
@@ -2631,4 +2625,9 @@
 
 
+(defun nx-root-var (var)
+  (do* ((var var bits)
+        (bits (var-bits var) (var-bits var)))
+       ((typep bits 'fixnum) var)))
+
 (defun nx-var-bits (var)
   (do* ((var var bits)
@@ -2641,4 +2640,25 @@
        ((fixnump bits) (setf (var-bits var) newbits))))
 
+(defun nx-var-root-nrefs (var)
+  (do* ((var var bits)
+        (bits (var-bits var) (var-bits var)))
+       ((fixnump bits) (var-root-nrefs var))))
+
+
+(defun nx-set-var-root-nrefs (var new)
+  (do* ((var var bits)
+        (bits (var-bits var) (var-bits var)))
+       ((fixnump bits) (setf (var-root-nrefs var) new))))
+
+(defun nx-var-root-nsetqs (var)
+  (do* ((var var bits)
+        (bits (var-bits var) (var-bits var)))
+       ((fixnump bits) (var-root-nsetqs var))))
+
+(defun nx-set-var-root-nsetqs (var new)
+  (do* ((var var bits)
+        (bits (var-bits var) (var-bits var)))
+       ((fixnump bits) (setf (var-root-nsetqs var) new))))
+
 (defun nx-make-lexical-reference (var)
   (let* ((ref (make-acode (%nx1-operator lexical-reference) var)))
@@ -2650,7 +2670,7 @@
          (temp-p (%ilogbitp $vbittemporary bits))
          (by (if temp-p 1 (expt  4 *nx-loop-nesting-level*)))
-         (new (%imin (%i+ (%ilogand2 $vrefmask bits) by) 255)))
-    (setf (var-refs var) (+ (var-refs var) by))
-    (nx-set-var-bits var (%ilogior (%ilogand (%ilognot $vrefmask) bits) new))
+         (new (+ (var-refs var) by)))
+    (setf (var-refs var) new)
+    (nx-set-var-root-nrefs var (+ (nx-var-root-nrefs var) 1))
     new))
 
Index: /trunk/source/compiler/nx1.lisp
===================================================================
--- /trunk/source/compiler/nx1.lisp	(revision 14981)
+++ /trunk/source/compiler/nx1.lisp	(revision 14982)
@@ -1601,5 +1601,5 @@
     (let ((tagbits (nx-var-bits tagvar)))
       (if (not (%ilogbitp $vbitclosed tagbits))
-        (if (neq 0 (%ilogand $vrefmask tagbits))
+        (if (neq 0 (nx-var-root-nrefs tagvar))
           (make-acode 
            (%nx1-operator local-block)
@@ -2195,10 +2195,11 @@
                 (let ((old-bits (nx-var-bits var)))
                   (push (nx1-form `(the ,type ,sym)) typechecks)
-                  (when (%izerop (%ilogand2 old-bits
-                                            (%ilogior (%ilsl $vbitspecial 1)
-                                                      (%ilsl $vbitreffed 1)
-                                                      (%ilsl $vbitclosed 1)
-                                                      $vrefmask
-                                                      $vsetqmask)))
+                  (when (%izerop (logior
+                                  (%ilogand2 old-bits
+                                             (%ilogior (%ilsl $vbitspecial 1)
+                                                       (%ilsl $vbitreffed 1)
+                                                       (%ilsl $vbitclosed 1)))
+                                  (nx-var-root-nrefs var)
+                                  (nx-var-root-nsetqs var)))
                     (nx-set-var-bits var (%ilogand2 (nx-var-bits var)
                                                     (%ilognot (%ilsl $vbitignore 1))))))))))))))
Index: /trunk/source/compiler/nxenv.lisp
===================================================================
--- /trunk/source/compiler/nxenv.lisp	(revision 14981)
+++ /trunk/source/compiler/nxenv.lisp	(revision 14982)
@@ -42,4 +42,7 @@
   var-nvr
   var-declared-unboxed-type             ; NIL or float or natural-integer type
+  var-root-nrefs                        ; reference count of "root" var
+  var-root-nsetqs                       ; setq count of root var
+  var-initform                          ; initial value acode or NIL.
 )
 
@@ -59,6 +62,4 @@
 (defconstant $vbitreffed 27)
 (defconstant $vbitspecial 28)
-(defconstant $vsetqmask #xff00)
-(defconstant $vrefmask #xff)
 
 (defconstant $decl_optimize (%ilsl 16 0))  ; today's chuckle
@@ -561,10 +562,10 @@
 (defun nx-adjust-setq-count (var &optional (by 1) catchp)
   (let* ((bits (nx-var-bits var))
+         (nsetqs (nx-var-root-nsetqs var))
          (scaled-by (if (%ilogbitp $vbittemporary bits)
                       by
                       (expt 4 *nx-loop-nesting-level*)))
-         (new (%i+ (%ilsr 8 (%ilogand2 $vsetqmask bits)) scaled-by)))
-    (if (%i> new 255) (setq new 255))
-    (setq bits (nx-set-var-bits var (%ilogior (%ilogand (%ilognot $vsetqmask) bits) (%ilsl 8 new))))
+         (new (%i+ nsetqs scaled-by)))
+    (nx-set-var-root-nsetqs var (1+ nsetqs))
     ;; If a variable is setq'ed from a catch nested within the construct that
     ;; bound it, it can't be allocated to a register. *
@@ -575,5 +576,5 @@
     (when catchp
       (nx-set-var-bits var (%ilogior2 bits (%ilsl $vbitnoreg 1))))
-    (setf (var-refs var) (+ (the fixnum (var-refs var)) scaled-by))
+    (setf (var-refs var) new)
     new))