summaryrefslogtreecommitdiff
path: root/sanctuary.s
diff options
context:
space:
mode:
Diffstat (limited to 'sanctuary.s')
-rw-r--r--sanctuary.s74
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