version 1.4, 1997/06/23 15:53:53
|
version 1.5, 1997/07/02 15:56:51
|
Line 44
|
Line 44
|
: -rot ( a b c -- c a b ) |
: -rot ( a b c -- c a b ) |
rot rot ; |
rot rot ; |
|
|
: under+ ( a b c -- a+c b ) |
|
rot + swap ; |
|
|
|
: perform ( ... addr -- ... ) |
: perform ( ... addr -- ... ) |
@ execute ; |
@ execute ; |
|
|
Line 90 end-struct interface%
|
Line 87 end-struct interface%
|
|
|
interface% |
interface% |
cell% field class-parent |
cell% field class-parent |
cell% field class-wordlist \ instance variables and other private words |
cell% field class-wordlist \ inst-vars and other protected words |
cell% 2* field class-inst-size \ size and alignment |
cell% 2* field class-inst-size \ size and alignment |
end-struct class% |
end-struct class% |
|
|
Line 117 variable current-interface
|
Line 114 variable current-interface
|
|
|
: do-class-method ( -- ) |
: do-class-method ( -- ) |
does> ( ... object -- ... ) |
does> ( ... object -- ... ) |
( object ) |
( object selector-body ) |
selector-offset @ over object-map @ + ( object xtp ) perform ; |
selector-offset @ over object-map @ + ( object xtp ) perform ; |
|
|
: do-interface-method ( -- ) |
: do-interface-method ( -- ) |
Line 178 does> ( ... object -- ... )
|
Line 175 does> ( ... object -- ... )
|
interface-override! ; |
interface-override! ; |
|
|
: overrides ( xt "selector" -- ) |
: overrides ( xt "selector" -- ) |
\ replace default method "method" in the current class with xt |
\ replace default method for "selector" in the current class with xt |
\ must not be used during an interface definition |
\ must not be used during an interface definition |
' current-interface @ class->map class-override! ; |
' current-interface @ class->map class-override! ; |
|
|
Line 308 variable public-wordlist
|
Line 305 variable public-wordlist
|
POSTPONE >r |
POSTPONE >r |
POSTPONE to-this ; |
POSTPONE to-this ; |
|
|
|
: exitm ( -- ) |
|
POSTPONE r> |
|
POSTPONE to-this |
|
POSTPONE exit ; immediate |
|
|
: ;m ( colon-sys -- ) ( run-time: -- ) |
: ;m ( colon-sys -- ) ( run-time: -- ) |
POSTPONE r> |
POSTPONE r> |
POSTPONE to-this |
POSTPONE to-this |
Line 367 does> \ name execution: ( -- w )
|
Line 369 does> \ name execution: ( -- w )
|
: bind' ( "class" "selector" -- xt ) |
: bind' ( "class" "selector" -- xt ) |
' execute ' <bind> ; |
' execute ' <bind> ; |
|
|
: bind ( ... object "class" "selector" -- ... ) |
: bind ( ... "class" "selector" -- ... ) |
bind' execute ; |
bind' execute ; |
|
|
: [bind] ( compile-time: "class" "selector" -- ; run-time: ... object -- ... ) |
: [bind] ( compile-time: "class" "selector" -- ; run-time: ... object -- ... ) |
Line 398 wordlist current-interface @ class-wordl
|
Line 400 wordlist current-interface @ class-wordl
|
object% |
object% |
current-interface @ push-order |
current-interface @ push-order |
|
|
:noname ( object -- ) |
' drop ( object -- ) |
drop ; |
|
method construct ( ... object -- ) |
method construct ( ... object -- ) |
|
|
:noname ( object -- ) |
:noname ( object -- ) |