Object Forth Project

By Jörg Langowski, Wayne Joerding

Object-Oriented Extension to MACH2TM Forth

by Wayne Joerding

[This is the first of - hopefully - several upcoming articles dealing with Object Forth extensions. I introduced you to some of the features of Wayne’s implementation in my last column. Now, here comes the real stuff. I checked out Wayne’s code several times and it seems to work very well. For those of you who play with the source code disk before reading the article I should point out that you have to turn vocabulary hashing OFF before you try out the code; this is also explained in the article.

Introduction

How could any programmer resist “object-oriented programming,” with its promise to reduce program development time through reusable code and improve revisability by the use of self-contained modules that encapsulate data structures and their procedures that operate on the structure. Then to find out that the whole thing works by passing messages to something called an object, it was too much to resist. But, I didn’t want to give up my experience with Forth, its fast code, extensible compiler and interactive programming style. Fortunately, it is possible and desirable to build an object-oriented extension of the Forth language, NEON is perhaps the best known example.

Brad Cox’s excellent book Object-oriented Programming: An Evolutionary Approach, promotes the advantages of using a hybrid language derived by extending a traditional language to accommodate the object-oriented approach. Object-oriented Forth by Dick Pountain actually shows how to add abstract data types (objects) to Forth. Armed with these two books, I have developed an object-oriented extension to MACH2 Forth. This article describes the results. My approach is not the only one, NEON has already been mentioned and there are postings on GEnie from others who are making object-oriented extensions to FORTH. However, each approach has unique features and limitations, thus an additional objective for this article is to discuss some of the problems and tradeoffs I faced in the process. Here is an abbreviated version of a summary sheet like that used by Kurt Schmucker in Object-oriented Programming for the Macintosh.

ObjectFORTH

Background Information

Programming Environment : MACH2 FORTH

Toolbox Access : Yes

Object-Oriented Information

Instance Variables and Methods : Yes

Class Variables and Methods : Yes

Multiple Inheritance : No

Unique Instance Methods : No

Number of Classes in library : 1

MacApp access : No

Dynamic Objects : No

First, let’s clarify some jargon used in the literature. Objects are an abstract construct composed of a data structure and associated procedures. Objects are organized into child-classes of a root class, each child-class having more specifically defined methods and data structures than its parent-class. For example, “stacks” are a child-class of “ordered lists” which are a child-class of “arrays”. Each class is composed of instances of the class. For example, a particular stack can be an instance of the class “stack”. An object’s data structure consists of named fields called instance variables. The procedures are called methods and are like subroutines. A program requests an object to execute a method by sending the object a message which is used by a “selector” routine to select the appropriate method. The set of messages to which an object responds is called a protocol.

There are two essential features of object-oriented programing, encapsulation and inheritance. Encapsulation refers to the isolation of an object’s data and methods from other parts of the program. Encapsulation is enforced by restricting access to an object’s data or procedures to a standardized message interface used by each object. Objects are presented a message to which they respond by selecting a method to execute. The specific method is an internal matter for the object and depends on the implementation. For example, a link-list can be implemented as an ordered array or an unordered array with pointers. The importance of encapsulation is that a user of an object does not need to know how the object is implemented. In a sense, encapsulation is nothing more than a strong form of good modular programming practice. However, object-oriented programming not only enforces modular code but also bundles the data structures with the procedures.

Inheritance refers to the ability of objects in a child-class to inherit the structure and procedures of the parent-class. Furthermore, objects in the same class, called instance objects, share the same code. The advantage of inheritance is that data structures and procedures can be reused and extended.

In addition to meeting the above requirements, I also had several design goals for the extension. The most important influence on the extension described here is its pedagogical nature. I was trying to learn about object-oriented programming from the extensions and so I made the logical and physical data structures as similar as possible. The logical structure adopted is that given in Cox’s book and is a natural choice for a FORTH programmer because of its reliance on linked lists.

A second design goal was to enforce a strong degree of encapsulation by requiring messages to be simple character strings, without any procedural capability of their own, and by hiding all forth words which identified methods or instance variables. Thus, trying to execute the name of a method or instance variable will only get you a beep and a question mark. An alternate approach is to have method names put an identifier on the stack and then have the object use that identifier to find the appropriate method. A disadvantage in this approach is that forgetting to use the object does not immediately result in an error. A disadvantage of my approach is that it requires rather major surgery on the links of the dictionary, a risky process which slows compilation.

A third design goal was that every construct in the extension should be an object in its own right, each object searching the input stream for a message. This means that the creation of subclasses is a method of a parent-class object. As a consequence, objects are divided into two groups, “class defining objects”, CDO’s, and “instance objects”, IO’s. Instance objects are members of a class that is defined by a class defining object. CDO’s are the factory objects of Brad Cox, their main purposes are (i) specify the data structure and methods that define the class and are used by instance objects, (ii) make instance objects, and (iii) create new child-classes. I will discuss each of these capabilities in turn.

The data structure and methods of an object are implemented as normal forth words which are sealed from the rest of the forth dictionary by redirecting the links of their headers, more on this later. Access to the data structure and method names is controlled by the class defining object. A CDO gives a new instance object a pointer to the link list of instance methods and instance variables that define the class.

Only CDO’s can make instances of a class. Each instance can respond to a protocol of messages as specified by its class definition. For example, if Forth’s “Pstack”, for parameter stack, and “Rstack”, for return stack, were defined in an object-oriented language then they would both be instances of the class “stack”, and as such would respond to the message “pop” because that is a message in the protocol of all instances of “stack”. The instance “ Pstack” would contain all the characteristics peculiar to the parameter stack, such as data, while the instance “Rstack” would do the same for the return stack. The CDO “stack” defines the structure of the data contained in the instances “Pstack” and “Rstack” and the methods to which these instances respond.

Only CDO’s can create new classes. It is the creation of child-classes that implements the inheritance of methods. A child class inherits the methods and data structure of its parent-class. For example, “stack” is a child-class of the class “list”, thus “list” passes along its data structure and methods to its child-class “stack”. Consequently, if instances of “list” respond to the message “size”, instances of the class “stack” also respond to “size”. If the programmer wants instances of the class “stack” to respond to “size” in a different manner than instances of the parent-class “list”, then the “size” method must be overridden by specifying a new method for the message “size”. This sounds great in theory, but practice reveals one of life’s tradeoffs. Take our example, one could code a “size” method which works ineffieciently for all possible child classes, or one could code a method which is optimized for a “list” type object and later override the “size” method with one which is optimized for a stack type object. The class creation procedure also provides a way to add additional methods to the child class, such as “pop” for the “stack” class.

There are important advantages to requiring all constructs to be objects. An obvious advantage is the uniform handling of objects. Making instances and subclasses is just the same as accessing data in an instance object. A much more important advantage is that instance and child-class creation are methods, methods which can be be overridden by child-classes. In a previous example it was pointed out that the “size” method of a parent-class can be overridden by the child-class, similarly, the instance and child-class creation methods can be overridden. This ability to override the methods of a class defining object is analogous to the extensibility of the forth compiler, and has the same importance. One of the code examples shows the use of this feature to alter the instance creation method so that it forms instances of variable size. Another example uses this feature to implement a C-style data structure.

A fourth design goal was to make the compiled code as fast as possible. Slowness has been a criticized characteristic of object oriented languages, although the speed sacrifice can be quite small (see Cox’s book for a discussion and references regarding this issue). The desire for speed led to a binding scheme like that used by Pountain. Binding refers to the point in time when a label is associated with a value. For example, the definition “ : myDUP [‘] DUP EXECUTE ; “ would bind early the CFA of DUP to the label myDUP. On the other hand, the definition “ : PLEASE ‘ EXECUTE ; “ and used as PLEASE DUP would be an example of late binding of the label PLEASE to the CFA of DUP. My extension uses early binding in the sense that methods are chosen at compilation time rather than run time. It uses late binding in the sense that variable names are associated with addresses at run time. The essential overhead involved with this approach is that a reference to any object instance variable in a method definition requires a number to be read off a special object stack and added to an offset number on the regular FORTH parameter stack. Any implementation of a data structure as complex as an array would require adding some offset value, so the extra fetch from the object stack is the actual overhead. Please see Pountain’s book for a discussion on the whether this overhead is worthwhile.

Finally, a fourth design goal was to make the extension itself use abstract data structures in order for the code to be as easy to change and maintain as possible. Thus, the data structures in class defining objects are accessed by their names as much as possible, not by calculating an offset which requires unchanging knowledge of the format of the data structure layout. The only fixed address is the field used by a CDO to store the LFA of its first method, this variable must be in the first long word of a CDO’s data set. A consequence of this goal is that the code sometimes uses the trick of temporarily pushing an object’s address on the object stack and then popping it off when no longer needed.

Syntax and Usage

This section describes the syntax used to send an object a message, create a new class, and make an instance of a class. Additionally, I describe some of the built-in methods and tips on using ObjectFORTH.

Send any object a message:

Object.1  Msg

Messages cannot be larger than 32 characters. Capitalization matters! These restrictions are due to the simplicity of the selector routine used to find methods.

Make an instance with the identifier INS.1:

CLASS.1    Make.Instance    INS.1

Make.Instance is a method of the class defining object CLASS.1, it simply uses the character string INS.1 from the input stream to create a dictionary header for the new instance.

Create new class with the identifier CLASS.2:

CLASS.1  Define.Child.Class
 :Class
 I.Var <name.1>
 Hide
 :M <name.2> <normal forth def>  ;
 ;Class
 k Constant <con.1>
 Variable <var.1>
 :Instance
 Variable  <var.2>
 I.Var <name.3>
 n Ins.Array <name.4>
 Hide
 :M <name.5> <normal forth def>  ;
 ;Instance
CLASS.1  Name.Child.Class   CLASS.2

Each CDO has two sections, a class section which contains the methods and variables of the object and an instance section which holds the methods and data structure for instances of the class. The words :Class and ;Class start and end definition of the class section of a child class, similarly for :Instance and ;Instance. Each of these parts of the definition are optional. Thus, most CDO’s have no need to add methods to the class section of the object. The order of the class and instance section definitions does not matter.

The word I.Var creates a long word integer variable which is inherited by each child. That is, an I.Var in the class section is inherited by any CDO which has CLASS.2 as an ancestor, and an I.Var in the instance section is inherited by each instance of the class defined by CLASS.2 and by each instance that has CLASS.2 as an ancestor. The word Ins.Array is similar but creates an array of n bytes. :M starts the definition of an object method. In this example, :M defines a new class method named <name.2>. The method <name.2> is used by sending the message <name.2> to the object CLASS.2.

The word Hide prevents previous words in a section from being available as methods. For example, use of Hide in the class section prevents the <name.1> instance variable from being available as a method name. In this way the user of an object cannot gain direct access to the memory location of <name.1> by sending <name.1> as a message. Hide is usually used in this way, to hide an object’s data structure, but it can also hide methods. Thus, one could define a method before Hide and it would not be available as a public method, only internally to the object. Hide is optional.

Note that normal forth constructs, such as Constant, can be used in the definition. How these constructs are used depends on their placement. If placed outside the section defining words (:Class and ;Class or :Instance and ;Instance), such as <con.1>, then the word is not available in any fashion after the object definition is completed. But the word can be used in method definitions. This is a good way to define words used in method definitions but which are not subsequently desired as methods. This should be contrasted with the effect of Hide discussed above. For example, the variables <var.1> and <var.2> both provide a” class variable” for CLASS.2. (Class variables are variables shared by instance objects of the same class, which can be used for passing data between instances.) The difference between the two is that <var.1> is not available to descendents of CLASS.2, while <var.2> would be available to new methods of CLASS.2 descendents. That is, methods defined in children of CLASS.2 could use <var.2> as a variable. However, <var.2> is not passed on to a child class in the manner of an instance variable. If forth definitions are placed inside the section defining words but after Hide then the construct is available as a method by its name.

There is an additional method included in the root object besides child-class and instance defining methods. This method is Describe which describes the an object. This method works for both CDOs and instances, but produces somewhat different results in each case. In the CDO case Describe prints the name of the object, some information about the object, then sends itself the messages Pr.ob.ivar, Pr.class.meths, and Pr.ins.meths. These methods list the ivars, class methods, and instance methods, however, only Pr.class.meths and Pr.ins.meths will work for child objects. Pr.ob.ivar will not work for a child object which adds ivars. This example demonstrates one of the subtle features of programing with objects. It takes extra thought, and sometimes is impossible, to define a method that works properly with child classes.

There are several important features of Object FORTH that affect usage. First, the data hiding and encapsulation are accomplished by redirecting links in the LFA of a name header. This hiding will be defeated and inheritance will not be implemented properly if HASHING is used. Thus, you must turn off the HASHING feature of MACH2. Second, only those methods which have been declared GLOBAL can be used outside a code segment, even interactively. In this regard we are very fortunate in the way MACH2 implements NEW-SEGMENT. MACH2 maintains a separate link list of words which are to have jump table entries, then during execution of NEW-SEGMENT this link list is traversed, changing the Segment Field of the dictionary header to the appropriate number and putting the jump table offset into the Parameter Field Pointer region of the dictionary header. Thus, those words designated as GLOBAL will have a correctly defined dictionary header after NEW-SEGMENT. However, the other methods have been delinked from the normal search order, so the dictionary header of these words is not found and changed by NEW-SEGMENT. What is needed is a new NEW-SEGMENT, a task which remains for the future. Third, you must execute Init.Ostack each time you start Object.FORTH from a file which was created by NEW-SEGMENT. Also, you must make Init.Ostack part of the initialization procedure in a TURNKEY’ed application. The reason for this is that the object stack, to be described later, is based on the variable Ostack and must be initialized to the proper value before use by objects. You have been warned, this one will sting you at least once!

Those familiar with other object oriented languages may have noted the absence of SELF and SUPER. These pseudo objects are avoided here in preference for the natural Forth ability to call any previously defined word. If you’re not familiar with these SELF and SUPER then ignore this paragraph.

Implementation

I will describe the implementation by sequentially discussing the most important words in the accompanying code. But first, it is best to describe the general structure of the implementation. Figure 1 shows the links between words before and during the definition of the instance part of a class defining object. It is supposed that the class part of the root object OBJECT has instance variables C.ivar.1, C.ivar.2, and methods C.meth.1, and C.meth.2, while the instance part has variables I.ivar.1 and methods I.meth.1 and I.meth.2. CLASS.1 is a child class of OBJECT, it has a class part with variable C.ivar.2 and method C.meth.3, it has an instance part with variable I.ivar.2 and methods I.meth.3 and I.ivar.4. CLASS.2 is a child class of CLASS.1, it only has one class method of C.meth.4 and one instance method of I.meth.5, no variables. The words word.1, word.2 and word.3 are normal forth definitions.

The left side shows the links before creation of a new child class begins. The solid lines represent the links followed by the forth interpreter, thus an execution of WORDS would result in CLASS.2 word.3 CLASS.1 word.2 OBJECT word.1 etc. The dashed lines represent internal links of an object. Data fields in the class defining object control access to these link lists. For example, an instance of CLASS.1 would use the pointer in a field named ins.Key to find the head node for its link list of methods, at I.meth.4. This link list of methods would then be traversed by a routine called Selector searching for the appropriate method. If the search got as far as <root>, whose link is zero, then the method is not found and an error message is reported. Similarly, a field named class.Key points to the head node of methods (i.e. C.meth.3) for the class defining object CLASS.1. Inheritance is implemented by linking methods of child classes to the methods of parent classes. It is also easy to see the effect of Hide. In the example all the instance variables are hidden by directing the link of the last method of each object to the first method of its parent object. That way Selector won’t find the method or instance variable name.

The right side shows the links during the definition of the instance part of the new class defining object. Two types of changes have occurred. First, Define.Child.Class makes a change which is not shown, it relinks the section defining words :Class, ;Class, :Instance, ;Instance, and Hide, so that they can be used during the class definition. Second, :Instance changes the links shown in heavy lines. For each ancestor object there are two link changes which must be made. First the object name is linked to the head instance method, for example, CLASS.1 in linked to I.meth.4. Second, the tail instance method is linked to either (i) the next public word (as with I.meth.5 to word.3) or (ii) the first hidden word (as with I.meth.3 to I.ivar.2). The difference occurs between those objects that do not have a hidden part, such as CLASS.2, and objects that do have a hidden part, such as CLASS.1. In the case of CLASS.1 the last hidden word is already linked to the next public word (i.e. I.ivar.2 is linked to word.2). In the case of CLASS.2 there is no hidden words so the last unhidden method is linked to the next public word (i.e. I.meth.5 is linked to word.3). For the root object the next public word is defined to be Ob.Words. At the conclusion of defining the instance part ;Instance will return the links to their previous condition. Then it only remains for Name.Child.Class to delink the words :Class, ;Class, . . . Hide.

The memory location for each type of object is quite different, but each object has a data structure starting at an address stored with the name of the object. I call this address the data field address, DFA. Thus, the DFA is the address where the object’s data structure starts. The data structure of a CDO is stored along with the dictionary headers, while the data structure of instance objects is stored in the Forth code segment by a standard ALLOT statement. The reason for this difference is that the data for a class defining object is only needed during compilation and can be disposed when compilation is complete. This is automatically done by TURNKEY. The name of a class defining object only stores the handle (not a pointer) to its data, whereas the name of an instance object stores the actual instance data. The only physical constraint on the data of a CDO is that the instance variable class.Key (which contains a relative address pointer to the first class method) must be at a zero offset from the value pointed to by the contents of the handle.

Now let’s look at the code. First comes the memory allocation for the object stack, enough to accommodate nested objects to 20 levels. Ob.DefWords and ObjectFORTH are markers which are used by Define.Child.Class to relink and delink the words in between. The section defining words :Class etc. are deferred so that their definitions can use the data structure names defined for the root object. Next come global variables used in the construction of new objects. Then the object stack manipulation words are defined. Note that the push and pop words contain one line of code for error checking which can be removed after debugging. Ins.Array, I.Var, and I.Pntr are defining words used to define an objects data structure. Let’s use PFA as one would for an indirect threaded Forth, i.e. PFA is the address put on the stack before execution of the DOES> code. Ins.Array creates an immediate word that takes an offset value from its PFA, compiles it as a literal, then compiles a JSR to Ocop+. The created word is the name of a variable or array. Ins.Array keeps track of the offset to the data for each new variable name in the variable Offset, which is incremented by the value ‘size’. I.Var is a special case of Ins.Array. I.Pntr is a special defining word that doesn’t increase the offset value, which is useful in constructing variable sized objects, but must be used with care. I.Pntr cannot be followed by Ins.Array or I.Var or the resulting instance variables will not have the correct offset.

The method defining word, :M, is nothing more than the usual colon definition, but changes could be made in the future. For example, :M could look for a duplication of the new method and issue a warning.

A special abort routine is defined. This abort routine is turned on by Define.Child.Class and turned off by Name.Child.Class. The reason for a special abort routine is that a compilation error while a child class is being defined leaves the hidden part of the object relinked to the forth dictionary. Unfortunately, because of the way :Class and :Instance work a subsequent attempt to compile the class definition, and consequent execution of :Class or :Instance, causes the dictionary to be relinked in such a way that the first method of the nearest ancestor class is the first word searched by the forth interpreter. This leads the interpreter to <root> which has a zero link, terminating search of the context vocabulary and leaving the user shut out from the default Forth words.

The next group of words are used in connecting messages with methods. The most important word in this section is Selector. The ‘key’ input argument to Selector is the LFA of the first method of an object. Selector then gets the next character string in the input stream and uses it to identify the appropriate method. Get.Meth finds the method and passes the methods CFA to Do.OR.Compile, which executes the method if the state is interpret and compiles the word otherwise. The best way to understand these words is to first look at Do.Meth. Do.Meth pushes the object’s data field address, DFA, on the object stack, then execute the method’s CFA, and finally pops the object stack. Compile.Meth compiles code which does the same thing at run time, except that it compiles a JSR to the method.

The actual definition of OBJECT begins with Ob.Words,which is used by :Class and :Instance to relink the previous words so they are visible by the Forth interpreter. <root> acts as a null CDO or a stopper for method link lists by setting its LFA to zero. <root> acts like a CDO by having a handle to data in the name area that is set to zero. The variable #c.Pvt.Tail is initialized to what eventually will be the CFA of the last word in the hidden class part of OBJECT. Offset is initialized to zero. All of the instance variables used by OBJECT are then defined and Offset is saved in #class.Size for later storage in OBJECT’s data structure as class.Size (Remember that Offset is used by the variable defining words, such as I.Var to accumulate the size of the instance object’s data set..

The next four words are used in class methods but are not available as methods. SetClassStruc, the most important, initializes the data structure of child classes. It is defined here so that it can use the variable names defined by the previous I.Var definitions. In order for the link changes to work after execution of NEW-SEGMENT all LFA’s must be converted to a relative link address, RLA, from a dictionary base pointer. A call to ClassStrucAllot with argument #class.Size gets the necessary space in the name area. ClassStrucAllot is set up to leave an error message but this feature is not implemented yet. After the space is allocated the returned address is duplicated. One copy is converted to a relative address and stored in the next memory location as a handle, the other copy is pushed onto the object stack. With the new object’s DFA on the object stack the instance variable names can be used to store the needed data. For example, the LFA of the head method for the class defining object is fetched from the variable #c.Head, converted to a RLA and stored in the field called class.Key. Further explanation of SetClassStruc is best done along with a discussion of the Define.Child.Class and Name.Child.Class, below. Next, the variable #c.Pub.Tail is initialized. This mimics the action of Hide.

The words Pr.ob.ivar, Pr.class.meths, Pr.ins.meths, and Describe are methods that can be used to describe a class defining object. As discussed earlier, Pr.ob.ivar only works with OBJECT, it won’t print any new instance variables in a child class.

The next three methods are the most important. The first two control the creation of child classes and the third makes instances of the class. Their use was described in the syntax section. Define.Child.Class initializes temporary variables used during the definition of a child class. Name.Child.Class actually creates a new child class, it sets up the data structure, seals the object so that the Forth interpreter cannot find its methods or variable names, links the tail method (which is the first method defined for a child class and the last one in the search order) of each part (class or instance) of the object to the head method (first in the search order) of the parent class and delinks the section defining words. Lets examine these methods, along with SetClassStruc and the as yet undefined words :Class and ;Class. The words :Instance and ;Instance behave similar to :Class and ;Class, so are not discussed.

Please examine each step in Define.Child.Class, in most cases the value contained in an instance variable of the object executing the Define.Child.Class method is stored in a temporary variable. In three cases an RLA is converted to a LFA. The LFA of the most recently defined public forth word is saved in #Forth.Head for use by the SetClassStruc routine. Saving class.Size, ins.Size, class.Key and ins.Key implements the inheritance feature of object oriented programming. The variables #c.Pvt.Tail thru #i.Pub.Tail are set to zero to flag the use or not of the section defining words :Class and :Instance. The variable #parent is set to the relative DFA of the object executing Define.Child.Class. The words :Class etc. are relinked to the dictionary and the custom abort routine is installed. This completes the setup, we’re now ready to execute :Class or :Instance.

:Class has two types of actions. First, it initializes certain variables. The size of the class defining object’s data structure is obtained from #class.Size and stored in Offset, remember that words like I.Var use the variable Offset. The variables #c.Pvt.Tail and #c.Pub.Tail are initialized to the same value. Each holds the future CFA of the tail word in the class section of the new object. This is converted to an LFA later. The variable C.or.I? is set to flag that compilation is inside the class section of the new object. The second type of action is to relink all ancestor class methods to the dictionary by executing Relink.Parents. Note that :Class is not a method, so it doesn’t have access to the instance variables of the object which executed Define.Child.Class.

Relink.Parents is one of the most difficult words in the entire code. It begins by pushing the DFA of the object executing Define.Child.Class (stored in #parent by Define.Child.Class) on the object stack in order to use instance variable names in the definition. Next, it checks the C.or.I? flag and then branches to the correct loop. The Begin-Repeat loop relinks each ancestor object and exits when it reaches an ancestor object with a class.Key of zero, an event which occurs when relinking reaches the null object <root>. The following is executed for each ancestor object, say Ob(i). If class.Key is not zero it checks class.Tail to see if Ob(i) has a class section. The instance variable class.Tail contains the value of #c.Pub.Tail at the time SetClassStruc was executed during the definition of Ob(i). Remember, #c.Pub.Tail is set to zero by Define.Child.Class and it is changed to non-zero by :Class. Thus, class.Tail is zero if the Ob(i) has no class section, and is non-zero if Ob(i) has a class section.

If there is no class section of Ob(i) then no relinking should be done. In this case Relink is skipped, the next object’s DFA is calculated from the contents of ivar Parent, the old DFA is popped from the object stack, and the new DFA is pushed on the object stack. Thus, when the loop starts again with a fetch of class.Key it will operate on the parent of Ob(i). In the case that class.Tail is not zero then relinking must be done. The current value of the objects LFA is stored in the ivar Ob.name.link for future restoration. Then, the offset to the head class method is stored in the LFA of Ob(i). Finally, the contents of the tail method’s LFA are swapped with the value in c.Tail.link.

Hide can be used during the definition of a class or instance section. Hide simply resets# c.Pub.Tail, if defining a class section, or #i.Pub.Tail, otherwise. This makes #c.Pvt.Tail and #c.Pub.Tail different, so that later one can tell if Hide was used.

The word ;Class has two parts. The first part stores the LFA of the head class method in the variable #c.Head, saves Offset in #class.Size, and converts the CFA of the words pointed to by #c.Pvt.Tail and #c.Pub.Tail to LFA’s. Remember that these two values are different if the word Hide was used to hide some of the methods or instance variables. The second task of ;Class is to delink the ancestor objects. This process is essentially the inverse of the relink process except that the contents of class.Key are not needed, because the original contents of the objects LFA were stored in Ob.name.link.

Name.Child.Class actually sets up the new object. First, it delinks the words :Class etc., restores the normal abort routine, creates an immediate name for the new class defining object, and then enters SetClassStruc. The SetClassStruc routine has been partially explained. Now let’s examine the handling of c.Tail.link and i.Tail.link, which, as we have seen, each store the required link change for the tail unhidden method of each section of the class defining object. Let’s consider c.Tail.link as an example. Recall that only two links need to be changed by :Class. The second link change requires that the tail unhidden method be redirected to the first hidden word, if there is one, or the next regular public Forth word, otherwise. Which specific change to make is determined at this point and stored in the field c.Tail.link for later use. The variables #c.Pub.Tail and #c.Pvt.Tail contain the LFA of the tail unhidden method and tail hidden method, respectively. If there is a hidden part then the contents of #c.Pub.Tail and #c.Pvt.Tail will not be the same, (because of the action of Hide.) so c.Tail.link should be set to the default contents of the tail unhidden word’s LFA, i.e. to the contents of the address pointed to by the contents of #c.Pub.Tail. If the contents of #c.Pub.Tail and #c.Pvt.Tail are the same then there is no hidden part (Hide has not been used) and the offset to the next public word is calculated (using #Forth.Head) and stored in c.Tail.link. Finally, notice that if the new object has no class section (specifically, if ;Class was not executed.) then #c.Head contains the LFA of the head class method of the parent class, which is stored in the class.Key field. Similarly for #i.Head and ins.Key.

The final task of Name.Child.Class is to seal the object and link it to the parent object. Alteration of the links occurs in the two IF-THEN parts of Name.Child.Class. If there are no additions to methods or instance variables in the class part of the new CDO then no link changes should be made. Determining whether there has been additions or not is made by examining #c.Pub.Tail (#c.Pvt.Tail would work just as well), which was set to zero by Define.Child.Class and would only be non-zero if :Class were executed during the child definition. The order of execution inside the IF-THEN part is important. First the tail hidden word in the class part, probably an instance variable, is linked to the most recently defined public word in the dictionary. Second, the tail unhidden method is linked to the head method of the parent class to implement inheritance. If there is no hidden section, because Hide was not used, then the second step just overwrites the first step because #c.Pub.Tail and #c.Pvt.Tail will contain the same number. Link changes in the instance part of the new class defining object are handled similarly.

The DOES> code of a class defining object is different from that of an instance object because its data is in the name area. The handle to a class defining object’s data is stored in its PFA, so the DOES> code is a fetch to get the relative address of the DFA, calculate the DFA, a dup and fetch to get the RLA of the head class method.

The Make.Instance method is simple by comparison. It creates an immediate name, stores the RLA of the head instance method in the next long word, and allots enough space for the instance data structure. The DOES> code simply duplicates the PFA and fetches the RLA of the head instance method, converting it to the LFA.

The definition of data structure and methods for instances of OBJECT are similarly defined. The only default methods provided are those useful in describing an instance object. Notice that, as with the class section, an important control variable, I.Key, is defined as a regular instance variable. This means that one could use this variable in methods, or even change its value. However, this is very dangerous since this variable is the link from between an instance and its class defining object. Changing this pointer can have disastrous results.

This essentially completes the definition of OBJECT. The actual construction is done by :OBJECT. There are a lot of references to specific names or addresses in these procedures because OBJECT is the first object.

Examples

The file concludes with several example objects. The first example is that of a simple integer object. Each instance of Integer can hold one long word integer and has the messages Save and Fetch. It is clearly very inefficient compared to the standard VARIABLE defining word. The second example shows how to define a fixed size array class of 10 cells.

The third example allows variable size array objects to be defined and shows the power of being able to redefine the Make.Instance method. This example also demonstrates use of the I.Pntr defining word. As mentioned earlier, this word must be the last instance variable and no child class may add instance variables. Thus, the instance variable Length is defined here, although it is not used by instances of Array, in order to be used by instances of a child class of Array. Be careful with this word! The next two examples use the variable array object to define a Vector object and a String object. Error checking has been implemented, but otherwise the objects are very primitive.

Finally, the example object Struct can be used to define C-style data structures. Again, it shows the power of being able to redefine the Make.Instance method. Note that even the DOES> code of Make.Instance has been changed. Also notice that the words S.Array and LongInt are instance variable defining words like Ins.Array and I.Var. These words must be defined in the instance section in order to be available to define the instance section of child class objects. These words cannot be used during definition of a child’s class section, one needs to use the regular instance variable defining words.

Improvements

There are several areas in which this code can be improved. The most obvious need is for assembly coding of the object stack control words, especially the word Ocop+ since it represents the execution overhead for fetch and save operations on instance variables. It would be nice to give the object stack its own CPU register. Unfortunately MACH2 does not leave any untrashable registers for applications, unless one gives up local variables by using A2. Second, there are no dynamic objects, although the Mac’s heap would make implementation relatively easy. Third, I have not included words to accommodate floating point numbers. Fourth, the error handling is rather primitive. Etc.

Caveats

I have tried to use this code as much as possible before publication. However, there certainly are combinations I have not yet tried. So, let the user beware. I would appreciate hearing about any suggestions, bugs, or improvements. My mailing address is Wayne Joerding, Department of Economics, Washington State University, Pullman, WA, 99164.

Listing 1: Object Forth for Mach2
\ ObjectFORTH.9  by

\  Wayne Joerding
\S.E. 430 Dilke St.
\Pullman, WA 99163

\ Copyright 1988 by Wayne Joerding for MacTutor

only mac 
also forth

$4EBA CONSTANT JSR_d(PC)
$4E75 CONSTANT RTS

$203C   Constant  MOVE.L_#,D0
$41FB08FA Constant  LEA_$-6(PC,D0.L),A0
$2D08   Constant  MOVE.L_A0,-(A6)

: Defer.Not.Init .” Uninitialized” abort ;
: Defer 
 Create -4 ALLOT JSR_d(PC) W, 
 [‘] Defer.Not.Init HERE - W, RTS W,
 ;
: Let: ( -- cfa+2 )  ‘ 2 + ;
: Do: ( cfa -- )  ‘ over - swap W! ;

\ ==== ObjectFORTH =======================

20 4 *  CONSTANT Maxnest  
VARIABLE Ostack 

\ ---- Allocate space for Object Stack --
Ostack 4 + maxnest + Ostack ! maxnest Vallot

GLOBAL
: Init.Ostack Ostack 4 + maxnest + Ostack ! ;

\ ============================================
CREATE ObjectFORTH 

\ ------ Section defining words --------------
GLOBAL Defer :Class
GLOBAL Defer :Instance
GLOBAL Defer ;Class
GLOBAL Defer ;Instance
GLOBAL Defer Hide

CREATE Ob.DefWords 
\ ============================================
GLOBAL
CODE DictBase@ ( -- n ) 
 MOVE.L $-532(A5),-(A6)   RTS
 END-CODE MACH

: Relink.DefWords
 [ ‘ Ob.DefWords body>link dup @ swap 
 DictBase@ - swap ] literal literal DictBase@ + !
 ; 
: Delink.DefWords
 [ ‘ Ob.DefWords body>link ‘ ObjectFORTH 
 body>link over swap - swap DictBase@ - swap ] 
 literal literal DictBase@ + ! 
 ;

\ ==== Global Variables for Class Definition ===
VARIABLE #class.Size 
VARIABLE #ins.Size 
VARIABLE #Forth.Head 
VARIABLE #c.Head 
VARIABLE #c.Pub.Tail 
VARIABLE #c.Pvt.Tail 
VARIABLE #i.Head 
VARIABLE #i.Pub.Tail 
VARIABLE #i.Pvt.Tail 
VARIABLE #parent 
VARIABLE #C.or.I?

\ ====== Object stack ===========================
GLOBAL
: Opush  ( n -- )\ push from Pstack to Ostack
 Ostack dup @ 4 - = 
 IF .” Ostack overflow” abort THEN 
 Ostack -4 over +! @ ! 
 ;

GLOBAL
: Opop ( -- )  \ discard top number on Ostack.
 Ostack dup maxnest + 4 + swap @ = 
 IF .” Ostack underflow” abort THEN 
 4 Ostack +! 
 ;

GLOBAL
: Ocop+ ( n -- n+os )\ add Ostack to Pstack.
 Ostack @ @ + 
 ; 

GLOBAL
: Ocop ( -- os ) \ copy Ostack to Pstack.
 Ostack @ @ 
 ;


\ ==== Data Structure Defining Words =============
GLOBAL VARIABLE Offset    

GLOBAL
: Ins.Array ( size -- ) ( name -IN- )
\ Make a new instance variable of ‘size’ bytes.
 CREATE immediate
 Offset @ , \ store offset
 dup 2 mod +     \ make sure even number
 Offset +!\ increase offset 
 DOES>  ( ob.DFA -OS- ob.DFA ) 
 @ [compile] literal 
 compile Ocop+   
 ;

GLOBAL
: I.Var ( -- ) ( name -IN- )
 4 Ins.Array 
 ;

GLOBAL
: I.Pntr ( -- ) ( name -IN- ) 
\ Make ivar without incrementing.
 CREATE immediate
 offset @ , \ compile offset.
 DOES>  ( ob.DFA -OS- ob.DFA ) 
 @ [compile] literal 
 compile Ocop+   
 ; 

\ ==== Method defining word =======================
GLOBAL
: :M  ( -- )\ Define a method.
 :
 ;

\ ====== Custom Abort routine =====================
80 USER (ABORT)
VARIABLE ^ABORT
: Ob.Abort ( n -- )\ Use during class definition.
 #C.or.I? @ cr 
 IF .” Class part” ;Class 
 ELSE .” Instance part” ;Instance 
 THEN 
 ^ABORT @ (ABORT) ! ABORT 
 ;

\ ====== Message support ===========================
: link>name 4 + ;

: Compile.Meth ( meth.CFA  ob.DFA -- )
\
\the following line was edited out -- JL     
\[compile] literal \ make a literal of ob.DFA
\
\and replaced by the following four lines
 MOVE.L_#,D0     W,
 here -           ,
 LEA_$-6(PC,D0.L),A0  ,
 MOVE.L_A0,-(A6)     W,

 compile Opush   \ compile a call to opush
 JSR_d(PC) W, here - W, 
 compile Opop
 ;

: Do.Meth ( meth.CFA  ob.DFA -- )
 Opush execute Opop
 ;

: Do.OR.Compile  ( ob.DFA  meth.CFA  f<>0 -- )
 1 =
 IF swap Do.Meth
 ELSE 
 swap state @ 
 IF Compile.Meth
 ELSE Do.Meth  THEN
 THEN
 ;

GLOBAL
: Find.Meth?
{ lfa  strng.adr | f -- strng.adr  CFA  f<>0 }
\ f = as with FIND
 0 -> f 
 BEGIN
 lfa  link>name C@ %11111 and 
 strng.adr C@ =  
 IF 1 -> f strng.adr C@ L_ext 1+ 1 
 DO   strng.adr I + C@ lfa 4 + I + C@ <>
 IF 0 -> f leave THEN
 LOOP
 THEN
 f 0= lfa @ 0 <> and
 WHILE  \ continue if meth <> message & LFA<>0
 lfa  @  negate +> lfa
 REPEAT
 strng.adr f 
 IF lfa dup link>body swap link>name C@
 %10000000 and 
 IF 1 ELSE -1 THEN
 ELSE f
 THEN
 ;

GLOBAL
: Get.Meth( key  strng.adr -- meth.CFA f<>0 )
 Find.Meth? 
 ?dup IF
 rot drop 
 ELSE 
 cr .” Method --> “ count %11111 and 
 type 3 spaces .” Not Found” ABORT 
 THEN
 ;

GLOBAL
: Get.Msg ( -- strng.adr )
 32 word pad over C@ L_ext 1+ cmove pad
 ;

GLOBAL
: Selector ( ob.DFA key -- )( <msg> -IN- )
 Get.Msg
 Get.Meth   
 Do.OR.Compile 
 ;


CREATE Ob.Words

\ ==== Define OBJECT ============================
: :Root
 Create \ stopper word
 NP @ DictBase@ - ,
 0 NP @ ! \ put 0 for class.Key
 4 NP +!\ increment NP by 4 bytes
 ;

:Root <root>

\ ---- Define class section of OBJECT ----------
here #c.Pvt.Tail ! 

0 offset !
GLOBAL  I.Var class.Key   
 I.Var class.Tail
 I.Var c.Tail.link 
GLOBAL  I.Var class.Size  
GLOBAL  I.Var ins.Key
 I.Var ins.Tail  
 I.Var i.Tail.link 
GLOBAL  I.Var ins.Size    
 I.Var parent    
 I.Var Ob.name.link
 I.Var Class.RLA 
offset @ #class.Size !  

: cr5sp cr 5 spaces ;

: <Pr.Meth> ( adr cnt -- )
 cr5sp %11111 and swap over type 
 25 swap - spaces .” Link adr = “ 
 dup . space .” Offset = “ dup @ . 
 ;

: Pr.meths( key -- )
 BEGIN  
 dup @  
 WHILE
 dup link>name count 
 <Pr.Meth> dup @  -
 REPEAT drop 
 ;
CODE ClassStrucAllot ( n -- addr )
 MOVE.L $-1FC(A5),D0
 MOVE.L D0,D1
 ASR.L  #$1,D1
 BCC.S  @1
 ADDQ.L #$1,D0   
@1 MOVE.L D0,A0
 ADD.L  (A6)+,D0 
 MOVE.L D0,$-1FC(A5) 
 MOVE.L A0,-(A6) 
 MOVE.L #0,-(A6) 
 RTS
 END-CODE


: SetClassStruc  ( -- ) 
 #class.Size @  ClassStrucAllot  
 IF .” Memory error” . .” Handle” . abort
 ELSE
 dup DictBase@ -  ,
 Opush  
 #c.Head @ DictBase@ - 
 class.Key !
 #c.Pub.Tail@ dup IF DictBase@ - THEN
 class.Tail !    
 #c.Pub.Tail @ dup 
 IF dup #c.Pvt.Tail @ =   
 IF #Forth.Head @ -  
 ELSE @ THEN     
 THEN c.Tail.link  !
 #class.Size @ class.Size ! 
 #i.Head @ DictBase@ - 
 ins.Key !
 #i.Pub.Tail@ dup IF DictBase@ - THEN
 ins.Tail ! 
 #i.Pub.Tail @ dup 
 IF dup #i.Pvt.Tail @ =   
 IF #Forth.Head @ -  
 ELSE @ THEN     
 THEN i.Tail.link  !
 #ins.Size   @ ins.Size   ! 
 #parent@ Parent ! 
 last DictBase@ - Class.RLA ! 
 last @ ob.name.link !  
 Opop   
 THEN
 ; 

here #c.Pub.Tail ! 

:M pr.ob.ivar  ( -- )
 cr cr .” Class instance variables are :”
 cr5sp .” class.Key     = “ 
 class.Key @ DictBase@ + .
 cr5sp .” class.Tail    = “ 
 class.Tail @ DictBase@ + .
 cr5sp .” c.Tail.link   = “ 
 c.Tail.link @ .
 cr5sp .” class.Size    = “ 
 class.Size @ .
 cr5sp .” ins.Key       = “ 
 ins.Key @ DictBase@ + .
 cr5sp .” ins.Tail      = “ 
 ins.Tail @ DictBase@ + .
 cr5sp .” i.Tail.link   = “ 
 i.Tail.link @ .
 cr5sp .” ins.Size      = “ 
 ins.Size @ .
 cr5sp .” Parent        = “ 
 Parent @ DictBase@ + .
 cr5sp .” ob.name.link  = “ 
 ob.name.link @ .
 cr5sp .” Class.RLA     = “ 
 Class.RLA @ DictBase@ + .
 ;
GLOBAL
:M Pr.class.meths( -- ) 
 cr cr .” Class methods are :” 
 class.Key @ DictBase@ +  
 Pr.meths
 ;
GLOBAL
:M Pr.ins.meths  ( -- )
 cr cr .” Instance methods are :”
 ins.Key @ DictBase@ +    
 Pr.meths
 ;

GLOBAL
:M Describe ( -- )
 cr .” ---- Class Information --------------------------------------”
 cr .” NAME : “ Class.RLA @ DictBase@ + dup . 
 link>name count %11111 and type 
 5 spaces .” pointer to class data = “ Ocop .
 Pr.ob.ivar
 Pr.class.meths
 Pr.ins.meths  cr
 ; 

GLOBAL
:M Define.Child.Class( -- ) 
 last #Forth.Head !
 class.Size @ #class.Size ! 
 ins.Size @ #ins.Size !   
 class.Key @ DictBase@ + #c.Head ! 
 0 #c.Pvt.Tail ! 
 0 #c.Pub.Tail ! 
 ins.Key @ DictBase@ + #i.Head !
 0 #i.Pvt.Tail ! 
 0 #i.Pub.Tail ! 
 Ocop DictBase@ - #parent !
 Relink.DefWords 
 [ ‘ Ob.Abort body>link DictBase@ - ] literal
 DictBase@ + link>body (ABORT) dup @ ^ABORT !  !
 ;

GLOBAL
:M Name.Child.Class( -- ) ( <name> -IN- )
 Delink.DefWords 
 ^ABORT @ (ABORT) !  \ restore old abort routine
 CREATE immediate
 SetCLassStruc

 \ -- seal class and link to parent ------------
 last dup #Forth.Head @ - swap!    
 #c.Pub.Tail @ ?dup  \ false => no class section
 IF  #c.Pvt.Tail @ dup #Forth.Head @ - swap  !
 dup class.Key @ DictBase@ + - swap  !
 THEN     
 #i.Pub.Tail @ ?dup  \ false => no class section
 IF   #i.Pvt.Tail @ dup #Forth.Head @ - swap !
 dup ins.Key @ DictBase@ + - swap !
 THEN     

 DOES> @ DictBase@ + dup @ DictBase@ + Selector
 ;
GLOBAL
:M Make.Instance ( -- ) ( <name> -IN- )
 CREATE immediate
 ins.Key @ ,
 ins.Size @ allot
 DOES> dup @ DictBase@ + Selector
 ;

last #c.Head !


\ ----Define instance section of root object --------

here #i.Pvt.Tail !

0 Offset !
 
GLOBAL  I.Var I.Key

Offset @ #ins.Size !
here #i.Pub.Tail ! 

GLOBAL
:M Pr.Imeths( -- )
 I.Key @ DictBase@ + 
 cr cr .” Instance methods are :”
 Pr.meths
 ;
GLOBAL
:M Name ( -- )
 cr .” NAME : “ Ocop 4 - body>link link>name count 
 %11111 and type 5 spaces .” instance.DFA = “ I.Key . 
 ;
GLOBAL
:M Describe ( -- )
 cr .” ---- Instance information ------------------------------------”
 Name
 Pr.Imeths
 ;

last #i.Head !


\ ---- Child Class defining words ------------------
: Relink{ t o k | -- } ( dfa -OS- dfa’ )
 Class.RLA @ dup DictBase@ + 
 dup @ Ob.name.link  ! 
 swap k @ - swap  ! 
 o @ t @ DictBase@ + dup @ o  ! !
 ;

: Relink.Parents ( -- )
 #parent @ DictBase@ + Opush 
 #C.or.I? @ 
 IF
 Begin
 class.Key @
 While
 class.Tail dup @
 IF     c.Tail.link  class.Key 
 Relink
 ELSE drop
 THEN Parent @ DictBase@ +
 Opop Opush
 Repeat
 ELSE
 Begin
 class.Key @
 While
 ins.Tail dup @
 IF     i.Tail.link  ins.Key 
 Relink
 ELSE drop
 THEN Parent @ DictBase@ +
 Opop Opush
 Repeat
 THEN
 Opop 
 ;

: Delink{ o t | -- } ( dfa -OS- dfa’ )
 t @  
 IF
 Ob.name.link @ Class.RLA @ DictBase@ + !
 o @ t @ DictBase@ + dup @ o ! !
 THEN
 Parent @ DictBase@ + 
 Opop Opush
 ;

: Delink.Parents ( -- )
 #parent @ DictBase@ + Opush 
 #C.or.I? @ 
 IF
 Begin
 class.Key @\ class.Key is zero for <root>
 While
 c.Tail.link   class.Tail
 Delink
 Repeat
 ELSE
 Begin
 class.Key @\ class.Key is zero for <root>
 While
 i.Tail.link   ins.Tail 
 Delink
 Repeat
 THEN
 Opop
 ;

: <:Class>( -- )
 #class.Size @ Offset !
 here #c.Pvt.Tail !
 here #c.Pub.Tail !
 -1 #C.or.I? !
 Relink.Parents  
 ;
Let: :Class Do: <:Class>

: <;Class>( -- )
 last #c.Head !
 Offset @ #class.Size !
 #c.Pvt.Tail @ body>link #c.Pvt.Tail !
 #c.Pub.Tail @ body>link #c.Pub.Tail !
 Delink.Parents
 ;
Let: ;Class Do: <;Class>

: <:Instance>  ( -- )
 #ins.Size @ Offset !
 here #i.Pvt.Tail !
 here #i.Pub.Tail !
 0 #C.or.I? !
 Relink.Parents
 ;
Let: :Instance Do: <:Instance>

: <;Instance>  ( -- )
 last #i.Head !
 Offset @ #ins.Size !
 #i.Pvt.Tail @ body>link #i.Pvt.Tail !
 #i.Pub.Tail @ body>link #i.Pub.Tail !
 Delink.Parents
 ;
Let: ;Instance Do: <;Instance>

: <Hide>
 here #C.or.I? @ 
 IF  #c.Pub.Tail ! ELSE  #i.Pub.Tail ! THEN
 ;

Let: Hide Do: <Hide>

\ ------ Complete and Seal root object ----------

: :OBJECT
 CREATE immediate\ make header for “OBJECT”
 DOES> @ DictBase@ + dup @ DictBase@ + Selector
 ;

:OBJECT OBJECT

\ -- Initialize temporary variables used by Set.Struc --
 ‘ <root> 4 + @ #parent ! 
 ‘ Ob.Words body>link #Forth.Head !
 #c.Pub.Tail @ body>link #c.Pub.Tail ! 
 #i.Pub.Tail @ body>link #i.Pub.Tail ! 
 #c.Pvt.Tail @ body>link #c.Pvt.Tail ! 
 #i.Pvt.Tail @ body>link #i.Pvt.Tail ! 
 
SetClassStruc    \ init class data structure 

\ -- seal class and link to <root> ----------------
 Delink.DefWords
 ‘ <root> body>link #parent ! 
 #i.Pub.Tail @ dup #parent @ - swap !
 #c.Pub.Tail @ dup #parent @ - swap !
 #i.Pvt.Tail @ dup #Forth.Head @ - swap !
 #c.Pvt.Tail @ dup #Forth.Head @ - swap !
 0 ‘ <root> body>link 
 last dup ‘ Ob.DefWords body>link - swap
 ! !  

\ ====== EXAMPLES ==================
\ ====== Integer Class =============
 OBJECT Define.Child.Class
 :Instance
 I.Var Int
 Hide
 :M Fetch ( -- n )
 Int @
 ;
 :M Save ( n -- )
 Int ! 
 ;
 ;Instance

OBJECT  Name.Child.Class  Integer


\ ====== 10 cell Array Class ==============
OBJECT Define.Child.Class
:Instance
 10 ConstantMax.Size  
 10 4 * Ins.ArrayHead
Hide
 :M Describe
 cr .” ---- Instance Information --------------------------------”
 Name
 cr .” Max.Size (in cells)  = “ Max.Size .
 Pr.Imeths
 ;
 :M Store ( x i -- )
 \ Store value x in array for index = i
 Max.Size over 1 + < if .” index out of bounds” abort then
 4 * Head + !    
 ;
 :M Retrieve ( i -- )
 \ Retrieve value of array for index = i.
 Max.Size over 1 + < if .” index out of bounds” abort then
 4 * Head + @    
 ;
;Instance
OBJECT  Name.Child.Class  Array10  ( -- )


\ ====== Variable size Array Class ===============
Integer Define.Child.Class
:Instance
 I.Var  Max.Index\ max size of array
 I.Var  Length   \ number of elements in array
 I.Pntr Start    \ points to the start of array memory
Hide
 :M Describe
 cr .” ---- Instance Information --------------------------------”
 Name
 cr .” Max Length in cells  = “ Max.Index @ 1+ .
 cr .” Cell size in bytes   = “ Int @ .
 Pr.Imeths
 ;
 :M Store ( x i -- ) \ Store value x in array for index = i
 \ first cell has index of zero
 Max.Index @ over < over 0 < or 
 IF .” index out of bounds” abort THEN \ <-- error checking
 Int @ * Start + ! 
 ;
:M Retrieve ( i -- ) \ Retrieve value of array for index = i.
 Max.Index @ over < over 0 < or 
 IF .” index out of bounds” abort THEN \ <-- error checking
 Int @  * Start + @
 ;
;Instance
:Class
 :M Make.Instance ( n c -- ) ( <name> -IN- ) 
 \ Array instance of size n cells, cell size of c
 CREATE immediate
 ins.Key @  
 , \ store key to methods of parent class
 dup ,  \ save cell size in ‘Int’ variable
 over 1-  ,    \ make and save Max.Index
 0 ,    \ init current Length to zero
 * ins.Size @ + allot
 DOES> dup @ DictBase@ + Selector
 ;
;Class
Integer Name.Child.Class  Array  ( n c -- )

\ ====== Vector Class ================================
Array Define.Child.Class
 :Class
 :M Make.Instance ( n -- )
 4 Make.Instance
 ;
 ;Class
Array Name.Child.Class    Vector   ( n -- )

\ ====== String Class =================================
Array   Define.Child.Class
:Class
 :M Make.Instance ( n -- )
 1 Make.Instance
 ;
;Class
:Instance
 :M Describe
 cr .” ---- Instance Information --------------------------------”
 Name
 cr 5 spaces .” Max String length        = “ 
 Max.Index @ 1+ .
 cr 5 spaces .” Current String length    = “ Length @ .
 Pr.Imeths
 ;
 :M Print ( -- ) \ Prints string for this instance.
 Start Length @  dup 
 IF type ELSE .” string empty” drop drop THEN
 ;
 :M Store ( a -- ) \ Store a string with count byte at address.
 count dup Max.Index @ 2 + <
 IF dup Length ! Start swap cmove
 ELSE cr .” String too large for ‘Store’ “ drop drop
 THEN
 ;
;Instance
Array Name.Child.Class    String ( n -- ) 

\ ==== Struc Class =================================
OBJECT Define.Child.Class 
:Class
 : Make.Instance ( -- ) ( name -IN- )
 CREATE immediate
 Ins.Key @ ,
 ins.Size @ allot
 DOES> dup @ DictBase@ + Get.Msg Get.Meth
 drop execute state @
 IF [compile] literal THEN
 ;
;Class
:Instance
 : S.Array ( size -- ) ( name -IN- )
 CREATE 
 offset @ , 
 dup 2 mod +     
 offset +!
 DOES> @  +
 ;
 : LongInt ( -- ) ( name -IN- )
 4 S.Array
 ;
;Instance
OBJECT  Name.Child.Class  Struct

\ ==== Point Class ========================
Struct Define.Child.Class 
 :Instance
 LongInt Xdim
 LongInt Ydim
 ;Instance
Struct  Name.Child.Class  Point

Listing 2: Test code for the Mach2 OOPS extensions
\ This was on one of Wayne’s earlier disks.  
\ I included it here because it still works and makes a nice example.
\ -- JL
\ ------ testing words ----------------
\ -- test Integer ------
Integer Make.Instance XY
XY Describe

\ -- test of Array10 ----
 Array10 Make.Instance vec10
 000 0 vec10 Store
 111 1 vec10 Store
 222 2 vec10 Store
 cr 1 vec10 Retrieve .
vec10 Describe

\ -- test of Array ----
10 4 Array Make.Instance Arr
000 0 Arr Store
111 1 Arr Store
999 9 Arr Store
cr 9 Arr Retrieve .
Arr Describe

\ -- test of Vector ----
 10 Vector Make.Instance vec
 000 0 vec Store
 111 1 vec Store
 222 2 vec Store
 cr 2 vec Retrieve .
 vec Describe

\ -- test of String ----
14 String Make.Instance hello
hello Describe
: hel .” This is hello” ;
‘ hel 4 + hello Store
cr hello Print

\ -- test of Point ----
Point  Make.Instance  thisPoint
111 thisPoint Xdim ! cr thisPoint Xdim @ .
222 thisPoint Ydim ! cr thisPoint Ydim @ .