diff options
Diffstat (limited to 'sanctuary.fs')
| -rw-r--r-- | sanctuary.fs | 70 |
1 files changed, 54 insertions, 16 deletions
diff --git a/sanctuary.fs b/sanctuary.fs index b5234a0..ad743d2 100644 --- a/sanctuary.fs +++ b/sanctuary.fs @@ -9,6 +9,9 @@ : nip swap drop ; : tuck swap over ; +\ todo doc +: 2swap rot >r rot r> ; + : not 0= ; \ todo doc : / /mod nip ; @@ -43,6 +46,7 @@ : ' 'h >body ; : [compile] ' ( word ) compile, ; immediate compile-only : ['] ' ( word ) [compile] literal ; immediate compile-only +: ['h] 'h ( word ) [compile] literal ; immediate compile-only \ todo doc : postpone 'h ( word ) dup immediate? if >body compile, else >body [compile] literal ['] compile, compile, then ; immediate compile-only @@ -67,6 +71,11 @@ 0 constant false -1 constant true +\ todo doc +: >ffa ( ht -- a ) cell+ ; +: >nfa ( ht -- a ) cell+ 1+ ; +: count ( a -- a' u ) dup c@ swap 1+ swap ; + hex : hijacks ' ( word ) here >r dp ! ( temporarily set dp so we can use , ) 49 c, bb c, ( xt ) , \ mov r11, xt @@ -373,8 +382,8 @@ privatise >resolve then ; immediate compile-only : i rp cell+ @ ; -\ todo leave -\ todo unloop +: leave postpone rdrop postpone r@ postpone >r ; immediate compile-only +: unloop postpone rdrop postpone rdrop ; immediate compile-only \ }}} \ todo doc @@ -382,7 +391,6 @@ privatise \ todo doc \ based on the forth standard word list reference implementations \ 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 @@ -430,24 +438,55 @@ defer default-wordlist forth-wordlist (vocabulary) forth -1 set-order -private{ -}private : search-wordlist ( a u wid -- 0 | ht -1 ) ( wid ) @ begin ( a u ht ) - dup >r - r> + >r 2dup r@ ( a u a u ht ; backup str for next loop ) + >nfa count ( a1 u1 a2 u2 ) + compare 0= if + 2drop ( drop backup ) + r> -1 exit + then + r> @ ?dup 0= until - ; -privatise + 2drop 0 ; -private{ -: (find) ( a u -- a u 0 | ht -1 ) ; -: (latest) ( -- a ) ; -}private +\ find (header) : ; smudge immediate compile-only + +: (find) ( a u -- a u 0 | ht -1 ) + #order @ 0 ?do + 2dup i cells context + @ ( a u a u wid ) + search-wordlist ( a u 0 | a u ht -1 ) + ?dup if + >r >r 2drop r> r> ( ht -1 ) + unloop exit + then + loop 0 ; + +: (smudge) latest @ >ffa dup c@ [ hex ] 01 [ decimal ] xor swap c! ; +: (immediate) latest @ >ffa dup c@ [ hex ] 02 [ decimal ] or swap c! ; +: (compile-only) latest @ >ffa dup c@ [ hex ] 04 [ decimal ] or swap c! ; + +: ((header)) here >r + latest @ , + 0 c, dup c, + cmove, + r> ; +: (:) parse-name (header) latest ! smudge postpone ] ; + +: (latest) ( -- a ) get-current ; \ the actual setup is in a compiled word to prevent \ the system from shitfucking itself when its only halfway done setting up -\ :noname ['] (find) is find ; execute -privatise +:noname [ latest @ ] literal forth-wordlist ! + forth-wordlist set-current + ['] (find) is find + ['] (smudge) is smudge + ['] (immediate) is immediate + ['] (compile-only) is compile-only + ['] ((header)) is (header) + ['] (:) is : + ['] (latest) is latest ; +execute +\ drop \ }}} \ PROGRAMMING TOOLS {{{ @@ -463,4 +502,3 @@ privatise :noname quit ; handler ! welcome quit bye -bye |