Data update

Task/Compiler-virtual-machine-interpreter/Red/compiler-virtual-machine-interpreter.red

@@ -0,0 +1,82 @@
+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