Adding indent.

common/forth_namespace_tests.fs

@@ -139,6 +139,7 @@ e: check-boot
 
 e: check-tier2-opcodes
   out: >flags 
+  out: >flags& 
   out: >params 
   out: >size 
   out: >link& 
@@ -396,6 +397,7 @@ e: check-utils
   out: str= 
   out: :noname 
   out: forget 
+  out: spaces 
   out: dump 
   out: assert 
 ;e

common/tier2_opcodes.h

@@ -14,6 +14,7 @@
 
 #define TIER2_OPCODE_LIST \
   X(">flags", TOFLAGS, tos = *TOFLAGS(tos)) \
+  X(">flags&", TOFLAGSAT, tos = (cell_t) TOFLAGS(tos)) \
   X(">params", TOPARAMS, tos = *TOPARAMS(tos)) \
   X(">size", TOSIZE, tos = TOSIZE(tos)) \
   X(">link&", TOLINKAT, tos = (cell_t) TOLINK(tos)) \

common/utils.fs

@@ -21,14 +21,19 @@
 : dump ( a n -- )
    cr 0 do i 16 mod 0= if cr then dup i + c@ . loop drop cr ;
 
+( Print spaces )
+: spaces ( n -- ) for aft space then next ;
+
 ( Remove from Dictionary )
 : forget ( "name" ) ' dup >link current @ !  >name drop here - allot ;
 
 internals definitions
+1 constant IMMEDIATE_MARK
 2 constant SMUDGE
 4 constant BUILTIN_FORK
-1 constant IMMEDIATE_MARK
 16 constant NONAMED
+32 constant +TAB
+64 constant -TAB
 : 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
@@ -39,28 +44,60 @@ forth definitions also internals
 : .s   ." <" depth n. ." > " raw.s cr ;
 only forth definitions
 
+( Tweak indent on branches )
+internals internalized definitions
+
+: flags'or! ( n -- ) ' >flags& dup >r c@ or r> c! ;
++TAB flags'or! BEGIN
+-TAB flags'or! AGAIN
+-TAB flags'or! UNTIL
++TAB flags'or! AHEAD
+-TAB flags'or! THEN
++TAB flags'or! IF
++TAB -TAB or flags'or! ELSE
++TAB -TAB or flags'or! WHILE
+-TAB flags'or! REPEAT
++TAB flags'or! AFT
++TAB flags'or! FOR
+-TAB flags'or! NEXT
+
+forth definitions 
+
 ( Definitions building to SEE and ORDER )
 internals definitions
+variable indent
 : see. ( xt -- ) >name type space ;
+: icr   cr indent @ 0 max 4* spaces ;
+: indent+! ( n -- ) indent +! icr ;
 : see-one ( xt -- xt+1 )
    dup cell+ swap @
    dup ['] DOLIT = if drop dup @ . cell+ exit then
-   dup ['] DOSET = if drop ." TO " dup @ cell - see. cell+ exit then
+   dup ['] DOSET = if drop ." TO " dup @ cell - see. cell+ icr exit then
    dup ['] DOFLIT = if drop dup sf@ <# [char] e hold #fs #> type space cell+ exit then
    dup ['] $@ = if drop ['] s" see.
                    dup @ dup >r >r dup cell+ r> type cell+ r> 1+ aligned +
                    [char] " emit space exit then
+   dup >flags -TAB AND if -1 indent+! then
+   dup see.
+   dup >flags +TAB AND if
+     1 indent+!
+   else
+     dup >flags -TAB AND if icr then
+   then
    dup  @ ['] BRANCH @ =
    over @ ['] 0BRANCH @ = or
    over @ ['] DONEXT @ = or
-       if see. cell+ exit then
+       if swap cell+ swap then
-   see. ;
+   drop
+;
 : see-loop   dup >body swap >params 1- cells over +
              begin 2dup < while swap see-one swap repeat 2drop ;
 : ?see-flags   >flags IMMEDIATE_MARK and if ." IMMEDIATE " then ;
 : see-xt ( xt -- )
   dup @ ['] see-loop @ = if
-    ['] : see.  dup see.  space dup see-loop   ['] ; see. ?see-flags cr  exit
+    ['] : see.  dup see.  1 indent !
+    icr dup see-loop   ['] ; see. ?see-flags cr
+    exit
   then
   dup >flags BUILTIN_FORK and if ." Built-in fork: " see. exit then
   dup @ ['] input-buffer @ = if ." CREATE/VARIABLE: " see. cr exit then

common/utils_tests.fs

@@ -44,49 +44,80 @@ e: test-forget
 e: test-see-number
   : test 123 456 ;
   see test
-  out: : test  123 456 ; 
+  out: : test 
+  out:     123 456 ; 
 ;e
 
 e: test-see-string
   : test s" hello there" ;
   see test
-  out: : test  s" hello there" ; 
+  out: : test 
+  out:     s" hello there" ; 
 ;e
 
 e: test-see-begin-again
-  : test begin again ;
+  : test begin . again ;
   see test
-  out: : test  BEGIN AGAIN ; 
+  out: : test 
+  out:     BEGIN 
+  out:         . 
+  out:     AGAIN 
+  out:     ; 
 ;e
 
 e: test-see-begin-until
-  : test begin until ;
+  : test begin . until ;
   see test
-  out: : test  BEGIN UNTIL ; 
+  out: : test 
+  out:     BEGIN 
+  out:         . 
+  out:     UNTIL 
+  out:     ;  
 ;e
 
 e: test-see-begin-while-repeat
-  : test begin while repeat ;
+  : test begin . while . repeat ;
   see test
-  out: : test  BEGIN WHILE REPEAT ; 
+  out: : test 
+  out:     BEGIN 
+  out:         . 
+  out:     WHILE 
+  out:         . 
+  out:     REPEAT 
+  out:     ;  
 ;e
 
 e: test-see-ahead-then
-  : test ahead then ;
+  : test ahead . then ;
   see test
-  out: : test  AHEAD THEN ; 
+  out: : test 
+  out:     AHEAD 
+  out:         . 
+  out:     THEN 
+  out:     ; 
 ;e
 
 e: test-see-for-next
   : test for i . next ;
   see test
-  out: : test  FOR I . NEXT ; 
+  out: : test 
+  out:     FOR 
+  out:         I . 
+  out:     NEXT 
+  out:     ; 
 ;e
 
 e: test-see-for-aft-next
-  : test for aft i . then next ;
+  : test for aft i . then . next ;
   see test
-  out: : test  FOR AFT I . THEN NEXT ; 
+  out: : test 
+  out:     FOR 
+  out:         AFT 
+  out:             I . 
+  out:         THEN 
+  out:         . 
+  out:     NEXT 
+  out:     ; 
 ;e
 
 e: test-see-string-strides
@@ -100,23 +131,59 @@ e: test-see-string-strides
   : test7 1 if ." ------>" then ;
   : test8 1 if ." ------->" then ;
   see test0
-  out: : test0  1 IF s" " type THEN ; 
+  out: : test0 
+  out:     1 IF 
+  out:         s" " type 
+  out:     THEN 
+  out:     ; 
   see test1
-  out: : test1  1 IF s" >" type THEN ; 
+  out: : test1 
+  out:     1 IF 
+  out:         s" >" type 
+  out:     THEN 
+  out:     ; 
   see test2
-  out: : test2  1 IF s" ->" type THEN ; 
+  out: : test2 
+  out:     1 IF 
+  out:         s" ->" type 
+  out:     THEN 
+  out:     ; 
   see test3
-  out: : test3  1 IF s" -->" type THEN ; 
+  out: : test3 
+  out:     1 IF 
+  out:         s" -->" type 
+  out:     THEN 
+  out:     ; 
   see test4
-  out: : test4  1 IF s" --->" type THEN ; 
+  out: : test4 
+  out:     1 IF 
+  out:         s" --->" type 
+  out:     THEN 
+  out:     ; 
   see test5
-  out: : test5  1 IF s" ---->" type THEN ; 
+  out: : test5 
+  out:     1 IF 
+  out:         s" ---->" type 
+  out:     THEN 
+  out:     ; 
   see test6
-  out: : test6  1 IF s" ----->" type THEN ; 
+  out: : test6 
+  out:     1 IF 
+  out:         s" ----->" type 
+  out:     THEN 
+  out:     ; 
   see test7
-  out: : test7  1 IF s" ------>" type THEN ; 
+  out: : test7 
+  out:     1 IF 
+  out:         s" ------>" type 
+  out:     THEN 
+  out:     ; 
   see test8
-  out: : test8  1 IF s" ------->" type THEN ; 
+  out: : test8 
+  out:     1 IF 
+  out:         s" ------->" type 
+  out:     THEN 
+  out:     ; 
 ;e
 
 e: test-noname
@@ -131,32 +198,38 @@ e: test-see-variable
   variable foo
   : bar foo @ . ;
   see bar
-  out: : bar  foo @ . ; 
+  out: : bar 
+  out:     foo @ . ; 
 ;e
 
 e: test-see-create
   create foo
   : bar foo @ . ;
   see bar
-  out: : bar  foo @ . ; 
+  out: : bar 
+  out:     foo @ . ; 
 ;e
 
 e: test-see-value
   0 value foo
   : bar foo . ;
   see bar
-  out: : bar  foo . ; 
+  out: : bar 
+  out:     foo . ; 
 ;e
 
 e: test-see-to
   0 value foo
   : bar 123 to foo ;
   see bar
-  out: : bar  123 TO foo ; 
+  out: : bar 
+  out:     123 TO foo 
+  out:     ; 
 ;e
 
 e: test-see-immediate
   : foo 123 ; immediate
   see foo
-  out: : foo  123 ; IMMEDIATE 
+  out: : foo 
+  out:     123 ; IMMEDIATE 
 ;e