qf/boot.qf

72 lines
1.9 KiB
Plaintext
Raw Normal View History

: debug word@ yelp ;
: here 0 @ ;
: here! 0 ! ;
2019-10-20 18:53:53 +00:00
: != = 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
2019-10-22 03:38:30 +00:00
: compiledo ' $do , here does.patch ! -1 , ;
: makedo word@ create compiledo ;
: anondo here compiledo ;
: does> here 3 + lit :| does.patch @ ! rdrop |; , ; immediate
2019-10-20 18:53:53 +00:00
: 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 ;