MiniOOF: la programmation Orientée Objet simple pour ESP32forth

publication: 24 août 2022 / mis à jour 24 août 2022

Read this page in english

Appel à collaboration

Vous développez des montages, simples ou complexes avec ESP32 et ESP32forth.

Partagez-les ici sur ce site.

ESP32forth ne pourra se développer qu'avec la collaboration active de toutes les bonnes volontés.

Vos montages peuvent aider d'autres développeurs.

Les montages des autres développeurs peuvent vous aider.

Pour proposer un article ou un montage, cliquez ici

Listing complet: Mini-OOF by Bernd Paysan

En préambule, voici quelques mots complétant ESP32forth et utilisés ensuite dans le code de miniOOF:

DEFINED? *MINI-OOF* [IF] forget *MINI-OOF* [THEN]  
: *MINI-OOF* ; 
 
\ Words missing from the forth system 
: 2+ 2 + ; 
 
\ 'Do nothing' placeholder - overwritten later with a deferred word 
: NOOP ; 
 
\ remove n chrs from the front of the counted byte block 
: /STRING ( addr1 cnt1 n -- addr2 cnt2 )  
  DUP >R -      \ reduce cnt1 
  SWAP R> +     \ increase start address 
  SWAP          \ cleanup 
 ; 
 
: cell-	 n1 -- n1-4 ) 
	4 - 
;  

Description détaillée de Mini-OOF

Les systèmes orientés objet avec liaison tardive utilisent généralement une approche "vtable": la première variable dans chaque objet est un pointeur vers une table, qui contient les méthodes en tant que pointeurs de fonction. Cette vtable peut également contenir d'autres informations.

So first, let's declare methods:

\ The object oriented extensions 
: METHOD  
    CREATE ( m v -- m' v ) 
        OVER ,              \ compile m 
        SWAP CELL+ SWAP     \ m' = m + cell			 
    DOES> ( ... O -- ... ) 
        @ OVER @ +          \ calculate the required method address from the object ref. 
        @ EXECUTE           \ read the xt of the method and execute it 
; 

Lors de la déclaration de méthode, le nombre de méthodes et de variables d'instance est sur la pile (en unités d'adresse). method crée une méthode et incrémente le numéro de méthode. Pour exécuter une méthode, il prend l'objet, récupère le pointeur vtable, ajoute le décalage, et exécute le xt qui y est stocké. Chaque méthode prend l'objet à partir duquel elle est invoquée comme top de paramètre de pile. La méthode elle-même devrait consommer cet objet.

Maintenant, nous devons également déclarer des variables d'instance:

: VAR ( m v size -- )  
    CREATE  
        OVER ,  \ compile v 
        +       ( m v+size ) 
    DOES> ( o -- addr ) 
        @ +     \ add the vla offset to the object ref to get the val address 
; 

Comme ci-dessus, un mot est créé avec le décalage actuel. Les variables d'instance peuvent avoir des tailles différentes (cellules, flottants, doubles, caractères), donc tout ce que nous faisons est de prendre la taille et ajoutez-la au décalage. Si votre machine a des restrictions d'alignement, mettez le bon alignement avant la variable, il ajustera la variable décalée. C'est pourquoi il se trouve en haut de la pile.

Nous avons besoin d'un point de départ (l'objet vide):

: CLASS ( class -- class methods vars ) 
    DUP  
    2@ SWAP \ read methods and instvars and copy to the stack  
  ; 

Maintenant, pour l'héritage, la vtable de l'objet parent doit être copiée, lorsqu'un nouveau, classe dérivée est déclarée. Cela donne toutes les méthodes de la classe mère, qui peuvent être cependant remplacées.

: END-CLASS  ( CLASS METHODtotalspace VARtotalspace "name" -- ) 
    CREATE      \ create the class entry in the dict. with the name that follows 
    HERE >R     \ remember the current compilation address - contains VARtotalspace 
    , DUP ,     \ compile VARtotalspace, then METHODtotalspace ( CLASS METHODtotalspace -- ) 
    2 CELLS ?DO \ if new methods have been defined in the class definition 
        ['] NOOP ,  \ compile a temporary NOOP for each method defined 
    1 CELLS +LOOP   ( CLASS -- ) 
    CELL+ DUP CELL+ R>  ( CLASS+4 CLASS+8 VARtotalspace -- ) 
    ROT         ( CLASS+8 VARtotalspace CLASS+4 -- ) 
    @           ( CLASS+8 VARtotalspace METHODtotalspace -- ) 
    2 CELLS     ( CLASS+8 VARtotalspace METHODtotalspace 8 -- ) 
    /STRING 
    CMOVE ;     \ copy across the XTs from the parent class 

La première ligne crée la vtable, initialisée avec noops. La deuxième ligne est la mécanisme d'héritage, il copie les xts de la vtable parent.

Nous n'avons toujours aucun moyen de définir de nouvelles méthodes, faisons-le maintenant :

: DEFINES ( xt class -- ) 
    '           \ find the XT of the method name in the input stream  
    >BODY @ + ! \ address [pfa]+class is set to XT, overwriting the NOOP    
;               \ in the class definition 

Pour allouer un nouvel objet, nous avons également besoin d'un mot:

: NEW ( class -- o ) 
    HERE            \ find the next unused code location 
    OVER @ ALLOT    \ read the total var space reqd. and allot that space 
    SWAP            ( here class ) 
    OVER !          \ store class at [here], leaving here on the stack as o 
; 

Et parfois, les classes dérivées veulent accéder à la méthode de l'objet parent. Il y a deux façons d'y parvenir avec cet OOF: premièrement, vous pouvez utiliser des mots nommés, et deuxièmement, vous pouvez rechercher la vtable de l'objet parent.

\ NB use this early binding word within a definition only,  
\ it doesn't work outside a definition 
: :: ( class "name" -- ) 
    ' >BODY @ + @ , 
; 

If all classes are derived from a base class with a method INIT, then this is useful to make INIT automatically run when an object is created

CREATE OBJECT 1 cells , 2 cells , 
 
OBJECT CLASS 
    method INIT 
END-CLASS INITOBJECT 
 
: NEW: ( ... o "name" -- ) 
    NEW DUP CONSTANT INIT 
; 

Further sub-Classes are created from INITOBJECT, each having INIT overrridden to suit that classes initialisation of VARs etc.

e.g. here's a class that requires one VAR initialising from a value on the stack:

\ INITOBJECT CLASS 
\   cell VAR myvar 
\ END-CLASS BABA 
\ :noname myvar ! ; BABA DEFINES INIT 
 
\ An object would be created as here, and myvar = 80 automatically 
 
\ 80 BABA NEW: MYBABA 

Rather than have the current object on the top of the data stack all the time, which gets in the way of input parameters - the following words store the current object at the very bottom of the data stack, making mini-oof compatible with the esp32forth multitasker. Each task has it's own stack so each task can store its own copy of the current object it is executing.

Set up one cell storage space for the current mini-oof object at the bottom of the data stack run this at the start of a program / start of each task.

: MINIOOF{	( -- ) 
    depth 0=    \ is the data stack empty? 
    IF 
        0       \ yes, so just put a placeholder on the stack for current object 
    ELSE 
        0       \ no 
        sp0 cell+ DUP cell+			 
        depth cells cell- 
        cmove   \ move all the data stack contents up by 4 addresses 
    THEN 
; 

Remove storage space for the current mini-oof object from the bottom of the data stack.

Run this at the end of a program / close down of each task.

: }MINIOOF	( -- ) 
    depth 1 =   \ Is the stack empty apart from 'current object'? 
    IF 
        DROP    \ Yes, so drop that 
    ELSE 
        \ No, remove 'current object' from underneath the stack contents 
        sp0 cell+ DUP cell+ SWAP     
        depth cells cell- 
        cmove> 
        DROP 
    THEN 
; 
 

: WITH	( obj -- )					\ store the current object
	sp0 cell+ !
;

: THIS	( -- obj )					\ read the current object
	sp0 cell+ @
;




On Wednesday, 20 July 2022 at 15:50:31 BST, Bob Edwards  wrote:


Here's the state machine example, with demo MAIN :-


\ State machine class using Mini-OOF ver 1 for ESP32forth - Bob Edwards July 2022
\ N.B. Requires Mini-OOF ver 3 to be loaded before loading this code

\ NB On entering each method, the address of the current object is top of the data stack
\ This must be removed by the method before exiting
\ You can see that it is often convenient to move that to the 'current object' location


DEFINED? *StateMC* [IF] forget *StateMC* [THEN] 
: *StateMC* ;

\ Word to create a prototype state - it's just a constant set to 0 for now 
\ later set to point to some code. So 0 indicates an unassigned or 'idle' state
: STATE
	0 ['] CONSTANT EXECUTE
; IMMEDIATE

\ store the action word in the state constant
: STATE!	( 'action 'state -- )
	>body !
;

\ State machine class SM
\ This is just a 'state program counter' and 'word launcher'
OBJECT CLASS
	cell VAR NEXTSTATE
	METHOD SMGOTO
	METHOD SMSTEP
END-CLASS SM

\ save state in the state machine 'progam counter'
: NEXTSTATE!				( state -- )
	THIS NEXTSTATE !
;

\ read the state machine 'program counter'
: NEXTSTATE@				( -- state )
	THIS NEXTSTATE @
;

\ Jump to 'state'
:noname WITH					( state -- )
	NEXTSTATE!
; SM DEFINES SMGOTO

\ Execute one state in the state machine
:noname WITH
	NEXTSTATE@
	DUP 0<> IF EXECUTE THEN	\ if the state has been assigned code, execute it
; SM DEFINES SMSTEP

\ End of class SM



\ We need some states for a state machine engine based on SM to work with so here they are:-

STATE STATE1
STATE STATE2
STATE STATE3

\ STATE1 to STATE3 need to do stuff, so we define that here
\ The start address of an anonymous word is stored in each STATE
\ For demo, each state displays it's identity and sets NEXTSTATE up for the next step
\ The states are set to run STATE1 -> STATE2 -> STATE3 -> STATE1 -> STATE2 ....
\ Obviously a real state machine would have more complex program flow than this
\ with conditionals that would select  one state or the other based on logic decisions

\ N.B. Each state must leave the data and return stack as it found them
:noname 
	." State 1 "
	STATE2 NEXTSTATE!			\ STATE1 unconditionally sets STATE2 to run next
; ' STATE1 STATE!
:noname
	." State 2 "
	STATE3 NEXTSTATE!			\ STATE2 unconditionally sets STATE3 to run next
; ' STATE2 STATE!
:noname
	." State 3 "
	STATE1 NEXTSTATE!			\ STATE3 unconditionally sets STATE1 to run next
; ' STATE3 STATE!

\ End of state definitions
\ The states are defined in this way, so that forward references are possible. All the states
\ are defined so that when their actions are defined we are free to jump to any state next 



\ this small demo runs SM1 starting at STATE3, SM2 starting at STATE1
\ The two state machines then run interleaved with each other until
\ pressing any key will stop them and take you back to the forth prompt
\ The program has been slowed down so the state changes are more easily read

SM NEW CONSTANT SM1
SM NEW CONSTANT SM2

: MAIN	( -- )
	MINIOOF{					\ Initialise the current object pointer at the bottom of the data stack
	STATE3 SM1 SMGOTO			\ We initialise SM1 to start at STATE3 
	STATE1 SM2 SMGOTO			\ and SM2 to start at STATE1
	BEGIN
		CR ." SM1 "
		SM1 SMSTEP				\ execute one state of SM1
		100 ms
		CR ." SM2 "
		SM2 SMSTEP				\ execute one step of SM2
		100 ms					\ and loop until
		KEY?					\ the user presses a key
	UNTIL
	}MINIOOF					\ remove the current object pointer from the bottom of the data stack
;



On Wednesday, 20 July 2022 at 15:49:48 BST, Bob Edwards  wrote:


Here's the Timer class and demo word MAIN :-

\ Periodic Timers using Mini-OOF ver 2 by Bob Edwards April 2022
\ this code allows multiple words to execute periodically, all with different time periods.
\ Run MAIN for a demo, which terminates on any key being pressed 

\ NB On entering each method, the address of the current object is top of the data stack
\ Mini-OOF expects this to be dropped from the data stack before exiting the method
\ You can see that it is often convenient to move the current object to the R stack
\ BUT the R stack must then be tidied up before exiting the method

DEFINED? *TIMERS* [IF] forget *TIMERS* [THEN] 
: *TIMERS* ;

\ TIMER class definition
OBJECT CLASS
	cell VAR STARTTIME
	cell VAR PERIOD
	cell VAR TCODE
	METHOD TSET
	METHOD TRUN
	METHOD TPRINT
END-CLASS TIMER

:noname >R 
	R@ PERIOD !									\ save the reqd period in ms
	R@ TCODE !									\ save the cfa of the word that will run periodically
	MS-TICKS R> STARTTIME !						\ save the current time since reset
; TIMER DEFINES TSET	( codetorun period -- ) \ initialises the TIMER

:noname >R
	MS-TICKS DUP								\ read the present time
	R@ STARTTIME @								\ read when this TIMER last ran
	-											\ calculate how long ago that is 
	R@ PERIOD @ >=								\ is it time to run the TCODE?
	IF
		R@ STARTTIME !							\ save the present time
		R> TCODE @ EXECUTE						\ run cfa stored in TCODE
	ELSE
		DROP R> DROP							\ else forget the present time
	THEN
; TIMER DEFINES TRUN	( -- )					\ run TCODE every PERIOD ms

:noname >R
	CR
	." STARTTIME = " R@ STARTTIME @ . CR
	." PERIOD = " R@ PERIOD @ . CR
	." TCODE = " R> TCODE @ . CR
; TIMER DEFINES TPRINT	( -- )					\ print timer variables for debug
\ end of TIMER class definition

\ Example application - 5 different tasks are started, all with different execution periods
\ Pressing any key will stop them and take you back to the forth prompt

TIMER NEW CONSTANT TIMER1
TIMER NEW CONSTANT TIMER2
TIMER NEW CONSTANT TIMER3
TIMER NEW CONSTANT TIMER4
TIMER NEW CONSTANT TIMER5

: HELLO1 ." Hi from HELLO1" CR ;
: HELLO2 ." HELLO2 here !" CR ;
: HELLO3 ." Bonjour, HELLO3 ici" CR ;
: HELLO4 ." Good day, Mate from HELLO4" CR ;
: HELLO5 ." How's it going? from HELLO5" CR ;

\ Print all timer variables
: .VARS	( -- )
	CR CR ." Timer1" CR
	TIMER1 TPRINT
	CR ." Timer2" CR
	TIMER2 TPRINT
	CR ." Timer3" CR
	TIMER3 TPRINT
	CR ." Timer4" CR
	TIMER4 TPRINT
	CR ." Timer5" CR
	TIMER5 TPRINT
;

: MAIN	( -- )									\ demo runs until a key is pressed
	CR
	['] HELLO1 2000 TIMER1 TSET
	['] HELLO2 450 TIMER2 TSET
	['] HELLO3 3500 TIMER3 TSET
	['] HELLO4 35000 TIMER4 TSET
	['] HELLO5 2500 TIMER5 TSET					\ all timer periods and actions defined
	0
	BEGIN
		1+
		TIMER1 TRUN
		TIMER2 TRUN
		TIMER3 TRUN
		TIMER4 TRUN
		TIMER5 TRUN								\ all timers repeatedly run
	KEY? UNTIL
	CR ." The five timers TRUN methods were each run " . ." times" CR
	.VARS										\ show each timer's data
;

 



On Wednesday, 20 July 2022 at 15:48:39 BST, Bob Edwards  wrote:


Here's the Timer class and a demo word MAIN:-



On Wednesday, 20 July 2022 at 15:47:35 BST, Bob Edwards  wrote:


Here's a simple example of using Mini-OOF:-

\ MINI-OOF simple demo - Bob Edwards July 2022

OBJECT CLASS
	cell VAR teeth
	cell VAR height
	METHOD SPEAK
	METHOD GREET
	METHOD WALK
	METHOD ADD.
END-CLASS PET

\ The code above defines a class in terms of data space and 'do nothing' methods
\ It can't be run - it's just a recipe for making any number of pets 
\ Notice VAR allocates data in units of bytes, so 'cell VAR' is a 32 bit variable here

:noname ." pet speaks" DROP	; PET DEFINES SPEAK
:noname ." pet greets" DROP	; PET DEFINES GREET
:noname ." pet walks" DROP	; PET DEFINES WALK
:noname  DROP + ." n1 + n2 = " . ; 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. : (WALK) ." pet walks" DROP	; ' (WALK) PET DEFINES WALK works just as well
\ notice each method is expected to drop the current object which is top of the data stack
\ in more useful methods, the object is used to access it's other methods and variables

\ now we define a CAT and DOG class derived from PET

PET CLASS
	METHOD  HAPPY	\ an extra method is defined, cats can do more than pets
END-CLASS CAT

:noname ." cat purrs" DROP ; CAT DEFINES HAPPY

\ cats override pets for these two methods
:noname ." cat says meow" DROP ; CAT DEFINES SPEAK	
:noname ." cat raises tail" DROP ; CAT DEFINES GREET

PET CLASS
END-CLASS DOG

\ dogs override pets for these two methods
:noname ." dog says wuff" DROP ; DOG DEFINES SPEAK	
:noname ." dog wags tail" DROP ; DOG DEFINES GREET

\ now we create a cat object called TIBBY and dog object called FIDO to work with
\ objects store actual data and execute methods

CAT NEW CONSTANT TIBBY
DOG NEW CONSTANT FIDO

\ Now we test storing and loading data in these two objects

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 @ .

\ Now we test running a few methods

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



On Wednesday, 20 July 2022 at 15:46:03 BST, Bob Edwards  wrote:


Hi BR,

I haven't stored the current version of Mini-OOF code anywhere on the internet, but thought maybe you'd like to publish it on your website. Here's the basic package. For a description of the tool, see Bernd's article at the website below:-

\ Mini-OOF by Bernd Paysan https://bernd-paysan.de/mini-oof.html
\ Adapted for ESP32Forth32 7.0.5.4 and onwards by Bob Edwards July 2022 ver 3
\ Mini-OOF offers no protection against a programming errors
\ ESP32forth multitasker compatible


DEFINED? *MINI-OOF* [IF] forget *MINI-OOF* [THEN] 
: *MINI-OOF* ;

\ Words missing from the forth system
: 2+ 2 + ;

\ 'Do nothing' placeholder - overwritten later with a deferred word
: NOOP ;

: /STRING ( addr1 cnt1 n -- addr2 cnt2 ) \ remove n chrs from the front of the counted byte block
  DUP >R -							\ reduce cnt1
  SWAP R> +							\ increase start address
  SWAP								\ cleanup
 ;

: cell-		( n1 -- n1-4 )
	4 -
; 
 
\ The object oriented extensions
 
: METHOD 
	CREATE ( m v -- m' v )
		OVER ,						\ compile m
		SWAP CELL+ SWAP				\ m' = m + cell			
	DOES> ( ... O -- ... )
		@ OVER @ +					\ calculate the required method address from the object ref.
		@ EXECUTE					\ read the xt of the method and execute it
;

	
: VAR ( m v size -- ) 
  CREATE 
	OVER ,							\ compile v
	+								( m v+size )
  DOES> ( o -- addr )
	@ +								\ add the vla offset to the object ref to get the val address
;

: CLASS ( class -- class methods vars )
  DUP 
  2@ SWAP  ;						\ read methods and instvars and copy to the stack 

: END-CLASS  ( CLASS METHODtotalspace VARtotalspace "name" -- )
	CREATE							\ create the class entry in the dict. with the name that follows
	HERE >R							\ remember the current compilation address - contains VARtotalspace
	, DUP , 						\ compile VARtotalspace, then METHODtotalspace ( CLASS METHODtotalspace -- )
	2 CELLS ?DO						\ if new methods have been defined in the class definition
		['] NOOP ,					\ compile a temporary NOOP for each method defined
	1 CELLS +LOOP					( CLASS -- )
	CELL+ DUP CELL+ R>				( CLASS+4 CLASS+8 VARtotalspace -- )
	ROT								( CLASS+8 VARtotalspace CLASS+4 -- )
	@								( CLASS+8 VARtotalspace METHODtotalspace -- )
	2 CELLS							( CLASS+8 VARtotalspace METHODtotalspace 8 -- )
	/STRING
	CMOVE ; 						\ copy across the XTs from the parent class

: DEFINES ( xt class -- )
  '									\ find the XT of the method name in the input stream 
  >BODY @ + !						\ address [pfa]+class is set to XT, overwriting the NOOP   
;									\ in the class definition

: NEW ( class -- o )
  HERE								\ find the next unused code location
  OVER @ ALLOT						\ read the total var space reqd. and allot that space
  SWAP								( here class )
  OVER !							\ store class at [here], leaving here on the stack as o
;

\ And sometimes derived classes want to access the method of the parent object.
\ There are two ways to achieve this with this OOF: first, you could use named words,
\ and second, you could look up the vtable of the parent object
\ NB use this early binding word within a definition only, it doesn't work outside a definition
: :: ( class "name" -- )
  ' >BODY @ + @ ,
;

CREATE OBJECT 1 cells , 2 cells ,

\ If all classes are derived from a base class with a method INIT, then this is useful to
\ make INIT automatically run when an object is created

OBJECT CLASS
	method INIT
END-CLASS INITOBJECT

: NEW: ( ... o "name" -- )
	NEW DUP CONSTANT INIT
;

\ Further sub-Classes are created from INITOBJECT, each having INIT overrridden to suit that classes
\ initialisation of VARs etc.

\ e.g. heres a class that requires one VAR initialising from a value on the stack

\ INITOBJECT CLASS
\	VAR myvar
\ END-CLASS BABA
\ :noname myvar ! ; BABA DEFINES INIT

\ An object would be created as here, and myvar = 80 automatically

\ 80 BABA NEW: MYBABA

\ To make working with the 'current object' easier ...

\ Rather than have the current object on the top of the data stack all the time, which
\ gets in the way of input parameters - the following words store the current object at the very bottom of
\ the data stack, making mini-oof compatible with the esp32forth multitasker. Each task has it's own stack
\ so each task can store its own copy of the current object it is executing 

\ set up one cell storage space for the current mini-oof object at the bottom of the data stack
\ run this at the start of a program / start of each task
: MINIOOF{	( -- )
	sp0 SP@ cell- =					\ is the data stack empty?
	IF
		0							\ yes, so just put a placeholder on the stack for current object
	ELSE
		0							\ no
		sp0 cell+ DUP cell+			
		depth cells cell-
		cmove						\ move all the data stack contents up by 4 addresses
	THEN
;

\ remove storage space for the current mini-oof object from the bottom of the data stack
\ run this at the end of a program / close down of each task
: }MINIOOF	( -- )
	depth 1 =
	IF
		DROP
	ELSE
		sp0 cell+ DUP cell+ SWAP
		depth cells cell-
		cmove>
		DROP
	THEN
;

: WITH	( obj -- )					\ store the current object
	sp0 cell+ !
;

: THIS	( -- obj )					\ read the current object
	sp0 cell+ @
;


    

Bernd PAYSAN / Bob EDWARDS - aug. 2022

Legal: site web personnel sans commerce / personal site without seling