qf/boot.qf

: debug word@ yelp ;
: here 0 @ ;
: here! 0 ! ;
: != = not ;
: outw! dup &hff & outb! 256 / &hff & outb! ;

: if ' jz_ , here 0 , ; immediate
: then here over - swap ! ; immediate
: else ' jmp_ , here >r 0 , [ ' then , ] r> ; immediate

: begin here ; immediate
: while [ ' if , ] ; immediate
: repeat ' jmp_ , swap here - , [ ' then , ] ; immediate
: again ' jmp_ , here - , ; immediate
: until ' jz_ , here - , ; immediate

: ( begin in@ [ in@ ) lit ] = until ; immediate
: \ begin in@ 0 < until ; immediate

: const word@ create ' $const , , ;
: array word@ create ' $var , ;
: var, array , ;
: var 0 var, ;

: allot here + here! ;

: nip swap drop ;
: negate 0 swap - ;
: abs dup 0 < if negate then ;

: :noname here ] ;
: :| here 4 + lit ' jmp_ , here 0 , ; immediate
: |; ' ret , [ ' then , ] ; immediate

: $do r> dup 1 + swap @ >r ;
var does.patch
: compiledo ' $do , here does.patch ! -1 , ;
: makedo word@ create compiledo  ;
: anondo here compiledo ;
: does> here 3 + lit :| does.patch @ ! rdrop |; , ; immediate

: do.data ( cp -- data ) 2 + ;

: $defer r> @ >r ;
: defer word@ create ' $defer , :| |; , ;
: redef 1 + ! ;

: +towards ( from to -- from+-1 )
  over > if 1 + else 1 - then ;

: for ( from to -- )
  ' >r , [ ' begin , ] ( from r: to )
  ' dup , ' r@ , ' != , [ ' while , ]
  ' >r , ; immediate ( r: to from )
: i ' r@ , ; immediate
: next
  ' r> , ' r@ , ' +towards , ( from+1 r: to )
  [ ' repeat , ] ' drop , ' rdrop , ; immediate

: yield rswap ;
: done rdrop 0 >r rswap ;
: ;done ' done , [ ' [ , ] ; immediate
: each [ ' begin , ] ' r@ , [ ' while , ] ; immediate
: more ' yield , [ ' repeat , ] ' rdrop , ; immediate
: break rswap rdrop :| yield done |; execute rswap ;

: links begin yield @ dup not until drop ;done

: min ( x y -- x|y ) 2dup > if swap then drop ;
: max ( x y -- x|y ) 2dup < if swap then drop ;