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

PCL and MCL2?

Though MCL2 has a native CLOS implementation, there is no support for any
Metaobject Protocol yet. So, I tried to compile the May Day PCL (Rev 4) 
Version from Xerox PARC. Not surprisingly the coral-specific code has to
be adapted to the new MCL2. I managed to fix the walker part 
(lexical environments etc.). But, however, I do not see any possibility
to update the funcallable-instance part.

Here is a clipping of the relevant part of the file "fin.lisp" of the
PCL distribution.

(in-package :pcl)

(defconstant funcallable-instance-data
             '(wrapper slots)
  "These are the 'data-slots' which funcallable instances have so that
   the meta-class funcallable-standard-class can store class, and static
   slots in them.")

(defmacro funcallable-instance-data-position (data)
  (if (and (consp data)
           (eq (car data) 'quote)
           (boundp 'funcallable-instance-data))
      (or (position (cadr data) funcallable-instance-data :test #'eq)
            (warn "Unknown funcallable-instance data: ~S." (cadr data))
            `(error "Unknown funcallable-instance data: ~S." ',(cadr data))))
      `(position ,data funcallable-instance-data :test #'eq)))

(defun called-fin-without-function ()
  (error "Attempt to funcall a funcallable-instance without first~%~
          setting its funcallable-instance-function."))

;;; Stuff deleted...

(defconstant ccl::$v_istruct 22)
(defvar ccl::initial-fin-slots (make-list (length funcallable-instance-data)))
(defconstant ccl::fin-function 1)
(defconstant ccl::fin-data (+ ccl::FIN-function 1))

(defun allocate-funcallable-instance-1 ()
  (apply #'ccl::%gvector 
         #'(lambda (&rest ignore)
             (declare (ignore ignore))

(eval-when (eval compile load)

;;; Make uvector-based objects (like funcallable instances) print better.
(defun print-uvector-object (obj stream &optional print-level)
  (declare (ignore print-level))
  (print-object obj stream))

;;; Inform the print system about funcallable instance uvectors.
(pushnew (cons 'ccl::funcallable-instance #'print-uvector-object)
	 :test #'equal)


(defun funcallable-instance-p (x)
  (and (eq (ccl::%type-of x) 'ccl::internal-structure)
       (eq (ccl::%uvref x 0) 'ccl::funcallable-instance)))

(defun set-funcallable-instance-function (fin new-value)
  (unless (funcallable-instance-p fin)
    (error "~S is not a funcallable-instance." fin))
  (unless (functionp new-value)
    (error "~S is not a function." new-value))
  (ccl::%uvset fin ccl::FIN-function new-value))

(defmacro funcallable-instance-data-1 (fin data-name)
  `(ccl::%uvref ,fin 
                (+ (funcallable-instance-data-position ,data-name)

(defsetf funcallable-instance-data-1 (fin data) (new-value)
  `(ccl::%uvset ,fin 
                (+ (funcallable-instance-data-position ,data) ccl::FIN-data)

); End of #+:coral


Probably ccl::%uvref and ccl::%uvset are ccl::uvref and ccl::uvset in
MCL2.  The constant ccl::$v_istruct should be 44 in MCL2, I suppose, but
this does not help. The instances returned by
allocate-funcallable-instance-1 are no longer funcallable. They cannot
even be supplied as a function definition via (setf symbol-function).
BTW type-of returns #<STANDARD-CLASS FUNCALLABLE-INSTANCE> when applied
to such a fin. That`s all I found out.

To go ahead, I need some help... How can funcallable-instances be
represented in MCL2? Notice that fins should have two additional slots
("wrapper" and "slots"). I'm not sure whether there is an Apple MCL
wizard who has enough time to fix this. But, maybe there are several
"old applications" that use the AMOP of PCL...


Ralf Moeller
University of Hamburg
Bodenstedtstr. 16
2000 Hamburg 50

Phone: ++40 4123 6134
Fax ++40 4123 6530
Email: moeller@informatik.uni-hamburg.de