application/octet-stream
•
4.25 KB
•
1 line
[do [def disassemble/length [λ* disassemble/length [op] "" [let* [do [def ΓεnΣym-52 op] [if [or [== ΓεnΣym-52 #$2] [== ΓεnΣym-52 #$6]] 2 [if [or [== ΓεnΣym-52 #$9] [== ΓεnΣym-52 #$A] [== ΓεnΣym-52 #$B] [== ΓεnΣym-52 #$17] [== ΓεnΣym-52 #$18]] 3 [if [or [== ΓεnΣym-52 #$5] [== ΓεnΣym-52 #$E] [== ΓεnΣym-52 #$F] [== ΓεnΣym-52 #$10]] 4 [if [or [== ΓεnΣym-52 #$8]] 5 [if [or [== ΓεnΣym-52 #$11] [== ΓεnΣym-52 #$12]] 13 1]]]]]]]]] [def bytecode-op->val [λ* bytecode-op->val [a b c] "" [do [def i [val->index v]] [index->val [logior [<< [bytecode-op->int a] 16] [<< [bytecode-op->int b] 8] [bytecode-op->int c]]]]]] [def bytecode-arr->val [λ* bytecode-arr->val [a i] "" [bytecode-op->val [a i] [a [+ 1 i]] [a [+ 2 i]]]]] [def bytecode-op->sym [λ* bytecode-op->sym [a b c] "" [do [def i [val->index v]] [index->sym [logior [<< [bytecode-op->int a] 16] [<< [bytecode-op->int b] 8] [bytecode-op->int c]]]]]] [def bytecode-arr->sym [λ* bytecode-arr->sym [a i] "" [bytecode-op->sym [a i] [a [+ 1 i]] [a [+ 2 i]]]]] [def bytecode-op->offset [λ* bytecode-op->offset [a b] "" [do [def t [logior [<< [bytecode-op->int a] 8] [bytecode-op->int b]]] [if [> t 32768] [- [- 65536 t]] t]]]] [def bytecode-arr->offset [λ* bytecode-arr->offset [a i] "" [bytecode-op->offset [a i] [a [+ 1 i]]]]] [def disassemble/op [λ* disassemble/op [a i] "" [cons i [let* [do [def ΓεnΣym-53 [a i]] [if [== ΓεnΣym-53 #$0] '[$nop] [if [== ΓεnΣym-53 #$1] '[$ret] [if [== ΓεnΣym-53 #$2] [cons '$push/int/byte [cons [bytecode-op->int [a [+ i 1]]] #nil]] [if [== ΓεnΣym-53 #$3] '[$add/int] [if [== ΓεnΣym-53 #$4] '[$debug/print-stack] [if [== ΓεnΣym-53 #$5] [cons '$push/lval [cons [bytecode-arr->val a [+ i 1]] #nil]] [if [== ΓεnΣym-53 #$6] [cons '$make-list [cons [bytecode-op->int [a [+ i 1]]] #nil]] [if [== ΓεnΣym-53 #$7] '[$eval] [if [== ΓεnΣym-53 #$8] [cons '$apply [cons [bytecode-op->int [a [+ i 1]]] [cons [bytecode-arr->val a [+ i 1]] #nil]]] [if [== ΓεnΣym-53 #$9] [cons '$jmp* [cons [bytecode-arr->offset a [+ i 1]] #nil]] [if [== ΓεnΣym-53 #$B] '[$dup] [if [== ΓεnΣym-53 #$A] [cons '$jt* [cons [bytecode-arr->offset a [+ i 1]] #nil]] [if [== ΓεnΣym-53 #$C] '[$drop] [if [== ΓεnΣym-53 #$D] [cons '$def [cons [bytecode-arr->sym a [+ i 1]] #nil]] [if [== ΓεnΣym-53 #$E] [cons '$set [cons [bytecode-arr->sym a [+ i 1]] #nil]] [if [== ΓεnΣym-53 #$F] [cons '$jf* [cons [bytecode-arr->offset a [+ i 1]] #nil]] [if [== ΓεnΣym-53 #$10] [cons '$lambda [cons [bytecode-arr->val a [+ i 1]] [cons [bytecode-arr->val a [+ i 4]] [cons [bytecode-arr->val a [+ i 7]] [cons [bytecode-arr->val a [+ i 10]] #nil]]]]] [if [== ΓεnΣym-53 #$11] [cons '$macro [cons [bytecode-arr->val a [+ i 1]] [cons [bytecode-arr->val a [+ i 4]] [cons [bytecode-arr->val a [+ i 7]] [cons [bytecode-arr->val a [+ i 10]] #nil]]]]] [if [== ΓεnΣym-53 #$12] [cons '$get [cons [bytecode-arr->sym a [+ i 1]] #nil]] [if [== ΓεnΣym-53 #$13] '[$closure/push] [if [== ΓεnΣym-53 #$14] '[$closure/enter] [if [== ΓεnΣym-53 #$15] '[$let] [if [== ΓεnΣym-53 #$16] '[$closure/pop] [if [== ΓεnΣym-53 #$17] [cons '$call [cons [bytecode-arr->offset a [+ i 1]] #nil]] [if [== ΓεnΣym-53 #$18] [cons '$try [cons [bytecode-arr->offset a [+ i 1]] #nil]] [if [== ΓεnΣym-53 #$19] '[$throw] :unknown-op]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]] [def disassemble/array [λ* disassemble/array [a i] "" [do [def ret #nil] [while [< i [array/length a]] [do [set! ret [cons [disassemble/op a i] ret]] [set! i [+ i [disassemble/length [a i]]]]]] [nreverse ret]]]] [def disassemble [λ* disassemble [code] "" [disassemble/array [bytecode-arr->arr code] 0]]] [def disassemble/test [λ* disassemble/test [asm] "" [do [println [ansi-blue "--------- Assembly -----------"]] [def cur-line 0] [for-each asm [λ* #nil [a] "" [println [cat [ansi-yellow [string/pad-start [set! cur-line [+ 1 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] [λ* #nil [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]]]]]]]]
