X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=sys.f;h=92efcb4667734414aecfc2bfb2a43a83627301cb;hb=c00c870fc49dff0b55701c10810bf92f99f2fa8e;hp=09963525c9e3a9f343efdafd87bbf476ca05a252;hpb=3e21454c3e1e006a38d2a05d856e4651d099b668;p=rrq%2Fjonasforth.git diff --git a/sys.f b/sys.f index 0996352..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,25 +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 ! ; -S" 10 FIB = " TELL -10 FIB .U -S" (Expected: 59)" TELL NEWLINE +: OVER ( a b -- a b a ) SWAP DUP ROT ; +( 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 ;