afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas SoomeS" FICL_WANT_OOP" ENVIRONMENT? drop [if]
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** F I C L O - O E X T E N S I O N S
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** john sadler aug 1998
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome.( loading ficl O-O extensions ) cr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome17 ficl-vocabulary oop
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomealso oop definitions
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Design goals:
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ 0. Traditional OOP: late binding by default for safety.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Early binding if you ask for it.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ 1. Single inheritance
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ 2. Object aggregation (has-a relationship)
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ 3. Support objects in the dictionary and as proxies for
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ existing structures (by reference):
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ *** A ficl object can wrap a C struct ***
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ 4. Separate name-spaces for methods - methods are
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ only visible in the context of a class / object
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ 5. Methods can be overridden, and subclasses can add methods.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ No limit on number of methods.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ General info:
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Classes are objects, too: all classes are instances of METACLASS
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ All classes are derived (by convention) from OBJECT. This
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ base class provides a default initializer and superclass
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ access method
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ A ficl object binds instance storage (payload) to a class.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ object ( -- instance class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ All objects push their payload address and class address when
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ A ficl class consists of a parent class pointer, a wordlist
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ID for the methods of the class, and a size for the payload
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ of objects created by the class. A class is an object.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ The NEW method creates and initializes an instance of a class.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Classes have this footprint:
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ cell 0: parent class address
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ cell 1: wordlist ID
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ cell 2: size of instance's payload
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Methods expect an object couple ( instance class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ on the stack. This is by convention - ficl has no way to
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ police your code to make sure this is always done, but it
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ happens naturally if you use the facilities presented here.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Overridden methods must maintain the same stack signature as
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ their predecessors. Ficl has no way of enforcing this, either.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Revised Apr 2001 - Added Guy Carver's vtable extensions. Class now
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ has an extra field for the vtable method count. Hasvtable declares
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ refs to vtable classes
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Revised Nov 2001 - metaclass debug method now finds only metaclass methods
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Planned: Ficl vtable support
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Each class has a vtable size parameter
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ END-CLASS allocates and clears the vtable - then it walks class's method
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ list and inserts all new methods into table. For each method, if the table
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ slot is already nonzero, do nothing (overridden method). Otherwise fill
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ vtable slot. Now do same check for parent class vtable, filling only
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ empty slots in the new vtable.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Methods are now structured as follows:
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ - vtable index
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ :noname definition for code
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ : is redefined to check for override, fill in vtable index, increment method
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ count if not an override, create header and fill in index. Allot code pointer
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ and run :noname
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ; is overridden to fill in xt returned by :noname
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ --> compiles code to fetch vtable address, offset by index, and execute
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ => looks up xt in the vtable and compiles it directly
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeuser current-class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome0 current-class !
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** L A T E B I N D I N G
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Compile the method name, and code to find and
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ execute it at run-time...
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ p a r s e - m e t h o d
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ compiles a method name so that it pushes
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ the string base address and count at run-time.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: parse-method \ name run: ( -- c-addr u )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome postpone sliteral
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome; compile-only
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: (lookup-method) { class 2:name -- class 0 | class xt 1 | class xt -1 }
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class name class cell+ @ ( class c-addr u wid )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome search-wordlist
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ l o o k u p - m e t h o d
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ takes a counted string method name from the stack (as compiled
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ by parse-method) and attempts to look this method up in the method list of
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ the class that's on the stack. If successful, it leaves the class on the stack
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ and pushes the xt of the method. If not, it aborts with an error message.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: lookup-method { class 2:name -- class xt }
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class name (lookup-method) ( 0 | xt 1 | xt -1 )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome name type ." not found in "
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class body> >name type
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: find-method-xt \ name ( class -- class xt )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome parse-word lookup-method
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: catch-method ( instance class c-addr u -- <method-signature> exc-flag )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome lookup-method catch
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: exec-method ( instance class c-addr u -- <method-signature> )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome lookup-method execute
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Method lookup operator takes a class-addr and instance-addr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ and executes the method from the class's wordlist if
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ interpreting. If compiling, bind late.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: --> ( instance class -- ??? )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome state @ 0= if
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome find-method-xt execute
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome parse-method postpone exec-method
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Method lookup with CATCH in case of exceptions
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: c-> ( instance class -- ?? exc-flag )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome state @ 0= if
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome find-method-xt catch
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome parse-method postpone catch-method
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ METHOD makes global words that do method invocations by late binding
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ in case you prefer this style (no --> in your code)
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Example: everything has next and prev for array access, so...
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ method next
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ method prev
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ my-instance next ( does whatever next does to my-instance by late binding )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: method create does> body> >name lookup-method execute ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** E A R L Y B I N D I N G
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Early binding operator compiles code to execute a method
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ given its class at compile time. Classes are immediate,
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ so they leave their cell-pair on the stack when compiling.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ : get-wid metaclass => .wid @ ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ my-class get-wid ( -- wid-of-my-class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome1 ficl-named-wordlist instance-vars
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeinstance-vars dup >search ficl-set-current
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: => \ c:( class meta -- ) run: ( -- ??? ) invokes compiled method
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome drop find-method-xt compile, drop
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome; immediate compile-only
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: my=> \ c:( -- ) run: ( -- ??? ) late bind compiled method of current-class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome current-class @ dup postpone =>
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome; immediate compile-only
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Problem: my=[ assumes that each method except the last is an obj: member
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ which contains its class as the first field of its parameter area. The code
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ detects non-obect members and assumes the class does not change in this case.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ This handles methods like index, prev, and next correctly, but does not deal
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ correctly with CLASS.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: my=[ \ same as my=> , but binds a chain of methods
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome current-class @
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome parse-word 2dup ( class c-addr u c-addr u )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome s" ]" compare while ( class c-addr u )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome lookup-method ( class xt )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome dup compile, ( class xt )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome dup ?object if \ If object member, get new class. Otherwise assume same class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome nip >body cell+ @ ( new-class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome drop ( class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome repeat 2drop drop
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome; immediate compile-only
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** I N S T A N C E V A R I A B L E S
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Instance variables (IV) are represented by words in the class's
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ private wordlist. Each IV word contains the offset
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ of the IV it represents, and runs code to add that offset
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ to the base address of an instance when executed.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ The metaclass SUB method, defined below, leaves the address
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ of the new class's offset field and its initial size on the
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ stack for these words to update. When a class definition is
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ complete, END-CLASS saves the final size in the class's size
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ field, and restores the search order and compile wordlist to
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ prior state. Note that these words are hidden in their own
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ wordlist to prevent accidental use outside a SUB END-CLASS pair.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: do-instance-var
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome does> ( instance class addr[offset] -- addr[field] )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: addr-units: ( offset size "name" -- offset' )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome create over , +
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome do-instance-var
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: chars: \ ( offset nCells "name" -- offset' ) Create n char member.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome chars addr-units: ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: char: \ ( offset nCells "name" -- offset' ) Create 1 char member.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: cells: ( offset nCells "name" -- offset' )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome cells >r aligned r> addr-units:
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: cell: ( offset nCells "name" -- offset' )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Aggregate an object into the class...
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Needs the class of the instance to create
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Example: object obj: m_obj
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: do-aggregate
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome does> ( instance class pfa -- a-instance a-class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 2@ ( inst class a-class a-offset )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 2swap drop ( a-class a-offset inst )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome + swap ( a-inst a-class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: obj: { offset class meta -- offset' } \ "name"
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome create offset , class ,
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class meta --> get-size offset +
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome do-aggregate
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Aggregate an array of objects into a class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Usage example:
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ 3 my-class array: my-array
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Makes an instance variable array of 3 instances of my-class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ named my-array.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: array: ( offset n class meta "name" -- offset' )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome locals| meta class nobjs offset |
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome create offset , class ,
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class meta --> get-size nobjs * offset +
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome do-aggregate
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Aggregate a pointer to an object: REF is a member variable
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ whose class is set at compile time. This is useful for wrapping
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ data structures in C, where there is only a pointer and the type
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ it refers to is known. If you want polymorphism, see c_ref
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ in classes.fr. REF is only useful for pre-initialized structures,
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ since there's no supported way to set one.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: ref: ( offset class meta "name" -- offset' )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome locals| meta class offset |
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome create offset , class ,
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome offset cell+
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome does> ( inst class pfa -- ptr-inst ptr-class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 2@ ( inst class ptr-class ptr-offset )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 2swap drop + @ swap
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas SoomeS" FICL_WANT_VCALL" ENVIRONMENT? drop [if]
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ vcall extensions contributed by Guy Carver
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: vcall: ( paramcnt "name" -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome current-class @ 8 + dup @ dup 1+ rot ! \ Kludge fix to get to .vtCount before it's defined.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome create , , \ ( paramcnt index -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome does> \ ( inst class pfa -- ptr-inst ptr-class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome nip 2@ vcall \ ( params offset inst class offset -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: vcallr: 0x80000000 or vcall: ; \ Call with return address desired.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas SoomeS" FICL_WANT_FLOAT" ENVIRONMENT? drop [if]
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: vcallf: \ ( paramcnt -<name>- f: r )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 0x80000000 or
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome current-class @ 8 + dup @ dup 1+ rot ! \ Kludge fix to get to .vtCount before it's defined.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome create , , \ ( paramcnt index -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome does> \ ( inst class pfa -- ptr-inst ptr-class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome nip 2@ vcall f> \ ( params offset inst class offset -- f: r )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome[endif] \ FICL_WANT_FLOAT
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome[endif] \ FICL_WANT_VCALL
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ END-CLASS terminates construction of a class by storing
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ the size of its instance variables in the class's size field
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ( -- old-wid addr[size] 0 )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: end-class ( old-wid addr[size] size -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome swap ! set-current
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome search> drop \ pop struct builder wordlist
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ See resume-class (a metaclass method) below for usage
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ This is equivalent to end-class for now, but that will change
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ when we support vtable bindings.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: suspend-class ( old-wid addr[size] size -- ) end-class ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeset-current previous
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ E N D I N S T A N C E V A R I A B L E S
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ D O - D O - I N S T A N C E
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Makes a class method that contains the code for an
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ instance of the class. This word gets compiled into
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ the wordlist of every class by the SUB method.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ PRECONDITION: current-class contains the class address
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ why use a state variable instead of the stack?
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ >> Stack state is not well-defined during compilation (there are
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ >> control structure match codes on the stack, of undefined size
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ >> easiest way around this is use of this thread-local variable
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: do-do-instance ( -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome s" : .do-instance does> [ current-class @ ] literal ;"
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** M E T A C L A S S
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Every class is an instance of metaclass. This lets
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ classes have methods that are different from those
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ of their instances.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Classes are IMMEDIATE to make early binding simpler
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ See above...
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 0 , \ NULL parent class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome[ S" FICL_WANT_VCALL" ENVIRONMENT? drop ] [if]
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 4 cells , \ instance size
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 3 cells , \ instance size
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome ficl-set-current
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome; execute metaclass
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ now brand OBJECT's wordlist (so that ORDER can display it by name)
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomemetaclass drop cell+ @ brand-wordlist
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomemetaclass drop current-class !
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomedo-do-instance
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ C L A S S M E T H O D S
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeinstance-vars >search
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomecreate .super ( class metaclass -- parent-class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 0 cells , do-instance-var
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomecreate .wid ( class metaclass -- wid ) \ return wid of class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 1 cells , do-instance-var
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas SoomeS" FICL_WANT_VCALL" ENVIRONMENT? drop [if]
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomecreate .vtCount \ Number of VTABLE methods, if any
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 2 cells , do-instance-var
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomecreate .size ( class metaclass -- size ) \ return class's payload size
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 3 cells , do-instance-var
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomecreate .size ( class metaclass -- size ) \ return class's payload size
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 2 cells , do-instance-var
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: get-size metaclass => .size @ ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: get-wid metaclass => .wid @ ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: get-super metaclass => .super @ ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas SoomeS" FICL_WANT_VCALL" ENVIRONMENT? drop [if]
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: get-vtCount metaclass => .vtCount @ ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: get-vtAdd metaclass => .vtCount ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ create an uninitialized instance of a class, leaving
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ the address of the new instance and its class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: instance ( class metaclass "name" -- instance class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome locals| meta parent |
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome here parent --> .do-instance \ ( inst class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome parent meta metaclass => get-size
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome allot \ allocate payload space
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ create an uninitialized array
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: array ( n class metaclass "name" -- n instance class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome locals| meta parent nobj |
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome here parent --> .do-instance \ ( nobj inst class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome parent meta metaclass => get-size
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome nobj * allot \ allocate payload space
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ create an initialized instance
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: new \ ( class metaclass "name" -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome metaclass => instance --> init
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ create an initialized array of instances
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: new-array ( n class metaclass "name" -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome metaclass => array
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome --> array-init
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Create an anonymous initialized instance from the heap
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: alloc \ ( class metaclass -- instance class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome locals| meta class |
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class meta metaclass => get-size allocate ( -- addr fail-flag )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome abort" allocate failed " ( -- addr )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class 2dup --> init
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Create an anonymous array of initialized instances from the heap
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: alloc-array \ ( n class metaclass -- instance class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome locals| meta class nobj |
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class meta metaclass => get-size
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome nobj * allocate ( -- addr fail-flag )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome abort" allocate failed " ( -- addr )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome nobj over class --> array-init
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Create an anonymous initialized instance from the dictionary
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: allot { 2:this -- 2:instance }
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome here ( instance-address )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome this my=> get-size allot
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome this drop 2dup --> init
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Create an anonymous array of initialized instances from the dictionary
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: allot-array { nobj 2:this -- 2:instance }
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome here ( instance-address )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome this my=> get-size nobj * allot
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome this drop 2dup ( 2instance 2instance )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome nobj -rot --> array-init
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ create a proxy object with initialized payload address given
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: ref ( instance-addr class metaclass "name" -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome drop create , ,
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ suspend-class and resume-class help to build mutually referent classes.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ object subclass c-akbar
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ suspend-class ( put akbar on hold while we define jeff )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ object subclass c-jeff
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ c-akbar ref: .akbar
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ( and whatever else comprises this class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ end-class ( done with c-jeff )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ c-akbar --> resume-class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ c-jeff ref: .jeff
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ( and whatever else goes in c-akbar )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ end-class ( done with c-akbar )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: resume-class { 2:this -- old-wid addr[size] size }
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome this --> .wid @ ficl-set-current ( old-wid )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome this --> .size dup @ ( old-wid addr[size] size )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome instance-vars >search
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ create a subclass
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ This method leaves the stack and search order ready for instance variable
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ building. Pushes the instance-vars wordlist onto the search order,
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ and sets the compilation wordlist to be the private wordlist of the
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ new class. The class's wordlist is deliberately NOT in the search order -
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ to prevent methods from getting used with wrong data.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Postcondition: leaves the address of the new class in current-class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: sub ( class metaclass "name" -- old-wid addr[size] size )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome locals| wid meta parent |
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome parent meta metaclass => get-wid
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome wid wid-set-super \ set superclass
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome create immediate \ get the subclass name
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome wid brand-wordlist \ label the subclass wordlist
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome here current-class ! \ prep for do-do-instance
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome parent , \ save parent class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome wid , \ save wid
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome[ S" FICL_WANT_VCALL" ENVIRONMENT? drop ] [if]
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome parent meta --> get-vtCount ,
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome here parent meta --> get-size dup , ( addr[size] size )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome metaclass => .do-instance
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome wid ficl-set-current -rot
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome do-do-instance
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome instance-vars >search \ push struct builder wordlist
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ OFFSET-OF returns the offset of an instance variable
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ from the instance base address. If the next token is not
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ the name of in instance variable method, you get garbage
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ results -- there is no way at present to check for this error.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: offset-of ( class metaclass "name" -- offset )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome drop find-method-xt nip >body @ ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ID returns the string name cell-pair of its class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: id ( class metaclass -- c-addr u )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome drop body> >name ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ list methods of the class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: methods \ ( class meta -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome locals| meta class |
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class body> >name type ." methods:" cr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class meta --> get-wid >search words cr previous
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class meta metaclass => get-super
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome dup to class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ list class's ancestors
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: pedigree ( class meta -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome locals| meta class |
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class body> >name type space
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class meta metaclass => get-super
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome dup to class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ decompile an instance method
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: see ( class meta -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome metaclass => get-wid >search see previous ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ debug a method of metaclass
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Eg: my-class --> debug my-method
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: debug ( class meta -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome find-method-xt debug-xt ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeprevious set-current
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ E N D M E T A C L A S S
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** META is a nickname for the address of METACLASS...
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomemetaclass drop
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeconstant meta
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** SUBCLASS is a nickname for a class's SUB method...
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Subclass compilation ends when you invoke end-class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ This method is late bound for safety...
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: subclass --> sub ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas SoomeS" FICL_WANT_VCALL" ENVIRONMENT? drop [if]
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ VTABLE Support extensions (Guy Carver)
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ object --> sub mine hasvtable
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: hasvtable 4 + ; immediate
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** O B J E C T
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Root of all classes
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome create immediate
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 0 , \ NULL parent class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 0 , \ instance size
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome[ S" FICL_WANT_VCALL" ENVIRONMENT? drop ] [if]
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 0 , \ .vtCount
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome ficl-set-current
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome; execute object
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ now brand OBJECT's wordlist (so that ORDER can display it by name)
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeobject drop cell+ @ brand-wordlist
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeobject drop current-class !
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomedo-do-instance
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeinstance-vars >search
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ O B J E C T M E T H O D S
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Convert instance cell-pair to class cell-pair
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Useful for binding class methods from an instance
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: class ( instance class -- class metaclass )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ default INIT method zero fills an instance
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: init ( instance class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome metaclass => get-size ( inst size )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Apply INIT to an array of NOBJ objects...
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: array-init ( nobj inst class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 0 dup locals| &init &next class inst |
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome \ bind methods outside the loop to save time
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome class s" init" lookup-method to &init
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome s" next" lookup-method to &next
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome inst class 2dup
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome &init execute
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome &next execute drop to inst
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ free storage allocated to a heap instance by alloc or alloc-array
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ NOTE: not protected against errors like FREEing something that's
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ really in the dictionary.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: free \ ( instance class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome abort" free failed "
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Instance aliases for common class methods
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Upcast to parent class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: super ( instance class -- instance parent-class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome meta metaclass => get-super ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: pedigree ( instance class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome object => class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome metaclass => pedigree ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: size ( instance class -- sizeof-instance )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome object => class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome metaclass => get-size ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: methods ( instance class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome object => class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome metaclass => methods ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Array indexing methods...
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Usage examples:
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ 10 object-array --> index
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ obj --> next
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: index ( n instance class -- instance[n] class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome locals| class inst |
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome object => class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome metaclass => get-size * ( n*size )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome inst + class ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: next ( instance[n] class -- instance[n+1] class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome locals| class inst |
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome object => class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome metaclass => get-size
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: prev ( instance[n] class -- instance[n-1] class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome locals| class inst |
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome object => class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome metaclass => get-size
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: debug ( 2this -- ?? )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome find-method-xt debug-xt ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeprevious set-current
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ E N D O B J E C T
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ reset to default search order
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeonly definitions
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ redefine oop in default search order to put OOP words in the search order and make them
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ the compiling wordlist...
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: oo only also oop definitions ;