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 6 - adapted for TAQOZ Reloaded v2.8 by Bob Edwards July 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
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 --- one TAQOZ instruction is two bytes
pub INSTRS INSTR * ; ( n -- 2*n ) --- compute the number of bytes for n instructions
pub INSTR+ INSTR + ; ( n -- n+2 ) --- increment n by one instructions worth of bytes in hub ram
--- 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' placeholder
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" -- adr )
[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@ --- get the address of the required method
;
--- this is an 'early binding' method selection, as the addr is resolved during compilation
--- Use: MYOBJECT MYCLASS :: MYMETHOD
--- e.g. : TEST TIMER1 [ TIMER :: TPRINT GRAB ] [W] CRLF ;
--- 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'
--- On entry to a method, Mini-OOF places the 'current object' top of data stack
--- Mini-OOF expects the method to consume the 'current object' before it exits
--- BUT - having the 'current object' top of stack all the time is a nuisance
--- especially when accessing the data stack entries underneath
--- So, we dedicate the L stack to store the 'current object', so that methods can call other methods
--- and the current object is saved and restored in a nested fashion
--- These three words utilise the L stack as the 'current object' stack
--- push the current object onto the L stack
ALIAS >L WITH ( obj -- )
--- read the current object
pub THIS ( -- obj )
L> DUP >L
;
--- unnest the current object and discard
pub ENDWITH ( -- )
L> DROP
;
--- End of Mini-OOF
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.
Comments
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.
Hi Bob,
you are aware, that Taqoz supports this sort of multitasking with "+poll" ?
I am wondering if this Mini-OOF could be used to handle different variable types like strings and floats together with their routines. ( Practically I do not actively use classes, when I do programming with Arduino. )
Thanks for posting!
Christof
Hi @"Christof Eb." , thanks for the comments,
So a Mini-OOF state machine could be attached via +POLL to step through one state each time it was called in the POLL list.
Just to warn anyone using Mini-OOF - it hasn't undergone much testing yet, so look out for bugs / issues. Taqoz is a different environment from the forths available in 1998.
I would say use Mini-OOF when you haven't found an easy way of writing your code in ordinary forth.
So a state-machine is a good example (maybe!) in that all state machines have some of the same code in common; but then the number and nature of the 'states' varies with the state machine application. That maps nicely to Mini-OOF as:-
1. A base class STATEMC with methods START, STEP and STOP and variable NEXTSTATE to remember the method to call next time through
2. Class MYSTATEMC1, parent STATEMC class, with additional methods STATE1, STATE2, STATE3 where the actual work is done. Additional variables will probably be needed too
3. Class MYSTATEMC2, parent STATEMC class or maybe even parent MYSTATEMC1 if they are nearly identical in function .... and so on
Another example that is often mentioned is pixel based graphics: You want to handle lines, rectangles, circles etc. so each could be sibling classes They all need functions such as draw, erase, move, flash etc. and these would be the methods of the classes. So redrawing a screen-full would involve handling a list of objects and applying the draw method to each in turn. You don't care what type of object each is, Mini-OOF selects the right draw method for the object type for you.
I've upissued Mini-OOF - the words WITH and THIS were not cog-safe, so now any number of cogs can run mini-OOF objects simultaneously. The module now stores a long at address $1FF in LUT space - well clear of the L stack.
EDIT: I've had to revise this - now the 'current object' is stored on the L stack so that methods may call methods may call methods and the current object is saved and restored in the same nested fashion.