implement CASE/OF, looping structures, :NONAME, and more

jumpforth.S

@@ -42,13 +42,25 @@ _start:
    mov $cold_start,%esi
    NEXT
 
+/* The entry point for threaded FORTH words */
+/* Push the return address (%esi) on the return stack */
+/* Load the address of the body of the definition from the DFA field at %eax+4 */
    .text
    .align 4
    .globl DOCOL
 DOCOL:
    PUSHRSP %esi
-   addl $4,%eax
+   movl 4(%eax),%esi
-   movl (%eax),%esi
+   NEXT
+
+/* The default behavior for words defined with CREATE */
+/* Place the value of the DFA field on the top of the stack */
+/* (By default the DFA field holds the address of the body of the definition) */
+   .text
+   .align 4
+   .globl SELF
+SELF:
+   pushl 4(%eax)
    NEXT
 
 .set F_IMMED,0x80
@@ -149,7 +161,7 @@ defconst SYS_WRITE,__NR_write
 /* defconst SYS_TIME,__NR_time */
 /* defconst SYS_CHMOD,__NR_chmod */
 /* defconst SYS_LSEEK,__NR_lseek */
-defconst SYS_GETPID,__NR_getpid
+/* defconst SYS_GETPID,__NR_getpid */
 /* defconst SYS_MOUNT,__NR_mount */
 /* defconst SYS_STIME,__NR_stime */
 /* defconst SYS_PTRACE,__NR_ptrace */
@@ -278,7 +290,7 @@ defconst SYS_BRK,__NR_brk
 /* defconst SYS_MADVISE,__NR_madvise */
 /* defconst SYS_GETDENTS64,__NR_getdents64 */
 /* defconst SYS_FCNTL64,__NR_fcntl64 */
-defconst SYS_GETTID,__NR_gettid
+/* defconst SYS_GETTID,__NR_gettid */
 /* defconst SYS_READAHEAD,__NR_readahead */
 /* defconst SYS_SETXATTR,__NR_setxattr */
 /* defconst SYS_LSETXATTR,__NR_lsetxattr */
@@ -313,7 +325,7 @@ defconst SYS_GETTID,__NR_gettid
 /* defconst SYS_TIMER_DELETE,__NR_timer_delete */
 /* defconst SYS_STATFS64,__NR_statfs64 */
 /* defconst SYS_FSTATFS64,__NR_fstatfs64 */
-defconst SYS_TGKILL,__NR_tgkill
+/* defconst SYS_TGKILL,__NR_tgkill */
 /* defconst SYS_UTIMES,__NR_utimes */
 /* defconst SYS_FADVISE64_64,__NR_fadvise64_64 */
 /* defconst SYS_MBIND,__NR_mbind */
@@ -457,7 +469,7 @@ defconst SYS_TGKILL,__NR_tgkill
 /* defconst SYS_FACCESSAT2,__NR_faccessat2 */
 
 /* Special dirfd for *at syscalls to resolve path relative to current directory */
-defconst AT_FDCWD,-100
+/* defconst AT_FDCWD,-100 */
 
 /*
 ** signal numbers
@@ -499,14 +511,14 @@ defconst AT_FDCWD,-100
 /*
 ** openat2() flags
 */
-defconst __O_RDONLY,0,"O_RDONLY"
+/* defconst __O_RDONLY,0,"O_RDONLY" */
-defconst __O_WRONLY,1,"O_WRONLY"
+/* defconst __O_WRONLY,1,"O_WRONLY" */
-defconst __O_RDWR,2,"O_RDWR"
+/* defconst __O_RDWR,2,"O_RDWR" */
-defconst __O_CREAT,0100,"O_CREAT"
+/* defconst __O_CREAT,0100,"O_CREAT" */
-defconst __O_EXCL,0200,"O_EXCL"
+/* defconst __O_EXCL,0200,"O_EXCL" */
-defconst __O_TRUNC,01000,"O_TRUNC"
+/* defconst __O_TRUNC,01000,"O_TRUNC" */
-defconst __O_APPEND,02000,"O_APPEND"
+/* defconst __O_APPEND,02000,"O_APPEND" */
-defconst __O_NONBLOCK,04000,"O_NONBLOCK"
+/* defconst __O_NONBLOCK,04000,"O_NONBLOCK" */
 
 /* NOTE: These are initialized in _start and read-only thereafter. */
 defparam C0     /* first byte of the heap */
@@ -770,16 +782,48 @@ defcode CMOVE
    mov %edx,%esi
    NEXT
 
+/* ( a -- ) ( R: -- a ) */
 defcode TOR,">R"
    pop %eax
    PUSHRSP %eax
    NEXT
 
+/* ( R: a -- ) ( -- a ) */
 defcode FROMR,"R>"
    POPRSP %eax
    push %eax
    NEXT
 
+/* (R: a -- a ) ( -- a ) */
+defcode RFETCH,"R@"
+   movl (%ebp),%eax
+   push %eax
+   NEXT
+
+/* ( a b -- ) ( R: -- a b ) */
+defcode TWOTOR,"2>R"
+   pop %ebx
+   pop %eax
+   PUSHRSP %eax
+   PUSHRSP %ebx
+   NEXT
+
+/* ( R: a b -- ) ( -- a b ) */
+defcode TWOFROMR,"2R>"
+   POPRSP %ebx
+   POPRSP %eax
+   push %eax
+   push %ebx
+   NEXT
+
+/* (R: a b -- a b ) ( -- a b ) */
+defcode TWORFETCH,"2R@"
+   movl (%ebp),%ebx
+   movl 4(%ebp),%eax
+   push %eax
+   push %ebx
+   NEXT
+
 defcode RSPFETCH,"RSP@"
    push %ebp
    NEXT
@@ -792,6 +836,10 @@ defcode RDROP
    addl $4,%ebp
    NEXT
 
+defcode TWORDROP,"2RDROP"
+   addl $8,%ebp
+   NEXT
+
 defcode SPFETCH,"SP@"
    mov %esp,%eax
    push %eax
@@ -953,22 +1001,13 @@ defword EMIT
    .int SPFETCH,TWODUP,STOREBYTE,LIT,0,SWAP,LIT,1,SYS_WRITE,SYSCALL3,TWODROP,EXIT
 
 /* ( c-addr u -- ) */
-defword DOTS,".S"
+defword TYPE
 0: .int QDUP,ZBRANCH,(1f - .),OVER,FETCHBYTE,EMIT
    .int SUB1,SWAP,ADD1,SWAP,BRANCH,(0b - .)
 1: .int DROP,EXIT
 
-defword GETPID
-   .int SYS_GETPID,SYSCALL0,EXIT
-
-defword GETTID
-   .int SYS_GETTID,SYSCALL0,EXIT
-
-defword RAISE
-   .int GETPID,GETTID,ROT,SYS_TGKILL,SYSCALL3,EXIT
-
 defword ABORT
-0: .int LIT,6,RAISE,DROP,BRANCH,(0b - .)
+0: .int S0,SPSTORE,QUIT
 
 defword ALLOT
    .int DUP,LIT,0,LT,ZBRANCH,(0f - .)
@@ -979,11 +1018,11 @@ defword ALLOT
    .int DUP,SYS_BRK,SYSCALL1,OVER,NEQU,ZBRANCH,(2f - .)
    .int TWODROP
    litstring "Out of memory\n"
-   .int DOTS,ABORT
+   .int TYPE,ABORT
 2: .int BRK,STORE
 3: .int CP,STORE,EXIT
 6: litstring "Allocation out of bounds\n"
-   .int DOTS,ABORT
+   .int TYPE,ABORT
 
 defword COMMA,","
    .int HERE,CELL,ALLOT,STORE,EXIT
@@ -1003,7 +1042,7 @@ defword ALIGN
 0: .int EXIT
 
 /* ( c-addr-1 u-1 c-addr-2 u-2 -- flag ) */
-defword STREQU,"S="
+defword STREQU,"=S"
    .int ROT,OVER,EQU,ZBRANCH,(1f - .)         /* c-addr-1 c-addr-2 u-2  R:           */
 0: .int DUP,ZBRANCH,(2f - .)                  /* c-addr-1 c-addr-2 u    R:           */
    .int SUB1                                  /* c-addr-1 c-addr-2 u'   R:           */
@@ -1059,19 +1098,11 @@ defword FIND
 defword FINDERR
    .int TWODUP,FIND,QDUP,ZBRANCH,(0f - .),NROT,TWODROP,EXIT
 0: litstring "UNKNOWN WORD: "
-   .int DOTS,DOTS,LIT,'\n',EMIT,ABORT
+   .int TYPE,TYPE,LIT,'\n',EMIT,ABORT
 
 defword QUOTE,"'"
    .int WORD,FINDERR,EXIT
 
-   .text
-   .align 4
-   .globl SELF
-SELF:
-   addl $4,%eax
-   pushl (%eax)
-   NEXT
-
 defword CREATE
    .int ALIGN,HERE,LIT,SELF,COMMA,LIT,0,COMMA,LATEST,FETCH,COMMA,LIT,0,COMMABYTE
    .int WORD,NIP,DUP,ALLOT,ALIGN
@@ -1095,6 +1126,16 @@ defword COLON,":"
    .int HERE,SWAP,TDFA,STORE
    .int TRUE,STATE,STORE,EXIT
 
+defword NONAME,":NONAME"
+   .int ALIGN,HERE
+   .int LIT,DOCOL,COMMA
+   .int HERE,LIT,12,ADD,COMMA
+   .int LATEST,FETCH,COMMA
+   .int __F_HIDDEN,COMMABYTE,ALIGN
+   .int DUP,LATEST,STORE
+   .int TRUE,STATE,STORE
+   .int EXIT
+
 defword SEMI,";",F_IMMED
    .int LIT,EXIT,COMMA,LATEST,FETCH,TFLAGS
    .int DUP,FETCHBYTE,DUP,__F_HIDDEN,AND,ZBRANCH,(0f - .)
@@ -1103,37 +1144,6 @@ defword SEMI,";",F_IMMED
 1: .int FALSE,STATE,STORE
    .int ALIGN,EXIT
 
-defword IMMEDIATE,,F_IMMED
-   .int LATEST,FETCH,LIT,12,ADD,DUP,FETCHBYTE,__F_IMMED,OR,SWAP,STOREBYTE,EXIT
-
-defword DOT,"."
-   .int DUP,LIT,0x80000000,EQU,ZBRANCH,(0f - .)
-   litstring "-2147483648"  /* special case; can't negate */
-   .int DOTS,DROP,EXIT
-0: .int DUP,LIT,0,LT,ZBRANCH,(1f - .)           /* n */
-   .int LIT,'-',EMIT,LIT,0,SWAP,SUB             /* n | n>0 */
-1: .int LIT,1000000000                          /* n pv */
-2: .int TWODUP,LT,ZBRANCH,(3f - .)              /* n pv */
-   .int DUP,LIT,1,GT,ZBRANCH,(3f - .)           /* n pv */
-   /* n < pv && pv > 1, so divide pv by 10 */
-   .int LIT,10,DIVMOD,NIP,BRANCH,(2b - .)       /* n pv/10 */
-   /* emit quotient+'0'; while pv > 1, divide pv by 10 and repeat with n%pv */
-3: .int TUCK,DIVMOD,LIT,'0',ADD,EMIT,SWAP       /* n%pv pv */
-   .int DUP,LIT,1,LE,ZBRANCH,(4f - .),TWODROP,EXIT
-4: .int LIT,10,DIVMOD,NIP,BRANCH,(3b - .)       /* n%pv pv/10 */
-
-defword DOTDS,".DS"
-   .int SPFETCH,S0
-.Ldotds_loop:
-   .int CELL,SUB,TWODUP,LE,ZBRANCH,(1f - .)
-   .int DUP,FETCH,DOT
-0: .int CELL,SUB,TWODUP,LE,ZBRANCH,(1f - .)
-   .int DUP,FETCH,LIT,' ',EMIT,DOT,BRANCH,(0b - .)
-1: .int TWODROP,EXIT
-
-defword DOTRS,".RS"
-   .int RSPFETCH,CELL,ADD,R0,BRANCH,(.Ldotds_loop - .)
-
 defword WORD
    .int SKIPSPACE,HERE
 0: .int KEY,DUP,ISSPACE,ZBRANCH,(1f - .)
@@ -1165,19 +1175,28 @@ defword PARSENUMBER
 9: .int TRUE,EXIT
 
 defword INTERPRET
-   .int SKIPSPACE,KEY,LIT,'"',EQU,ZBRANCH,(0f - .),READSTRING,EXIT
+   .int SKIPSPACE
-0: .int PUTBACK,WORD,TWODUP,PARSENUMBER,ZBRANCH,(1f - .),NROT,TWODROP,EXIT
+   .int KEY,LIT,'"',EQU,ZBRANCH,(1f - .)
-1: .int FINDERR,EXECUTE,EXIT
+   .int   STATE,FETCH,ZBRANCH,(0f - .)
-
-defword COMPILE
-   .int SKIPSPACE,KEY,LIT,'"',EQU,ZBRANCH,(0f - .)
    .int     LIT,LITSTRING,COMMA,HERE,LIT,0,COMMABYTE
    .int     READSTRING,ROT,STOREBYTE,DROP,ALIGN,EXIT
-0: .int PUTBACK,WORD,TWODUP,PARSENUMBER,ZBRANCH,(1f - .)
+   /*     ELSE */
-   .int NROT,TWODROP,LIT,LIT,COMMA,COMMA,EXIT
+0: .int     READSTRING,EXIT
-1: .int FINDERR,DUP,ISIMMEDIATE,ZBRANCH,(2f - .)
+   /*   ELSE */
-   .int EXECUTE,EXIT
+1: .int   PUTBACK,WORD
-2: .int COMMA,EXIT
+   .int   TWODUP,PARSENUMBER,ZBRANCH,(3f - .)
+   .int     NROT,TWODROP
+   .int     STATE,FETCH,ZBRANCH,(2f - .)
+   .int       LIT,LIT,COMMA,COMMA
+2: .int     EXIT
+   /*     ELSE */
+3: .int     FINDERR
+   .int     STATE,FETCH,ZBRANCH,(4f - .)
+   /*       ( OR ) */
+   .int     DUP,ISIMMEDIATE,ZBRANCH,(5f - .)
+4: .int       EXECUTE,EXIT
+   /*       ELSE */
+5: .int       COMMA,EXIT
 
 defword SLASH,"\\",F_IMMED
 0: .int KEY,LIT,10,EQU,ZBRANCH,(0b - .),EXIT
@@ -1187,9 +1206,7 @@ defword PAREN,"(",F_IMMED
 
 defword QUIT
    .int R0,RSPSTORE
-0: .int STATE,FETCH,ZBRANCH,(1f - .)
+0: .int INTERPRET,BRANCH,(0b - .)
-   .int COMPILE,BRANCH,(0b - .)
-1: .int INTERPRET,BRANCH,(0b - .)
 
 /* This is the initial value of the LATEST variable */
 .set last_word,QUIT

startup.4th

@@ -9,7 +9,14 @@
 : BL 32 ;  \ BLank (space)
 
 \ Emit an implementation-dependent End-of-Line sequence
-: .EOL LF EMIT ;
+: EOL LF EMIT ;
+
+\ Emit a blank (space) character
+: SPACE BL EMIT ;
+
+\ Set the latest defined word as immediate
+\ Note that IMMEDIATE is itself an immediate word
+: IMMEDIATE LATEST @ >FLAGS DUP C@ F_IMMED OR SWAP C! ; IMMEDIATE
 
 \ Switch from compiling to interpreting, or vice-versa
 : [ FALSE STATE ! ; IMMEDIATE
@@ -20,45 +27,138 @@
 \ definitions are just arrays of execution tokens.
 : COMPILE, , ;
 
-\ Read a word and append it to the current definition, ignoring the IMMED flag.
+\ Append the execution semantics of the current definition to the current definition.
-\ This is used to "call" an immediate word as a normal function.
+: RECURSE LATEST @ COMPILE, ; IMMEDIATE
-\ POSTPONE has no effect (as a modifier) if the IMMED flag is not set.
-: POSTPONE WORD FINDERR COMPILE, ; IMMEDIATE
 
 \ Append the LIT xt and the topmost word on the stack to the current definition.
-\ If [COMPILE] were already defined then this could simply be written as:
+\ If POSTPONE were already defined then this could simply be written as:
 \
-\   : LITERAL [COMPILE] LIT , ; IMMEDIATE
+\   : LITERAL POSTPONE LIT , ; IMMEDIATE
 \
 \ ... but since it isn't we must manually insert the LIT sequence to obtain the
 \ address of LIT as a literal to be compiled into the current definition.
 : LITERAL [ ' LIT COMPILE, ' LIT , ] COMPILE, , ; IMMEDIATE
 
-\ Like CHAR, but generates a literal at compile-time.
+\ Read a word and append its compilation semantics to the current definition.
+: POSTPONE ( "<spaces>name" -- ) IMMEDIATE
+   WORD FINDERR
+   \ Would be: DUP IMMEDIATE? IF COMPILE, EXIT THEN
+   DUP IMMEDIATE? 0BRANCH [ 3 CELL * , ] COMPILE, EXIT
+   [ ' LITERAL COMPILE, ' COMPILE, ] LITERAL COMPILE,
+;
+
+\ Like CHAR but generates a literal at compile-time.
 : [CHAR] CHAR POSTPONE LITERAL ; IMMEDIATE
 
-\ Like ', but generates a literal at compile-time.
+\ Like ' but generates a literal at compile-time.
 : ['] ' POSTPONE LITERAL ; IMMEDIATE
 
-\ "[COMPILE] <word>" is equivalent to "['] <word> COMPILE,".
+\ Set the F_HIDDEN flag on the named word: HIDE <name>
-\ Definition has been manually expanded (vs. [COMPILE] COMPILE,) to avoid recursion.
+: HIDE ' >FLAGS DUP C@ F_HIDDEN OR SWAP C! ;
-: [COMPILE] POSTPONE ['] ['] COMPILE, COMPILE, ; IMMEDIATE
 
 \ Our first control-flow primitive: <cond> IF <true> {ELSE <false>} THEN
-\ IF consumes <cond> and executes <true> if <cond> was non-zero or else
+\
-\ <false> if <cond> was zero. In either case execution continues after THEN.
+\ IF compiles an unresolved conditional branch.
-\ IF and ELSE leave the address of the latest branch "hole" on the data stack.
+\ AHEAD compiles an unconditional branch (same effect as TRUE IF).
-\ ELSE and THEN fill in the previous "hole" with the relative branch offset.
+\ Both AHEAD and IF leave the address of the unresolved offset on the stack.
-\ The {ELSE <false>} clause is optional.
+\
-: IF [COMPILE] 0BRANCH HERE 0 , ; IMMEDIATE
+\ THEN consumes the offset address and resolves it to the next code address.
+\
+\ ELSE inserts an unconditional branch (to THEN) and also resolves the
+\ previous forward reference (from IF).
+\
+: IF POSTPONE 0BRANCH HERE 0 , ; IMMEDIATE
+: AHEAD POSTPONE BRANCH HERE 0 , ; IMMEDIATE
 : THEN HERE OVER - SWAP ! ; IMMEDIATE
-: ELSE [COMPILE] BRANCH HERE 0 , SWAP POSTPONE THEN ; IMMEDIATE
+: ELSE POSTPONE AHEAD SWAP POSTPONE THEN ; IMMEDIATE
+
+\ Inline :NONAME-style function literals. "{ <code> }" has the runtime effect
+\ of placing the execution token for an anonymous function with the runtime
+\ effect of <code> on the top of the data stack. A branch is emitted to skip
+\ over the memory used for the nested definition. The original value of LATEST
+\ is restored at the end of the definition. If RECURSE is used in <code> it
+\ will create a recursive call to the anonymous inner function.
+\
+\ Example:
+\   OK> : TIMES 0 DO DUP EXECUTE LOOP DROP ;
+\   OK> : GREETINGS { "Hello" TYPE EOL } 3 TIMES ;
+\   OK> GREETINGS
+\   Hello
+\   Hello
+\   Hello
+\
+\ Compilation effect: ( C: -- latest orig state )
+\ Interpreter effect: ( C: -- latest state )
+\ Enters compilation mode if not already compiling
+: {
+   LATEST @
+   STATE @
+   DUP IF
+      POSTPONE AHEAD
+      SWAP
+      POSTPONE [
+   THEN
+   :NONAME
+; IMMEDIATE
+
+\ ( C: latest {orig} state -- )
+\ Leave compilation mode if (prior) state was 0
+: }
+   POSTPONE ; SWAP IF
+      -ROT
+      POSTPONE THEN
+      LATEST !
+      POSTPONE LITERAL
+      POSTPONE ]
+   ELSE
+      SWAP LATEST !
+   THEN
+; IMMEDIATE
 
 \ Unbounded loop: BEGIN <code> AGAIN
 \ BEGIN places the offset of the start of <code> on the stack.
 \ AGAIN creates a relative branch back to the start of <code>.
 : BEGIN HERE ; IMMEDIATE
-: AGAIN [COMPILE] BRANCH HERE - , ; IMMEDIATE
+: AGAIN POSTPONE BRANCH HERE - , ; IMMEDIATE
+
+\ Conditional loop: BEGIN <cond> WHILE <code> REPEAT
+: WHILE POSTPONE IF SWAP ; IMMEDIATE
+: REPEAT POSTPONE AGAIN POSTPONE THEN ; IMMEDIATE
+
+\ Alternate conditional loop: BEGIN <code> UNTIL
+\ UNTIL consumes the top of the stack and branches back to BEGIN if the value was zero.
+: UNTIL POSTPONE 0BRANCH HERE - , ; IMMEDIATE
+
+\ Range loop: <limit> <index> DO <code> LOOP
+\             <limit> <index> DO <code> <step> +LOOP
+: UNLOOP POSTPONE 2RDROP ; IMMEDIATE
+: DO POSTPONE 2>R POSTPONE BEGIN ; IMMEDIATE
+: (+LOOP) ( step limit index -- flag limit index' )
+   ROT + 2DUP <= -ROT ;
+: +LOOP
+   POSTPONE 2R> POSTPONE (+LOOP) POSTPONE 2>R POSTPONE UNTIL POSTPONE 2RDROP
+; IMMEDIATE
+: LOOP 1 POSTPONE LITERAL POSTPONE +LOOP ; IMMEDIATE
+
+\ Return the current index value from the innermost or next-innermost loop.
+: I RSP@ [ CELL ] LITERAL + @ ;
+: J RSP@ [ 3 CELL * ] LITERAL + @ ;
+
+\ Sequential equality tests:
+\   <x> CASE
+\     <x0> OF <code0> ENDOF
+\     <x1> OF <code1> ENDOF
+\     ...
+\   ENDCASE
+\
+\ When <x> equals <x0> execute <code0>, when <x> equals <x1> execute <code1>, etc.
+\ During compilation the stack holds a list of forward references to the ENDCASE,
+\ with the number of references on top. Inside OF ... ENDOF there is additionally
+\ a forward reference to the ENDOF (as with IF ... THEN) above the ENDCASE counter.
+: CASE 0 ; IMMEDIATE
+: OF POSTPONE OVER POSTPONE = POSTPONE IF POSTPONE DROP ; IMMEDIATE
+: ENDOF POSTPONE AHEAD -ROT POSTPONE THEN 1+ ; IMMEDIATE
+: ENDCASE POSTPONE DROP 0 DO POSTPONE THEN LOOP ; IMMEDIATE
 
 \ Define a named constant.
 \   Execution: ( value "<spaces>name" -- )
@@ -75,19 +175,103 @@
 \ Named values defined with VALUE can be modified with TO.
 \   Execution: ( x "<spaces>name" -- )
 \   name execution: ( -- value )
-: VALUE CREATE , POSTPONE DOES> [COMPILE] @ POSTPONE ; ;
+: VALUE CREATE , POSTPONE DOES> POSTPONE @ POSTPONE ; ;
 
 \ When compiling, append code to store to the data field area of the named value.
 \ When interpreting, store to the data field directly.
 \ An ambiguous condition exists if the name was not created with VALUE.
 ( x "<spaces>name" -- )
-: TO ' >BODY STATE @ IF POSTPONE LITERAL [COMPILE] ! ELSE ! THEN ; IMMEDIATE
+: TO ' >BODY STATE @ IF POSTPONE LITERAL POSTPONE ! ELSE ! THEN ; IMMEDIATE
 
+\ Separate division and modulus operators
 : / /MOD NIP ;
 : MOD /MOD DROP ;
 
+\ Display the signed number at the top of the stack
+: . ( n -- "<minussign?><digits>" )
+   DUP -2147483648 = IF
+      \ Special case, can't negate due to overflow
+      DROP "-2147483648" TYPE
+   ELSE
+      \ Emit the - sign and use absolute value if input is negative
+      DUP 0 < IF
+         [CHAR] - EMIT
+         NEGATE
+      THEN
+      \ Start with the highest place-value on the left
+      1000000000
+      \ Skip place-values that would be larger than the input
+      BEGIN 2DUP < OVER 1 > AND WHILE 10 / REPEAT
+      \ Emit the remaining digits down to the units' place
+      BEGIN
+         TUCK /MOD [CHAR] 0 + EMIT SWAP
+         DUP 1 <= IF 2DROP EXIT THEN
+         10 /
+      AGAIN
+   THEN
+;
+
+\ Display the content of the data stack
+: .DS
+   SP@ S0
+   CELL - 2DUP > IF 2DROP EXIT THEN DUP @ .
+   BEGIN
+      CELL - 2DUP > IF 2DROP EXIT THEN DUP @ SPACE .
+   AGAIN
+;
+
+\ Display the content of the return stack
+: .RS
+   RSP@ CELL + R0
+   CELL - 2DUP > IF 2DROP EXIT THEN DUP @ .
+   BEGIN
+      CELL - 2DUP > IF 2DROP EXIT THEN DUP @ SPACE .
+   AGAIN
+;
+
+\ Display the content of the data and return stacks on separate lines
+: TRACE "DS: " TYPE .DS EOL "RS: " TYPE .RS EOL EOL ;
+
+\ Return the number of words on the data stack
 : DEPTH SP@ S0 SWAP - CELL / ;
 
-: BANNER "JumpForth version " .S VERSION . ", by Jesse McDonald" .S .EOL ;
+\ Attempt to locate a word whose execution token matches the given address
+\ If found return the word name and TRUE; otherwise just return FALSE
+: LOOKUP ( addr -- c-addr u TRUE | FALSE )
+   LATEST @
+   BEGIN
+      ?DUP IF
+         \ entry address is not zero
+         2DUP = IF
+            \ entry matches given address
+            NIP >NAME TRUE EXIT
+         THEN
+         \ get next entry address
+         >LINK @
+      ELSE
+         \ entry address is zero; end of list
+         DROP FALSE EXIT
+      THEN
+   AGAIN
+;
+
+\ Display the top of the stack as a word name if possible, or a number otherwise
+: .W ( addr -- "<name>" | "<digits>" )
+   DUP LOOKUP IF TYPE DROP ELSE . THEN ;
+
+\ Display the first `u` words in the body of the given execution token with .W
+: UNTHREAD ( xt u -- )
+   SWAP >DFA @ SWAP
+   BEGIN
+      ?DUP IF
+         SWAP DUP @ .W BL EMIT
+         CELL + SWAP 1-
+      ELSE
+         DROP EXIT
+      THEN
+   AGAIN
+;
+
+: BANNER "JumpForth version " TYPE VERSION . ", by Jesse McDonald" TYPE EOL ;
 
 BANNER