: ['] ' postpone literal ; immediate : if ['] _jmp0 , here 0 , ; immediate : then here swap ! ; immediate : else ['] _jmp , here 0 , swap here swap ! ; immediate : _msb [ 1 cell 8 * 1- lshift ] literal ; : 2/ dup 1 rshift swap 0< if _msb or then ; : ?dup dup if dup then ; : abs dup 0< if negate then ; : min 2dup <= if drop else swap drop then ; : max 2dup <= if swap drop else drop then ; : begin 0 here ; immediate : while swap 1+ swap postpone if -rot ; immediate : repeat ['] _jmp , , if postpone then then ; immediate : until ['] _jmp0 , , drop ; immediate : do ['] _lit , here 0 , ['] >r , postpone 2>r here ; immediate : unloop postpone 2r> ['] 2drop , ['] r> , ['] drop , ; immediate : leave postpone 2r> ['] 2drop , postpone exit ; immediate : +loop ['] r> , ['] 2dup , ['] + , postpone r@ ['] swap , ['] >r , ['] - , ['] 2dup , ['] + , ['] over , ['] xor , ['] rot , ['] rot , ['] xor , ['] and , ['] _lit , 0 , ['] < , ['] _jmp0 , , postpone unloop here 1 cells - swap ! ; immediate : loop postpone 2r> ['] 1+ , ['] 2dup , postpone 2>r ['] = , ['] _jmp0 , , postpone unloop here 1 cells - swap ! ; immediate : i postpone r@ ; immediate : j postpone 2r> ['] r> , postpone r@ ['] swap , ['] >r , ['] -rot , postpone 2>r ; immediate : create : here [ 4 cells ] literal + postpone literal postpone ; 0 , ; : >body [ 2 cells ] literal + @ ; : _does> latest dup cell+ @ [ 5 cells ] literal + + ['] _jmp over ! cell+ ! ; : does> here 4 cells + postpone literal ['] _does> , 0 , ; immediate : variable create cell allot ; : constant create , does> @ ; : cr 10 emit ; : space bl emit ; : spaces begin dup 0 > while space 1- repeat drop ; : word 0 here c! begin \ bl key 2dup <> \ bl key <> over 0<> and while \ bl key here c@ char+ \ bl key u dup here c! \ bl key u here + c! \ bl repeat 2drop here ; : count dup char+ swap c@ ; : char 0 here char+ c! bl word char+ c@ ; : [char] char postpone literal ; immediate : s" state @ if ['] _jmp , here 0 , then [char] " word count state @ 0<> if dup cell+ allot rot here swap ! swap postpone literal postpone literal then ; immediate : type ?dup if 0 do dup c@ emit 1+ loop then drop ; : ." postpone s" state @ if postpone type else type then ; immediate : ( begin [char] ) key = until ; immediate : execute [ here 3 cells + ] literal ! [ ' _jmp , 0 , ] ; : 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 ;