X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=sys.f;h=92efcb4667734414aecfc2bfb2a43a83627301cb;hb=4061939a8f1a4afd749434ed70a6122016c0a8dc;hp=23fed8781df27e3ee98bfff9a2bd8b12375d1968;hpb=02f53b20b4f7244a84a442bbae10eb8401abcfc5;p=rrq%2Fjonasforth.git

diff --git a/sys.f b/sys.f
index 23fed87..92efcb4 100644
--- a/sys.f
+++ b/sys.f
@@ -10,6 +10,69 @@ EXIT [
   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 ;
+
+: 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 ;
+
+( 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 ;