Establish a mutex-like claim on the hold cluster before MRW scanning (#79)

* If best MRW scan rec has weight zero, abort + scan wider next time

* Switch to a hold-cluster claim + release strategy instead

* Extend the claimed-roots list rather than resetting it

Author: karalekas

src/logger.lisp

@@ -144,16 +144,49 @@
           (getf entry ':hold-cluster)
           (getf entry ':cluster-min-id)))
 
+(defmethod print-log-entry (entry
+                            (source supervisor)
+                            (entry-type (eql ':multireweight-broadcast-scan-result))
+                            &optional (stream *standard-output*))
+  (format stream "~5f: [~a] ~a (~a)'s MRW cluster scan returned pong (~a ~a ~{~a~^ ~} target-root ~a) for hold-cluster (~{~a~^ ~})~%"
+          (getf entry ':time)
+          (getf entry ':source)
+          (getf entry ':source-root)
+          (getf entry ':source-id)
+          (getf entry ':recommendation)
+          (getf entry ':weight)
+          (getf entry ':edges)
+          (getf entry ':target-root)
+          (getf entry ':hold-cluster)))
+
 (defmethod print-log-entry (entry
                             (source supervisor)
                             (entry-type (eql ':aborting-multireweight-negative-pong))
                             &optional (stream *standard-output*))
-  (format stream "~5f: [~a] aborting ~a (~a)'s MRW bc the cluster scan returned a negative-weight pong ~a for hold-cluster (~{~a~^ ~})~%"
+  (format stream "~5f: [~a] aborting ~a (~a)'s MRW bc the cluster scan returned a negative-weight pong (~a ~a ~{~a~^ ~} target-root ~a) for hold-cluster (~{~a~^ ~})~%"
+          (getf entry ':time)
+          (getf entry ':source)
+          (getf entry ':source-root)
+          (getf entry ':source-id)
+          (getf entry ':recommendation)
+          (getf entry ':weight)
+          (getf entry ':edges)
+          (getf entry ':target-root)
+          (getf entry ':hold-cluster)))
+
+(defmethod print-log-entry (entry
+                            (source supervisor)
+                            (entry-type (eql ':aborting-multireweight-zero-pong))
+                            &optional (stream *standard-output*))
+  (format stream "~5f: [~a] aborting ~a (~a)'s MRW bc the cluster scan returned a zero-weight pong (~a ~a ~{~a~^ ~} target-root ~a) for hold-cluster (~{~a~^ ~})~%"
           (getf entry ':time)
           (getf entry ':source)
           (getf entry ':source-root)
           (getf entry ':source-id)
-          (getf entry ':internal-pong)
+          (getf entry ':recommendation)
+          (getf entry ':weight)
+          (getf entry ':edges)
+          (getf entry ':target-root)
           (getf entry ':hold-cluster)))
 
 ;;;

src/node.lisp

@@ -122,7 +122,13 @@
     :initform nil
     :initarg :held-by-roots
     :type list
-    :documentation "LIST of `BLOSSOM-NODE' roots who are causing us to `HOLD'."))
+    :documentation "LIST of `BLOSSOM-NODE' roots who are causing us to `HOLD'.")
+   (claimed?
+    :accessor blossom-node-claimed?
+    :initform nil
+    :initarg :claimed?
+    :type boolean
+    :documentation "If T, this blossom is claimed as part of a hold-cluster."))
   (:documentation "Embodies a blossom in the blossom algorithm."))
 
 ;;;
@@ -266,8 +272,13 @@ evalutes to
   (values nil :type list))
 
 (defstruct (message-id-query (:include message))
-  "Replies with the minimum ID at this macrovertex."
-  )
+  "Replies with the minimum ID at this macrovertex.")
+
+(defstruct (message-claim-root (:include message))
+  "Attempts to claim a root; if successful, returns a release channel.")
+
+(defstruct (message-release-root (:include message))
+  "Releases a claimed root.")
 
 ;;;
 ;;; message handlers for BLOSSOM-NODE
@@ -384,6 +395,25 @@ evalutes to
                                       :address (process-public-address node)))
   (setf (blossom-node-wilting node) t))
 
+(define-rpc-handler handle-message-claim-root
+    ((node blossom-node) (message message-claim-root))
+  "If node is already claimed, return NIL. Otherwise, set claimed? to T and return our public address."
+  (with-slots (claimed?) node
+    (cond
+      (claimed?
+       nil)
+      (t
+       (setf claimed? t)
+       (process-public-address node)))))
+
+(define-rpc-handler handle-message-release-root
+    ((node blossom-node) (message message-release-root))
+  "Set claimed? to NIL."
+  (with-slots (claimed?) node
+    (assert claimed? () "Trying to release an unclaimed root!")
+    (setf claimed? nil)
+    t))
+
 ;;;
 ;;; blossom message dispatch table
 ;;;
@@ -441,7 +471,9 @@ evalutes to
 
   (message-sprout                     'handle-message-sprout-on-blossom)
 
-  (message-id-query                   'handle-message-id-query))
+  (message-id-query                   'handle-message-id-query)
+  (message-claim-root                 'handle-message-claim-root)
+  (message-release-root               'handle-message-release-root))
 
 ;;;
 ;;; basic command definitions for BLOSSOM-NODE