DO LOOP LEAVE working

[forth.jl.git] / src / lib.4th

diff --git a/src/lib.4th b/src/lib.4th
index c9e07bf..ff46f5f 100644 (file)
--- a/src/lib.4th
+++ b/src/lib.4th
@@ -2,13 +2,7 @@
 : MOD /MOD DROP ;
 : */ * / ;
 
-: '\n' 10 ;
-: BL 32 ;
-
-: CR '\n' emit ;
-: SPACE BL emit ;
-
-: NEGATE 0 swap - ;
+: NEGATE 0 SWAP - ;
 
 : TRUE -1 ;
 : FALSE 0 ;
@@ -18,6 +12,9 @@
 
 : DEPTH PSP@ PSP0 @ - ;
 
+: '\n' 10 ;
+: BL 32 ;
+
 : LITERAL IMMEDIATE ' LIT , , ;
 
 : ':' [ CHAR : ] LITERAL ;
@@ -32,6 +29,9 @@
 : '-' [ CHAR - ] LITERAL ;
 : '.' [ CHAR . ] LITERAL ;
 
+: CR '\n' emit ;
+: SPACE BL emit ;
+
 : [COMPILE] IMMEDIATE
         WORD            \ get the next word
         FIND            \ find it in the dictionary
@@ -45,6 +45,9 @@
         ,               \ compile it
 ;
 
+: DEBUGON TRUE DEBUG ! ;
+: DEBUGOFF FALSE DEBUG ! ;
+
 \ CONTROL STRUCTURES ----------------------------------------------------------------------
 
 : IF IMMEDIATE
@@ -107,19 +110,30 @@
 
 : DO IMMEDIATE
         ' >R , ' >R ,
+        ' LIT , HERE @ 0 , ' >R ,
         HERE @
 ;
 
-: I RSP@ 2- @ ;
+: I RSP@ 3 - @ ;
+
+: LEAVE IMMEDIATE
+        ' R> , ' RDROP , ' RDROP ,
+        ' LIT ,  HERE @ 7 + , ' DUP , ' ROT , ' - , ' SWAP , ' ! ,
+        ' BRANCH ,
+        0 ,
+;
 
 : LOOP IMMEDIATE
-        ' R> , ' R> , ' 1+ , ' 2DUP , ' - ,
-        ' SWAP , ' >R , ' SWAP , ' >R ,
+        ' R> , ' R> , ' R> , ' 1+ , ' 2DUP , ' - ,
+        ' SWAP , ' >R , ' SWAP , ' >R , ' SWAP , ' >R ,
         ' 0<= , ' 0BRANCH ,
         HERE @ - ,
-        ' RDROP , ' RDROP ,
+        ' RDROP , ' RDROP , ' RDROP ,
+        HERE @ SWAP !
 ;
 
+: lt 10 0 do leave loop ;
+
 
 \ COMMENTS ----------------------------------------------------------------------
 
@@ -165,12 +179,28 @@
 : HEX ( -- ) 16 BASE ! ;
 
 ( Compute absolute value. )
-: ABS           ( n -- m)
+: ABS           ( n -- |n| )
         dup 0< if
                 negate
         then
 ;
 
+: MAX           ( n m -- max )
+        2dup - 0< if
+                swap drop
+        else
+                drop
+        then
+;
+
+: MIN           ( n m -- max )
+        2dup - 0> if
+                swap drop
+        else
+                drop
+        then
+;
+
 ( PRINTING NUMBERS ---------------------------------------------------------------------- )
 
 ( This is the underlying recursive definition of U. )