A forth incomplete, but turing complete implementation

core.4th

: CONSTANT  : POSTPONE LITERAL POSTPONE ; ;
0 CONSTANT FALSE
FALSE INVERT CONSTANT TRUE
32 CONSTANT BL
( a-addr -- x ) \ gets the cell value stores at a-addr
CODE @  
  () => push(dataSpace.getInt32(pop())) 
END-CODE

( x a-addr -- ) \ set the value of a-addr to x
CODE !
  () => dataSpace.setInt32(pop(), pop())
END-CODE

\ Creating a variable manually. The pos of HERE is on Stack
CONSTANT HERE

: ALLOT  ( n -- ) \ allocates (or de-allocates if n < 0) n bytes
  HERE @ + HERE ! ;

: CELL+  ( a-addr1 -- a-addr2 ) \ a-addr2 is a-addr1 plus one cell
  4 + ;

: CELLS  ( n1 -- n2 ) \ n2 os the address in bytes for n1 cells
  DUP + DUP + ;

( c-addr -- x ) \ Like @ but only gets a UTF16 Char code
CODE C@
  () => dataStack.push(dataSpace.getUint16(pop()))
END-CODE

( x c-addr -- ) \ Like ! but only sets a UTF16 Char code
CODE C!
  () => dataSpace.setUint16(pop(), pop()) 
END-CODE

: CHAR+ ( c-addr1 -- c-addr2 ) \ c-addr2 is c-addr1 plus 1 UTF16 char
  2 + ;

: CHARS ( n1 -- n2 ) \ n2 os the address in bytes for n1 UTF16 chars
  DUP + ;

CODE B@
  () => dataStack.push(dataSpace.getUint8(pop()))
END-CODE
: CREATE ( "<spaces>name" -- ) \ Create pointer to contiguous data
  HERE @ CONSTANT ;

: VARIABLE ( "<spaces>name" -- ) \ Create pointer and allocate 1 cell
  CREATE 1 CELLS ALLOT ;

: , ( x -- ) \ Allocates an extra cell and stores x there
  HERE @ ! 1 CELLS ALLOT ;

: C, ( x -- ) \ Allocates an extra cell and stores x there
  HERE @ C! 1 CHARS ALLOT ;
( -- ) \ Show all WORDS currently defined
CODE WORDS  
  () => output(dictionary.dump()
    .map(d => `${d.code}\t${d.name}\n`).join(''))
END-CODE

: ? ( a-addr -- ) \ Print the value stored at this a-address
  @ . ;

( "<spaces>name" -- ) \ Print the given word in a readable format
CODE SEE 
  () => {
    const name = inputBuffer.parseName()
    const d = dictionary.find(name)
    if (!d) {
      throw new Error(`Can't find word named ${name}`)
    }
    const postfix = d.immediate ? 'IMMEDIATE ' : ''
    const action = d.action
    const body = action.thread
      ? `() => executor([${action.thread.join(', ')}])`
      : action.toString().trim()
    output(`CODE ${d.name}\n  ${body}\nEND-CODE ${postfix}`)
  }
END-CODE
: BRANCH ( n -- ) \ Branch by offset n (relative to next)
  R> + >R ;

: RECURSE ( R: -- th ) \ Call the current word being executed
  R> R@ SWAP >R >R 0 >R ;

: EXIT ( R: th -- ) \ Return early from a word
  R> R> DROP DROP ;

( x -- TRUE | FALSE ) \ Returns whether the top is equal to zero
CODE 0=
  () => push(pop() ? 0 : -1) 
END-CODE

: 0BRANCH ( n x -- ) \ Branch by offset n, when x is 0
  0= NEGATE DUP + BRANCH DROP EXIT R> + >R ;

( -- th-addr ) \ Gets address reserved to compile next instruction
CODE PC@
  () => push(compiler.buffer.length) 
END-CODE

: LIT@ ( C: -- orig ) \ Compiles a literal with value to be defined
  0 POSTPONE LITERAL PC@ ;

( C: x orig -- ) \ Defines a pending literal created by LIT@
CODE LIT!
  () => { compiler.buffer[pop() - 1] = pop() } 
END-CODE
: IF ( C: -- orig ) ( x -- ) \ Jumps to next unpaired THEN or ELSE 
\ when the x is 0
  LIT@ POSTPONE SWAP POSTPONE 0BRANCH PC@ ; IMMEDIATE

: THEN ( C: orig -- ) \ Closes the last unpaired IF or ELSE
  NEGATE PC@ + SWAP LIT! ; IMMEDIATE

: ELSE ( C: orig1 -- orig2 ) \ Closes the last unpaired IF and if its
\ x was not 0 jumps to next unpaired THEN
  LIT@ POSTPONE BRANCH >R POSTPONE THEN R> PC@ ; IMMEDIATE

: BEGIN ( C: -- dest ) \ Starts a unbounded loop
  PC@ ; IMMEDIATE

: UNTIL ( C: dest -- ) ( x -- ) \if x is zero, jumps to dest
  PC@ - 4 - POSTPONE LITERAL POSTPONE SWAP POSTPONE 0BRANCH
; IMMEDIATE

: AGAIN ( C: dest -- ) ( x -- ) \ jumps to dest
  PC@ - 3 - POSTPONE LITERAL POSTPONE BRANCH ; IMMEDIATE

: WHILE ( C: dest -- orig dest ) ( x -- ) \ jumps to next unpaired 
\ REPEAT if x is zero
  POSTPONE IF ROT ; IMMEDIATE

: REPEAT ( C: orig dest -- ) \ when last unpaired WHILE's x was not 
\ zero, jump to dest
POSTPONE AGAIN POSTPONE THEN ; IMMEDIATE

: ?DUP ( n -- n n | 0 ) \ Duplicate only if it is not zero
  DUP IF DUP THEN ;

: DUMP ( addr u -- ) \ Print all values within range
  BEGIN ?DUP WHILE 1 - >R DUP B@ . 1 + R> REPEAT DROP ;

( n "nnnn*" -- ) \ Skip zero or more consecutive chars with value n
CODE SKIP
  () => inputBuffer.skip(String.fromCharCode(pop()))
END-CODE

( n "[^n]*n" -- c-addr u ) \ Parse 0 or more characters until the next
\ char n is found or the input is exausted. Return the address and
\ size of parsed string. The delimiter is excluded, but not counted
CODE PARSE () => {
  const str = inputBuffer.parse(String.fromCharCode(pop()))
  pushStr(scratchPtr, str.slice(0, 80))
} END-CODE 

( "<spaces>name" -- c-addr u ) \ Skip consecutive spaces, parse a 
\ valid name and return its address and count
CODE PARSE-NAME () => {
  const str = inputBuffer.parseName()
  pushStr(scratchPtr, str.slice(0, 80))
} END-CODE 

: 2DUP ( n1 n2 -- n1 n2 n1 n2 ) \ Duplicate the 2 elements on top
  OVER OVER ;

: MOVE  ( addr1 addr2 u -- ) \ Copy u bytes from addr1 to addr2
  BEGIN ?DUP WHILE >R OVER @ OVER ! >R 1 + R> 1 + R> 1 - REPEAT
  DROP DROP ;

: S" ( C: ".*<quote>" ) ( -- c-addr u ) \ Save content up to next
\ quote on compilation time and push it addres and chars count on 
\ run time
  [CHAR] " PARSE >R HERE @ SWAP OVER R@ CHARS DUP ALLOT
  MOVE POSTPONE LITERAL R> POSTPONE LITERAL ; IMMEDIATE

: TYPE ( c-addr u -- ) \ Print u chars starting at c-addr
  BEGIN ?DUP WHILE >R DUP C@ EMIT CHAR+ R> 1 - REPEAT DROP ;

: ." ( C: ".*<quote>" -- ) \ Save content up to next quote on compile 
\ time and prints it on runtime
  POSTPONE S" POSTPONE TYPE ; IMMEDIATE

: .( ( ".*<c-paren>" -- ) \ Save content up to next closing bracket
\ and print immediatelly
  [CHAR] ) PARSE TYPE ; IMMEDIATE
( "<spaces>name" -- xt ) \ Pushes the execution token for name
CODE ' 
  () => push(addressOf(inputBuffer.parseName()))
END-CODE

: ['] ( C: "<spaces>name" -- ) ( -- xt ) \ On compilation, parses the 
\ next name and on runtime pushes its execution token
  ' POSTPONE LITERAL ; IMMEDIATE

( c-addr u -- xt n | 0 ) \ Looks for string and return its xt and 1 
\ if immediate or -1 if not. If not found reuturn just 0
CODE FIND-S () => {
  const sz = pop()
  const addr = pop()
  const d = dictionary.find(loadStr(addr, sz))
  if (d) {
    push(d.code)
    push(d.immediate ? 1 : -1)
  } else {
    push(addr)
    push(sz)
    push(0)
  }
} END-CODE

( x*i xt -- x*j ) \ Pops the given execution token and executes it
CODE EXECUTE 
  () => codeSpace[pop()]() 
END-CODE

( -- flag ) \ Pushes -1 if compiling, 0 if executing
CODE IS-COMPILING
  () => push(compiling ? -1 : 0)
END-CODE

( n -- flag ) \ Return -1 if n less than 0, zero if equals or larger
CODE 0<
  () => push(pop() < 0 ? -1 : 0) 
END-CODE

: 0> ( n -- flag ) \ Return -1 if n larger than 0, zero if equals or 
\ less
  NEGATE 0< ;

: 0<> ( n -- flag ) \ Returns -1 if n is not equals to 0
  0= INVERT ;

: =
  - 0= ;

: <
  - 0< ;

: >
  - 0> ;

: <>
  = INVERT ;

( x1 x2 -- x3 ) \ Return the binary 'or' between x1 and x2
CODE OR
  () => push(pop() | pop())
END-CODE

( x1 x2 -- x3 ) \ Return the binary 'and' between x1 and x2
CODE AND
  () => push(pop() & pop())
END-CODE

: WITHIN  ( test low high -- flag ) 
  2DUP < IF
    >R OVER > INVERT SWAP R> < AND
  ELSE
    >R OVER > INVERT SWAP R> < OR
  THEN
  ;
  
( x1 x2 -- x3 ) \ multiply
CODE * 
  () => push(pop() * pop())
END-CODE

: >NUMBER ( prev c-addr1 u1 -- curr c-addr2 n2 )
  ROT >R -1
  BEGIN OVER 0<> AND WHILE
    OVER C@ DUP [CHAR] 0 [CHAR] 9 1 + WITHIN IF
      [CHAR] 0 - R> 10 * + >R 1 - SWAP 1 CHARS + SWAP
      -1
    ELSE DROP 0 THEN
  REPEAT
  R> ROT ROT
;

VARIABLE ABORTED
0 ABORTED !

: ABORT ( -- ) \ 
  1 ABORTED !
;

: ?ABORT ( n -- )
  IF ." ?" ABORT THEN
;

: >NUMBER-WORD ( c-addr u -- n )
  OVER C@ DUP [CHAR] - = IF
    DROP 1 - SWAP
    CHAR+ SWAP
    0 ROT ROT
    >NUMBER
    ?ABORT
    DROP
    NEGATE
  ELSE 
    [CHAR] + = IF 
      1 - SWAP
      CHAR+ SWAP
    THEN
    0 ROT ROT
    >NUMBER
    ?ABORT
    DROP
  THEN
;

VARIABLE STATE
0 STATE !

: INTERPRET  ( x*i -- y*j )
  BEGIN PARSE-NAME ?DUP ABORTED @ 0= AND WHILE 
    FIND-S ?DUP IF
      -1 = STATE @ AND IF 
        COMPILE,
      ELSE
        EXECUTE
      THEN
      IS-COMPILING STATE !
    ELSE
      >NUMBER-WORD
      STATE @ IF POSTPONE LITERAL THEN
    THEN
  REPEAT
  DROP
  ABORTED @ IF ."  Err" 0 ABORTED ! DROP ELSE ."  Ok" THEN CR
;

core.js

function loadCore(evaluate) {
  return evaluate(
    ': CONSTANT  : POSTPONE LITERAL POSTPONE ; ;\n'+
    '0 CONSTANT FALSE\n'+
    'FALSE INVERT CONSTANT TRUE\n'+
    '32 CONSTANT BL\n'+
    '( a-addr -- x ) \\ gets the cell value stores at a-addr\n'+
    'CODE @  \n'+
    '  () => push(dataSpace.getInt32(pop())) \n'+
    'END-CODE\n'+
    '\n'+
    '( x a-addr -- ) \\ set the value of a-addr to x\n'+
    'CODE !\n'+
    '  () => dataSpace.setInt32(pop(), pop())\n'+
    'END-CODE\n'+
    '\n'+
    '\\ Creating a variable manually. The pos of HERE is on Stack\n'+
    'CONSTANT HERE\n'+
    '\n'+
    ': ALLOT  ( n -- ) \\ allocates (or de-allocates if n < 0) n bytes\n'+
    '  HERE @ + HERE ! ;\n'+
    '\n'+
    ': CELL+  ( a-addr1 -- a-addr2 ) \\ a-addr2 is a-addr1 plus one cell\n'+
    '  4 + ;\n'+
    '\n'+
    ': CELLS  ( n1 -- n2 ) \\ n2 os the address in bytes for n1 cells\n'+
    '  DUP + DUP + ;\n'+
    '\n'+
    '( c-addr -- x ) \\ Like @ but only gets a UTF16 Char code\n'+
    'CODE C@\n'+
    '  () => dataStack.push(dataSpace.getUint16(pop()))\n'+
    'END-CODE\n'+
    '\n'+
    '( x c-addr -- ) \\ Like ! but only sets a UTF16 Char code\n'+
    'CODE C!\n'+
    '  () => dataSpace.setUint16(pop(), pop()) \n'+
    'END-CODE\n'+
    '\n'+
    ': CHAR+ ( c-addr1 -- c-addr2 ) \\ c-addr2 is c-addr1 plus 1 UTF16 char\n'+
    '  2 + ;\n'+
    '\n'+
    ': CHARS ( n1 -- n2 ) \\ n2 os the address in bytes for n1 UTF16 chars\n'+
    '  DUP + ;\n'+
    '\n'+
    'CODE B@\n'+
    '  () => dataStack.push(dataSpace.getUint8(pop()))\n'+
    'END-CODE\n'+
    ': CREATE ( \"<spaces>name\" -- ) \\ Create pointer to contiguous data\n'+
    '  HERE @ CONSTANT ;\n'+
    '\n'+
    ': VARIABLE ( \"<spaces>name\" -- ) \\ Create pointer and allocate 1 cell\n'+
    '  CREATE 1 CELLS ALLOT ;\n'+
    '\n'+
    ': , ( x -- ) \\ Allocates an extra cell and stores x there\n'+
    '  HERE @ ! 1 CELLS ALLOT ;\n'+
    '\n'+
    ': C, ( x -- ) \\ Allocates an extra cell and stores x there\n'+
    '  HERE @ C! 1 CHARS ALLOT ;\n'+
    '( -- ) \\ Show all WORDS currently defined\n'+
    'CODE WORDS  \n'+
    '  () => output(dictionary.dump()\n'+
    '    .map(d => \`${d.code}\\t${d.name}\\n\`).join(\'\'))\n'+
    'END-CODE\n'+
    '\n'+
    ': ? ( a-addr -- ) \\ Print the value stored at this a-address\n'+
    '  @ . ;\n'+
    '\n'+
    '( \"<spaces>name\" -- ) \\ Print the given word in a readable format\n'+
    'CODE SEE \n'+
    '  () => {\n'+
    '    const name = inputBuffer.parseName()\n'+
    '    const d = dictionary.find(name)\n'+
    '    if (!d) {\n'+
    '      throw new Error(\`Can\'t find word named ${name}\`)\n'+
    '    }\n'+
    '    const postfix = d.immediate ? \'IMMEDIATE \' : \'\'\n'+
    '    const action = d.action\n'+
    '    const body = action.thread\n'+
    '      ? \`() => executor([${action.thread.join(\', \')}])\`\n'+
    '      : action.toString().trim()\n'+
    '    output(\`CODE ${d.name}\\n  ${body}\\nEND-CODE ${postfix}\`)\n'+
    '  }\n'+
    'END-CODE\n'+
    ': BRANCH ( n -- ) \\ Branch by offset n (relative to next)\n'+
    '  R> + >R ;\n'+
    '\n'+
    ': RECURSE ( R: -- th ) \\ Call the current word being executed\n'+
    '  R> R@ SWAP >R >R 0 >R ;\n'+
    '\n'+
    ': EXIT ( R: th -- ) \\ Return early from a word\n'+
    '  R> R> DROP DROP ;\n'+
    '\n'+
    '( x -- TRUE | FALSE ) \\ Returns whether the top is equal to zero\n'+
    'CODE 0=\n'+
    '  () => push(pop() ? 0 : -1) \n'+
    'END-CODE\n'+
    '\n'+
    ': 0BRANCH ( n x -- ) \\ Branch by offset n, when x is 0\n'+
    '  0= NEGATE DUP + BRANCH DROP EXIT R> + >R ;\n'+
    '\n'+
    '( -- th-addr ) \\ Gets address reserved to compile next instruction\n'+
    'CODE PC@\n'+
    '  () => push(compiler.buffer.length) \n'+
    'END-CODE\n'+
    '\n'+
    ': LIT@ ( C: -- orig ) \\ Compiles a literal with value to be defined\n'+
    '  0 POSTPONE LITERAL PC@ ;\n'+
    '\n'+
    '( C: x orig -- ) \\ Defines a pending literal created by LIT@\n'+
    'CODE LIT!\n'+
    '  () => { compiler.buffer[pop() - 1] = pop() } \n'+
    'END-CODE\n'+
    ': IF ( C: -- orig ) ( x -- ) \\ Jumps to next unpaired THEN or ELSE \n'+
    '\\ when the x is 0\n'+
    '  LIT@ POSTPONE SWAP POSTPONE 0BRANCH PC@ ; IMMEDIATE\n'+
    '\n'+
    ': THEN ( C: orig -- ) \\ Closes the last unpaired IF or ELSE\n'+
    '  NEGATE PC@ + SWAP LIT! ; IMMEDIATE\n'+
    '\n'+
    ': ELSE ( C: orig1 -- orig2 ) \\ Closes the last unpaired IF and if its\n'+
    '\\ x was not 0 jumps to next unpaired THEN\n'+
    '  LIT@ POSTPONE BRANCH >R POSTPONE THEN R> PC@ ; IMMEDIATE\n'+
    '\n'+
    ': BEGIN ( C: -- dest ) \\ Starts a unbounded loop\n'+
    '  PC@ ; IMMEDIATE\n'+
    '\n'+
    ': UNTIL ( C: dest -- ) ( x -- ) \\if x is zero, jumps to dest\n'+
    '  PC@ - 4 - POSTPONE LITERAL POSTPONE SWAP POSTPONE 0BRANCH\n'+
    '; IMMEDIATE\n'+
    '\n'+
    ': AGAIN ( C: dest -- ) ( x -- ) \\ jumps to dest\n'+
    '  PC@ - 3 - POSTPONE LITERAL POSTPONE BRANCH ; IMMEDIATE\n'+
    '\n'+
    ': WHILE ( C: dest -- orig dest ) ( x -- ) \\ jumps to next unpaired \n'+
    '\\ REPEAT if x is zero\n'+
    '  POSTPONE IF ROT ; IMMEDIATE\n'+
    '\n'+
    ': REPEAT ( C: orig dest -- ) \\ when last unpaired WHILE\'s x was not \n'+
    '\\ zero, jump to dest\n'+
    'POSTPONE AGAIN POSTPONE THEN ; IMMEDIATE\n'+
    '\n'+
    ': ?DUP ( n -- n n | 0 ) \\ Duplicate only if it is not zero\n'+
    '  DUP IF DUP THEN ;\n'+
    '\n'+
    ': DUMP ( addr u -- ) \\ Print all values within range\n'+
    '  BEGIN ?DUP WHILE 1 - >R DUP B@ . 1 + R> REPEAT DROP ;\n'+
    '\n'+
    '( n \"nnnn*\" -- ) \\ Skip zero or more consecutive chars with value n\n'+
    'CODE SKIP\n'+
    '  () => inputBuffer.skip(String.fromCharCode(pop()))\n'+
    'END-CODE\n'+
    '\n'+
    '( n \"[^n]*n\" -- c-addr u ) \\ Parse 0 or more characters until the next\n'+
    '\\ char n is found or the input is exausted. Return the address and\n'+
    '\\ size of parsed string. The delimiter is excluded, but not counted\n'+
    'CODE PARSE () => {\n'+
    '  const str = inputBuffer.parse(String.fromCharCode(pop()))\n'+
    '  pushStr(scratchPtr, str.slice(0, 80))\n'+
    '} END-CODE \n'+
    '\n'+
    '( \"<spaces>name\" -- c-addr u ) \\ Skip consecutive spaces, parse a \n'+
    '\\ valid name and return its address and count\n'+
    'CODE PARSE-NAME () => {\n'+
    '  const str = inputBuffer.parseName()\n'+
    '  pushStr(scratchPtr, str.slice(0, 80))\n'+
    '} END-CODE \n'+
    '\n'+
    ': 2DUP ( n1 n2 -- n1 n2 n1 n2 ) \\ Duplicate the 2 elements on top\n'+
    '  OVER OVER ;\n'+
    '\n'+
    ': MOVE  ( addr1 addr2 u -- ) \\ Copy u bytes from addr1 to addr2\n'+
    '  BEGIN ?DUP WHILE >R OVER @ OVER ! >R 1 + R> 1 + R> 1 - REPEAT\n'+
    '  DROP DROP ;\n'+
    '\n'+
    ': S\" ( C: \".*<quote>\" ) ( -- c-addr u ) \\ Save content up to next\n'+
    '\\ quote on compilation time and push it addres and chars count on \n'+
    '\\ run time\n'+
    '  [CHAR] \" PARSE >R HERE @ SWAP OVER R@ CHARS DUP ALLOT\n'+
    '  MOVE POSTPONE LITERAL R> POSTPONE LITERAL ; IMMEDIATE\n'+
    '\n'+
    ': TYPE ( c-addr u -- ) \\ Print u chars starting at c-addr\n'+
    '  BEGIN ?DUP WHILE >R DUP C@ EMIT CHAR+ R> 1 - REPEAT DROP ;\n'+
    '\n'+
    ': .\" ( C: \".*<quote>\" -- ) \\ Save content up to next quote on compile \n'+
    '\\ time and prints it on runtime\n'+
    '  POSTPONE S\" POSTPONE TYPE ; IMMEDIATE\n'+
    '\n'+
    ': .( ( \".*<c-paren>\" -- ) \\ Save content up to next closing bracket\n'+
    '\\ and print immediatelly\n'+
    '  [CHAR] ) PARSE TYPE ; IMMEDIATE\n'+
    '( \"<spaces>name\" -- xt ) \\ Pushes the execution token for name\n'+
    'CODE \' \n'+
    '  () => push(addressOf(inputBuffer.parseName()))\n'+
    'END-CODE\n'+
    '\n'+
    ': [\'] ( C: \"<spaces>name\" -- ) ( -- xt ) \\ On compilation, parses the \n'+
    '\\ next name and on runtime pushes its execution token\n'+
    '  \' POSTPONE LITERAL ; IMMEDIATE\n'+
    '\n'+
    '( c-addr u -- xt n | 0 ) \\ Looks for string and return its xt and 1 \n'+
    '\\ if immediate or -1 if not. If not found reuturn just 0\n'+
    'CODE FIND-S () => {\n'+
    '  const sz = pop()\n'+
    '  const addr = pop()\n'+
    '  const d = dictionary.find(loadStr(addr, sz))\n'+
    '  if (d) {\n'+
    '    push(d.code)\n'+
    '    push(d.immediate ? 1 : -1)\n'+
    '  } else {\n'+
    '    push(addr)\n'+
    '    push(sz)\n'+
    '    push(0)\n'+
    '  }\n'+
    '} END-CODE\n'+
    '\n'+
    '( x*i xt -- x*j ) \\ Pops the given execution token and executes it\n'+
    'CODE EXECUTE \n'+
    '  () => codeSpace[pop()]() \n'+
    'END-CODE\n'+
    '\n'+
    '( -- flag ) \\ Pushes -1 if compiling, 0 if executing\n'+
    'CODE IS-COMPILING\n'+
    '  () => push(compiling ? -1 : 0)\n'+
    'END-CODE\n'+
    '\n'+
    '( n -- flag ) \\ Return -1 if n less than 0, zero if equals or larger\n'+
    'CODE 0<\n'+
    '  () => push(pop() < 0 ? -1 : 0) \n'+
    'END-CODE\n'+
    '\n'+
    ': 0> ( n -- flag ) \\ Return -1 if n larger than 0, zero if equals or \n'+
    '\\ less\n'+
    '  NEGATE 0< ;\n'+
    '\n'+
    ': 0<> ( n -- flag ) \\ Returns -1 if n is not equals to 0\n'+
    '  0= INVERT ;\n'+
    '\n'+
    ': =\n'+
    '  - 0= ;\n'+
    '\n'+
    ': <\n'+
    '  - 0< ;\n'+
    '\n'+
    ': >\n'+
    '  - 0> ;\n'+
    '\n'+
    ': <>\n'+
    '  = INVERT ;\n'+
    '\n'+
    '( x1 x2 -- x3 ) \\ Return the binary \'or\' between x1 and x2\n'+
    'CODE OR\n'+
    '  () => push(pop() | pop())\n'+
    'END-CODE\n'+
    '\n'+
    '( x1 x2 -- x3 ) \\ Return the binary \'and\' between x1 and x2\n'+
    'CODE AND\n'+
    '  () => push(pop() & pop())\n'+
    'END-CODE\n'+
    '\n'+
    ': WITHIN  ( test low high -- flag ) \n'+
    '  2DUP < IF\n'+
    '    >R OVER > INVERT SWAP R> < AND\n'+
    '  ELSE\n'+
    '    >R OVER > INVERT SWAP R> < OR\n'+
    '  THEN\n'+
    '  ;\n'+
    '  \n'+
    '( x1 x2 -- x3 ) \\ multiply\n'+
    'CODE * \n'+
    '  () => push(pop() * pop())\n'+
    'END-CODE\n'+
    '\n'+
    ': >NUMBER ( prev c-addr1 u1 -- curr c-addr2 n2 )\n'+
    '  ROT >R -1\n'+
    '  BEGIN OVER 0<> AND WHILE\n'+
    '    OVER C@ DUP [CHAR] 0 [CHAR] 9 1 + WITHIN IF\n'+
    '      [CHAR] 0 - R> 10 * + >R 1 - SWAP 1 CHARS + SWAP\n'+
    '      -1\n'+
    '    ELSE DROP 0 THEN\n'+
    '  REPEAT\n'+
    '  R> ROT ROT\n'+
    ';\n'+
    '\n'+
    'VARIABLE ABORTED\n'+
    '0 ABORTED !\n'+
    '\n'+
    ': ABORT ( -- ) \\ \n'+
    '  1 ABORTED !\n'+
    ';\n'+
    '\n'+
    ': ?ABORT ( n -- )\n'+
    '  IF .\" ?\" ABORT THEN\n'+
    ';\n'+
    '\n'+
    ': >NUMBER-WORD ( c-addr u -- n )\n'+
    '  OVER C@ DUP [CHAR] - = IF\n'+
    '    DROP 1 - SWAP\n'+
    '    CHAR+ SWAP\n'+
    '    0 ROT ROT\n'+
    '    >NUMBER\n'+
    '    ?ABORT\n'+
    '    DROP\n'+
    '    NEGATE\n'+
    '  ELSE \n'+
    '    [CHAR] + = IF \n'+
    '      1 - SWAP\n'+
    '      CHAR+ SWAP\n'+
    '    THEN\n'+
    '    0 ROT ROT\n'+
    '    >NUMBER\n'+
    '    ?ABORT\n'+
    '    DROP\n'+
    '  THEN\n'+
    ';\n'+
    '\n'+
    'VARIABLE STATE\n'+
    '0 STATE !\n'+
    '\n'+
    ': INTERPRET  ( x*i -- y*j )\n'+
    '  BEGIN PARSE-NAME ?DUP ABORTED @ 0= AND WHILE \n'+
    '    FIND-S ?DUP IF\n'+
    '      -1 = STATE @ AND IF \n'+
    '        COMPILE,\n'+
    '      ELSE\n'+
    '        EXECUTE\n'+
    '      THEN\n'+
    '      IS-COMPILING STATE !\n'+
    '    ELSE\n'+
    '      >NUMBER-WORD\n'+
    '      STATE @ IF POSTPONE LITERAL THEN\n'+
    '    THEN\n'+
    '  REPEAT\n'+
    '  DROP\n'+
    '  ABORTED @ IF .\"  Err\" 0 ABORTED ! DROP ELSE .\"  Ok\" THEN CR\n'+
    ';'
  )
}
if (typeof module !== 'undefined') {
  module.exports.loadCore = loadCore
}

forth.html

<!DOCTYPE html>
<html>

<head>
  <meta charset="UTF8" />
  <title>Forth interactive REPL</title>
  <style>
    .console {
      background-color: #eee;
      border: 1px solid #ccc;
      font-family: monospace;
    }

    .history .line {
      white-space: pre-wrap;
    }

    .input-area {
      border-top: 3px double #ccc;
      display: flex;
    }

    .prompt {
      white-space: pre-wrap;
    }

    .input-line {
      width: 100%;
      padding: 0;
      border: 0;
      background-color: transparent;
      font-family: monospace;
    }
  </style>
</head>

<body>
  <h1>Forth interactive REPL</h1>
  <div id="console" class="console">
    <div id="history" class="history">
      <div class="line" v-for="text of history">{{text}}</div>
    </div>
    <div class="input-area" @keydown.Enter="commitLine">
      <div class="prompt">{{prompt}}</div>
      <input class="input-line" v-model="inputLine" />
    </div>
  </div>
  <script src="https://cdn.jsdelivr.net/npm/vue@2/dist/vue.js"></script>
  <script src="forth.js"></script>
  <script src="core.js"></script>
  <script>
    const app = new Vue({
      el: '#console',
      data: {
        inputLine: '',
        history: [],
        prompt: '% ',
        inputHandler,
      },
      methods: {
        commitLine() {
          const input = this.inputLine
          this.inputLine = ''
          this.outputLine(input)
          // here we call some handler method
          this.inputHandler(input)
        },
        clear() {
          this.history = []
        },
        output(text) {
          text = (text || '').toString()
          const lastNewLine = text.lastIndexOf('\n')
          if (lastNewLine >= 0) {
            this.outputLine(text.slice(0, lastNewLine))
            this.prompt = text.slice(lastNewLine + 1)
          } else {
            this.prompt += text
          }
        },
        outputLine(text) {
          text = this.prompt + (text || '')
          this.history.push(text)
          this.prompt = ''
        }
      },
    })
    loadCore(evaluate)
    function output(text) {
      app.output(text)
    }
    function inputHandler(text) {
      evaluate(`INTERPRET ${text}`)
      output('% ')
    }
  </script>
</body>

</html>

forth.js

//#region dataStack
function createStack() {
  /** @type {number[]} */
  const stack = []
  return {
    push: val => stack.push(val | 0), // |0 ensures int32
    pop: () => stack.pop(),
    size: () => stack.length,
    top: () => stack[stack.length - 1],
    dump: () => stack.map(v => v),
    clear: () => stack.splice(0),
  }
}
const dataStack = createStack()

// These save some keystrokes, as these functions are frequently used
const { push, pop } = dataStack
//#endregion dataStack

/**
 * @typedef {object} Definition
 * @property {string} name
 * @property {Function} action
 * @property {number} [code]
 * @property {boolean} [immediate]
 */

//#region dictionary
function createDictionary() {
  /** @type {Object.<string, Definition>} */
  const dictionary = {}
  return {
    /** @returns {Definition} */
    define: (name, action) => dictionary[name] = { name, action },
    find: name => dictionary[name],
    dump: () => Object.values(dictionary),
  }
}
const dictionary = createDictionary()
dictionary.define('+', () => push(pop() + pop()))
dictionary.define('-', () => push(-pop() + pop()))
dictionary.define('DROP', pop)
dictionary.define('DUP', () => push(dataStack.top()))
dictionary.define('DEPTH', () => push(dataStack.size()))
dictionary.define('SWAP', () => {
  const a = pop()
  const b = pop()
  push(a)
  push(b)
})
//#endregion dictionary

//#region rudeEval
const evaluateWord = word => {
  const a = dictionary.find(word)?.action;
  if (a) { a() } else { push(word) }
}
const evaluateRudely = str => str.split(/\s+/).forEach(evaluateWord)
//#endregion rudeEval

//#region codeSpace
// All code is stored here
const codeSpace = [push]

// The address of LIT, as it is not visible on dictionary
const xtLIT = codeSpace.length - 1

// Assign the index for already defined words
for (const d of dictionary.dump()) {
  d.code = codeSpace.length
  codeSpace.push(d.action)
}

function addressOf(word) {
  const xt = dictionary.find(word)?.code ?? null
  if (xt === null)
    throw new Error(`No word defined with name ${word}`)
  return xt
}

// Fills both codeSpace and dictionary
function define(name, action) {
  const code = codeSpace.push(action) - 1
  const d = dictionary.define(name, action)
  d.code = code
  return d
}
//#endregion codeSpace

//#region executor
// Another stack, but mainly used for return address bookkeeping
let returnStack = createStack()

// Execute sequential steps within a thread
// Return the next pc, with the next thread xt on returnStack
function executorStep(thread, pc) {
  const currentAddress = returnStack.pop()
  while (pc < thread.length) {
    const address = thread[pc++]
    const action = codeSpace[address]
    if (action.thread) {
      returnStack.push(currentAddress)
      returnStack.push(pc)
      returnStack.push(address)
      return 0
    }
    action.apply(null, thread.slice(pc, pc += action.length))
  }
  return returnStack.pop()
}
// Execute the thread recursively
function executor(root) {
  const savedStack = returnStack

  returnStack = createStack()
  returnStack.push(-1)
  let pc = 0
  while (returnStack.size()) {
    const address = returnStack.top()
    const thread = address === -1 ? root : codeSpace[address].thread
    pc = executorStep(thread, pc)
  }
  returnStack = savedStack
}
//#endregion executor

//#region Compiler
// Mounts a compilation unit for us
function Compiler() {
  this.buffer = []
}
Compiler.prototype.code = function (xt, ...params) {
  this.buffer.push(xt, ...params)
  return this
}
Compiler.prototype.word = function (word) {
  return this.code(addressOf(word));
}
Compiler.prototype.lit = function (num) {
  return this.code(xtLIT, +num)
}
Compiler.prototype.build = function () {
  const thread = this.buffer
  const runner = () => executor(thread)
  runner.thread = thread
  return runner
}
define('NEGATE', new Compiler().lit(0).word('SWAP').word('-').build())
define('INVERT', new Compiler().word('NEGATE').lit(1).word('-')
  .build())
//#endregion Compiler

//#region inputBuffer
// InputBuffer 
function InputBuffer(text) {
  this.buffer = text
  this.offset = 0
}
let inputBuffer = new InputBuffer('')

InputBuffer.prototype.match = function (delim) {
  if (this.offset >= this.buffer.length) {
    return false
  }
  const ch = this.buffer[this.offset]
  if (ch === delim) return true
  return delim === ' ' && !!ch.match(/[\x00-\x20\x7f]/)
}
InputBuffer.prototype.skip = function (delim) {
  const len = this.buffer.length
  const off = this.offset
  while (this.offset < len) {
    if (!this.match(delim)) {
      break
    }
    this.offset++
  }
  return this.offset - off
}
InputBuffer.prototype.parse = function (delim) {
  const len = this.buffer.length
  const off = this.offset

  while (this.offset < len) {
    if (this.match(delim)) {
      const text = this.buffer.slice(off, this.offset)
      this.offset++ // Discard the delimiter
      return text
    }
    this.offset++
  }
  return this.buffer.slice(off)
}
InputBuffer.prototype.parseName = function () {
  this.skip(' ')
  return this.parse(' ')
}
//#endregion inputBuffer

//#region comments
define('(', () => inputBuffer.parse(')')).immediate = true
define('\\', () => inputBuffer.parse('\n')).immediate = true
//#endregion comments

//#region run
// Stores the current word being compiled
let compiler = new Compiler()

// Flag to know if we are compiling or interpreting right now
let compiling = false

// Do just one step with the given word, respecting the compiling flag
function doStep(word) {
  const d = dictionary.find(word)
  if (d) {
    if (!compiling || d.immediate) {
      return d.action()
    }
    compiler.code(d.code)
  } else if (compiling) {
    compiler.lit(word)
  } else {
    push(word)
  }
}
// Run though our current inputBuffer until the end
function run() {
  let word
  while ((word = inputBuffer.parseName())) {
    doStep(word)
  }
}
// Evaluate code!
function evaluate(text) {
  const savedBuffer = inputBuffer
  inputBuffer = new InputBuffer(text)
  run()
  inputBuffer = savedBuffer
}
// Compile fragment into the existing compiler
Compiler.prototype.compile = function (text) {
  const savedCompiler = compiler
  const savedCompiling = compiling

  compiler = this
  compiling = true
  evaluate(text)

  compiler = savedCompiler
  compiling = savedCompiling
  return this
}
// Compile!
function compile(text) {
  return new Compiler().compile(text).build()
}
//#endregion run

//#region returnStack
// These allow using return stack as a temporary stack
define('>R', () => returnStack.push(pop()))
define('R>', () => push(returnStack.pop()))
define('R@', () => push(returnStack.top()))
define('OVER', compile('>R DUP R> SWAP'))
define('ROT', compile('>R SWAP R> SWAP'))
//#endregion returnStack

//#region output
// Pops number top of the stack and show its value plus space.
define('.', () => output(pop().toString() + ' '))

// Pops number top of the stack and show it as a UTF16 code point.
define('EMIT', () => output(String.fromCharCode(pop())))

// Shows the entire stack. No popping is involved
define('.S', () => output(dataStack.dump().join(', ') + '\n'))

// Prints space
define('CR', compile('10 EMIT'))

// Prints new line
define('SPACE', compile('32 EMIT'))

// Pushes First CHAR on the stack
define('CHAR', () => push(inputBuffer.parseName().charCodeAt(0)))
//#endregion output

//#region literal
// ( C: x -- ) ( -- x )
// Pos value at compile time and makes current definition push it 
// on its run time
define('LITERAL', () => { compiler.lit(pop()) }).immediate = true

// ( -- ) Exits compilation mode
define('[', () => compiling = false).immediate = true

// ( -- ) Enters compilation mode
define(']', () => compiling = true)
//#endregion literal

//#region colon-definition
let curDef = ''

// ( "<spaces>name"-- ) parse name and append to new definition
define('DEFER', () => curDef = inputBuffer.parseName())

define(':', compile('DEFER ]'))

define('BUILD', () => {
  push(codeSpace.push(compiler.build()) - 1)
  compiler = new Compiler()
})
define('PERSIST-DEF', () => {
  const xt = pop()
  dictionary.define(curDef, codeSpace[xt]).code = xt
})

define('COMPILE,', () => compiler.code(pop()))

define('POSTPONE', () => {
  const name = inputBuffer.parseName()
  const d = dictionary.find(name)
  if (!d) {
    throw new Error(`word ${name} not found ${dictionary.dump().map(a => a.name)} `)
  }
  if (d.immediate) {
    compiler.code(d.code)
  } else {
    compiler.lit(d.code).word('COMPILE,')
  }
}).immediate = true
define(';', compile('BUILD PERSIST-DEF POSTPONE [')
).immediate = true
//#endregion colon-definition

//#region immediate
// Marks last definition as immediate
define('IMMEDIATE', () =>
  dictionary.find(curDef).immediate = true)

// ( C: "<spaces>name" -- ) ( -- x ) x is the first char from name
evaluate(': [CHAR] CHAR POSTPONE LITERAL ; IMMEDIATE')
//#endregion immediate

//#region code-definition
define('CODE', () => {
  curDef = inputBuffer.parseName()
  const start = inputBuffer.offset
  let delimCandidate
  do {
    const end = inputBuffer.offset
    delimCandidate = inputBuffer.parseName()
    if (delimCandidate === 'END-CODE') {
      return define(curDef, eval(inputBuffer
        .buffer.slice(start, end - 1)))
    }
  } while (delimCandidate)
  throw new Error('SOURCE finished before END-CODE was found')
})
//#endregion code-definition

//#region data-space
// 1KiB of RAM!
const dataSpace = new DataView(new ArrayBuffer(1024))
const herePtr = 8
dataSpace.setInt32(herePtr, 12)
push(herePtr)
//#endregion data-space

//#region string
function storeStr(pos, str) {
  for (const ch of str) {
    dataSpace.setUint16(pos, ch.charCodeAt())
    pos += 2
  }
  return str.length
}
function pushStr(pos, str) {
  storeStr(pos, str)
  push(pos)
  push(str.length)
}
function loadStr(pos, len) {
  const arr = new Array(len)
  for (let i = 0; i < len; i++) {
    arr[i] = String.fromCharCode(dataSpace
      .getUint16(pos + i * 2))
  }
  return arr.join('')
}
function popStr() {
  const sz = pop()
  return loadStr(pop(), sz)
}
const scratchPtr = dataSpace.getInt32(herePtr)
dataSpace.setInt32(herePtr, scratchPtr + 160)
//#endregion string

if (typeof module === 'object'
  && typeof module.exports === 'object') {
  let outBuffer = ''
  function output(str) {
    const newLineIndex = str.lastIndexOf('\n')
    if (newLineIndex === -1) {
      outBuffer += str
    } else {
      console.log(outBuffer + str.slice(0, newLineIndex))
      outBuffer = str.slice(newLineIndex + 1)
    }
  }
  module.exports.evaluate = evaluate
  module.exports.isCompiling = () => compiling
}

forthcli.js

const readline = require('readline')
const { evaluate, isCompiling } = require("./forth")
const { loadCore } = require('./core')

//#region repl
const rl = readline.createInterface({
  input: process.stdin,
  output: process.stdout,
  prompt: '% ',
})

rl.prompt()

loadCore(evaluate)

let compileStatus = false
rl.on('line', line => {
  evaluate(`INTERPRET ${line}`)
  if (compileStatus !== isCompiling()) {
    compileStatus = !compileStatus
    rl.setPrompt(compileStatus ? '%%% ' : '% ')
  }
  rl.prompt()
}).on('close', () => {
  console.log('')
  process.exit(0)
})
//#endregion repl