From 1a93fc7e8456251bfdeb954a9ab0ac4441d18f5b Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Sun, 20 Sep 2020 13:55:06 -0400 Subject: [PATCH] A bunch of stuff - refactor assembler to be more modular / extensible - fix a bunch of bugs - better error reporting - stop using imgui in favour of lite commands - in-editor hotswap & eval hotkeys - machine:write in batches so bytes aren't dropped - first cut at stack VM primitives --- asm.fnl | 320 +++++++++++---------- lume.lua | 780 ++++++++++++++++++++++++++++++++++++++++++++++++++++ machine.fnl | 41 +-- main.lua | 3 +- spawn.lua | 5 +- stream.fnl | 12 +- test.fnl | 160 ++++++++++- wrap.fnl | 49 +++- 8 files changed, 1173 insertions(+), 197 deletions(-) create mode 100644 lume.lua diff --git a/asm.fnl b/asm.fnl index 920aca2..b08d4c5 100644 --- a/asm.fnl +++ b/asm.fnl @@ -23,7 +23,7 @@ (local base (bit.bor cc (bit.lshift aaa 5))) (fn [mode] (local bbb (. modemap mode)) - (if bbb (bit.bor base (bit.lshift bbb 2)) nil))) + (if bbb (bit.bor base (bit.lshift bbb 2)) nil))) (fn indexed-modes [...] (let [modemap {}] @@ -49,7 +49,6 @@ (each [opcode aaa (pairs ops)] (tset opcodes opcode (aaabbbcc aaa 1 cc1-modes)) (tset opcodes :sta (aaabbbcc 4 1 (without-modes cc1-modes :imm))))) - ; cc=2 ops (let [cc2-modes (indexed-modes nil :zp :a :abs nil :zp-x nil :abs-x)] (each [opcode aaa (pairs {:asl 0 :rol 1 :lsr 2 :ror 3})] @@ -79,172 +78,193 @@ (match op [_ :a] [:a nil] ([_ imm] ? (= (type imm) "number")) [:imm imm] - ([op addr] ? (and (= (type addr) "string") (= (op:sub 1 1) "b"))) [:rel addr] ; branch - ([_ addr] ? (= (type addr) "string")) [:addr addr] + ([opcode addr] ? (and (= (type addr) "string") (= (opcode:sub 1 1) "b"))) [:rel addr] ; branch [_ addr :x] [:addr-x addr] - [_ addr :y] [:addr-y addr] [_ [addr] :y] [:zp*-y addr] + [_ addr :y] [:addr-y addr] [_ [addr :x]] [:zp-x* addr] + ([_ addr] ? (= (type addr) "string")) [:addr addr] [_ [addr]] [:abs* addr] [_] [nil nil] _ (error (.. "Unrecognized syntax" (fv op))))) -(fn parse-ops [block ops] - (var index 1) - (each [_ op (ipairs ops)] - (if (= (type op) "string") - (tset block.symbols op index) - (let [opcode (. op 1)] - (if - (. opcodes opcode) - (let [[mode arg] (parse-mode-arg op)] - (table.insert block.code {: opcode : mode : arg})) - - (= opcode :block) - (let [ops (table.clone op)] - (table.remove ops 1) - (table.insert block.code (parse-ops {: opcode :code [] :symbols {}} ops))) - - (error (.. "Unrecognized opcode " (fv opcode)))) +; dat - anything that takes up space in the assembled output (op, dw, db, etc) +; takes the form [:op args] +; pdat - a parsed dat; takes the form {:type type :addr addr ...} +(local dat-parser {}) +(fn parse-dats [block dats] + (var index (+ (length block.pdats) 1)) + (each [_ dat (ipairs dats)] + (if (= (type dat) "string") + (tset block.symbols dat index) + (let [opcode (. dat 1) + parser (. dat-parser opcode) + pdat + (if + parser (parser dat) + (. opcodes opcode) (dat-parser.op dat) + (error (.. "Unrecognized opcode " (fv opcode))))] + (table.insert block.pdats pdat) (set index (+ index 1))))) block) -(fn block [org ...] (parse-ops {:type :code : org :code [] :symbols {}} [...])) -(fn db [org init] {:type :var : org : init :size 1}) -(fn dw [org init] {:type :var : org : init :size 2}) -(fn allot [org size] {:type :var : org : size}) +(fn dat-parser.op [op] + (let [[mode arg] (parse-mode-arg op)] + {:type :op :opcode (. op 1) : mode : arg})) -(fn make-env [blocks] - {: blocks - :push (fn [self block] - (make-env - (-> (stream self.blocks) - (: :concat (one block)) - (: :tolist)))) - :lookup - (fn [self name] - (-> (stream self.blocks) - (: :reverse) - (: :map - (fn [block] - (let [symbol (. block.symbols name)] - (match (type symbol) - "number" (. block.code symbol) - "table" symbol - _ nil)))) - (: :filter (fn [symbol] symbol)) - (: :first))) - :lookup-block +(fn dat-parser.block [block] + (let [dats (table.clone block)] + (table.remove dats 1) + (parse-dats {:type :block :pdats [] :symbols {}} dats))) + +(fn dat-parser.db [db] {:type :var :init (. db 2) :size 1}) +(fn dat-parser.dw [dw] {:type :var :init (. dw 2) :size 2}) +(fn dat-parser.bytes [bytes] {:type :raw : bytes}) + +(fn make-env [block parent] + {:parent parent + :block block + :is-zp? (fn [self name] (self.parent:is-zp? name)) + :lookup-addr (fn [self name] + (local ipdat (. self.block.symbols name)) + (print "looking up" name "in" self) (if - (-> (stream self.blocks) - (: :skip 1) - (: :filter (fn [block] (. block.symbols name))) - (: :next)) - (. self.blocks 2) - (. (. self.blocks 1) name))) - :is-zp? (fn [self name] (< (. (self:lookup-block name) :org) 0x100))}) + (and ipdat (> ipdat (length self.block.pdats))) + (+ self.block.addr self.block.size) -(fn op-stream [env block] - (-> (stream block.code) - (: :map - (fn [op] - (if (= op.opcode :block) - (: (one op env) - :concat (op-stream (env:push op) op)) - (one op env)))) - (: :flatten))) + ipdat (. self.block.pdats ipdat :addr) + + (self.parent:lookup-addr name)))}) (fn int8-to-bytes [i] (string.char (bit.band i 0xff))) (fn int16-to-bytes [i] (string.char (bit.band i 0xff) (bit.band (bit.rshift i 8) 0xff))) -(fn program [] - {:symbols {} - :start-symbol :main - :add (fn [self name elem] (tset self.symbols name elem)) - :block (fn [self name org ...] (self:add name (block org ...))) - :db (fn [self name org init] (self:add name (db org init))) - :dw (fn [self name org init] (self:add name (dw org init))) - :allot (fn [self name org size] (self:add name (allot org size))) - :op-stream - (fn [self block] (op-stream (make-env [self block]) block)) - :patch-addr-modes - (fn [self] - (each [name block (pairs self.symbols)] - (each [op env (: (self:op-stream block) :iter)] - (when (and op.mode (= (op.mode:sub 1 4) :addr)) - (let [zp-mode (.. :zp (op.mode:sub 5)) - abs-mode (.. :abs (op.mode:sub 5)) - is-zp (and ((. opcodes op.opcode) zp-mode) (env:is-zp? op.arg))] - (set op.mode (if is-zp zp-mode abs-mode))))))) - :allocate - (fn [self org size org-addr] - (var addr (. org-addr org)) - (when (= nil addr) - (tset org-addr org org) - (set addr org)) - (tset org-addr org (+ addr size)) - addr) - :allocate-var-block - (fn [self block org-addr] - (set block.addr (self:allocate block.org block.size org-addr))) - :allocate-code-block - (fn [self block org-addr] - (set block.addr (self:allocate block.org 0 org-addr)) - (each [op env (: (self:op-stream block) :iter)] - (set op.addr (self:allocate block.org (opsize op) org-addr)))) - :allocate-addresses - (fn [self] - (let [org-addr {}] - (each [name block (pairs self.symbols)] - (match block.type - :var (self:allocate-var-block block org-addr) - :code (self:allocate-code-block block org-addr))))) - :generate-var-block - (fn [self block] - (match block.size - 1 (int8-to-bytes (or block.init 0)) - 2 (int16-to-bytes (or block.init 0)) - n (string.rep "\0" n))) - :lookup-addr - (fn [self sym env] - (local op (env:lookup sym)) - (if op - op.addr - (tonumber sym))) - :generate-op-arg - (fn [self op env] - (if - (= op.mode :imm) (int8-to-bytes op.arg) - (= op.mode :rel) - (int8-to-bytes (- (self:lookup-addr op.arg env) (+ op.addr 2))) - (= (size op.mode) 2) (int8-to-bytes (self:lookup-addr op.arg env)) - (= (size op.mode) 3) (int16-to-bytes (self:lookup-addr op.arg env)) - "")) - :generate-op - (fn [self op env] - (let [bytegen (. opcodes op.opcode)] - (if bytegen - (.. (int8-to-bytes (bytegen op.mode)) (self:generate-op-arg op env)) - ""))) - :generate-code-block - (fn [self block] - (var bytes "") - (each [op env (: (self:op-stream block) :iter)] - (set bytes (.. bytes (self:generate-op op env)))) - (set block.bytes bytes)) - :generate-bytes - (fn [self] - (each [name block (pairs self.symbols)] - (match block.type - :var (self:generate-var-block block) - :code (self:generate-code-block block)))) - :assemble - (fn [self] - (self:patch-addr-modes) - (self:allocate-addresses) - (self:generate-bytes))}) +(local pdat-processor { + :op {} + :var {} + :raw {} + :block {} +}) -program \ No newline at end of file +(fn pdat-processor.op.patch [op env] + (when (and op.mode (= (op.mode:sub 1 4) :addr)) + (let [zp-mode (.. :zp (op.mode:sub 5)) + abs-mode (.. :abs (op.mode:sub 5)) + is-zp (and ((. opcodes op.opcode) zp-mode) (env:is-zp? op.arg))] + (set op.mode (if is-zp zp-mode abs-mode))))) + +(fn pdat-processor.raw.size [raw] (length raw.bytes)) +(fn pdat-processor.op.size [op] (size op.mode)) +(fn pdat-processor.var.size [d] d.size) + +(fn pdat-processor.op.bytes [op env] + (local bytegen (. opcodes op.opcode)) + (pp op) + (if bytegen + (let [opbyte (bytegen op.mode) + argbytes + (if + (= op.mode :imm) (int8-to-bytes op.arg) + (= op.mode :rel) + (int8-to-bytes (- (env:lookup-addr op.arg env) (+ op.addr 2))) + (= (size op.mode) 2) (int8-to-bytes (env:lookup-addr op.arg env)) + (= (size op.mode) 3) (int16-to-bytes (env:lookup-addr op.arg env)) + "")] + (if opbyte + (.. (int8-to-bytes opbyte) argbytes) + (error (.. op.opcode " doesn't support mode " op.mode)))) + "")) +(fn pdat-processor.var.bytes [d env] + (match d.size + 1 (int8-to-bytes (or d.init 0)) + 2 (int16-to-bytes (or d.init 0)) + n (string.rep "\0" n))) + +(fn process-pdat [pdat process default ...] + (local processor (. pdat-processor pdat.type process)) + (if processor (processor pdat ...) default)) + +(fn pdat-processor.block.symbols [block] + (lume.keys block.symbols)) + +(fn pdat-processor.block.patch [block env] + (local block-env (make-env block env)) + (each [_ pdat (ipairs block.pdats)] + (process-pdat pdat :patch nil block-env))) + +(fn pdat-processor.block.allocate [block addr] + (var size 0) + (set block.addr addr) + (each [_ pdat (ipairs block.pdats)] + (set pdat.addr (+ addr size)) + (process-pdat pdat :allocate nil pdat.addr) + (local pdatsize (process-pdat pdat :size pdat.size)) + (set pdat.size pdatsize) + (set pdat.addr (+ addr size)) + (set size (+ size pdatsize))) + (set block.size size)) + +(fn pdat-processor.block.generate [block env] + (local block-env (make-env block env)) + (var bytes "") + (each [_ pdat (ipairs block.pdats)] + (process-pdat pdat :generate nil block-env) + (local pdatbytes (process-pdat pdat :bytes pdat.bytes block-env)) + (set pdat.bytes pdatbytes) + (set bytes (.. bytes pdatbytes))) + (set block.bytes bytes)) + +(fn program [] + {:type :program + :org-to-block {} + :symbol-to-org {} + :start-symbol :main + :org + (fn [self org] + (var block (. self.org-to-block org)) + (when (not block) + (set block {:type :block :pdats [] :symbols {}}) + (tset self.org-to-block org block)) + {: block + :append (fn [self ...] (parse-dats self.block [...]) self)}) + :is-zp? + (fn [self name] + (local org (. self.symbol-to-org name)) + (if (not= org nil) + (< org 0x100) + (< (tonumber name) 0x100))) + :lookup-addr + (fn [self name] + (print "looking up" name "in" self) + (local org (. self.symbol-to-org name)) + (local addr (and org (: (make-env (. self.org-to-block org) self) :lookup-addr name))) + (if (not= addr nil) + addr + (tonumber name))) + :pass + (fn [self passname] + (each [org block (pairs self.org-to-block)] + (: self passname org block))) + :gather-symbols + (fn [self org block] + (each [_ name (ipairs (process-pdat block :symbols []))] + (tset self.symbol-to-org name org))) + :patch (fn [self org block] (process-pdat block :patch nil self)) + :allocate (fn [self org block] (process-pdat block :allocate nil org)) + :generate (fn [self org block] (process-pdat block :generate nil self)) + :assemble + (fn [self] + (self:pass :gather-symbols) + (self:pass :patch) + (self:pass :allocate) + (self:pass :generate)) + :upload + (fn [self machine] + (each [org block (pairs self.org-to-block)] + (machine:write org block.bytes))) + }) + +{: program} diff --git a/lume.lua b/lume.lua new file mode 100644 index 0000000..2157891 --- /dev/null +++ b/lume.lua @@ -0,0 +1,780 @@ +-- +-- lume +-- +-- Copyright (c) 2020 rxi +-- +-- Permission is hereby granted, free of charge, to any person obtaining a copy of +-- this software and associated documentation files (the "Software"), to deal in +-- the Software without restriction, including without limitation the rights to +-- use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +-- of the Software, and to permit persons to whom the Software is furnished to do +-- so, subject to the following conditions: +-- +-- The above copyright notice and this permission notice shall be included in all +-- copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +-- SOFTWARE. +-- + +local lume = { _version = "2.3.0" } + +local pairs, ipairs = pairs, ipairs +local type, assert, unpack = type, assert, unpack or table.unpack +local tostring, tonumber = tostring, tonumber +local math_floor = math.floor +local math_ceil = math.ceil +local math_atan2 = math.atan2 or math.atan +local math_sqrt = math.sqrt +local math_abs = math.abs + +local noop = function() +end + +local identity = function(x) + return x +end + +local patternescape = function(str) + return str:gsub("[%(%)%.%%%+%-%*%?%[%]%^%$]", "%%%1") +end + +local absindex = function(len, i) + return i < 0 and (len + i + 1) or i +end + +local iscallable = function(x) + if type(x) == "function" then return true end + local mt = getmetatable(x) + return mt and mt.__call ~= nil +end + +local getiter = function(x) + if lume.isarray(x) then + return ipairs + elseif type(x) == "table" then + return pairs + end + error("expected table", 3) +end + +local iteratee = function(x) + if x == nil then return identity end + if iscallable(x) then return x end + if type(x) == "table" then + return function(z) + for k, v in pairs(x) do + if z[k] ~= v then return false end + end + return true + end + end + return function(z) return z[x] end +end + + + +function lume.clamp(x, min, max) + return x < min and min or (x > max and max or x) +end + + +function lume.round(x, increment) + if increment then return lume.round(x / increment) * increment end + return x >= 0 and math_floor(x + .5) or math_ceil(x - .5) +end + + +function lume.sign(x) + return x < 0 and -1 or 1 +end + + +function lume.lerp(a, b, amount) + return a + (b - a) * lume.clamp(amount, 0, 1) +end + + +function lume.smooth(a, b, amount) + local t = lume.clamp(amount, 0, 1) + local m = t * t * (3 - 2 * t) + return a + (b - a) * m +end + + +function lume.pingpong(x) + return 1 - math_abs(1 - x % 2) +end + + +function lume.distance(x1, y1, x2, y2, squared) + local dx = x1 - x2 + local dy = y1 - y2 + local s = dx * dx + dy * dy + return squared and s or math_sqrt(s) +end + + +function lume.angle(x1, y1, x2, y2) + return math_atan2(y2 - y1, x2 - x1) +end + + +function lume.vector(angle, magnitude) + return math.cos(angle) * magnitude, math.sin(angle) * magnitude +end + + +function lume.random(a, b) + if not a then a, b = 0, 1 end + if not b then b = 0 end + return a + math.random() * (b - a) +end + + +function lume.randomchoice(t) + return t[math.random(#t)] +end + + +function lume.weightedchoice(t) + local sum = 0 + for _, v in pairs(t) do + assert(v >= 0, "weight value less than zero") + sum = sum + v + end + assert(sum ~= 0, "all weights are zero") + local rnd = lume.random(sum) + for k, v in pairs(t) do + if rnd < v then return k end + rnd = rnd - v + end +end + + +function lume.isarray(x) + return type(x) == "table" and x[1] ~= nil +end + + +function lume.push(t, ...) + local n = select("#", ...) + for i = 1, n do + t[#t + 1] = select(i, ...) + end + return ... +end + + +function lume.remove(t, x) + local iter = getiter(t) + for i, v in iter(t) do + if v == x then + if lume.isarray(t) then + table.remove(t, i) + break + else + t[i] = nil + break + end + end + end + return x +end + + +function lume.clear(t) + local iter = getiter(t) + for k in iter(t) do + t[k] = nil + end + return t +end + + +function lume.extend(t, ...) + for i = 1, select("#", ...) do + local x = select(i, ...) + if x then + for k, v in pairs(x) do + t[k] = v + end + end + end + return t +end + + +function lume.shuffle(t) + local rtn = {} + for i = 1, #t do + local r = math.random(i) + if r ~= i then + rtn[i] = rtn[r] + end + rtn[r] = t[i] + end + return rtn +end + + +function lume.sort(t, comp) + local rtn = lume.clone(t) + if comp then + if type(comp) == "string" then + table.sort(rtn, function(a, b) return a[comp] < b[comp] end) + else + table.sort(rtn, comp) + end + else + table.sort(rtn) + end + return rtn +end + + +function lume.array(...) + local t = {} + for x in ... do t[#t + 1] = x end + return t +end + + +function lume.each(t, fn, ...) + local iter = getiter(t) + if type(fn) == "string" then + for _, v in iter(t) do v[fn](v, ...) end + else + for _, v in iter(t) do fn(v, ...) end + end + return t +end + + +function lume.map(t, fn) + fn = iteratee(fn) + local iter = getiter(t) + local rtn = {} + for k, v in iter(t) do rtn[k] = fn(v) end + return rtn +end + + +function lume.all(t, fn) + fn = iteratee(fn) + local iter = getiter(t) + for _, v in iter(t) do + if not fn(v) then return false end + end + return true +end + + +function lume.any(t, fn) + fn = iteratee(fn) + local iter = getiter(t) + for _, v in iter(t) do + if fn(v) then return true end + end + return false +end + + +function lume.reduce(t, fn, first) + local started = first ~= nil + local acc = first + local iter = getiter(t) + for _, v in iter(t) do + if started then + acc = fn(acc, v) + else + acc = v + started = true + end + end + assert(started, "reduce of an empty table with no first value") + return acc +end + + +function lume.unique(t) + local rtn = {} + for k in pairs(lume.invert(t)) do + rtn[#rtn + 1] = k + end + return rtn +end + + +function lume.filter(t, fn, retainkeys) + fn = iteratee(fn) + local iter = getiter(t) + local rtn = {} + if retainkeys then + for k, v in iter(t) do + if fn(v) then rtn[k] = v end + end + else + for _, v in iter(t) do + if fn(v) then rtn[#rtn + 1] = v end + end + end + return rtn +end + + +function lume.reject(t, fn, retainkeys) + fn = iteratee(fn) + local iter = getiter(t) + local rtn = {} + if retainkeys then + for k, v in iter(t) do + if not fn(v) then rtn[k] = v end + end + else + for _, v in iter(t) do + if not fn(v) then rtn[#rtn + 1] = v end + end + end + return rtn +end + + +function lume.merge(...) + local rtn = {} + for i = 1, select("#", ...) do + local t = select(i, ...) + local iter = getiter(t) + for k, v in iter(t) do + rtn[k] = v + end + end + return rtn +end + + +function lume.concat(...) + local rtn = {} + for i = 1, select("#", ...) do + local t = select(i, ...) + if t ~= nil then + local iter = getiter(t) + for _, v in iter(t) do + rtn[#rtn + 1] = v + end + end + end + return rtn +end + + +function lume.find(t, value) + local iter = getiter(t) + for k, v in iter(t) do + if v == value then return k end + end + return nil +end + + +function lume.match(t, fn) + fn = iteratee(fn) + local iter = getiter(t) + for k, v in iter(t) do + if fn(v) then return v, k end + end + return nil +end + + +function lume.count(t, fn) + local count = 0 + local iter = getiter(t) + if fn then + fn = iteratee(fn) + for _, v in iter(t) do + if fn(v) then count = count + 1 end + end + else + if lume.isarray(t) then + return #t + end + for _ in iter(t) do count = count + 1 end + end + return count +end + + +function lume.slice(t, i, j) + i = i and absindex(#t, i) or 1 + j = j and absindex(#t, j) or #t + local rtn = {} + for x = i < 1 and 1 or i, j > #t and #t or j do + rtn[#rtn + 1] = t[x] + end + return rtn +end + + +function lume.first(t, n) + if not n then return t[1] end + return lume.slice(t, 1, n) +end + + +function lume.last(t, n) + if not n then return t[#t] end + return lume.slice(t, -n, -1) +end + + +function lume.invert(t) + local rtn = {} + for k, v in pairs(t) do rtn[v] = k end + return rtn +end + + +function lume.pick(t, ...) + local rtn = {} + for i = 1, select("#", ...) do + local k = select(i, ...) + rtn[k] = t[k] + end + return rtn +end + + +function lume.keys(t) + local rtn = {} + local iter = getiter(t) + for k in iter(t) do rtn[#rtn + 1] = k end + return rtn +end + + +function lume.clone(t) + local rtn = {} + for k, v in pairs(t) do rtn[k] = v end + return rtn +end + + +function lume.fn(fn, ...) + assert(iscallable(fn), "expected a function as the first argument") + local args = { ... } + return function(...) + local a = lume.concat(args, { ... }) + return fn(unpack(a)) + end +end + + +function lume.once(fn, ...) + local f = lume.fn(fn, ...) + local done = false + return function(...) + if done then return end + done = true + return f(...) + end +end + + +local memoize_fnkey = {} +local memoize_nil = {} + +function lume.memoize(fn) + local cache = {} + return function(...) + local c = cache + for i = 1, select("#", ...) do + local a = select(i, ...) or memoize_nil + c[a] = c[a] or {} + c = c[a] + end + c[memoize_fnkey] = c[memoize_fnkey] or {fn(...)} + return unpack(c[memoize_fnkey]) + end +end + + +function lume.combine(...) + local n = select('#', ...) + if n == 0 then return noop end + if n == 1 then + local fn = select(1, ...) + if not fn then return noop end + assert(iscallable(fn), "expected a function or nil") + return fn + end + local funcs = {} + for i = 1, n do + local fn = select(i, ...) + if fn ~= nil then + assert(iscallable(fn), "expected a function or nil") + funcs[#funcs + 1] = fn + end + end + return function(...) + for _, f in ipairs(funcs) do f(...) end + end +end + + +function lume.call(fn, ...) + if fn then + return fn(...) + end +end + + +function lume.time(fn, ...) + local start = os.clock() + local rtn = {fn(...)} + return (os.clock() - start), unpack(rtn) +end + + +local lambda_cache = {} + +function lume.lambda(str) + if not lambda_cache[str] then + local args, body = str:match([[^([%w,_ ]-)%->(.-)$]]) + assert(args and body, "bad string lambda") + local s = "return function(" .. args .. ")\nreturn " .. body .. "\nend" + lambda_cache[str] = lume.dostring(s) + end + return lambda_cache[str] +end + + +local serialize + +local serialize_map = { + [ "boolean" ] = tostring, + [ "nil" ] = tostring, + [ "string" ] = function(v) return string.format("%q", v) end, + [ "number" ] = function(v) + if v ~= v then return "0/0" -- nan + elseif v == 1 / 0 then return "1/0" -- inf + elseif v == -1 / 0 then return "-1/0" end -- -inf + return tostring(v) + end, + [ "table" ] = function(t, stk) + stk = stk or {} + if stk[t] then error("circular reference") end + local rtn = {} + stk[t] = true + for k, v in pairs(t) do + rtn[#rtn + 1] = "[" .. serialize(k, stk) .. "]=" .. serialize(v, stk) + end + stk[t] = nil + return "{" .. table.concat(rtn, ",") .. "}" + end +} + +setmetatable(serialize_map, { + __index = function(_, k) error("unsupported serialize type: " .. k) end +}) + +serialize = function(x, stk) + return serialize_map[type(x)](x, stk) +end + +function lume.serialize(x) + return serialize(x) +end + + +function lume.deserialize(str) + return lume.dostring("return " .. str) +end + + +function lume.split(str, sep) + if not sep then + return lume.array(str:gmatch("([%S]+)")) + else + assert(sep ~= "", "empty separator") + local psep = patternescape(sep) + return lume.array((str..sep):gmatch("(.-)("..psep..")")) + end +end + + +function lume.trim(str, chars) + if not chars then return str:match("^[%s]*(.-)[%s]*$") end + chars = patternescape(chars) + return str:match("^[" .. chars .. "]*(.-)[" .. chars .. "]*$") +end + + +function lume.wordwrap(str, limit) + limit = limit or 72 + local check + if type(limit) == "number" then + check = function(s) return #s >= limit end + else + check = limit + end + local rtn = {} + local line = "" + for word, spaces in str:gmatch("(%S+)(%s*)") do + local s = line .. word + if check(s) then + table.insert(rtn, line .. "\n") + line = word + else + line = s + end + for c in spaces:gmatch(".") do + if c == "\n" then + table.insert(rtn, line .. "\n") + line = "" + else + line = line .. c + end + end + end + table.insert(rtn, line) + return table.concat(rtn) +end + + +function lume.format(str, vars) + if not vars then return str end + local f = function(x) + return tostring(vars[x] or vars[tonumber(x)] or "{" .. x .. "}") + end + return (str:gsub("{(.-)}", f)) +end + + +function lume.trace(...) + local info = debug.getinfo(2, "Sl") + local t = { info.short_src .. ":" .. info.currentline .. ":" } + for i = 1, select("#", ...) do + local x = select(i, ...) + if type(x) == "number" then + x = string.format("%g", lume.round(x, .01)) + end + t[#t + 1] = tostring(x) + end + print(table.concat(t, " ")) +end + + +function lume.dostring(str) + return assert((loadstring or load)(str))() +end + + +function lume.uuid() + local fn = function(x) + local r = math.random(16) - 1 + r = (x == "x") and (r + 1) or (r % 4) + 9 + return ("0123456789abcdef"):sub(r, r) + end + return (("xxxxxxxx-xxxx-4xxx-yxxx-xxxxxxxxxxxx"):gsub("[xy]", fn)) +end + + +function lume.hotswap(modname) + local oldglobal = lume.clone(_G) + local updated = {} + local function update(old, new) + if updated[old] then return end + updated[old] = true + local oldmt, newmt = getmetatable(old), getmetatable(new) + if oldmt and newmt then update(oldmt, newmt) end + for k, v in pairs(new) do + if type(v) == "table" then update(old[k], v) else old[k] = v end + end + end + local err = nil + local function onerror(e) + for k in pairs(_G) do _G[k] = oldglobal[k] end + err = lume.trim(e) + end + local ok, oldmod = pcall(require, modname) + oldmod = ok and oldmod or nil + xpcall(function() + package.loaded[modname] = nil + local newmod = require(modname) + if type(oldmod) == "table" then update(oldmod, newmod) end + for k, v in pairs(oldglobal) do + if v ~= _G[k] and type(v) == "table" then + update(v, _G[k]) + _G[k] = v + end + end + end, onerror) + package.loaded[modname] = oldmod + if err then return nil, err end + return oldmod +end + + +local ripairs_iter = function(t, i) + i = i - 1 + local v = t[i] + if v ~= nil then + return i, v + end +end + +function lume.ripairs(t) + return ripairs_iter, t, (#t + 1) +end + + +function lume.color(str, mul) + mul = mul or 1 + local r, g, b, a + r, g, b = str:match("#(%x%x)(%x%x)(%x%x)") + if r then + r = tonumber(r, 16) / 0xff + g = tonumber(g, 16) / 0xff + b = tonumber(b, 16) / 0xff + a = 1 + elseif str:match("rgba?%s*%([%d%s%.,]+%)") then + local f = str:gmatch("[%d.]+") + r = (f() or 0) / 0xff + g = (f() or 0) / 0xff + b = (f() or 0) / 0xff + a = f() or 1 + else + error(("bad color string '%s'"):format(str)) + end + return r * mul, g * mul, b * mul, a * mul +end + + +local chain_mt = {} +chain_mt.__index = lume.map(lume.filter(lume, iscallable, true), + function(fn) + return function(self, ...) + self._value = fn(self._value, ...) + return self + end + end) +chain_mt.__index.result = function(x) return x._value end + +function lume.chain(value) + return setmetatable({ _value = value }, chain_mt) +end + +setmetatable(lume, { + __call = function(_, ...) + return lume.chain(...) + end +}) + + +return lume diff --git a/machine.fnl b/machine.fnl index 216c3ad..c34e357 100644 --- a/machine.fnl +++ b/machine.fnl @@ -1,5 +1,5 @@ (local command (require "core.command")) -(local spawn (require "spawn")) +(local {: spawn : kill } (require "spawn")) (local socket (require "socket")) (local json (require "dkjson")) @@ -7,14 +7,14 @@ (local debug-port 8769) (local reg-write-format { - :ip "k%06X " - :a "a%04X " - :x "x%04X " - :y "y%04X " - :s "s%04X " - :d "d%04X " - :b "b%02X " - :psr "p%06X " + :ip " k%06X" + :a " a%04X" + :x " x%04X" + :y " y%04X" + :s " s%04X" + :d " d%04X" + :b " b%02X" + :psr " p%06X" }) (local machine {:boot @@ -23,12 +23,10 @@ (set self.pid (spawn [:nixGL gsplus-path :-debugport (tostring debug-port)])))) :die (fn [self] + (self:disconnect) (when self.pid - (spawn [:kill (tostring self.pid)]) - (set self.pid nil) - (when self.socket - (self.socket:close) - (set self.socket nil)))) + (kill (- self.pid) 1) + (set self.pid nil))) :connect (fn [self] (when (not self.socket) @@ -61,7 +59,13 @@ :get-bp (fn [self] (self:cmd-response "A")) :write (fn [self addr bytes] - (self:cmd-response (.. "7" (string.format "%06X" addr) (bytes:tohex)))) + (var bytes-to-write bytes) + (var addrout addr) + (while (> (length bytes-to-write) 0) + (local bytesout (bytes-to-write:sub 1 50)) + (self:cmd-response (.. "7" (string.format "%06X" addrout) (bytesout:tohex))) + (set bytes-to-write (bytes-to-write:sub 51)) + (set addrout (+ addrout 50)))) :setreg (fn [self regvals] (var bytes "5") @@ -75,9 +79,7 @@ (var retries 5) (while (> retries 0) (local reg (. (self:getreg) 1 :data)) - (pp reg.PC.fromhex) (local pc (reg.PC:fromhex)) - (pp) (local curr-k (reg.K:fromhex)) (print (curr-k:tohex) (pc:tohex)) (if (and (= pc addr) (= curr-k (or k 0))) @@ -90,10 +92,13 @@ "gsplus:launch-gsplus" #(machine:boot) "gsplus:boot" (fn [] (machine:boot) - (while (not machine.socket) (pp (machine:connect))) + (while (not machine.socket) (machine:connect)) (machine:hello) ) }) +(command.add (fn [] machine.pid) { + "gsplus:kill-gsplus" #(machine:die) +}) (command.add (fn [] machine.socket) { "gsplus:disconnect" #(machine:disconnect) "gsplus:hello" #(machine:hello) diff --git a/main.lua b/main.lua index 2c88a23..6f6b835 100644 --- a/main.lua +++ b/main.lua @@ -3,6 +3,7 @@ fennel = require("lib.fennel") table.insert(package.loaders, fennel.make_searcher({correlate=true})) fv = require("lib.fennelview") pp = function(x) print(fv(x)) end +lume = require("lume") function reload(modname) package.loaded[modname] = nil @@ -18,4 +19,4 @@ function coroutine.resume(...) return state,result end -require("wrap") \ No newline at end of file +require("wrap") diff --git a/spawn.lua b/spawn.lua index 180b865..238f4f7 100644 --- a/spawn.lua +++ b/spawn.lua @@ -10,6 +10,8 @@ int open(const char *pathname, int flags, int mode); int close(int fd); int dup2(int oldfd, int newfd); int execvp(const char *file, char *const argv[]); +int kill(pid_t pid, int sig); +pid_t setsid(void); ]]) local bor = bit.bor @@ -25,6 +27,7 @@ local function spawn(args) if pid < 0 then error("fork failed " .. ffi.errno()) elseif pid == 0 then -- child process + C.setsid() local argv = k_char_p_arr_t(#args + 1) -- automatically NULL terminated for i = 1, #args do argv[i-1] = args[i] -- args is 1-based Lua table, argv is 0-based C array @@ -38,4 +41,4 @@ local function spawn(args) end end -return spawn \ No newline at end of file +return {spawn=spawn, kill=C.kill} diff --git a/stream.fnl b/stream.fnl index 5786bb4..493c079 100644 --- a/stream.fnl +++ b/stream.fnl @@ -3,9 +3,9 @@ (make-stream {:table (or table []) :i 0 - :n (length table) + :n (length (or table [])) :step 1 - :next + :next (fn [self] (when (~= self.i self.n) (set self.i (+ self.i self.step)) @@ -96,10 +96,10 @@ :curr (fn [self] (self.curr-stream:curr)) :next (fn [self] - (var reached-next + (var reached-next (if self.curr-stream (self.curr-stream:next) false)) (while (not reached-next) - (set self.curr-stream + (set self.curr-stream (if (self.stream:next) (self.stream:curr) nil)) (set reached-next (if self.curr-stream (self.curr-stream:next) true))) @@ -145,7 +145,7 @@ (tset m k v)) m)) -(set make-stream +(set make-stream (fn [stream] (set stream.iter iter) (set stream.map map) @@ -160,4 +160,4 @@ (set stream.tomap tomap) stream)) -{: stream : kvstream : one} \ No newline at end of file +{: stream : kvstream : one} diff --git a/test.fnl b/test.fnl index af60f5f..221cec3 100644 --- a/test.fnl +++ b/test.fnl @@ -1,14 +1,156 @@ -(local program (require "asm")) +(local {: program} (require "asm")) (local {: stream : kvstream : one} (require "stream")) (local prg (program)) +(local code1 (prg:org 0xc00)) + +; (prg:block :print-chars-forever 0x0c00 +; :start +; [:dex] +; [:txa] +; [:jsr :0xfded] +; [:jmp :start]) +(local vm { + :IP :0x40 + :IPH :0x41 + :W :0x42 + :WH :0x43 + :ROFF :0x44 + :TOP :0x80 + :TOPH :0x81 + :ST1 :0x7e + :ST1H :0x7f + :ST2 :0x7c + :ST2H :0x7d + :RSTACK :0x6000 + :ret (fn [self] [:jmp :next]) + :push + (fn [self v] + (local l (bit.band v 0xff)) + (local h (bit.band (bit.rshift v 8) 0xff)) + [:block + [:inx] + [:inx] + [:lda l] + [:sta [self.TOP :x]] + [:lda h] + [:sta [self.TOPH :x]] + ]) + :drop (fn [self] [:block [:dex] [:dex]]) + :def + (fn [self name ...] + (code1:append name (table.unpack (lume.concat [...] [(self:ret)])))) + }) +(fn inc16 [l h] + [:block + [:inc l] + [:bne :done] + [:inc h] + :done + ]) +(fn add16 [l h] + [:block + [:adc l] + [:bcc :go] + [:inc h] + :go + ]) + +(code1:append :next + [:lda vm.IP] [:sta vm.W] + [:lda vm.IPH] [:sta vm.WH] + [:lda 2] (add16 vm.IP vm.IPH) + [:jmp [vm.W]]) + +(vm:def + [:pla] [:sta vm.IP] [:pla] [:sta vm.IPH] + (inc16 vm.IP vm.IPH)) + +(vm:def + :subroutine ; usage: [jsr :subroutine] followed by bytecode + [:ldy vm.ROFF] + [:lda vm.IP] [:sta vm.RSTACK :y] [:iny] + [:lda vm.IPH] [:sta vm.RSTACK :y] [:iny] + :interpret ; usage: [jsr :interpret] followed by bytecode + [:pla] [:sta vm.IP] [:pla] [:sta vm.IPH] + (inc16 vm.IP vm.IPH)) + +(vm:def :ret + [:ldy vm.ROFF] + [:dey] [:lda vm.RSTACK :y] [:sta vm.IPH] + [:dey] [:lda vm.RSTACK :y] [:sta vm.IP] + [:sty vm.ROFF]) + +(code1:append :native [:jmp [vm.IP]]) +(code1:append :quit [:rts]) + +(vm:def :mixed-hires + [:sta :0xc050] + [:sta :0xc057] + [:sta :0xc053]) + +(vm:def :drop (vm:drop)) + +(vm:def :dup + [:inx] [:inx] + [:lda vm.ST1H :x] + [:sta vm.TOPH :x] + [:lda vm.ST1 :x] + [:sta vm.TOP :x]) + +(vm:def :swap + [:lda vm.TOP :x] + [:ldy vm.ST1 :x] + [:sty vm.TOP :x] + [:sta vm.ST1 :x] + [:lda vm.TOPH :x] + [:ldy vm.ST1H :x] + [:sty vm.TOPH :x] + [:sta vm.ST1H :x]) + +(vm:def :>rot ; (a b c -- c a b) + [:lda vm.TOP :x] ; a: c (a b c) + [:ldy vm.ST2 :x] ; y: a (a b c) + [:sta vm.ST2 :x] ; a: c (c b c) + [:lda vm.ST1 :x] ; a: b (c b c) + [:sta vm.TOP :x] ; a: b (c b b) + [:sty vm.ST1 :x] ; y: a (c a b) + [:lda vm.TOPH :x] ; a: c (a b c) + [:ldy vm.ST2H :x] ; y: a (a b c) + [:sta vm.ST2H :x] ; a: c (c b c) + [:lda vm.ST1H :x] ; a: b (c b c) + [:sta vm.TOPH :x] ; a: b (c b b) + [:sty vm.ST1H :x] ; y: a (c a b) +) +(vm:def : core.active_view.doc.filename + (: :gsub "%.%a+$" "") + (: :gsub "/" ".") + (: :gsub "^data%." "") + (: :gsub "%.init$" ""))) + (core.log (.. "Hotswapping " modname)) + (local (mod err) (lume.hotswap modname)) + (when (not= err nil) (print err) (error err))) +}) +(keymap.add { + "alt+e" "fennel:eval" + "alt+r" "lume:hotswap" +}) + +(fn love.load []) (fn love.update [dt] (imgui.NewFrame)) (fn love.draw [] - (when machine.socket - (when (imgui.Button "Stop on keypress") - (machine:stop-at 0xfd1b)) - (when (imgui.Button "Upload") - (local prg (reload "test")) - (each [_ block (pairs prg.symbols)] - (pp (machine:write block.addr block.bytes))) - (pp (machine:setreg {:ip (. prg.symbols prg.start-symbol :addr)})) - (pp (machine:continue)))) (imgui.Render)) (fn love.quit [] @@ -45,3 +68,5 @@ (fn love.wheelmoved [x y] (imgui.WheelMoved y)) + +{}