diff options
| -rw-r--r-- | sanctuary.fs | 69 | ||||
| -rw-r--r-- | sanctuary.s | 52 |
2 files changed, 112 insertions, 9 deletions
diff --git a/sanctuary.fs b/sanctuary.fs index 7dd455c..b5234a0 100644 --- a/sanctuary.fs +++ b/sanctuary.fs @@ -373,10 +373,14 @@ privatise >resolve then ; immediate compile-only : i rp cell+ @ ; +\ todo leave +\ todo unloop \ }}} +\ todo doc \ VOCABULARY {{{ \ 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 @@ -385,19 +389,65 @@ privatise 32 constant #vocs \ #context better name ? variable #order create context #vocs cells allot +variable current : wordlist here 0 , ; -: vocabulary wordlist create , does> ( todo ) ; +wordlist constant forth-wordlist + +defer default-wordlist +:noname forth-wordlist 1 ; is default-wordlist + +\ the most recent is stored toward high memory +: get-order ( -- widn ... wid1 n ) + #order @ 0 ?do + #order @ i - + 1- cells + context + @ + loop + #order @ ; +: set-order ( widn ... wid1 n -- ) + dup 1 < if + drop default-wordlist + then + dup #order ! + 0 ?do + i cells context + ! + loop ; + +: (vocabulary) create , does> + >r get-order swap drop r> swap set-order ; +: vocabulary wordlist (vocabulary) ; + +: get-current ( -- wid ) current @ ; +: set-current ( wid -- ) current ! ; + +: discard ( x1 xn u -- ) 0 ?do drop loop ; +: definitions get-order swap set-current discard ; +: previous get-order nip 1- set-order ; +: only -1 set-order ; +: also get-order over swap 1+ set-order ; + +forth-wordlist (vocabulary) forth +-1 set-order -: get-order ( -- widn ... wid1 n ) ; -: set-order ( widn ... wid1 n -- ) ; +private{ +}private +: search-wordlist ( a u wid -- 0 | ht -1 ) + ( wid ) @ begin ( a u ht ) + dup >r + r> + until + ; +privatise -\ 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 +private{ +: (find) ( a u -- a u 0 | ht -1 ) ; +: (latest) ( -- a ) ; +}private +\ 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 \ }}} \ PROGRAMMING TOOLS {{{ @@ -411,5 +461,6 @@ create context #vocs cells allot 0 constant version : welcome ." sanctuary: a 64 bit forth for linux, version " version u. cr ; +:noname quit ; handler ! welcome quit bye bye diff --git a/sanctuary.s b/sanctuary.s index 4108078..83b924e 100644 --- a/sanctuary.s +++ b/sanctuary.s @@ -1108,6 +1108,58 @@ defcode "u>=", ugreatereq, 0 ret ; }}} +; todo doc +; ( a¹ u¹ a² u² -- n ) +defcode "compare", compare, 0 + pspop r11 ; u2 + pspop rdi ; a2 + pspop r13 ; u1 + pspop rsi ; a1 + + ; check a* = 0? + +.loop: + cmpsb + + jl .below + jg .above + + dec r11 + dec r13 + + ; check both = 0 + ; either of these = 0 then jmp accordingly also + + cmp r11, 0 + jne .11n0 + + cmp r13, 0 ; r11 = r13 & strings identical + je .same + + ; u2 > u1 + jmp .above + +.11n0: + cmp r13, 0 ; u1 < u2 + je .below + +.cont: + jmp .loop + +.below: + mov r11, true + jmp .e + +.above: + mov r11, 1 + jmp .e + +.same: + mov r11, false +.e: + pspush r11 + ret + defcode "branch", branch, 0 mov r12, [dp] mov byte [r12], 0xe9 |