new file mode 100644

@@ -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