[Openmcl-devel] I want to make this change but I want to run it by everyone first

[alex crain]

(Particularly Gary and Randal
This goes back to a discussion that Dan Knapp and I had on the board in 
january.

The problem:

Given that there is a class that has both lisp and foreign slots,
if that class is instantiated on the AppKit side of things,
AppKit will allocate the class but won't invoke MAKE-INSTANCE because
AppKit knows nothing about the lisp class system.

For example: I have IDE-EDITOR-DOCUMENT which is a subclass of 
NSDocument.
If I do

  (let ((controller (send (@class ns:ns-document-controller) 
'shared-document-controller)))
     (send controller
	  :perform-selector-on-main-thread (@selector "newDocument:")
	  :with-object (%null-ptr)
	  :wait-until-done t))

Then the AppKit side of things will correctly look into Info.plist and 
decide that I want
to create and IDE-EDITOR-DOCUMENT, create the object and starting 
invoking
methods on it, like makeWindowControllers. If I have a lisp method 
defined, it is
called with the object but since the object was created on the AppKit 
side,
INITIALIZE-INSTANCE was never called and none of the slot vectors exist 
yet.

This problem manifests itself whenever a class is instantiated on the 
AppKit side - nib files, documents, etc.

I made the following change and it works, but I'm not convinced it's 
the best way.
I added a check so that if we can't find a slot vector then we try to 
explicitly create it
and if that works then we go ahead and call INITIALIZE-INSTANCE to 
finish the job.
If we can't explicitly create the slot, then we're confused and we die 
appropriately.

I'll commit it if no one has a problem with it.

(defun %objc-domain-slots-vector (p)
        (let* ((type (%macptr-type p))
              (flags (ldb objc-type-flags type))
              (index (ldb objc-type-index type)))
         (declare (fixnum type flags index))
         (ecase flags
           (#.objc-flag-instance (or (gethash p 
*objc-object-slot-vectors*)
                                     ; try to allocate the slot vector 
on demand
                                     (let* ((raw-ptr 
(raw-macptr-for-instance p))
                                            (slot-vector 
(create-foreign-instance-slot-vector (class-of
p))))
                                       (when slot-vector
                                         (setf (slot-vector.instance 
slot-vector) raw-ptr)
                                         (setf (gethash raw-ptr 
*objc-object-slot-vectors*) slot-vector)
                                         
(register-canonical-objc-instance p raw-ptr)
                                         (initialize-instance p))
                                       slot-vector)
                                     (error "~s has no slots." p)))
           (#.objc-flag-class (id->objc-class-slots-vector index))
           (#.objc-flag-metaclass (id->objc-metaclass-slots-vector 
index)))))