--- gforth/Attic/kernal.fs	1994/06/17 12:35:07	1.8
+++ gforth/Attic/kernal.fs	1994/07/07 14:59:23	1.9
@@ -79,13 +79,13 @@ DOES> ( n -- )  + c@ ;
 \ name> found                                          17dec92py
 
 : (name>)  ( nfa -- cfa )    count  $1F and  +  aligned ;
-: name>    ( nfa -- cfa )
+: name>    ( nfa -- cfa )    cell+
   dup  (name>) swap  c@ $80 and 0= IF  @ THEN ;
 
 : found ( nfa -- cfa n )  cell+
   dup c@ >r  (name>) r@ $80 and  0= IF  @       THEN
-\                  -1 r@ $40 and     IF  1-      THEN
-                  -1 r> $20 and     IF  negate  THEN  ;
+                  -1 r@ $40 and     IF  1-      THEN
+                     r> $20 and     IF  negate  THEN  ;
 
 \ (find)                                               17dec92py
 
@@ -590,13 +590,12 @@ variable dead-code \ true if normal code
 \ we have to store more than just the address of the branch, so the
 \ traditional linked list approach is no longer viable.
 \ This is solved by storing the information about the leavings in a
-\ special stack. The leavings of different DO-LOOPs are separated
-\ by a 0 entry
+\ special stack.
 
 \ !! remove the fixed size limit. 'Tis not hard.
 20 constant leave-stack-size
-create leave-stack 60 cells allot
-Avariable leave-sp  leave-stack leave-sp !
+create leave-stack  60 cells allot
+Avariable leave-sp  leave-stack 3 cells + leave-sp !
 
 : clear-leave-stack ( -- )
     leave-stack leave-sp ! ;
@@ -617,67 +616,68 @@ Avariable leave-sp  leave-stack leave-sp
 : leave> ( -- orig )
     \ pop from leave-stack
     leave-sp @
-    dup leave-stack <= abort" leave-stack empty"
+    dup leave-stack <= IF
+       drop 0 0 0  EXIT  THEN
     cell - dup @ swap
     cell - dup @ swap
     cell - dup @ swap
     leave-sp ! ;
 
-: done ( -- )
+: DONE ( orig -- )  drop >r drop
     \ !! the original done had ( addr -- )
     begin
 	leave>
-	dup
+	over r@ u>=
     while
 	POSTPONE then
     repeat
-    2drop drop ; immediate
+    >leave rdrop ; immediate restrict
 
 : LEAVE ( -- )
     POSTPONE ahead
-    >leave ; immediate
+    >leave ; immediate restrict
 
 : ?LEAVE ( -- )
     POSTPONE 0= POSTPONE if
-    >leave ; immediate
+    >leave ; immediate restrict
 
 : DO ( -- do-sys )
     POSTPONE (do)
     POSTPONE begin drop do-dest
-    0 0 0 >leave ; immediate
+    ( 0 0 0 >leave ) ; immediate restrict
 
 : ?DO ( -- do-sys )
-    0 0 0 >leave
+    ( 0 0 0 >leave )
     POSTPONE (?do)
     >mark >leave
-    POSTPONE begin drop do-dest ; immediate
+    POSTPONE begin drop do-dest ; immediate restrict
 
 : FOR ( -- do-sys )
     POSTPONE (for)
     POSTPONE begin drop do-dest
-    0 0 0 >leave ; immediate
+    ( 0 0 0 >leave ) ; immediate restrict
 
 \ LOOP etc. are just like UNTIL
 
 : loop-like ( do-sys xt1 xt2 -- )
-    rot do-dest?
+    >r >r 0 cs-pick swap cell - swap 1 cs-roll r> r> rot do-dest?
     until-like  POSTPONE done  POSTPONE unloop ;
 
 : LOOP ( do-sys -- )
- ['] (loop) ['] (loop)-lp+!# loop-like ; immediate
+ ['] (loop) ['] (loop)-lp+!# loop-like ; immediate restrict
 
 : +LOOP ( do-sys -- )
- ['] (+loop) ['] (+loop)-lp+!# loop-like ; immediate
+ ['] (+loop) ['] (+loop)-lp+!# loop-like ; immediate restrict
 
 \ A symmetric version of "+LOOP". I.e., "-high -low ?DO -inc S+LOOP"
 \ will iterate as often as "high low ?DO inc S+LOOP". For positive
 \ increments it behaves like "+LOOP". Use S+LOOP instead of +LOOP for
 \ negative increments.
 : S+LOOP ( do-sys -- )
- ['] (s+loop) ['] (s+loop)-lp+!# loop-like ; immediate
+ ['] (s+loop) ['] (s+loop)-lp+!# loop-like ; immediate restrict
 
 : NEXT ( do-sys -- )
- ['] (next) ['] (next)-lp+!# loop-like ; immediate
+ ['] (next) ['] (next)-lp+!# loop-like ; immediate restrict
 
 \ Structural Conditionals                              12dec92py
 
@@ -717,8 +717,8 @@ Avariable leave-sp  leave-stack leave-sp
 
 : flag! ( 8b -- )   last @ cell+ tuck c@ xor swap c! ;
 : immediate     $20 flag! ;
-\ : restrict      $40 flag! ;
-' noop alias restrict
+: restrict      $40 flag! ;
+\ ' noop alias restrict
 
 \ Header                                               23feb93py
 
@@ -777,7 +777,7 @@ create nextname-buffer 32 chars allot
 : name>string ( nfa -- addr count )
  cell+ count $1F and ;
 
-Create ???  ," ???"
+Create ???  0 , 3 c, char ? c, char ? c, char ? c,
 : >name ( cfa -- nfa )
  $21 cell do
    dup i - count $9F and + aligned over $80 + = if
@@ -1001,14 +1001,14 @@ Create crtlkeys
 DEFER type      \ defer type for a output buffer or fast
                 \ screen write
 
-: (type) ( addr len -- )
-  bounds ?DO  I c@ emit  LOOP ;
+\ : (type) ( addr len -- )
+\   bounds ?DO  I c@ emit  LOOP ;
 
 ' (TYPE) IS Type
 
-\ DEFER Emit
+DEFER Emit
 
-\ ' (Emit) IS Emit
+' (Emit) IS Emit
 
 \ : form  ( -- rows cols )  &24 &80 ;
 \ form should be implemented using TERMCAPS or CURSES
@@ -1087,7 +1087,7 @@ create nl$ 1 c, A c, 0 c, \ gnu includes
 
 \ RECURSE                                               17may93jaw
 
-: recurse  last @ cell+ name> a, ; immediate restrict
+: recurse  last @ ( cell+ ) name> a, ; immediate restrict
 \ !! does not work with anonymous words; use lastxt compile,
 
 \ */MOD */                                              17may93jaw