version 1.1, 1996/09/19 22:17:35
|
version 1.4, 1996/11/18 21:28:18
|
Line 241 Create chunks here 16 cells dup allot er
|
Line 241 Create chunks here 16 cells dup allot er
|
>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 |
Line 372 Variable last-interface 0 last-interfac
|
Line 372 Variable last-interface 0 last-interfac
|
|
|
: 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 @ , ; |
Line 494 Objects definitions
|
Line 494 Objects definitions
|
|
|
: implement ( interface -- ) |
: implement ( interface -- ) |
align here over , ob-interface @ , ob-interface ! |
align here over , ob-interface @ , ob-interface ! |
:ilist + @ >r get-order r> swap 1+ set-order ; |
:ilist + @ >r get-order r> swap 1+ set-order 1 voc# +! ; |
|
|
: inter-method, ( interface -- ) |
: inter-method, ( interface -- ) |
:ilist + @ bl word count 2dup s" '" compare |
:ilist + @ bl word count 2dup s" '" compare |
Line 515 Vocabulary interfaces interfaces defini
|
Line 515 Vocabulary interfaces interfaces defini
|
|
|
: 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 |