SpindleyQ/honeylisp
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

preserve globals across hot reloads why doncha

Browse source
This commit is contained in:
Jeremy Penner 2021-10-04 22:00:14 -04:00
parent e11241eb10
commit 06ccd4a2b3
2 changed files with 7 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
ssc/hotswap.fnl
View file

@ -49,7 +49,6 @@
(. ssc.addr-to-callsite addr))) (. ssc.addr-to-callsite addr)))
(fn patch-stack [ssc-old ssc-new stack bank far] (fn patch-stack [ssc-old ssc-new stack bank far]
(print (length stack) bank far)
(if (= (length stack) 0) stack (if (= (length stack) 0) stack
; top-of-stack should be a callsite; look it up ; top-of-stack should be a callsite; look it up
(let [callsite-addr (read-callsite-addr stack bank far) (let [callsite-addr (read-callsite-addr stack bank far)
@ -65,8 +64,7 @@
new-top (if far (.. (stack:sub 1 1) (int24-to-bytes new-addr)) new-top (if far (.. (stack:sub 1 1) (int24-to-bytes new-addr))
(int16-to-bytes new-addr)) (int16-to-bytes new-addr))
iaftertop (if far 5 3) iaftertop (if far 5 3)
inextstack (+ iaftertop (next-callsite-offset locals)) inextstack (+ iaftertop (next-callsite-offset locals))]
_ (print (.. "locals " (fv locals) " offset " (next-callsite-offset locals)) inextstack)]
(.. new-top (stack:sub iaftertop (- inextstack 1)) (.. new-top (stack:sub iaftertop (- inextstack 1))
(if (= funcname ssc-old.prg.start-symbol) (stack:sub inextstack) ; stop when we hit the boot-up function (if (= funcname ssc-old.prg.start-symbol) (stack:sub inextstack) ; stop when we hit the boot-up function
(patch-stack ssc-old ssc-new (stack:sub inextstack) new-bank (next-callsite-far? locals))))))) (patch-stack ssc-old ssc-new (stack:sub inextstack) new-bank (next-callsite-far? locals)))))))
@ -97,23 +95,18 @@
(fn lookup-yield-bank [ssc] (bit.rshift (ssc.prg:lookup-addr :yield) 16)) (fn lookup-yield-bank [ssc] (bit.rshift (ssc.prg:lookup-addr :yield) 16))
(fn filter-nonyielding-stacks [ssc stacks] (fn filter-nonyielding-stacks [ssc stacks]
(let [yield-bank (lookup-yield-bank ssc)] (let [yield-bank (lookup-yield-bank ssc)]
(print "yield-bank" yield-bank)
(icollect [_ stack (ipairs stacks)] (icollect [_ stack (ipairs stacks)]
(let [callsite-addr (read-callsite-addr stack.stack yield-bank false) (let [callsite-addr (read-callsite-addr stack.stack yield-bank false)
callsite (lookup-callsite ssc callsite-addr) callsite (lookup-callsite ssc callsite-addr)
funcname (?. callsite :calling)] funcname (?. callsite :calling)]
(print "top callsite:" (string.format "%X" callsite-addr) (fv callsite))
(when (= funcname :yield) stack))))) (when (= funcname :yield) stack)))))
(fn hotswap-stacks [link ssc-old ssc-new] (fn hotswap-stacks [link ssc-old ssc-new]
(print "hotswappin time" link ssc-old ssc-new)
(let [stacks (read-stacks link ssc-old) (let [stacks (read-stacks link ssc-old)
_ (print "read stacks" (fv stacks))
yielding-stacks (filter-nonyielding-stacks ssc-old stacks)] yielding-stacks (filter-nonyielding-stacks ssc-old stacks)]
(print "filtered stacks" (length stacks) (length yielding-stacks))
(collect [_ {: sp-addr : stack} (ipairs yielding-stacks)] (collect [_ {: sp-addr : stack} (ipairs yielding-stacks)]
(let [(success new-stack) (pcall #(patch-stack ssc-old ssc-new stack (lookup-yield-bank ssc-old) false))] (let [(success new-stack) (pcall #(patch-stack ssc-old ssc-new stack (lookup-yield-bank ssc-old) false))]
(if success (do (print "patched" (stack:tohex) "to" (new-stack:tohex)) (values (tostring sp-addr) new-stack)) (if success (values (tostring sp-addr) new-stack)
(error (.. new-stack ": stack at " (string.format "%X" sp-addr)))))))) (error (.. new-stack ": stack at " (string.format "%X" sp-addr))))))))
{: hotswap-stacks} {: hotswap-stacks}

10
ssc/init.fnl
View file

@ -263,15 +263,15 @@
(func self ...)))) (func self ...))))
:global (lambda [self etype name ?const] :global (lambda [self etype name ?const]
(tset self.globals name {:type etype : name}) (tset self.globals name {:type etype : name})
(self.org:append name (self.org:append [:hot-preserve name
(match etype (match etype
:word [:dw ?const] :word [:dw ?const]
:long [:dl ?const] :long [:dl ?const]
_ (error (.. "Unrecognized type " (fv etype)))))) _ (error (.. "Unrecognized type " (fv etype))))]))
:buffer (lambda [self name bytes-or-size] :buffer (lambda [self name bytes-or-size]
(self.org:append name [:bytes (match (type bytes-or-size) (self.org:append [:hot-preserve name [:bytes (match (type bytes-or-size)
:string bytes-or-size :string bytes-or-size
:number (string.rep "\x00" bytes-or-size))])) :number (string.rep "\x00" bytes-or-size))]]))
:do (fn [self ...] :do (fn [self ...]
(var etype-body :void) (var etype-body :void)
(local c-body (lume.concat [:block] (icollect [i (countiter (select :# ...))] (local c-body (lume.concat [:block] (icollect [i (countiter (select :# ...))]