application/octet-stream
•
7.59 KB
•
118 lines
;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Contains the disassembler, which is probably not that important to most
;;; people, but invaluable when working on compiler internals
[def disassemble [let*
[defn disassemble/length [op]
"Return the length in bytes of a bytecode operation and all its arguments"
[case op
[[#$0 #$1 #$3 #$C #$D #$11 #$12 #$13 #$14 #$15 #$16 #$17 #$18 #$19 #$1B #$1C #$1E #$1F #$20 #$21 #$22 #$24 #$25 #$26 #$27 #$28 #$29 #$2A] 1]
[[#$2 #$4 #$E #$1A #$5 #$7] 2]
[[#$6 #$9 #$A #$B #$F #$10 #$8] 3]
[otherwise [throw [list :unknown-op "This op needs its length specified for disassembly to work" op [current-lambda]]]]]]
[defn bytecode/nil-catcher [error] [if [= [car error] :type-error] #nil [throw error]]]
[defn bytecode-arr->val [a i]
"Read a bytecode encoded value in A at I and return it"
[try bytecode/nil-catcher [bytecode-op->val [ref a i] [ref a [+ 1 i]] [ref a [+ 2 i]]]]]
[defn bytecode-arr->sym [a i]
"Read a bytecode encoded symbol in A at I and return it"
[try bytecode/nil-catcher [bytecode-op->sym [ref a i] [ref a [+ 1 i]] [ref a [+ 2 i]]]]]
[defn bytecode-op->offset [a b]
"Turn two bytecode ops encoding an offset into the integer representation"
[def t [bit-or [bit-shift-left [bytecode-op->int a] 8]
[bytecode-op->int b] ] ]
[if-not [> t 32768] t
[- [- 65536 t]]]]
[defn bytecode-arr->offset [a i]
"Read a bytecode encoded offset in A at I and return it as a signed integer"
[bytecode-op->offset [ref a i] [ref a [+ 1 i]]]]
[defn disassemble/maybe-quote [v]
"Quotes symbols but just passes through every other value"
[if [symbol? v] [list 'quote v] v]]
[defn disassemble/op [a i literals]
"Disassemble a single bytecode op in A at I and return it as an s-expression, that could be applied to eval"
[case [ref a i]
[#$0 '[$nop]]
[#$1 '[$ret]]
[#$2 `[$push/int/byte ~[bytecode-op->int [ref a [+ i 1]]]]]
[#$3 '[$add/int]]
[#$4 `[$apply ~[bytecode-op->int [ref a [+ i 1]]]]]
[#$5 `[$set/val ~[disassemble/maybe-quote [ref literals [bytecode-op->int [ref a [+ i 1]]]]]]]
[#$6 `[$push/val/ext ~[ref literals [bit-or [bytecode-op->int [ref a [+ i 1]]]
[bit-shift-left [bytecode-op->int [ref a [+ i 2]]] 8]]]]]
[#$7 `[$det/val ~[disassemble/maybe-quote [ref literals [bytecode-op->int [ref a [+ i 1]]]]]]]
[#$8 `[$def/val/ext ~[ref literals [bit-or [bytecode-op->int [ref a [+ i 1]]]
[bit-shift-left [bytecode-op->int [ref a [+ i 2]]] 8]]]]]
[#$9 `[$jmp* ~[bytecode-arr->offset a [+ i 1]]]]
[#$A `[$jt* ~[bytecode-arr->offset a [+ i 1]]]]
[#$B `[$jf* ~[bytecode-arr->offset a [+ i 1]]]]
[#$C '[$dup]]
[#$D '[$drop]]
[#$E `[$get/val ~[disassemble/maybe-quote [ref literals [bytecode-op->int [ref a [+ i 1]]]]]]]
[#$F `[$get/val/ext ~[ref literals [bit-or [bytecode-op->int [ref a [+ i 1]]]
[bit-shift-left [bytecode-op->int [ref a [+ i 2]]] 8]]]]]
[#$10 `[$set/val/ext ~[ref literals [bit-or [bytecode-op->int [ref a [+ i 1]]]
[bit-shift-left [bytecode-op->int [ref a [+ i 2]]] 8]]]]]
[#$11 '[$car]]
[#$12 '[$cdr]]
[#$13 '[$closure/push]]
[#$14 '[$cons]]
[#$15 '[$let]]
[#$16 '[$closure/pop]]
[#$17 '[$fn/dynamic]]
[#$18 '[$macro/dynamic]]
[#$19 `[$try ~[bytecode-arr->offset a [+ i 1]]]]
[#$1A `[$push/val ~[disassemble/maybe-quote [ref literals [bytecode-op->int [ref a [+ i 1]]]]]]]
[#$1E '[$<]]
[#$1F '[$<=]]
[#$20 '[$=]]
[#$21 '[$>=]]
[#$22 '[$>]]
[#$23 '[$inc/int]]
[#$24 '[$push/nil]]
[#$25 '[$add]]
[#$26 '[$sub]]
[#$27 '[$mul]]
[#$28 '[$div]]
[#$29 '[$rem]]
[#$2A '[$zero?]]
[otherwise :unknown-op]]]
[defn disassemble/array [a i literals]
"Disassemble all bytecode operations in the plain array A starting at I, turning it into an assembler S-Expression and return it as a dotted pair, with the car containing the offset and the cdr containing the S-Expression"
[def ret #nil]
[while [< i [array/length a]]
[cons! [cons i [disassemble/op a i literals]] ret]
[set! i [+ i [disassemble/length [ref a i]]]]]
[nreverse ret]]
[defn disassemble/bytecode-array [code]
"Disassemble the bytecode array CODE, turning it into a list of dotted pairs, with the car containing the offset and the cdr containing assembler S-Expressions,"
[disassemble/array [bytecode-arr->arr code] 0 [bytecode-literals code]]]
[defn disassemble/print [bc]
[doseq [a [disassemble/bytecode-array bc]]
[println [cat [pad-start [string [car a]] 6]
" - "
[cdr a]]]]]
[defn disassemble [bc]
"Disassemble the bytecode array CODE, turning it into a list of dotted pairs, with the car containing the offset and the cdr containing assembler S-Expressions,"
:cat :bytecode
:internal
[case [type-of bc]
[[:lambda :macro] [disassemble/print [closure/code bc]]]
[:bytecode-array [disassemble/print bc]]
[otherwise [throw [list :type-error "Can't disassemble that" bc [current-lambda]]]]]]]]
