Fixup decompile DO LOOP.

common/boot.fs

@@ -61,20 +61,20 @@ variable leaving
 : leaving(   leaving @ 0 leaving !   2 nest-depth +! ;
 : )leaving   leaving @ swap leaving !  -2 nest-depth +!
              begin dup while dup @ swap here swap ! repeat drop ;
-: (do) ( n n -- .. ) swap r> -rot >r >r >r ;
-: do ( lim s -- ) leaving( postpone (do) here ; immediate
-: (?do) ( n n -- n n f .. )
+: DO ( n n -- .. ) swap r> -rot >r >r >r ;
+: do ( lim s -- ) leaving( postpone DO here ; immediate
+: ?DO ( n n -- n n f .. )
    2dup = if 2drop r> @ >r else swap r> cell+ -rot >r >r >r then ;
-: ?do ( lim s -- ) leaving( postpone (?do) leaving, here ; immediate
-: unloop   r> rdrop rdrop >r ;
-: (leave)   r> rdrop rdrop @ >r ;
-: leave   postpone (leave) leaving, ; immediate
-: (+loop) ( n -- ) dup 0< swap r> r> rot + dup r@ < -rot >r >r xor 0=
-                        if r> cell+ rdrop rdrop >r else r> @ >r then ;
-: +loop ( n -- ) postpone (+loop) , )leaving ; immediate
-: (loop)   r> r> 1+ dup r@ < -rot >r >r 0=
-           if r> cell+ rdrop rdrop >r else r> @ >r then ;
-: loop   postpone (loop) , )leaving ; immediate
+: ?do ( lim s -- ) leaving( postpone ?DO leaving, here ; immediate
+: UNLOOP   r> rdrop rdrop >r ;
+: LEAVE   r> rdrop rdrop @ >r ;
+: leave   postpone LEAVE leaving, ; immediate
+: +LOOP ( n -- ) dup 0< swap r> r> rot + dup r@ < -rot >r >r xor 0=
+                 if r> cell+ rdrop rdrop >r else r> @ >r then ;
+: +loop ( n -- ) postpone +LOOP , )leaving ; immediate
+: LOOP   r> r> 1+ dup r@ < -rot >r >r 0=
+         if r> cell+ rdrop rdrop >r else r> @ >r then ;
+: loop   postpone LOOP , )leaving ; immediate
 create I ' r@ @ ' i !  ( i is same as r@ )
 : J ( -- n ) rp@ 3 cells - @ ;
 : K ( -- n ) rp@ 5 cells - @ ;

common/forth_namespace_tests.fs

@@ -103,7 +103,7 @@ e: check-boot
   out: loop 
   out: +loop 
   out: leave 
-  out: unloop 
+  out: UNLOOP 
   out: ?do 
   out: do 
   out: next 

common/utils.fs

@@ -34,6 +34,7 @@ internals definitions
 16 constant NONAMED
 32 constant +TAB
 64 constant -TAB
+128 constant ARGS_MARK
 : mem= ( a a n -- f)
    for aft 2dup c@ swap c@ <> if 2drop rdrop 0 exit then 1+ swap 1+ then next 2drop -1 ;
 forth definitions also internals
@@ -60,6 +61,11 @@ internals internalized definitions
 +TAB flags'or! AFT
 +TAB flags'or! FOR
 -TAB flags'or! NEXT
++TAB flags'or! DO
+ARGS_MARK +TAB or flags'or! ?DO
+ARGS_MARK -TAB or flags'or! +LOOP
+ARGS_MARK -TAB or flags'or! LOOP
+ARGS_MARK flags'or! LEAVE
 
 forth definitions 
 
@@ -90,10 +96,7 @@ variable indent
    dup  @ ['] BRANCH @ =
    over @ ['] 0BRANCH @ = or
    over @ ['] DONEXT @ = or
-   over ['] (?do) = or
-   over ['] (+loop) = or
-   over ['] (loop) = or
-   over ['] (leave) = or
+   over >flags ARGS_MARK and or
        if swap cell+ swap then
    drop
 ;

common/vocabulary.fs

@@ -57,7 +57,6 @@ transfer{
   immediate? input-buffer ?echo ?arrow. arrow
   evaluate-buffer aliteral value-bind
   leaving( )leaving leaving leaving,
-  (do) (?do) (+loop) (loop) (leave)
   parse-quote digit $@ raw.s
   tib-setup input-limit
   [SKIP] [SKIP]' raw-ok boot-prompt free.
@@ -71,6 +70,8 @@ cleave begin   cleave again   cleave until
 cleave ahead   cleave then    cleave if
 cleave else    cleave while   cleave repeat
 cleave aft     cleave for     cleave next
+cleave do      cleave ?do     cleave +loop
+cleave loop    cleave leave
 
 forth definitions