Shop Learn
TAQOZ Reloaded v2.8 - Mini-OOF object oriented programming revisited — Parallax Forums

TAQOZ Reloaded v2.8 - Mini-OOF object oriented programming revisited

bob_g4bbybob_g4bby Posts: 311
edited 2022-04-17 13:13 in Forth

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.

Comments

  • @bob_g4bby said:

    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

  • bob_g4bbybob_g4bby Posts: 311
    edited 2022-04-05 09:10

    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.

  • bob_g4bbybob_g4bby Posts: 311
    edited 2022-04-17 13:13

    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.

Sign In or Register to comment.