objectstore.lisp

   1 ;;;-----------------------------------------------------------------------------------
   2 ;;; name       : objectstore
   3 ;;; description:
   4 ;;; notes      :
   5 ;;; contact    : me (Michael Trowe)
   6 ;;; copyright  :
   7 ;;; history    :
   8 ;;; contents   :
   9 ;;;-----------------------------------------------------------------------------------
  10 (in-package nc)
  11
  12 (defclass objstore ()
  13   ((storage :reader storage
  14             :initform (make-hash-table)
  15             :initarg :storage)
  16    (back-map :reader back-map
  17              :initform (make-hash-table)
  18              :initarg :back-map)
  19    (next-address :accessor next-address
  20                  :initform 0
  21                  :initarg :next-address)
  22    (proxies :accessor proxies
  23             :initform (make-hash-table :test #'equal)
  24             :initarg :proxies)))
  25
  26
  27
  28
  29 (defmessage send-notifier (address destination)
  30   :receive-action (store-destination (objstore *manager*)
  31                                      address
  32                                      destination))
  33
  34 (defmessage reference-revoked (address)
  35   :receive-action (let* ((store (objstore *manager*))
  36                          (exports (when(cdr (gethash address (storage store)))
  37                                     (setf (cdr (gethash address (storage store)))
  38                                     (delete *calling-os*
  39                                             (cdr (gethash address (storage store))))))))
  40                     (unless exports
  41                       (remhash (fetch-obj address) (back-map store))
  42                       (remhash address (storage store)))))
  43
  44
  45
  46 (defun ensure-exported (obj &optional (destination *current-actor*))
  47   (with-slots (back-map storage next-address) (objstore *manager*)
  48     (let ((address-and-packform (gethash obj back-map)))
  49       (if address-and-packform
  50           (store-destination  (objstore *manager*) (car address-and-packform) destination)
  51         (let ((address (setf next-address (1+ next-address))))
  52           (setf (gethash address storage) (list obj destination))
  53           (setf address-and-packform
  54             (setf (gethash obj back-map)
  55               (cons  address
  56                      (format nil "(np  ~a '~a)"
  57                              address
  58                              (format nil "~S"
  59                                      (class-name (class-of obj)))))))))
  60       (values (car address-and-packform)
  61               (cdr address-and-packform)))))
  62
  63
  64 (defun fetch-obj (address)
  65   (car (gethash address (storage (objstore *manager*)))))
  66
  67 (defun print-storage ()
  68   (print-hash (storage (objstore *manager*))))
  69
  70 (defun print-hash (hashtable)
  71   (maphash #'(lambda (k v) (print (list k v)))
  72            hashtable))
  73
  74 (defun notify-sending (proxy)
  75   (kernel-send (remote-os proxy)
  76             (send-notifier-message
  77               :address (remote-address proxy)
  78               :destination *current-actor*)))
  79
  80 (defmethod notify-proxy ((proxy proxy))
  81   (or (get-proxy (objstore *manager*) proxy)
  82       (store-proxy (objstore *manager*) proxy)))
  83
  84 (defmethod notify-proxy :after ((proxy proxy))
  85   (initialize-local-slots proxy)
  86   )
  87
  88
  89 (defun notify-gc (proxy)
  90   (let ((address (remote-address proxy))
  91         (os (remote-os proxy)))
  92     (when address
  93       (remhash (cons address os)
  94                (proxies (objstore *manager*)))
  95       (let ((*current-actor* ()))
  96         (kernel-send os
  97                      (reference-revoked-message
  98                       :address address))))))
  99
 100
 101
 102
 103 (defmethod get-proxy ((store objstore) proxy)
 104   (let ((pointer (gethash (cons (remote-address proxy)
 105                                 (remote-os proxy))
 106                           (proxies store))))
 107     (when pointer
 108           (aref pointer 0))))
 109
 110
 111
 112 (defmethod store-proxy ((store objstore) proxy)
 113   (setf (gethash (cons (remote-address proxy) (remote-os proxy))
 114                  (proxies store))
 115     (make-array 1 :weak t :initial-element proxy))
 116   #+allegro
 117   (excl:schedule-finalization proxy #'notify-gc)
 118   #+sbcl
 119   (sb-ext:finalize proxy #'notify-gc)
 120   proxy)
 121
 122
 123 (defmethod store-destination ((store objstore) address
 124                               destination)
 125   (pushnew destination (cdr (gethash address (storage store)))))
 126
 127
 128 (defmethod reset ((store objstore))
 129   (maphash #'(lambda (key proxy-pointer)
 130                (declare (ignore key))
 131                (kill (aref proxy-pointer 0)))
 132            (proxies store))
 133   (reinitialize-instance store
 134                          :storage (make-hash-table)
 135                          :back-map (make-hash-table)
 136                          :next-address 0
 137                          :proxies (make-hash-table :test #'equal)))
 138
 139 (defmethod kill ((proxy proxy))
 140   (setf (remote-address proxy) ()))
 141
 142
 143
 144
 145
 146