X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=sys.f;h=92efcb4667734414aecfc2bfb2a43a83627301cb;hb=4061939a8f1a4afd749434ed70a6122016c0a8dc;hp=604d87aa75e71f116f1177d048e18c4028a5b4b6;hpb=f05a9a424e2d5cfc15f55cee82f503d7b4c1e5a9;p=rrq%2Fjonasforth.git diff --git a/sys.f b/sys.f index 604d87a..92efcb4 100644 --- a/sys.f +++ b/sys.f @@ -10,10 +10,6 @@ EXIT [ EXIT [ IMMEDIATE -: / /MOD DROP ; -: MOD /MOD SWAP DROP ; -: NEG 0 SWAP - ; - : IF IMMEDIATE ' 0BRANCH , HERE @ @@ -37,48 +33,46 @@ EXIT [ HERE @ ; +: AGAIN IMMEDIATE + ' BRANCH , + HERE @ - , ; + +: ( IMMEDIATE + BEGIN + READ-WORD + 1 = IF + C@ 41 = IF + EXIT + THEN + ELSE + DROP + THEN + AGAIN ; + : UNTIL IMMEDIATE ' 0BRANCH , HERE @ - , ; -: FIB - 0 1 - 0 - BEGIN - ROT - DUP ROT + - ROT ROT +( Compile a literal value into the current word. ) +: LIT, IMMEDIATE ( x -- ) + ' LIT , , ; - 1 + - DUP 4 PICK = UNTIL - DROP SWAP DROP SWAP DROP -; +: / /MOD DROP ; +: MOD /MOD SWAP DROP ; +: NEG 0 SWAP - ; : C, HERE @ C! HERE @ 1 + HERE ! ; -: OVER - SWAP DUP ROT ; +: OVER ( a b -- a b a ) SWAP DUP ROT ; -: STORE-STRING +( Compile the given string into the current word directly. ) +: STORE-STRING ( str len -- ) BEGIN OVER C@ C, SWAP 1 + SWAP 1 - DUP 0 = UNTIL DROP DROP ; - -S" HELLO-ADDR" CREATE -S" Hello!" DUP ROT -STORE-STRING -: HELLO - ' HELLO-ADDR LIT [ , ] TELL NEWLINE ; - -HELLO - -S" 10 FIB = " TELL -10 FIB .U -S" (Expected: 59)" TELL NEWLINE -