version 1.12, 1997/08/03 20:21:35
|
version 1.14, 1999/02/16 06:32:29
|
Line 174 define? faligned 0= [IF]
|
Line 174 define? faligned 0= [IF]
|
types definitions |
types definitions |
|
|
: static ( -- ) \ oof- oof |
: static ( -- ) \ oof- oof |
\G Create a class-wide cell sized variable |
\G Create a class-wide cell-sized variable. |
mallot Create , #static , |
mallot Create , #static , |
DOES> @ o@ + ; |
DOES> @ o@ + ; |
: method ( -- ) \ oof- oof |
: method ( -- ) \ oof- oof |
\G Create a method selector |
\G Create a method selector. |
mallot Create , #method , |
mallot Create , #method , |
DOES> @ o@ + @ execute ; |
DOES> @ o@ + @ execute ; |
: early ( -- ) \ oof- oof |
: early ( -- ) \ oof- oof |
\G Create a method selector for early binding |
\G Create a method selector for early binding. |
Create ['] crash , #early , |
Create ['] crash , #early , |
DOES> @ execute ; |
DOES> @ execute ; |
: var ( size -- ) \ oof- oof |
: var ( size -- ) \ oof- oof |
Line 458 types definitions
|
Line 458 types definitions
|
\G Create an instance pointer |
\G Create an instance pointer |
Create immediate lastob @ here lastob ! instptr, ; |
Create immediate lastob @ here lastob ! instptr, ; |
: asptr ( class -- ) \ oof- oof |
: asptr ( class -- ) \ oof- oof |
\G Create an alias to an instance pointer, casted to another class |
\G Create an alias to an instance pointer, cast to another class. |
cell+ @ Create immediate |
cell+ @ Create immediate |
lastob @ here lastob ! , , instptr> ; |
lastob @ here lastob ! , , instptr> ; |
|
|
: Fpostpone postpone postpone ; immediate |
: Fpostpone postpone postpone ; immediate |
|
|
: : ( <methodname> -- ) decl @ abort" HOW: missing! " |
: : ( <methodname> -- ) \ oof- oof colon |
|
decl @ abort" HOW: missing! " |
bl word findo 0= abort" not found" |
bl word findo 0= abort" not found" |
dup exec? over early? or over >body cell+ @ 0< or |
dup exec? over early? or over >body cell+ @ 0< or |
0= abort" not a method" |
0= abort" not a method" |
Line 472 types definitions
|
Line 473 types definitions
|
|
|
Forth |
Forth |
|
|
: ; ( xt colon-sys -- ) postpone ; |
: ; ( xt colon-sys -- ) \ oof- oof |
|
postpone ; |
m-name @ dup >body swap exec? |
m-name @ dup >body swap exec? |
IF @ o@ + |
IF @ o@ + |
ELSE dup cell+ @ 0< IF 2@ swap o@ + @ + THEN |
ELSE dup cell+ @ 0< IF 2@ swap o@ + @ + THEN |
Line 581 class; \ object
|
Line 583 class; \ object
|
|
|
Objects definitions |
Objects definitions |
|
|
: implement ( interface -- ) |
: implement ( interface -- ) \ oof-interface- oof |
align here over , ob-interface @ , ob-interface ! |
align here over , ob-interface @ , ob-interface ! |
:ilist + @ >r get-order r> swap 1+ set-order 1 voc# +! ; |
:ilist + @ >r get-order r> swap 1+ set-order 1 voc# +! ; |
|
|
: inter-method, ( interface -- ) |
: inter-method, ( interface -- ) \ oof-interface- oof |
:ilist + @ bl word count 2dup s" '" compare |
:ilist + @ bl word count 2dup s" '" compare |
0= dup >r IF 2drop bl word count THEN |
0= dup >r IF 2drop bl word count THEN |
rot search-wordlist |
rot search-wordlist |
Line 599 Variable inter#
|
Line 601 Variable inter#
|
|
|
Vocabulary interfaces interfaces definitions |
Vocabulary interfaces interfaces definitions |
|
|
: method ( -- ) mallot Create , inter# @ , |
: method ( -- ) \ oof-interface- oof |
DOES> 2@ swap o@ + @ + @ execute ; |
mallot Create , inter# @ , |
|
DOES> 2@ swap o@ + @ + @ execute ; |
|
|
: how: ( -- ) align |
: how: ( -- ) \ oof-interface- oof |
|
align |
here lastif @ ! 0 decl ! |
here lastif @ ! 0 decl ! |
here last-interface @ , last-interface ! |
here last-interface @ , last-interface ! |
inter-list @ , methods @ , inter# @ , |
inter-list @ , methods @ , inter# @ , |
methods @ :inum cell+ ?DO ['] crash , LOOP ; |
methods @ :inum cell+ ?DO ['] crash , LOOP ; |
|
|
: interface; ( -- ) old-current @ set-current |
: interface; ( -- ) \ oof-interface- oof |
|
old-current @ set-current |
previous previous ; |
previous previous ; |
|
|
: : ( <methodname> -- ) decl @ abort" HOW: missing! " |
: : ( <methodname> -- ) \ oof-interface- oof colon |
|
decl @ abort" HOW: missing! " |
bl word count lastif @ @ :ilist + @ |
bl word count lastif @ @ :ilist + @ |
search-wordlist 0= abort" not found" |
search-wordlist 0= abort" not found" |
dup >body cell+ @ 0< 0= abort" not a method" |
dup >body cell+ @ 0< 0= abort" not a method" |
Line 619 Vocabulary interfaces interfaces defini
|
Line 625 Vocabulary interfaces interfaces defini
|
|
|
Forth |
Forth |
|
|
: ; ( xt colon-sys -- ) postpone ; |
: ; ( xt colon-sys -- ) \ oof-interface- oof |
|
postpone ; |
m-name @ >body @ lastif @ @ + ! ; immediate |
m-name @ >body @ lastif @ @ + ! ; immediate |
|
|
Forth definitions |
Forth definitions |
|
|
: interface ( -- ) |
: interface ( -- ) \ oof-interface- oof |
Create here lastif ! 0 , get-current old-current ! |
Create here lastif ! 0 , get-current old-current ! |
last-interface @ dup IF :inum @ THEN 1 cells - inter# ! |
last-interface @ dup IF :inum @ THEN 1 cells - inter# ! |
get-order wordlist |
get-order wordlist |