mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-15 18:12:47 +03:00
Add FIFO build cache. Tests pass
This commit is contained in:
Ted Blackman
parent
5d0fa0e0e7
commit
3f81f708cc
@ -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: {<requesters.build-status>}"]
|
||||
[%leaf "clients: {<~(tap in ~(key by clients.build-status))>}"]
|
||||
==
|
||||
::
|
||||
=/ braces [[' ' ' ' ~] ['{' ~] ['}' ~]]
|
||||
::
|
||||
|
||||
@ -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 "{<resource-list>}"]
|
||||
==
|
||||
:: 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]
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user