loouping and start of wordlist

2 files changed, 50 insertions, 23 deletions

diff --git a/sanctuary.fs b/sanctuary.fs
index 8880ccb..018da63 100644
--- a/sanctuary.fs
+++ b/sanctuary.fs
@@ -349,30 +349,57 @@ privatise
 
 \ DO LOOP {{{
 \ todo doc
-: do  postpone swap postpone >r postpone >r  <mark ; immediate compile-only
-\ : ?do  postpone <> ?branch >mark
-\ 	postpone swap postpone >r postpone >r  <mark ; immediate compile-only
-: +loop  postpone r> postpone + postpone r@
+: do ( comp: -- mark f )
+	postpone swap postpone >r postpone >r  <mark false ; immediate compile-only
+: ?do ( comp: ?domark mark t ) postpone 2dup postpone <> ?branch >mark
+	postpone swap postpone >r postpone >r  <mark true ; immediate compile-only
+: +loop  ( ? ) >r
+	postpone r> postpone + postpone r@
 	postpone over postpone >r ( n+i lim , R: lim n+i )
 	postpone >=
 	?branch <resolve
-	postpone rdrop postpone rdrop ; immediate compile-only
+	postpone rdrop postpone rdrop
+	r> ( ?domark t | f -- ) true = if
+		>resolve
+	then ; immediate compile-only
 \ todo -loop
-: loop  postpone r> postpone 1+ postpone r@
+: loop  ( ? ) >r
+	postpone r> postpone 1+ postpone r@
 	postpone over postpone >r ( n+i lim , R: lim n+i )
 	postpone >=
 	?branch <resolve
-	postpone rdrop postpone rdrop ; immediate compile-only
-: i  r@ ;
+	postpone rdrop postpone rdrop
+	r> ( ?domark t | f -- ) true = if
+		>resolve
+	then ; immediate compile-only
+: i  rp cell+ @ ;
 \ }}}
 
+bye
+
 \ VOCABULARY {{{
-\ do this after user input and stuff is Working
+\ todo doc
 \ words in asm that use latest directly:
 \ find (header) : ; smudge immediate compile-only
+\ the easiest (altho kind of ugly) way i'll probably do this
+\ is to just redefine all of these here
+\ we don't need to redo ; because we already did it above
 32 constant #vocs \ #context better name ?
 variable #order
 create context #vocs cells allot
+
+: wordlist  here 0 , ;
+: vocabulary  wordlist create , does> ( todo ) ;
+
+: get-order ( -- widn ... wid1 n ) ;
+: set-order ( widn ... wid1 n -- ) ;
+
+\ private{
+\ }private
+\ \ the actual setup is in a compiled word to prevent
+\ \ the system from shitfucking itself when its only halfway done setting up
+\ :noname  ; execute
+\ privatise
 \ }}}
 
 \ PROGRAMMING TOOLS {{{
diff --git a/sanctuary.s b/sanctuary.s
index c8f16d8..4108078 100644
--- a/sanctuary.s
+++ b/sanctuary.s
@@ -55,17 +55,17 @@
 %macro defvar 4
 	%2: dq %4
 	defdict %1, %2, %3
-	pspush qword %2
+	do_%2: pspush qword %2
 	ret
 %endmacro
 
 %macro defdefervar 4
 	%2: dq %4
 	defdict %1, %2, %3
-	mov r11, dodefer
+	do_%2: mov r11, dodefer
 	call r11
-	dq do_%2
-	do_%2:
+	dq in_%2
+	in_%2:
 	pspush qword %2
 	ret
 %endmacro
@@ -491,7 +491,7 @@ defcode "]", rbrac, immediate_mask
 	mov qword [state], COMPILING
 	ret
 
-defcode "(header)", brac_header, 0
+defdefer "(header)", brac_header, 0
 	pspop r9
 	pspop r10
 	mov r11, qword [latest]
@@ -517,7 +517,7 @@ defcode "(header)", brac_header, 0
 	ret
 
 ; fix to follow ans: yielding colon-sys
-defcode ":", colon, 0
+defdefer ":", colon, 0
 	call parse_name
 	; todo check zero
 	call brac_header
@@ -529,7 +529,7 @@ defcode ":", colon, 0
 
 ; fix to follow ans: reading from colon-sys
 ; this will not work with :noname or i think does>.
-defdefer ";", semicolon, immediate_mask
+defcode ";", semicolon, immediate_mask
 	mov r12, [latest]
 	add r12, 8
 	mov r13b, [r12]
@@ -543,7 +543,7 @@ defdefer ";", semicolon, immediate_mask
 	mov qword [state], INTERPRET
 	ret
 
-defcode "smudge", smudge, 0
+defdefer "smudge", smudge, 0
 	mov r12, [latest]
 	add r12, 8
 	mov r13b, [r12]
@@ -551,7 +551,7 @@ defcode "smudge", smudge, 0
 	mov byte [r12], r13b
 	ret
 
-defcode "immediate", immediate, 0
+defdefer "immediate", immediate, 0
 	mov r12, [latest]
 	add r12, 8
 	mov r13b, [r12]
@@ -560,7 +560,7 @@ defcode "immediate", immediate, 0
 	mov byte [r12], r13b
 	ret
 
-defcode "compile-only", compile_only, 0
+defdefer "compile-only", compile_only, 0
 	mov r12, [latest]
 	add r12, 8
 	mov r13b, [r12]
@@ -1240,11 +1240,11 @@ defvar "rp0", rp0, 0, 0
 defvar "dp", dp, 0, 0
 defvar "dp0", dp0, 0, 0
 defvar "dp$", dp$, 0, 0
-defdefervar "tib", tib, 0, initfile
-defdefervar "#tib", n_tib, 0, initlen
-defdefervar ">in", to_in, 0, 0
+defvar "tib", tib, 0, initfile
+defvar "#tib", n_tib, 0, initlen
+defvar ">in", to_in, 0, 0
 defvar "handler", handler, 0, do_0handler
-defvar "latest", latest, 0, lfa_latest
+defdefervar "latest", latest, 0, lfa_latest
 
 initfile: incbin "sanctuary.fs"
 initlen equ $ - initfile