: cell+ [ 1 cells ] literal + ; : char+ 1 + ; : chars ; : 1+ 1 + ; : 1- 1 - ; : over 1 pick ; : rot >r swap r> swap ; : -rot rot rot ; : +! dup >r swap r> @ + swap ! ; : imm immediate ; : base [ 0 _d ] literal ; : here [ 1 cells _d ] literal @ ; : allot [ 1 cells _d ] literal +! ; : state [ 3 cells _d ] literal ; : _compxt [ 4 cells _d ] literal ; : _source [ 5 cells _d ] literal ; : _sourceu [ 6 cells _d ] literal ; : >in [ 7 cells _d ] literal ; : _begin [ 8 cells 80 chars + _d ] literal ; : c, here c! 1 allot ; : if ['] _jmp0 compile, here 0 , ; imm : then here swap ! ; imm : else ['] _jmp compile, here 0 , swap here swap ! ; imm : postpone ' dup _i swap [ ' literal compile, ] if ['] execute else ['] , then compile, ; imm : 2drop drop drop ; : 2dup over over ; : 2over 3 pick 3 pick ; : 2swap rot >r rot r> ; : decimal 10 base ! ; : 2r> ['] r> compile, ['] r> compile, ['] swap compile, ; imm : 2>r ['] swap compile, ['] >r compile, ['] >r compile, ; imm : r@ ['] r> compile, ['] dup compile, ['] >r compile, ; imm : 2! swap over ! cell+ ! ; : 2@ dup cell+ @ swap @ ; : 0= 0 = ; : 0< 0 < ; : <= 2dup < >r = r> or ; : > swap < ; : <> = 0= ; : begin 0 here ; imm : while swap 1+ swap postpone if -rot ; imm : repeat ['] _jmp compile, , if postpone then then ; imm : until ['] _jmp0 compile, , drop ; imm : do 0 postpone literal here 1 cells - ['] >r compile, postpone 2>r here ; imm : unloop postpone 2r> ['] 2drop compile, ['] r> compile, ['] drop compile, ; imm : leave postpone 2r> ['] 2drop compile, ['] exit compile, ; imm : +loop ['] r> compile, ['] 2dup compile, ['] + compile, postpone r@ ['] swap compile, ['] >r compile, ['] - compile, ['] 2dup compile, ['] + compile, ['] over compile, ['] xor compile, ['] rot compile, ['] rot compile, ['] xor compile, ['] and compile, 0 postpone literal ['] < compile, ['] _jmp0 compile, , postpone unloop here 1 cells - swap ! ; imm : loop postpone 2r> ['] 1+ compile, ['] 2dup compile, postpone 2>r ['] = compile, ['] _jmp0 compile, , postpone unloop here 1 cells - swap ! ; imm : i postpone r@ ; imm : j postpone 2r> ['] r> compile, postpone r@ ['] swap compile, ['] >r compile, ['] -rot compile, postpone 2>r ; imm : invert -1 ^ ; : 2* 2 * ; : _msb [ 1 1 cells 8 * 1- lshift ] literal ; : 2/ dup 1 rshift swap 0< if _msb or then ; : cr 10 emit ; : bl 32 ; : space bl emit ; : spaces begin dup 0 > while space 1- repeat drop ; : ?dup dup if dup then ; : negate -1 * ; : abs dup 0< if negate then ; : min 2dup <= if drop else swap drop then ; : max 2dup <= if swap drop else drop then ; : source _source @ _sourceu @ ; : count dup char+ swap c@ ; : char 0 here char+ c! bl word char+ c@ ; : [char] char postpone literal ; imm : ( begin [char] ) key <> while repeat ; imm : _type >r begin dup 0 > while swap dup c@ r@ execute char+ swap 1- repeat 2drop r> drop ; : type [ ' emit ] literal _type ; : s" state @ if ['] _jmp compile, here 0 , then [char] " word count state @ 0= if exit then dup cell+ allot rot here swap ! swap postpone literal postpone literal ; imm : ." postpone s" state @ if ['] type compile, else type then ; imm : move dup 0 <= if drop 2drop exit then >r 2dup < r> swap if 1- 0 swap do over i + c@ over i + c! -1 +loop else 0 do over i + c@ over i + c! loop then 2drop ; : fill -rot begin dup 0 > while >r 2dup c! char+ r> 1- repeat 2drop drop ; : environment? 2drop 1 0= ; : accept over >r begin dup 0 > while key dup 32 < if 2drop 0 else dup emit rot 2dup c! char+ swap drop swap 1- then repeat drop r> - [ 1 chars ] literal / ; : recurse _compxt @ compile, ; imm : fib ( n1 -- n2 ) dup 1 > if 1- dup 1- recurse swap recurse + then ; : fibs 10 0 do i fib . loop cr ; fibs ." hello world"