diff options
| -rw-r--r-- | readme.md | 28 | ||||
| -rw-r--r-- | sanctuary.fs | 44 | ||||
| -rw-r--r-- | sanctuary.s | 2 | ||||
| -rw-r--r-- | test.fs | 9 |
4 files changed, 44 insertions, 39 deletions
@@ -323,22 +323,6 @@ a 32 bit branch offset must be written immediately after. ### `brk@ ( -- a )` yields current program break. -### `buf>buf ( a -- a' )` -transform an input buffer pointer into the *true buffer pointer*, -skipping past the header. - -### `buf>fd ( a -- a' )` -transform an input buffer pointer into the file descriptor that the buffer is read from. - -### `buf>in ( a -- a' )` -transform an input buffer pointer into the number of read characters from that input buffer. - -### `buf>line ( a -- a' )` -transform an input buffer pointer into the corresponding line buffer variable pointer. - -### `buf>used ( a -- a' )` -transform an input buffer pointer into the number of characters contained in the input buffer. - ### `bye ( -- )` exits the forth system. @@ -524,18 +508,6 @@ set the deferred word name to execute xt. a variable containing the execution token of the most recently created word. -### `latest-buffer ( -- a )` -a variable: the address of the highest recursed (current) input buffer. - -### `linebuf>used ( a -- a' )` -transform a line buffer pointer into the number of used characters of the buffer. - -### `linebuf>buf ( a -- a' )` -transform a line buffer pointer into the real line buffer pointer, skipping the header cells. - -### `buf>used ( a -- a' )` -transform an input buffer pointer into the number of characters contained in the input buffer. - ### `literal ( n -- ) IMMEDIATE COMPILE-ONLY` compile a push of the literal value n into the currently compiling word. diff --git a/sanctuary.fs b/sanctuary.fs index 70bc8cf..b542b64 100644 --- a/sanctuary.fs +++ b/sanctuary.fs @@ -414,7 +414,10 @@ variable #order create context #vocs cells allot variable current -: wordlist here 0 , ; +hex b16b0065cafebabe constant empty-voc-magic decimal +: empty-wordlist? ( wid -- ? ) @ cell- @ empty-voc-magic = ; + +: wordlist empty-voc-magic , here 0 , ; wordlist constant forth-wordlist defer default-wordlist @@ -455,8 +458,8 @@ forth-wordlist (vocabulary) forth : visible? ( ht -- ? ) >ffa c@ 1 and 0= ; -\ todo handle smudge : search-wordlist ( a u wid -- 0 | ht -1 ) + dup empty-wordlist? if drop 2drop 0 exit then ( wid ) @ begin ( a u ht ) >r 2dup r@ ( a u a u ht ; backup str for next loop ) >nfa count ( a1 u1 a2 u2 ) @@ -470,6 +473,7 @@ forth-wordlist (vocabulary) forth until 2drop 0 ; +private{ : (find) ( a u -- a u 0 | ht -1 ) #order @ 0 ?do 2dup i cells context + @ ( a u a u wid ) @@ -484,14 +488,18 @@ forth-wordlist (vocabulary) forth : (immediate) latest @ >ffa dup c@ [ hex ] 02 [ decimal ] or swap c! ; : (compile-only) latest @ >ffa dup c@ [ hex ] 04 [ decimal ] or swap c! ; +: place-latest get-current empty-wordlist? if 0 else latest @ then , ; + : ((header)) here >r - latest @ , + place-latest 0 c, dup c, cmove, r> ; + : (:) parse-name (header) latest ! smudge postpone ] ; : (latest) ( -- a ) get-current ; +}private \ the actual setup is in a compiled word to prevent \ the system from shitfucking itself when its only halfway done setting up :noname [ latest @ ] literal forth-wordlist ! @@ -504,7 +512,7 @@ forth-wordlist (vocabulary) forth ['] (:) is : ['] (latest) is latest ; execute -\ drop +privatise \ }}} \ TEST SUITE {{{ @@ -512,7 +520,7 @@ execute \ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. \ modified tho: \ - put into lowercase -\ - { } → T{ }T +\ - { } → t{ }t hex @@ -564,11 +572,27 @@ create actual-results 20 cells allot decimal \ }}} -\ PROGRAMMING TOOLS {{{ -\ should write top of stack on right -\ : .s ; -\ gonna need to be rewritten when/if i add vocabulary/wordlist support -\ : words ; +\ TOOLS {{{ +\ write top of stack on right (as stack notation does) +: .s sp >r + sp0 8 - @ begin + dup r@ >= + while + dup @ . + cell- + repeat + rdrop drop ; + +\ my idea is: words does all words, vlist is an internal word that takes a wid +\ todo ignore smudged words +: vlist ( wid -- ) dup empty-wordlist? if drop exit then + @ begin ( ht ) + dup >nfa count type space + @ ?dup 0= + until cr ; +\ doesn't work when there are multiple vocabularies, +\ for some reason the header of the last word is printed +: words get-order 0 ?do .s vlist loop ; \ }}} \ todo doc diff --git a/sanctuary.s b/sanctuary.s index b453ff0..1630e2b 100644 --- a/sanctuary.s +++ b/sanctuary.s @@ -90,7 +90,7 @@ section .bss wstk_b: resq 4091 -wstk: resq 1 +wstk: section .text global _start @@ -477,4 +477,13 @@ t{ ge7 -> 124 }t t{ gs4 123 456 -> }t +testing vocabularies + +t{ vocabulary testvoc -> }t +t{ also testvoc definitions -> }t +t{ get-current empty-wordlist? -> <true> }t +t{ : testicle 67 ; -> }t +t{ get-current empty-wordlist? -> <false> }t +t{ testicle -> 67 }t + decimal |