moving some stuff over from jewelforth

i would like to at some point add $ and % prefixes
to the number interpreter.

1 files changed, 134 insertions, 0 deletions

diff --git a/sanctuary.s b/sanctuary.s
index 30a9f5b..8cad3f8 100644
--- a/sanctuary.s
+++ b/sanctuary.s
@@ -276,6 +276,139 @@ defcode "find", find, 0
 	pspush r13
 	ret
 
+; interpret {{{
+; r11: word found flag
+; r12: state
+; TODO INCOMPLETE
+defcode "interpret", interpret, 0
+.loop:
+	call parse_name
+	cmp qword [r15], 0
+	je .eof
+	call find
+	mov r12, qword [state]
+	cmp r12, INTERPRET
+	jne .compl
+
+	pspop r11
+	test r11, r11 ; set SF if negative (word found)
+	js .intrpnum
+
+.intrpnum:
+	; TODO
+
+.compl:
+
+	jmp .loop
+.eof:
+	lea r15, [r15+16] ; drop a u
+	ret
+; }}}
+
+defcode ">body", to_body, 0
+	pspop r11
+	add r11, 9
+	xor r12, r12
+	mov r12b, byte [r11]
+	inc r11
+	add r11, r12
+	pspush r11
+	ret
+
+defcode "literal", literal, immediate_mask|comp_only_mask
+	; 4d 8d 7f f8
+	; 49 bb VAL
+	; 4d 89 1f
+	pspop r11
+	mov r12, qword [here]
+
+	mov dword [r12], 0xf87f8d4d
+	add r12, 4
+	mov word [r12], 0xbb49
+	add r12, 2
+	mov qword [r12], r11
+	add r12, 8
+	mov word [r12], 0x894d
+	add r12, 2
+	mov byte [r12], 0x1f
+	inc r12
+
+	mov qword [here], r12
+	ret
+
+; TODO compile,
+
+; number {{{
+defcode "number", number, 0 ; ( c-addr u -- ?n flag )
+	pspop r11 ; u
+	pspop r12 ; c-addr
+	xor r13, r13 ; r13: result
+	xor r14, r14 ; r14b: current char
+	xor r10, r10 ; r10: negative flag
+	mov r9, qword [base]
+
+	cmp r11, 0
+	je .no
+
+	mov r14b, byte [r12]
+	cmp r14b, '-'
+	jnz .enterloop
+	mov r10, true
+	inc r12
+	dec r11
+
+.loop:
+	mov r14b, byte [r12]
+
+.enterloop:
+	; non numeral = goodbye
+	cmp r14b, 48
+	jl .no
+
+	sub r14b, 48
+	cmp r14b, 10 ; 48+10: < ':', <= '9'
+	jl .basecmp
+	cmp r14b, 17 ; ':' - '@'
+	jl .no
+	sub r14b, 7 ; keep 10 so 'A' = 10
+	cmp r14b, 36 ; < '[' <= 'Z'
+	jl .basecmp
+	cmp r14b, 42 ; < 'a'
+	jl .no
+	sub r14b, 32
+	cmp r14b, 36 ; < '{' <= 'z'
+	jl .basecmp
+	jmp .no
+
+.basecmp:
+	cmp r14, r9
+	jge .no
+
+	imul r13, r9
+	add r13, r14
+
+	inc r12
+	dec r11
+
+	cmp r11, 0
+	jne .loop
+
+	test r10, r10
+	jz .bye
+	neg r13
+
+.bye:
+	pspush r13
+	mov r13, true
+	pspush r13
+	ret
+
+.no:
+	mov r13, false
+	pspush r13
+	ret
+; }}}
+
 ; .s {{{
 defcode ".s", dots, 0
 	push r11
@@ -316,6 +449,7 @@ defcode ".s", dots, 0
 ; }}}
 
 defvar "state", state, 0, INTERPRET
+defvar "base", base, 0, 10
 defvar "dp", dp, 0, 0
 defvar "dp0", dp0, 0, 0
 defvar "dp$", dp$, 0, 0