diff options
| -rw-r--r-- | sanctuary.fs | 8 | ||||
| -rw-r--r-- | test.fs | 138 |
2 files changed, 146 insertions, 0 deletions
diff --git a/sanctuary.fs b/sanctuary.fs index 6f94aca..9ea7a5a 100644 --- a/sanctuary.fs +++ b/sanctuary.fs @@ -50,9 +50,17 @@ : postpone 'h ( word ) dup immediate? if >body compile, else >body [compile] literal ['] compile, compile, then ; immediate compile-only +\ todo doc +: recurse latest @ >body compile, ; immediate + : cells 8 * ; : cell+ 8 + ; : cell- 8 - ; +\ todo doc +: chars ; +: char+ 1+ ; +: char- 1- ; + : create parse-name (header) latest ! ['] (create) compile, 0 , ; : does> latest @ >body 2 + ['] (does>) over ! \ replace call loc ( replace destination ) 11 + r> swap ! ; @@ -276,4 +276,142 @@ t{ mid-uint+1 1 rshift 2 * -> mid-uint+1 }t t{ mid-uint+1 2 rshift 4 * -> mid-uint+1 }t t{ mid-uint+1 1 rshift mid-uint+1 or 2 * -> mid-uint+1 }t +testing memory stuff + +here 1 allot +here +constant 2nda +constant 1sta +t{ 1sta 2nda u< -> <true> }t \ here must grow with allot +t{ 1sta 1+ -> 2nda }t \ ... by one address unit + +here 1 , +here 2 , +constant 2nd +constant 1st +t{ 1st 2nd u< -> <true> }t \ here must grow with allot +t{ 1st cell+ -> 2nd }t \ ... by one cell +t{ 1st 1 cells + -> 2nd }t +t{ 1st @ 2nd @ -> 1 2 }t +t{ 5 1st ! -> }t +t{ 1st @ 2nd @ -> 5 2 }t +t{ 6 2nd ! -> }t +t{ 1st @ 2nd @ -> 5 6 }t +t{ 1s 1st ! 1st @ -> 1s }t \ can store cell-wide value + +here 1 c, +here 2 c, +constant 2ndc +constant 1stc +t{ 1stc 2ndc u< -> <true> }t \ here must grow with allot +t{ 1stc char+ -> 2ndc }t \ ... by one char +t{ 1stc 1 chars + -> 2ndc }t +t{ 1stc c@ 2ndc c@ -> 1 2 }t +t{ 3 1stc c! -> }t +t{ 1stc c@ 2ndc c@ -> 3 2 }t +t{ 4 2ndc c! -> }t +t{ 1stc c@ 2ndc c@ -> 3 4 }t + +t{ 1 chars 1 < -> <false> }t +t{ 1 chars 1 cells > -> <false> }t + +t{ 1 cells 1 < -> <false> }t +t{ 1 cells 1 chars mod -> 0 }t + +testing characters and strings + +t{ char X -> 58 }t +t{ char Hello -> 48 }t +t{ bl -> 20 }t + +t{ : gc4 s" XY" ; -> }t +t{ gc4 swap drop -> 2 }t +t{ gc4 drop dup c@ swap char+ c@ -> 58 59 }t +: gc5 s" A String"2drop ; \ There is no space between the " and 2drop +t{ gc5 -> }t + +testing dictionary + +t{ : gt1 123 ; -> }t +t{ ' gt1 execute -> 123 }t +t{ : gt2 ['] gt1 ; immediate -> }t +t{ gt2 execute -> 123 }t + +here 3 c, char g c, char t c, char 1 c, constant gt1string +here 3 c, char g c, char t c, char 2 c, constant gt2string +t{ gt1string count find -> 'h gt1 -1 }t +t{ gt2string count find -> 'h gt2 -1 }t + +t{ : gt3 gt2 literal ; -> }t +t{ gt3 -> ' gt1 }t + +t{ gt1string count -> gt1string char+ 3 }t + +t{ : gt4 postpone gt1 ; immediate -> }t +t{ : gt5 gt4 ; -> }t +t{ gt5 -> 123 }t +t{ : gt6 345 ; immediate -> }t +t{ : gt7 postpone gt6 ; -> }t +t{ gt7 -> 345 }t + +t{ : gt8 state @ ; immediate -> }t +t{ gt8 -> 0 }t +t{ : gt9 gt8 literal ; -> }t +t{ gt9 0= -> <false> }t + +t{ : gi1 if 123 then ; -> }t +t{ : gi2 if 123 else 234 then ; -> }t +t{ 0 gi1 -> }t +t{ 1 gi1 -> 123 }t +t{ -1 gi1 -> 123 }t +t{ 0 gi2 -> 234 }t +t{ 1 gi2 -> 123 }t +t{ -1 gi1 -> 123 }t +\ Multiple ELSEs in an IF statement +: melse if 1 else 2 else 3 else 4 else 5 then ; +t{ <false> melse -> 2 4 }t +t{ <true> melse -> 1 3 5 }t + +t{ : gi3 begin dup 5 < while dup 1+ repeat ; -> }t +t{ 0 gi3 -> 0 1 2 3 4 5 }t +t{ 4 gi3 -> 4 5 }t +t{ 5 gi3 -> 5 }t +t{ 6 gi3 -> 6 }t + +t{ : gi4 begin dup 1+ dup 5 > until ; -> }t +t{ 3 gi4 -> 3 4 5 6 }t +t{ 5 gi4 -> 5 6 }t +t{ 6 gi4 -> 6 7 }t + +t{ : gi6 ( n -- 0,1,..n ) + dup if dup >r 1- recurse r> then ; -> }t +t{ 0 gi6 -> 0 }t +t{ 1 gi6 -> 0 1 }t +t{ 2 gi6 -> 0 1 2 }t +t{ 3 gi6 -> 0 1 2 3 }t +t{ 4 gi6 -> 0 1 2 3 4 }t +decimal +t{ :noname ( N -- 0, 1, .., N ) + dup if dup >r 1- recurse r> then + ; + constant RN1 -> }t +t{ 0 RN1 execute -> 0 }t +t{ 4 RN1 execute -> 0 1 2 3 4 }t + +\ :noname ( N -- N1 ) +\ 1- dup +\ case 0 of exit endof +\ 1 of 11 swap recurse endof +\ 2 of 22 swap recurse endof +\ 3 of 33 swap recurse endof +\ drop abs recurse exit +\ endcase +\ ; constant RN2 +\ +\ t{ 1 RN2 execute -> 0 }t +\ t{ 2 RN2 execute -> 11 0 }t +\ t{ 4 RN2 execute -> 33 22 11 0 }t +\ t{ 25 RN2 execute -> 33 22 11 0 }t +hex + decimal |