: 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 ;