diff --git a/gen/ford-turbo.hoon b/gen/ford-turbo.hoon index 3f4c1b085..475f1e410 100644 --- a/gen/ford-turbo.hoon +++ b/gen/ford-turbo.hoon @@ -7429,17 +7429,37 @@ |= [ford-gate=_ford-gate ship=@p] ^- tang :: + =^ results1 ford-gate + %- test-ford-call :* + ford-gate + now=~1234.5.6 + scry=scry-is-forbidden + call-args=[duct=~[/empty] type=~ [%keep 0 0]] + expected-moves=~ + == + :: =/ ford *ford-gate =/ state (~(got by state-by-ship.ax.+>+<.ford) ship) - =. compiler-cache.state compiler-cache:*ford-state:ford :: - ?: =(*ford-state:ford state) + =/ default-state *ford-state:ford + :: + =. max-size.compiler-cache.state max-size.compiler-cache.default-state + =. max-size.queue.build-cache.state max-size.queue.build-cache.default-state + =. next-anchor-id.build-cache.state 0 + :: + %+ welp results1 + :: + ?: =(default-state state) ~ :: =/ build-state=(list tank) - %+ turn ~(tap in ~(key by builds.state)) - |= build=build:ford - [%leaf (build-to-tape:ford build)] + %- zing + %+ turn ~(tap by builds.state) + |= [build=build:ford build-status=build-status:ford] + :~ [%leaf (build-to-tape:ford build)] + [%leaf "requesters: {}"] + [%leaf "clients: {<~(tap in ~(key by clients.build-status))>}"] + == :: =/ braces [[' ' ' ' ~] ['{' ~] ['}' ~]] :: diff --git a/sys/vane/ford.hoon b/sys/vane/ford.hoon index ccdcb4405..72ef225be 100644 --- a/sys/vane/ford.hoon +++ b/sys/vane/ford.hoon @@ -82,6 +82,14 @@ max-size=_2.048 depth=_1 == +:: +capped-queue: a +qeu with a maximum number of entries +:: +++ capped-queue + |* item-type=mold + $: queue=(qeu item-type) + size=@ud + max-size=_64 + == -- |% :: +by-clock: interface core for a cache using the clock replacement algorithm @@ -212,6 +220,56 @@ size 0 == -- +:: +to-capped-queue: interface door for +capped-queue +:: +++ to-capped-queue + |* item-type=mold + |_ queue=(capped-queue item-type) + :: +put: enqueue :item, possibly popping and producing an old item + :: + ++ put + |= item=item-type + ^- [(unit item-type) _queue] + :: are we already at max capacity? + :: + ?. =(size.queue max-size.queue) + :: we're below max capacity, so push and increment size + :: + =. queue.queue (~(put to queue.queue) item) + =. size.queue +(size.queue) + :: + [~ queue] + :: we're at max capacity, so pop before pushing; size is unchanged + :: + =^ oldest queue.queue ~(get to queue.queue) + =. queue.queue (~(put to queue.queue) item) + :: + [`oldest queue] + :: +get: pop an item off the queue, adjusting size + :: + ++ get + ^- [item-type _queue] + :: + =. size.queue (dec size.queue) + =^ oldest queue.queue ~(get to queue.queue) + :: + [oldest queue] + :: change the :max-size of the queue, popping items if necessary + :: + ++ resize + =| pops=(list item-type) + |= new-max=@ud + ^+ [pops queue] + :: we're not overfull, so no need to pop off more items + :: + ?: (gte new-max size.queue) + [(flop pops) queue(max-size new-max)] + :: we're above capacity; pop an item off and recurse + :: + =^ oldest queue get + :: + $(pops [oldest pops]) + -- -- |% :: +axle: overall ford state @@ -267,9 +325,16 @@ :: pending-subscriptions: outgoing subscriptions on live resources :: pending-subscriptions=(request-tracker subscription) - :: build-cache: fifo queue of previous completed ducts. + :: build-cache: fifo queue of completed root builds :: - :: build-cache=(qeu duct) + $= build-cache + $: :: next-anchor-id: incrementing identifier for cache anchors + :: + next-anchor-id=@ud + :: queue: fifo queue of root builds identified by anchor id + :: + queue=(capped-queue build-cache-key) + == :: compiler-cache: clock based cache of build results :: compiler-cache=(clock compiler-cache-key build-result) @@ -473,6 +538,16 @@ [%slim subject-type=type formula=hoon] [%slit gate=type sample=type] == +:: +build-cache-key: key for the fifo cache of completed build trees +:: ++= build-cache-key + $: :: id: incrementing identifier for an +anchor + :: + id=@ud + :: root-build: the root build associated with this anchor + :: + root-build=build + == :: +build-receipt: result of running +make :: :: A +build-receipt contains all information necessary to perform the @@ -1149,7 +1224,6 @@ :: =< finalize :: - :: ~& [%rebuild subscription=subscription pending-subscriptions.state] =. pending-subscriptions.state +:(del-request pending-subscriptions.state subscription duct) :: @@ -1311,15 +1385,28 @@ :: ++ keep ~/ %keep - |= max=@ud + |= [compiler-cache-size=@ud build-cache-size=@ud] ^+ state + :: pop old builds out of :build-cache and remove their cache anchors + :: + =^ pops queue.build-cache.state + %. build-cache-size + ~(resize (to-capped-queue build-cache-key) queue.build-cache.state) + :: + =. state + |- ^+ state + ?~ pops state + :: + =. state (remove-anchor-from-root root-build.i.pops [%cache id.i.pops]) + :: + $(pops t.pops) :: %_ state compiler-cache %- %~ resize (by-clock compiler-cache-key build-result) compiler-cache.state - max + compiler-cache-size == :: +cancel: cancel a build :: @@ -1350,7 +1437,7 @@ =/ root-build=build [in-progress.live root-schematic]:u.duct-status :: =. ..execute (cancel-scrys root-build) - =. state (remove-duct-from-root root-build) + =. state (remove-anchor-from-root root-build [%duct duct]) ..execute :: if the duct was live and has an unfinished build, cancel it :: @@ -1359,7 +1446,7 @@ =/ root-build=build [u.in-progress.live root-schematic]:u.duct-status :: =. ..execute (cancel-scrys root-build) - =. state (remove-duct-from-root root-build) + =. state (remove-anchor-from-root root-build [%duct duct]) ..execute :: if there is no completed build for the live duct, we're done :: @@ -1369,7 +1456,7 @@ :: =/ root-build=build [date.u.last-sent root-schematic.u.duct-status] :: - =. state (remove-duct-from-root root-build) + =. state (remove-anchor-from-root root-build [%duct duct]) :: ?~ subscription.u.last-sent ..execute @@ -1388,31 +1475,113 @@ =. ..execute (cancel-scry-request i.blocked-sub-scrys) :: $(blocked-sub-scrys t.blocked-sub-scrys) - :: +remove-duct-from-root: remove :duct from a build tree + :: +move-root-to-cache: replace :duct with a %cache anchor in :build's tree :: - ++ remove-duct-from-root - ~/ %remove-duct-from-root + ++ move-root-to-cache + ~/ %move-root-to-cache |= =build ^+ state - :: ~& [%remove-duct-from-root (build-to-tape build) duct] + :: obtain the new cache id and increment the :next-anchor-id in the state + :: + =^ new-id next-anchor-id.build-cache.state + =/ id=@ud next-anchor-id.build-cache.state + [id +(id)] + :: replace the requester in the root build :: =. builds.state %+ ~(jab by builds.state) build |= =build-status - build-status(requesters (~(del in requesters.build-status) [%duct duct])) + %_ build-status + requesters + =- (~(del in -) [%duct duct]) + =- (~(put in -) [%cache new-id]) + requesters.build-status + == + :: enqueue :build into cache, possibly popping and deleting a stale build :: - =. builds.state (remove-duct-from-subs build) + =^ oldest queue.build-cache.state + %. [new-id build] + ~(put (to-capped-queue build-cache-key) queue.build-cache.state) + :: + =? state + ?=(^ oldest) + (remove-anchor-from-root root-build.u.oldest [%cache id.u.oldest]) + :: recursively replace :clients in :build and descendants + :: + |- ^+ state + :: + =/ client-status=build-status (~(got by builds.state) build) + =/ subs=(list ^build) ~(tap in ~(key by subs.client-status)) + :: + |- ^+ state + ?~ subs state + :: + =. builds.state + %+ ~(jab by builds.state) i.subs + |= =build-status + %_ build-status + clients + =/ old-clients-on-duct (~(get ju clients.build-status) [%duct duct]) + :: + =- (~(del by -) [%duct duct]) + =- (~(put by -) [%cache new-id] old-clients-on-duct) + clients.build-status + == + :: + =. state ^$(build i.subs) + :: + $(subs t.subs) + :: +remove-anchor-from-root: remove :anchor from :build's tree + :: + ++ remove-anchor-from-root + ~/ %remove-anchor-from-root + |= [=build =anchor] + ^+ state + :: + =. builds.state + %+ ~(jab by builds.state) build + |= =build-status + build-status(requesters (~(del in requesters.build-status) anchor)) + :: + =. builds.state (remove-anchor-from-subs build anchor) :: (cleanup build) - :: +add-ducts-to-build-subs: for each sub, add all of :build's ducts + :: +remove-anchor-from-subs: recursively remove :anchor from sub-builds :: - ++ add-ducts-to-build-subs - ~/ %add-ducts-to-build-subs + ++ remove-anchor-from-subs + ~/ %remove-anchor-from-subs + |= [=build =anchor] + ^+ builds.state + :: + =/ =build-status (~(got by builds.state) build) + =/ subs=(list ^build) ~(tap in ~(key by subs.build-status)) + =/ client=^build build + :: + |- ^+ builds.state + ?~ subs builds.state + :: + =/ sub-status=^build-status (~(got by builds.state) i.subs) + :: + =. clients.sub-status + (~(del ju clients.sub-status) anchor client) + :: + =. builds.state (~(put by builds.state) i.subs sub-status) + :: + =? builds.state !(~(has by clients.sub-status) anchor) + :: + ^$(build i.subs) + :: + $(subs t.subs) + :: +add-anchors-to-build-subs: for each sub, add all of :build's anchors + :: + ++ add-anchors-to-build-subs + ~/ %add-anchors-to-build-subs |= =build ^+ state :: =/ =build-status (~(got by builds.state) build) - =/ new-anchors ~(tap in (~(put in ~(key by clients.build-status)) [%duct duct])) + =/ new-anchors + ~(tap in (~(put in ~(key by clients.build-status)) [%duct duct])) =/ subs ~(tap in ~(key by subs.build-status)) :: =. state @@ -1459,33 +1628,6 @@ =? builds.state !already-had-anchor ^$(build i.subs) :: $(subs t.subs) - :: +remove-duct-from-subs: recursively remove duct from sub-builds - :: - ++ remove-duct-from-subs - ~/ %remove-duct-from-subs - |= =build - ^+ builds.state - :: ~& [%remove-duct-from-subs (build-to-tape build)] - :: - =/ =build-status (~(got by builds.state) build) - =/ subs=(list ^build) ~(tap in ~(key by subs.build-status)) - =/ client=^build build - :: - |- ^+ builds.state - ?~ subs builds.state - :: - =/ sub-status=^build-status (~(got by builds.state) i.subs) - :: - =. clients.sub-status - (~(del ju clients.sub-status) [%duct duct] client) - :: - =. builds.state (~(put by builds.state) i.subs sub-status) - :: - =? builds.state !(~(has by clients.sub-status) [%duct duct]) - :: - ^$(build i.subs) - :: - $(subs t.subs) :: +copy-build-tree-as-provisional: prepopulate new live build :: :: Make a provisional copy of the completed old root build tree at the @@ -1640,7 +1782,6 @@ ++ gather-build |= =build ^+ ..execute - :: ~& [%gather-build duct (build-to-tape build)] ~| [%duct duct] =/ duct-status (~(got by ducts.state) duct) :: if we already have a result for this build, don't rerun the build @@ -1656,7 +1797,7 @@ :: =/ =build-status (~(got by builds.state) build) ?: ?=(%blocked -.state.build-status) - =. state (add-ducts-to-build-subs build) + =. state (add-anchors-to-build-subs build) :: =/ sub-scrys=(list scry-request) ~(tap in (collect-blocked-sub-scrys build)) @@ -1765,7 +1906,7 @@ =. builds.state (add-subs-to-client build un-stored-new-subs [verified=%.n blocked=%.y]) :: - =. state (add-ducts-to-build-subs build) + =. state (add-anchors-to-build-subs build) :: ?^ un-stored-new-subs :: enqueue incomplete sub-builds to be promoted or run @@ -1824,7 +1965,6 @@ ++ promote-build |= [old-build=build new-date=@da new-subs=(list build)] ^+ ..execute - :: ~& [%promote-build (build-to-tape old-build) new-date] :: grab the previous result, freshening the cache :: =^ old-build-record builds.state (access-build-record old-build) @@ -1954,7 +2094,7 @@ [sub [verified=& blocked]] == :: - =. state (add-ducts-to-build-subs client) + =. state (add-anchors-to-build-subs client) :: |- ^+ state ?~ sub-builds state @@ -2921,7 +3061,6 @@ :: ?~ q.parsed =/ =path (rail-to-path source-rail) - ~& [%fail path] %- return-error :- :- %leaf %+ weld "ford: %hood: syntax error at " @@ -4570,7 +4709,6 @@ (wrap-error call-result) :: =/ product=vase vase.u.call-result - ~& [%call-result u.call-result] :: +grab might produce the wrong type :: ?. (~(nest ut p.mark-sample) | p.product) @@ -5321,7 +5459,7 @@ ?- -.live.duct-status %once =. ducts.state (~(del by ducts.state) duct) - =. state (remove-duct-from-root build) + =. state (move-root-to-cache build) :: ..execute :: @@ -5332,7 +5470,7 @@ =? state ?=(^ last-sent.live.duct-status) =/ old-build=^build build(date date.u.last-sent.live.duct-status) :: - (remove-duct-from-root old-build) + (move-root-to-cache old-build) :: =/ resource-list=(list [=disc resources=(set resource)]) ~(tap by resources) @@ -5350,8 +5488,10 @@ [%leaf "tried to subscribe to multiple discs:"] [%leaf "{}"] == + :: delete this instead of caching it, since it wasn't right + :: =. ducts.state (~(del by ducts.state) duct) - =. state (remove-duct-from-root build) + =. state (remove-anchor-from-root build [%duct duct]) ..execute :: =/ subscription=(unit subscription) @@ -5419,6 +5559,8 @@ $(orphans t.orphans) == :: + =/ =anchor [%duct duct] + :: |- ^+ ..execute ?~ orphans ..execute :: remove link to :build in :i.orphan's +build-status @@ -5427,14 +5569,14 @@ %+ update-build-status i.orphans |= orphan-status=_build-status %_ orphan-status - clients (~(del ju clients.orphan-status) [%duct duct] build) + clients (~(del ju clients.orphan-status) anchor build) == :: - ?: (~(has by clients.orphan-status) [%duct duct]) + ?: (~(has by clients.orphan-status) anchor) $(orphans t.orphans) :: :build was the last client on this duct so remove it :: - =. builds.state (remove-duct-from-subs i.orphans) + =. builds.state (remove-anchor-from-subs i.orphans anchor) =. state (cleanup i.orphans) $(orphans t.orphans) :: +access-build-record: access a +build-record, updating :last-accessed @@ -5742,7 +5884,7 @@ :: =. state-by-ship.ax %+ ~(put by state-by-ship.ax) ship - (keep:(per-event event-args) max.task) + (keep:(per-event event-args) [compiler-cache build-cache]:task) :: $(ship-states t.ship-states) :: @@ -5838,7 +5980,6 @@ =+ [ship desk date]=(raid:wired t.t.wire ~[%p %tas %da]) =/ disc [ship desk] :: - :: ~& [%pending-subscriptions pending-subscriptions.ship-state] =/ =subscription ~| [%ford-take-bad-clay-sub wire=wire duct=duct] =/ =duct-status (~(got by ducts.ship-state) duct) @@ -5846,12 +5987,10 @@ ?> ?=(^ last-sent.live.duct-status) ?> ?=(^ subscription.u.last-sent.live.duct-status) u.subscription.u.last-sent.live.duct-status - :: ~& [%subscription subscription] :: =/ ducts=(list ^duct) ~| [%ford-take-missing-subscription subscription] (get-request-ducts pending-subscriptions.ship-state subscription) - :: ~& [%ducts-for-clay-sub ducts] :: =| moves=(list move) |- ^+ [moves ship-state] @@ -5886,7 +6025,6 @@ =/ ducts=(list ^duct) ~| [%ford-take-missing-scry-request scry-request] (get-request-ducts pending-scrys.ship-state scry-request) - :: ~& [%ducts-for-scrys ducts] :: =| moves=(list move) |- ^+ [moves ship-state] diff --git a/sys/zuse.hoon b/sys/zuse.hoon index 2eac70a8d..2478fe23d 100644 --- a/sys/zuse.hoon +++ b/sys/zuse.hoon @@ -828,9 +828,9 @@ :: =schematic == - :: %keep: resize cache to :max entries + :: %keep: reset cache sizes :: - [%keep max=@ud] + [%keep compiler-cache=@ud build-cache=@ud] :: %kill: stop a build; send on same duct as original %build request :: $: %kill