: immediate _read @ ! - * / <0 exit echo key _pick: debug immediate 1 5 ! exit: r 1 exit: ] r @ 1 - r ! _read ]: _main immediate r @ 7 ! ]_main: _x 3 @ exit: _y 4 @ exit: _x! 3 ! exit: _y! 4 ! exit: swap _x! _y! _x _y exit: + 0 swap - - exit: dup _x! _x _x exit: inc dup @ 1 + swap ! exit: h 0 exit: , h @ ! h inc exit: ' r @ @ dup 1 + r @ ! @ exit: ; immediate ' exit , exit: drop 0 * + ;: dec dup @ 1 - swap ! ;: tor r @ @ swap r @ ! r @ 1 + r ! r @ ! ;: fromr r @ @ r @ 1 - r ! r @ @ swap r @ ! ;: tail fromr fromr drop tor ;: minus 0 swap - ;: bnot 1 swap - ;: < - <0 ;: logical dup 0 < swap minus 0 < + ;: not logical bnot ;: = - not ;: branch r @ @ @ r @ @ + r @ ! ;: computebranch 1 - * 1 + ;: notbranch  not  r @ @ @  computebranch  r @ @ +  r @ !;: here h @ ;: if immediate ' notbranch , here 0 , ;: then immediate dup here swap - swap ! ;: ')' 0 ;: _fix key drop key swap 2 + ! ;: fix-')' immediate ' ')' _fix ;fix-')' ): find-) key ')' = not if tail find-) then ;: ( immediate find-) ;( we should be able to do FORTH-style comments now )( this works as follows: ( is an immediate word, so it gets  control during compilation.  Then it simply reads in characters  until it sees a close parenthesis.  once it does, it exits.  if not, it pops off the return stack--manual tail recursion. )( now that we've got comments, we can comment the rest of the code! ): else immediate  ' branch ,		( compile a definite branch )  here			( push the backpatching address )  0 ,			( compile a dummy offset for branch )  swap			( bring old backpatch address to top )  dup here swap -	( calculate the offset from old address )  swap !		( put the address on top and store it );: over _x! _y! _y _x _y ;: add  _x!			( save the pointer in a temp variable )  _x @			( get the value pointed to )  +			( add the incremement from on top of the stack )  _x !			( and save it );: allot	h add ;: maybebranch  logical		( force the TOS to be 0 or 1 )  r @ @ @		( load the branch offset )  computebranch	( calculate the condition offset [either TOS or 1])  r @ @ +		( add it to the return address )  r @ !		( store it to our return address and return );: mod _x! _y!		( get x then y off of stack )  _y  _y _x / _x *		( y - y / x * x )  -;: '\n' 0 ;: '"' 0 ;: '0' 0 ;: 'space' 0 ;: fix-'\n' immediate ' '\n' _fix ;: fix-'"' immediate ' '"' _fix ;: fix-'0' immediate ' '0' _fix ;: fix-'space' immediate ' 'space' _fix ;fix-'0' 0 fix-'space'  fix-'"' "fix-'\n': cr '\n' echo exit: printnum  dup  10 mod '0' +  swap 10 / dup  if    printnum 0  then  drop echo;: .  dup 0 <  if    45 echo minus  then  printnum  'space' echo;: debugprint dup . cr ;( the following routine takes a pointer to a string, and prints it,  except for the trailing quote.  returns a pointer to the next word  after the trailing quote ): _print  dup 1 +  swap @  dup '"' =  if    drop exit  then  echo  tail _print;: print _print ;  ( print the next thing from the instruction stream ): immprint  r @ @  print  r @ !;: find-"  key dup ,  '"' =  if    exit  then  tail find-";: " immediate  key drop  ' immprint ,  find-";: do immediate  ' swap ,		( compile 'swap' to swap the limit and start )  ' tor ,		( compile to push the limit onto the return stack )  ' tor ,		( compile to push the start on the return stack )  here			( save this address so we can branch back to it );: i r @ 1 - @ ;: j r @ 3 - @ ;: > swap < ;: <= 1 + < ;: >= swap <= ;: inci   r @ 1 - 	( get the pointer to i )  inc		( add one to it )  r @ 1 - @ 	( find the value again )  r @ 2 - @	( find the limit value )  <  if    r @ @ @ r @ @ + r @ ! exit		( branch )  then  fromr 1 +  fromr drop  fromr drop  tor;  	: loop immediate ' inci , here - , ;: loopexit  fromr drop		( pop off our return address )  fromr drop		( pop off i )  fromr drop		( pop off the limit of i );			( and return to the caller's caller routine ): isprime  dup 2 = if    exit  then  dup 2 / 2		( loop from 2 to n/2 )  do    dup			( value we're checking if it's prime )    i mod		( mod it by divisor )    not if      drop 0 loopexit	( exit from routine from inside loop )    then  loop ;: primes  " The primes from "  dup .  "  to "  over .  "  are:"  cr  do    i isprime     if      i . 'space' echo    then  loop  cr;: execute  8 !  ' exit 9 !  8 tor;: :: ;		( :: is going to be a word that does ':' at runtime ): fix-:: immediate 3 ' :: ! ;fix-::	( Override old definition of ':' with a new one that invokes ] ): : immediate :: ] ;: command  here 5 !		( store dict pointer in temp variable )  _read			( compile a word )			( if we get control back: )  here 5 @  = if    tail command	( we didn't compile anything )  then  here 1 - h !		( decrement the dictionary pointer )  here 5 @		( get the original value )  = if    here @		( get the word that was compiled )    execute		( and run it )  else    here @		( else it was an integer constant, so push it )    here 1 - h !	( and decrement the dictionary pointer again )  then  tail command;: make-immediate	( make a word just compiled immediate )  here 1 -		( back up a word in the dictionary )  dup dup		( save the pointer to here )  h !			( store as the current dictionary pointer )  @			( get the run-time code pointer )  swap			( get the dict pointer again )  1 -			( point to the compile-time code pointer )  !			( write run-time code pointer on compile-time pointer );: <build immediate  make-immediate	( make the word compiled so far immediate )  ' :: ,		( compile '::', so we read next word )  2 ,			( compile 'pushint' )  here 0 ,		( write out a 0 but save address for does> )  ' , ,			( compile a push that address onto dictionary );: does> immediate  ' command ,		( jump back into command mode at runtime )  here swap !		( backpatch the build> to point to here )  2 ,			( compile run-code primitive so we look like a word )  ' fromr ,		( compile fromr, which leaves var address on stack );: _dump			( dump out the definition of a word, sort of )  dup " (" . " , "  dup @			( save the pointer and get the contents )  dup ' exit  = if	" ;)" cr exit  then  . " ), "  1 +  tail _dump;: dump _dump ;: # . cr ;  : var <build , does> ;: constant <build , does> @ ;: array <build allot does> + ;: [ immediate command ;: _welcome " Welcome to THIRD.Ok." ;: ; immediate ' exit , command exit[_welcome