82 lines
2.1 KiB
Text
82 lines
2.1 KiB
Text
Red [
|
|
Title: "Compiler/virtual machine interpreter"
|
|
Author: "hinjolicious"
|
|
]
|
|
|
|
#include %lex2-bak.red
|
|
#include %parse.red
|
|
#include %gen3.red
|
|
#include %../../mylib/mylib.red
|
|
#include %../../mylib/profiler-greg.red
|
|
|
|
VM: func [code /local stk var-pool pc op x][
|
|
stk: copy []
|
|
var-pool: #[]
|
|
|
|
error: func [msg][ print ["ERROR:" msg halt] ]
|
|
|
|
pc: 1
|
|
forever [
|
|
op: code/:pc
|
|
pc: pc + 1
|
|
switch/default op [
|
|
FETCH [ insert stk var-pool/(code/:pc) pc: pc + 1 ]
|
|
STORE [ var-pool/(code/:pc): stk/1 take stk pc: pc + 1 ]
|
|
PUSH [ insert stk code/:pc pc: pc + 1 ]
|
|
|
|
ADD [ stk/2: stk/2 + stk/1 take stk]
|
|
SUB [ stk/2: stk/2 - stk/1 take stk]
|
|
MUL [ stk/2: stk/2 * stk/1 take stk]
|
|
DIV [ stk/2: to integer! stk/2 / stk/1 take stk]
|
|
MOD [ stk/2: modulo stk/2 stk/1 take stk]
|
|
|
|
LT [ stk/2: either stk/2 < stk/1 [1][0] take stk]
|
|
GT [ stk/2: either stk/2 > stk/1 [1][0] take stk]
|
|
LE [ stk/2: either stk/2 <= stk/1 [1][0] take stk]
|
|
GE [ stk/2: either stk/2 >= stk/1 [1][0] take stk]
|
|
EQ [ stk/2: either stk/2 = stk/1 [1][0] take stk]
|
|
NE [ stk/2: either stk/2 <> stk/1 [1][0] take stk]
|
|
|
|
AND [ stk/2: stk/2 * stk/1 take stk] ; bit and
|
|
OR [ stk/2: stk/2 + stk/1 take stk] ; bit or
|
|
NEG [ stk/1: negate stk/1 ]
|
|
NOT [ stk/1: either stk/1 = 0 [1][0] ]
|
|
|
|
JMP [ pc: pc + code/:pc ]
|
|
JZ [ pc: either stk/1 = 0 [pc + code/:pc][pc + 1] take stk ]
|
|
|
|
PRTC [ prin to char! stk/1 take stk ]
|
|
PRTI [ prin to integer! stk/1 take stk ]
|
|
PRTS [ x: stk/1
|
|
replace/all x "\\n" "`n`" replace/all x "\n" "^/"
|
|
prin replace/all x "`n`" "\n" take stk ]
|
|
HALT [ exit ]
|
|
][ error rejoin ["Unknown opcode: " op] ]
|
|
]
|
|
] ; vm
|
|
|
|
test: does [
|
|
while [(tx: ask "Code: ") <> ""] [
|
|
case [
|
|
tx = "r" [tx: read fn: request-file]
|
|
all [tx = "s" fn <> "" tcode <> ""] [
|
|
out-fn: replace fn ".t" ".tcode"
|
|
write out-fn tcode
|
|
print ["Saved to " out-fn]
|
|
continue ] ]
|
|
?? fn
|
|
;?? tx
|
|
lx: lex tx
|
|
;?? lx
|
|
ast: parse lx
|
|
;?? ast
|
|
gen ast
|
|
;?? code
|
|
tcode: list-code
|
|
print tx
|
|
print tcode
|
|
timer: [vm code]
|
|
profile/show [timer]
|
|
]
|
|
]
|
|
test
|