[Openmcl-cvs-notifications] r11384 - in /trunk/source/compiler: nx0.lisp nxenv.lisp

[gb at clozure.com]

Author: gb
Date: Mon Nov 17 08:05:15 2008
New Revision: 11384

Log:
When incrementing/propagating a variable's assignment/reference
counts, increment the VAR-REFS slot as well.  (Separate instances of
inherited lexical variables are represented as separate per-function
VARs in which the child references the parent via the VAR-BITS slot
and information about "the variable as a whole, in all functions that
reference/set it" is maintained in the parent's VAR-BITS.  Keeping
reference-count info per function (and not sharing structure so much)
should give us a clearer idea of which inherited variables are good
candidates for register allocation.  (Until now, we've tended to
overestimate the number of times a variable's referenced in the
parent, since the shared ref info includes references from inner
functions, and have avoided NVR allocation in the child (because
that has updated shared info and confused things in the parent.)


Modified:
    trunk/source/compiler/nx0.lisp
    trunk/source/compiler/nxenv.lisp

Modified: trunk/source/compiler/nx0.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/nx0.lisp (original)
+++ trunk/source/compiler/nx0.lisp Mon Nov 17 08:05:15 2008
@@ -1280,16 +1280,17 @@
           (nx-set-var-bits var (%ilogior
                                  (%ilsl $vbitpuntable 1)
                                  (%i- varbits varcount)))
-              (nx-set-var-bits
-               boundto
-                 (%i+ (%i- boundtobits boundtocount)
-                      (%ilogand $vrefmask
-                                (%i+ (%i- boundtocount 1) varcount)))))))))
-
-;; Home-baked handler-case replacement.  About 10 times as fast as full ha=
ndler-case.
-;;(LET ((S 0)) (DOTIMES (I 1000000) (INCF S))) took 45,678 microseconds
-;;(LET ((S 0)) (DOTIMES (I 1000000) (BLOCK X (ERROR (CATCH 'X (RETURN-FROM=
 X (INCF S))))))) took 57,485
-;;(LET ((S 0)) (DOTIMES (I 1000000) (HANDLER-CASE (INCF S) (ERROR (C) C)))=
) took 168,947
+          (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)))))))))
+
+;;; Home-baked handler-case replacement.  About 10 times as fast as full h=
andler-case.
+;;;(LET ((S 0)) (DOTIMES (I 1000000) (INCF S))) took 45,678 microseconds
+;;;(LET ((S 0)) (DOTIMES (I 1000000) (BLOCK X (ERROR (CATCH 'X (RETURN-FRO=
M X (INCF S))))))) took 57,485
+;;;(LET ((S 0)) (DOTIMES (I 1000000) (HANDLER-CASE (INCF S) (ERROR (C) C))=
)) took 168,947
 (defmacro with-program-error-handler (handler &body body)
   (let ((tag (gensym)))
     `(block ,tag
@@ -2344,6 +2345,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) ne=
w))
     new))
 =


Modified: trunk/source/compiler/nxenv.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/nxenv.lisp (original)
+++ trunk/source/compiler/nxenv.lisp Mon Nov 17 08:05:15 2008
@@ -563,14 +563,15 @@
          (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 $vsetqma=
sk) bits) (%ilsl 8 new))))
-; If a variable is setq'ed from a catch nested within the construct that
-; bound it, it can't be allocated to a register. *
-; * unless it can be proved that the variable isn't referenced
-;   after that catch construct has been exited. **
-; ** or unless the saved value of the register in the catch frame =

-;    is also updated.
+    ;; If a variable is setq'ed from a catch nested within the construct t=
hat
+    ;; bound it, it can't be allocated to a register. *
+    ;; * unless it can be proved that the variable isn't referenced
+    ;;   after that catch construct has been exited. **
+    ;; ** or unless the saved value of the register in the catch frame =

+    ;;    is also updated.
     (when catchp
       (nx-set-var-bits var (%ilogior2 bits (%ilsl $vbitnoreg 1))))
+    (setf (var-refs var) (+ (the fixnum (var-refs var)) by))
     new))
 =

 =