sys/boot/ficl/softwords/oo.fr

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