seemingly working interpret from jf

nice
honestly it might not be a bad idea to add testing
*at this point*

1 files changed, 69 insertions, 5 deletions

diff --git a/sanctuary.s b/sanctuary.s
index 8cad3f8..ce407c1 100644
--- a/sanctuary.s
+++ b/sanctuary.s
@@ -71,8 +71,7 @@ _start:
 	mov r11, 0x9c400
 	pspush r11
 	call grow
-	call parse_name
-	call type
+	call interpret
 	call bye
 
 defcode "brk@", brk@, 0
@@ -279,7 +278,7 @@ defcode "find", find, 0
 ; interpret {{{
 ; r11: word found flag
 ; r12: state
-; TODO INCOMPLETE
+; TODO respect comp-only flag (do this once error handling is impld)
 defcode "interpret", interpret, 0
 .loop:
 	call parse_name
@@ -294,17 +293,60 @@ defcode "interpret", interpret, 0
 	test r11, r11 ; set SF if negative (word found)
 	js .intrpnum
 
+.callw: ; label here for immed jump
+	call to_body
+	pspop r14
+	call r14
+	jmp .loop
+
 .intrpnum:
-	; TODO
+	call number
+	pspop r11
+	test r11, r11
+	js .notfound
+	jmp .loop
 
 .compl:
+	pspop r11
+	test r11, r11
+	js .complnum
+
+	; dup immediate? if [imm] else normal then
+	call dup
+	call immediate_q
+	pspop r13
+	test r13, r13
+	jns .callw
 
+	call to_body
+	call compile_comma
 	jmp .loop
+
+.complnum:
+	call number
+	pspop r11
+	test r11, r11
+	js .notfound
+	call literal
+	jmp .loop
+
+.notfound:
+	; error handling should go here
+	jmp .loop
+
 .eof:
 	lea r15, [r15+16] ; drop a u
 	ret
 ; }}}
 
+defcode "immediate?", immediate_q, 0
+	pspop r11
+	add r11, 8
+	mov r12b, byte [r11]
+	xor r13, r13
+	test r12b, immediate_mask
+	ret
+
 defcode ">body", to_body, 0
 	pspop r11
 	add r11, 9
@@ -336,7 +378,24 @@ defcode "literal", literal, immediate_mask|comp_only_mask
 	mov qword [here], r12
 	ret
 
-; TODO compile,
+defcode "compile,", compile_comma, 0
+	pspop r11
+	mov r12, [here]
+
+	; compile mov r11, [cfa]
+	mov word [r12], 0xbb49
+	add r12, 2
+	mov qword [r12], r11
+	add r12, 8
+
+	; compile call r11
+	mov word [r12], 0xff41
+	add r12, 2
+	mov byte [r12], 0xd3
+	inc r12
+
+	mov qword [here], r12
+	ret
 
 ; number {{{
 defcode "number", number, 0 ; ( c-addr u -- ?n flag )
@@ -409,6 +468,11 @@ defcode "number", number, 0 ; ( c-addr u -- ?n flag )
 	ret
 ; }}}
 
+defcode "dup", dup, 0
+	mov r11, [r15]
+	pspush r11
+	ret
+
 ; .s {{{
 defcode ".s", dots, 0
 	push r11