TAQOZ Reloaded v2.8 - Mini-OOF object oriented programming revisited
Mini-OOF was created by Bernd Paysan in 1998 to provide a modest amount of object oriented programming capability - no frills, no safeguards, very small (496 bytes) to suit microcontrollers. If CREATE .. DOES> doesn't go far enough for you, then Mini-OOF takes you a step further in capability. Here's the code:-
--- Mini-OOF ver 5 - adapted for TAQOZ Reloaded v2.8 by Bob Edwards March 2022 --- Use only when a more elegant non-OOF solution can't be found --- Mini-OOF was originally written by Bernd Paysan 1998 --- see https://bernd-paysan.de/mini-oof.html for more details TAQOZ IFDEF *MINI-OOF* FORGET *MINI-OOF* } pub *MINI-OOF* ." Mini object oriented forth version 5 for Taqoz Reloaded v2.8" ; pub CREATE ( -- ) [C] GRAB [C] CREATE: --- Using the next word in the input stream as the name, create a VARIABLE type dictionary entry [C] GRAB --- make sure CREATE: has run before anything more HERE 2- 0 REG W! --- save the address of the code after DOES> in the REG scratchpad area ; --- set new cfa to point back to DOES: code (skipped by DOES: itself) pub DOES> ( -- ) R> --- the first word location in the new word being defined 0 REG W@ --- retrieve the address stored on scratchpad W! --- set the first word to execute as the address of the code after DOES> ; --- remove the first n bytes / chars from the string at addr1 pub /STRING ( addr1 cnt1 n -- addr2 cnt2 ) DUP >R - --- reduce cnt1 SWAP R> + --- increase start address SWAP --- cleanup ; --- this 'do nothing' action is loaded into the CLASS vtable for all methods to start with ' NOP := 'NOP 2 := INSTR pub INSTRS INSTR * ; pub INSTR+ INSTR + ; --- Start a CLASS definition pub CLASS ( class -- class methods varis ) DUP W@ OVER INSTR+ W@ SWAP --- copy methods and instvars to the stack ; --- All classes are based on this skeleton class CREATE: OBJECT 1 INSTRS || 2 INSTRS || --- declare a method within a class definition / run the method on a specific object pre METHOD CREATE ( m v -- m' v ) OVER [C] || SWAP INSTR+ SWAP --- compile m, then m' = m + cell DOES> ( ... O -- ... ) DUP W@ --- vtable address read from 1st word in object R> W@ --- read this methods offset number + --- this is reqd address in the vtable W@ --- read the address of the method's code JUMP --- and run the method ; --- declare a variable within a class definition / return the variable address in an object pre VARI CREATE ( m v size -- ) --- size - in bytes OVER [C] || + DOES> ( o -- addr ) R> W@ + --- read the VARIs offset and add that to the object address ; --- close the class definition pre END-CLASS ( CLASS methods varis "name" -- ) [C] GRAB [C] CREATE: --- create the class entry in the dict. with the name that follows [C] GRAB HERE >R --- remember the current compilation address - contains VARtotalspace [C] || DUP [C] || --- compile VARtotalspace, then METHODtotalspace ( CLASS METHODtotalspace -- ) 2 INSTRs 2DUP <> IF --- If the new class defines any methods DO 'NOP [C] || --- compile a temporary NOP for each method defined INSTR +LOOP ( CLASS -- ) ELSE 2DROP THEN ( CLASS -- ) INSTR+ DUP INSTR+ R> ( CLASS+2 CLASS+4 HERE -- ) ROT ( CLASS+4 HERE CLASS+2 -- ) W@ ( CLASS+4 HERE METHODbytescnt -- ) 2 INSTRS ( CLASS+4 HERE METHODbytescnt 4 -- ) 2DUP <> IF --- if parent class has any methods /STRING --- exclude the varis or methods byte cnts CMOVE --- copy across the XTs from the parent class ELSE 2DROP 2DROP THEN ; --- assigns a word to one of the method "names" within a class, replacing the 'do nothing' pre DEFINES ( xtanon class 'methodname" -- ) [C] ' --- find xt of the method whose word follows in the input stream [G] --- ( xtanon class pointertooffset ) 2+ --- point to the method offset value ( xt class methodoffset+2 ) W@ --- read the method offset ( xt class methodnumber ) + --- add the offset to the vtable start address W! --- store the new method at that offset ; --- create a new object of a class pub NEW ( class -- o ) HERE --- ( class here ) get address of next compilation location OVER W@ --- ( class here objsize ) read the required size of the new object from the vtable 2 ALIGN --- ( class here objsize' ) ALLOT only takes even numbers ALLOT --- ( class here ) allocate that in code space SWAP --- ( here class ) OVER W! --- ( here ) save the address of the vtable at the start of the object ; --- Read a method address, given the class and method name pre :: ( class "methodname" -- methodaddress ) [C] ' --- find xt of the method whose word follows in the input stream [G] --- ( xtanon class pointertooffset ) 2+ --- point to the method offset value ( xt class methodoffset+2 ) W@ --- read the method offset ( xt class methodnumber ) + --- add the offset to the vtable start address W@ --- address of method's code left on top of stack ; --- this is an 'early binding' method selection, as the addr is resolved during compilation --- Use: MYOBJECT MYCLASS :: MYMETHOD --- Used to create an anonymous word - it is normal code, but has no dictionary entry --- removes the dictionary entry of the last defined word - leaves it's code field address on the stack pub ANON ( -- cfa ) --- Remove dictionary entry of last word defined, leaves xt of code on stack @WORDS --- point to name of latest word in dictionary CPA --- convert to it's code pointer address W@ --- reading the code field address, left on the stack @WORDS CPA 2+ --- now we're pointing to the name field address of the last but one word names ! --- 'names' now points to last but one word in the dictionary ; --- thus the name of the latest word is 'forgotten' $1FF := obj --- LUT adr used to store current object, cog safe --- The end of LUT is well away from the L stack, $80 and upwards --- save the 'current' object for local reference - usage: MYOBJECT WITH pub WITH ( obj -- ) obj LUT! ; --- read the 'current' object - usage: THIS MYMETHOD or THIS MYVARI pub THIS obj LUT@ ; END
Here's a few trivial classes and objects used to test inheritance and override of methods was working:-
\ MINI-OOF demo - Bob Edwards April 2022 OBJECT CLASS 4 VARI teeth# 4 VARI height METHOD SPEAK METHOD GREET METHOD WALK METHOD ADD. END-CLASS PET \ This defines a class in terms of data space and 'do nothing' methods \ It can't be run - it's just a recipe for making pets \ Notice VARI allocates data in units of bytes, so 4 VARI is a long here pub noname ." pet speaks" DROP ; ANON PET DEFINES SPEAK pub noname ." pet greets" DROP ; ANON PET DEFINES GREET pub noname ." pet walks" DROP ; ANON PET DEFINES WALK pub noname DROP + ." n1 + n2 = " . ; ANON PET DEFINES ADD. ( n1 n2 -- ) \ now the methods are reassigned to do useful stuff, using anonymous words \ a named word can be assigned to a method instead :- \ e.g. pub (WALK) ." pet walks" DROP ; ' (WALK) PET DEFINES WALK works just as well \ notice each method drops the object which is top of stack \ in more useful methods, the object is used to access it's other methods and variables PET CLASS METHOD HAPPY \ an extra method is defined, cats can do more than pets END-CLASS CAT pub noname ." cat purrs" DROP ; ANON CAT DEFINES HAPPY \ cats override pets for these two methods pub noname ." cat says meow" DROP ; ANON CAT DEFINES SPEAK pub noname ." cat raises tail" DROP ; ANON CAT DEFINES GREET PET CLASS END-CLASS DOG \ dogs override pets for these two methods pub noname ." dog says wuff" DROP ; ANON DOG DEFINES SPEAK pub noname ." dog wags tail" DROP ; ANON DOG DEFINES GREET \ now we create a cat and dog object to work with \ objects have actual data and can run their methods CAT NEW := TIBBY DOG NEW := FIDO 20 TIBBY teeth# ! 30 FIDO teeth# ! 50 TIBBY height ! 75 FIDO height ! TIBBY teeth# @ . \ we can read data special to TIBBY TIBBY height @ . FIDO teeth# @ . \ we can read FIDO data too FIDO height @ . TIBBY WALK \ notice tibby is a PET so she can walk OK - that is an inherited method 34 56 FIDO ADD. \ the parent PET method ADD. is also inherited here TIBBY GREET \ the PET method is overridden with a method special to CAT FIDO SPEAK \ the PET method is overridden with a method special to DOG TIBBY HAPPY \ cats do more than other pets with this extra method
Bernd admitted Mini-OOF was a bit verbose as it stood - having to have an object reference top of stack all the while was a nuisance. I've maybe fixed that: The word WITH stores the current object in LUT space and the word THIS retrieves it again, which is one less thing to get in the way on the data stack.
I really admire how small the system is - I'm going to see if I can create a basic state-machine class in it and then create a few specific state-machine classes from that. A cog should be able to run any number of such state machines serially in a big loop to 'multi-task' around many different jobs. On each call, one step per state machine is performed. Several cogs could each run their own instance of a state-machine where identical multichannel function is required (each object having it's own data space). There are many applications waiting for Mini-OOF I expect.