;;; -*- Mode:LISP; Package:GARBAGE-COLLECTOR; Base:10 -*-

(defvar *frob->executor* (make-hash-table))
	(make-array (aref #'sys:system-communication-area sys:%sys-com-number-regions)))

(defun make-executor (frob procedure)
  (when (not (%pointerp frob))
    (ferror nil "Attempt to create an executor for immortal object ~s" frob))
  (without-flipping
    (let ((frob-address   (%pointer    frob))
	  (frob-data-type (%data-type  frob))
	  (frob-code      (object-hash frob)))
      (unless
	(without-interrupts
	  (if (gethash frob-code *frob->executor*)
	      nil
	      (progn (puthash frob-code (list frob-address frob-data-type procedure))
		     t)))
	(ferror nil "Object ~s already has an executor." frob)))))

(defun invoke-executor (code entry invoke do-not-invoke)
  (let ((what-i-point-at (follow-structure-forwarding (%make-pointer dtp-locative (first entry)))))
    (if (oldspace-pointer what-i-point-at)
	(if (= (%p-data-type what-i-point-at) dtp-gc-forward)
	    (progn (setf (first entry) (%p-pointer what-i-point-at))
		   (funcall do-not-invoke))
	    (let ((frob (ncons nil)))
	      (%p-dpb (second entry) %%q-data-type frob)
	      (%p-dpb (%pointer what-i-point-at) %%q-pointer frob)
	      (funcall invoke #'(lambda ()
				  (remhash code *frob->executor*)
				  (funcall (third entry) (car frob))))))
	(funcall do-not-invoke))))

(defun invoke-executors ()
  (let ((things-to-invoke '()))
    (maphash invoke-executor *frob->executor*
      #'(lambda (thing) (push thing things-to-invoke))
      #'ignore)
    (dolist (thing things-to-invoke)
      (funcall thing))))

(push 'invoke-executors *after-scavenge-daemons*)