Added Uxambly porting helper program

etc/uxambly-translate.moon

@@ -0,0 +1,102 @@
+-- Used for porting Uxambly code for use with the old assembler
+-- in commit 82f7103a55c21b13f898b20e5d1e174e501bc825 with the
+-- assembler that replaced it straight afterwards.
+
+import P, R, S, C, Ct, Cp, V from require 'lpeg'
+
+local labels, filename
+
+opcode_translate =
+    PEK2: 'GET'
+    POK2: 'PUT'
+    LDR: 'PEK2'
+    STR: 'POK2'
+    LDR2: 'GET2'
+    STR2: 'PUT2'
+
+grammar = P {
+    'file'
+    file: Ct(V'ows' * (V'atom' * V'ows') ^ 0) * Cp!
+    ws: C S' \n\t' ^ 1
+    ows: C S' \n\t' ^ 0
+    atom: V'opcode' + V'comment' + V'variable' + V'addr' + V'literal' + V'setter' + V'getter' + V'short' + V'labeldef' + V'relative' + V'sublabel' + V'data' + V'macro' + V'macroref' + V'rawshort'
+    comment: C P'(' * (1-V'ws'*P')') ^ 0 * V'ws' * P')'
+    variable: (P';' / -> '@') * C(V'name') * V'ws' * (P'{' / ->'[') * V'ws' * ((P'' / -> '&') * C(V'name') * V'ws' * (P'' / -> '$') * C(V'name') * V'ws') ^ 0 * (P'}' / -> ']') / (...) ->
+        var = select 2, ...
+        r, w = if var\sub(1, 1) == var\sub(1, 1)\upper!
+            ' DEI', ' DEO'
+        else
+            ' PEK', ' POK'
+        for i = 7, select('#', ...), 6
+            k = select i, ...
+            rr, ww = if '2' == select i + 3, ...
+                r .. '2', w .. '2'
+            else
+                r, w
+            labels['~' .. var .. '.' .. k] = '.' .. var .. '/' .. k .. rr
+            labels['=' .. var .. '.' .. k] = '.' .. var .. '/' .. k .. ww
+            if i == 7
+                labels['~' .. var] = '.' .. var .. rr
+                labels['=' .. var] = '.' .. var .. ww
+        ...
+    name: R('az', 'AZ', '09', '__', '--', '++', '**', '//', '??') ^ 1
+    addr: C(P'|') * (C(V'hex') / (i) ->
+        if i == '0200'
+            return '0100'
+        if i\match '^01..$'
+            return i\sub 3
+        return i
+    )
+    literal: C P'#' * V'hex'
+    hex: R('09', 'af', 'AF') ^ 1
+    setter: C(P'=' * V'label') / (s) ->
+        if not labels[s]
+            error 'label not found: %q in %s'\format s, filename
+        return labels[s]
+    getter: C(P'~' * V'label') / (s) ->
+        if not labels[s]
+            error 'label not found: %q in %s'\format s, filename
+        return labels[s]
+    label: R('az', 'AZ', '09', '__', '--', '..', '$$', ']]', '))', '@@', '""', ',,', '##', '||', '{{', '}}', '%%', ';;', '^^', '~~', '==', '//') ^ 1
+    short: (P',' / -> ';') * (C(V'label') / (s) -> (s\gsub '%$', '&'))
+    rawshort: (P'.' / -> ':') * (C(V'label') / (s) -> (s\gsub '%$', '&'))
+    opcode: (C(R'AZ' * R'AZ' * R'AZ' * P'2' ^ -1) / (s) -> opcode_translate[s] or s) * C P'r' ^ -1 * #V'ws'
+    labeldef: C P'@' * V'label'
+    relative: (P'^' / -> ',') * (C(V'label') / (s) -> (s\gsub '%$', '&'))
+    sublabel: (P'$' / -> '&') * (C(V'label') / (s) -> (s\gsub '%$', '&'))
+    data: C P'[' * (1-P']') ^ 0 * P']'
+    macro: C(P'%' * V'name' * V'ws' * P'{') * V'ws' * (V'atom' * V'ows') ^ 0 * C P'}'
+    macroref: C V'name'
+}
+
+translate = (_filename) ->
+    filename = _filename
+    labels = {}
+    f = assert io.open filename
+    contents = f\read '*a'
+    f\close!
+    t, len = grammar\match contents
+    if len <= #contents
+        print '\027[32m%s\027[0;1m%s\027[0m'\format contents\sub(len - 100, len - 1), contents\sub(len, len + 100)
+        error 'no match'
+    filename = filename\gsub 'attic', 'auto'
+    f = assert io.open filename, 'w'
+    f\write (table.concat(t)\gsub(' +\n', '\n')\gsub('  +', ' '))
+    f\close!
+    f = assert io.popen 'bin/assembler %s bin/boot.rom'\format filename
+    for l in f\lines!
+        print l
+        if l == 'Error: Assembly[Failed]'
+            os.exit 1
+    f\close!
+    os.exit 0
+
+translate 'attic/software/left.usm'
+os.exit 0
+
+translate 'attic/software/assembler.usm'
+translate 'attic/tests/opcodes.usm'
+translate 'attic/tests/basics.usm'
+
+-- for k, v in pairs t
+--     print k