X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=sys.f;h=6e7c8539bcdd67ea720b7faf5c2f15c8781b0880;hb=4a9ccd4fd3b9b19c696a2f37e0b46eecc1fdd671;hp=bc9dae9b53f5cae19ac523786215678299ae9e3c;hpb=c4dd16293a71e782e36f795d302bf944056ffd4c;p=rrq%2Fjonasforth.git

diff --git a/sys.f b/sys.f
index bc9dae9..6e7c853 100644
--- a/sys.f
+++ b/sys.f
@@ -9,3 +9,101 @@ EXIT [
   [ S" [" FIND >CFA , ]
   EXIT
 [ IMMEDIATE
+
+: IF IMMEDIATE
+  ' 0BRANCH ,
+  HERE @
+  0 ,
+;
+
+: THEN IMMEDIATE
+  DUP
+  HERE @ SWAP -
+  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
+