72 lines
1.9 KiB
Plaintext
Executable file
72 lines
1.9 KiB
Plaintext
Executable file
: 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 ;
|
|
|