: state     [ _d 7 cells + ] literal ;

: sp        [ _d cell+ ] literal ;
: rp        [ _d 2 cells + ] literal ;
: dp        [ _d 4 cells + ] literal ;

: sp@       sp @ ;
: rp@       rp @ cell+ ;
: ip        [ _d 3 cells + ] literal ;
: here      dp @ ;
: unused    [ _d 8 cells + ] literal @ here - ;
: base      [ _d 9 cells + ] literal ;
: latest    _d @ ;

: pick      cells cell+ sp@ + @ ;
: >r        rp@ cell - rp !
            rp@ cell+ @ rp@ !
            rp@ cell+ ! ;
: r>        rp@ @
            rp@ cell+ rp !
            rp@ @ swap rp@ ! ;
: over      1 pick ;

: 2dup      over over ;
: 2over     3 pick 3 pick ;
: 2swap     rot >r rot r> ;

: +!        dup >r swap r> @ + swap ! ;
: allot     dp +! ;
: ,         here ! cell allot ;
: c,        here c! 1 allot ;
: [']       ' [ ' literal , ] ; immediate

: if        ['] _jmp0 , here 0 , ; immediate
: then      here swap ! ; immediate
: else      ['] _jmp , here 0 , swap here swap ! ; immediate

: 2r>       ['] r> , ['] r> , ['] swap , ; immediate
: 2>r       ['] swap , ['] >r , ['] >r , ; immediate
: r@        ['] r> , ['] dup , ['] >r , ; immediate

: 2!        swap over ! cell+ ! ;
: 2@        dup cell+ @ swap @ ;

: <=        2dup < >r = r> or ;

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

: aligned   cell 1- + cell 1- invert and ;
: align     here dup aligned swap - allot ;

: cr        10 emit ;
: space     bl emit ;
\ : spaces    begin dup 0 > while space 1- repeat drop ;

: decimal   10 base ! ;
: hex       16 base ! ;

: 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 , ['] 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> @ ;