;;;
;;; known-oops.lisp
;;;
;;; Known OOPs.
;;;

(cl:in-package :speakeasy)

;;; Guaranteed pointers (from the blue book)
;;
;; Some of these are only used in primitive activation, particularly
;; for the UI methods.
;;
;; 0: ???
;; 2: nil
;; 4: False
;; 6: True
;; 8: SchedulerAssociation (the Association in Smalltalk for Processor)
;; 10: ???
;; 12: ???
;; 14: ClassString
;; 16: ClassArray
;; 18: ???
;; 20: ???
;; 22: ClassMethodContext
;; 24: ClassBlockContext
;; 26: ClassPoint
;; 28: ClassLargePositiveInteger
;; 30: ???
;; 32: ClassMessage
;; 34: ???
;; 36: ???
;; 38: ???
;; 40: ClassCharacter
;; 42: #doesNotUnderstand:
;; 44: #cannotReturn:
;; 46: ???
;; 48: SpecialSelectors
;; 50: CharacterTable
;; 52: #mustBeBoolean
;;
;; As we are not expecting true ST-80 image compatability, we don't
;; need to treat this as more than a guideline.  Additionally, since
;; we're bootstrapping our own image, we can use variables instead of
;; constants for these values, and just populate them as they are
;; defined.

;; "Known" OOPs need placeholder values until their objects have
;; actually been defined.  In some cases, we arrange for them to be
;; defined before use, in others, we backpatch (such as for known
;; classes, as that's an easy fixup).  We will be attempting to avoid
;; backpatching non-class fields, as doing a full image search for a
;; given OOP is more code to write and would of necessity be slower
;; than scanning the class fields of the object table.

(defvar +smalltalk-oop+)
(defvar +nil-oop+)
(defvar +false-oop+)
(defvar +true-oop+)
(defvar +does-not-understand-oop+)
(defvar +cannot-return-oop+)
(defvar +must-be-boolean-oop+)
(defvar +character-table-oop+)

(defvar +array-class-oop+ 'array)
(defvar +symbol-class-oop+ 'symbol)
(defvar +string-class-oop+ 'string) ;; For compiler support (intern-literal).
(defvar +association-class-oop+ 'association)
(defvar +identity-dictionary-class-oop+ 'identity-dictionary)
(defvar +dictionary-class-oop+ 'dictionary)
(defvar +character-class-oop+ 'character)
(defvar +metaclass-class-oop+ 'metaclass)
(defvar +compiled-method-class-oop+ 'compiled-method)

(defun reset-known-oops ()
  (makunbound '+smalltalk-oop+)
  (makunbound '+nil-oop+)
  (makunbound '+false-oop+)
  (makunbound '+true-oop+)
  (makunbound '+does-not-understand-oop+)
  (makunbound '+cannot-return-oop+)
  (makunbound '+must-be-boolean-oop+)
  (makunbound '+character-table-oop+)

  (setf +array-class-oop+ 'array)
  (setf +symbol-class-oop+ 'symbol)
  (setf +string-class-oop+ 'string)
  (setf +association-class-oop+ 'association)
  (setf +identity-dictionary-class-oop+ 'identity-dictionary)
  (setf +dictionary-class-oop+ 'dictionary)
  (setf +character-class-oop+ 'character)
  (setf +metaclass-class-oop+ 'metaclass)
  (setf +compiled-method-class-oop+ 'compiled-method)
  )

;;; EOF
