Changeset 9506


Ignore:
Timestamp:
May 16, 2008, 12:54:02 AM (11 years ago)
Author:
gb
Message:

Move the real FIND-CLASS-CELL here. ISTRUCTs now store an interned
("registersd") pair of (class-name.wrapper) in their first element
(rather than just the class-name); interact with support for that in
xloader/fasloader and compile-file.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711-perf/ccl/level-0/l0-pred.lisp

    r9436 r9506  
    2626  (cons type nil))
    2727
    28 (defun find-class-cell (type create?)
    29   (declare (ignore create?))
    30   (make-class-cell type))
    3128
    3229(defun builtin-typep (form cell)
     
    374371        (if (= x-type y-type)
    375372            (if (= x-type target::subtag-istruct)
    376                 (and (let* ((structname (%svref x 0)))
    377                        (and (eq structname (%svref y 0))
     373                (and (let* ((structname (istruct-cell-name (%svref x 0))))
     374                       (and (eq structname (istruct-cell-name (%svref y 0)))
    378375                            (or (eq structname 'pathname)
    379376                                (eq structname 'logical-pathname)))
     
    882879  (= (the fixnum (typecode form)) target::subtag-istruct))
    883880
     881
     882;;; Not to be conused with STRUCTURE-TYPE-P, defined in ccl:lib;pprint.lisp.
    884883(defun structure-typep (thing type)
    885884  (if (= (the fixnum (typecode thing)) target::subtag-struct)
    886     (if (memq type (%svref thing 0))
    887       t)))
     885    (let* ((types (%svref thing 0)))
     886      (if (typep type 'symbol)
     887        (dolist (x types)
     888          (when (eq (class-cell-name x) type)
     889            (return t)))
     890        (dolist (x types)
     891          (when (eq x type)
     892            (return t)))))))
     893
     894
    888895
    889896
    890897(defun istruct-typep (thing type)
    891898  (if (= (the fixnum (typecode thing)) target::subtag-istruct)
    892     (eq (%svref thing 0) type)))
     899    (eq (istruct-cell-name (%svref thing 0)) type)))
     900
     901(defun istruct-type-name (thing)
     902  (if (= (the fixnum (typecode thing)) target::subtag-istruct)
     903    (istruct-cell-name (%svref thing 0))))
     904
     905
     906;;; This is actually set to an alist in the xloader.
     907(defparameter *istruct-cells* nil)
     908
     909;;; This should only ever push anything on the list in the cold
     910;;; load (e.g., when running single-threaded.)
     911(defun register-istruct-cell (name)
     912  (or (assq name *istruct-cells*)
     913      (let* ((pair (cons name nil)))
     914        (push pair *istruct-cells*)
     915        pair)))
     916
     917(defun set-istruct-cell-info (cell info)
     918  (etypecase cell
     919    (cons (%rplacd cell info)))
     920  info)
     921
     922
    893923
    894924(defun symbolp (thing)
     
    937967        (setf (gethash specifier *type-cells*)
    938968              (make-type-cell specifier)))))
     969
     970
     971(defvar %find-classes% nil)
     972
     973(setq %find-classes% (make-hash-table :test 'eq))
     974
     975
     976(defun find-class-cell (name create?)
     977  (unless %find-classes%
     978    (dbg name))
     979  (let ((cell (gethash name %find-classes%)))
     980    (or cell
     981        (and create?
     982             (setf (gethash name %find-classes%) (make-class-cell name))))))
     983
Note: See TracChangeset for help on using the changeset viewer.