Object Oriented Programming

A library for data structures and object oriented programming is available for StrongForth.f. It is mainly based on the C++ model of object oriented programming, providing similar features and using the same terminology. It fully supports polymorphism, encapsulation and inheritance. Objects are actually special data types that can be passed on the stack and that are consumed by member functions. Other important features and properties are:

Multiple class inheritance is not supported. Furthermore, all kinds of implicit data type conversions and default actions have been omitted. Implicit data type conversions are dangerous anyway, because they are somtimes ambiguous and can lead to unexpected results. Anyway, StrongForth's hierarchical data type system often makes type conversions obsolete, because words that expect items of a specific data type can generally be applied to all subtypes of it.

Object oriented programming can be made available by first including the Memory-Allocation word set, and then including the object oriented programming library:

" memory.sf" INCLUDE
" OOP.sf" INCLUDE

Data structures are classes without dedicated member functions. They are actually simplified kinds of classes. That's why we'll start with data structures as an introduction to the object oriented programming library.

Structures

Data structures are a pretty common feature of high-level programming languages. A data structure consists of a set of data members that can be accessed in predefined ways. For example, consider a data structure that describes a rectangle on the screen. A very simple version might consist of its width and its height, plus the coordinates of its lower left corner.

There are numerous ways to implement data structures in ANS Forth. In StrongForth, the data type system makes the implementation a little bit more challenging, because each structure and each of its members has to have a data type. As a reward, StrongForth's structures are type-save. You can only store data of the specified type in a data member, and you cannot access members that do not exist in a structure, unless you use an explicit type cast. Furthermore, there are no name conflicts between members of different structures. You can overload members as often as you like without any risk of accessing a member of the wrong structure.

Here's a first example of a simple structure definition and how it can be used:

DT STRUCTURE PROCREATES RECTANGLE

STRUCT RECTANGLE
  NULL SIGNED MEMBER PX
  NULL SIGNED MEMBER PY
  NULL UNSIGNED MEMBER WIDTH
  NULL UNSIGNED MEMBER HEIGHT
ENDSTRUCT

NEW RECTANGLE CONSTANT RECT1
+100 RECT1 PX !
+150 RECT1 PY !
  40 RECT1 WIDTH !
  25 RECT1 HEIGHT !

Data type STRUCTURE is a direct subtype of data type SINGLE. Each new type of structure has its own data type that has to be directly or indirectly derived from STRUCTURE. An extended version of PROCREATES reserves memory space for specific attributes of data types that are derived from STRUCTURE. The fact that each kind of structure is a unique data type enables the interpreter and the compiler to perform the necessary type checks and to ensure that only data members that are actually included in a given structure can be accessed.

Once a new data type has been created, the data members can be defined between STRUCT and ENDSTRUCT. STRUCT checks whether the given data type was really derived from data type STRUCTURE and leaves an item of data type STRUCT-SIZE on the stack, which counts the size of the structure bits. It is incremented each time a new data member is added to the structure. At the end of the structure definition, ENDSTRUCT stores the accumulated size of the data structure as an attribute of the structure's data type. The data type of the currently defined structure (RECTANGLE) is stored in the global variable THIS-CLASS to be readily available whenever it's needed.

The creation of a new data type for the structure is decoupled from the structure definition. I. e., you first have to create a new data type that is directly or indirectly derived from data type STRUCTURE, and then you can specify the members of the structure. This decoupling makes it possible to define members of the structure data type itself, for example if a structure shall contain a pointer to another structure of the same type. Furthermore, cross references between two structures can be implemented easily, like in this example:

DT STRUCTURE PROCREATES STRUCT-A
DT STRUCTURE PROCREATES STRUCT-B

STRUCT STRUCT-A
  NULL STRUCT-B MEMBER SB
  \ ... \
ENDSTRUCT

STRUCT STRUCT-B
  NULL STRUCT-A MEMBER SA
  \ ... \
ENDSTRUCT

MEMBER is a defining word that defines the data members of the structure. In the above example, the data members are PX, PY, WIDTH and HEIGHT:

PX ( RECTANGLE -- ADDRESS -> SIGNED )
PY ( RECTANGLE -- ADDRESS -> SIGNED )
WIDTH ( RECTANGLE -- ADDRESS -> UNSIGNED )
HEIGHT ( RECTANGLE -- ADDRESS -> UNSIGNED )

MEMBER expects the current size of the structure in bits, which is originally supplied by STRUCT, plus a dummy parameter that has the data type of the new member. A member definition looks like an ordinary variable definition. But since the data member is not being initialized, a null item can be provided as a sample for the data type. The execution semantic of a data member is to return its address within a specific instance of the structure. StrongForth does not provide defining words for data members that behave like values.

Structure RECT1 of the example may thus be used as follows:

40 RECT1 .S UNSIGNED RECTANGLE  OK
WIDTH .S ! UNSIGNED ADDRESS -> UNSIGNED  OK
25 RECT1 HEIGHT !  OK
RECT1 WIDTH @ . 40  OK

NEW allocates dynamic memory for a structure of a given type. The new instance of the structure may be stored as a constant, as in this example. PX, PY, WIDTH and HEIGHT can then be used to access the data members of the structure.

Of course, data members need not be all single-cell items. It is also possible to define double-cell items and character size items as members, or even arrays of items with the same data type. Here's a more comprehensive example:

DT STRUCTURE PROCREATES HEADER  OK
STRUCT HEADER  OK
  NULL UNSIGNED CMEMBER WLENGTH  OK
  NULL CHARACTER 31 CMEMBERS WNAME ALIGNED  OK
  NULL ADDRESS MEMBER WLINK  OK
  NULL LOGICAL MEMBER ATTRIBUTES  OK
  NULL TOKEN MEMBER CODEFIELD  OK
  NULL DATA-TYPE 8 MEMBERS PARAMETERS  OK
ENDSTRUCT  OK
NEW HEADER CONSTANT WORD1  OK
" TEST" DUP WORD1 WLENGTH .S ! CADDRESS -> CHARACTER UNSIGNED UNSIGNED CADDRESS -> UNSIGNED  OK
WORD1 WNAME SWAP .S MOVE CADDRESS -> CHARACTER CADDRESS -> CHARACTER UNSIGNED  OK
DICT-HERE WORD1 WLINK .S ! ADDRESS ADDRESS -> ADDRESS  OK
'HOST 2/ WORD1 CODEFIELD .S ! TOKEN ADDRESS -> TOKEN  OK
2 CAST LOGICAL WORD1 ATTRIBUTES .S ! LOGICAL ADDRESS -> LOGICAL  OK
DT SIGNED DT-INPUT OR WORD1 PARAMETERS .S ! DATA-TYPE ADDRESS -> DATA-TYPE  OK
DT SIGNED DT-OUTPUT OR 1 OFFSET+ WORD1 PARAMETERS 1+ .S ! DATA-TYPE ADDRESS -> DATA-TYPE  OK
WORD1 WNAME WORD1 WLENGTH @ .S CADDRESS -> CHARACTER UNSIGNED  OK
TYPE TEST OK

CMEMBER defines a character size data member, whose address is of data type CADDRESS -> .... Of course, defining character size members can lead to the following members becoming unaligned. ALIGNED is used after the second character size member to re-align the offset. Since the already existing version of ALIGNED only works for addresses, an overloaded version for items of data type STRUCT-SIZE has to be provided:

ALIGNED ( STRUCT-SIZE -- 1ST )

Arrays of data members can easily be defined with MEMBERS, CMEMBERS etc. These defining words expect an additional size parameter on the stack. Their runtime semantics is to return the address of the first array element. Here's a list of all defining words for data members:

MEMBER ( STRUCT-SIZE SINGLE -- 1ST ) 
MEMBER ( STRUCT-SIZE DOUBLE -- 1ST ) 
CMEMBER ( STRUCT-SIZE SINGLE -- 1ST ) 

MEMBERS ( STRUCT-SIZE SINGLE UNSIGNED -- 1ST ) 
MEMBERS ( STRUCT-SIZE DOUBLE UNSIGNED -- 1ST ) 
CMEMBERS ( STRUCT-SIZE SINGLE UNSIGNED -- 1ST )

In connection with structures and classes, overloading becomes once more a very useful feature, because the names of data members can be reused for different structures and classes. Since the input parameter of member definitions like PX has the data type of the structure it belongs to, data members from different structures do never interfere, even if they have the same name. The interpreter and the compiler are always able to chose the correct version.

New instances of structures can be dynamically allocated with NEW. To free the dynamic memory space occupied by a structure, you should use DELETE:

RECT1 DELETE  OK

If you prefer to allocate static memory space or to use any other place for the structure's data members, you simply provide NEW with the address as an additional parameter of data type ADDRESS or CADDRESS:

HERE DT RECTANGLE SIZE-STRUCTURE ALLOT .S ADDRESS  OK
NEW RECTANGLE CONSTANT RECT2  OK

SIZE-STRUCTURE determines the size of a structure in address units. Just note that SIZE-STRUCTURE expects the data type of a structure and not one of its instances. Of course, structures that are not allocated in the dynamic memory space may not be deleted. Applying DELETE to a statically allocated structure will cause an ambiguous condition and can lead to a system crash.

Usually structures are direct children of data type STRUCTURE. But since in StrongForth structures are just stripped-down classes, it is not prohibited to derive a structure from a child or grandchild of STRUCTURE. What happens if you do that? Well, the new structure inherits the data members from its parent and allows adding additional members. The new structure is just an extension of the old one:

DT RECTANGLE SIZE-STRUCTURE . 16  OK
DT RECTANGLE PROCREATES SCREEN-RECTANGLE  OK
STRUCT SCREEN-RECTANGLE  OK
  NULL FLAG MEMBER VISIBLE  OK
ENDSTRUCT  OK
DT SCREEN-RECTANGLE SIZE-STRUCTURE . 20  OK
NEW SCREEN-RECTANGLE CONSTANT SRECT  OK
SRECT PX . 1525632  OK
SRECT PY . 1525636  OK
SRECT WIDTH . 1525640  OK
SRECT HEIGHT . 1525644  OK
SRECT VISIBLE . 1525648  OK
RECT2 VISIBLE .
RECT2 VISIBLE ? undefined word
RECTANGLE

VISIBLE expects an item of data type SCREEN-RECTANGLE on the stack. Since SCREEN-RECTANGLE is a child of RECTANGLE, VISIBLE cannot be applied to a RECTANGLE, but PX, PY, WIDTH and HEIGHT can be applied to a SCREEN-RECTANGLE.

Note that a parent structure always has to be defined before its children. Otherwise, the definitions of a child structure couldn't determine the members it inherits from its parent. Of course, this restriction applies to classes as well. Note also that it is possible to redefine a structure (and a class). If an exception is thrown during a structure definition you may thus just give it a second try without the necessity to create a new data type for the structure.

Classes

The definition of a class looks quite similar to the definition of a structure. Classes are data types that are directly or indirectly derived from data type OBJECT, which is in turn a child of SINGLE. The class definition is enclosed between the words CLASS and ENDCLASS. Additionally, the word BODY divides the class definition in two parts The first part, between CLASS and BODY, will be described later in this chapter. Here's a first example that only uses the second part:

DT OBJECT PROCREATES POINT

CLASS POINT
  \ first part is left empty
BODY
  \ second part starts here
  +0 MEMBER PX
  +0 MEMBER PY
  : SET-POINT ( SIGNED SIGNED POINT -- )
    LOCALS| THIS | THIS PY ! THIS PX ! ;
  : GET-POINT ( POINT -- SIGNED SIGNED )
    LOCALS| THIS | THIS PX @ THIS PY @ ;
  : POINT ( POINT -- 1ST )
    LOCALS| THIS | +0 +0 THIS SET-POINT THIS ;
ENDCLASS

The class definition of POINT contains two data members PX and PY of data type SIGNED, plus three member words. The defining words for data members are the same as those you already know from structure definitions. Just as with structures, the data members are not automatically initialized. Note that PX and PY are overloaded versions of two of the data members of structure RECTANGLE in the example of the previous chapter. StrongForth's interpreter and compiler have no difficulty at all to always select the correct version, because the data type of the structure or the class of the object they are applied to is known at compile time. The same holds true for overloading data members and member words of different classes.

The three member words within the class definition are ordinary colon definitions. The fact that their last input parameter is always an object of the class makes them member words. To make the object available throughout the definitions, it is generally assigned to a local named THIS. Exactly like structures, objects can be allocated with NEW and deallocated with DELETE:

NEW POINT CONSTANT P1  OK
P1 GET-POINT . . 0 0  OK
+5 -7 P1 SET-POINT  OK
P1 GET-POINT . . -7 5  OK
P1 DELETE  OK

Wait a moment. Why does the first GET-POINT return zero for both data members? They are supposed not to be automatically initialized! That's true. The initialization happens program controlled by implicitly executing the third member word POINT. NEW does not only allocate the data members of an object; it also evaluates a word with the same name as the class. This word is called a constructor of the class, and it usually contains code that initializes the data members. It is possible to provide multiple overloaded constructors with different sets of parameters, for example:

: POINT ( SIGNED SIGNED POINT -- 3RD )
  LOCALS| THIS | THIS SET-POINT THIS ;

Now, two different kinds of initializations are possible:

NEW POINT DUP GET-POINT . . DELETE 0 0  OK
+12 +40 NEW POINT DUP GET-POINT . . DELETE 40 12  OK

A constructor always has exactly one output parameter, which is an unchanged copy of the object that is provided as the last input parameter. Note that NEW requires the existence of a constructor. Without a constructor, it is not possible to create an object of a class.

The size of an object in address units can be determined from its class with SIZE-OBJECT:

DT POINT SIZE-OBJECT . 12  OK

12 address units? Since POINT has only two single cell members and one cell occupies 4 address units, shouldn't it rather be 8? Objects actually contain an additional cell for a pointer to the so-called virtual member table, which contains runtime type information of the object. This will be elaborated in detail in the section about virtual members. However, since the virtual member table also contains the size of objects of the class, it is possible to determine the object size not only from its class, but also from the object itself. This is not possible for structures, because structures do not have virtual member tables:

NEW POINT DUP SIZE . DELETE 2  OK

SIZE for items of data type OBJECT returns the size in cells of the object's data members. Based on SIZE, two words have been defined that can be applied to all objects:

: COPY ( OBJECT 1ST -- )
  OVER SIZE OVER SIZE MIN
  ROT CAST ADDRESS -> SINGLE 1+ ROT CAST ADDRESS -> SINGLE 1+
  ROT MOVE ;

: ERASE ( OBJECT -- )
  DUP CAST ADDRESS -> SINGLE 1+ SWAP SIZE ERASE ;

COPY copies the data members of an object to the data members of another object of the same class. This is what is called in C++ memberwise initialization. However, note that something like default memberwise initialization does not exist in StrongForth. All initialization has to be done explicitly. For specific objects, COPY can be overloaded if memberwise initialization is not desired. Since in most cases these overloaded versions require direct access to the data members, they usually have to be made member words.

ERASE initializes all data members of an object with zero. Using ERASE, the first constructor of the POINT class can be simplified:

: POINT ( POINT -- 1ST )
  DUP ERASE ;

The definitions of COPY and ERASE reveal an implementation detail of objects. The phrase CAST ADDRESS -> SINGLE 1+ shows that an item of data type OBJECT is nothing else but a pointer to an address one cell below the first data member. The cell it actually points to contains the pointer to the virtual member table:

virtual table pointer
PX
PY

THIS Object

All data members and member words have a specific object of their class as the last input parameter. As the definition of the POINT class demonstrates, it is often convenient to have this object available as a local within the definition of a member word. By convention, this local is called THIS, and creating this local is usually the first action of member words. The phrase LOCALS| THIS | can be replaced by the immediate word >THIS, which does exactly the same thing. Since the ANS Forth host system does not generally permit multiple occurences of LOCALS| ... |, using >THIS and LOCALS| within the definition of the same member word might cause an exception being thrown. Instead of

: COPY ( OBJECT 1ST -- )
  >THIS LOCALS| FROM |
  FROM CAST ADDRESS -> SINGLE 1+ 
  THIS CAST ADDRESS -> SINGLE 1+
  FROM SIZE THIS SIZE MIN MOVE ;

you should rather write

: COPY ( OBJECT 1ST -- )
  LOCALS| THIS FROM |
  FROM CAST ADDRESS -> SINGLE 1+ 
  THIS CAST ADDRESS -> SINGLE 1+
  FROM SIZE THIS SIZE MIN MOVE ;

In the member word definitions of the POINT class, THIS is used quite often. Whenever a data member or another member word is used, it has to be preceeded by a reference to the THIS object. Wouldn't it be nice if the compiler automatically inserted THIS whenever a data member or a member word of the same class is used? Of course, it should only do so if an object of the class type is not already on the stack, because in some cases the data member or the member word belongs to a different object of the class type or even to an object of a different class. Such a feature really exists! It is actually the default for all data members defined with MEMBER, CMEMBER, etc. Member words that are compiled with :MEMBER instead of : also compile an implicit THIS if an object of the THIS class is not already on the data stack. The definition of the POINT class can now be written shorter:

DT OBJECT PROCREATES POINT

CLASS POINT
BODY
  +0 MEMBER PX
  +0 MEMBER PY
  :MEMBER SET-POINT ( SIGNED SIGNED POINT -- )
    >THIS PY ! PX ! ;
  :MEMBER GET-POINT ( POINT -- SIGNED SIGNED )
    >THIS PX @ PY @ ;
  :MEMBER POINT ( POINT -- 1ST )
    >THIS +0 +0 SET-POINT THIS ;
ENDCLASS

The Automatic THIS feature works only within class definitions, because that's where almost all usages of data members and own member words refer to THIS. It is important to understand how this feature works, because it can lead to ambiguities if not used with care. Let's investigate what happens once the compiler parses PY in the definition of SET-POINT. At this point, the compiler data type heap consists of two times data type SIGNED. The attempt to find PY in the dictionary fails, because PY has an object of data type POINT as its only input parameter. But the search continues. CLASS actually appends a special word list called AUTOTHIS to the end of the search order. This word list is only searched when the search in all other word lists of the search order failed. AUTOTHIS contains an immediate word PY with no parameters, that was created by the previous definition of PY with MEMBER. This immediate word temporarily removes the AUTOTHIS word list from the search order, then evaluates THIS PY, and finally restores the search order. Temporarily removing the AUTOTHIS word list from the search order is necessary in order to avoid recursive executions of the immediate word if inserting THIS doesn't help. But in this case, evaluating THIS results in SIGNED SIGNED POINT on the compiler data type heap, and the subsequent search of PY is successful. The same thing happens with PX in the definition of SET-POINT.

:MEMBER and all defining words for data members actually create two definitions: the proper definition in the current compilation word list, and an immediate word with the same name in the AUTOTHIS word list. Note that the Automatic THIS feature works only after a local with the name THIS has been defined.

The defining word that defines the immediate word is called AUTOTHIS, just like the word list. It parses the input source for the name of the word to be defined, and then skips back in the input source specification, so that the name can be parsed once more. With AUTOTHIS, The definition of :MEMBER becomes pretty simple:

: :MEMBER ( OBJ-SIZE -- 1ST COLON-DEFINITION )
  AUTOTHIS : ;

The two words that add and remove the AUTOTHIS word list to and from the search order might be useful at other places, because they work with other word lists as well:

WORDS APPEND-WORDLIST
APPEND-WORDLIST ( WID -- )  OK
WORDS STRIP-WORDLIST
STRIP-WORDLIST ( -- )  OK
ORDER
CURRENT: FORTH
CONTEXT: FORTH  OK
ENVIRONMENT-WORDLIST APPEND-WORDLIST ORDER
CURRENT: FORTH
CONTEXT: FORTH ENVIRONMENT  OK
STRIP-WORDLIST ORDER
CURRENT: FORTH
CONTEXT: FORTH  OK

Note that the Automatic THIS feature does not work with RECURSE. The reason is that RECURSE does not actually perform a dictionary search. It just tries to compile the current definition and expects that its parameters are on the stack. Recursive member words generally require an explicit THIS before the RECURSE.

Encapsulation

Encapsulation is one of the major properties of object oriented programming. It means that classes hide the details of their internal data representation by just providing access to a number of interface member words that restrict the access to internal data. The internal representation of the POINT class is not encapsulated, because you can freely access it's data members:

NEW POINT CONSTANT POINT3  OK
-20 POINT3 PX !  OK
POINT3 GET-POINT . . 0 -20  OK

Like C++, StrongForth has three levels of information hiding:

Note that the three levels can be applied to both data members and member words. Usually, all data members are either private or protected, but it is often useful also to restict access to member words that are supposed to be used only internally to the class.

Access to data members and member words can be restricted by defining them in the PRIVATE or PROTECTED word lists. Each class has its own instances of these two word lists, and it is generally not possible to access them from outside the class definition. For example, we can make the data members of the POINT class private:

DT OBJECT PROCREATES POINT

CLASS POINT
BODY
  ALSO PRIVATE DEFINITIONS
  +0 MEMBER PX
  +0 MEMBER PY
  ALSO FORTH DEFINITIONS PREVIOUS
  :MEMBER SET-POINT ( SIGNED SIGNED POINT -- )
    >THIS PY ! PX ! ;
  :MEMBER GET-POINT ( POINT -- SIGNED SIGNED )
    >THIS PX @ PY @ ;
  :MEMBER POINT ( POINT -- 1ST )
    >THIS +0 +0 SET-POINT THIS ;
ENDCLASS

To be able to access the two data members within the class definition, the PRIVATE word list has to be in the search order. CLASS saves the search order and the current compilation word list at the beginning of the class definition, and ENDCLASS restores both. After ENDCLASS, the PRIVATE word list of the POINT class is inaccessible, which means that all access to the data members is restricted to using the public member words:

NEW POINT CONSTANT POINT4  OK
+20 POINT4 PX !
+20 POINT4 PX ? undefined word
SIGNED POINT
POINT4 GET-POINT . . 0 0  OK
+20 +0 POINT4 SET-POINT  OK
POINT4 GET-POINT . . 0 20  OK

In some cases, it is necessary for one class to access the data members of another class. Does this mean you have to make the data members public? No, not necessarily. StrongForth supports the same mechanism as C++. A class that is a friend of another class can access its private and protected members, just as if these members were defined in the friend class itself. Within the definition of a class A, a list of classes B1, B2, ..., Bn can be granted access to the private and protected members of class A with the phrase:

FRIENDS( class-B1 class-B2 ... class-Bn )

Within each of the classes B1, B2, ..., Bn, you can then add the combined PRIVATE and PROTECTED word list of class A to the search order with the phrase

ALSO ACCESS class-A

ACCESS class-A has a similar semantic like a vocabulary. class-A, class-B1, class-B2, ..., class-Bn are the actual class names. Note that only classes can be declared friends of a class. It is not possible, like in C++, to declare a word a friend to a class.

A typical application that takes advantage of the friendship mechanism is an iterator class. An iterator is a class that provides iterative access to some items that belong to another class. The iterator contains a member word that returns the next item of the other class each time it is executed. In the following example, an iterator is defined for a (simplified) STRING class. The member word NEXT of the iterator returns one character of the string after the other, starting with the first one:

DT OBJECT PROCREATES STRING
DT OBJECT PROCREATES STRING-ITERATOR

CLASS STRING
BODY
  FRIENDS( STRING-ITERATOR )
  ALSO PROTECTED DEFINITIONS
  NULL UNSIGNED MEMBER LEN
  NULL CADDRESS -> CHARACTER MEMBER BUF
  ALSO FORTH DEFINITIONS PREVIOUS
  :MEMBER STRING ( CADDRESS -> CHARACTER UNSIGNED STRING -- 4 TH )
    >THIS DUP LEN ! CALLOCATE THROW -> CHARACTER BUF !
    BUF @ LEN @ MOVE THIS ;
  :MEMBER . ( STRING -- )
    >THIS THIS
    IF LEN @
       IF BUF @ LEN @ TYPE
       ELSE ." <empty>"
       THEN
    ELSE ." <null>" 
    THEN SPACE ;
  :MEMBER LENGTH ( STRING -- UNSIGNED )
    LEN @ ;
ENDCLASS

CLASS STRING-ITERATOR
BODY
  ALSO ACCESS STRING
  ALSO PROTECTED DEFINITIONS
  NULL STRING MEMBER STRI
  NULL UNSIGNED MEMBER INDX
  ALSO FORTH DEFINITIONS PREVIOUS
  :MEMBER STRING-ITERATOR ( STRING STRING-ITERATOR -- 2ND )
    >THIS STRI ! 0 INDX ! THIS ;
  :MEMBER NEXT ( STRING-ITERATOR -- CHARACTER )
    >THIS INDX @ STRI @ LENGTH <
    IF STRI @ BUF @ INDX @ + @ 1 INDX +!
    ELSE NULL CHARACTER
    THEN ;
ENDCLASS

Class STRING-ITERATOR is a friend of class STRING, because it needs access to STRING's data members. Here's an example of how the two classes may be used together:

" abc" NEW STRING CONSTANT STRING1  OK
" " NEW STRING CONSTANT STRING2  OK
STRING1 . abc  OK
STRING2 . <empty>  OK
NULL STRING . <null>  OK
STRING1 LENGTH . 3  OK
STRING2 LENGTH . 0  OK
STRING1 NEW STRING-ITERATOR CONSTANT SI1  OK
SI1 NEXT . a OK
SI1 NEXT . b OK
SI1 NEXT . c OK
SI1 NEXT CAST INTEGER . 0  OK
SI1 DELETE  OK

After the iterator has exceeded the end of the string, it is useless and can be deleted.

StrongForth does not allow class definitions to be nested. In the above example, the class definition of STRING-ITERATOR cannot be enclosed within the class definition of STRING, although this might look like a reasonable approach.

The class defnitions of STRING and STRING-ITERATOR contain, just like the last version of the class definition of POINT, only data members defined by MEMBER and CMEMBER, and member words defined by :MEMBER. But you've seen in the first version of POINT, that it is also possible to define member words as simple colon definitions. Now, what happens if you define words with VARIABLE, CONSTANT and VALUE? These words obviously define variables, constants and values that are not data members, and that are not even related to the class they are defined in. Nevertheless, it can make sense to use these defining words within a class definition, if they are added to the PRIVATE or PROTECTED word lists. Private variables, constants and values are only available to the members of the class and to friends of the class. and their names can be reused in other classes. The following extension of the POINT class contains both a private variable and a private constant:

DT OBJECT PROCREATES POINT

CLASS POINT
BODY
  ALSO PRIVATE DEFINITIONS
  +0 MEMBER PX
  +0 MEMBER PY
  0 MEMBER PINDEX
  CHAR P CONSTANT ID
  0 VARIABLE COUNT
  ALSO FORTH DEFINITIONS PREVIOUS
  :MEMBER SET-POINT ( SIGNED SIGNED POINT -- )
    >THIS PY ! PX ! ;
  :MEMBER GET-POINT ( POINT -- SIGNED SIGNED )
    >THIS PX @ PY @ ;
  :MEMBER POINT ( POINT -- 1ST )
    >THIS +0 +0 SET-POINT 1 COUNT +! COUNT @ PINDEX ! THIS ;
  :MEMBER .NAME ( POINT -- )
    ID . PINDEX @ . ;
ENDCLASS

Each object of class POINT is assigned an index PINDEX. In order to make sure that the index is unique, the index of a new POINT object is taken from a non-member variable COUNT that is incremented by the constructor. .NAME is a (public) member word that displays the index together with a one-letter identifier that is specific for points. The identifier is defined as a constant in the PRIVATE word list. Here's an example of how this version of POINT can be used:

NEW POINT CONSTANT FIRST  OK
+3 -8 FIRST SET-POINT  OK
NEW POINT CONSTANT SECOND  OK
FIRST .NAME FIRST GET-POINT SWAP . . P1 3 -8  OK
SECOND .NAME P2  OK

Colon definitions defined by : can in some cases be used as a replacement for what is called in C++ a static member of the class, because they don't need to be bound to a specific object. The necessity to include those words in the class definition might arise from the fact that they access private or protected non-member variables, constants and values. If you need to overload colon definitions, you can add an object of the respective class type as a dummy input parameter. However, please note that such colon definitions within class definitions are actually not the same as static members in C++ classes.

Similarly, private constants in StrongForth must not be confused with const members in C++. It is not possible to reference a constant through an object of the class the constant is defined in. Furthermore, there is nothing like const classes or const member words that are not allowed to change the data members. Of course, you can define a class whose member words (except for the constructors) do not change the data members, but there are no means for the compiler to ensure that a class definition really does not contain non-constant member words.

Inheritance And Binding

The concept of inheritance is a fundamental technique of object oriented programming. You already got a quick glance at inheritance at the end of the section about structures. Generally, a class whose data type is a direct or indirect subtype of another class inherits the members from the other class. It's the same mechanism as for ordinary data types. For example, DUP is a word that expects an item of data type SINGLE on the stacks, but it can also be applied to all direct or indirect subtypes of SINGLE. So, let's design a simple class hierarchy that will serve as an example:

DT OBJECT PROCREATES MEDIUM
DT MEDIUM PROCREATES PAPER-MEDIUM
DT MEDIUM PROCREATES ELECTRONIC-MEDIUM
DT PAPER-MEDIUM PROCREATES BOOK
DT PAPER-MEDIUM PROCREATES JOURNAL
DT ELECTRONIC-MEDIUM PROCREATES ANALOG-MEDIUM
DT ELECTRONIC-MEDIUM PROCREATES DIGITAL-MEDIUM
DT DIGITAL-MEDIUM PROCREATES CD
DT DIGITAL-MEDIUM PROCREATES DVD
\ ...

Class MEDIUM is at the top of the class hierarchy. Each medium is supposed to have a title and a price. Here's the corresponding class definition:

CLASS MEDIUM
BODY
  ALSO PROTECTED DEFINITIONS
  NULL STRING MEMBER TITLE
  NULL UNSIGNED MEMBER PRICE \ in cent
  FORTH DEFINITIONS PROTECTED
  :MEMBER MEDIUM ( CADDRESS -> CHARACTER UNSIGNED MEDIUM -- 4 TH )
    >THIS NEW STRING TITLE ! 0 PRICE ! THIS ;
  :MEMBER SET-PRICE ( UNSIGNED MEDIUM -- )
    PRICE ! ;
  :MEMBER GET-PRICE ( MEDIUM -- UNSIGNED )
    PRICE @ ;
  :MEMBER SALE ( MEDIUM -- )
    >THIS PRICE @ 8 10 */ PRICE ! ;
  :MEMBER .PRICE ( MEDIUM -- )
    PRICE @ 100 /MOD 0 .R [CHAR] . . S>D <# # # #> TYPE ;
  :MEMBER . ( MEDIUM -- )
    >THIS TITLE @ . ." ($" .PRICE ." )" ;
ENDCLASS

The data members are protected, whereas the member words including the constructors are public definitions that can be accessed from outside of the class definition. Remember that protected members can still be accessed within the definitions of derived classes.

Since data type PAPER-MEDIUM is a child of data type MEDIUM, it inherits all of MEDIUM's data members and member words. Additionally, it defines the number of pages as a data member and a member word that returns the number of pages. Its constructor reuses the constructor of MEDIUM and additionally initializes the number of pages:

CLASS PAPER-MEDIUM
BODY
  ALSO PROTECTED DEFINITIONS
  NULL UNSIGNED MEMBER #PAGES
  FORTH DEFINITIONS PROTECTED
  :MEMBER PAPER-MEDIUM ( CADDRESS -> CHARACTER UNSIGNED UNSIGNED 
       PAPER-MEDIUM -- 5 TH )
    >THIS #PAGES ! MEDIUM ;
  :MEMBER PAGES ( PAPER-MEDIUM -- UNSIGNED )
    #PAGES @ ;
  :MEMBER . ( PAPER-MEDIUM -- )
    DUP . CR PAGES . ." pages" ;
ENDCLASS

Finally, here are the definitions of the BOOK and JORUNAL classes, which are both derived from PAPER-MEDIUM. The other classes (ELECTRONIC-MEDIUM and its derived classes) are not required for this example.

CLASS BOOK
BODY
  ALSO PROTECTED DEFINITIONS
  NULL STRING MEMBER AUTHOR
  FORTH DEFINITIONS PROTECTED
  :MEMBER BOOK ( CADDRESS -> CHARACTER UNSIGNED UNSIGNED BOOK -- 5 TH )
    >THIS NULL STRING AUTHOR ! PAPER-MEDIUM ;
  :MEMBER SET-AUTHOR ( CADDRESS -> CHARACTER UNSIGNED BOOK -- )
    >THIS NEW STRING AUTHOR ! ;
  :MEMBER GET-AUTHOR ( BOOK -- STRING )
    AUTHOR @ ;
  :MEMBER . ( BOOK -- )
    DUP GET-AUTHOR . ." - " . ;
ENDCLASS

CLASS JOURNAL
BODY
  ALSO PROTECTED DEFINITIONS
  NULL UNSIGNED MEMBER YEAR
  NULL UNSIGNED MEMBER MONTH
  FORTH DEFINITIONS PROTECTED
  :MEMBER JOURNAL ( CADDRESS -> CHARACTER UNSIGNED UNSIGNED UNSIGNED 
       UNSIGNED JOURNAL -- 7 TH )
    >THIS YEAR ! MONTH ! PAPER-MEDIUM ;
  :MEMBER SALE ( JOURNAL -- )
    100 SWAP PRICE ! ;
  :MEMBER .EDITION ( JOURNAL -- )
    DUP MONTH @ 0 .R [CHAR] / . YEAR @ . ;
  :MEMBER . ( JOURNAL -- )
    DUP . CR ." Edition " .EDITION ;
ENDCLASS

Let's now create an object of each of these four classes. The two classes at the bottom of the class hierarchy (BOOK and JOURNAL) inherit all public and protected members from their common parent PAPER-MEDIUM and their grandparent MEDIUM.

" No name" NEW MEDIUM CONSTANT MEDIUM1  OK
MEDIUM1 . No name ($0.00) OK
" White paper" 1 NEW PAPER-MEDIUM CONSTANT PAPER1  OK
PAPER1 . White paper ($0.00)
1 pages OK
" Starting Forth" 348 NEW BOOK CONSTANT BOOK1  OK
BOOK1 . <null> - Starting Forth ($0.00)
348 pages OK
" Scientific American" 114 3 2008 NEW JOURNAL CONSTANT JOURNAL1  OK
JOURNAL1 . Scientific American ($0.00)
114 pages
Edition 3/2008  OK
" Leo Brodie" BOOK1 SET-AUTHOR  OK
1999 BOOK1 SET-PRICE  OK
BOOK1 . Leo Brodie - Starting Forth ($19.99)
348 pages OK
BOOK1 PAGES . 348  OK
BOOK1 GET-AUTHOR . Leo Brodie  OK
BOOK1 SALE  OK
BOOK1 GET-PRICE . 1599  OK
BOOK1 .PRICE 15.99 OK
799 JOURNAL1 SET-PRICE  OK
JOURNAL1 PAGES . 114  OK
JOURNAL1 GET-PRICE . 799  OK
JOURNAL1 SALE  OK
JOURNAL1 . Scientific American ($1.00)
114 pages
Edition 3/2008  OK

The polymophism of the words . and SALE is simply implemented by overloading. Since this is one of StrongForth's basic features, no special treatment for object oriented programming is required. A different version of . is included in each of the four classes. However, . for a derived class generally uses the version defined for the respective parent class. For example, the member word . of class BOOK first displays the author followed by a dash and then executes .. Which version of . is this? The compiler sees an item of data type BOOK on the compiler data type heap. Searching the dictionary, the first match it finds is the member word . of BOOK's parent class PAPER-MEDIUM. As a result, . for objects of class BOOK displays the author, the title, the price and the number of pages. SALE, on the other hand, is defined in MEDIUM and redefined in JOURNAL. This means that executing SALE for objects of the classes MEDIUM, PAPER-MEDIUM and BOOK causes a 20% price reduction, while SALE for objects of the class JOURNAL causes the price to be reduced to $1.00, no matter what the previous price was.

Based on the class hierarchy defined in the previous section, let's now try to implement a word that advertises the sellout of a given medium:

: SELLOUT ( MEDIUM -- )
  ." Save money now!" CR DUP . CR DUP SALE
  ." Now for only $" .PRICE ." !" ;  OK
1999 BOOK1 SET-PRICE  OK
BOOK1 . Leo Brodie - Starting Forth ($19.99)
348 pages OK
799 JOURNAL1 SET-PRICE  OK
JOURNAL1 . Scientific American ($7.99)
114 pages
Edition 3/2008  OK
BOOK1 SELLOUT Save money now!
Starting Forth ($19.99)
Now for only $15.99! OK
JOURNAL1 SELLOUT Save money now!
Scientific American ($7.99)
Now for only $6.39! OK

Well, this did not work as intended. A 20% price reduction is granted for the book, but SELLOUT does not display the author and the number of pages. From the display of the journal, the number of pages and the edition is missing. Even worse, the reduced price is not correct. SELLOUT grants 20% for the journal, even though class JOURNAL has its own version of SALE that reduces the price to $1.00. What happened? When . and SALE are compiled into SELLOUT, the compiler sees an item of data type MEDIUM on the compiler data type heap and thus selects MEDIUM's versions of the two member words. . and SALE are statically bound to MEDIUM by the compiler. To resolve this problem, they have to be made virtual members of the class hierarchy. Virtual members are bound dynamically at runtime, i. e., the versions of . and SALE to be executed depend on the actual class of the object.

The data type of an object can be determined at runtime, because each object contains a pointer to the virtual member table of its class. The memory image of a virtual member table looks like this:

object size
virtual member table size

tokens of virtual members

Both the object size and the virtual member table size are stored in address units. Each virtual member word has a place for its execution token in the virtual member table. When a virtual member is executed for an object, the corresponding token is taken from the virtual member table of its class, requiring an index operation and one additional level of indirection. Executing a virtual member is thus similar to executing a deferred word.

VIRTUAL name ( ... class -- ... )

used between CLASS and BODY defines a virtual member for the actual class and for all inherited classes. The actual semantics are then assigned in the body of a class with

:NONAME ( ... class -- ... ) ... ; IS name

The complete virtual member table of a class is passed to the class's children. This means, as long as the semantics of a virtual member are not reassigned with IS name in the body of a class, the semantics assigned by its parent remains unchanged. It is even possible to define a virtual member and postpone assigning the semantics to one or more of the derived classes. Such a virtual member is called a pure virtual member An attempt to execute a pure virtual member results in an exception being thrown, because the virtual member table is initialized with the tokens of the word PURE-VIRTUAL. This word does nothing else but throwing this exception.

The last input parameter of a virtual member always needs to be an object of the respective class. This object is required in order to locate the virtual member table and to get the token of the virtual member that has been assigned to the class the object belongs to. Invoking a virtual member with a null object on the stack will almost certainly cause a crash. On the other hand, a non-virtual member may be invoked with a null object on the stack, as long as no data members are being accessed based on the null object. It is even possible to defined non-virtual members that do not expect an object of its class as the last input parameter.

With this knowledge about virtual members and dynamic binding, let's redefine the MEDIUM class hierarchy. Both . and SALE become virtual members:

CLASS MEDIUM
  VIRTUAL . ( MEDIUM -- )
  VIRTUAL SALE ( MEDIUM -- )
BODY
  ALSO PROTECTED DEFINITIONS
  NULL STRING MEMBER TITLE
  NULL UNSIGNED MEMBER PRICE \ in cent
  FORTH DEFINITIONS PROTECTED
  :MEMBER MEDIUM ( CADDRESS -> CHARACTER UNSIGNED MEDIUM -- 4 TH )
    >THIS NEW STRING TITLE ! 0 PRICE ! THIS ;
  :MEMBER SET-PRICE ( UNSIGNED MEDIUM -- )
    PRICE ! ;
  :MEMBER GET-PRICE ( MEDIUM -- UNSIGNED )
    PRICE @ ;
  :NONAME ( MEDIUM -- )
    >THIS PRICE @ 8 10 */ PRICE ! ; IS SALE
  :MEMBER .PRICE ( MEDIUM -- )
    PRICE @ 100 /MOD 0 .R [CHAR] . . S>D <# # # #> TYPE ;
  :NONAME ( MEDIUM -- )
    >THIS TITLE @ . ." ($" .PRICE ." )" ; IS .
ENDCLASS

CLASS PAPER-MEDIUM
BODY
  ALSO PROTECTED DEFINITIONS
  NULL UNSIGNED MEMBER #PAGES
  FORTH DEFINITIONS PROTECTED
  :MEMBER PAPER-MEDIUM ( CADDRESS -> CHARACTER UNSIGNED UNSIGNED 
       PAPER-MEDIUM -- 5 TH )
    >THIS #PAGES ! MEDIUM ;
  :MEMBER PAGES ( PAPER-MEDIUM -- UNSIGNED )
    #PAGES @ ;
  :NONAME ( PAPER-MEDIUM -- )
    DUP [PARENT] . CR PAGES . ." pages" ; IS .
ENDCLASS

CLASS BOOK
BODY
  ALSO PROTECTED DEFINITIONS
  NULL STRING MEMBER AUTHOR
  FORTH DEFINITIONS PROTECTED
  :MEMBER BOOK ( CADDRESS -> CHARACTER UNSIGNED UNSIGNED BOOK -- 5 TH )
    >THIS NULL STRING AUTHOR ! PAPER-MEDIUM ;
  :MEMBER SET-AUTHOR ( CADDRESS -> CHARACTER UNSIGNED BOOK -- )
    >THIS NEW STRING AUTHOR ! ;
  :MEMBER GET-AUTHOR ( BOOK -- STRING )
    AUTHOR @ ;
  :NONAME ( BOOK -- )
    DUP GET-AUTHOR . ." - " [PARENT] . ; IS .
ENDCLASS

CLASS JOURNAL
BODY
  ALSO PROTECTED DEFINITIONS
  NULL UNSIGNED MEMBER YEAR
  NULL UNSIGNED MEMBER MONTH
  FORTH DEFINITIONS PROTECTED
  :MEMBER JOURNAL ( CADDRESS -> CHARACTER UNSIGNED UNSIGNED UNSIGNED 
     UNSIGNED JOURNAL -- 7 TH )
    >THIS YEAR ! MONTH ! PAPER-MEDIUM ;
  :NONAME ( JOURNAL -- )
    100 SWAP PRICE ! ; IS SALE
  :MEMBER .EDITION ( JOURNAL -- )
    DUP MONTH @ 0 .R [CHAR] / . YEAR @ . ;
  :NONAME ( JOURNAL -- )
    DUP [PARENT] . CR ." Edition " .EDITION ; IS .
ENDCLASS

The virtual member table is built (or extended) between CLASS and BODY, where an item of data type VTABLE-SIZE is kept on the stack to count the number of address units allocated for the virtual member table. Between BODY and ENDCLASS, an item of data type OBJ-SIZE counts number of address units occupied by objects of the class. Now let's try SELLOUT again:

: SELLOUT ( MEDIUM -- )
  ." Save money now!" CR DUP . CR DUP SALE
  ." Now for only $" .PRICE ." !" ;  OK
" Starting Forth" 348 NEW BOOK CONSTANT BOOK1  OK
" Leo Brodie" BOOK1 SET-AUTHOR  OK
1999 BOOK1 SET-PRICE  OK
BOOK1 . Leo Brodie - Starting Forth ($19.99)
348 pages OK
BOOK1 SELLOUT Save money now!
Leo Brodie - Starting Forth ($19.99)
348 pages
Now for only $15.99! OK
" Scientific American" 114 3 2008 NEW JOURNAL CONSTANT JOURNAL1  OK
799 JOURNAL1 SET-PRICE  OK
JOURNAL1 . Scientific American ($7.99)
114 pages
Edition 3/2008  OK
JOURNAL1 SELLOUT Save money now!
Scientific American ($7.99)
114 pages
Edition 3/2008
Now for only $1.00! OK

Okay, now it works fine. Both . and SALE used in SELLOUT are bound dynamically to their actual objects. Instead of statically being bound by the compiler to an object of class MEDIUM, the two words are bound to the object SELLOUT receives from the stack at runtime.

But you also have to change the definitions of . for classes PAPER-MEDIUM, BOOK and JOURNAL. Instead of just writing . to compile the version of . from the respective parent class, you now have to write [PARENT] . in order to accomplish the same thing as before. [PARENT] is an immediate word that compiles a virtual member bound statically to the version of the parent class. If you just write ., the compiler uses dynamic binding, which results in . executing itself and thus causing an endless recursion. But in this case, you want to explicitly compile the token of the parent's version of .. Generally, [PARENT] is useful whenever the semantics of a virtual member word that is defined in the parent class is to be somehow extended in the child class. This definitely applies to .. On the other hand, the original version of SALE, which is defined in class MEDIUM, is not being extended. The version of SALE in class JOURNAL has its own semantic. If JOURNAL's version were an extended version of MEDIUM's version, [PARENT] could be applied as well, for example like this:

:NONAME ( JOURNAL -- )
  DUP [PARENT] SALE
  DUP PRICE @ 100 MAX SWAP PRICE ! ; IS SALE

This definition works as expected even though the grandparent and not the parent of class JOURNAL defines the original version of SALE. The parent PAPER-MEDIUM has inherited the version from JOURNAL's grandparent MEDIUM. If for whatever reason you want to compile a version that is different from that of the parent class, you can use [BIND] instead of [PARENT]:

[BIND] MEDIUM SALE

[BIND] allows you to specify the direct parent class as well as any indirect parent class whose version of the virtual member word shall be compiled with static binding. Specifying any other than direct or indirect parent classes is possible, but will cause an ambiguous condition in most cases. [BIND] is actually a generalized version of [PARENT]. Note that the usage of [PARENT] and [BIND] is not restricted to extending the semantics of virtual members within a class hierarchy. You can even chose to statically bind a virtual member in the definition of a non-member word like SELLOUT. For example, If you want to display only the title and the original price of a medium, you can statically bind . to class MEDIUM in the definition of SELLOUT:

: SELLOUT ( MEDIUM -- )
  ." Save money now!" CR DUP [BIND] MEDIUM . CR DUP SALE
  ." Now for only $" .PRICE ." !" ;  OK
1999 BOOK1 SET-PRICE  OK
BOOK1 SELLOUT Save money now!
Starting Forth ($19.99)
Now for only $15.99! OK
799 JOURNAL1 SET-PRICE  OK
JOURNAL1 SELLOUT Save money now!
Scientific American ($7.99)
Now for only $1.00! OK

Members that have been compiled into the PROTECTED word list of a class are passed on to child classes as well. However, private members can only be directly referred to within the parent class definition. Accessing private data members or private member words within the child class definitions or outside of a class definition can only happen indirectly through public or protected member words. That's because the PRIVATE word list of a class is not passed on to its children. The PROTECTED word list of a class, on the other hand, is passed on to all its children. Each child class actually starts with the PROTECTED word list of its parent class and extends it with its own protected members, whereas a child's PRIVATE word list is initially empty. Given the parent class definition

DT OBJECT PROCREATES PARENT-CLASS
DT PARENT-CLASS PROCREATES CHILD-CLASS

CLASS PARENT-CLASS
BODY
  NULL UNSIGNED MEMBER PUBLIC-DATA-MEMBER
  :MEMBER PUBLIC-MEMBER-WORD ( PARENT-CLASS -- )
    >THIS ;
  ALSO PRIVATE DEFINITIONS
  NULL UNSIGNED MEMBER PRIVATE-DATA-MEMBER
  :MEMBER PRIVATE-MEMBER-WORD ( PARENT-CLASS -- )
    >THIS ;
  ALSO PROTECTED DEFINITIONS
  NULL UNSIGNED MEMBER PROTECTED-DATA-MEMBER
  :MEMBER PROTECTED-MEMBER-WORD ( PARENT-CLASS -- )
    >THIS ;
ENDCLASS

here's what happens in the child class definition:

CLASS CHILD-CLASS BODY  OK
ALSO PRIVATE WORDS  OK
ALSO PROTECTED WORDS
PROTECTED-MEMBER-WORD ( PARENT-CLASS -- )
PROTECTED-DATA-MEMBER ( PARENT-CLASS -- ADDRESS -> UNSIGNED )  OK

Note that the assignment of a virtual member word does not affect the word list in which the virtual member word had been originally defined with VIRTUAL.

NEW and DELETE

By default, new structures and new objects are allocated in dynamic memory. NEW is a state-smart immediate word that executes or compiles the word (NEW) in order to allocate and initialize the new structure or object. It determines the data type of the structure or object by parsing the input stream for the name of the data type. If the data type is a structure, (NEW) is passed a literal parameter of data type ADDRESS -> STRUCTURE which is the address of a cell that contains the size of the structure in address units. STRUCTURE is the actual data type of the structure. The output parameter of (NEW) is the address of the allocated memory as an item of the structure's data type.

(NEW) ( ADDRESS -> STRUCTURE -- 2ND )

If you prefer to do the memory allocation yourself, all you have to do is pushing the address of the allocated memory onto the stack before NEW gets executed. This works because (NEW) is overloaded with two additional versions that expect addresses of data types ADDRESS and CADDRESS on the stack:

(NEW) ( ADDRESS ADDRESS -> STRUCTURE -- 3RD )
(NEW) ( CADDRESS ADDRESS -> STRUCTURE -- 3RD )

Let's assume you want to statically allocate a structure in the data space using ALLOT. Here's what you have to do:

HERE DT structure SIZE-STRUCTURE ALLOT NEW structure

structure stands for the name of structure. Remember that new structures are not being automatically initialized.

You can even chose to implement your own version of (NEW) for allocating structures. For example, if you generally want to allocate structures with ALLOT instead of with ALLOCATE, the following version of (NEW) does the job. If you define a separate vocabulary for it, you can even switch arbitrarily between dynamic and static allocation:

VOCABULARY STATIC-ALLOCATION  OK
GET-CURRENT ALSO STATIC-ALLOCATION DEFINITIONS  OK
: (NEW) ( ADDRESS -> STRUCTURE -- 2ND )
  SIZE-STRUCTURE HERE CAST STRUCTURE SWAP ALLOT ;  OK
SET-CURRENT HERE . 4756966  OK
NEW RECTANGLE .S . RECTANGLE 4756966  OK
PREVIOUS  OK
NEW RECTANGLE DUP . 1525264  OK
DELETE  OK

A structure that is no longer required shall be deleted with DELETE. DELETE simply frees the allocated dynamic memory:

: DELETE ( STRUCTURE -- )
  CAST ADDRESS FREE THROW ;

However, bear in mind that DELETE must not be applied to structures that were not allocated in dynamic memory with the first version of (NEW).

Allocating and deleting objects is similar to allocating and deleting structures. The main differences are that each object has a constructor that needs to be executed immediately after the memory space for the object has been allocated, and a destructor that is exectured immediately before the memory space for the object is released. Furthermore, the virtual member table pointer needs to be stored into the first cell of a new object. Since NEW is used both for creating new structures and new objects, corresponding versions of (NEW) are provided:

: (NEW) ( ADDRESS -> OBJECT -- 2ND )
  DUP SIZE-OBJECT ALLOCATE THROW
  TUCK -> ADDRESS -> OBJECT ! CAST OBJECT ;

: (NEW) ( ADDRESS ADDRESS -> OBJECT -- 3RD )
  OVER -> ADDRESS -> OBJECT ! CAST OBJECT ;

: (NEW) ( CDATA CONST -> OBJECT -- 3RD )
  OVER -> ADDRESS -> OBJECT ! CAST OBJECT ;

The input parameter ADDRESS -> OBJECT is the pointer to the object's virtual member table, whose first cell contains the size of the object in address units. The actual definitions of (NEW) are slightly different than what is shown here, but this has no impact on the semantics. Of course, you can also define your own versions of (NEW) just as has been demonstrated for structures a few paragraphs above.

Now, what about the constructors? Since the constructors of a class always have the same name as the class, and NEW parses the class name, NEW simply saves the input source specification before parsing, and restores it after parsing. The result is that the class name is evaluated immediately after NEW, executing or compiling a constructor that matches the parameters on the stack. You can define multiple constructors for different sets of parameters. For example, the STRING class that was shown above has a constructor that expects the address and count of a character string in addition to the string object. However, a string can also be initialized with another object of class STRING, or with just a character count. An example of an extended version of the STRING class with additional constructors will be shown later in this section.

Since NEW always evaluates the name of a constructor, it is not possible to create an object of a class that has no constructor. However, defining a class without a constructor can make sense, if the only purpose of this class is to derive child classes from it. Another interesting technique is to define the constructors of a class in the PRIVATE word list. The result is that objects of this class can only be created by member words of classes that have been declared friends of the class. Objects of classes whose constructors were defined in the PROTECTED word list can only be created by member words of child classes or friend classes.

In contrast to constructors, each class has only one destructor, because destructors do not have parameters in addition to the object itself. Moreover, all destructors are virtual members and share the common name DESTRUCTOR. They have one input parameter of the class data type that is not consumed. DELETE for objects is an immediate word that evaluates first the destructor and then a word called (DELETE) that releases the allocated memory space:

: (DELETE) ( OBJECT -- )
  CAST ADDRESS FREE THROW ;

: DELETE ( -- )
  " DESTRUCTOR" EVALUATE POSTPONE (DELETE) ; IMMEDIATE

If an object has not been allocated in the dynamic memory space using the first version of (NEW), you may not apply DELETE or (DELETE) to it. If you want to destroy the object anyway, you have to use its destructor alone.

Now what's the typical semantic of a destructor? The destructor of class OBJECT does nothing:

:NONAME ( OBJECT -- 1ST ) ; IS DESTRUCTOR

But the destructor of the STRING class actually needs a destructor that frees the dynamic memory space the constructor allocated for the character array. Otherwise, each time an object of class STRING is deleted, the available dynamic memory space shrinks by the the size of the character array. Without a dedicated destructor the definition of the STRING class is incomplete. It would just inherit the default destructor from class OBJECT. Adding the destructor and some more constructors, the definition of the STRING class now looks like this:

DT OBJECT PROCREATES STRING

CLASS STRING
BODY
  ALSO PROTECTED DEFINITIONS
  NULL UNSIGNED MEMBER LEN
  NULL CADDRESS -> CHARACTER MEMBER BUF
  :MEMBER INIT ( UNSIGNED STRING -- )
    >THIS DUP LEN ! CALLOCATE THROW -> CHARACTER BUF ! ;
  ALSO FORTH DEFINITIONS PREVIOUS
  :MEMBER STRING ( UNSIGNED STRING -- 2ND )
    >THIS INIT BUF @ LEN @ BLANK THIS ;
  :MEMBER STRING ( CADDRESS -> CHARACTER UNSIGNED STRING -- 4 TH )
    >THIS INIT BUF @ LEN @ MOVE THIS ;
  :MEMBER STRING ( STRING STRING -- 2ND )
    >THIS DUP LEN @ INIT BUF @ BUF @ LEN @ MOVE THIS ;
  :MEMBER . ( STRING -- )
    >THIS THIS
    IF LEN @
       IF BUF @ LEN @ TYPE
       ELSE ." <empty>"
       THEN
    ELSE ." <null>" 
    THEN SPACE ;
  :MEMBER LENGTH ( STRING -- UNSIGNED )
    LEN @ ;
  :NONAME ( STRING -- 1ST )
    DUP BUF @ FREE THROW ; IS DESTRUCTOR
  ENDCLASS

Note that INIT has been made a protected member, because it is supposed to be used only by the constructors of the STRING class and by its children.

Finally, here's another interesting feature that can be applied to both structures and objects. You can define dedicated versions of (NEW) and (DELETE) that only apply to a specific object, or dedicated versions of (NEW) and DELETE for specific structures. All you have to do is overloading (NEW) and (DELETE) for the specific data type. But what's this feature good for? One example is if you want to allocate all objects of a certain class in the data space instead of in dynamic memory, while the default allocation for all other objects remains dynamic:

: (NEW) ( ADDRESS -> SAMPLE-CLASS -- 2ND )
  SIZE-OBJECT HERE CAST SAMPLE-CLASS SWAP ALLOT ;

This definition of (NEW) overloads the default version and is only invoked for the class SAMPLE-CLASS and its children. Since the allocation is static, you don't need to overload (DELETE). The overloaded version of (NEW) can be either a member word or a global definition.

As another example, you might want to dynamically allocate objects of a specific class from a pre-allocated pool of memory chunks instead of from the general dynamic memory region, because allocating and freeing dynamic memory is rather slow. Assume you have a class SUDOKU and you need at most 8 objects of this class. The pool consists of 8 chunks that each can hold exactly one SUDOKU object. Unused chunks are deposited in a linked list that needs to be initialized at compile time. (NEW) takes one chunk from the top of the linked list, and (DELETE) returns it to the list:

DT OBJECT PROCREATES SUDOKU

CLASS SUDOKU
BODY
  NULL SUDOKU MEMBER NEXT
  NULL UNSIGNED 9 9 * CMEMBERS FIELD
  :MEMBER SUDOKU ( SUDOKU -- 1ST )
    DUP FIELD [ 9 9 * ] LITERAL ERASE ;
  \ ... \
ENDCLASS

NULL SUDOKU VARIABLE SUDOKU-FREELIST

: INIT-SUDOKU-FREELIST ( UNSIGNED -- )
  NULL SUDOKU SWAP 0
  DO HERE CAST SUDOKU 0 , \ vtable pointer \ SWAP ,
     [ 9 9 * ] LITERAL CHARS ALLOT ALIGN
  LOOP
  SUDOKU-FREELIST ! ;

8 INIT-SUDOKU-FREELIST

: (NEW) ( ADDRESS -> SUDOKU -- 2ND )
  SUDOKU-FREELIST @ DUP 0= ABORT" No more Sudokus"
  TUCK CAST ADDRESS -> ADDRESS -> SUDOKU !
  DUP NEXT @ SUDOKU-FREELIST ! ;

: (DELETE) ( SUDOKU -- )
  SUDOKU-FREELIST @ OVER NEXT ! SUDOKU-FREELIST ! ;

The virtual member table pointer is being initialized in the definition of (NEW). Alternatively, this initialization can also happen in INIT-SUDOKU-FREELIST, provided that you don't intend to derive children from SUDOKU that have their own virtual member table.

C++ allows using new to create arrays of objects. This is not possible in StrongForth. If you need to create multiple objects of the same class, you have to execute NEW within a loop, and store the resulting objects in an array. This restriction is a consequence of the way StrongForth invokes the constructor. Since a constructor consumes its input parameters, the parameters won't be available any more after the first object has been created.

Bit Fields

Both in ANS Forth and in StrongForth, the minimum size of a variable is one cell. Since a single cell is usually pretty small compared to the totally available memory of a system, not much memory is wasted if the data to be represented by a variable requires fewer bits than the number of bits in a cell. However, this statement can become wrong when arrays are being considered. A large array of ASCII characters actually is a waste of memory, if each character occupies one cell. That's why ANS Forth specifies access to character size items in memory with C@ and C!. It is further possible to define arrays of characters with

CREATE name n CHARS ALLOT

StrongForth supports character size items with dedicated address data types like CADDRESS. Overloaded versions of @ and ! deal with these addresses in order to fetch and store character size items, respectively. Proper address arithmetic is also provided. And within the definition of structures and objects, you can even define character size members with CMEMBER and CMEMBERS. But that's still not enough. It is also possible to define bit fields that occupy a given number of bits in memory:

NULL UNSIGNED 5 BMEMBER CHANNEL
NULL FLAG 1 6 BMEMBERS SWITCHES

defines a member of data type UNSIGNED that is 5 bits long, plus an array of 6 flags that each occupy only one bit. When CHANNEL and SWITCHES are executed, they return compound data types BADDRESS -> UNSIGNED and BADDRESS -> FLAG, respectively. BADDRESS is a new address data type that is derived from data type DOUBLE. BADDRESS contains information about

A bit field may not be bigger than the size of a cell. However, a bit field may extend over the border between two succeeding cells, e. g., on a 16-bit system a 12 bits long bit field that starts at bit 9 is still handled correctly. This bit field extends over the 7 most significant bits of one cell and the 5 least significant bits of the next cell.

It is also possible to obtain a bit field address without defining a bit field member of a structure or an object. BIT-FIELD creates a bit field address with a given address, position and size:

' BIT-FIELD . BIT-FIELD ( ADDRESS -> SINGLE UNSIGNED UNSIGNED -- BADDRESS -> 2ND )  OK
HEX 89AB VARIABLE TEST  OK
TEST 4 8 BIT-FIELD CONSTANT FIELD1  OK
' FIELD1 . FIELD1 ( -- BADDRESS -> UNSIGNED )  OK
TEST @ . 89AB  OK
FIELD1 @ . 9A  OK
65 FIELD1 !  OK
TEST @ . 865B  OK

The second input parameter of BIT-FIELD is the position of the bit field's least significant bit, and the third input parameter is the size of the bit field. Least significant bit, most significant bit and size can be retrieved from a bit field address with the words LSB, MSB and SIZE, respectively:

DECIMAL  OK
FIELD1 LSB . 4  OK
FIELD1 MSB . 11  OK
FIELD1 SIZE . 8  OK

Overloaded versions of the words @ and ! deal with bit fields, accessing only the bits in the cell that belong to the bit field. Even zero and sign extensions and accesses across cell borders are performed correctly. Here are some more examples:

HEX CREATE ARRAY ( -- ADDRESS -> UNSIGNED )  OK
11223344 , 55667788 , 99AABBCC ,  OK
ARRAY 3 CELLS DUMP
  48B614 44 33 22 11 88 77 66 55 CC BB AA 99             D3"..wfU....     OK
ARRAY 1+ CAST ADDRESS -> SIGNED 11 11 BIT-FIELD CONSTANT FIELD2  OK
-1 FIELD2 ! ARRAY 3 CELLS DUMP
  48B614 44 33 22 11 88 77 FE FF CF BB AA 99             D3"..w......     OK
+0 FIELD2 ! ARRAY 3 CELLS DUMP
  48B614 44 33 22 11 88 77 00 00 CC BB AA 99             D3"..w......     OK
+1F3 FIELD2 ! ARRAY 3 CELLS DUMP
  48B614 44 33 22 11 88 77 E6 03 CC BB AA 99             D3"..w......     OK
FIELD2 @ . 1F3  OK

For dealing with arrays of bit fields, overloaded versions of FILL and ERASE as well as the usual address arithmetic words are available:

FILL ( BADDRESS -> SINGLE UNSIGNED 2ND -- ) 
ERASE ( BADDRESS -> SINGLE UNSIGNED -- ) 
+ ( BADDRESS INTEGER -- 1ST )
- ( BADDRESS INTEGER -- 1ST ) 
1+ ( BADDRESS -- 1ST ) 
1- ( BADDRESS -- 1ST ) 
+! ( INTEGER BADDRESS -> INTEGER -- ) 
+! ( INTEGER ADDRESS -> BADDRESS -- )

Again, let's view some examples of their application:

DECIMAL  OK
ARRAY 12 4 BIT-FIELD CONSTANT FIELD3  OK
FIELD3 15 ERASE ARRAY 3 CELLS DUMP
  48B6F4 44 03 00 00 00 00 00 00 00 BB AA 99             D...........     OK
FIELD3 15 9 FILL ARRAY 3 CELLS DUMP
  48B6F4 44 93 99 99 99 99 99 99 99 BB AA 99             D...........     OK
7 FIELD3 3 + ! ARRAY 3 CELLS DUMP
  48B6F4 44 93 99 97 99 99 99 99 99 BB AA 99             D...........     OK
8 FIELD3 1+ +! ARRAY 3 CELLS DUMP
  48B6F4 44 93 91 97 99 99 99 99 99 BB AA 99             D...........     OK

Bit field members defined in structures and objects are always packed as tight as possible. In the example at the beginning of this section, bit field CHANNEL starts at bit position 0, and the bit field array SWITCHES starts at bit position 5. The next bit field would then start at bit position 11, unless the next member (if any) is defined with MEMBER or CMEMBER. Since members defined with MEMBER always have to be cell aligned, MEMBER implicitly uses ALIGNED to realign the current member offset. Character size members need to be character aligned. The new word CALIGNED, which is implicitly used by CMEMBER, can be used in the same way as ALIGNED:

CALIGNED ( STRUCT-SIZE -- 1ST )

Finally, here's an example of bit fields as class members. Since the numbers to be entered into a Sudoku board range from 1 to 9, they can be represented by 4 bit long unsigned numbers. The SUDOKU class can thus be redefined to cut the memory requirement by almost a factor of 2:

CLASS SUDOKU
BODY
  NULL SUDOKU MEMBER NEXT
  NULL UNSIGNED 4 9 9 * BMEMBERS FIELD
  :MEMBER SUDOKU ( SUDOKU -- 1ST )
    DUP FIELD [ 9 9 * ] LITERAL ERASE ;
  \ ... \
ENDCLASS

Unions Of Members

Sometimes it is useful to assign the same memory space to different members. For example, suppose you want to implement a class that can alternatively contain a single-cell item and a double-cell item. If you simply define two different members, plus a discriminator that tells the object which member to select, you always have at least one cell of unused memory space:

Discriminator
SINGLE

DOUBLE

A better solution would be to use the same memory for both items:

Discriminator
SINGLE DOUBLE
 

StrongForth supports this feature by enclosing the three members in a UNION:

UNION    NULL SINGLE MEMBER S
AND      NULL DOUBLE MEMBER D
ENDUNION

Of course, the word AND in this context is a different version than the versions of AND that expect input parameters of data types LOGICAL and DATA-TYPE. This example demonstrates that it might make sense to overload even words with completely different semantics. In ANS Forth, on the other hand, it is often necessary to assign a bad or misleading name to a word , just because all better names are already in use by other words. In StrongForth, like in natural language, you can reuse names as long as the interpreter and compiler can clearly distinguish the context, i. e., the set of input parameters.

AND is required here in order to split the union into a number of blocks. Each block may contain more than one member, and the members defined in a block share the reserved memory space with the members of all other blocks. The following example demonstrates how to use nested unions with blocks containing multiple members:

DT STRUCTURE PROCREATES DISCRETE

STRUCT DISCRETE
  NULL UNSIGNED MEMBER INDEX
  NULL CHARACTER CMEMBER ID
  UNION
    NULL UNSIGNED-DOUBLE MEMBER OHM
    NULL UNSIGNED MEMBER MAX-MILLIWATT
  AND
    NULL FLAG 1 BMEMBER POLAR
    NULL UNSIGNED-DOUBLE MEMBER PICOFARAD
    NULL UNSIGNED MEMBER MAX-VOLT
  AND
    UNION
      NULL FLAG 1 BMEMBER FET
      UNION
        NULL FLAG 1 BMEMBER PNP
      AND
        NULL FLAG 1 BMEMBER P-CHANNEL
      ENDUNION
    AND
      NULL FLAG 1 BMEMBER ZENER
    AND
      NULL UNSIGNED CMEMBER PINS
    ENDUNION
    NULL CHARACTER 8 CMEMBERS TYPE#
  ENDUNION
ENDSTRUCT

This structure stores the parameters of various discrete electronic components. Each component has a character ID and an index number INDEX to identify it. ID serves as the discriminator. Transistors, diodes and integrated circuits have a type numer TYPE#, while resistors and capacitors only have numeric and boolean parameters:

The structure can be used like this:

NEW DISCRETE CONSTANT RESISTOR1
CHAR R RESISTOR1 ID !
12 RESISTOR1 INDEX !
4700. RESISTOR1 OHM !
125 RESISTOR1 MAX-MILLIWATT !

NEW DISCRETE CONSTANT TRANSISTOR1
CHAR T TRANSISTOR1 ID !
5 TRANSISTOR1 INDEX !
" 2N3055  " TRANSISTOR1 TYPE# SWAP MOVE
FALSE TRANSISTOR1 FET !
FALSE TRANSISTOR1 PNP !

The implementation of the three words UNION, AND and ENDUNION is surprisingly simple. UNION expects the current structure size, which becomes the starting offset of the union on the stack, and creates two copies of this value. During the definition of the union, these three values stand for

  1. the starting offset of the union,
  2. the offset at the end of the largest block so far, and
  3. the offset within the current block.

And here are the definitions:

: UNION ( STRUCT-SIZE -- 1ST 1ST 1ST )
  DUP DUP ;

: AND ( STRUCT-SIZE STRUCT-SIZE STRUCT-SIZE -- 1ST 2ND 3RD )
  MAX OVER ;

: ENDUNION ( STRUCT-SIZE STRUCT-SIZE STRUCT-SIZE -- 3RD )
  MAX NIP ;

Container Classes

A container class is a class whose objects are collections of items. Typical container classes are arrays, lists, queues and stacks. StrongForth's library for object oriented programming supports container classes, which can be used in a similar way as addresses. This means, an object of a container class usually has a compound data type like STACK -> SIGNED or LIST -> STRING. For example, a STACK container will be used like this:

NEW STACK -> SIGNED CONSTANT ST1  OK
-8156 ST1 PUSH  OK
+601 ST1 PUSH  OK
ST1 POP .S . SIGNED 601  OK
+20012 ST1 PUSH  OK
ST1 POP . 20012  OK
ST1 POP . -8156  OK
ST1 POP . Empty stack
ST1 DELETE  OK

Trying to pop from an empty stack results in an exception being thrown, producing the error message Empty stack. Let's now have a look at the implementation of the STACK container class:

DT OBJECT PROCREATES STACK
DT OBJECT PROCREATES STACK-SINGLE

CLASS STACK-SINGLE
BODY
  FRIENDS( STACK )
  ALSO PRIVATE DEFINITIONS
  NULL SINGLE MEMBER ITEM
  NULL STACK-SINGLE MEMBER NEXT
  :MEMBER STACK-SINGLE ( SINGLE STACK-SINGLE STACK-SINGLE -- 3RD )
    TUCK NEXT ! TUCK ITEM ! ;
ENDCLASS

CLASS STACK
BODY
  ALSO ACCESS STACK-SINGLE
  ALSO PRIVATE DEFINITIONS
  NULL STACK-SINGLE MEMBER TOS
  FORTH DEFINITIONS PRIVATE
  :MEMBER STACK ( STACK -- 1ST )
    NULL STACK-SINGLE OVER TOS ! ;
  :MEMBER EMPTY? ( STACK -- FLAG )
    TOS @ 0= ;
  :MEMBER PUSH ( SINGLE STACK -> 1ST -- )
    >THIS TOS @ NEW STACK-SINGLE TOS ! ;
  :MEMBER POP ( STACK -> SINGLE -- 2ND )
    >THIS EMPTY? ABORT" Empty stack"
    TOS @ DUP ITEM @ SWAP NEXT @ TOS @ DELETE TOS ! ;
  :NONAME ( STACK -- 1ST )
    BEGIN DUP TOS @
    WHILE DUP -> SINGLE POP DROP
    REPEAT ; IS DESTRUCTOR
ENDCLASS

STACK-SINGLE is a class whose objects contain a single item of data type SINGLE, and a link to another object of the same class. Since all of STACK-SINGLE's members are private, including the constructor, the class can only be used by its friends. That's why class STACK is declared being a friend of class STACK-SINGLE. STACK can create objects of class STACK-SINGLE and access its members, because the phrase ALSO ACCESS STACK-SINGLE adds STACK-SINGLE's private word list to the search order. Class STACK has a constructor, a destructor, and the three member words EMPTY?, PUSH and POP. Note that the last input parameters of PUSH and POP are compound data type types. They ensure that access to a stack is restricted to items of the given data type.

The destructor empties the stack by deleting all objects of data type STACK-SINGLE that belong to the stack. However, the items themselves are not deleted, which might become necessary if they are objects, as in

NEW STACK -> STRING CONSTANT ST2

You can consider defining an additional member word called e. g. DELETE-ITEMS that removes and deletes all items:

:MEMBER DELETE-ITEMS ( STACK -> OBJECT -- 1ST )
  BEGIN DUP TOS @
  WHILE DUP -> OBJECT POP DELETE
  REPEAT ;

The items of the container class STACK are always single-cell items. For double-cell items the class definitions have to extended appropriately. First, we need to define a variant of class STACK-SINGLE, which contains an item of data type DOUBLE. The two classes can be derived from one parent called STACK-ITEM. In the definition of STACK itself, we need multiple variants of TOS to store pointers to the two different item-containing classes. Furthermore, we need additional overloaded versions of PUSH and POP for the two data types. And finally, the destructor needs to be made independent from the data type of the item. This is the result:

DT OBJECT PROCREATES STACK
DT OBJECT PROCREATES STACK-ITEM
DT STACK-ITEM PROCREATES STACK-SINGLE
DT STACK-ITEM PROCREATES STACK-DOUBLE

CLASS STACK-ITEM
BODY
  FRIENDS( STACK )
  ALSO PROTECTED DEFINITIONS
  NULL STACK-ITEM MEMBER NEXT
ENDCLASS

CLASS STACK-SINGLE
BODY
  FRIENDS( STACK )
  ALSO PROTECTED
  ALSO PRIVATE DEFINITIONS
  NULL SINGLE MEMBER ITEM
  :MEMBER STACK-SINGLE ( SINGLE STACK-ITEM STACK-SINGLE -- 3RD )
    TUCK NEXT ! TUCK ITEM ! ;
ENDCLASS

CLASS STACK-DOUBLE
BODY
  FRIENDS( STACK )
  ALSO PROTECTED
  ALSO PRIVATE DEFINITIONS
  NULL DOUBLE MEMBER ITEM
  :MEMBER STACK-DOUBLE ( DOUBLE STACK-ITEM STACK-DOUBLE -- 3RD )
    TUCK NEXT ! TUCK ITEM ! ;
ENDCLASS

CLASS STACK
BODY
  ALSO PRIVATE DEFINITIONS
  UNION NULL STACK-ITEM   MEMBER TOS
  AND   NULL STACK-SINGLE MEMBER TOS-SINGLE
  AND   NULL STACK-DOUBLE MEMBER TOS-DOUBLE
  ENDUNION
  ALSO FORTH DEFINITIONS
  :MEMBER STACK ( STACK -- 1ST )
    NULL STACK-ITEM OVER TOS ! ;
  :MEMBER EMPTY? ( STACK -- FLAG )
    TOS @ 0= ;
  PRIVATE DEFINITIONS
  :MEMBER ?EMPTY ( STACK -- )
    EMPTY? ABORT" Empty stack" ;
  FORTH DEFINITIONS
  ACCESS STACK-SINGLE
  :MEMBER PUSH ( SINGLE STACK -> 1ST -- )
    >THIS TOS @ NEW STACK-SINGLE TOS-SINGLE ! ;
  :MEMBER POP ( STACK -> SINGLE -- 2ND )
    >THIS ?EMPTY
    TOS-SINGLE @ ITEM @ TOS @ NEXT @ TOS @ DELETE TOS ! ;
  ACCESS STACK-DOUBLE
  :MEMBER PUSH ( DOUBLE STACK -> 1ST -- )
    >THIS TOS @ NEW STACK-DOUBLE TOS-DOUBLE ! ;
  :MEMBER POP ( STACK -> DOUBLE -- 2ND )
    >THIS ?EMPTY
    TOS-DOUBLE @ ITEM @ TOS @ NEXT @ TOS @ DELETE TOS ! ;
  ACCESS STACK-ITEM
  :NONAME ( STACK -- 1ST )
    >THIS
    BEGIN TOS @
    WHILE TOS @ NEXT @ TOS @ DELETE TOS !
    REPEAT THIS ; IS DESTRUCTOR
ENDCLASS

Please notice the phrase ALSO PROTECTED within the class definitions of STACK-SINGLE and STACK-DOUBLE. Without the PROTECTED word list being included in the search order the three classes it wouldn't be possible to access the protected data member NEXT of their parent class STACK-ITEM. If NEXT had been made a private data member by adding its definition to the PRIVATE word list of class STACK-ITEM, the two child classes had to be declared friends of STACK-ITEM, and additionally the phrase ALSO ACCESS STACK-ITEM had to be added to each of them.

You now have a universal stack container class for items of all data types. It's usage is easy and straight-forward:

NEW STACK -> UNSIGNED CONSTANT ST1  OK
NEW STACK -> DEFINITION CONSTANT ST2  OK
714 ST1 PUSH  OK
81 ST1 PUSH  OK
ST1 POP . 81  OK
911 ST1 PUSH  OK
ST1 POP . 911  OK
ST1 POP . 714  OK
ST1 POP . Empty stack
ST1 DELETE  OK
ST2 EMPTY? . TRUE  OK
' EMIT ST2 PUSH  OK
' SPACE ST2 PUSH  OK
ST2 POP . SPACE ( -- )  OK
ST2 DELETE  OK

Dr. Stephan Becher - January 28th, 2009