application/octet-stream
•
4.31 KB
•
98 lines
[defun disassemble/length [op]
[case op
[[#$2 #$6] 2]
[[#$9 #$A #$B #$17 #$18] 3]
[[#$5 #$E #$F #$10] 4]
[[#$8] 5]
[[#$11 #$12] 13]
[otherwise 1]]]
[defun bytecode-op->val [a b c]
[def i [val->index v]]
[index->val [logior [<< [bytecode-op->int a] 16]
[<< [bytecode-op->int b] 8]
[bytecode-op->int c] ]]]
[defun bytecode-arr->val [a i]
[bytecode-op->val [a i] [a [+ 1 i]] [a [+ 2 i]]]]
[defun bytecode-op->sym [a b c]
[def i [val->index v]]
[index->sym [logior [<< [bytecode-op->int a] 16]
[<< [bytecode-op->int b] 8]
[bytecode-op->int c] ]]]
[defun bytecode-arr->sym [a i]
[bytecode-op->sym [a i] [a [+ 1 i]] [a [+ 2 i]]]]
[defun bytecode-op->offset [a b]
[def t [logior [<< [bytecode-op->int a] 8]
[bytecode-op->int b] ] ]
[if-not [> t 32768] t
[- [- 65536 t]]]]
[defun bytecode-arr->offset [a i]
[bytecode-op->offset [a i] [a [+ 1 i]]]]
[defun disassemble/op [a i]
[cons i [case [a i]
[#$0 '[$nop]]
[#$1 '[$ret]]
[#$2 `[$push/int/byte ~[bytecode-op->int [a [+ i 1]]]]]
[#$3 '[$add/int]]
[#$4 '[$debug/print-stack]]
[#$5 `[$push/lval ~[bytecode-arr->val a [+ i 1]]]]
[#$6 `[$make-list ~[bytecode-op->int [a [+ i 1]]]]]
[#$7 '[$eval]]
[#$8 `[$apply ~[bytecode-op->int [a [+ i 1]]]
~[bytecode-arr->val a [+ i 1]]]]
[#$9 `[$jmp* ~[bytecode-arr->offset a [+ i 1]]]]
[#$B '[$dup]]
[#$A `[$jt* ~[bytecode-arr->offset a [+ i 1]]]]
[#$C '[$drop]]
[#$D `[$def ~[bytecode-arr->sym a [+ i 1]]]]
[#$E `[$set ~[bytecode-arr->sym a [+ i 1]]]]
[#$F `[$jf* ~[bytecode-arr->offset a [+ i 1]]]]
[#$10 `[$lambda ~[bytecode-arr->val a [+ i 1]]
~[bytecode-arr->val a [+ i 4]]
~[bytecode-arr->val a [+ i 7]]
~[bytecode-arr->val a [+ i 10]]]]
[#$11 `[$macro ~[bytecode-arr->val a [+ i 1]]
~[bytecode-arr->val a [+ i 4]]
~[bytecode-arr->val a [+ i 7]]
~[bytecode-arr->val a [+ i 10]]]]
[#$12 `[$get ~[bytecode-arr->sym a [+ i 1]]]]
[#$13 '[$closure/push]]
[#$14 '[$closure/enter]]
[#$15 '[$let]]
[#$16 '[$closure/pop]]
[#$17 `[$call ~[bytecode-arr->offset a [+ i 1]]]]
[#$18 `[$try ~[bytecode-arr->offset a [+ i 1]]]]
[#$19 '[$throw]]
[otherwise :unknown-op]]]]
[defun disassemble/array [a i]
[def ret #nil]
[while [< i [array/length a]]
[set! ret [cons [disassemble/op a i] ret]]
[set! i [+ i [disassemble/length [a i]]]]]
[nreverse ret]]
[defun disassemble [code]
[disassemble/array [bytecode-arr->arr code] 0]]
[defun disassemble/test [asm]
[println [ansi-blue "--------- Assembly -----------"]]
[def cur-line 0]
[for-each asm [\ [a] [println [cat [ansi-yellow [string/pad-start [++ cur-line] 6]]
" - "
a]]]]
[println [ansi-yellow "--------- Raw Bytecode -----------"]]
[def bc [apply assemble asm]]
[println [str/write bc]]
[println [ansi-green "--------- Now for the disassembly -----------"]]
[for-each [disassemble bc] [\ [a]
[println [cat [ansi-blue [string/pad-start [string [car a]] 6]]
" - "
[cdr a]]]]]
[println [ansi-red "--------- Fin -----------\n"]]
[try display/error [println [str/write [bytecode-eval bc]]]]]
