From 3073d8b614243627adff3c592978798539296bdc Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Wed, 5 Jul 2017 07:13:36 -0400 Subject: [PATCH] Avoid some stop-when/rising-edge/flag combinations, and some rising-edge uses generally --- .../netstack/incremental-highlevel/main.rkt | 4 +--- .../netstack/incremental-highlevel/tcp.rkt | 24 +++++++++---------- examples/platformer/hll-main.rkt | 8 +++---- examples/webchat/server/duplicate.rkt | 4 +--- racket/syndicate/actor.rkt | 6 +++++ .../examples/actor/box-and-client.rkt | 4 ++-- .../actor/example-bug-rising-edge-true.rkt | 3 +++ racket/syndicate/examples/actor/mutex.rkt | 2 +- .../examples/actor/web-sanity-check.rkt | 6 ++--- racket/syndicate/supervise.rkt | 5 ++-- 10 files changed, 33 insertions(+), 33 deletions(-) diff --git a/examples/netstack/incremental-highlevel/main.rkt b/examples/netstack/incremental-highlevel/main.rkt index 6f91f86..be29268 100644 --- a/examples/netstack/incremental-highlevel/main.rkt +++ b/examples/netstack/incremental-highlevel/main.rkt @@ -66,8 +66,6 @@ (during/spawn (inbound (advertise (tcp-channel ($ them (tcp-address _ _)) us _))) #:name (list 'webserver-session them) (log-info "Got connection from ~v" them) - (field [done? #f]) - (stop-when (rising-edge (done?))) (assert (outbound (advertise (tcp-channel us them _)))) (on (message (inbound (tcp-channel them us _)))) ;; ignore input @@ -84,4 +82,4 @@ "

There have been ~a requests prior to this one.

\n") counter))) (send! (outbound (tcp-channel us them response))) - (done? #t)))))) + (stop-facet (current-facet-id))))))) diff --git a/examples/netstack/incremental-highlevel/tcp.rkt b/examples/netstack/incremental-highlevel/tcp.rkt index e064647..6f08723 100644 --- a/examples/netstack/incremental-highlevel/tcp.rkt +++ b/examples/netstack/incremental-highlevel/tcp.rkt @@ -304,6 +304,8 @@ (ip-address->hostname dst-ip) dst-port) + (define root-facet (current-facet-id)) + (define initial-outbound-seqn ;; Yuck (inexact->exact (truncate (* #x100000000 (random))))) @@ -317,7 +319,7 @@ ;; ^ when the index of the first outbound unacknowledged byte changed [most-recent-time (current-inexact-milliseconds)] ;; ^ updated by timer expiry; a field, to trigger quit checks - [quit-because-reset? #f]) + ) (let () (local-require (submod syndicate/actor priorities)) @@ -445,7 +447,7 @@ dst-port (ip-address->hostname src-ip) src-port) - (quit-because-reset? #t) + (stop-facet root-facet) (send! (tcp-packet #f dst-ip dst-port src-ip src-port seqn ackn @@ -463,25 +465,21 @@ (assert #:when (and (syn-acked?) (not (buffer-finished? (inbound)))) (advertise (tcp-channel src dst _))) - (stop-when - (rising-edge - (and (buffer-finished? (outbound)) - (buffer-finished? (inbound)) - (all-output-acknowledged?) - (not (heard-from-peer-within-msec? (* 2 1000 maximum-segment-lifetime-sec))))) + (stop-when-true + (and (buffer-finished? (outbound)) + (buffer-finished? (inbound)) + (all-output-acknowledged?) + (not (heard-from-peer-within-msec? (* 2 1000 maximum-segment-lifetime-sec)))) ;; Everything is cleanly shut down, and we just need to wait a while for unexpected ;; packets before we release the state vector. ) - (stop-when - (rising-edge (user-timeout-expired?)) + (stop-when-true (user-timeout-expired?) ;; We've been plaintively retransmitting for user-timeout-msec without hearing anything ;; back; this is a crude approximation of the real condition for TCP_USER_TIMEOUT, but ;; it will do for now? TODO (log-info "TCP_USER_TIMEOUT fired.")) - (stop-when (rising-edge (quit-because-reset?))) - (define/query-value local-peer-seen? #f (observe (tcp-channel src dst _)) #t #:on-remove (begin (log-info "Closing outbound stream.") @@ -500,7 +498,7 @@ (define is-syn? (set-member? flags 'syn)) (define is-fin? (set-member? flags 'fin)) (cond - [(set-member? flags 'rst) (quit-because-reset? #t)] + [(set-member? flags 'rst) (stop-facet root-facet)] [(and (not expected) ;; no syn yet (or (not is-syn?) ;; and this isn't it (and (not (listener-listening?)) ;; or it is, but no listener... diff --git a/examples/platformer/hll-main.rkt b/examples/platformer/hll-main.rkt index d00dea1..5f1bfe4 100644 --- a/examples/platformer/hll-main.rkt +++ b/examples/platformer/hll-main.rkt @@ -550,7 +550,7 @@ (field [hit-points 1]) (assert (health player-id (hit-points))) - (stop-when (rising-edge (<= (hit-points) 0))) + (stop-when-true (<= (hit-points) 0)) (on (message (damage player-id $amount)) (hit-points (- (hit-points) amount))) @@ -624,9 +624,9 @@ [(> (+ left width) range-hi) 'left] [else (facing)])))) - (stop-when (rising-edge (and (current-level-size) - (> (vector-ref (pos) 1) - (vector-ref (current-level-size) 1))))) + (stop-when-true (and (current-level-size) + (> (vector-ref (pos) 1) + (vector-ref (current-level-size) 1)))) (field [facing initial-facing]) (assert (outbound* game-level diff --git a/examples/webchat/server/duplicate.rkt b/examples/webchat/server/duplicate.rkt index 28b6a4c..36eaec3 100644 --- a/examples/webchat/server/duplicate.rkt +++ b/examples/webchat/server/duplicate.rkt @@ -7,11 +7,9 @@ (define (stop-when-duplicate spec) (define id (random-hex-string 16)) - (field [duplicate? #f]) - (stop-when (rising-edge (duplicate?))) (assert (instance id spec)) (on (asserted (instance $id2 spec)) (when (string