;;;
;;; symbols.lisp
;;;
;;; Image symbol access.
;;;

(cl:in-package :speakeasy)

;;;
;;; Symbol access.
;;;

(defvar *symbol-mapping* (make-hash-table :test 'equal))

(defun find-symbol-in-image (name)
  "Look through all Symbols in the system looking for one matching NAME."
  (or (gethash name *symbol-mapping*)
      (dotimes (i #x8000)
	(let ((ob (aref *object-table* i)))
	  (when (and (ote-p ob)
		     (eql (ote-class ob) +symbol-class-oop+)
		     (= (length (ote-data ob)) (ash (1+ (length name)) -1))
		     (eql (ote-odd-length ob) (oddp (length name))))
	    ;; We have an allocated object, that is a symbol, and is the
	    ;; same length as the name.  Now check we the actual data.
	    (loop for j from 0 below (length name)
	       when (/= (obj-byte (ash i 1) j) (char-code (aref name j)))
	       return nil
	       finally (return-from find-symbol-in-image (ash i 1))))))))

(defun create-symbol (name)
  "Create a new Symbol in the system called NAME."
  (let ((oop (allocate-oop)))
    (make-object oop :bytes (length name) +symbol-class-oop+)
    (dotimes (i (length name))
      (setf (obj-byte oop i) (char-code (aref name i))))
    oop))

(defun intern-symbol (name)
  "Find a Symbol for NAME, creating one if necessary."
  (or (gethash name *symbol-mapping*)
      (setf (gethash name *symbol-mapping*)
	    (or (find-symbol-in-image name)
		(create-symbol name)))))

;;; EOF
