Honeylisp VM eval!
This commit is contained in:
parent
ab23a7dbe0
commit
dab1881d90
59
asm/vm.fnl
59
asm/vm.fnl
|
@ -1,6 +1,7 @@
|
||||||
(local lume (require "lib.lume"))
|
(local lume (require "lib.lume"))
|
||||||
(local {: lo : hi} (require "lib.util"))
|
(local {: lo : hi} (require "lib.util"))
|
||||||
(local link (require :link))
|
(local link (require :link))
|
||||||
|
(local asm (require :asm.asm))
|
||||||
|
|
||||||
(fn inc16-stk [l h]
|
(fn inc16-stk [l h]
|
||||||
[:block
|
[:block
|
||||||
|
@ -35,9 +36,7 @@
|
||||||
:go
|
:go
|
||||||
])
|
])
|
||||||
|
|
||||||
(fn mk-vm [prg options]
|
(fn install-vm-parser [prg]
|
||||||
(local code1 (prg:org 0xc00))
|
|
||||||
|
|
||||||
(fn prg.dat-parser.vm [bytecodes]
|
(fn prg.dat-parser.vm [bytecodes]
|
||||||
(local block (prg:new-block))
|
(local block (prg:new-block))
|
||||||
(each [_ bytecode (ipairs (lume.slice bytecodes 2))]
|
(each [_ bytecode (ipairs (lume.slice bytecodes 2))]
|
||||||
|
@ -52,7 +51,11 @@
|
||||||
(prg:parse-dats block [bytecode])
|
(prg:parse-dats block [bytecode])
|
||||||
|
|
||||||
(error (.. "VM can't parse " (fv bytecode)))))
|
(error (.. "VM can't parse " (fv bytecode)))))
|
||||||
block)
|
block))
|
||||||
|
|
||||||
|
(fn mk-vm [prg options]
|
||||||
|
(local code1 (prg:org 0xc00))
|
||||||
|
(install-vm-parser prg)
|
||||||
(local vm {
|
(local vm {
|
||||||
:IP :0x60
|
:IP :0x60
|
||||||
:IPH :0x61
|
:IPH :0x61
|
||||||
|
@ -82,10 +85,10 @@
|
||||||
:drop (fn [self] [:block [:dex] [:dex]])
|
:drop (fn [self] [:block [:dex] [:dex]])
|
||||||
:def
|
:def
|
||||||
(fn [self name ...]
|
(fn [self name ...]
|
||||||
(code1:append name [:flatten ...] (self:ret)))
|
(self.code:append name [:flatten ...] (self:ret)))
|
||||||
:word
|
:word
|
||||||
(fn [self name ...]
|
(fn [self name ...]
|
||||||
(code1:append name [:jsr :subroutine] [:vm ...] [:vm :ret]))
|
(self.code:append name [:jsr :subroutine] [:vm ...] [:vm :ret]))
|
||||||
:inline
|
:inline
|
||||||
(fn [self ...]
|
(fn [self ...]
|
||||||
[:block [:jsr :subroutine] [:vm ...] [:vm :restore]])
|
[:block [:jsr :subroutine] [:vm ...] [:vm :restore]])
|
||||||
|
@ -96,7 +99,7 @@
|
||||||
(fn [self ...]
|
(fn [self ...]
|
||||||
(if link.machine.stub
|
(if link.machine.stub
|
||||||
(do
|
(do
|
||||||
(link.machine:stub code1 :next
|
(link.machine:stub self.code :next
|
||||||
[:lda #(lo ($1:lookup-addr :G-POST-HOTSWAP-RESET))]
|
[:lda #(lo ($1:lookup-addr :G-POST-HOTSWAP-RESET))]
|
||||||
[:sta self.IP]
|
[:sta self.IP]
|
||||||
[:lda #(hi ($1:lookup-addr :G-POST-HOTSWAP-RESET))]
|
[:lda #(hi ($1:lookup-addr :G-POST-HOTSWAP-RESET))]
|
||||||
|
@ -105,8 +108,9 @@
|
||||||
[:block [:vm :debug-stub :jmp :no-hotswap-reset [:block :G-POST-HOTSWAP-RESET] ...] :no-hotswap-reset])
|
[:block [:vm :debug-stub :jmp :no-hotswap-reset [:block :G-POST-HOTSWAP-RESET] ...] :no-hotswap-reset])
|
||||||
[:block]))
|
[:block]))
|
||||||
})
|
})
|
||||||
|
(set prg.vm vm)
|
||||||
|
|
||||||
(code1:append :next
|
(vm.code:append :next
|
||||||
[:ldy 0]
|
[:ldy 0]
|
||||||
[:lda [vm.IP] :y] [:sta vm.W]
|
[:lda [vm.IP] :y] [:sta vm.W]
|
||||||
(inc16 vm.IP vm.IPH)
|
(inc16 vm.IP vm.IPH)
|
||||||
|
@ -115,7 +119,7 @@
|
||||||
|
|
||||||
[:jmp [vm.W]])
|
[:jmp [vm.W]])
|
||||||
|
|
||||||
(code1:append :reset
|
(vm.code:append :reset
|
||||||
[:lda #(lo ($1:lookup-addr :quit))]
|
[:lda #(lo ($1:lookup-addr :quit))]
|
||||||
[:sta vm.IP]
|
[:sta vm.IP]
|
||||||
[:lda #(hi ($1:lookup-addr :quit))]
|
[:lda #(hi ($1:lookup-addr :quit))]
|
||||||
|
@ -141,9 +145,9 @@
|
||||||
[:dey] [:lda vm.RSTACK :y] [:sta vm.IP]
|
[:dey] [:lda vm.RSTACK :y] [:sta vm.IP]
|
||||||
[:sty vm.ROFF])
|
[:sty vm.ROFF])
|
||||||
|
|
||||||
(code1:append :native [:jmp [vm.IP]])
|
(vm.code:append :native [:jmp [vm.IP]])
|
||||||
(code1:append :quit [:rts])
|
(vm.code:append :quit [:rts])
|
||||||
(code1:append :restore
|
(vm.code:append :restore
|
||||||
[:lda vm.IP] [:sta vm.W]
|
[:lda vm.IP] [:sta vm.W]
|
||||||
[:lda vm.IPH] [:sta vm.WH]
|
[:lda vm.IPH] [:sta vm.WH]
|
||||||
[:ldy vm.ROFF]
|
[:ldy vm.ROFF]
|
||||||
|
@ -152,6 +156,11 @@
|
||||||
[:sty vm.ROFF]
|
[:sty vm.ROFF]
|
||||||
[:jmp [vm.W]])
|
[:jmp [vm.W]])
|
||||||
|
|
||||||
|
(vm.code:append :execute
|
||||||
|
[:lda vm.TOP :x] [:sta vm.W]
|
||||||
|
[:lda vm.TOPH :x] [:sta vm.WH]
|
||||||
|
(vm:drop)
|
||||||
|
[:jmp [vm.W]])
|
||||||
|
|
||||||
(vm:def :drop (vm:drop))
|
(vm:def :drop (vm:drop))
|
||||||
|
|
||||||
|
@ -325,6 +334,32 @@
|
||||||
(if (= (type init) :table) init
|
(if (= (type init) :table) init
|
||||||
[:dw init])))
|
[:dw init])))
|
||||||
|
|
||||||
|
(fn vm.defer [self name ?init]
|
||||||
|
(self.code:append name [:jmp (or ?init :next)]))
|
||||||
|
|
||||||
|
(vm:word :redefine ; xp deferredxp --
|
||||||
|
1 :+ :set)
|
||||||
|
|
||||||
|
(fn vm.override-deferred-parent [self prg name redirect]
|
||||||
|
(local addr (prg.prg-base:lookup-addr name))
|
||||||
|
(local org (prg:org (+ addr 1)))
|
||||||
|
(org:append [:ref redirect]))
|
||||||
|
|
||||||
|
(vm:defer :interactive-eval-checkpoint)
|
||||||
|
|
||||||
|
(fn vm.gen-eval-prg [self vmcode]
|
||||||
|
(local eval-prg (asm.new self.code.prg))
|
||||||
|
(install-vm-parser eval-prg)
|
||||||
|
(local org (eval-prg:org self.code.org))
|
||||||
|
(org:append :code-to-eval
|
||||||
|
[:jsr :subroutine]
|
||||||
|
[:vm :lit :next :lit :interactive-eval-checkpoint :redefine]
|
||||||
|
vmcode
|
||||||
|
[:vm :ret])
|
||||||
|
(self:override-deferred-parent eval-prg :interactive-eval-checkpoint :code-to-eval)
|
||||||
|
(eval-prg:assemble)
|
||||||
|
eval-prg)
|
||||||
|
|
||||||
(vm:def :+ ; a b -- c
|
(vm:def :+ ; a b -- c
|
||||||
[:clc]
|
[:clc]
|
||||||
[:lda vm.ST1 :x] [:adc vm.TOP :x] [:sta vm.ST1 :x]
|
[:lda vm.ST1 :x] [:adc vm.TOP :x] [:sta vm.ST1 :x]
|
||||||
|
|
|
@ -273,6 +273,7 @@
|
||||||
:full-redraw
|
:full-redraw
|
||||||
(vm:forever
|
(vm:forever
|
||||||
(vm:hotswap-sync :full-redraw)
|
(vm:hotswap-sync :full-redraw)
|
||||||
|
:interactive-eval-checkpoint
|
||||||
:handle-key
|
:handle-key
|
||||||
)
|
)
|
||||||
:quit])
|
:quit])
|
||||||
|
|
|
@ -121,6 +121,10 @@
|
||||||
(prg-new:upload self)
|
(prg-new:upload self)
|
||||||
(self:jump (prg-new:lookup-addr :on-hotswap))
|
(self:jump (prg-new:lookup-addr :on-hotswap))
|
||||||
(self:continue))))
|
(self:continue))))
|
||||||
|
(fn Machine.overlay [self prg-overlay]
|
||||||
|
(self:step)
|
||||||
|
(prg-overlay:upload self)
|
||||||
|
(self:continue))
|
||||||
|
|
||||||
(Machine:new)
|
(Machine:new)
|
||||||
|
|
||||||
|
|
13
wrap.fnl
13
wrap.fnl
|
@ -21,6 +21,18 @@
|
||||||
(core.log "Reloaded!")
|
(core.log "Reloaded!")
|
||||||
(core.log "Reload failed")))
|
(core.log "Reload failed")))
|
||||||
})
|
})
|
||||||
|
|
||||||
|
(command.add #(and (link.machine:connected?) link.machine.overlay) {
|
||||||
|
"honeylisp:vm-eval" (fn []
|
||||||
|
(fn vm-eval [code]
|
||||||
|
(local vmcode (fennel.eval (.. "[:vm " code "]") {:env _G :compiler-env _G}))
|
||||||
|
(local prg (require :game))
|
||||||
|
(local overlay (prg.vm:gen-eval-prg vmcode))
|
||||||
|
(link.machine:overlay overlay)
|
||||||
|
"")
|
||||||
|
(editor.inline-eval vm-eval))
|
||||||
|
})
|
||||||
|
|
||||||
(command.add (fn [] true) {
|
(command.add (fn [] true) {
|
||||||
"honeylisp:rebuild" #(util.reload "game")
|
"honeylisp:rebuild" #(util.reload "game")
|
||||||
})
|
})
|
||||||
|
@ -53,6 +65,7 @@
|
||||||
})
|
})
|
||||||
(keymap.add {
|
(keymap.add {
|
||||||
"alt+e" "fennel:eval"
|
"alt+e" "fennel:eval"
|
||||||
|
"alt+v" "honeylisp:vm-eval"
|
||||||
"alt+r" "lume:hotswap"
|
"alt+r" "lume:hotswap"
|
||||||
"alt+a" "honeylisp:address"
|
"alt+a" "honeylisp:address"
|
||||||
"alt+l" "honeylisp:reload"
|
"alt+l" "honeylisp:reload"
|
||||||
|
|
Loading…
Reference in a new issue