[Openmcl-cvs-notifications] r10282 - in /trunk/source: level-0/l0-pred.lisp level-0/nfasload.lisp lib/nfcomp.lisp xdump/faslenv.lisp

[gb at clozure.com]

Author: gb
Date: Sun Aug  3 23:33:13 2008
New Revision: 10282

Log:
Early changes to support "istruct cells", which can speed up type/class
operations on istructs.

Some of this is hard to bootstrap, and bootstrapping may involve slowing
things down (e.g., not inlining things) while representations change.

Binaries coming soon.

Modified:
    trunk/source/level-0/l0-pred.lisp
    trunk/source/level-0/nfasload.lisp
    trunk/source/lib/nfcomp.lisp
    trunk/source/xdump/faslenv.lisp

Modified: trunk/source/level-0/l0-pred.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/level-0/l0-pred.lisp (original)
+++ trunk/source/level-0/l0-pred.lisp Sun Aug  3 23:33:13 2008
@@ -1009,7 +1009,33 @@
 =

 (defun istruct-typep (thing type)
   (if (=3D (the fixnum (typecode thing)) target::subtag-istruct)
+    (let* ((cell (%svref thing 0)))
+      (eq (if (atom cell) cell (car cell))
+          (if (atom type) type (car type))))
+    #+istruct-bootstrap
     (eq (%svref thing 0) type)))
+
+(defun istruct-type-name (thing)
+  (if (=3D (the fixnum (typecode thing)) target::subtag-istruct)
+    (istruct-cell-name (%svref thing 0))))
+
+
+;;; This is actually set to an alist in the xloader.
+(defparameter *istruct-cells* nil)
+
+;;; This should only ever push anything on the list in the cold
+;;; load (e.g., when running single-threaded.)
+(defun register-istruct-cell (name)
+  (or (assq name *istruct-cells*)
+      (let* ((pair (cons name nil)))
+        (push pair *istruct-cells*)
+        pair)))
+
+(defun set-istruct-cell-info (cell info)
+  (etypecase cell
+    (cons (%rplacd cell info)))
+  info)
+
 =

 (defun symbolp (thing)
   "Return true if OBJECT is a SYMBOL, and NIL otherwise."

Modified: trunk/source/level-0/nfasload.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/level-0/nfasload.lisp (original)
+++ trunk/source/level-0/nfasload.lisp Sun Aug  3 23:33:13 2008
@@ -686,6 +686,8 @@
 (deffaslop $fasl-provide (s)
   (provide (%fasl-expr s)))    =

 =

+(deffaslop $fasl-istruct-cell (s)
+  (%epushval s (register-istruct-cell (%fasl-expr-preserve-epush s))))
 =

 ;;; The loader itself
 =


Modified: trunk/source/lib/nfcomp.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/lib/nfcomp.lisp (original)
+++ trunk/source/lib/nfcomp.lisp Sun Aug  3 23:33:13 2008
@@ -1086,12 +1086,27 @@
            (eql (typecode (%cadr form)) target::subtag-xfunction))
        (null (%cddr form))))
 =

+;;; We currently represent istruct-cells as conses.  That's not
+;;; incredibly efficient (among other things, we have to do this
+;;; check when scanning/dumping any list, but it's probably not
+;;; worth burning a tag on them.  There are currently about 50
+;;; entries on the *istruct-cells* list.
+(defun istruct-cell-p (x)
+  #-bootstrap-istruct (declare (ignore x))
+  #+bootstrap-istruct
+  (and (consp x)
+       (typep (%car x) 'symbol)
+       (atom (%cdr x))
+       (not (null (memq x *istruct-cells*)))))
+
 (defun fasl-scan-list (list)
   (cond ((eq (%car list) cfasl-load-time-eval-sym)
          (let ((form (car (%cdr list))))
            (fasl-scan-form (if (funcall-lfun-p form)
                              (%cadr form)
                              form))))
+        ((istruct-cell-p list)
+         (fasl-scan-form (%car list)))        =

         (t (when list
              (fasl-scan-ref list)
              (fasl-scan-form (%car list))
@@ -1564,6 +1579,9 @@
              (progn
                (fasl-out-byte opcode)
                (fasl-dump-form form)))))
+        ((istruct-cell-p list)
+         (fasl-out-opcode $fasl-istruct-cell (car list))
+         (fasl-dump-symbol (car list)))       =

         (t (fasl-dump-cons list))))
 =

 (defun fasl-dump-cons (cons &aux (end cons) (cdr-len 0))

Modified: trunk/source/xdump/faslenv.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/xdump/faslenv.lisp (original)
+++ trunk/source/xdump/faslenv.lisp Sun Aug  3 23:33:13 2008
@@ -121,6 +121,8 @@
 (defconstant $fasl-nvintern 67)         ;<pkg:expr><nvstring> Make a sym i=
n pkg.
 (defconstant $fasl-nvmksym 68)          ;<nvstring> Make a string
 (defconstant $fasl-nvstr 69)            ;<nvstring> Make an uninterned sym=
bol
+(defconstant $fasl-toplevel-location 70);<expr> - Set *loading-toplevel-lo=
cation* to <expr>
+(defconstant $fasl-istruct-cell 71)     ;<expr> register istruct cell for =
expr
 =

 =

 ;;; <string> means <size><size bytes> (this is no longer used)