lull,ames: use mop instead of pha in .wan.keens

This commit is contained in:
~wicrum-wicrun 2023-05-02 15:17:25 +02:00
parent 6c0e53e9da
commit d7a2c53df8
4 changed files with 152 additions and 29 deletions

View File

@ -831,7 +831,10 @@
|= keen-state |= keen-state
|^ ^- json |^ ^- json
%- pairs %- pairs
:~ 'wan'^a/(turn (tap:(deq want) wan) wants) :~ :- %wan
:- %a
(turn (tap:((on @sd want) lth-wan) wan) |=([@ a=_+6:wants] (wants a)))
::
'nex'^a/(turn nex wants) 'nex'^a/(turn nex wants)
:: ::
:- 'hav' :- 'hav'

View File

@ -49,6 +49,9 @@
:: ::
:: +pha: finger tree :: +pha: finger tree
:: ::
:: DO NOT USE THIS
:: It's wrong and only kept around for state migration purposes.
::
++ pha ++ pha
|$ [val] |$ [val]
$~ [%nul ~] $~ [%nul ~]
@ -461,6 +464,13 @@
?: (compare key.n.a key.n.b) ?: (compare key.n.a key.n.b)
$(l.b $(b l.b, r.a ~), a r.a) $(l.b $(b l.b, r.a ~), a r.a)
$(r.b $(b r.b, l.a ~), a l.a) $(r.b $(b r.b, l.a ~), a l.a)
:: +wyt: measure size
::
++ wyt
~/ %wyt
|= a=(tree item)
^- @ud
?~(a 0 +((add $(a l.a) $(a r.a))))
-- --
:: ::
+$ deco ?(~ %bl %br %un) :: text decoration +$ deco ?(~ %bl %br %un) :: text decoration
@ -1029,9 +1039,9 @@
keens=(map path keen-state) keens=(map path keen-state)
== ==
+$ keen-state +$ keen-state
$: wan=(pha want) :: request packets, sent $: wan=((mop @sd want) lth-wan) :: request packts, sent
nex=(list want) :: request packets, unsent nex=(list want) :: request packets, unsent
hav=(list have) :: response packets, backward hav=(list have) :: response packets, backward
num-fragments=@ud num-fragments=@ud
num-received=@ud num-received=@ud
next-wake=(unit @da) next-wake=(unit @da)
@ -1183,6 +1193,11 @@
%.n %.n
(lte fragment-num.a fragment-num.b) (lte fragment-num.a fragment-num.b)
:: ::
++ lth-wan
|= [@sd @sd]
^- ?
=(-1 (cmp:si +<))
::
:: $pump-metrics: congestion control state for a |packet-pump :: $pump-metrics: congestion control state for a |packet-pump
:: ::
:: This is an Ames adaptation of TCP's Reno congestion control :: This is an Ames adaptation of TCP's Reno congestion control

View File

@ -777,6 +777,52 @@
++ com |~(a=pass ^?(..nu)) ++ com |~(a=pass ^?(..nu))
-- --
-- --
::
+$ ames-state-13
$: peers=(map ship ship-state-13)
=unix=duct
=life
=rift
crypto-core=acru:ames
=bug
snub=[form=?(%allow %deny) ships=(set ship)]
cong=[msg=@ud mem=@ud]
==
::
+$ ship-state-13
$% [%alien alien-agenda]
[%known peer-state-13]
==
::
+$ peer-state-13
$: $: =symmetric-key
=life
=rift
=public-key
sponsor=ship
==
route=(unit [direct=? =lane])
=qos
=ossuary
snd=(map bone message-pump-state)
rcv=(map bone message-sink-state)
nax=(set [=bone =message-num])
heeds=(set duct)
closing=(set bone)
corked=(set bone)
keens=(map path keen-state-13)
==
::
+$ keen-state-13
$: wan=(pha want) :: request packts, sent
nex=(list want) :: request packets, unsent
hav=(list have) :: response packets, backward
num-fragments=@ud
num-received=@ud
next-wake=(unit @da)
listeners=(set duct)
metrics=pump-metrics
==
:: $bug: debug printing configuration :: $bug: debug printing configuration
:: ::
:: veb: verbosity toggles :: veb: verbosity toggles
@ -909,7 +955,8 @@
[%10 ames-state-10] [%10 ames-state-10]
[%11 ames-state-11] [%11 ames-state-11]
[%12 ames-state-12] [%12 ames-state-12]
[%13 ^ames-state] [%13 ames-state-13]
[%14 ^ames-state]
== ==
:: ::
|= [now=@da eny=@ rof=roof] |= [now=@da eny=@ rof=roof]
@ -1032,7 +1079,7 @@
:: lifecycle arms; mostly pass-throughs to the contained adult ames :: lifecycle arms; mostly pass-throughs to the contained adult ames
:: ::
++ scry scry:adult-core ++ scry scry:adult-core
++ stay [%13 %larva queued-events ames-state.adult-gate] ++ stay [%14 %larva queued-events ames-state.adult-gate]
++ load ++ load
|= $= old |= $= old
$% $: %4 $% $: %4
@ -1099,6 +1146,13 @@
[%adult state=ames-state-12] [%adult state=ames-state-12]
== == == ==
$: %13 $: %13
$% $: %larva
events=(qeu queued-event)
state=ames-state-13
==
[%adult state=ames-state-13]
== ==
$: %14
$% $: %larva $% $: %larva
events=(qeu queued-event) events=(qeu queued-event)
state=_ames-state.adult-gate state=_ames-state.adult-gate
@ -1113,7 +1167,7 @@
=. state.old (state-4-to-5:load:adult-core state.old) =. state.old (state-4-to-5:load:adult-core state.old)
$(-.old %5) $(-.old %5)
:: ::
[%5 %adult *] [%5 %adult *]
=. cached-state `[%5 state.old] =. cached-state `[%5 state.old]
~> %slog.0^leaf/"ames: larva reload" ~> %slog.0^leaf/"ames: larva reload"
larval-gate larval-gate
@ -1201,14 +1255,24 @@
=. queued-events events.old =. queued-events events.old
larval-gate larval-gate
:: ::
[%13 %adult *] (load:adult-core %13 state.old) [%13 %adult *]
=. cached-state `[%13 state.old]
~> %slog.0^leaf/"ames: larva reload"
larval-gate
:: ::
[%13 %larva *] [%13 %larva *]
~> %slog.1^leaf/"ames: larva: load" ~> %slog.1^leaf/"ames: larva: load"
=. cached-state `[%13 state.old]
=. queued-events events.old =. queued-events events.old
=. adult-gate (load:adult-core %13 state.old)
larval-gate larval-gate
:: ::
[%14 %adult *] (load:adult-core %14 state.old)
::
[%14 %larva *]
~> %slog.1^leaf/"ames: larva: load"
=. queued-events events.old
=. adult-gate (load:adult-core %14 state.old)
larval-gate
== ==
:: ::
++ event-11-to-12 ++ event-11-to-12
@ -1250,7 +1314,9 @@
12+(state-11-to-12:load:adult-core +.u.cached-state) 12+(state-11-to-12:load:adult-core +.u.cached-state)
=? u.cached-state ?=(%12 -.u.cached-state) =? u.cached-state ?=(%12 -.u.cached-state)
13+(state-12-to-13:load:adult-core +.u.cached-state) 13+(state-12-to-13:load:adult-core +.u.cached-state)
?> ?=(%13 -.u.cached-state) =? u.cached-state ?=(%13 -.u.cached-state)
14+(state-13-to-14:load:adult-core +.u.cached-state)
?> ?=(%14 -.u.cached-state)
=. ames-state.adult-gate +.u.cached-state =. ames-state.adult-gate +.u.cached-state
[moz larval-core(cached-state ~)] [moz larval-core(cached-state ~)]
-- --
@ -3813,9 +3879,25 @@
^+ same ^+ same
(trace %fine verb her ships.bug.ames-state print) (trace %fine verb her ships.bug.ames-state print)
:: ::
++ fi-mop
=, ((on @sd want) lth-wan)
|%
++ cons
|= [a=_wan.keen =want]
^+ a
=- (put a - want)
?~ prev=(pry a) --0
(dif:si key.u.prev --1)
::
++ snoc
|= [a=_wan.keen =want]
^+ a
=- (put a - want)
?~ prev=(pry a) --0
(sum:si key.u.prev --1)
--
++ fi-emit |=(move fine(event-core (emit +<))) ++ fi-emit |=(move fine(event-core (emit +<)))
++ fi-deq (deq want) ++ fi-gauge (ga metrics.keen (wyt:fi-mop wan.keen))
++ fi-gauge (ga metrics.keen (wyt:fi-deq wan.keen))
++ fi-wait |=(tim=@da (fi-pass-timer %b %wait tim)) ++ fi-wait |=(tim=@da (fi-pass-timer %b %wait tim))
++ fi-rest |=(tim=@da (fi-pass-timer %b %rest tim)) ++ fi-rest |=(tim=@da (fi-pass-timer %b %rest tim))
:: ::
@ -3839,7 +3921,7 @@
=/ fra=@ 1 =/ fra=@ 1
=/ req=hoot (fi-etch-wail fra) =/ req=hoot (fi-etch-wail fra)
=/ =want [fra req last=now tries=1 skips=0] =/ =want [fra req last=now tries=1 skips=0]
=. wan.keen (cons:fi-deq *(pha ^want) want) =. wan.keen (cons:fi-mop ~ want)
(fi-send `@ux`req) (fi-send `@ux`req)
:: ::
++ fi-rcv ++ fi-rcv
@ -3909,12 +3991,12 @@
=| marked=(list want) =| marked=(list want)
|= fra=@ud |= fra=@ud
^- [? _fine] ^- [? _fine]
=; [[found=? cor=_fine] wan=(pha want)] =; [[found=? cor=_fine] wan=_wan.keen]
:- found :- found
?.(found fine cor(wan.keen wan)) ?.(found fine cor(wan.keen wan))
%^ (dip-left:fi-deq ,[found=? cor=_fine]) wan.keen %^ (dip:fi-mop ,[found=? cor=_fine]) wan.keen
[| fine] [| fine]
|= [[found=? cor=_fine] =want] |= [[found=? cor=_fine] @sd =want]
^- [(unit _want) stop=? [found=? cor=_fine]] ^- [(unit _want) stop=? [found=? cor=_fine]]
=. fine cor =. fine cor
?: =(fra fra.want) ?: =(fra fra.want)
@ -3965,7 +4047,7 @@
=^ =want nex.keen nex.keen =^ =want nex.keen nex.keen
=. last-sent.want now =. last-sent.want now
=. tries.want +(tries.want) =. tries.want +(tries.want)
=. wan.keen (snoc:fi-deq wan.keen want) =. wan.keen (snoc:fi-mop wan.keen want)
=. fine (fi-send `@ux`hoot.want) =. fine (fi-send `@ux`hoot.want)
$(inx +(inx)) $(inx +(inx))
:: ::
@ -3981,11 +4063,11 @@
:: ::
++ fi-fast-retransmit ++ fi-fast-retransmit
|= fra=@ud |= fra=@ud
=; [cor=_fine wants=(pha want)] =; [cor=_fine wants=_wan.keen]
cor(wan.keen wants) cor(wan.keen wants)
%^ (dip-left:fi-deq ,cor=_fine) wan.keen %^ (dip:fi-mop ,cor=_fine) wan.keen
fine fine
|= [cor=_fine =want] |= [cor=_fine @sd =want]
^- [(unit ^want) stop=? cor=_fine] ^- [(unit ^want) stop=? cor=_fine]
?. (lte fra.want fra) ?. (lte fra.want fra)
[`want & cor] [`want & cor]
@ -4003,9 +4085,9 @@
++ fi-set-wake ++ fi-set-wake
^+ fine ^+ fine
=/ next-wake=(unit @da) =/ next-wake=(unit @da)
?~ want=(peek-left:fi-deq wan.keen) ?~ want=(pry:fi-mop wan.keen)
~ ~
`(next-expiry:fi-gauge +>:u.want) `(next-expiry:fi-gauge +>:val.u.want)
?: =(next-wake next-wake.keen) ?: =(next-wake next-wake.keen)
fine fine
=? fine !=(~ next-wake.keen) =? fine !=(~ next-wake.keen)
@ -4027,13 +4109,13 @@
=. peer-state (update-peer-route her peer-state) =. peer-state (update-peer-route her peer-state)
=. metrics.keen on-timeout:fi-gauge =. metrics.keen on-timeout:fi-gauge
=^ want=(unit want) wan.keen =^ want=(unit want) wan.keen
(pop-left:fi-deq wan.keen) (fall (mole |.([`val.head rest]:(pop:fi-mop wan.keen))) `wan.keen)
~| %took-wake-for-empty-want ~| %took-wake-for-empty-want
?> ?=(^ want) ?> ?=(^ want)
=: tries.u.want +(tries.u.want) =: tries.u.want +(tries.u.want)
last-sent.u.want now last-sent.u.want now
== ==
=. wan.keen (cons:fi-deq wan.keen u.want) =. wan.keen (cons:fi-mop wan.keen u.want)
(fi-send `@ux`hoot.u.want) (fi-send `@ux`hoot.u.want)
-- --
:: +ga: constructor for |pump-gauge congestion control core :: +ga: constructor for |pump-gauge congestion control core
@ -4252,15 +4334,15 @@
[moves ames-gate] [moves ames-gate]
:: +stay: extract state before reload :: +stay: extract state before reload
:: ::
++ stay [%13 %adult ames-state] ++ stay [%14 %adult ames-state]
:: +load: load in old state after reload :: +load: load in old state after reload
:: ::
++ load ++ load
=< |= $= old-state =< |= $= old-state
$% [%13 ^ames-state] $% [%14 ^ames-state]
== ==
^+ ames-gate ^+ ames-gate
?> ?=(%13 -.old-state) ?> ?=(%14 -.old-state)
ames-gate(ames-state +.old-state) ames-gate(ames-state +.old-state)
:: all state transitions are called from larval ames :: all state transitions are called from larval ames
:: ::
@ -4379,7 +4461,7 @@
:: ::
++ state-12-to-13 ++ state-12-to-13
|= old=ames-state-12 |= old=ames-state-12
^- ^ames-state ^- ames-state-13
=+ !< =rift =+ !< =rift
q:(need (need (rof ~ %j `beam`[[our %rift %da now] /(scot %p our)]))) q:(need (need (rof ~ %j `beam`[[our %rift %da now] /(scot %p our)])))
=+ pk=sec:ex:crypto-core.old =+ pk=sec:ex:crypto-core.old
@ -4397,10 +4479,29 @@
:: ::
++ ship-state-12-to-13 ++ ship-state-12-to-13
|= old=ship-state-12 |= old=ship-state-12
^- ship-state ^- ship-state-13
?: ?=(%alien -.old) ?: ?=(%alien -.old)
old(heeds [heeds.old ~]) old(heeds [heeds.old ~])
old(corked [corked.old ~]) old(corked [corked.old ~])
::
++ state-13-to-14
|= old=ames-state-13
^- ^ames-state
=- old(peers -)
%- ~(run by peers.old)
|= old=ship-state-13
?: ?=(%alien -.old) old
old(keens (~(run by keens.old) keen-state-13-to-14))
::
++ keen-state-13-to-14
|= old=keen-state-13
^- keen-state
=- old(wan wan)
%^ (dip-left:(deq want) ,[@ud wan=((mop @sd want) lth-wan)]) wan.old
[0 ~]
|= [[ix=@ud wan=((mop @sd want) lth-wan)] =want]
^- [(unit ^want) ? @ud _wan]
[~ | +(ix) (put:((on @sd ^want) lth-wan) wan (sun:si ix) want)]
-- --
:: +scry: dereference namespace :: +scry: dereference namespace
:: ::

View File

@ -5593,6 +5593,10 @@
$(pops [oldest pops]) $(pops [oldest pops])
-- --
-- --
:: +deq: deque
::
:: DO NOT USE THIS
:: It's wrong and only kept around for state migration purposes.
:: ::
++ deq ++ deq
|* val=mold |* val=mold