implement leave

diff --git a/compat.txt b/compat.txt
index 7685f8ca44c936c452e1dafbc552c1da5d8e8700..a4c6326be944d9622d2d63c46a1a7b74c46e41ba 100644 (file)
--- a/compat.txt
+++ b/compat.txt
@@ -88,7 +88,7 @@ yes 6.1.1710 IMMEDIATE (as "imm")
 yes 6.1.1720 INVERT
 yes 6.1.1730 J
 yes 6.1.1750 KEY
-    6.1.1760 LEAVE
+yes 6.1.1760 LEAVE
 yes 6.1.1780 LITERAL
 yes 6.1.1800 LOOP
 yes 6.1.1805 LSHIFT

diff --git a/core.fth b/core.fth
index 0f00ba8fa9e5b10c2bddada457246233c6b33b48..bcdd577950414fe7b921d481d49814d63fab910d 100644 (file)
--- a/core.fth
+++ b/core.fth
@@ -73,11 +73,14 @@
 : until    ['] _jmp0 , , drop ; imm
 : again    postpone repeat ; imm
 
-: do       postpone 2>r here ; imm
+: do       ['] _lit , here 0 , ['] >r , postpone 2>r here ; imm
 : unloop   postpone 2r> ['] 2drop , ; imm
+: leave    postpone unloop postpone 2r>
+           ['] drop , ['] >r , ['] exit , ; imm
 : +loop    postpone 2r> ['] rot , ['] + , ['] 2dup ,
            postpone 2>r ['] - , ['] 0= , ['] _jmp0 , ,
-           postpone unloop ; imm
+           postpone unloop
+           here swap ! ['] r> , ['] drop , ; imm
 : loop     1 postpone literal postpone +loop ; imm
 : i        postpone r@ ; imm 
 : j        postpone 2r> postpone r@ ['] -rot , postpone 2>r ; imm