commit 16f51cb8766fa0610588716be376d0fad9fda712
parent ce00dc2189f8a40e605ec4b628c747f2db282d84
Author: Andrew Alderwick <andrew@alderwick.co.uk>
Date: Mon, 3 May 2021 19:15:06 +0100
Rewritten asma
Diffstat:
A | etc/asma.lua | | | 235 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
A | etc/asma.moon | | | 169 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
D | etc/assembler-trees.lua | | | 350 | ------------------------------------------------------------------------------- |
D | etc/assembler-trees.moon | | | 210 | ------------------------------------------------------------------------------- |
M | projects/software/asma.usm | | | 1365 | +++++++++++++++++++++++++++++++++++-------------------------------------------- |
5 files changed, 1008 insertions(+), 1321 deletions(-)
diff --git a/etc/asma.lua b/etc/asma.lua
@@ -0,0 +1,235 @@
+local band, bor, lshift, rshift
+do
+ local _obj_0 = require('bit')
+ band, bor, lshift, rshift = _obj_0.band, _obj_0.bor, _obj_0.lshift, _obj_0.rshift
+end
+local spairs
+spairs = function(t)
+ local keys
+ do
+ local _accum_0 = { }
+ local _len_0 = 1
+ for k in pairs(t) do
+ _accum_0[_len_0] = k
+ _len_0 = _len_0 + 1
+ end
+ keys = _accum_0
+ end
+ table.sort(keys)
+ local i = 0
+ return function()
+ i = i + 1
+ return keys[i], t[keys[i]]
+ end
+end
+local trees = {
+ ['asma-labels'] = { },
+ ['asma-opcodes'] = { }
+}
+local opcodes_in_order = { }
+do
+ local wanted = false
+ for l in assert(io.lines('src/assembler.c')) do
+ if l == 'char ops[][4] = {' then
+ wanted = true
+ elseif wanted then
+ if l == '};' then
+ break
+ end
+ for w in l:gmatch('[^%s",][^%s",][^%s",]') do
+ if w ~= '---' then
+ trees['asma-opcodes'][w] = {
+ ('"%s 00'):format(w),
+ ''
+ }
+ end
+ table.insert(opcodes_in_order, w)
+ end
+ end
+ end
+ assert(#opcodes_in_order == 32, 'didn\'t find 32 opcodes in assembler code!')
+end
+do
+ local add_device
+ add_device = function(addr, name, fields)
+ addr = tonumber(addr, 16)
+ local k
+ if name:match('^Audio%x+$') then
+ k = 'asma-ldev-Audio'
+ else
+ k = ('asma-ldev-%s'):format(name)
+ end
+ trees['asma-labels'][name] = {
+ ('"%s 00'):format(name),
+ ('00%02x :%s/_entry'):format(addr, k)
+ }
+ trees[k] = { }
+ addr = 0
+ for fname, flen in fields:gmatch('%&(%S+) +%$(%x+)') do
+ if fname ~= 'pad' then
+ trees[k][fname] = {
+ ('"%s 00'):format(fname),
+ ('00%02x'):format(addr)
+ }
+ end
+ addr = addr + tonumber(flen, 16)
+ end
+ end
+ for l in assert(io.lines('projects/examples/blank.usm')) do
+ local f = {
+ l:match('^%|(%x%x) +%@(%S+) +%[ (.*) %]')
+ }
+ if f[1] then
+ add_device(unpack(f))
+ end
+ end
+end
+do
+ local representation = setmetatable({
+ ['&'] = '26 00 ( & )'
+ }, {
+ __index = function(self, c)
+ return ("'%s 00"):format(c)
+ end
+ })
+ local process
+ process = function(label, t)
+ trees[label] = { }
+ for k, v in pairs(t) do
+ trees[label][('%02x'):format(k:byte())] = {
+ representation[k],
+ (':%s'):format(v)
+ }
+ end
+ end
+ process('asma-first-char-normal', {
+ ['%'] = 'asma-macro-define',
+ ['|'] = 'asma-pad-absolute',
+ ['$'] = 'asma-pad-relative',
+ ['@'] = 'asma-label-define',
+ ['&'] = 'asma-sublabel-define',
+ ['#'] = 'asma-literal-hex',
+ ['.'] = 'asma-literal-zero-addr',
+ [','] = 'asma-literal-rel-addr',
+ [';'] = 'asma-literal-abs-addr',
+ [':'] = 'asma-abs-addr',
+ ["'"] = 'asma-raw-char',
+ ['"'] = 'asma-raw-word',
+ ['{'] = 'asma-ignore',
+ ['}'] = 'asma-ignore',
+ ['['] = 'asma-ignore',
+ [']'] = 'asma-ignore',
+ ['('] = 'asma-comment-start',
+ [')'] = 'asma-comment-end'
+ })
+ process('asma-first-char-macro', {
+ ['('] = 'asma-comment-start',
+ [')'] = 'asma-comment-end',
+ ['{'] = 'asma-ignore',
+ ['}'] = 'asma-macro-end'
+ })
+ process('asma-first-char-comment', {
+ [')'] = 'asma-comment-end'
+ })
+end
+local traverse_node
+traverse_node = function(t, min, max, lefts, rights)
+ local i = math.ceil((min + max) / 2)
+ if min < i then
+ lefts[t[i]] = (':&%s'):format(traverse_node(t, min, i - 1, lefts, rights))
+ end
+ if i < max then
+ rights[t[i]] = (':&%s'):format(traverse_node(t, i + 1, max, lefts, rights))
+ end
+ return t[i]
+end
+local traverse_tree
+traverse_tree = function(t)
+ local lefts, rights = { }, { }
+ local keys
+ do
+ local _accum_0 = { }
+ local _len_0 = 1
+ for k in pairs(t) do
+ _accum_0[_len_0] = k
+ _len_0 = _len_0 + 1
+ end
+ keys = _accum_0
+ end
+ table.sort(keys)
+ return lefts, rights, traverse_node(keys, 1, #keys, lefts, rights)
+end
+local ptr
+ptr = function(s)
+ if s then
+ return (':&%s'):format(s)
+ end
+ return ' $2'
+end
+local ordered_opcodes
+ordered_opcodes = function(t)
+ local i = 0
+ return function()
+ i = i + 1
+ local v = opcodes_in_order[i]
+ if t[v] then
+ return v, t[v]
+ elseif v then
+ return false, {
+ '"--- 00',
+ ''
+ }
+ end
+ end
+end
+local printout = true
+local fmt
+fmt = function(...)
+ return (('\t%-11s %-10s %-12s %-14s %s '):format(...):gsub(' +$', '\n'))
+end
+do
+ local _with_0 = assert(io.open('projects/software/asma.usm.tmp', 'w'))
+ for l in assert(io.lines('projects/software/asma.usm')) do
+ if l:match('--- cut here ---') then
+ break
+ end
+ _with_0:write(l)
+ _with_0:write('\n')
+ end
+ _with_0:write('( --- 8< ------- 8< --- cut here --- 8< ------- 8< --- )\n')
+ _with_0:write('( automatically generated code below )\n')
+ _with_0:write('( see etc/asma.moon for instructions )\n')
+ _with_0:write('\n(')
+ _with_0:write(fmt('label', 'less than', 'greater than', 'key', 'data )'))
+ _with_0:write('\n')
+ for name, tree in spairs(trees) do
+ _with_0:write(('@%s\n'):format(name))
+ local lefts, rights, entry = traverse_tree(tree)
+ local sort_fn
+ if name == 'asma-opcodes' then
+ if rights[opcodes_in_order[1]] then
+ rights[opcodes_in_order[1]] = rights[opcodes_in_order[1]] .. ' &_disasm'
+ else
+ rights[opcodes_in_order[1]] = ' $2 &_disasm'
+ end
+ sort_fn = ordered_opcodes
+ else
+ sort_fn = spairs
+ end
+ for k, v in sort_fn(tree) do
+ local label
+ if k == entry then
+ label = '&_entry'
+ elseif k then
+ label = ('&%s'):format(k)
+ else
+ label = ''
+ end
+ _with_0:write(fmt(label, lefts[k] or ' $2', rights[k] or ' $2', unpack(v)))
+ end
+ _with_0:write('\n')
+ end
+ _with_0:write('@asma-heap\n\n')
+ _with_0:close()
+end
+return os.execute('mv projects/software/asma.usm.tmp projects/software/asma.usm')
diff --git a/etc/asma.moon b/etc/asma.moon
@@ -0,0 +1,169 @@
+import band, bor, lshift, rshift from require 'bit'
+
+spairs = (t) ->
+ keys = [ k for k in pairs t ]
+ table.sort keys
+ i = 0
+ ->
+ i = i + 1
+ keys[i], t[keys[i]]
+
+trees = {
+ ['asma-labels']: {}
+ ['asma-opcodes']: {}
+}
+
+opcodes_in_order = {}
+
+do -- opcodes
+ wanted = false
+ for l in assert io.lines 'src/assembler.c'
+ if l == 'char ops[][4] = {'
+ wanted = true
+ elseif wanted
+ if l == '};'
+ break
+ for w in l\gmatch '[^%s",][^%s",][^%s",]'
+ if w != '---'
+ trees['asma-opcodes'][w] = {
+ '"%s 00'\format w
+ ''
+ }
+ table.insert opcodes_in_order, w
+ assert #opcodes_in_order == 32, 'didn\'t find 32 opcodes in assembler code!'
+
+do -- devices -> labels
+ add_device = (addr, name, fields) ->
+ addr = tonumber addr, 16
+ k = if name\match '^Audio%x+$'
+ 'asma-ldev-Audio'
+ else
+ 'asma-ldev-%s'\format name
+ trees['asma-labels'][name] = {
+ '"%s 00'\format name
+ '00%02x :%s/_entry'\format addr, k
+ }
+ trees[k] = {}
+ addr = 0
+ for fname, flen in fields\gmatch '%&(%S+) +%$(%x+)'
+ if fname != 'pad'
+ trees[k][fname] = {
+ '"%s 00'\format fname,
+ '00%02x'\format addr
+ }
+ addr += tonumber flen, 16
+ for l in assert io.lines 'projects/examples/blank.usm'
+ f = { l\match '^%|(%x%x) +%@(%S+) +%[ (.*) %]' }
+ if f[1]
+ add_device unpack f
+
+
+do -- first characters
+ representation = setmetatable {
+ '&': '26 00 ( & )'
+ },
+ __index: (c) => "'%s 00"\format c
+ process = (label, t) ->
+ trees[label] = {}
+ for k, v in pairs t
+ trees[label]['%02x'\format k\byte!] = {
+ representation[k]
+ ':%s'\format v
+ }
+ process 'asma-first-char-normal',
+ '%': 'asma-macro-define'
+ '|': 'asma-pad-absolute'
+ '$': 'asma-pad-relative'
+ '@': 'asma-label-define'
+ '&': 'asma-sublabel-define'
+ '#': 'asma-literal-hex'
+ '.': 'asma-literal-zero-addr'
+ ',': 'asma-literal-rel-addr'
+ ';': 'asma-literal-abs-addr'
+ ':': 'asma-abs-addr'
+ "'": 'asma-raw-char'
+ '"': 'asma-raw-word'
+ '{': 'asma-ignore'
+ '}': 'asma-ignore'
+ '[': 'asma-ignore'
+ ']': 'asma-ignore'
+ '(': 'asma-comment-start'
+ ')': 'asma-comment-end'
+ process 'asma-first-char-macro',
+ '(': 'asma-comment-start'
+ ')': 'asma-comment-end'
+ '{': 'asma-ignore'
+ '}': 'asma-macro-end'
+ process 'asma-first-char-comment',
+ ')': 'asma-comment-end'
+
+traverse_node = (t, min, max, lefts, rights) ->
+ i = math.ceil (min + max) / 2
+ if min < i
+ lefts[t[i]] = ':&%s'\format traverse_node t, min, i - 1, lefts, rights
+ if i < max
+ rights[t[i]] = ':&%s'\format traverse_node t, i + 1, max, lefts, rights
+ return t[i]
+
+traverse_tree = (t) ->
+ lefts, rights = {}, {}
+ keys = [ k for k in pairs t ]
+ table.sort keys
+ lefts, rights, traverse_node keys, 1, #keys, lefts, rights
+
+ptr = (s) ->
+ if s
+ return ':&%s'\format s
+ return ' $2'
+
+ordered_opcodes = (t) ->
+ i = 0
+ ->
+ i = i + 1
+ v = opcodes_in_order[i]
+ if t[v]
+ return v, t[v]
+ elseif v
+ return false, { '"--- 00', '' }
+
+printout = true
+
+fmt = (...) ->
+ ('\t%-11s %-10s %-12s %-14s %s '\format(...)\gsub ' +$', '\n')
+
+with assert io.open 'projects/software/asma.usm.tmp', 'w'
+ for l in assert io.lines 'projects/software/asma.usm'
+ if l\match '--- cut here ---'
+ break
+ \write l
+ \write '\n'
+ \write '( --- 8< ------- 8< --- cut here --- 8< ------- 8< --- )\n'
+ \write '( automatically generated code below )\n'
+ \write '( see etc/asma.moon for instructions )\n'
+ \write '\n('
+ \write fmt 'label', 'less than', 'greater than', 'key', 'data )'
+ \write '\n'
+ for name, tree in spairs trees
+ \write '@%s\n'\format name
+ lefts, rights, entry = traverse_tree tree
+ sort_fn = if name == 'asma-opcodes'
+ if rights[opcodes_in_order[1]]
+ rights[opcodes_in_order[1]] ..= ' &_disasm'
+ else
+ rights[opcodes_in_order[1]] = ' $2 &_disasm'
+ ordered_opcodes
+ else
+ spairs
+ for k, v in sort_fn tree
+ label = if k == entry
+ '&_entry'
+ elseif k
+ '&%s'\format k
+ else
+ ''
+ \write fmt label, lefts[k] or ' $2', rights[k] or ' $2', unpack v
+ \write '\n'
+ \write '@asma-heap\n\n'
+ \close!
+os.execute 'mv projects/software/asma.usm.tmp projects/software/asma.usm'
+
diff --git a/etc/assembler-trees.lua b/etc/assembler-trees.lua
@@ -1,350 +0,0 @@
-local build_dag
-build_dag = function(t, dag, i, j, level)
- if dag == nil then
- dag = { }
- end
- if i == nil then
- i = 1
- end
- if j == nil then
- j = #t
- end
- if level == nil then
- level = 0
- end
- if i > j then
- return
- end
- local mid = math.floor((i + j) / 2)
- dag[t[mid]] = {
- (build_dag(t, dag, i, mid - 1, level + 1)),
- (build_dag(t, dag, mid + 1, j, level + 1))
- }
- return t[mid], dag
-end
-local append_dag
-append_dag = function(node, dag, k)
- local i = k > node and 2 or 1
- local next_node = dag[node][i]
- if next_node then
- return append_dag(next_node, dag, k)
- end
- dag[node][i] = k
- dag[k] = { }
-end
-local build_dag_from_chars
-build_dag_from_chars = function(s, ...)
- local t
- do
- local _accum_0 = { }
- local _len_0 = 1
- for i = 1, #s do
- _accum_0[_len_0] = s:sub(i, i)
- _len_0 = _len_0 + 1
- end
- t = _accum_0
- end
- table.sort(t)
- local root, dag = build_dag(t)
- for i = 1, select('#', ...) do
- append_dag(root, dag, (select(i, ...)))
- end
- return root, dag
-end
-local check_terminals
-check_terminals = function(dag, s)
- for i = 1, #s do
- local k = s:sub(i, i)
- assert(not dag[k][1], ('%s has left child node'):format(k))
- assert(not dag[k][2], ('%s has right child node'):format(k))
- end
-end
-local dump
-dump = function(f, root, dag, level)
- if level == nil then
- level = 0
- end
- if dag[root][1] then
- dump(f, dag[root][1], dag, level + 1)
- end
- f:write((' '):rep(level))
- f:write(root)
- f:write('\n')
- if dag[root][2] then
- return dump(f, dag[root][2], dag, level + 1)
- end
-end
-local convert = setmetatable({
- ['.'] = 'dot',
- ['\0'] = 'nul'
-}, {
- __index = function(self, k)
- return k
- end
-})
-local write_opcode_tree
-do
- local byte_to_opcode = { }
- local byte = false
- for l in assert(io.lines('src/assembler.c')) do
- if l:match('^%s*char%s+ops%[%]%[4%]') then
- byte = 0
- elseif l:match('%}') then
- byte = false
- elseif byte then
- for opcode in l:gmatch('"([A-Z-][A-Z-][A-Z-])"') do
- byte_to_opcode[byte] = opcode
- byte = byte + 1
- end
- end
- end
- local order_to_opcode
- do
- local _accum_0 = { }
- local _len_0 = 1
- for i = 0, #byte_to_opcode do
- if byte_to_opcode[i] ~= '---' then
- _accum_0[_len_0] = byte_to_opcode[i]
- _len_0 = _len_0 + 1
- end
- end
- order_to_opcode = _accum_0
- end
- table.sort(order_to_opcode)
- local root, opcode_to_links = build_dag(order_to_opcode)
- write_opcode_tree = function(f)
- f:write(('\t$tree .$op-%s ( opcode tree )\n'):format(root:lower()))
- f:write('\t$start\n')
- for i = 0, #byte_to_opcode do
- local opcode = byte_to_opcode[i]
- f:write('\t')
- if opcode ~= '---' then
- f:write(('$op-%s '):format(opcode:lower()))
- else
- f:write(' ')
- end
- for j = 1, 2 do
- if opcode ~= '---' and opcode_to_links[opcode][j] then
- f:write(('.$op-%s '):format(opcode_to_links[opcode][j]:lower()))
- else
- f:write('[ 0000 ] ')
- end
- end
- if i == 0 then
- f:write('$disasm ')
- else
- f:write(' ')
- end
- if opcode ~= '---' then
- f:write(('[ %s ]'):format(opcode))
- else
- f:write('[ ??? ]')
- end
- if i == 0 then
- f:write(' $asm')
- end
- f:write('\n')
- end
- end
-end
-local type_byte
-type_byte = function(size, has_subtree)
- local n1 = has_subtree and '8' or '0'
- local n2
- local _exp_0 = size
- if '1' == _exp_0 then
- n2 = '1'
- elseif '2' == _exp_0 then
- n2 = '2'
- else
- n2 = '0'
- end
- return n1 .. n2
-end
-local globals = { }
-local add_globals
-add_globals = function(root, dag, key_to_label, key_to_contents, pad_before, pad_after)
- if pad_before == nil then
- pad_before = ''
- end
- if pad_after == nil then
- pad_after = ''
- end
- for k in pairs(dag) do
- local l = ''
- if k == root then
- l = l .. ('@%s\n'):format(key_to_label('root'):gsub('%s', ''))
- end
- l = l .. ('@%s '):format(key_to_label(k))
- for j = 1, 2 do
- if dag[k][j] then
- l = l .. ('.%s '):format(key_to_label(dag[k][j]))
- else
- l = l .. ('%s[ 0000 ]%s '):format(pad_before, pad_after)
- end
- end
- l = l .. key_to_contents(k)
- l = l .. '\n'
- globals[key_to_label(k):gsub('%s', '')] = l
- end
- globals[key_to_label('root'):gsub('%s', '')] = ''
-end
-do
- local root, dag = build_dag_from_chars('{}[]%@$;|=~,.^#"\0', '(', ')')
- check_terminals(dag, ')')
- local label_name
- label_name = function(s)
- return ('normal-%-3s'):format(convert[s])
- end
- local label_value
- label_value = function(k)
- return ('[ %02x ]'):format(k:byte())
- end
- add_globals(root, dag, label_name, label_value, '', ' ')
-end
-do
- local root, dag = build_dag_from_chars('{}', '\0', '(')
- dump(io.stdout, root, dag)
- local label_name
- label_name = function(s)
- if s == '(' then
- return 'normal-( '
- end
- return ('variable-%s'):format(convert[s])
- end
- local label_value
- label_value = function(k)
- return ('[ %02x ]'):format(k:byte())
- end
- dag['('] = nil
- add_globals(root, dag, label_name, label_value, '', ' ')
-end
-do
- local root, dag = build_dag_from_chars('{}\0', '(')
- dump(io.stdout, root, dag)
- local label_name
- label_name = function(s)
- if s == '(' then
- return 'normal-( '
- end
- return ('macro-%-3s'):format(convert[s])
- end
- local label_value
- label_value = function(k)
- return ('[ %02x ]'):format(k:byte())
- end
- dag['('] = nil
- add_globals(root, dag, label_name, label_value, '', ' ')
-end
-do
- local root, dag = build_dag_from_chars(']\0', '(')
- dump(io.stdout, root, dag)
- local label_name
- label_name = function(s)
- if s == '(' then
- return 'normal-( '
- end
- return ('data-%-4s'):format(convert[s])
- end
- local label_value
- label_value = function(k)
- return ('[ %02x ]'):format(k:byte())
- end
- dag['('] = nil
- add_globals(root, dag, label_name, label_value, '', ' ')
-end
-local devices = { }
-local add_device
-add_device = function(name, fields)
- local field_sizes
- do
- local _tbl_0 = { }
- for k, size in fields:gmatch('(%S+) (%d+)') do
- _tbl_0[k] = size
- end
- field_sizes = _tbl_0
- end
- field_sizes.pad = nil
- local field_names
- do
- local _accum_0 = { }
- local _len_0 = 1
- for k in pairs(field_sizes) do
- _accum_0[_len_0] = k
- _len_0 = _len_0 + 1
- end
- field_names = _accum_0
- end
- table.sort(field_names)
- local root, dag = build_dag(field_names)
- local label_name
- label_name = function(k)
- return ('l-%-14s'):format(name .. '-' .. k)
- end
- local label_value
- label_value = function(k)
- return ('%-17s [ %s ] .%s.%s'):format(('[ %s 00 ]'):format(k), type_byte(field_sizes[k], false), name, k)
- end
- add_globals(root, dag, label_name, label_value, ' ', ' ')
- return table.insert(devices, name)
-end
-local add_devices
-add_devices = function()
- table.sort(devices)
- local root, dag = build_dag(devices)
- local label_name
- label_name = function(k)
- return ('l-%-14s'):format(k)
- end
- local label_value
- label_value = function(k)
- return ('%-17s [ %s ] .%s .l-%s-root'):format(('[ %s 00 ]'):format(k), type_byte(0, true), k, k)
- end
- return add_globals(root, dag, label_name, label_value, ' ', ' ')
-end
-local filename = 'projects/software/assembler.usm'
-local f = assert(io.open(('%s.tmp'):format(filename), 'w'))
-local state = 'normal'
-local machine = {
- normal = function(l)
- if l:match('%( opcode tree %)') then
- write_opcode_tree(f)
- state = 'opcode'
- elseif l:match('^%@') then
- if l == '@RESET' then
- add_devices()
- end
- for k in l:gmatch('%@(%S+)') do
- if globals[k] then
- f:write(globals[k])
- globals[k] = nil
- return
- end
- end
- f:write(l)
- return f:write('\n')
- else
- if l:match('^%|%x%x%x%x %;') then
- add_device(l:match('%;(%S+) %{ (.*) %}'))
- end
- f:write(l)
- return f:write('\n')
- end
- end,
- opcode = function(l)
- if not l:match('.') then
- f:write(l)
- f:write('\n')
- state = 'normal'
- end
- end
-}
-for l in assert(io.lines(filename)) do
- machine[state](l)
-end
-for _, l in pairs(globals) do
- f:write(l)
-end
-f:close()
-assert(0 == os.execute(('mv %s %s.bak'):format(filename, filename)))
-return assert(0 == os.execute(('mv %s.tmp %s'):format(filename, filename)))
diff --git a/etc/assembler-trees.moon b/etc/assembler-trees.moon
@@ -1,210 +0,0 @@
-build_dag = (t, dag = {}, i = 1, j = #t, level = 0) ->
- if i > j
- return
- mid = math.floor (i + j) / 2
- dag[t[mid]] = {
- (build_dag t, dag, i, mid - 1, level + 1)
- (build_dag t, dag, mid + 1, j, level + 1)
- }
- t[mid], dag
-append_dag = (node, dag, k) ->
- i = k > node and 2 or 1
- next_node = dag[node][i]
- if next_node
- return append_dag next_node, dag, k
- dag[node][i] = k
- dag[k] = {}
-build_dag_from_chars = (s, ...) ->
- t = [ s\sub i, i for i = 1, #s ]
- table.sort t
- root, dag = build_dag t
- for i = 1, select '#', ...
- append_dag root, dag, (select i, ...)
- return root, dag
-check_terminals = (dag, s) ->
- for i = 1, #s
- k = s\sub i, i
- assert not dag[k][1], '%s has left child node'\format k
- assert not dag[k][2], '%s has right child node'\format k
-dump = (f, root, dag, level = 0) ->
- if dag[root][1]
- dump f, dag[root][1], dag, level + 1
- f\write ' '\rep level
- f\write root
- f\write '\n'
- if dag[root][2]
- dump f, dag[root][2], dag, level + 1
-
-convert = setmetatable { ['.']: 'dot', ['\0']: 'nul' },
- __index: (k) => k
--- deal with opcodes
-
-write_opcode_tree = do
- byte_to_opcode = {}
- byte = false
- for l in assert io.lines 'src/assembler.c'
- if l\match '^%s*char%s+ops%[%]%[4%]'
- byte = 0
- elseif l\match '%}'
- byte = false
- elseif byte
- for opcode in l\gmatch '"([A-Z-][A-Z-][A-Z-])"'
- byte_to_opcode[byte] = opcode
- byte += 1
- order_to_opcode = [ byte_to_opcode[i] for i = 0, #byte_to_opcode when byte_to_opcode[i] != '---' ]
- table.sort order_to_opcode
- root, opcode_to_links = build_dag order_to_opcode
- (f) ->
- f\write '\t$tree .$op-%s ( opcode tree )\n'\format root\lower!
- f\write '\t$start\n'
- for i = 0, #byte_to_opcode
- opcode = byte_to_opcode[i]
- f\write '\t'
- if opcode != '---'
- f\write '$op-%s '\format opcode\lower!
- else
- f\write ' '
- for j = 1, 2
- if opcode != '---' and opcode_to_links[opcode][j]
- f\write '.$op-%s '\format opcode_to_links[opcode][j]\lower!
- else
- f\write '[ 0000 ] '
- if i == 0
- f\write '$disasm '
- else
- f\write ' '
- if opcode != '---'
- f\write '[ %s ]'\format opcode
- else
- f\write '[ ??? ]'
- if i == 0
- f\write ' $asm'
- f\write '\n'
-
-type_byte = (size, has_subtree) ->
- n1 = has_subtree and '8' or '0'
- n2 = switch size
- when '1'
- '1'
- when '2'
- '2'
- else
- '0'
- n1 .. n2
-
-globals = {}
-
-add_globals = (root, dag, key_to_label, key_to_contents, pad_before = '', pad_after = '') ->
- for k in pairs dag
- l = ''
- if k == root
- l ..= '@%s\n'\format key_to_label('root')\gsub '%s', ''
- l ..= '@%s '\format key_to_label k
- for j = 1, 2
- if dag[k][j]
- l ..= '.%s '\format key_to_label dag[k][j]
- else
- l ..= '%s[ 0000 ]%s '\format pad_before, pad_after
- l ..= key_to_contents k
- l ..= '\n'
- globals[key_to_label(k)\gsub '%s', ''] = l
- globals[key_to_label('root')\gsub '%s', ''] = ''
-
-do
- root, dag = build_dag_from_chars '{}[]%@$;|=~,.^#"\0', '(', ')'
- check_terminals dag, ')'
- label_name = (s) -> 'normal-%-3s'\format convert[s]
- label_value = (k) -> '[ %02x ]'\format k\byte!
- add_globals root, dag, label_name, label_value, '', ' '
-
-do
- root, dag = build_dag_from_chars '{}', '\0', '('
- dump io.stdout, root, dag
- label_name = (s) ->
- if s == '('
- return 'normal-( '
- 'variable-%s'\format convert[s]
- label_value = (k) -> '[ %02x ]'\format k\byte!
- dag['('] = nil
- add_globals root, dag, label_name, label_value, '', ' '
-
-do
- root, dag = build_dag_from_chars '{}\0', '('
- dump io.stdout, root, dag
- label_name = (s) ->
- if s == '('
- return 'normal-( '
- 'macro-%-3s'\format convert[s]
- label_value = (k) -> '[ %02x ]'\format k\byte!
- dag['('] = nil
- add_globals root, dag, label_name, label_value, '', ' '
-
-do
- root, dag = build_dag_from_chars ']\0', '('
- dump io.stdout, root, dag
- label_name = (s) ->
- if s == '('
- return 'normal-( '
- 'data-%-4s'\format convert[s]
- label_value = (k) -> '[ %02x ]'\format k\byte!
- dag['('] = nil
- add_globals root, dag, label_name, label_value, '', ' '
-
-devices = {}
-
-add_device = (name, fields) ->
- field_sizes = { k, size for k, size in fields\gmatch '(%S+) (%d+)' }
- field_sizes.pad = nil
- field_names = [ k for k in pairs field_sizes ]
- table.sort field_names
- root, dag = build_dag field_names
- label_name = (k) -> 'l-%-14s'\format name .. '-' .. k
- label_value = (k) -> '%-17s [ %s ] .%s.%s'\format '[ %s 00 ]'\format(k), type_byte(field_sizes[k], false), name, k
- add_globals root, dag, label_name, label_value, ' ', ' '
- table.insert devices, name
-
-add_devices = ->
- table.sort devices
- root, dag = build_dag devices
- label_name = (k) -> 'l-%-14s'\format k
- label_value = (k) -> '%-17s [ %s ] .%s .l-%s-root'\format '[ %s 00 ]'\format(k), type_byte(0, true), k, k
- add_globals root, dag, label_name, label_value, ' ', ' '
-
-filename = 'projects/software/assembler.usm'
-
-f = assert io.open '%s.tmp'\format(filename), 'w'
--- f = io.stdout
-state = 'normal'
-machine =
- normal: (l) ->
- if l\match '%( opcode tree %)'
- write_opcode_tree f
- state = 'opcode'
- elseif l\match '^%@'
- if l == '@RESET'
- add_devices!
- for k in l\gmatch '%@(%S+)'
- if globals[k]
- f\write globals[k]
- globals[k] = nil
- return
- f\write l
- f\write '\n'
- else
- if l\match '^%|%x%x%x%x %;'
- add_device l\match '%;(%S+) %{ (.*) %}'
- f\write l
- f\write '\n'
- opcode: (l) ->
- if not l\match '.'
- f\write l
- f\write '\n'
- state = 'normal'
-for l in assert io.lines filename
- machine[state] l
-for _, l in pairs globals
- f\write l
-f\close!
-assert 0 == os.execute 'mv %s %s.bak'\format filename, filename
-assert 0 == os.execute 'mv %s.tmp %s'\format filename, filename
-
diff --git a/projects/software/asma.usm b/projects/software/asma.usm
@@ -1,910 +1,753 @@
-( asma: in-Uxn assembler (not working yet, in progress) )
-
-%HCF { #0000 DIV }
-%SHORT_FLAG { #20 }
-%RETURN_FLAG { #40 }
-
( devices )
-|00 @System [ &vector $2 &pad $6 &r $2 &g $2 &b $2 ]
-|10 @Console [ &vector $2 &pad $6 &char $1 &byte $1 &short $2 &string $2 ]
-|20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &color $1 ]
-|30 @Audio [ &wave $2 &envelope $2 &pad $4 &volume $1 &pitch $1 &play $1 &value $2 &delay $2 &finish $1 ]
-|80 @Controller [ &vector $2 &button $1 &key $1 ]
-|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &chord $1 ]
-|a0 @File [ &vector $2 &success $2 &offset $2 &pad $2 &name $2 &length $2 &load $2 &save $2 ]
-|b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ]
-
-( variables )
-
-|0000
-
-@tree [ &search-key $2 &max-key-len $1 ]
-@assembler [ &pass $1 &state $1 &token $2 &scope-len $1 &scope $80 &heap $2 &addr $2 &subtree $2 &field_size $2 &var_size $2 &field $2 ]
+|10 @Console [ &pad $8 &char $1 &byte $1 &short $2 &string $2 ]
+|a0 @File [ &vector $2 &success $2 &offset $2 &pad $2 &name $2 &length $2 &load $2 &save $2 ]
( vectors )
-|0100 ,RESET JMP
-
-@RESET
- ;assembler-heap-start .assembler/heap POK2
-
- ;&read-filename ,assemble-file JSR
- HCF
-
- HCF
-
- &read-filename [ "projects/software/noodle.usm 00 ]
-
-@assemble-file ( filename-ptr* -- )
+|0100
+
+%asma-IF-ERROR { ;asma/error LDA2 ORA }
+
+@reset
+ ;asma-init-assembler JSR2
+ ;&filename ,asma-assemble-file-pass JSR
+ asma-IF-ERROR ,asma-print-error JNZ
+ ;asma-init-assembler-pass JSR2
+ ;&filename ,asma-assemble-file-pass JSR
+ asma-IF-ERROR ,asma-print-error JNZ
+ BRK
+
+ &filename
+ ( "test.usm 00 )
+ "projects/software/noodle.usm 00
+
+@asma-print-error ( -- )
+ ;asma/error LDA2 .Console/string DEO2
+ #3a .Console/char DEO
+ #20 .Console/char DEO
+ ;asma/orig-token LDA2 .Console/string DEO2
+ ;&line .Console/string DEO2
+ ;asma/line LDA2 .Console/short DEO2
+ #2e .Console/char DEO
+ #0a .Console/char DEO
+ BRK
+
+ &line 20 "on 20 "line 20 00
+
+@asma-assemble-file-pass ( filename-ptr* -- )
#0000
&loop
OVR2 .File/name DEO2
DUP2 .File/offset DEO2
- #0600 .File/length DEO2
- #f000 DUP2 DUP2 .File/load DEO2
- .File/success DEI2 DUP2 #0000 EQU2 ,&end JNZ
- ,assemble-chunk JSR
+ #0100 .File/length DEO2
+ #fe00 DUP2 DUP2 .File/load DEO2
+ .File/success DEI2 DUP2 ORA ,¬-end JNZ
+ POP2 POP2
+ &error
+ POP2 POP2 POP2
+ JMP2r
+
+ ¬-end
+ ,asma-assemble-chunk JSR asma-IF-ERROR ,&error JNZ
SUB2 SUB2
,&loop JMP
- &end
- POP2 POP2 POP2 POP2 POP2
- JMP2r
+@asma-init-assembler ( -- )
+ #ff ;asma/pass STA
+ #0000 ;asma/error STA2
+ ;asma-heap ;asma/heap STA2
+ ;asma-labels/_entry ;asma-trees/labels STA2
+ ( FIXME should walk the label tree and remove any in the heap )
+ ;asma-opcodes/_entry ;asma-trees/opcodes STA2
+ #0000 ;asma-trees/macros STA2
-@assemble-chunk ( ptr* len* -- assembled-up-to-ptr* )
- ( FIXME we still return on seeing 00 in source code,
- while assemble-file is now binary safe )
- OVR2 ADD2 STH2
- #0001 SUB2
+@asma-init-assembler-pass ( -- )
+ ;asma/pass LDA #01 ADD ;asma/pass STA
+ #00 ;asma/state STA
+ #0000 ;asma/addr STA2
+ #0001 ;asma/line STA2
+ JMP2r
- &per-token
- DUP2 STH2
+@asma-assemble-chunk ( ptr* len* -- assembled-up-to-ptr* )
+ OVR2 ADD2 #0001 SUB2 SWP2 DUP2 STH2
+ ,&loop JMP
- &loop
+ &next-char-pop
+ POP
+ &next-char
#0001 ADD2
- DUP2 LDA
- #20 GTH ,&loop JNZ
+ &loop ( last-ptr* ptr* / start-of-token* )
+ OVR2 OVR2 LTH2 ,&end JNZ
+ DUP2 LDA ( last-ptr* ptr* char / start-of-token* )
+ DUP #20 GTH ,&next-char-pop JNZ
- DUP2 OVR2r STH2r LTS2 ,&valid JNZ
- SWP2r POP2r POP2
- STH2r #0001 ADD2
- JMP2r
+ #00 OVR2 ( last-ptr* ptr* char 00 ptr* / start-of-token* )
+ STA
+ STH2r ,asma-assemble-token JSR asma-IF-ERROR ,&error JNZ
- &valid
- DUP2 LDA #00 OVR2 STA
- STH2r #0001 ADD2 ,assemble-token JSR
- ,&per-token JNZ
+ #0a NEQ ,¬-newline JNZ
+ ;asma/line LDA2 #0001 ADD2 ;asma/line STA2
+ ¬-newline
- POP2r JMP2r
-
-@assemble-macro ( macro-ptr* -- )
- DUP2 ;strlen JSR2 DUP2 #0000 EQU2 ,&end JNZ
- OVR2 ,assemble-token JSR
- ADD2 #0001 ADD2
- ,assemble-macro JMP
+ DUP2 #0001 ADD2 STH2 ,&next-char JMP
&end
- POP2 POP2
+ POP2 POP2 STH2r
JMP2r
-@assemble-token ( string-ptr* -- )
- ( get location of tree )
- DUP2
- ;state-machine-pointers #00 .assembler/state PEK ;highest-bit JSR2 #0004 MUL2 ADD2
- DUP2 STH2
- ( see if first char is recognised )
- SWP2 #01 ;traverse-tree JSR2
- ,¬-found JNZ
- ( skip first character of token )
- SWP2 #0001 ADD2 .assembler/token POK2
- ( tail call handling function defined in tree )
- POP2r JMP2
-
- ¬-found
- ( not interested in incoming-ptr )
- POP2
- .assembler/token POK2
- ( tail call default handling function defined in state-machine-pointers )
- LIT2r [ 0002 ] ADD2r LDA2r
+ &error
+ POP POP2 POP2
JMP2r
-@parse-hex-length ( string-ptr* -- value 01 if one or two hex digits
- OR 00 otherwise )
- DUP2 #0001 ADD2 LDA ,parse-hex-string/try-two JNZ
- LDA ,parse-hex-digit JSR DUP #04 SFT ,parse-hex-string/fail1 JNZ
- #01 JMP2r
+@asma [ &pass $1 &state $1 &line $2 &token $2 &orig-token $2 &heap $2 &addr $2 &scope-addr $2 &error $2 ]
+@asma-trees [ &labels $2 ¯os $2 &opcodes $2 &scope $2 ]
-@parse-hex-string ( string-ptr* -- value* 02 if four hex digits
- OR value 01 if two hex digits
- OR 00 otherwise )
- DUP2 #0004 ADD2 LDA #00 EQU ,&try-four JNZ
- &try-two
- DUP2 #0002 ADD2 LDA ,&fail2 JNZ
- &known-two
- DUP2 LDA ,parse-hex-digit JSR DUP #04 SFT ,&fail3 JNZ ROT ROT
- #0001 ADD2 LDA ,parse-hex-digit JSR DUP #04 SFT ,&fail2 JNZ
- SWP #40 SFT ORA #01 JMP2r
-
- &fail3 POP
- &fail2 POP
- &fail1 POP #00 JMP2r
-
- &try-four
- DUP2 #0002 ADD2 ,&known-two JSR ,&maybe-four JNZ
- ,&try-two JMP
-
- &maybe-four
- ROT ROT ,&known-two JSR ,&four JNZ
- ,&fail1 JMP
-
- &four
- SWP #02 JMP2r
-
-@parse-hex-digit ( charcode -- 00-0f if valid hex
- -- 10-ff otherwise )
- DUP #3a LTH ,&digit JNZ
- DUP #60 GTH ,&lowercase JNZ
- DUP #40 GTH ,&uppercase JNZ
+@asma-assemble-token ( string-ptr* -- )
+ DUP2 .Console/string DEO2 #0a .Console/char DEO
+ DUP2 ;asma/token STA2
+ DUP2 ;asma/orig-token STA2
+ DUP2 LDA ,¬-empty JNZ
+ POP2
JMP2r
- &digit ( #30 is #00 )
- #30 SUB JMP2r
-
- &lowercase ( #61 is #0a )
- #57 SUB JMP2r
+ ¬-empty ( token* / )
+ ( truncate to one char long )
+ #0001 ADD2 ( end* / )
+ DUP2 STH2 DUP2r LDAr ( end* / end* char )
+ DUP2 STH2 ( end* / end* char end* )
+ LITr 00 STH2 ( / end* char end* 00 end* )
+ STAr ( / end* char end* )
- &uppercase ( #41 is #0a )
- #37 SUB JMP2r
+ ( find lowest set bit of assembler/state
+ in C, this would be i & -i )
+ #00 ;asma/state LDA DUP2 SUB AND ( tree-offset* / end* )
+ DUP2 ;&first-char-trees ADD2 ( tree-offset* incoming-ptr* / end* )
+ ;asma-traverse-tree JSR2
-@find-opcode ( name* -- byte 00 if valid opcode name
- OR 01 if not found )
- ;opcodes/tree SWP2 #03 ,traverse-tree JSR
- ,&nomatch JNZ
- ;opcodes/asm SUB2 #0007 DIV2
- SWP JMP2r
+ ( restore truncated char )
+ STAr
- &nomatch
- DUP2 EQU2 JMP2r
+ ,¬-found JNZ
-@traverse-tree ( tree-ptr* search-key* max-key-len --
- binary-ptr* 00 if key matched
- OR incoming-ptr* 01 if key not found )
- .tree/max-key-len POK .tree/search-key POK2
+ ( tree-offset* token-routine-ptr* / end* )
+ STH2r ;asma/token STA2
+ SWP2 POP2 LDA2
+ JMP2 ( tail call )
- &loop
- DUP2 LDA2 #0000 NEQ2 ,&valid-node JNZ
- #01 JMP2r
+ ¬-found ( tree-offset* dummy* / end* )
+ POP2 POP2r
+ ;&first-char-dispatch ADD2 LDA2
+ JMP2 ( tail call )
- &valid-node
- LDA2 DUP2 STH2 #0004 ADD2 ,strcmp-tree JSR
- DUP ,&nomatch JNZ
- POP2r JMP2r
+ &first-char-trees
+ :asma-first-char-normal/_entry
+ :asma-first-char-comment/_entry
+ :asma-first-char-macro/_entry
- &nomatch
- #07 SFT #02 MUL #00 SWP
- STH2r ADD2
- ,&loop JMP
+ &first-char-dispatch
+ :asma-normal-body
+ :asma-ignore
+ :asma-macro-body
-@strcmp-tree ( node-key* -- order if strings differ
- OR after-node-key* 00 if strings match )
- .tree/search-key PEK2 STH2
- .tree/max-key-len PEK
+@asma-parse-hex-digit ( charcode -- 00-0f if valid hex
+ OR 10-ff otherwise )
+ DUP #3a LTH ,&digit JNZ
+ DUP #60 GTH ,&letter JNZ
+ JMP2r
- &loop ( node-key* key-len in wst, search-key* in rst )
- DUP ,&keep-going JNZ
+ &digit
+ #30 SUB
+ JMP2r
- ( exhausted key-len, match found )
- POP2r
+ &letter
+ #57 SUB
JMP2r
- &keep-going
- #01 OVR2 LDA DUP2r LDAr STHr
- DUP2 ORA ,¬-end JNZ
+@asma-parse-hex-string ( -- value* 06 if valid hex and length > 2
+ OR value* 03 if valid hex and length <= 2
+ OR 00 otherwise )
+ ;asma/token LDA2 DUP2 ,asma-strlen JSR #02 GTH ROT ROT
+ LIT2r 0000
- ( end of C strings, match found )
- POP2r POP ROT POP SWP ADD2 #00
+ &loop
+ DUP2 LDA
+ DUP ,¬-end JNZ
+ POP POP2
+ STH2r ROT #01 ADD #03 MUL
JMP2r
¬-end
- SUB DUP ,&nomatch JNZ
- POP SUB
- LIT2r [ 0001 ] ADD2r STH
- LIT2 [ 0001 ] ADD2 STHr
+ ,asma-parse-hex-digit JSR
+ DUP #f0 AND ,&fail JNZ
+ LIT2r 0010 MUL2r
+ #00 STH STH ADD2r
+ #0001 ADD2
,&loop JMP
- &nomatch
- STH POP2 POP2 STHr POP2r
- JMP2r
-
-@highest-bit ( n -- 00 if n is 00
- OR 01 if n is 01
- OR 02 if n is 02..03
- OR 03 if n is 04..07
- OR 04 if n is 08..0f
- ..
- OR 08 if n is 80..ff )
- DUP #00 NEQ JMP JMP2r
- DUP #01 SFT ORA
- DUP #02 SFT ORA
- DUP #04 SFT ORA
- #1d MUL #05 SFT #00 SWP ;&lookup ADD2 LDA
+ &fail
+ POP POP2 POP2r
+ DUP EOR
JMP2r
- &lookup
- [ 01 06 02 07 05 04 03 08 ]
-
-@memcpy ( src-ptr* dest-ptr* length* -- after-dest-ptr* )
- SWP2 STH2
+@asma-strlen ( string-ptr* -- length )
+ LITr 00
&loop
- DUP2 ORA ,&keep-going JNZ
- POP2 POP2 STH2r
+ DUP2 LDA
+ ,¬-end JNZ
+ POP2 STHr
JMP2r
- &keep-going
- #0001 SUB2
- SWP2 DUP2 LDA DUP2r STH2r STA
- #0001 ADD2 SWP2
- LIT2r [ 0001 ] ADD2r
- ,&loop JMP
-
-@strcpy ( src-ptr* dest-ptr* -- after-dest-ptr* )
- OVR2 ,strlen JSR #0001 ADD2 ,memcpy JMP
-
-@strlen ( string-ptr* -- length* )
- DUP2 #0001 SUB2
- &loop
+ ¬-end
+ LITr 01 ADDr
#0001 ADD2
- DUP2 LDA ,&loop JNZ
- SWP2 SUB2
- JMP2r
-
-@append-heap ( string-ptr* -- after-string-ptr* )
- .assembler/heap PEK2 ;strcpy JSR2
- DUP2 .assembler/heap POK2
- JMP2r
+ ,&loop JMP
-@append-tree ( string-ptr* incoming-ptr* -- binary-data* )
- .assembler/heap PEK2 SWP2 STA2
- ;&zero-pointers .assembler/heap PEK2 #0004 ,memcpy JSR .assembler/heap POK2
- ,append-heap JSR
- JMP2r
+%asma-SHORT-FLAG { #20 }
+%asma-RETURN-FLAG { #40 }
- &zero-pointers [ 0000 0000 ]
+@asma-parse-opcode ( -- byte 00 if valid opcode
+ OR 01 otherwise )
+ ;asma/token LDA2
+ DUP2 ,asma-strlen JSR #03 LTH ,&too-short JNZ
-@add-label ( label-flags string-ptr* tree-ptr* -- )
- OVR2 #ff ;traverse-tree JSR2
- ,&new-label JNZ
+ ( truncate to three chars long )
+ #0003 ADD2 ( end* / )
+ DUP2 STH2 DUP2r LDAr ( end* / end* char )
+ DUP2 STH2 ( end* / end* char end* )
+ LITr 00 STH2 ( / end* char end* 00 end* )
+ STAr ( / end* char end* )
- ( label already exists, check the flags and addr value )
- SWP2 POP2
- DUP2 #0001 ADD2 LDA2 .assembler/addr PEK2 EQU2 ,&addr-okay JNZ
- ( FIXME address is different to previous run, or label defined twice )
- &addr-okay
- LDA EQU ,&type-okay JNZ
- ( FIXME node type is different to before )
- &type-okay
- JMP2r
-
- &new-label
- ,append-tree JSR
- (
- ~assembler.heap SWP2 STR2
- ,$zero-pointers ~assembler.heap #0004 ^memcpy JSR =assembler.heap
- ~assembler.heap ,strcpy JSR2
- )
-
- DUP2 STH2 STA STH2r
- DUP2 #0001 ADD2 .assembler/addr PEK2 SWP2 STA2
- #0003 ADD2 .assembler/heap POK2
- JMP2r
-
-@lookup-label ( string-ptr* -- address* node-type if found
- OR false-address* 00 if not found )
- DUP2
- &loop
- DUP2 #0001 ADD2 SWP2 LDA
- DUP #2e EQU ,&dotted JNZ
- ,&loop JNZ
- DUP2 EOR2 ( faster than POP2 #0000 )
- .assembler/field POK2
-
- &main
- DUP2 ;label-tree SWP2 #ff ;traverse-tree JSR2
- ,¬-found JNZ
-
- SWP2 POP2
- .assembler/field PEK2 #0000 EQU2 ,&end JNZ
- DUP2 LDA #80 LTH ,¬-found JNZ
- #0003 ADD2 .assembler/field PEK2 #ff ;traverse-tree JSR2
+ ;asma-trees/opcodes ;asma-traverse-tree JSR2
+ STAr
,¬-found JNZ
- &end
- DUP2 #0001 ADD2 LDA2 SWP2 LDA
- JMP2r
-
- ¬-found
- POP2
- ( FIXME complain about missing label )
- POP2
- ( false-address is out of reach for JMP )
- .assembler/addr PEK2 #8765 ADD2
- #00
- JMP2r
-
- &dotted
- DUP OVR2 .assembler/field POK2
- EOR ROT ROT #0001 SUB2 STA
- ,&main JMP
-
-@write-byte ( byte -- )
- ( FIXME ) .Console/byte DEO
- .assembler/addr PEK2 #0001 ADD2 .assembler/addr POK2
- JMP2r
-
-@write-short ( short -- )
- ( FIXME ) .Console/short DEO2
- .assembler/addr PEK2 #0002 ADD2 .assembler/addr POK2
- JMP2r
-
-@label-tree :l-root
-@macro-tree [ 0000 ]
-
-@opcodes
- (
- The code for this section is automatically generated, and needs to be
- regenerated when the opcode list in src/assembler.c is updated.
-
- After editing src/assembler.c, run "lua etc/assembler-trees.lua"
- and this file will be edited automatically.
-
- This is the first example of a binary tree in this code, so let's
- explore them in general. The format of a tree node in memory is:
-
- left-node* right-node* node-key-cstring binary-data
-
- and the general algorithm is to compare the key you're looking for
- against node-key-cstring, and move to the node pointed to by left-node*
- or right-node* if the keys don't match. If your key sorts earlier than
- use left-node*, otherwise go to right-node*. When you find a node that
- matches your key, traverse-bintree gives you a pointer to the
- binary-data straight after the node-key-cstring. This data can contain
- anything you want: fixed length fields, executable code... in this case
- of this opcode tree, we store nothing. traverse-bintree is passed the
- maximum length of node-key-cstring, not including the zero, so the zero
- can be omitted if the string is at that maximum length.
-
- If the key isn't present in the tree, you'll eventually get to a node
- where the left-node* or right-node* pointer you'll need to follow is
- null (0000). traverse-bintree will give you the location of that
- pointer, so if you want to insert another node, you can write it to the
- heap and overwrite the pointer with the new node's location. This
- approach works even if the tree is completely empty and the pointer
- you've provided to the root node is null, since that pointer gets
- updated to point to the first node without needing any special logic.
-
- The ordering of nodes in memory is totally arbitrary, so for pre-
- prepared trees like this one we can have our own meaning for the order
- of the nodes. By ordering the opcodes by their byte value, we can find
- the byte by subtracting $asm from the binary-data pointer and dividing
- by seven (the size of each node). By multiplying the byte value by seven
- and adding to $disasm, we get the opcode name when disassembling too.
- )
-
- &tree :&op-lth ( opcode tree )
- &start
- &op-brk :&op-add :&op-dup &disasm [ "BRK ] &asm
- &op-nop :&op-mul :&op-ovr [ "NOP ]
- &op-lit [ 0000 ] [ 0000 ] [ "LIT ]
- &op-pop [ 0000 ] [ 0000 ] [ "POP ]
- &op-dup :&op-div :&op-eor [ "DUP ]
- &op-swp [ 0000 ] [ 0000 ] [ "SWP ]
- &op-ovr :&op-ora :&op-pek [ "OVR ]
- &op-rot :&op-pop :&op-sft [ "ROT ]
- &op-equ :&op-brk :&op-jnz [ "EQU ]
- &op-neq [ 0000 ] [ 0000 ] [ "NEQ ]
- &op-gth [ 0000 ] [ 0000 ] [ "GTH ]
- &op-lth :&op-equ :&op-pok [ "LTH ]
- &op-gts :&op-gth :&op-jmp [ "GTS ]
- &op-lts [ 0000 ] [ 0000 ] [ "LTS ]
- [ 0000 ] [ 0000 ] [ "??? ]
- [ 0000 ] [ 0000 ] [ "??? ]
- &op-pek [ 0000 ] [ 0000 ] [ "PEK ]
- &op-pok :&op-nop :&op-sth [ "POK ]
- &op-ldr :&op-jsr :&op-lit [ "LDR ]
- &op-str [ 0000 ] [ 0000 ] [ "STR ]
- &op-jmp [ 0000 ] [ 0000 ] [ "JMP ]
- &op-jnz :&op-gts :&op-ldr [ "JNZ ]
- &op-jsr [ 0000 ] [ 0000 ] [ "JSR ]
- &op-sth :&op-rot :&op-sub [ "STH ]
- &op-add [ 0000 ] :&op-and [ ADD ]
- &op-sub :&op-str :&op-swp [ "SUB ]
- &op-mul :&op-lts :&op-neq [ "MUL ]
- &op-div [ 0000 ] [ 0000 ] [ "DIV ]
- &op-and [ 0000 ] [ 0000 ] [ "AND ]
- &op-ora [ 0000 ] [ 0000 ] [ "ORA ]
- &op-eor [ 0000 ] [ 0000 ] [ "EOR ]
- &op-sft [ 0000 ] [ 0000 ] [ "SFT ]
-
-@state-machine-pointers
-( normal mode 00 )
-:normal-root :normal-main
-( macro definition 01 )
-:macro-root :macro-main
-( macro definition, contents ignored 02 )
-:macro-root :ignore
-( variable definition, expect field size 04 )
-:variable-nul :variable-size
-( variable definition, expect field name 08 )
-:variable-root :variable-name
-( reserved for future use 10 )
-[ 0000 ] :ignore
-( literal data 20 )
-:normal-5d :data-main
-( reserved for future use 40 )
-[ 0000 ] :ignore
-( comment 80 )
-:normal-29 :ignore
-
-(
- Next up, we have the tree of code corresponding to each token's
- first character. Here we do have a binary payload, which is
- the code to run when the assembler considers the token.
-
- Some special assembler modes have their own trees. Since comments
- have a very simple tree that only understands the end of comments,
- we reuse the terminal branch of the main tree as the root of
- the comment tree.
-)
-
-
-(
- Left and right parentheses start and end comment sections. They use the
- highest bit in assembler state, so they receive highest priority: it
- doesn't matter what other bits are set, a comment's a comment.
-)
-
-
-@normal-28 [ 0000 ] :normal-29 [ 28 ]
- .assembler/state PEK #80 ORA .assembler/state POK
- JMP2r
-
-@normal-29 [ 0000 ] [ 0000 ] [ 29 ]
- .assembler/state PEK #7f AND .assembler/state POK
- JMP2r
-
-(
- Ampersands introduce global labels, and define the scope for any
- local labels that follow.
-)
-
-
-@normal-@ [ 0000 ] [ 0000 ] [ 40 ]
- #00 .assembler/token PEK2 ;label-tree ;add-label JSR2
-
- &scope
- .assembler/token PEK2 ;assembler/scope ;strcpy JSR2
- DUP2 ;assembler/scope SUB2 .assembler/scope-len POK POP
- #0001 SUB2 #2d SWP POK POP
- JMP2r
-
-(
- Dollar signs introduce local labels, which use the scope defined above.
-)
-
-
-@normal-24 :normal-" :normal-, [ 24 ]
- .assembler/token PEK2
- ;assembler/scope .assembler/scope-len PEK ADD
- ;strcpy JSR2 POP2
-
- #00 ;assembler/scope ;label-tree ;add-label JMP2 ( tail call )
-
-(
- Hash signs followed by two or four hex digits write a literal.
-)
-
-
-@normal-# [ 0000 ] [ 0000 ] [ 23 ]
- .assembler/token PEK2 ;parse-hex-string JSR2
- DUP ,&valid JNZ
- ( FIXME complain about invalid hex literal )
- POP
+ ;asma-opcodes/_disasm SUB2 #0003 SFT2 ( 00 byte / end* )
+ &loop
+ DUP2r LDAr STHr LIT2r 0001 ADD2r ( 00 byte char / end* )
+ DUP ,¬-end JNZ
+ POP POP2r
+ SWP
JMP2r
-
- &valid
- DUP #01 SUB SHORT_FLAG MUL ( short flag for opcode )
- ;opcodes/op-lit ;opcodes/start SUB2 #07 DIV
- ADD ADD ;write-byte JSR2
- &value
- #02 EQU ,&short JNZ
- ;write-byte JMP2 ( tail call )
-
- &short
- ;write-short JMP2 ( tail call )
-
-(
- Left and right square brackets start and end literal data sections.
-)
+ ¬-end
+ DUP LIT '2 NEQ ,¬-two JNZ
+ POP asma-SHORT-FLAG ORA ,&loop JMP
+ ¬-two
+ LIT 'r NEQ ,¬-return JNZ
+ asma-RETURN-FLAG ORA ,&loop JMP
-@normal-5b :normal-@ :normal-5d [ 5b ]
- .assembler/state PEK #20 ORA .assembler/state POK
+ ¬-return ( 00 byte / end* )
+ ¬-found ( incoming-ptr* / end* )
+ POP2r
+ &too-short ( token* / )
+ POP2 #01
JMP2r
-@normal-5d [ 0000 ] [ 0000 ] [ 5d ]
- .assembler/state PEK #df AND .assembler/state POK
+@asma-write-byte ( byte -- )
+ #3e .Console/char DEO
+ #20 .Console/char DEO
+ .Console/byte DEO ( FIXME actually write! )
+ #0a .Console/char DEO
+ ;asma/addr LDA2 #0001 ADD2 ;asma/addr STA2
JMP2r
-@data-] :normal-28 [ 0000 ] [ 5d ]
- .assembler/state PEK #df AND .assembler/state POK
- JMP2r
+@asma-write-short ( short -- )
+ SWP
+ ,asma-write-byte JSR
+ ,asma-write-byte JMP ( tail call )
-@data-root
-@data-nul [ 0000 ] :data-] [ 00 ]
+@asma-append-heap-byte ( dummy byte -- dummy )
+ ;asma/heap LDA2
+ OVR2 OVR2 STA POP
+ #0001 ADD2 ;asma/heap STA2
+ POP
JMP2r
-@data-main
- .assembler/token PEK2 ;parse-hex-string JSR2
- DUP ,normal-#/value JNZ
- POP
+@asma-append-heap-short ( dummy short* -- dummy )
+ SWP
+ ,asma-append-heap-byte JSR
+ ,asma-append-heap-byte JMP ( tail call )
- .assembler/token PEK2
- &loop
+@asma-append-heap-string ( string* -- )
DUP2 LDA
- DUP ,&keep-going JNZ
- POP POP2 JMP2r
+ DUP ,asma-append-heap-byte JSR
+ ,&keep-going JNZ
+ POP2 JMP2r
&keep-going
- ;write-byte JSR2
#0001 ADD2
+ ,asma-append-heap-string JMP
+
+@asma-traverse-tree ( incoming-ptr* -- binary-ptr* 00 if key found
+ OR node-incoming-ptr* 01 if key not found )
+ ( ;&help-str .Console/string DEO2
+ DUP2 .Console/short DEO2
+ #20 .Console/char DEO
+ ;asma/token LDA2 .Console/string DEO2
+ #20 .Console/char DEO
+ ;asma/orig-token LDA2 .Console/string DEO2
+ #0a .Console/char DEO )
+
+ &loop ( incoming-ptr* )
+ DUP2 LDA2 ORA ,&valid-node JNZ
+ #01 JMP2r
+
+ &valid-node
+ LDA2 DUP2 STH2
+ #0004 ADD2 ,asma-strcmp-tree JSR
+ DUP ,&nomatch JNZ
+ POP2r JMP2r
+
+ &nomatch
+ #06 SFT #02 AND #00 SWP
+ STH2r ADD2
,&loop JMP
-(
- A pipe moves the current address to the hex value given.
-)
+ ( &help-str "Looking 20 "up 20 00 )
+
+@asma-strcmp-tree ( node-key* -- order if strings differ
+ OR after-node-key* 00 if strings match )
+ ;asma/token LDA2 STH2
+ &loop ( node-key* / token* )
+ DUP2 #0001 ADD2 SWP2 LDA DUP2r LDAr STHr
+ DUP2 ORA ,¬-end JNZ
-@normal-| :normal-{ :normal-} [ 7c ]
- .assembler/token PEK2 ;parse-hex-string JSR2
- DUP #02 EQU ,&valid JNZ
- #00 EQU JMP POP
- ( FIXME complain about invalid hex literal )
+ ( end of C strings, match found )
+ POP2r POP
JMP2r
- &valid
+ ¬-end
+ SUB
+ DUP ,&nomatch JNZ
POP
- DUP2 .assembler/addr PEK2 LTH2 ,&backwards JNZ
- ( FIXME add zeroes when writing )
- .assembler/addr POK2
- JMP2r
+ LIT2r 0001 ADD2r
+ ,&loop JMP
- &backwards
- ( FIXME complain about going backwards )
- POP2
+ &nomatch
+ POP2r ROT ROT POP2
JMP2r
-(
- Commas and dots write the label address - the comma precedes this
- with a LIT2 opcode.
-)
+( actions based on first character )
+%asma-STATE-SET { ;asma/state LDA ORA ;asma/state STA }
+%asma-STATE-CLEAR { #ff EOR ;asma/state LDA AND ;asma/state STA }
-@normal-, :normal-% :normal-dot [ 2c ]
- ;opcodes/op-lit ;opcodes/start SUB2 #07 DIV SHORT_FLAG ADD ;write-byte JSR2 POP
- ,normal-dot/main JMP
+@asma-comment-start
+ #02 asma-STATE-SET
+@asma-ignore
+ JMP2r
-@normal-dot [ 0000 ] :normal-; [ 2e ]
- &main
- .assembler/token PEK2 ;lookup-label JSR2
- POP ( don't care about node type )
- ;write-short JMP2 ( tail call )
+@asma-comment-end
+ #02 asma-STATE-CLEAR
+ JMP2r
-(
- Caret writes LIT, followed by the label address as an offset.
-)
+@asma-macro-define
+ ;asma/pass LDA ,&ignore-macro JNZ
+ ;asma-trees/macros ;asma-traverse-tree JSR2 ,¬-exist JNZ
+ POP2
+ ;asma-msg-macro ;asma/error STA2
+ JMP2r
-@normal-^ :normal-5b :normal-| [ 5e ]
- ;opcodes/op-lit ;opcodes/start SUB2 #07 DIV ;write-byte JSR2 POP
- .assembler/token PEK2 ;lookup-label JSR2
- POP ( don't care about node type )
- .assembler/addr PEK2 SUB2
- DUP2 #ff79 GTH2 ,&okay JNZ
- DUP2 #0080 LTH2 ,&okay JNZ
+ ¬-exist
+ ( define macro by creating new node )
+ ;asma/heap LDA2 SWP2 STA2
+ #0000 ;asma-append-heap-short JSR2 ( less-than pointer )
+ #0000 ;asma-append-heap-short JSR2 ( greater-than pointer )
+ ;asma/token LDA2 ;asma-append-heap-string JSR2 ( key )
+ #04 asma-STATE-SET
+ JMP2r
- ( FIXME complain about jump being too far )
+ &ignore-macro
+ #0c asma-STATE-SET
+ JMP2r
- &okay
- ;write-byte JSR2 POP
+@asma-macro-body
+ ;asma/token LDA2 ;asma-append-heap-string JSR2
JMP2r
-(
- Tilde and equals are the load and store helpers respectively.
- If the target is in the zero page, use LDR/PEK or STR/POK opcodes,
- otherwise use LDR2/PEK2 or STR2/POK2 opcodes.
-)
+@asma-macro-end
+ #00 ;asma-append-heap-byte JSR2
+ #0c asma-STATE-CLEAR
+ JMP2r
-@normal-~ [ 0000 ] [ 0000 ] [ 7e ]
- LIT2r :opcodes/op-ldr LIT2r :opcodes/op-pek
- ,normal-=/main JMP
+@asma-label-define
+ #0000 ;asma/scope-addr STA2
+ ;asma-trees/labels ,asma-label-helper JSR
+ ,&already-existed JNZ
-@normal-root
-@normal-= :normal-24 :normal-^ [ 3d ]
- LIT2r :opcodes/op-str LIT2r :opcodes/op-pok
- &main
- .assembler/token PEK2 ;lookup-label JSR2
- DUP #03 AND ,&valid JNZ
+ #0000 ;asma-append-heap-short JSR2 ( data2: subtree incoming ptr )
- ( FIXME complain about helper not being usable )
- POP2 JMP2r
+ &already-existed
+ ;asma/addr LDA2 ;asma/scope-addr STA2
+ #0002 ADD2 ;asma-trees/scope STA2
+ JMP2r
- &valid
- #02 AND ,&two-byte JNZ
- SWP2r
- &two-byte
- POP2r
- LIT2r :opcodes/start SUB2r LITr [ 07 ] DIVr
- OVR #00 EQU ,&byte-mode JNZ
+@asma-sublabel-define
+ ;asma-trees/scope LDA2 ,asma-label-helper JSR
+ POP POP2
+ JMP2r
- ;write-short SHORT_FLAG ,&end JMP
+@asma-label-helper ( incoming-ptr* -- binary-ptr* 00 if label existed already
+ OR binary-ptr* 01 if label was created )
+ ;asma-traverse-tree JSR2
+ ,&new-label JNZ
- &byte-mode
- SWP POP
- ;write-byte #00
+ ( label already exists )
+ ( FIXME check label address )
+ #01 JMP2r
- &end
- ;opcodes/op-lit ;opcodes/start SUB2 #07 DIV ADD ADD ;write-byte JSR2
- JSR2
- STHr ;write-byte JSR2
- POPr
- JMP2r
+ &new-label ( incoming-ptr* )
+ ( define label by creating new node )
+ ;asma/heap LDA2 SWP2 STA2
+ #0000 ;asma-append-heap-short JSR2 ( less-than pointer )
+ #0000 ;asma-append-heap-short JSR2 ( greater-than pointer )
+ ;asma/token LDA2 ;asma-append-heap-string JSR2 ( key )
-(
- Semicolons introduce variables. The variable name is added to the label
- tree as usual, but all of the subfields are collected into their own tree
- pointed to in the variable name's binary data.
-)
+ ;asma/heap LDA2
-@normal-; [ 0000 ] [ 0000 ] [ 3b ]
- #80 .assembler/token PEK2 ;label-tree ;add-label JSR2
- .assembler/heap PEK2 #0000 OVR2 STA2
- DUP2 #0003 SUB2 .assembler/var_size POK2
- DUP2 .assembler/subtree POK2
- #0002 ADD2 .assembler/heap POK2
+ ;asma/addr LDA2 ;asma/scope-addr LDA2 SUB2
+ ;asma-append-heap-short JSR2 ( data1: address )
+ #00 JMP2r
- .assembler/state PEK #0c ORA .assembler/state POK
- JMP2r
+@asma-pad-absolute
+ #0000 ,asma-pad-helper JMP
-@variable-root
-@variable-{ :variable-nul :variable-} [ 7b ]
- JMP2r
+@asma-pad-relative
+ ;asma/addr LDA2
+ ( fall through )
-@variable-nul [ 0000 ] :normal-28 [ 00 ]
- JMP2r
+@asma-pad-helper ( offset* -- )
+ ;asma-parse-hex-string JSR2
+ ,&valid JNZ
-@variable-} [ 0000 ] [ 0000 ] [ 7d ]
- .assembler/state PEK #f3 AND .assembler/state POK
+ ;asma-msg-hex ;asma/error POK2
JMP2r
-@variable-name
- #00 .assembler/token PEK2 .assembler/subtree PEK2 ;add-label JSR2
- .assembler/heap PEK2 #0003 SUB2 .assembler/field_size POK2
- .assembler/state PEK #f7 AND .assembler/state POK
+ &valid
+ ( FIXME complain if rewind after writing nonzeroes )
+ ADD2 ;asma/addr STA2
JMP2r
-@variable-size
- .assembler/token PEK2 ;parse-hex-length JSR2
- ,&valid JNZ
- ( FIXME complain about invalid size )
- JMP2r
+@asma-raw-char
+ ;asma/token LDA2 LDA
+ ;asma-write-byte JMP2 ( tail call )
- &valid
- &no-var-size
- DUP #02 GTH ,&end JNZ
- DUP .assembler/field_size PEK2 STA
- .assembler/var_size PEK2 #0000 EQU2 ,&end JNZ
- DUP #80 EOR .assembler/var_size PEK2 STA
- ,&end JMP
+@asma-raw-word
+ ;asma/token LDA2
&loop
- #00 ;write-byte JSR2
- #01 SUB
- &end
- DUP ,&loop JNZ
- POP
- .assembler/state PEK #0c ORA .assembler/state POK
- #0000 .assembler/var_size POK2
+ DUP2 LDA
+ DUP ,¬-end JNZ
+
+ POP POP2
JMP2r
-(
- Percent signs introduce macros. The macro name is added to the macro tree,
- and all the arguments are collected into a list that follows the label's
- binary data.
-)
+ ¬-end
+ ;asma-write-byte JSR2
+ #0001 ADD2
+ ,&loop JMP
+
+@asma-literal-abs-addr
+ LIT LIT2 ;asma-write-byte JSR2
+ ( fall through )
-@normal-% [ 0000 ] :normal-28 [ 25 ]
- ;macro-tree .assembler/token PEK2 #ff ;traverse-tree JSR2
- ,&new-macro JNZ
+@asma-abs-addr
+ ,asma-addr-helper JSR
+ ;asma-write-short JMP2 ( tail call )
- ( macro already exists, we assume defined in a previous pass
- we totally ignore the contents )
- POP2
- .assembler/state PEK #02 ORA .assembler/state POK
- JMP2r
+@asma-literal-zero-addr
+ LIT LIT ;asma-write-byte JSR2
+ ,asma-addr-helper JSR
+ ;asma-write-byte JSR2
- &new-macro
- .assembler/token PEK2 SWP2 ;append-tree JSR2
- POP2
- .assembler/state PEK #01 ORA .assembler/state POK
+ ,¬-zero-page JNZ
JMP2r
-@macro-root
-@macro-{ :macro-nul :macro-} [ 7b ]
+ ¬-zero-page
+ ;asma-msg-zero-page ;asma/error STA2
JMP2r
-@macro-} [ 0000 ] [ 0000 ] [ 7d ]
- .assembler/heap PEK2 DUP2 #00 ROT ROT STA
- #0001 ADD2 .assembler/heap POK2
- .assembler/state PEK #fc AND .assembler/state POK
- JMP2r
+@asma-literal-rel-addr
+ LIT LIT ;asma-write-byte JSR2
+ ,asma-addr-helper JSR ;asma/addr LDA2 SUB2 #0002 SUB2
-@macro-nul [ 0000 ] :normal-28 [ 00 ]
- JMP2r
+ DUP2 #0080 LTH2 STH
+ DUP2 #ff7f GTH2 STHr ORA ,&in-bounds JNZ
-@macro-main
- .assembler/token PEK2 ;append-heap JSR2
POP2
+ ;asma-msg-relative ;asma/error STA2
JMP2r
-
-@normal-" :normal-nul :normal-# [ 22 ]
- ( FIXME NYI )
+ &in-bounds
+ ;asma-write-byte JSR2
+ POP
JMP2r
-@normal-{ [ 0000 ] [ 0000 ] [ 7b ]
- ( these are spurious, but ignore them anyway )
- JMP2r
+@asma-addr-helper ( -- addr* )
+ ;asma/token LDA2 DUP2 LDA #26 NEQ ,¬-local JNZ
+ #0001 ADD2 ;asma/token STA2
+ ;asma/scope-addr LDA2 ;asma-trees/scope LDA2
+ ,&final-lookup JMP
+
+ ¬-local ( token* )
+ DUP2 LDA
+ DUP ,¬-end JNZ
+ POP POP2
+ #0000 ;asma-trees/labels
+ ,&final-lookup JMP
+
+ ¬-end ( token* char )
+ #2f EQU ,&found-slash JNZ
+ #0001 ADD2
+ ,¬-local JMP
+
+ &found-slash ( token* )
+ DUP2 #00 ROT ROT STA
+ ;asma-trees/labels ;asma-traverse-tree JSR2 STH
+ SWP2 DUP2 #2f ROT ROT STA
+ STHr ,¬-found JNZ
+ ( token* binary-ptr* )
+ #0001 ADD2 ;asma/token STA2
+ DUP2 LDA2 SWP2 #0002 ADD2
-@normal-} [ 0000 ] :normal-~ [ 7d ]
- ( these are spurious, but ignore them anyway )
+ &final-lookup ( addr-offset* incoming-ptr* )
+ ;asma-traverse-tree JSR2 ,¬-found JNZ
+ LDA2 ADD2
JMP2r
-@normal-nul [ 0000 ] [ 0000 ] [ 00 ]
-@ignore
+ ¬-found ( dummy* dummy* )
+
+ ;asma/pass LDA #00 EQU ,&ignore-error JNZ
+ ;asma-msg-label ;asma/error STA2
+ &ignore-error
+
+ POP2 POP2
+ ;asma/addr LDA2
JMP2r
-@normal-main
- .assembler/token PEK2
- ;opcodes/tree OVR2 #03 ;traverse-tree JSR2
- ,¬-opcode JNZ
+@asma-literal-hex
+ ;asma-parse-hex-string JSR2 JMP
+ ( hex invalid ) ,&invalid JMP
+ ( hex byte ) ,asma-byte-helper JMP
+ ( hex short ) ,asma-short-helper JMP
- ;opcodes/asm SUB2 #0007 DIV2
- SWP2 #0003 ADD2
- &flags
- DUP2 LDA
- DUP #00 EQU ,&end-flags JNZ
- DUP #32 NEQ ,¬-two JNZ
- POP SWP2 SHORT_FLAG ORA SWP2 #0001 ADD2 ,&flags JMP
- ¬-two
- DUP #72 NEQ ,¬-r JNZ
- POP SWP2 RETURN_FLAG ORA SWP2 #0001 ADD2 ,&flags JMP
- ¬-r
- POP POP2 .assembler/token PEK2 SWP2
- ,¬-opcode JMP
+ &invalid
+ POP2
- &end-flags
- POP POP2
- ;write-byte JSR2
+ ;asma-msg-hex ;asma/error STA2
+ JMP2r
+
+@asma-byte-helper ( dummy value -- )
+ LIT LIT ;asma-write-byte JSR2
+ &raw
+ ;asma-write-byte JSR2
POP
JMP2r
+@asma-short-helper ( value* -- )
+ LIT LIT2 ;asma-write-byte JSR2
+ &raw
+ ;asma-write-short JMP2 ( tail call )
+
+@asma-normal-body
+ ;asma-parse-opcode JSR2 ,¬-opcode JNZ
+ ;asma-write-byte JMP2 ( tail call )
+
¬-opcode
+ ;asma-parse-hex-string JSR2 JMP
+ ( hex invalid ) ,¬-hex JMP
+ ( hex byte ) ,asma-byte-helper/raw JMP
+ ( hex short ) ,asma-short-helper/raw JMP
+
+ ¬-hex
+ ;asma-trees/macros ;asma-traverse-tree JSR2 ,¬-macro JNZ
+
+ ¯o-loop
+ DUP2 LDA ,&keep-going JNZ
+ &error
POP2
- ;macro-tree SWP2 #ff ;traverse-tree JSR2
- ,¬-macro JNZ
- ;assemble-macro JMP2 ( tail call )
+ JMP2r
+
+ &keep-going
+ DUP2 DUP2 ;asma-strlen JSR2 #00 SWP #0001 ADD2 ADD2
+ SWP2 ;asma-assemble-token JSR2 asma-IF-ERROR ,&error JNZ
+ ,¯o-loop JMP
¬-macro
- ( FIXME complain about bad opcode / nonexistent macro )
POP2
- JMP2r
-(
- Here's the big set of trees relating to labels. Starting from l-root, all
- the devices are stored here, perhaps some helper functions in the future,
- too.
-
- left-node* right-node* node-key-cstring binary-data
-
- The node-keys are terminated with NUL since, unlike the opcodes and first
- characters, the keys are variable length.
-
- The binary-data is either three or five bytes long:
- flags value* [ subtree-pointer* ]
-
- The flags byte is divided up into bits:
-
- bit 0-1: 00 means store / load helpers cannot be used,
- 01 means the helpers use POK / PEK,
- 02 means the helpers use STR / LDR,
- 03 is invalid;
- bits 2-6 are reserved; and
- bit 7: 80 means there is a subtree.
-
- If there is a subtree, it is searched when the reference contains a dot.
-)
-
-
-@l-Audio [ 0000 ] [ 0000 ] [ "Audio 00 ] [ 80 ] :Audio :l-Audio-root
-@l-Audio-delay [ 0000 ] [ 0000 ] [ "delay 00 ] [ 02 ] :Audio/delay
-@l-Audio-envelope :l-Audio-delay :l-Audio-finish [ "envelope 00 ] [ 02 ] :Audio/envelope
-@l-Audio-finish [ 0000 ] [ 0000 ] [ "finish 00 ] [ 01 ] :Audio/finish
-@l-Audio-root
-@l-Audio-pitch :l-Audio-envelope :l-Audio-value [ "pitch 00 ] [ 01 ] :Audio/pitch
-@l-Audio-play [ 0000 ] [ 0000 ] [ "play 00 ] [ 01 ] :Audio/play
-@l-Audio-value :l-Audio-play :l-Audio-volume [ "value 00 ] [ 02 ] :Audio/value
-@l-Audio-volume [ 0000 ] :l-Audio-wave [ "volume 00 ] [ 01 ] :Audio/volume
-@l-Audio-wave [ 0000 ] [ 0000 ] [ "wave 00 ] [ 02 ] :Audio/wave
-@l-Console :l-Audio :l-Controller [ "Console 00 ] [ 80 ] :Console :l-Console-root
-@l-Console-byte [ 0000 ] :l-Console-char [ "byte 00 ] [ 01 ] :Console/byte
-@l-Console-char [ 0000 ] [ 0000 ] [ "char 00 ] [ 01 ] :Console/char
-@l-Console-root
-@l-Console-short :l-Console-byte :l-Console-string [ "short 00 ] [ 02 ] :Console/short
-@l-Console-string [ 0000 ] :l-Console-vector [ "string 00 ] [ 02 ] :Console/string
-@l-Console-vector [ 0000 ] [ 0000 ] [ "vector 00 ] [ 02 ] :Console/vector
-@l-Controller [ 0000 ] [ 0000 ] [ "Controller 00 ] [ 80 ] :Controller :l-Controller-root
-@l-Controller-button [ 0000 ] [ 0000 ] [ "button 00 ] [ 01 ] :Controller/button
-@l-Controller-root
-@l-Controller-key :l-Controller-button :l-Controller-vector [ "key 00 ] [ 01 ] :Controller/key
-@l-Controller-vector [ 0000 ] [ 0000 ] [ "vector 00 ] [ 02 ] :Controller/vector
-@l-root
-@l-DateTime :l-Console :l-Mouse [ "DateTime 00 ] [ 80 ] :DateTime :l-DateTime-root
-@l-DateTime-day [ 0000 ] [ 0000 ] [ "day 00 ] [ 01 ] :DateTime/day
-@l-DateTime-dotw :l-DateTime-day :l-DateTime-doty [ "dotw 00 ] [ 01 ] :DateTime/dotw
-@l-DateTime-doty [ 0000 ] :l-DateTime-hour [ "doty 00 ] [ 02 ] :DateTime/doty
-@l-DateTime-hour [ 0000 ] [ 0000 ] [ "hour 00 ] [ 01 ] :DateTime/hour
-@l-DateTime-root
-@l-DateTime-isdst :l-DateTime-dotw :l-DateTime-refresh [ "isdst 00 ] [ 01 ] :DateTime/isdst
-@l-DateTime-minute [ 0000 ] :l-DateTime-month [ "minute 00 ] [ 01 ] :DateTime/minute
-@l-DateTime-month [ 0000 ] [ 0000 ] [ "month 00 ] [ 01 ] :DateTime/month
-@l-DateTime-refresh :l-DateTime-minute :l-DateTime-second [ "refresh 00 ] [ 01 ] :DateTime/refresh
-@l-DateTime-second [ 0000 ] :l-DateTime-year [ "second 00 ] [ 01 ] :DateTime/second
-@l-DateTime-year [ 0000 ] [ 0000 ] [ "year 00 ] [ 02 ] :DateTime/year
-@l-File [ 0000 ] [ 0000 ] [ "File 00 ] [ 80 ] :File :l-File-root
-@l-File-length [ 0000 ] [ 0000 ] [ "length 00 ] [ 02 ] :File/length
-@l-File-load :l-File-length :l-File-name [ "load 00 ] [ 02 ] :File/load
-@l-File-name [ 0000 ] [ 0000 ] [ "name 00 ] [ 02 ] :File/name
-@l-File-root
-@l-File-offset :l-File-load :l-File-success [ "offset 00 ] [ 02 ] :File/offset
-@l-File-save [ 0000 ] [ 0000 ] [ "save 00 ] [ 02 ] :File/save
-@l-File-success :l-File-save :l-File-vector [ "success 00 ] [ 02 ] :File/success
-@l-File-vector [ 0000 ] [ 0000 ] [ "vector 00 ] [ 02 ] :File/vector
-@l-Mouse :l-File :l-Screen [ "Mouse 00 ] [ 80 ] :Mouse :l-Mouse-root
-@l-Mouse-chord [ 0000 ] :l-Mouse-state [ "chord 00 ] [ 01 ] :Mouse/chord
-@l-Mouse-state [ 0000 ] [ 0000 ] [ "state 00 ] [ 01 ] :Mouse/state
-@l-Mouse-root
-@l-Mouse-vector :l-Mouse-chord :l-Mouse-x [ "vector 00 ] [ 02 ] :Mouse/vector
-@l-Mouse-x [ 0000 ] :l-Mouse-y [ "x 00 ] [ 02 ] :Mouse/x
-@l-Mouse-y [ 0000 ] [ 0000 ] [ "y 00 ] [ 02 ] :Mouse/y
-@l-Screen [ 0000 ] :l-System [ "Screen 00 ] [ 80 ] :Screen :l-Screen-root
-@l-Screen-addr [ 0000 ] [ 0000 ] [ "addr 00 ] [ 02 ] :Screen/addr
-@l-Screen-color :l-Screen-addr :l-Screen-height [ "color 00 ] [ 01 ] :Screen/color
-@l-Screen-height [ 0000 ] [ 0000 ] [ "height 00 ] [ 02 ] :Screen/height
-@l-Screen-root
-@l-Screen-vector :l-Screen-color :l-Screen-x [ "vector 00 ] [ 02 ] :Screen/vector
-@l-Screen-width [ 0000 ] [ 0000 ] [ "width 00 ] [ 02 ] :Screen/width
-@l-Screen-x :l-Screen-width :l-Screen-y [ "x 00 ] [ 02 ] :Screen/x
-@l-Screen-y [ 0000 ] [ 0000 ] [ "y 00 ] [ 02 ] :Screen/y
-@l-System [ 0000 ] [ 0000 ] [ "System 00 ] [ 80 ] :System :l-System-root
-@l-System-b [ 0000 ] [ 0000 ] [ b 00 ] [ 02 ] :System/b
-@l-System-root
-@l-System-g :l-System-b :l-System-r [ "g 00 ] [ 02 ] :System/g
-@l-System-r [ 0000 ] :l-System-vector [ "r 00 ] [ 02 ] :System/r
-@l-System-vector [ 0000 ] [ 0000 ] [ "vector 00 ] [ 02 ] :System/vector
-
-@assembler-heap-start
+ ;asma-msg-label ;asma/error STA2
+ JMP2r
+
+( messages )
+
+@asma-msg-hex "Invalid 20 "hexadecimal 00
+@asma-msg-zero-page "Address 20 "not 20 "in 20 "zero 20 "page 00
+@asma-msg-relative "Address 20 "outside 20 "range 00
+@asma-msg-label "Label 20 "not 20 "found 00
+@asma-msg-macro "Macro 20 "already 20 "exists 00
+
+( trees )
+
+( --- 8< ------- 8< --- cut here --- 8< ------- 8< --- )
+( automatically generated code below )
+( see etc/asma.moon for instructions )
+
+( label less than greater than key data )
+
+@asma-first-char-comment
+ &_entry $2 $2 ') 00 :asma-comment-end
+
+@asma-first-char-macro
+ &28 $2 $2 '( 00 :asma-comment-start
+ &29 :&28 $2 ') 00 :asma-comment-end
+ &_entry :&29 :&7d '{ 00 :asma-ignore
+ &7d $2 $2 '} 00 :asma-macro-end
+
+@asma-first-char-normal
+ &22 $2 $2 '" 00 :asma-raw-word
+ &23 :&22 $2 '# 00 :asma-literal-hex
+ &24 :&23 :&25 '$ 00 :asma-pad-relative
+ &25 $2 $2 '% 00 :asma-macro-define
+ &26 :&24 :&29 26 00 ( & ) :asma-sublabel-define
+ &27 $2 $2 '' 00 :asma-raw-char
+ &28 :&27 $2 '( 00 :asma-comment-start
+ &29 :&28 :&2c ') 00 :asma-comment-end
+ &2c $2 $2 ', 00 :asma-literal-rel-addr
+ &_entry :&26 :&5d '. 00 :asma-literal-zero-addr
+ &3a $2 $2 ': 00 :asma-abs-addr
+ &3b :&3a $2 '; 00 :asma-literal-abs-addr
+ &40 :&3b :&5b '@ 00 :asma-label-define
+ &5b $2 $2 '[ 00 :asma-ignore
+ &5d :&40 :&7c '] 00 :asma-ignore
+ &7b $2 $2 '{ 00 :asma-ignore
+ &7c :&7b :&7d '| 00 :asma-pad-absolute
+ &7d $2 $2 '} 00 :asma-ignore
+
+@asma-labels
+ &Audio0 $2 $2 "Audio0 00 0030 :asma-ldev-Audio/_entry
+ &Audio1 :&Audio0 :&Audio2 "Audio1 00 0040 :asma-ldev-Audio/_entry
+ &Audio2 $2 $2 "Audio2 00 0050 :asma-ldev-Audio/_entry
+ &Audio3 :&Audio1 :&Controller "Audio3 00 0060 :asma-ldev-Audio/_entry
+ &Console $2 $2 "Console 00 0010 :asma-ldev-Console/_entry
+ &Controller :&Console $2 "Controller 00 0080 :asma-ldev-Controller/_entry
+ &_entry :&Audio3 :&Mouse "DateTime 00 00b0 :asma-ldev-DateTime/_entry
+ &File $2 $2 "File 00 00a0 :asma-ldev-File/_entry
+ &Midi :&File $2 "Midi 00 0070 :asma-ldev-Midi/_entry
+ &Mouse :&Midi :&System "Mouse 00 0090 :asma-ldev-Mouse/_entry
+ &Screen $2 $2 "Screen 00 0020 :asma-ldev-Screen/_entry
+ &System :&Screen $2 "System 00 0000 :asma-ldev-System/_entry
+
+@asma-ldev-Audio
+ &addr $2 $2 "addr 00 000c
+ &adsr :&addr $2 "adsr 00 0008
+ &length :&adsr :&output "length 00 000a
+ &output $2 $2 "output 00 0004
+ &_entry :&length :&vector "pitch 00 000f
+ &position $2 $2 "position 00 0002
+ &vector :&position :&volume "vector 00 0000
+ &volume $2 $2 "volume 00 000e
+
+@asma-ldev-Console
+ &byte $2 $2 "byte 00 0009
+ &char :&byte $2 "char 00 0008
+ &_entry :&char :&string "short 00 000a
+ &string $2 $2 "string 00 000c
+
+@asma-ldev-Controller
+ &button $2 $2 "button 00 0002
+ &_entry :&button :&vector "key 00 0003
+ &vector $2 $2 "vector 00 0000
+
+@asma-ldev-DateTime
+ &day $2 $2 "day 00 0003
+ &dotw :&day $2 "dotw 00 0007
+ &doty :&dotw :&hour "doty 00 0008
+ &hour $2 $2 "hour 00 0004
+ &_entry :&doty :&second "isdst 00 000a
+ &minute $2 $2 "minute 00 0005
+ &month :&minute $2 "month 00 0002
+ &second :&month :&year "second 00 0006
+ &year $2 $2 "year 00 0000
+
+@asma-ldev-File
+ &length $2 $2 "length 00 000a
+ &load :&length :&name "load 00 000c
+ &name $2 $2 "name 00 0008
+ &_entry :&load :&success "offset 00 0004
+ &save $2 $2 "save 00 000e
+ &success :&save :&vector "success 00 0002
+ &vector $2 $2 "vector 00 0000
+
+@asma-ldev-Midi
+ &channel $2 $2 "channel 00 0002
+ ¬e :&channel $2 "note 00 0003
+ &_entry :¬e :&velocity "vector 00 0000
+ &velocity $2 $2 "velocity 00 0004
+
+@asma-ldev-Mouse
+ &chord $2 $2 "chord 00 0007
+ &state :&chord $2 "state 00 0006
+ &_entry :&state :&y "vector 00 0000
+ &x $2 $2 "x 00 0002
+ &y :&x $2 "y 00 0004
+
+@asma-ldev-Screen
+ &addr $2 $2 "addr 00 000c
+ &color :&addr :&height "color 00 000e
+ &height $2 $2 "height 00 0004
+ &_entry :&color :&x "vector 00 0000
+ &width $2 $2 "width 00 0002
+ &x :&width :&y "x 00 0008
+ &y $2 $2 "y 00 000a
+
+@asma-ldev-System
+ &b $2 $2 "b 00 000c
+ &g :&b :&r "g 00 000a
+ &r $2 $2 "r 00 0008
+ &_entry :&g :&wst "rst 00 0003
+ &vector $2 $2 "vector 00 0000
+ &wst :&vector $2 "wst 00 0002
+
+@asma-opcodes
+ &BRK :&AND :&DEI &_disasm "BRK 00
+ &LIT $2 $2 "LIT 00
+ &NOP $2 $2 "NOP 00
+ &POP :&ORA :&STH "POP 00
+ &DUP :&DIV :&EOR "DUP 00
+ &SWP $2 $2 "SWP 00
+ &OVR $2 $2 "OVR 00
+ &ROT $2 $2 "ROT 00
+ &EQU :&DEO :&JSR "EQU 00
+ &NEQ :&MUL :&NOP "NEQ 00
+ >H $2 $2 "GTH 00
+ &_entry :&EQU :&POP "LTH 00
+ &JMP :>H :&JNZ "JMP 00
+ &JNZ $2 $2 "JNZ 00
+ &JSR :&JMP :&LDR "JSR 00
+ &STH :&SFT :&SUB "STH 00
+ &PEK :&OVR :&POK "PEK 00
+ &POK $2 $2 "POK 00
+ &LDR :&LDA :&LIT "LDR 00
+ &STR $2 $2 "STR 00
+ &LDA $2 $2 "LDA 00
+ &STA $2 $2 "STA 00
+ &DEI $2 $2 "DEI 00
+ &DEO :&BRK :&DUP "DEO 00
+ &ADD $2 $2 "ADD 00
+ &SUB :&STR :&SWP "SUB 00
+ &MUL $2 $2 "MUL 00
+ &DIV $2 $2 "DIV 00
+ &AND :&ADD $2 "AND 00
+ &ORA :&NEQ :&PEK "ORA 00
+ &EOR $2 $2 "EOR 00
+ &SFT :&ROT :&STA "SFT 00
+
+@asma-heap