Fully synchronize sys/boot from FreeBSD-5.x, but add / to the module path
[dragonfly.git] / sys / boot / ficl / softwords / oo.fr
CommitLineData
5ee58eed 1\ #if FICL_WANT_OOP
984263bc
MD
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\
5ee58eed
MD
6\ $FreeBSD: src/sys/boot/ficl/softwords/oo.fr,v 1.4 2002/04/09 17:45:28 dcs Exp $
7\ $DragonFly: src/sys/boot/ficl/softwords/oo.fr,v 1.3 2003/11/10 06:08:34 dillon Exp $
984263bc 8
5ee58eed 917 ficl-vocabulary oop
984263bc
MD
10also oop definitions
11
12\ Design goals:
13\ 0. Traditional OOP: late binding by default for safety.
14\ Early binding if you ask for it.
15\ 1. Single inheritance
16\ 2. Object aggregation (has-a relationship)
17\ 3. Support objects in the dictionary and as proxies for
18\ existing structures (by reference):
19\ *** A ficl object can wrap a C struct ***
20\ 4. Separate name-spaces for methods - methods are
21\ only visible in the context of a class / object
22\ 5. Methods can be overridden, and subclasses can add methods.
23\ No limit on number of methods.
24
25\ General info:
26\ Classes are objects, too: all classes are instances of METACLASS
27\ All classes are derived (by convention) from OBJECT. This
28\ base class provides a default initializer and superclass
29\ access method
30
31\ A ficl object binds instance storage (payload) to a class.
32\ object ( -- instance class )
33\ All objects push their payload address and class address when
5ee58eed 34\ executed.
984263bc
MD
35
36\ A ficl class consists of a parent class pointer, a wordlist
37\ ID for the methods of the class, and a size for the payload
38\ of objects created by the class. A class is an object.
39\ The NEW method creates and initializes an instance of a class.
40\ Classes have this footprint:
41\ cell 0: parent class address
42\ cell 1: wordlist ID
43\ cell 2: size of instance's payload
44
45\ Methods expect an object couple ( instance class )
5ee58eed
MD
46\ on the stack. This is by convention - ficl has no way to
47\ police your code to make sure this is always done, but it
48\ happens naturally if you use the facilities presented here.
49\
984263bc 50\ Overridden methods must maintain the same stack signature as
5ee58eed
MD
51\ their predecessors. Ficl has no way of enforcing this, either.
52\
53\ Revised Apr 2001 - Added Guy Carver's vtable extensions. Class now
54\ has an extra field for the vtable method count. Hasvtable declares
55\ refs to vtable classes
56\
57\ Revised Nov 2001 - metaclass debug method now finds only metaclass methods
58\
59\ Planned: Ficl vtable support
60\ Each class has a vtable size parameter
61\ END-CLASS allocates and clears the vtable - then it walks class's method
62\ list and inserts all new methods into table. For each method, if the table
63\ slot is already nonzero, do nothing (overridden method). Otherwise fill
64\ vtable slot. Now do same check for parent class vtable, filling only
65\ empty slots in the new vtable.
66\ Methods are now structured as follows:
67\ - header
68\ - vtable index
69\ - xt
70\ :noname definition for code
71\
72\ : is redefined to check for override, fill in vtable index, increment method
73\ count if not an override, create header and fill in index. Allot code pointer
74\ and run :noname
75\ ; is overridden to fill in xt returned by :noname
76\ --> compiles code to fetch vtable address, offset by index, and execute
77\ => looks up xt in the vtable and compiles it directly
78
79
984263bc
MD
80
81user current-class
820 current-class !
83
84\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
85\ ** L A T E B I N D I N G
86\ Compile the method name, and code to find and
87\ execute it at run-time...
984263bc 88\
5ee58eed
MD
89
90hide
91
92\ p a r s e - m e t h o d
93\ compiles a method name so that it pushes
94\ the string base address and count at run-time.
95
984263bc
MD
96: parse-method \ name run: ( -- c-addr u )
97 parse-word
5ee58eed 98 postpone sliteral
984263bc
MD
99; compile-only
100
5ee58eed
MD
101\ l o o k u p - m e t h o d
102\ takes a counted string method name from the stack (as compiled
103\ by parse-method) and attempts to look this method up in the method list of
104\ the class that's on the stack. If successful, it leaves the class on the stack
105\ and pushes the xt of the method. If not, it aborts with an error message.
106
107: lookup-method { class 2:name -- class xt }
108 name class cell+ @ ( c-addr u wid )
109 search-wordlist ( 0 | xt 1 | xt -1 )
110 0= if
111 name type ." not found in "
112 class body> >name type
984263bc 113 cr abort
5ee58eed
MD
114 endif
115 class swap
984263bc
MD
116;
117
5ee58eed
MD
118: find-method-xt \ name ( class -- class xt )
119 parse-word lookup-method
984263bc
MD
120;
121
5ee58eed
MD
122set-current ( stop hiding definitions )
123
124: catch-method ( instance class c-addr u -- <method-signature> exc-flag )
125 lookup-method catch
984263bc
MD
126;
127
5ee58eed
MD
128: exec-method ( instance class c-addr u -- <method-signature> )
129 lookup-method execute
130;
984263bc
MD
131
132\ Method lookup operator takes a class-addr and instance-addr
133\ and executes the method from the class's wordlist if
134\ interpreting. If compiling, bind late.
135\
136: --> ( instance class -- ??? )
137 state @ 0= if
5ee58eed
MD
138 find-method-xt execute
139 else
140 parse-method postpone exec-method
141 endif
142; immediate
143
144\ Method lookup with CATCH in case of exceptions
145: c-> ( instance class -- ?? exc-flag )
146 state @ 0= if
147 find-method-xt catch
984263bc 148 else
5ee58eed 149 parse-method postpone catch-method
984263bc
MD
150 endif
151; immediate
152
5ee58eed
MD
153\ METHOD makes global words that do method invocations by late binding
154\ in case you prefer this style (no --> in your code)
155\ Example: everything has next and prev for array access, so...
156\ method next
157\ method prev
158\ my-instance next ( does whatever next does to my-instance by late binding )
159
160: method create does> body> >name lookup-method execute ;
161
984263bc
MD
162
163\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
164\ ** E A R L Y B I N D I N G
165\ Early binding operator compiles code to execute a method
166\ given its class at compile time. Classes are immediate,
167\ so they leave their cell-pair on the stack when compiling.
168\ Example:
169\ : get-wid metaclass => .wid @ ;
170\ Usage
171\ my-class get-wid ( -- wid-of-my-class )
172\
5ee58eed
MD
1731 ficl-named-wordlist instance-vars
174instance-vars dup >search ficl-set-current
175
984263bc 176: => \ c:( class meta -- ) run: ( -- ??? ) invokes compiled method
5ee58eed
MD
177 drop find-method-xt compile, drop
178; immediate compile-only
179
180: my=> \ c:( -- ) run: ( -- ??? ) late bind compiled method of current-class
181 current-class @ dup postpone =>
182; immediate compile-only
183
184\ Problem: my=[ assumes that each method except the last is am obj: member
185\ which contains its class as the first field of its parameter area. The code
186\ detects non-obect members and assumes the class does not change in this case.
187\ This handles methods like index, prev, and next correctly, but does not deal
188\ correctly with CLASS.
189: my=[ \ same as my=> , but binds a chain of methods
190 current-class @
191 begin
192 parse-word 2dup ( class c-addr u c-addr u )
193 s" ]" compare while ( class c-addr u )
194 lookup-method ( class xt )
195 dup compile, ( class xt )
196 dup ?object if \ If object member, get new class. Otherwise assume same class
197 nip >body cell+ @ ( new-class )
198 else
199 drop ( class )
200 endif
201 repeat 2drop drop
984263bc
MD
202; immediate compile-only
203
204
205\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
206\ ** I N S T A N C E V A R I A B L E S
207\ Instance variables (IV) are represented by words in the class's
208\ private wordlist. Each IV word contains the offset
209\ of the IV it represents, and runs code to add that offset
210\ to the base address of an instance when executed.
211\ The metaclass SUB method, defined below, leaves the address
212\ of the new class's offset field and its initial size on the
213\ stack for these words to update. When a class definition is
214\ complete, END-CLASS saves the final size in the class's size
215\ field, and restores the search order and compile wordlist to
216\ prior state. Note that these words are hidden in their own
217\ wordlist to prevent accidental use outside a SUB END-CLASS pair.
218\
984263bc
MD
219: do-instance-var
220 does> ( instance class addr[offset] -- addr[field] )
5ee58eed 221 nip @ +
984263bc
MD
222;
223
224: addr-units: ( offset size "name" -- offset' )
225 create over , +
226 do-instance-var
227;
228
5ee58eed 229: chars: \ ( offset nCells "name" -- offset' ) Create n char member.
984263bc
MD
230 chars addr-units: ;
231
5ee58eed 232: char: \ ( offset nCells "name" -- offset' ) Create 1 char member.
984263bc
MD
233 1 chars: ;
234
235: cells: ( offset nCells "name" -- offset' )
5ee58eed 236 cells >r aligned r> addr-units:
984263bc
MD
237;
238
239: cell: ( offset nCells "name" -- offset' )
240 1 cells: ;
241
242\ Aggregate an object into the class...
243\ Needs the class of the instance to create
244\ Example: object obj: m_obj
245\
246: do-aggregate
5ee58eed
MD
247 objectify
248 does> ( instance class pfa -- a-instance a-class )
249 2@ ( inst class a-class a-offset )
250 2swap drop ( a-class a-offset inst )
251 + swap ( a-inst a-class )
984263bc
MD
252;
253
5ee58eed 254: obj: { offset class meta -- offset' } \ "name"
984263bc 255 create offset , class ,
5ee58eed
MD
256 class meta --> get-size offset +
257 do-aggregate
984263bc
MD
258;
259
260\ Aggregate an array of objects into a class
261\ Usage example:
262\ 3 my-class array: my-array
263\ Makes an instance variable array of 3 instances of my-class
264\ named my-array.
265\
266: array: ( offset n class meta "name" -- offset' )
5ee58eed
MD
267 locals| meta class nobjs offset |
268 create offset , class ,
269 class meta --> get-size nobjs * offset +
270 do-aggregate
984263bc
MD
271;
272
273\ Aggregate a pointer to an object: REF is a member variable
274\ whose class is set at compile time. This is useful for wrapping
275\ data structures in C, where there is only a pointer and the type
276\ it refers to is known. If you want polymorphism, see c_ref
277\ in classes.fr. REF is only useful for pre-initialized structures,
278\ since there's no supported way to set one.
279: ref: ( offset class meta "name" -- offset' )
5ee58eed
MD
280 locals| meta class offset |
281 create offset , class ,
282 offset cell+
283 does> ( inst class pfa -- ptr-inst ptr-class )
284 2@ ( inst class ptr-class ptr-offset )
285 2swap drop + @ swap
286;
287
288\ #if FICL_WANT_VCALL
289\ vcall extensions contributed by Guy Carver
290: vcall: ( paramcnt "name" -- )
291 current-class @ 8 + dup @ dup 1+ rot ! \ Kludge fix to get to .vtCount before it's defined.
292 create , , \ ( paramcnt index -- )
293 does> \ ( inst class pfa -- ptr-inst ptr-class )
294 nip 2@ vcall \ ( params offset inst class offset -- )
295;
296
297: vcallr: 0x80000000 or vcall: ; \ Call with return address desired.
298
299\ #if FICL_WANT_FLOAT
300: vcallf: \ ( paramcnt -<name>- f: r )
301 0x80000000 or
302 current-class @ 8 + dup @ dup 1+ rot ! \ Kludge fix to get to .vtCount before it's defined.
303 create , , \ ( paramcnt index -- )
304 does> \ ( inst class pfa -- ptr-inst ptr-class )
305 nip 2@ vcall f> \ ( params offset inst class offset -- f: r )
984263bc 306;
5ee58eed
MD
307\ #endif /* FLOAT */
308\ #endif /* VCALL */
984263bc
MD
309
310\ END-CLASS terminates construction of a class by storing
311\ the size of its instance variables in the class's size field
312\ ( -- old-wid addr[size] 0 )
313\
314: end-class ( old-wid addr[size] size -- )
315 swap ! set-current
5ee58eed 316 search> drop \ pop struct builder wordlist
984263bc
MD
317;
318
5ee58eed
MD
319\ See resume-class (a metaclass method) below for usage
320\ This is equivalent to end-class for now, but that will change
321\ when we support vtable bindings.
322: suspend-class ( old-wid addr[size] size -- ) end-class ;
323
984263bc
MD
324set-current previous
325\ E N D I N S T A N C E V A R I A B L E S
326
327
328\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
329\ D O - D O - I N S T A N C E
330\ Makes a class method that contains the code for an
331\ instance of the class. This word gets compiled into
332\ the wordlist of every class by the SUB method.
333\ PRECONDITION: current-class contains the class address
334\ why use a state variable instead of the stack?
5ee58eed 335\ >> Stack state is not well-defined during compilation (there are
984263bc
MD
336\ >> control structure match codes on the stack, of undefined size
337\ >> easiest way around this is use of this thread-local variable
338\
339: do-do-instance ( -- )
340 s" : .do-instance does> [ current-class @ ] literal ;"
341 evaluate
342;
343
344\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
345\ ** M E T A C L A S S
346\ Every class is an instance of metaclass. This lets
347\ classes have methods that are different from those
348\ of their instances.
349\ Classes are IMMEDIATE to make early binding simpler
350\ See above...
351\
352:noname
5ee58eed
MD
353 wordlist
354 create
984263bc 355 immediate
5ee58eed
MD
356 0 , \ NULL parent class
357 dup , \ wid
358\ #if FICL_WANT_VCALL
359 4 cells , \ instance size
360\ #else
361 3 cells , \ instance size
362\ #endif
363 ficl-set-current
364 does> dup
365; execute metaclass
366\ now brand OBJECT's wordlist (so that ORDER can display it by name)
367metaclass drop cell+ @ brand-wordlist
984263bc
MD
368
369metaclass drop current-class !
370do-do-instance
371
372\
373\ C L A S S M E T H O D S
374\
375instance-vars >search
376
377create .super ( class metaclass -- parent-class )
378 0 cells , do-instance-var
379
380create .wid ( class metaclass -- wid ) \ return wid of class
381 1 cells , do-instance-var
382
5ee58eed
MD
383\ #if FICL_WANT_VCALL
384create .vtCount \ Number of VTABLE methods, if any
984263bc
MD
385 2 cells , do-instance-var
386
5ee58eed
MD
387create .size ( class metaclass -- size ) \ return class's payload size
388 3 cells , do-instance-var
389\ #else
390create .size ( class metaclass -- size ) \ return class's payload size
391 2 cells , do-instance-var
392\ #endif
984263bc
MD
393
394: get-size metaclass => .size @ ;
395: get-wid metaclass => .wid @ ;
396: get-super metaclass => .super @ ;
5ee58eed
MD
397\ #if FICL_WANT_VCALL
398: get-vtCount metaclass => .vtCount @ ;
399: get-vtAdd metaclass => .vtCount ;
400\ #endif
984263bc
MD
401
402\ create an uninitialized instance of a class, leaving
403\ the address of the new instance and its class
404\
405: instance ( class metaclass "name" -- instance class )
406 locals| meta parent |
5ee58eed 407 create
984263bc
MD
408 here parent --> .do-instance \ ( inst class )
409 parent meta metaclass => get-size
410 allot \ allocate payload space
411;
412
413\ create an uninitialized array
414: array ( n class metaclass "name" -- n instance class )
415 locals| meta parent nobj |
5ee58eed 416 create nobj
984263bc
MD
417 here parent --> .do-instance \ ( nobj inst class )
418 parent meta metaclass => get-size
5ee58eed 419 nobj * allot \ allocate payload space
984263bc
MD
420;
421
422\ create an initialized instance
423\
424: new \ ( class metaclass "name" -- )
425 metaclass => instance --> init
426;
427
428\ create an initialized array of instances
429: new-array ( n class metaclass "name" -- )
5ee58eed
MD
430 metaclass => array
431 --> array-init
984263bc
MD
432;
433
434\ Create an anonymous initialized instance from the heap
435: alloc \ ( class metaclass -- instance class )
436 locals| meta class |
437 class meta metaclass => get-size allocate ( -- addr fail-flag )
438 abort" allocate failed " ( -- addr )
439 class 2dup --> init
440;
441
442\ Create an anonymous array of initialized instances from the heap
443: alloc-array \ ( n class metaclass -- instance class )
444 locals| meta class nobj |
445 class meta metaclass => get-size
446 nobj * allocate ( -- addr fail-flag )
447 abort" allocate failed " ( -- addr )
448 nobj over class --> array-init
449 class
450;
451
5ee58eed
MD
452\ Create an anonymous initialized instance from the dictionary
453: allot { 2:this -- 2:instance }
454 here ( instance-address )
455 this my=> get-size allot
456 this drop 2dup --> init
457;
458
459\ Create an anonymous array of initialized instances from the dictionary
460: allot-array { nobj 2:this -- 2:instance }
461 here ( instance-address )
462 this my=> get-size nobj * allot
463 this drop 2dup ( 2instance 2instance )
464 nobj -rot --> array-init
465;
466
984263bc
MD
467\ create a proxy object with initialized payload address given
468: ref ( instance-addr class metaclass "name" -- )
469 drop create , ,
470 does> 2@
471;
472
5ee58eed
MD
473\ suspend-class and resume-class help to build mutually referent classes.
474\ Example:
475\ object subclass c-akbar
476\ suspend-class ( put akbar on hold while we define jeff )
477\ object subclass c-jeff
478\ c-akbar ref: .akbar
479\ ( and whatever else comprises this class )
480\ end-class ( done with c-jeff )
481\ c-akbar --> resume-class
482\ c-jeff ref: .jeff
483\ ( and whatever else goes in c-akbar )
484\ end-class ( done with c-akbar )
485\
486: resume-class { 2:this -- old-wid addr[size] size }
487 this --> .wid @ ficl-set-current ( old-wid )
488 this --> .size dup @ ( old-wid addr[size] size )
489 instance-vars >search
490;
491
984263bc 492\ create a subclass
5ee58eed
MD
493\ This method leaves the stack and search order ready for instance variable
494\ building. Pushes the instance-vars wordlist onto the search order,
495\ and sets the compilation wordlist to be the private wordlist of the
496\ new class. The class's wordlist is deliberately NOT in the search order -
497\ to prevent methods from getting used with wrong data.
498\ Postcondition: leaves the address of the new class in current-class
984263bc
MD
499: sub ( class metaclass "name" -- old-wid addr[size] size )
500 wordlist
5ee58eed
MD
501 locals| wid meta parent |
502 parent meta metaclass => get-wid
503 wid wid-set-super \ set superclass
504 create immediate \ get the subclass name
505 wid brand-wordlist \ label the subclass wordlist
506 here current-class ! \ prep for do-do-instance
507 parent , \ save parent class
508 wid , \ save wid
509\ #if FICL_WANT_VCALL
510 parent meta --> get-vtCount ,
511\ #endif
512 here parent meta --> get-size dup , ( addr[size] size )
513 metaclass => .do-instance
514 wid ficl-set-current -rot
515 do-do-instance
516 instance-vars >search \ push struct builder wordlist
984263bc
MD
517;
518
519\ OFFSET-OF returns the offset of an instance variable
520\ from the instance base address. If the next token is not
521\ the name of in instance variable method, you get garbage
522\ results -- there is no way at present to check for this error.
523: offset-of ( class metaclass "name" -- offset )
524 drop find-method-xt nip >body @ ;
525
526\ ID returns the string name cell-pair of its class
527: id ( class metaclass -- c-addr u )
5ee58eed 528 drop body> >name ;
984263bc
MD
529
530\ list methods of the class
531: methods \ ( class meta -- )
5ee58eed
MD
532 locals| meta class |
533 begin
534 class body> >name type ." methods:" cr
535 class meta --> get-wid >search words cr previous
536 class meta metaclass => get-super
537 dup to class
538 0= until cr
984263bc
MD
539;
540
541\ list class's ancestors
542: pedigree ( class meta -- )
5ee58eed
MD
543 locals| meta class |
544 begin
545 class body> >name type space
546 class meta metaclass => get-super
547 dup to class
548 0= until cr
984263bc
MD
549;
550
5ee58eed 551\ decompile an instance method
984263bc
MD
552: see ( class meta -- )
553 metaclass => get-wid >search see previous ;
554
5ee58eed
MD
555\ debug a method of metaclass
556\ Eg: my-class --> debug my-method
557: debug ( class meta -- )
558 find-method-xt debug-xt ;
559
560previous set-current
984263bc
MD
561\ E N D M E T A C L A S S
562
5ee58eed 563\ ** META is a nickname for the address of METACLASS...
984263bc
MD
564metaclass drop
565constant meta
566
5ee58eed 567\ ** SUBCLASS is a nickname for a class's SUB method...
984263bc
MD
568\ Subclass compilation ends when you invoke end-class
569\ This method is late bound for safety...
570: subclass --> sub ;
571
5ee58eed
MD
572\ #if FICL_WANT_VCALL
573\ VTABLE Support extensions (Guy Carver)
574\ object --> sub mine hasvtable
575: hasvtable 4 + ; immediate
576\ #endif
577
984263bc
MD
578
579\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
580\ ** O B J E C T
581\ Root of all classes
582:noname
5ee58eed
MD
583 wordlist
584 create immediate
585 0 , \ NULL parent class
586 dup , \ wid
587 0 , \ instance size
588 ficl-set-current
589 does> meta
984263bc 590; execute object
5ee58eed
MD
591\ now brand OBJECT's wordlist (so that ORDER can display it by name)
592object drop cell+ @ brand-wordlist
984263bc
MD
593
594object drop current-class !
595do-do-instance
5ee58eed 596instance-vars >search
984263bc
MD
597
598\ O B J E C T M E T H O D S
599\ Convert instance cell-pair to class cell-pair
600\ Useful for binding class methods from an instance
601: class ( instance class -- class metaclass )
5ee58eed 602 nip meta ;
984263bc
MD
603
604\ default INIT method zero fills an instance
605: init ( instance class -- )
606 meta
607 metaclass => get-size ( inst size )
608 erase ;
609
610\ Apply INIT to an array of NOBJ objects...
611\
612: array-init ( nobj inst class -- )
5ee58eed
MD
613 0 dup locals| &init &next class inst |
614 \
615 \ bind methods outside the loop to save time
616 \
617 class s" init" lookup-method to &init
618 s" next" lookup-method to &next
619 drop
620 0 ?do
621 inst class 2dup
622 &init execute
623 &next execute drop to inst
624 loop
984263bc
MD
625;
626
627\ free storage allocated to a heap instance by alloc or alloc-array
628\ NOTE: not protected against errors like FREEing something that's
629\ really in the dictionary.
630: free \ ( instance class -- )
5ee58eed
MD
631 drop free
632 abort" free failed "
984263bc
MD
633;
634
635\ Instance aliases for common class methods
636\ Upcast to parent class
637: super ( instance class -- instance parent-class )
638 meta metaclass => get-super ;
639
640: pedigree ( instance class -- )
5ee58eed 641 object => class
984263bc
MD
642 metaclass => pedigree ;
643
644: size ( instance class -- sizeof-instance )
5ee58eed 645 object => class
984263bc
MD
646 metaclass => get-size ;
647
648: methods ( instance class -- )
5ee58eed 649 object => class
984263bc
MD
650 metaclass => methods ;
651
652\ Array indexing methods...
653\ Usage examples:
654\ 10 object-array --> index
655\ obj --> next
656\
657: index ( n instance class -- instance[n] class )
5ee58eed
MD
658 locals| class inst |
659 inst class
984263bc 660 object => class
5ee58eed
MD
661 metaclass => get-size * ( n*size )
662 inst + class ;
984263bc
MD
663
664: next ( instance[n] class -- instance[n+1] class )
5ee58eed
MD
665 locals| class inst |
666 inst class
984263bc 667 object => class
5ee58eed
MD
668 metaclass => get-size
669 inst +
670 class ;
984263bc
MD
671
672: prev ( instance[n] class -- instance[n-1] class )
5ee58eed
MD
673 locals| class inst |
674 inst class
984263bc 675 object => class
5ee58eed
MD
676 metaclass => get-size
677 inst swap -
678 class ;
984263bc 679
5ee58eed
MD
680: debug ( 2this -- ?? )
681 find-method-xt debug-xt ;
682
683previous set-current
984263bc
MD
684\ E N D O B J E C T
685
5ee58eed
MD
686\ reset to default search order
687only definitions
688
689\ redefine oop in default search order to put OOP words in the search order and make them
690\ the compiling wordlist...
691
692: oo only also oop definitions ;
984263bc 693
5ee58eed 694\ #endif