[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Compiling a CLOS application



I would like to have something similar to compile-flavor-methods for my CLOS
application in Genera 8.1 on a 3653.  It didn't have to compile everything at
compile time.  I just need a function that I can call before I demonstrate my
application so that it runs fast right away and doesn't compile something
first.  

I have already started writing such a function but I hope that more can be
done for speeding up things.  Currently, my function compiles constructors for
classes and finds selectors for generic functions by calling these functions
with wrong arguments.  But I still don't know how to avoid messages such as:
   
  compiling #<clos-internals::miscellaneous-function standard ...>

Any help will be appreciated.

Andreas Girgensohn
andreasg@cs.colorado.edu

-------------------------------------------------------------------------------
(defmethod check-constructor ((class standard-class))
  (with-slots (clos-internals::bits) class
    (unless (clos-internals:class-finalized-p class)
      (clos-internals::finalize-inheritance class))
    (unless (ldb-test clos-internals::%%standard-class-slow-make-instance-p
                      clos-internals::bits)
      (setf (ldb clos-internals::%%standard-class-slow-make-instance-p
		 clos-internals::bits)
	    1)
      (when (clos-internals::compute-keyword-constructor-method-using-class class)
        (setf (ldb clos-internals::%%standard-class-slow-make-instance-p
		   clos-internals::bits)
              0)))))

(defun check-all-clos-symbols (&optional (pkg (find-package "JC")))
  (let ((miss-function #'clos-internals::handle-start-dispatch-miss))
    (do-symbols (sym pkg)
      (let ((class (find-class sym nil)))
	(when (and class (typep class 'standard-class))
	  (check-constructor class)))
      (let ((function (and (fboundp sym) (symbol-function sym))))
	(when (and (typep function 'standard-generic-function)
		   (eq (clos-internals::%funcallable-instance-function function)
		       miss-function))
	  (scl:ignore-errors
	    (funcall function nil)))))))