anchor.diff:  
         (with-symbols ()
   
  -        (multiple-value-bind (%user-metaclass %params)
  -            (compute-user-metaclass %params) ;; NB: May be unused here
  +        (multiple-value-bind (user-metaclass %params)
  +            (compute-user-metaclass %params)
   
             ;; NB: Using an implcit PROTOTYPE-METACLASS is-a SINGLETON here.
   
             `(progn
  +
  +             ;; FIXME: How much here may need to be wrapped in EVAL-WHEN?
   
                ;; NB: This macro, in effect, prevents any usage of forward
                ;; referenced classes in the SUPERCLASSES list
  
positive.code: ;; implementations.
  
  
  ;; NB: The following forms were in use, as to test the original
  ;; DEFSINGLETON definition -- as has subsequently been removed from the
  ;; source code, in lieu of an updated  DEFSINGLETON*, defined later in
  ;; this source file.
  ;;
  ;; The origingial DEFSINGLETON macro definition was removed in changeset
  ;; d2d9c76740f684a18276207cc149a981e76619a3 - 9 June, 2019 19:01:08-0700
  
negative.code: 
  
  (subtypep (make-instance 'singleton-1-1) 'singleton-1-1)
  ;; => NIL, T ;; not OK
  
  (subtypep (make-instance 'singleton-2-2) 'singleton-1-1)
  ;; => NIL, T ;; not OK
  
  (typep (make-instance 'singleton-2-2) 'singleton-1-1)
  ;; => T
  ;; "It's a start!" ....
  
  
  ;; NB: To produce a suclass C2 of a class C1, such that C2 is both an
  ;; instance typep C1 and a subtype of C1 ...
  ;;
  ;; one may define MAKE-INSTANCE => CREATE-SUBTYPE
  ;; via ALLOCATE-INSTANCE
  ;;
  ;; This, albeit, may seem to pose some difficulty for typing in the
  ;; implementation compiler (??() whether or not that may be singularly
  ;; dependent on any one manner of approach.
  
  )
  
  
  ;; --------------------------------------------------
  
  ;; NB: PCL does not define a slot with a :direct-superclasses initarg
  ;;     but some other MOP implementations may
  
  (macrolet ((find-for (name accessor whence base-class)
               `(block search
                  (dolist (c (reverse (class-precedence-list
                                       (find-class (quote ,base-class)))))
                    (dolist (sl (,whence c))
                      (when (find (quote ,name)
                                  (the list (,accessor sl))
                                  :test #'eq)
                        (return-from search (slot-definition-name sl))))))))
    (defconstant* +direct-superclasses-slot+
        (or (find-for :direct-superclasses
                      slot-definition-initargs
                      class-slots
                      standard-class)
            (find-for class-direct-superclasses
                      slot-definition-readers
                      class-direct-slots
                      standard-class)
            (error "Cannot find direct superclasses slot for ~
  standard-class, in this implementation"))))
  
  
  
  (defmethod change-class :after ((instance forward-referenced-class)
                                  (new prototype-class)
                                  &rest initargs &key &allow-other-keys)
    (let* ((implc (and (slot-boundp instance 'implementation-class)
                       (prototype-implementation-class new)))
           (implc-inst (when implc
                         (compute-class implc nil))))
      (cond
        (implc-inst
         ;; FIXME: OTHERWISE need to defer evaluation !
         #+nil
         (warn "Dispatch from CHANGE-CLASS ~S ~S to initialize ~S"
               instance new implc-inst)
  
         ;; NB: in PCL this may be the only way that the
         ;; direct-supeclasses slot winds up initialized from
         ;; CHANGE-CLASS (??) (FIXME: Evaluate how that's been implemented)
         (shared-initialize implc-inst (list +direct-superclasses-slot+)))
        (t (warn "~<Unable to initilize unreachable ~
  implementation class ~S for ~S~>~< during CHANGE-CLASS ~s ~s~>"
                 implc new
                 instance new)))))
  
  
  (defmethod shared-initialize :after ((instance singleton) slots
                                       &rest initargs &key &allow-other-keys)
    (when (or (eq slots t)
              (and (consp slots)
                   (find +direct-superclasses-slot+ (the cons slots)
                         :test #'eq)))
      (let ((tgt-class (find-class 'singleton))
            (unused-class (find-class 'standard-object))
            (dsup (slot-value instance +direct-superclasses-slot+)))
        (declare (dynamic-extent tgt-class unused-class))
  
        (setq dsup
              (delete unused-class dsup :test #'eq))
  
        (unless (some (lambda (c)
                        (find-class-in-precedence tgt-class c nil))
                      dsup)
          (setq dsup (cons tgt-class dsup)))
  
        #+NIL
        (warn "Frob in SHARED-INITIALIZE for ~S - DSUP ~S" instance dsup)
  
        (setf (slot-value instance +direct-superclasses-slot+)
              dsup))))
  
  
  ;; --------------------------------------------------
  
  (defmethod initialize-instance ((instance singleton)
                                  &rest initargs &key
                                                   direct-superclasses
                                                   &allow-other-keys)
    ;; ensure that any call to MAKE-INSTANCE of a SINGLETON will produce
    ;; an object that is a subtype of the original SINGLETON
    ;;
    ;; [FIXME DNW IN SOME POST-HOC APPLICATIONS - NEEDS FURTHER TESTING]
  
    ;; NB: This may be "Early enough" to catch where PCL is initially
    ;; setting the direct-superclasses list for a class definition.
    ;;
    ;; Note that PCL may be (perhaps cheaply) setting the STANDARD-OBJECT
    ;; class into the list of DIRECT-SUPRECLASSES whenever the
    ;; direct-superclasses list is NIL in the initial DEFCLASS form.
    ;;
    ;; Theoretically. that can be removed during ENSURE-TGT-SUPERCLASS below.
    ;; [FIXME / QA]
  
    (let ((tgt-class (find-class 'singleton))
          (unused-class (find-class 'standard-object))
          initargs-updated)
      (declare (dynamic-extent tgt-class unused-class))
      (macrolet ((dispatch ()
                   `(cond
                      (initargs-updated
                       #+NIL
                       (warn "~<Updated Dispatch for ~S in INITIALIZE-INSTANCE ~>~
  ~< - DIRECT-SUPERCLASSES modified: ~S~>" instance direct-superclasses)
                       (apply #'call-next-method instance initargs))
                      (t (call-next-method)))))
        (labels ((ensure-tgt-superclass ()
                   (cond
                     (direct-superclasses
                      (unless (some (lambda (c)
                                      (find-class-in-precedence tgt-class c nil))
                                    direct-superclasses)
                        (prog1 (setf (getf initargs :direct-superclasses)
                                     (cons tgt-class
                                           (remove unused-class
                                                   direct-superclasses
                                                   :test #'eq)))
                          (setq initargs-updated t))))
                     (t (prog1 (setf (getf initargs :direct-superclasses)
                                     (cons tgt-class
                                           (remove unused-class
                                                   direct-superclasses
                                                   :test #'eq)))
                          (setq initargs-updated t))))))
          ;; NB: This does not ever check the value of SLOTS.
          ;;;
          ;; Such a check would have to be performed in a completely
          ;; implementation-specific regard, in order to detect what the
          ;; assumed DIRECT-SUPERCLASES slot would be named, for any
          ;; instance in which SLOTS would be TYPEP CONS.
          ;;
          ;; This could also, then, dispatch in a portable way singularly
          ;; for the case of (EQ SLOTS T)
          ;;
          ;; In lieu of that, this will modify SLOTS in many
          ;; instances. The modification might subsequently be ignored by
          ;; the next method.
          ;;
          ;; This method, as such, might be left undefined in the top level of
          ;; the containing source file.
          (setq direct-superclasses (ensure-tgt-superclass))
  
          ;; NB: Not useful if the updated value is being ignored
          ;;     by the implementation
  
          (dispatch)))))
  
  
  
  ;; )
  
  (eval-when ()
    ;; FIXME: Not very rigorous tests onto the updated SHARED-INITIALIZE
  
    (defsingleton x-a () ;; FIXME SINGLETON no longer appearing in the X-A CPL
      ())
  
    (typep (make-instance 'x-a) 'x-a)
  