X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=sys.f;h=6e7c8539bcdd67ea720b7faf5c2f15c8781b0880;hb=d8a61fe84d4b71c21c4ce18a9b7bc78000db725a;hp=df2d231a8266511b8dcfe5cc251f1be28bd4055f;hpb=03fd7979b12ff7cc5d074bb83c9d4e3fcdf616c3;p=rrq%2Fjonasforth.git diff --git a/sys.f b/sys.f index df2d231..6e7c853 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 @ @@ -26,3 +22,88 @@ EXIT [ SWAP ! ; +: ELSE IMMEDIATE + ' BRANCH , + HERE @ + 0 , + SWAP DUP HERE @ SWAP - SWAP ! +; + +: BEGIN IMMEDIATE + HERE @ +; + +: AGAIN IMMEDIATE + ' BRANCH , + HERE @ - , ; + +: ( IMMEDIATE + BEGIN + READ-WORD + 1 = IF + C@ 41 = IF + EXIT + THEN + ELSE + DROP + THEN + AGAIN ; ( Yay! We now have comments! ) + +: UNTIL IMMEDIATE + ' 0BRANCH , + HERE @ - , +; + +( Compile a literal value into the current word. ) +: LIT, IMMEDIATE ( x -- ) + ' LIT , , ; + +: / /MOD DROP ; +: MOD /MOD SWAP DROP ; +: NEG 0 SWAP - ; + +: C, + HERE @ C! + HERE @ 1 + + HERE ! ; + +: OVER ( a b -- a b a ) SWAP DUP ROT ; + +( An alternative comment syntax. Reads until the end of the line. ) +: \ IMMEDIATE + BEGIN + KEY + 10 = UNTIL ; + +\ So far, S" has only worked in immediate mode, which is backwards -- actually, +\ the main use-case of this is as a compile-time word. Let's fix that. +: S" IMMEDIATE + ' LITSTRING , + HERE @ 0 C, \ We will put the length here + 0 + BEGIN + 1 + + KEY DUP C, + 34 = UNTIL + \ Remove final " + HERE @ 1 - HERE ! + 1 - + SWAP C! ; + +( 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 ; + +: NEWLINE 10 EMIT ; +: SPACE 32 EMIT ; + +( Read a number from standard input. ) +: READ-NUMBER READ-WORD PARSE-NUMBER ; + +: RESTART S" Ready." TELL NEWLINE ; +RESTART +