This is an ’emulator’ to demonstrate the features of my old Object-oriented Forth systems.
The original (old) source code of the file oofemu.4th written by me, as it has survived on the Internet is shown below.
Please note that certain pieces of information in the comments are very old, e.g. my contact information it it will not work and links to my papers are broken.
I am describing it here only because of its historic value. I have left it untouched even in places where it is outdated or could be improved. Let’s just go through its major points.
Hierarchical name spaces
Lines 45 to 70 implement a vocabulary structure with hierarchical search (if something is not found in CONTEXT its parents are searched. This is implemented on top of the ANS Forth search order words, trying very hard to make any other assumptions about the system at this point.
Classes will use the same search order.
Then some utility words are defined. [.] sets the search order so that the current vocabulary (where definitions are appended)is searched first followed by its parents.
This will be useful when we need to refer to another class’s fields or methods while writing a definition inside another class and we need to go back to work on our original class.
The word [..] sets the search order so that we go down one level in the hierarchy (takes the context vocabulary and makes its parent searched first, etc.). This is useful if we ever need to specifically refer to something in a parent class.
The word [><] swaps context and current properly so that the new context and its parents are searched.
The anatomy of a class
Classes are implemented as vocabularies in the sense described above. This is a single hierarchy type system, every new class is derived from Objects directly or indirectly. In addition to the data needed to word as a vocabulary each class stores certain other information, which is contained in the class’s Virtual Method Table (VMT), as follows:
- The number of methods allocated in the VMT table (maximum number of methods).
- The current number of methods in the VMT that have actually been named by the defining word Method.
- The size of the data area of an object instance.
- A back link to the paren’t class’s VMT.
- A link to this class’s vocabulary structure. This is more of a debugging feature.
- The methods themselves. In this implementation an array of execution tokens.
Creating a new class
A new class can be created by deriving it from an old class. One needs to make the old class the current vocabulary and just define the new class under it. Classes are created by the defining word Class which consumes the number of new virtual methods in the VMT. This is necessary so that space for them can be properly allocated.
The new class will inherit the fields and already populated virtual methods of its parent class. Whent he new class is created its VMT is cloned.
Names can be assigned to the new virtual method slots by using the defining word Method.
Cell-sized fields can be created by using the word Field. If fields of a different size are needed new defining words should be created to deal with them.
Assigning the implementation to a virtual method
Reserving a virtual method in the VMT and assigning a name to it by means of Method does only that, i.e. assigns a name so that the method can be conveniently referred to.
To make the method do anything meaningful one has to assign an implementation to it.
This is done in the following manner:
As MethodName use: Just like a colon definition, whatever the method supposed to do. ;M
This construct will compile the body of the definition and assign its action to the named method in the class currently being defined.
The anatomy of an object instance
Object instances contains their VMT address followed by all their data fields. The address of the object is the address of it’s first data field (thereby making the pointer to the VMT sit at what is technically a negative offset one cell back from the object’s address) but this convention makes of easier to deal with objects as data and not accidentally overwrite ‘system’ information in them.
Creating a new object instance
A new object instance is initialized by the word MakeObject which takes raw memory and turns it into an object by storing the location of the type appropriate VMT in the memory area and then calling the new object’s Init method to initialize fields in a manner defined by the application programmer.
This low level mechanism can be used to create objects e.g. in dynamically allocated memory. A common place to create objects is just in the dictionary data area where variables would be defined. The utility word Obj is provided for that purpose. Data needed to initialize the new object instance should be pushed onto the data stack, then the class should be selected by making it’s corresponding wordlist the context (first in search order). The defining word Obj can then be used to create a named object whose name will appear in the wordlist where definitions go.
Manipulating the current object instance
A reference/pointer to current object instance is stored in a global variable in this implementation. Usually it is recommended that in real life it should be assigned to a hard register if the hardware architecture allows it.
Similarly the VMT is cached in another variable or register.
There are a number of word to manipulate these two pointers (references) the most important ones for application programs are the following:
- O! which consumes the address of an valid, already initialized object and sets both the object and VMT references based on that.
- { or <( save the current object and current VMT on the return stack and set the new current object via O!.
- } or )> restore the current object and VMT saved by { or <(.
The { } construct did work in interpreter mode in the native OOF implementation but there is no way to do so in a portable manner for all ANS forth systems, so the definitions provided are compile only.
The source code
\ The (Dyn)OOF Emulator Version 0.0.2.
\
\ Copyright (C) ZSOTER, Andras 1996.
\
\ This is not the "real thing" just an emulator
\ written in ANS Forth (hopefully), so that people
\ who cannot run my OOF or DynOOF can try out (Dyn)OOF style objects
\ on an ANS-Forth system.
\ I have tested this program on dynoof-0.1.5 (try dynoof -A),
\ on PFE, and on gforth, so probably it is ANS enough that
\ it should run on most ANS-Forth systems.
\ You need the SEARCH ORDER wordset, and probably the minimal
\ requirements (8 wordlists, and 8-deep search order) will not
\ be enough for anything even remotedly useful.
\
\ Unlike in (Dyn)OOF -- { and } cannot be used in interpreter mode!
\ If you want to test an object interactively, use the word O!
\ instead of { to activate the object.
\
\ You can freely distribute, use or abuse this file, as long as
\ I am given credit for it, and you emphasize, that it is just
\ an emulator.
\ You can even modify it, and incorporate it in your own programs
\ as long as the above requirements are met.
\
\ For the real thing look at taygeta (taygeta.com or ftp.taygeta.com)
\ /pub/Forth/Reviewed/oof.zip
\ /pub/Forth/Linux/dynoof-0.1.5.tgz
\
\ For some documentation look at my FD papers:
\ http://www.forth.org/fig/andras.html
\ http://www.forth.org/fig/oopf.html
MARKER OOF-EMULATOR
ONLY FORTH DEFINITIONS
\ --------------------------------------------------------------------------
\ The first part is the hierarchical search order emulated by ANS Forth
\ style SEARCH-ORDER words.
\ The basic idea came from Anton Ertl, all the programming errors, bugs
\ and the like are from me.
\ The structure of a vocabulary is:
\ 1st CELL : Wordlist ID
\ 2nd CELL : Pointer to the PARENT vocabulary
: CELL- ( x -- x-CELL ) [ 1 CELLS ] LITERAL - ;
: (Get-Parents) ( Voc -- i*wid i )
DUP @ SWAP CELL+ @
DUP IF SWAP >R RECURSE R> SWAP THEN 1+
;
VARIABLE __CONTEXT
VARIABLE __CURRENT 0 __CURRENT !
: (Do-Voc) DUP __CONTEXT ! (Get-Parents) SET-ORDER ;
: (Vocabulary) ( wid +++ )
CREATE , __CURRENT @ , IMMEDIATE
DOES> (Do-Voc)
;
: VOCABULARY ( +++ ) WORDLIST (Vocabulary) ;
: DEFINITIONS ( -- ) DEFINITIONS __CONTEXT @ __CURRENT ! ;
\ Some more DynOOF style search order words.
: [.] ( -- ) __CURRENT @ (Do-Voc) ; IMMEDIATE
: [..] __CONTEXT @ CELL+ @ (Do-Voc) ; IMMEDIATE
: [><] __CURRENT @ DEFINITIONS (Do-Voc) ; IMMEDIATE
FORTH-WORDLIST (Vocabulary) FORTH
FORTH DEFINITIONS
\ -------------------------------------------------------------------------
\ And now comes the OOF emulator.
: Dummy ( -- ) ; IMMEDIATE \ A word which does not do anything.
\ A Class is just a Vocabulary which has a VMT (Virtual Method Table).
VOCABULARY Objects HERE CELL+ ,
3 , \ Maximal # of methods.
0 , \ Current # of methods.
0 , \ The size of an object instance.
0 , \ Parent's VMT.
' Objects >BODY , \ This Class.
' Dummy DUP DUP , , , \ The methods.
Objects DEFINITIONS
: (UndefinedMethod) ( -- ) 1 ABORT" Method Body is Undefined." ;
\ Some constants to make the program more readable.
0 CONSTANT __WordList
__WordList CELL+ CONSTANT __Parent
__Parent CELL+ CONSTANT __VMT
0 CONSTANT __Maximal#
__Maximal# CELL+ CONSTANT __Current#
__Current# CELL+ CONSTANT __Size
__Size CELL+ CONSTANT __VMTLink
__VMTLink CELL+ CONSTANT __ThisClass
__ThisClass CELL+ CONSTANT __Methods
: (CopyVMT) ( ThisClass ParentVMT -- NewVMT )
HERE >R
DUP @ DUP , >R \ Maximal#
CELL+ DUP @ , \ Current#
CELL+ DUP @ , \ Size
CELL+ DUP @ , \ Parent VMT
CELL+ SWAP , \ ThisClass
CELL+
R> 0 DO I CELLS OVER + @ , LOOP
DROP R>
;
VARIABLE (OPtr)
VARIABLE (VPtr)
: Class ( #NewMethods +++ )
VOCABULARY
HERE DUP CELL+ ,
2 CELLS - DUP \ The address of this class.
__Parent + @ __VMT + @ \ The Parent's VMT.
(CopyVMT) __Maximal# + OVER SWAP +! \ The New Maximal # of methods.
0 ?DO ['] (UndefinedMethod) , LOOP
;
: VmtOf ( -- Vmt ) __CONTEXT @ __VMT + @ ;
: [VmtOf] ( -- Vmt ) VmtOf POSTPONE LITERAL ; IMMEDIATE
: (SizeOf) ( VMT -- SizeOf ) __Size + ;
: SizeOf ( -- SizeOf ) __CONTEXT @ __VMT + @ (SizeOf) ;
: [SizeOf] ( -- SizeOf ) (SizeOf) POSTPONE LITERAL ; IMMEDIATE
: |> ( NewSize -- ) POSTPONE [.] SizeOf ! ;
: <| ( -- Firts-Unused-Offset ) DEFINITIONS SizeOf @ ;
: Nth ( MethodIX -- ) CELLS (VPtr) @ __Methods + + @ EXECUTE ;
: Field ( OldSize -- NewSize ) CREATE DUP , CELL+ DOES> @ (OPtr) @ + ;
: Offset ( Token -- FieldOffset ) >BODY @ ;
: Method ( -- )
__CURRENT @ __VMT + @
DUP __Current# + @
OVER __Maximal# + @ < 0= ABORT" Too many methods."
__Current# + DUP @ DUP CREATE , 1+ SWAP ! DOES> @ Nth
;
Method Done
Method Init
Method Restart
: Index ( Token -- MethodIndex ) >BODY @ ;
: ;M ( MethodIndex Noname-Sys -- )
POSTPONE ;
SWAP CELLS __CURRENT @ __VMT + @ __Methods + + !
; IMMEDIATE
: use: ( MethodIndex -- MethodIndex Noname-Sys ) :NONAME ;
: As ( -- MethodIndex ) ' Index ;
: !O ( Object -- ) (OPtr) ! ;
: O@ ( -- Object ) (OPtr) @ ;
: !Vmt ( VMT -- ) (VPtr) ! ;
: Vmt@ ( -- VMT ) (VPtr) @ ;
: O! ( Object -- ) DUP CELL- @ !Vmt !O ;
: Size@ ( -- Size ) Vmt@ (SizeOf) @ ;
: MakeObject ( i*x Type Address -- Object )
Vmt@ O@ 2>R
OVER !Vmt DUP CELL+ !O !
Init
O@
2R> !O !Vmt
;
: (Obj) ( i*x Type ++ )
CREATE HERE OVER (SizeOf) @ CELL+ ALLOT MakeObject DROP DOES> CELL+
;
: Obj ( i*x ++ ) __CONTEXT @ __VMT + @ (Obj) ;
\ For a "Compile-Only" { } the following definitions will do:
: } ( -- ) POSTPONE 2R> POSTPONE !O POSTPONE !Vmt ; IMMEDIATE
: { ( Obj -- ) POSTPONE Vmt@ POSTPONE O@ POSTPONE 2>R POSTPONE O! ; IMMEDIATE
\ For the digraph notation:
: )> ( -- ) POSTPONE } ; IMMEDIATE
: <( ( Obj -- ) POSTPONE { ; IMMEDIATE
No comments:
Post a Comment