vaguely working interpretation

1 files changed, 109 insertions, 22 deletions

diff --git a/sanctuary.s b/sanctuary.s
index eda1466..a2ba5dd 100644
--- a/sanctuary.s
+++ b/sanctuary.s
@@ -44,8 +44,8 @@
 %assign immediate_mask	0x2
 %assign comp_only_mask	0x4
 
-%assign true 0x0
-%assign false (~0x0)
+%assign false 0x0
+%assign true (~0x0)
 
 %assign INTERPRET 0x0
 %assign COMPILING (~0x0)
@@ -55,6 +55,8 @@
 %assign __NR_brk	12
 %assign __NR_exit	60
 
+%assign init_brk	0x9c400
+
 section .bss
 resq 4091
 wstk: resq 1
@@ -68,9 +70,15 @@ _start:
 	pspop r11
 	mov qword [dp], r11
 	mov qword [dp0], r11
-	mov r11, 0x9c400
+	mov r11, init_brk
 	pspush r11
 	call grow
+	; TODO grow should call executable automatically
+	mov r11, qword [dp0]
+	pspush r11
+	mov r11, init_brk
+	pspush r11
+	call executable
 	call interpret
 	call bye
 
@@ -279,6 +287,7 @@ defcode "find", find, 0
 ; r11: word found flag
 ; r12: state
 ; TODO respect comp-only flag (do this once error handling is impld)
+; TODO it doesnt work right
 defcode "interpret", interpret, 0
 .loop:
 	call parse_name
@@ -286,47 +295,53 @@ defcode "interpret", interpret, 0
 	je .eof
 	call find
 	mov r12, qword [state]
-	cmp r12, INTERPRET
-	jne .compl
-
+	cmp r12, COMPILING
+	je .compl
+ 
 	pspop r11
-	test r11, r11 ; set SF if negative (word found)
-	js .intrpnum
+	cmp r11, false
+	je .intrpnum
 
 .callw: ; label here for immed jump
 	call to_body
-	pspop r14
-	call r14
+	pspop r13
+	call r13
 	jmp .loop
 
 .intrpnum:
 	call number
 	pspop r11
-	test r11, r11
-	js .notfound
+	cmp r11, false
+	je .notfound
 	jmp .loop
 
 .compl:
+	; call dots
 	pspop r11
-	test r11, r11
-	js .complnum
+	cmp r11, false
+	je .complnum
 
 	; dup immediate? if [imm] else normal then
+	; i think this is broken (; not working)
 	call dup
+	; call dots
 	call immediate_q
+	; call dots
 	pspop r13
-	test r13, r13
-	jns .callw
+	cmp r13, true
+	je .callw
 
 	call to_body
 	call compile_comma
 	jmp .loop
 
 .complnum:
+	; call dots
 	call number
+	; call dots
 	pspop r11
-	test r11, r11
-	js .notfound
+	cmp r11, false
+	je .notfound
 	call literal
 	jmp .loop
 
@@ -345,6 +360,9 @@ defcode "immediate?", immediate_q, 0
 	mov r12b, byte [r11]
 	xor r13, r13
 	test r12b, immediate_mask
+	setnz r13b
+	neg r13
+	pspush r13
 	ret
 
 defcode ">body", to_body, 0
@@ -362,7 +380,7 @@ defcode "literal", literal, immediate_mask|comp_only_mask
 	; 49 bb VAL
 	; 4d 89 1f
 	pspop r11
-	mov r12, qword [here]
+	mov r12, qword [dp]
 
 	mov dword [r12], 0xf87f8d4d
 	add r12, 4
@@ -375,12 +393,12 @@ defcode "literal", literal, immediate_mask|comp_only_mask
 	mov byte [r12], 0x1f
 	inc r12
 
-	mov qword [here], r12
+	mov qword [dp], r12
 	ret
 
 defcode "compile,", compile_comma, 0
 	pspop r11
-	mov r12, [here]
+	mov r12, [dp]
 
 	; compile mov r11, [cfa]
 	mov word [r12], 0xbb49
@@ -394,7 +412,7 @@ defcode "compile,", compile_comma, 0
 	mov byte [r12], 0xd3
 	inc r12
 
-	mov qword [here], r12
+	mov qword [dp], r12
 	ret
 
 defcode "[", lbrac, immediate_mask
@@ -405,6 +423,63 @@ defcode "]", rbrac, immediate_mask
 	mov qword [state], COMPILING
 	ret
 
+defcode "(header)", brac_header, 0
+	pspop r9
+	pspop r10
+	mov r11, qword [latest]
+	mov r12, qword [dp]
+	push r12
+
+	mov qword [r12], r11
+	add r12, 8
+	mov byte [r12], 0
+	inc r12
+	mov byte [r12], r9b
+	inc r12
+
+	mov rcx, r9
+	mov rsi, r10
+	mov rdi, r12
+	rep movsb
+	add r12, r9
+
+	mov qword [dp], r12
+	pop r12
+	pspush r12
+	ret
+
+defcode ":", colon, 0
+	call parse_name
+	; todo check zero
+	call brac_header
+	pspop r11
+	mov qword [latest], r11
+	call smudge
+	mov qword [state], COMPILING
+	ret
+
+defcode ";", semicolon, immediate_mask
+	mov r12, [latest]
+	add r12, 8
+	mov r13b, [r12]
+	and r13b, ~smudge_mask ; does this syntax work? equiv SMUDGEMASK NOT
+	mov byte [r12], r13b
+
+	mov r11, qword [dp]
+	mov byte [r11], 0xc3 ; ret
+	inc r11
+	mov qword [dp], r11
+	mov qword [state], INTERPRET
+	ret
+
+defcode "smudge", smudge, 0
+	mov r12, [latest]
+	add r12, 8
+	mov r13b, [r12]
+	xor r13b, smudge_mask
+	mov byte [r12], r13b
+	ret
+
 ; number {{{
 defcode "number", number, 0 ; ( c-addr u -- ?n flag )
 	pspop r11 ; u
@@ -481,6 +556,7 @@ defcode "dup", dup, 0
 	pspush r11
 	ret
 
+; TEMPORARY WONKY DEBUGGING FUNCTIONS {{{
 ; .s {{{
 defcode ".s", dots, 0
 	push r11
@@ -520,6 +596,17 @@ defcode ".s", dots, 0
 .dmsg: db "DONEDONEYIPPEEEE"
 ; }}}
 
+defcode "HEREDUMP", heredump, 0
+	mov rdx, [dp]
+	mov r11, [dp0]
+	sub rdx, r11
+	mov rsi, [dp0]
+	mov rdi, 1
+	mov rax, __NR_write
+	syscall
+	ret
+; }}}
+
 defvar "state", state, 0, INTERPRET
 defvar "base", base, 0, 10
 defvar "dp", dp, 0, 0