diff --git a/jumpforth.S b/jumpforth.S index 62223fb..cef4a5d 100644 --- a/jumpforth.S +++ b/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 (%eax),%esi + movl 4(%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_WRONLY,1,"O_WRONLY" -defconst __O_RDWR,2,"O_RDWR" -defconst __O_CREAT,0100,"O_CREAT" -defconst __O_EXCL,0200,"O_EXCL" -defconst __O_TRUNC,01000,"O_TRUNC" -defconst __O_APPEND,02000,"O_APPEND" -defconst __O_NONBLOCK,04000,"O_NONBLOCK" +/* defconst __O_RDONLY,0,"O_RDONLY" */ +/* defconst __O_WRONLY,1,"O_WRONLY" */ +/* defconst __O_RDWR,2,"O_RDWR" */ +/* defconst __O_CREAT,0100,"O_CREAT" */ +/* defconst __O_EXCL,0200,"O_EXCL" */ +/* defconst __O_TRUNC,01000,"O_TRUNC" */ +/* defconst __O_APPEND,02000,"O_APPEND" */ +/* 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 -0: .int PUTBACK,WORD,TWODUP,PARSENUMBER,ZBRANCH,(1f - .),NROT,TWODROP,EXIT -1: .int FINDERR,EXECUTE,EXIT - -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 - .) - .int NROT,TWODROP,LIT,LIT,COMMA,COMMA,EXIT -1: .int FINDERR,DUP,ISIMMEDIATE,ZBRANCH,(2f - .) - .int EXECUTE,EXIT -2: .int COMMA,EXIT + .int SKIPSPACE + .int KEY,LIT,'"',EQU,ZBRANCH,(1f - .) + .int STATE,FETCH,ZBRANCH,(0f - .) + .int LIT,LITSTRING,COMMA,HERE,LIT,0,COMMABYTE + .int READSTRING,ROT,STOREBYTE,DROP,ALIGN,EXIT + /* ELSE */ +0: .int READSTRING,EXIT + /* ELSE */ +1: .int PUTBACK,WORD + .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 - .) - .int COMPILE,BRANCH,(0b - .) -1: .int INTERPRET,BRANCH,(0b - .) +0: .int INTERPRET,BRANCH,(0b - .) /* This is the initial value of the LATEST variable */ .set last_word,QUIT diff --git a/startup.4th b/startup.4th index 3c36b0c..02fc0ca 100644 --- a/startup.4th +++ b/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. -\ This is used to "call" an immediate word as a normal function. -\ POSTPONE has no effect (as a modifier) if the IMMED flag is not set. -: POSTPONE WORD FINDERR COMPILE, ; IMMEDIATE +\ Append the execution semantics of the current definition to the current definition. +: RECURSE LATEST @ 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 ( "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] " is equivalent to "['] COMPILE,". -\ Definition has been manually expanded (vs. [COMPILE] COMPILE,) to avoid recursion. -: [COMPILE] POSTPONE ['] ['] COMPILE, COMPILE, ; IMMEDIATE +\ Set the F_HIDDEN flag on the named word: HIDE +: HIDE ' >FLAGS DUP C@ F_HIDDEN OR SWAP C! ; \ Our first control-flow primitive: IF {ELSE } THEN -\ IF consumes and executes if was non-zero or else -\ if was zero. In either case execution continues after THEN. -\ IF and ELSE leave the address of the latest branch "hole" on the data stack. -\ ELSE and THEN fill in the previous "hole" with the relative branch offset. -\ The {ELSE } clause is optional. -: IF [COMPILE] 0BRANCH HERE 0 , ; IMMEDIATE +\ +\ IF compiles an unresolved conditional branch. +\ AHEAD compiles an unconditional branch (same effect as TRUE IF). +\ Both AHEAD and IF leave the address of the unresolved offset on the stack. +\ +\ 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. "{ }" has the runtime effect +\ of placing the execution token for an anonymous function with the runtime +\ effect of 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 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 AGAIN \ BEGIN places the offset of the start of on the stack. \ AGAIN creates a relative branch back to the start of . : BEGIN HERE ; IMMEDIATE -: AGAIN [COMPILE] BRANCH HERE - , ; IMMEDIATE +: AGAIN POSTPONE BRANCH HERE - , ; IMMEDIATE + +\ Conditional loop: BEGIN WHILE REPEAT +: WHILE POSTPONE IF SWAP ; IMMEDIATE +: REPEAT POSTPONE AGAIN POSTPONE THEN ; IMMEDIATE + +\ Alternate conditional loop: BEGIN 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: DO LOOP +\ DO +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: +\ CASE +\ OF ENDOF +\ OF ENDOF +\ ... +\ ENDCASE +\ +\ When equals execute , when equals execute , 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 "name" -- ) @@ -75,19 +175,103 @@ \ Named values defined with VALUE can be modified with TO. \ Execution: ( x "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 "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 -- "" ) + 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 -- "" | "" ) + 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