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

@@ -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
+    ([opcode addr] ? (and (= (type addr) "string") (= (opcode:sub 1 1) "b"))) [:rel addr] ; branch
-    ([_ addr] ? (= (type addr) "string")) [:addr addr]
     [_ 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]
+; dat - anything that takes up space in the assembled output (op, dw, db, etc)
-  (var index 1)
+;   takes the form [:op args]
-  (each [_ op (ipairs ops)]
+; pdat - a parsed dat; takes the form {:type type :addr addr ...}
-    (if (= (type op) "string")
+(local dat-parser {})
-      (tset block.symbols op index)
+(fn parse-dats [block dats]
-      (let [opcode (. op 1)]
+  (var index (+ (length block.pdats) 1))
-        (if 
+  (each [_ dat (ipairs dats)]
-          (. opcodes opcode)
+    (if (= (type dat) "string")
-          (let [[mode arg] (parse-mode-arg op)]
+      (tset block.symbols dat index)
-            (table.insert block.code {: opcode : mode : arg}))
+      (let [opcode (. dat 1)
-
+            parser (. dat-parser opcode)
-          (= opcode :block)
+            pdat
-          (let [ops (table.clone op)]
+            (if
-            (table.remove ops 1)
+              parser (parser dat)
-            (table.insert block.code (parse-ops {: opcode :code [] :symbols {}} ops)))
+              (. opcodes opcode) (dat-parser.op dat)
-          
+              (error (.. "Unrecognized opcode " (fv opcode))))]
-          (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 dat-parser.op [op]
-(fn db [org init] {:type :var : org : init :size 1})
+  (let [[mode arg] (parse-mode-arg op)]
-(fn dw [org init] {:type :var : org : init :size 2})
+    {:type :op :opcode (. op 1) : mode : arg}))
-(fn allot [org size] {:type :var : org : size})
 
-(fn make-env [blocks]
+(fn dat-parser.block [block]
-  {: blocks
+  (let [dats (table.clone block)]
-   :push (fn [self block] 
+    (table.remove dats 1)
-     (make-env 
+    (parse-dats {:type :block :pdats [] :symbols {}} dats)))
-       (-> (stream self.blocks)
+
-         (: :concat (one block))
+(fn dat-parser.db [db]       {:type :var :init (. db 2) :size 1})
-         (: :tolist))))
+(fn dat-parser.dw [dw]       {:type :var :init (. dw 2) :size 2})
-   :lookup
+(fn dat-parser.bytes [bytes] {:type :raw : bytes})
-   (fn [self name]
+
-     (-> (stream self.blocks)
+(fn make-env [block parent]
-       (: :reverse)
+  {:parent parent
-       (: :map
+   :block block
-         (fn [block] 
+   :is-zp? (fn [self name] (self.parent:is-zp? name))
-           (let [symbol (. block.symbols name)]
+   :lookup-addr
-             (match (type symbol)
-               "number" (. block.code symbol)
-               "table" symbol
-               _ nil))))
-       (: :filter (fn [symbol] symbol))
-       (: :first)))
-   :lookup-block
    (fn [self name]
+     (local ipdat (. self.block.symbols name))
+     (print "looking up" name "in" self)
      (if
-       (-> (stream self.blocks)
+       (and ipdat (> ipdat (length self.block.pdats)))
-         (: :skip 1)
+       (+ self.block.addr self.block.size)
-         (: :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))})
 
-(fn op-stream [env block]
+       ipdat (. self.block.pdats ipdat :addr)
-  (-> (stream block.code)
+
-    (: :map
+       (self.parent:lookup-addr name)))})
-      (fn [op]
-        (if (= op.opcode :block)
-          (: (one op env)
-            :concat (op-stream (env:push op) op))
-          (one op env))))
-    (: :flatten)))
 
 (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 []
+(local pdat-processor {
-  {:symbols {}
+  :op {}
-   :start-symbol :main
+  :var {}
-   :add (fn [self name elem] (tset self.symbols name elem))
+  :raw {}
-   :block (fn [self name org ...] (self:add name (block org ...)))
+  :block {}
-   :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))})
 
-program
+(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}

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

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 "
+  :ip  " k%06X"
-  :a   "a%04X "
+  :a   " a%04X"
-  :x   "x%04X "
+  :x   " x%04X"
-  :y   "y%04X "
+  :y   " y%04X"
-  :s   "s%04X "
+  :s   " s%04X"
-  :d   "d%04X "
+  :d   " d%04X"
-  :b   "b%02X "
+  :b   " b%02X"
-  :psr "p%06X "
+  :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)])
+     (kill (- self.pid) 1)
-     (set self.pid nil)
+     (set self.pid nil)))
-     (when self.socket
-       (self.socket:close)
-       (set self.socket 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)

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")
+require("wrap")

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
+return {spawn=spawn, kill=C.kill}

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}
+{: stream : kvstream : one}

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 :<rot ; (a b c -- b c a)
+  [:lda vm.TOP :x] ; a: c (a b c)
+  [:ldy vm.ST1 :x] ; y: b (a b c)
+  [:sta vm.ST1 :x] ; a: c (a c c)
+  [:lda vm.ST2 :x] ; a: a (a c c)
+  [:sta vm.TOP :x] ; a: a (a c a)
+  [:sty vm.ST1 :x] ; y: b (b c a)
+  [:lda vm.TOPH :x] ; a: c (a b c)
+  [:ldy vm.ST1H :x] ; y: b (a b c)
+  [:sta vm.ST1H :x] ; a: c (a c c)
+  [:lda vm.ST2H :x] ; a: a (a c c)
+  [:sta vm.TOPH :x] ; a: a (a c a)
+  [:sty vm.ST1H :x] ; y: b (b c a)
+)
+
+(vm:def "@"
+  [:lda [vm.TOP :x]]
+  [:tay]
+  (inc16 vm.TOP vm.TOPH)
+  [:lda [vm.TOP :x]]
+  [:sta vm.TOPH :x]
+  [:sty vm.TOP :x])
+
+(vm:def :lit
+  [:inx] [:inx] [:ldy 0]
+  [:lda [vm.IP] :y]  [:sta [vm.TOP :x]]
+  [:lda [vm.IPH] :y] [:sta [vm.TOP :x]]
+  [:lda 2] (add16 vm.IP vm.IPH))
 
-(prg:block :print-chars-forever 0x0c00
-  :start
-    [:dex]
-    [:txa]
-    [:jsr :0xfded]
-    [:jmp :start])
 (prg:assemble)
-(set prg.start-symbol :print-chars-forever)
+(set prg.start-symbol :mixed-hires)
-prg
+prg

wrap.fnl

@@ -2,24 +2,47 @@
 (require "util")
 (local imgui (require "imgui"))
 (local machine (require "machine"))
+(local core (require "core"))
+(local command (require "core.command"))
+(local keymap (require "core.keymap"))
 
-(fn love.load []
+(fn upload [] (: (reload "test") :upload machine))
-  ; (repl.start)
+
-  )
+(command.add (fn [] machine.socket) {
+  "honeylisp:upload" upload
+})
+
+(command.add "core.docview" {
+  "fennel:eval" (fn []
+    (let [ldoc core.active_view.doc
+          (aline acol bline bcol) (ldoc:get_selection)
+          options {:env _G :compiler-env _G}
+          inject #(ldoc:insert bline bcol (fv (fennel.eval $1 options) {}))]
+      (if (and (= aline bline) (= acol bcol))
+        (inject (ldoc:get_text aline 1 aline 10000000))
+        (inject (ldoc:get_text aline acol bline bcol)))))
+  "lume:hotswap" (fn []
+    (local modname
+      (-> 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))
+
+{}