version 1.12, 1999/02/16 06:32:29
|
version 1.14, 1999/07/05 18:54:20
|
Line 1
|
Line 1
|
\ yet another Forth objects extension |
\ yet another Forth objects extension |
|
|
\ written by Anton Ertl 1996-1998 |
\ written by Anton Ertl 1996-1999 |
\ public domain; NO WARRANTY |
\ public domain; NO WARRANTY |
|
|
\ This (in combination with compat/struct.fs) is in ANS Forth (with an |
\ This (in combination with compat/struct.fs) is in ANS Forth (with an |
Line 228 variable last-interface-offset 0 last-in
|
Line 228 variable last-interface-offset 0 last-in
|
\g @var{interface}. |
\g @var{interface}. |
end-interface-noname constant ; |
end-interface-noname constant ; |
|
|
|
\ visibility control |
|
|
|
variable public-wordlist |
|
|
|
: protected ( -- ) \ objects- objects |
|
\g Set the compilation wordlist to the current class's wordlist |
|
current-interface @ class-wordlist @ |
|
dup get-current <> |
|
if \ we are not protected already |
|
get-current public-wordlist ! |
|
then |
|
set-current ; |
|
|
|
: public ( -- ) \ objects- objects |
|
\g Restore the compilation wordlist that was in effect before the |
|
\g last @code{protected} that actually changed the compilation |
|
\g wordlist. |
|
current-interface @ class-wordlist @ get-current = |
|
if \ we are protected |
|
public-wordlist @ set-current |
|
then ; |
|
|
\ classes |
\ classes |
|
|
: add-class-order ( n1 class -- wid1 ... widn n+n1 ) |
: add-class-order ( n1 class -- wid1 ... widn n+n1 ) |
Line 241 variable last-interface-offset 0 last-in
|
Line 263 variable last-interface-offset 0 last-in
|
\g Add @var{class}'s wordlists to the head of the search-order. |
\g Add @var{class}'s wordlists to the head of the search-order. |
>r get-order r> add-class-order set-order ; |
>r get-order r> add-class-order set-order ; |
|
|
|
: methods ( class -- ) |
|
\g Makes @var{class} the current class. This is intended to be |
|
\g used for defining methods to override selectors; you cannot |
|
\g define new fields or selectors. |
|
dup current-interface ! push-order ; |
|
|
: class ( parent-class -- align offset ) \ objects- objects |
: class ( parent-class -- align offset ) \ objects- objects |
\g Start a new class definition as a child of |
\g Start a new class definition as a child of |
\g @var{parent-class}. @var{align offset} are for use by |
\g @var{parent-class}. @var{align offset} are for use by |
Line 252 variable last-interface-offset 0 last-in
|
Line 280 variable last-interface-offset 0 last-in
|
0 r@ interface-offset ! |
0 r@ interface-offset ! |
dup r@ class-parent ! |
dup r@ class-parent ! |
wordlist r@ class-wordlist ! |
wordlist r@ class-wordlist ! |
r@ current-interface ! |
r> methods |
r> push-order |
|
class-inst-size 2@ ; |
class-inst-size 2@ ; |
|
|
: remove-class-order ( wid1 ... widn n+n1 class -- n1 ) |
: remove-class-order ( wid1 ... widn n+n1 class -- n1 ) |
Line 270 variable last-interface-offset 0 last-in
|
Line 297 variable last-interface-offset 0 last-in
|
\g on the search order. |
\g on the search order. |
>r get-order r> remove-class-order set-order ; |
>r get-order r> remove-class-order set-order ; |
|
|
|
: end-methods ( -- ) |
|
\g Switch back from defining methods of a class to normal mode |
|
\g (currently this just restores the old search order). |
|
current-interface @ drop-order ; |
|
|
: end-class-noname ( align offset -- class ) \ objects- objects |
: end-class-noname ( align offset -- class ) \ objects- objects |
\g End a class definition. The resulting class is @var{class}. |
\g End a class definition. The resulting class is @var{class}. |
current-interface @ dup drop-order class-inst-size 2! |
public end-methods |
|
current-interface @ class-inst-size 2! |
end-interface-noname ; |
end-interface-noname ; |
|
|
: end-class ( align offset "name" -- ) \ objects- objects |
: end-class ( align offset "name" -- ) \ objects- objects |
Line 281 variable last-interface-offset 0 last-in
|
Line 314 variable last-interface-offset 0 last-in
|
\ name execution: ( -- class ) |
\ name execution: ( -- class ) |
end-class-noname constant ; |
end-class-noname constant ; |
|
|
\ visibility control |
|
|
|
variable public-wordlist |
|
|
|
: protected ( -- ) \ objects- objects |
|
\g Set the compilation wordlist to the current class's wordlist |
|
current-interface @ class-wordlist @ |
|
dup get-current <> |
|
if \ we are not protected already |
|
get-current public-wordlist ! |
|
then |
|
set-current ; |
|
|
|
: public ( -- ) \ objects- objects |
|
\g Restore the compilation wordlist that was in effect before the |
|
\g last @code{protected} that actually changed the compilation |
|
\g wordlist. |
|
public-wordlist @ set-current ; |
|
|
|
\ classes that implement interfaces |
\ classes that implement interfaces |
|
|
: front-extend-mem ( addr1 u1 u -- addr addr2 u2 ) |
: front-extend-mem ( addr1 u1 u -- addr addr2 u2 ) |