patch for MACL

[BALL%YALEMED.BITNET@CUNYVM.CUNY.EDU]

I don't know anything about Macintosh Allegro Common Lisp, but
I have a suggestion.  Try moving the definition of print-uvector-object
in fin.lisp into the eval-when that follows, so that print-uvector-object
will be defined at compile-time too.

Richard Harris

Thanks, this patch for fin.lisp on arisia in /pcl/tarfile-rev-3 seems toe-rev-3
seems toe-rev-3 l Lisp
;;;
#+:coral
(progn

(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
         ccl::$v_istruct
         'ccl::funcallable-instance
         #'(lambda (&rest ignore)
             (declare (ignore ignore))
             (called-fin-without-function))
         ccl::initial-fin-slots))

;;; Make uvector-based objects (like funcallable instances) print better.
#+:ccl-1.3

;;; Inform the print system about funcallable instance uvectors.
#+:ccl-1.3
(eval-when (eval compile load)
  (defun print-uvector-object (obj stream &optional print-level)
    (declare (ignore print-level))
    (print-object obj stream))
  (pushnew (cons 'ccl::funcallable-instance #'print-uvector-object)
           ccl:*write-uvector-alist*
           :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)
                   ccl::FIN-data)))

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

); End of #+:coral

Thanks again, Sheldon Ball