Deleted Added
sdiff udiff text old ( 94290 ) new ( 167850 )
full compact
oo.fr (94290) oo.fr (167850)
1\ #if FICL_WANT_OOP
2\ ** ficl/softwords/oo.fr
3\ ** F I C L O - O E X T E N S I O N S
4\ ** john sadler aug 1998
5\
1\ #if FICL_WANT_OOP
2\ ** ficl/softwords/oo.fr
3\ ** F I C L O - O E X T E N S I O N S
4\ ** john sadler aug 1998
5\
6\ $FreeBSD: head/sys/boot/ficl/softwords/oo.fr 94290 2002-04-09 17:45:28Z dcs $
6\ $FreeBSD: head/sys/boot/ficl/softwords/oo.fr 167850 2007-03-23 22:26:01Z jkim $
7
817 ficl-vocabulary oop
9also oop definitions
10
11\ Design goals:
12\ 0. Traditional OOP: late binding by default for safety.
13\ Early binding if you ask for it.
14\ 1. Single inheritance

--- 66 unchanged lines hidden (view full) ---

810 current-class !
82
83\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
84\ ** L A T E B I N D I N G
85\ Compile the method name, and code to find and
86\ execute it at run-time...
87\
88
7
817 ficl-vocabulary oop
9also oop definitions
10
11\ Design goals:
12\ 0. Traditional OOP: late binding by default for safety.
13\ Early binding if you ask for it.
14\ 1. Single inheritance

--- 66 unchanged lines hidden (view full) ---

810 current-class !
82
83\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
84\ ** L A T E B I N D I N G
85\ Compile the method name, and code to find and
86\ execute it at run-time...
87\
88
89hide
90
91\ p a r s e - m e t h o d
92\ compiles a method name so that it pushes
93\ the string base address and count at run-time.
94
95: parse-method \ name run: ( -- c-addr u )
96 parse-word
97 postpone sliteral
98; compile-only
99
89\ p a r s e - m e t h o d
90\ compiles a method name so that it pushes
91\ the string base address and count at run-time.
92
93: parse-method \ name run: ( -- c-addr u )
94 parse-word
95 postpone sliteral
96; compile-only
97
98
99
100: (lookup-method) { class 2:name -- class 0 | class xt 1 | class xt -1 }
101 class name class cell+ @ ( class c-addr u wid )
102 search-wordlist
103;
104
100\ l o o k u p - m e t h o d
101\ takes a counted string method name from the stack (as compiled
102\ by parse-method) and attempts to look this method up in the method list of
103\ the class that's on the stack. If successful, it leaves the class on the stack
104\ and pushes the xt of the method. If not, it aborts with an error message.
105
106: lookup-method { class 2:name -- class xt }
105\ l o o k u p - m e t h o d
106\ takes a counted string method name from the stack (as compiled
107\ by parse-method) and attempts to look this method up in the method list of
108\ the class that's on the stack. If successful, it leaves the class on the stack
109\ and pushes the xt of the method. If not, it aborts with an error message.
110
111: lookup-method { class 2:name -- class xt }
107 name class cell+ @ ( c-addr u wid )
108 search-wordlist ( 0 | xt 1 | xt -1 )
112 class name (lookup-method) ( 0 | xt 1 | xt -1 )
109 0= if
110 name type ." not found in "
111 class body> >name type
112 cr abort
113 endif
113 0= if
114 name type ." not found in "
115 class body> >name type
116 cr abort
117 endif
114 class swap
115;
116
117: find-method-xt \ name ( class -- class xt )
118 parse-word lookup-method
119;
120
118;
119
120: find-method-xt \ name ( class -- class xt )
121 parse-word lookup-method
122;
123
121set-current ( stop hiding definitions )
122
123: catch-method ( instance class c-addr u -- <method-signature> exc-flag )
124 lookup-method catch
125;
126
127: exec-method ( instance class c-addr u -- <method-signature> )
128 lookup-method execute
129;
130

--- 563 unchanged lines hidden --- 		124: catch-method ( instance class c-addr u -- <method-signature> exc-flag )
125 lookup-method catch
126;
127
128: exec-method ( instance class c-addr u -- <method-signature> )
129 lookup-method execute
130;
131

--- 563 unchanged lines hidden ---