| >r drop r@ @ rot ! r@ swap erase r> ; |
>r drop r@ @ rot ! r@ swap erase r> ; |
| |
|
| : >chunk ( n -- root n' ) |
: >chunk ( n -- root n' ) |
| 8aligned dup 3 rshift cells chunks + swap ; |
1- -8 and dup 3 rshift cells chunks + swap 8 + ; |
| |
|
| : Dalloc ( size -- addr ) |
: Dalloc ( size -- addr ) |
| dup 128 > IF allocate throw EXIT THEN |
dup 128 > IF allocate throw EXIT THEN |
| |
|
| : lastob! ( -- ) lastob @ dup |
: lastob! ( -- ) lastob @ dup |
| BEGIN nip dup @ here cell+ 2 pick ! dup 0= UNTIL drop |
BEGIN nip dup @ here cell+ 2 pick ! dup 0= UNTIL drop |
| dup , op! o@ lastob ! ; |
dup , [ order ] op! o@ lastob ! ; |
| |
|
| : thread, ( -- ) classlist @ , ; |
: thread, ( -- ) classlist @ , ; |
| : var, ( -- ) methods @ , vars @ , ; |
: var, ( -- ) methods @ , vars @ , ; |
| |
|
| : how: ( -- ) align |
: how: ( -- ) align |
| here lastif @ ! 0 decl ! |
here lastif @ ! 0 decl ! |
| last-interface @ , inter-list @ , methods @ , inter# @ , |
here last-interface @ , last-interface ! |
| |
inter-list @ , methods @ , inter# @ , |
| methods @ :inum cell+ ?DO ['] crash , LOOP ; |
methods @ :inum cell+ ?DO ['] crash , LOOP ; |
| |
|
| : interface; ( -- ) old-current @ set-current |
: interface; ( -- ) old-current @ set-current |