syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Further adaptation to recent Preserves changes

This commit is contained in:
Tony Garnock-Jones 2021-06-08 16:09:59 +02:00
parent 92eab82b1f
commit ef66c1d358
2 changed files with 26 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
syndicate/engine.rkt
View File

@ -57,6 +57,9 @@
(exit 1))
(define (queue-task! e thunk)
(thread-send (engine-thread e) thunk))
(thread-send (engine-thread e)
thunk
(lambda ()
(log-syndicate/engine-warning "Attempt to enqueue task for dead engine ~v" e))))
(define *dead-engine* (make-engine 0))

40
syndicate/relay.rkt
View File

@ -122,7 +122,7 @@
(define rewrite-ref-in
(action (tr wire-ref save!)
(match wire-ref
[(sturdy:WireRef-mine oid)
[(sturdy:WireRef-mine (sturdy:Oid oid))
(define ws (grab (tunnel-relay-imported-references tr)
membrane-oid-map
oid
@ -131,7 +131,7 @@
(wire-symbol oid (turn-ref this-turn (make-relay-entity tr oid)) 0))))
(save! ws)
(wire-symbol-ref ws)]
[(sturdy:WireRef-yours oid attenuation)
[(sturdy:WireRef-yours (sturdy:Oid oid) attenuation)
(define r (lookup-local tr oid))
(if (or (null? attenuation) (eq? *inert-ref* r))
r
@ -143,25 +143,26 @@
(action (tr packet)
(match (parse-Turn packet)
[(? eof-object?) (error 'handle-packet "Invalid IO.Turn")]
[wire-turn
[(Turn wire-turn)
(for [(ev (in-list wire-turn))]
(match-define (TurnEvent oid event) ev)
(log-info "~v" ev)
(match-define (TurnEvent (Oid oid) event) ev)
(define r (lookup-local tr oid))
(match event
[(Event-Assert (Assert assertion remote-handle))
[(Event-Assert (Assert (Assertion assertion) (Handle remote-handle)))
(define-values (a imported) (rewrite-in this-turn tr assertion))
(hash-set! (tunnel-relay-inbound-assertions tr)
remote-handle
(inbound (turn-assert! this-turn r a)
imported))]
[(Event-Retract (Retract remote-handle))
[(Event-Retract (Retract (Handle remote-handle)))
(define i (hash-ref (tunnel-relay-inbound-assertions tr) remote-handle #f))
(when (not i) (error 'handle-packet "Peer retracted invalid handle ~a" remote-handle))
(hash-remove! (tunnel-relay-inbound-assertions tr) remote-handle)
(for [(ws (in-list (inbound-imported i)))]
(drop (tunnel-relay-imported-references tr) ws))
(turn-retract! this-turn (inbound-local-handle i))]
[(Event-Message (Message body))
[(Event-Message (Message (Assertion body)))
(define-values (a imported) (rewrite-in this-turn tr body))
(when (not (null? imported))
(error 'handle-packet "Cannot receive transient reference"))
@ -207,14 +208,14 @@
(set-tunnel-relay-next-local-oid! tr (+ oid 1))
(wire-symbol oid local-ref 0))))
(save! ws)
(sturdy:WireRef-mine (wire-symbol-oid ws)))
(sturdy:WireRef-mine (sturdy:Oid (wire-symbol-oid ws))))
(define (rewrite-ref-out tr local-ref transient? save!)
(define re (entity-data (entity-ref-target local-ref)))
(cond [(or (not (relay-entity? re)) (not (eq? (relay-entity-relay re) tr)))
(rewrite-ref-out* tr local-ref transient? save!)]
[(null? (entity-ref-attenuation local-ref))
(sturdy:WireRef-yours (relay-entity-oid re) '())]
(sturdy:WireRef-yours (sturdy:Oid (relay-entity-oid re)) '())]
[else
;; we may trust the peer to enforce attenuation on our
;; behalf, in which case we can return (sturdy:WireRef-yours
@ -238,20 +239,21 @@
(define (make-relay-entity tr oid)
(entity #:name (list (tunnel-relay-name tr) oid)
#:assert (action (assertion handle)
(send-event tr (Event-Assert (Assert (register tr assertion handle) handle))))
(send-event tr (Event-Assert
(Assert (Assertion (register tr assertion handle))
(Handle handle)))))
#:retract (action (handle)
(deregister tr handle)
(send-event tr (Event-Retract (Retract handle))))
(send-event tr (Event-Retract (Retract (Handle handle)))))
#:message (action (body)
(send-event tr (Event-Message (Message (register tr body #f)))))
(send-event tr (Event-Message (Message (Assertion (register tr body #f))))))
#:sync (action (peer)
(define exported #f)
(define (save! ws) (set! exported ws))
(define spe (sync-peer-entity tr oid peer (lambda () exported)))
(send-event tr
(Event-Sync
(Sync (embedded
(rewrite-ref-out tr (turn-ref this-turn spe) #f save!))))))
(Sync (rewrite-ref-out tr (turn-ref this-turn spe) #f save!)))))
#:data (relay-entity tr oid)))
(define (sync-peer-entity tr oid peer get-export)
@ -286,10 +288,12 @@
(turn-assert! this-turn
then
(and initial-oid
(embedded (rewrite-ref-in this-turn
tr
(sturdy:WireRef-mine initial-oid)
(lambda (_ws) (void))))))))))
(embedded
(rewrite-ref-in this-turn
tr
(sturdy:WireRef-mine
(sturdy:Oid initial-oid))
(lambda (_ws) (void))))))))))
(define-syntax-rule (D v0)
(let ((v v0))