rebol[
	Title: "Tiny Dialect"
	Date: 3-Mayl-2007
    	File: %tiny_dialect.r
    	Version: 0.90
    	Author: "Tim Wylie"
    	Purpose: "Write inline tiny code."
]

tiny-dialect: make object![
	tiny-emulator: make object![
		accumulator: none 	;stack-pointer: none instruction-register: none
		program-counter: none
		stack: none

		set-memory: func[i[integer!] str[string!]][ i: i + 1
			;have to set the memory and the two asm variables
			program-lines/:i/memory: str
			program-lines/:i/opcode-asm: (copy/part str 2)
			program-lines/:i/operand-asm: reverse(copy/part reverse str 3)

		]
		get-memory: func[i[integer!]][ i: i + 1
			program-lines/:i/memory
		]
		get-program-line: func[i[integer!]][ i: i + 1
			program-lines/:i
		]
		run-inline: func[/norebol][
			program-counter: 0
			stack: copy []
			cpu-running: true
			while[cpu-running = true][
				line: get-program-line (to-integer program-counter)
				switch/default line/opcode-asm [
					0[cpu-running: false]	;stop
					1[either line/reb[accumulator: line/operand-asm][accumulator: get-memory (to-integer line/operand-asm)]];ld x
					2[accumulator: get-memory (get-memory line/operand-asm)];ldi x;
					3[accumulator: line/operand-asm];lda x
					4[either line/reb[m: get to-word line/operand m: accumulator]
						[set-memory line/operand-asm accumulator]];st x
					5[ set-memory (get-memory line/operand-asm) accumulator];stix
					6[accumulator: (to-integer accumulator) + (to-integer get-memory (to-integer line/operand-asm))]	;add x
					7[accumulator: (to-integer accumulator) - (to-integer get-memory (to-integer line/operand-asm))]	;sub x
					8[accumulator: (to-integer accumulator) * (to-integer get-memory (to-integer line/operand-asm))]	;mul x
					9[accumulator: (to-integer accumulator) / (to-integer get-memory (to-integer line/operand-asm))]		;div x
					10[if char: (pick input 1) <> none[accumulator: to-integer char]]	;in
					11[prin accumulator]	;out
					12[program-counter: (to-integer line/operand-asm) - 1];b x
					13[if (to-integer accumulator) > 0 [program-counter: (to-integer line/operand-asm) - 1]];bp x
					14[if (to-integer accumulator) < 0 [program-counter: (to-integer line/operand-asm) - 1]];bn x
					15[if (to-integer accumulator) = 0 [program-counter: (to-integer line/operand-asm) - 1]];bz x
					16[	insert stack program-counter
						program-counter: to-integer line/operand-asm

						switch/default to-integer line/operand-asm[
							900[prin to-integer accumulator
								(program-counter: first stack) remove stack]
							925[	i: 0
								while [(to-integer (get-memory ((to-integer accumulator) + i ))) > 0][
									prin to-char to-integer(get-memory ((to-integer accumulator) + i))
									i: i + 1]
								(program-counter: first stack) remove stack]
							950[	num: input
								if (length? num) > 0[accumulator: to-integer num]
								(program-counter: first stack) remove stack]
							975[	str: input
								if (length? str) > 0[i: 0
									while[i < length? str][
										set-memory (accumulator + i) (pick str (i + 1)) i: i + 1]
									set-memory (accumulator + i) "00000"
									(program-counter: first stack) remove stack
								]]
						][program-counter: (to-integer program-counter) - 1]
					];?jsb x
					17[(program-counter: first stack) remove stack]; rsb x
					18[insert stack accumulator];push
					19[(accumulator: first stack) remove stack]; pop
				][print rejoin["Fatal Error:  Bad Opcode line " program-counter]	cpu-running: false]
				program-counter: (to-integer program-counter) + 1
			]return
		]
	]
	make-row: func[rn[integer!] /opcode opc[string!] /asm-opcode aopc /operand oper /asm-operand aoper /byte b][
		make object![rownum: rn opcode: opc opcode-asm: aopc operand: oper
			operand-asm: aoper memory: b reb: false]
	]
	pad: func [value [string! number!] length [integer!] /fill char [char!] /locals field][
	    if not string? value [value: form value]
	    if none? char [char: #"0"]
	    insert/dup field: copy "" char length
	    change/part field head reverse value length? value
	    head reverse field
	]

	tiny-assembler: func[/norebol][
		if error? err: try[
			memory: copy []
			foreach line program-lines[
				if all[line/opcode (none? line/opcode-asm)][line/opcode-asm: (select opcode-table line/opcode)]
				if all[line/opcode-asm (none? line/opcode)][line/opcode: first back (find opcode-table line/opcode-asm)]
				if line/operand[
					line-oper: (select symbol-table line/operand)
					if none? line-oper[numbers: charset[#"0" - #"9"]
						either (parse/all line/operand [some numbers])[
							line-oper: (pad line/operand 3)
						][
							either norebol[throw rejoin["Illegal operand line" line/rownum]][
								either (value? get to-word line/operand)[
									line-oper: get to-word line/operand
									line/reb: true
								][throw rejoin["Illegal operand line" line/rownum]]
							]
						]
					]line/operand-asm: (pad line-oper 3)
				]
				either line/memory[line/memory: (pad to-string line/memory 5)
				][line/memory: rejoin[(pad line/opcode-asm 2) (pad to-integer line-oper 3)]]
			]
		][print rejoin["Error assembling: " err/type err/code err/id err/where err/near err/arg1 err/arg2 err/arg3]]
	]
	tiny-parser: func[data [string!]][
		validchars: charset [#"0" - #"9" #"A" - #"Z" #"a" - #"z" #"_" #"#"]
		numbers: charset[#"0" - #"9"]
		stringchars: complement charset[#"'"]
		whitespace: charset [#"^-" #"^/" " "]
		program-lines: copy []
		symbol-table: ["printn" 900 "printc" 925 "inputn" 950 "inputc" 975]
		line-counter: 0

		;verify syntax/build symbol table
		if error? try[
			foreach str parse/all data "^/"[
				opcode: none operand: none
				parse/all str [
					any[
						[copy opcode ["lda"|"ldi"|"ld"|"sti"|"st"|"add"|"sub"|"mul"|"div"|"bz"|"bp"|"bn"|"b"|"jsb"] some whitespace
							copy operand some validchars (append program-lines (make-row/opcode/operand/asm-opcode line-counter opcode operand (select opcode-table opcode)) line-counter: line-counter + 1)]
						|[["db"] some whitespace copy operand some validchars (
								unless (parse/all operand [some numbers])[operand: to-integer (get to-word operand)]
								append program-lines (make-row/byte line-counter operand) line-counter: line-counter + 1)]
						|[["ds"] some whitespace copy operand some validchars (
								unless (parse/all operand [some numbers])[operand: to-integer (get to-word operand)]
								loop to-integer operand [append program-lines (make-row/byte line-counter 0) line-counter: line-counter + 1])]
						|[["dc"] any whitespace ["'" copy operand some stringchars "'" | copy operand some validchars (operand: to-string (get to-word operand))]
							(foreach let operand [append program-lines (make-row/byte line-counter to-integer let) line-counter: line-counter + 1])]
						|[copy opcode ["stop"|"in"|"out"|"push"|"pop"|"rsb"](append program-lines (make-row/opcode/asm-opcode line-counter opcode (select opcode-table opcode)) line-counter: line-counter + 1)]
						|[copy symbol some validchars ":"(repend symbol-table [symbol line-counter])]
						|[any whitespace ";" to end]
						|[some whitespace]
					]
				]
			]
		][print rejoin["Error parsing tiny code line: " line-counter] return false]
		return true
	]
	set 'tiny func[data [string!] /norebol /files][
		program-line: none symbol-table: none
		if tiny-parser data[
			either norebol[tiny-assembler/norebol][tiny-assembler]
			if files[print output assembly file]
			tiny-emulator/run-inline]
	]
	opcode-table: ["stop" 00 "ld" 01 "ldi" 02 "lda" 03 "st" 04 "sti" 05 "add" 06 "sub" 07 "mul" 08 "div" 09
		    "in" 10 "out" 11 "b" 12 "bp" 13 "bn" 14 "bz" 15 "jsb" 16 "rsb" 17 "push" 18 "pop" 19]
	symbol-table: none
	program-lines: none
]