OOP für alle Modula-2-Systeme
Objektorientierte Programmierung läßt sich nicht nur mit Hilfe neuer Sprachen wie Simula, Smalltalk, C++ oder Oberon verwirklichen: Das in SPC Modula-2 implementierte Modul ermöglicht bereits die wesentlichen Elemente der OOP - insbesondere das Prinzip der Vererbung.
Was ist nun objektorientierte Programmierung? Sie zeichnet sich durch zwei wesentliche Merkmale aus:
- die stärkere Bindung zwischen Prozeduren (bzw. „Methoden“) und Datentypen
- die Definition neuer Datentypen auf der Basis bereits existierender Datentypen (Prinzip der Vererbung)
Methoden = Prozedurvariablen
Die Bindung von Prozeduren an Datentypen läßt sich in Modula-2 bereits ohne größeren Aufwand mit Hilfe von Prozedurvariablen realisieren. Als Beispiel definieren wir einen Typ, der als Wert eine INTEGER-Variable sowie eine Prozedur zum Schreiben des INTEGER-Wertes enthält:
TYPE WriteProc =
PROCEDURE(INTEGER,INTEGER);
INTObject = RECORD
Value : INTEGER;
Write : WriteProc
END;
Nun ist noch eine Prozedur zur Initialisierung einer, entsprechenden Variablen nötig:
PROCEDURE INIT(VAR i : INTObject; v : INTEGER);
BEGIN i.Value := v;
i.WriteProc := InOut.WriteInt
END INIT;
In einem Klientmodul (also einem Modul, das diese Bezeichner importiert) könnte es dann später heißen:
VAR i : INTObject;
BEGIN INIT(i,10);
i.Write(i,1)
END ...
Andere Programmiersprachen, die OOP beinhalten, bieten elegantere Konstrukte an, so daß der Zusammenhang zwischen i und Write bereits in der Schreibweise i.Write(1) vom Compiler erkannt und richtig umgesetzt wird. Darüber hinaus speichern sie die Prozeduren in einer Tabelle ab, die für jeden Datentyp einmal generiert wird und somit nicht von jeder Variablen „mitgeschleppt“ werden muß. All dies kann im Prinzip auch in Modula-2 mit Hilfe eines Moduls realisiert werden, jedoch rechtfertigt der Nutzen den Aufwand nicht: In den allermeisten Fällen kann die Schreibweise Variable.Prozedur durch Prozedur (Variable) ersetzt werden. Für die sehr wenigen Ausnahmefälle reicht die oben beschriebene Methode aus.
Tatsächlich hat die Schreibweise Variable.Prozedur den Nachteil, daß man den jeweiligen Datentyp praktisch neu definieren muß, wenn man auch nur eine einzige Prozedur hinzufügen will, was unter Umständen die erneute Kompilierung einiger Module nach sich zieht. Ohne objektorientierten Programmierstil schreibt man einfach ein neues Modul mit der benötigten Prozedur, was letzten Endes den gleichen, erwünschten Effekt hat.
Vererbung = MOBS
Das Prinzip der Vererbung ist das Hauptthema dieses Artikels. Auch das kann in Modula-2 indirekt realisiert werden.
Vererbung kommt u.a. auch im Bereich der Mathematik vor. Hier bedeutet es, daß neue Definitionen auf bereits existierende zurückgreifen. Ein sehr vereinfachtes Beispiel ist im folgenden wiedergegeben:
- Ein Punkt ist durch seine kartesischen Koordinaten bestimmt.
- Ein Kreis ist die Menge aller Punkte, die zu einem gegebenen Mittelpunkt den gleichen, gegebenen Abstand haben.
In der Definition des Kreises wird die Definition eines Punktes nicht wiederholt, sondern einfach der Begriff Punkt genannt, der ja bereits bekannt ist. Übertragen auf objektorientierte Programmiersprachen (wie z.B. Oberon - Wiiths Weiterentwicklung von Modula-2 - deren Schreibweise im folgenden übernommen wird) läßt sich dieser Sachverhalt folgendermaßen darstellen:
TYPE Punkt = RECORD x, y : INTEGER END;
Kreis = RECORD (Punkt) r : INTEGER
END;
VAR p : Punkt; k : Kreis;
Im Typ Kreis sind nach obiger Definition auch die Komponenten des Typs Punkt sichtbar, so daß neben k.r auch k.x und k.y vorhanden sind. Darüber hinaus sind derart definierte Datentypen in einer Richtung zuweisungskompatibel, d.h. p:=k hat die gleiche Wirkung wie p.x := k.x; p.y := k.y, wobei k.r nicht beachtet wird, k := p ist hingegen nicht erlaubt, da k.r sich danach in einem Undefinierten Zustand befände.
Die Wirkung von p := k kann mit dem mathematischen Begriff der Abbildung beschrieben werden: k wird auf p abgebildet. In Oberon wird das Prinzip der Vererbung auch auf Pointer ausgeweitet. Mit
TYPE PunktPtr = POINTER TO Punkt;
KreisPtr = POINTER TO Kreis;
VAR pp : PunktPtr; kp ; KreisPtr;
ist der Befehl pp := kp zulässig. Nach dieser Zuweisung zeigt pp auf den kompletten Inhalt von kp, der mit Hilfe von Typprüfungen auch erreicht werden kann: Mit dem Booleschen Ausdruck pp IS KreisPtr kann der Typ einer Variablen überprüft werden (nach obiger Zuweisung ergibt dieser Ausdruck „TRUE“), und mit pp(KreisPtr) kann auf die Komponenten des Kreistyps zugegriffen werden: pp(KreisPtr)^.r := 5.
Mit diesen Mitteln können nun z.B. Baumstrukturen definiert werden, deren Knoten unterschiedlichen Typs sind. Man schreibt in einem Grundmodul die Prozeduren, die die Verwaltung des Baums bewerkstelligen, und kann dann in einem Klientmodul den entsprechenden Knotentyp mit dem benötigten Inhalt erweitern und trotzdem auf die Prozeduren des Grundmoduls zurückgreifen. Darüber hinaus gelten die oben beschriebenen Typprüfungen nicht nur für Pointer, sondern auch für VAR-Parameter (hier wird ja nicht der Wert selbst, sondern eine Adresse, sprich Pointer auf den Wert, übergeben), wodurch sogenannte polymorphe, d.h. auf verschiedene Datentypen anwendbare, Prozeduren verwirklicht werden können.
Das Modul MOBS
Zunächst eine wichtige Anmerkung zu MOBS: Einerseits ist das Modul extrem systemabhängig, da es sich darauf verläßt, daß Komponenten von RECORDS in der Reihenfolge der Notierung bei der Definition eines Datentyps abgelegt werden und die Offsets für einzelne Komponenten unabhängig von den in der Reihenfolge später auftretenden Komponenten sind. Es müssen zum Beispiel die beiden Typen
TYPE T1 = RECORD
u : RECORD
v1 : BOOLEAN;
v2 : ARRAY [0..20] OF CHAR
END;
v3 : LONGINT;
v4 : BOOLEAN;
v5 : CHAR
END;
T2 = RECORD
v1 ; BOOLEAN;
v2 : ARRAY [0..20] OF CHAR;
v3 : LONGINT;
u : RECORD
v4 : BOOLEAN;
v5 : CHAR END
END;
exakt dieselbe Speicherbelegung ergeben. Andererseits dürfte dies jedoch nicht problematisch sein, da sich die meisten Compiler so verhalten dürften. (Vorsicht jedoch bei Compiler-Optionen, die das Packen von RECORDS ermöglichen - diese müssen für jeden Datentyp, der im Zusammenhang mit MOBS verwendet wird, dieselbe Einstellung haben!)
Zum Modul selbst (s. Listing 1): In einer Variablen vom Typ CLASSDEF („Klasse“ ist die Bezeichnung, die von objektorientierten Sprachen für „RECORD“ benutzt wird) wird ein neuer Datentyp definiert. Sie wird in der Prozedur NEW mit den übergebenen Werten belegt; SUPER muß dabei die Oberklasse (der Datentyp, von dem geerbt wird) und SIZE die Größe des zu definierenden Datentyps enthalten (wird durch die gleichnamige Modula-2-Standardfunktion ermittelt, s.u.). NEW ermittelt eine eindeutige Klassenidentifikation und gibt sie als Funktionswert zurück. Eine Variable gilt als zu einer bestimmten Klasse gehörend, wenn sie als ersten Eintrag diese Klassenidentifikation hat. Ein Beispiel:
TYPE INTObject = RECORD
ID : MOBS.CLASS;
Value : INTEGER
END;
VAR INTObjectDef : CLASSDEF;
INTObjectClass : CLASS;
BEGIN INTObjectClass :=
MOBS.NEW(INTObjectDef,NIL,SIZE(INTObject));
(* Diese Klasse besitzt keine Oberklasse A *)
END ...
Damit eine Variable vom Typ INTObject von MOBS als zur entsprechenden Klasse gehörig erkannt werden kann, muß bei jeder Variablen folgende Zuweisung erfolgen: v.ID :=INTObjectClass. Dies wird zweckmäßig durch eine Initialisierungsprozedur des Bibliotheksmoduls bewerkstelligt, das diese Klasse exportiert.
Die Prozedur IS überprüft, ob eine Variable als zu einer bestimmten Klasse gehörig betrachtet werden kann. Dabei wird eine Vererbungshierarchie berücksichtigt. Im weiter oben behandelten Beispiel der Datentypen Punkt und Kreis kann z.B. eine Variable vom Typ Kreis auch als Punkt benutzt werden. IS gibt in solchen Fällen die Adresse der untersuchten Variablen zurück, um anschließend den Zugriff auf den gesamten Inhalt zu ermöglichen. (Daher muß ein Referenzparameter verwendet werden.) Kann die gewünschte Klasse in der Vererbungshierarchie der zu untersuchenden Variablen nicht gefunden werden, liefert die Prozedur den Wert NIL. Will man polymorphe Prozeduren schreiben, muß man sich bei den betroffenen Parametern statt des tatsächlich gewünschten Datentyps lediglich die Klassenzugehörigkeit als Referenzparameter übergeben lassen und im Innern der Prozedur die Typprüfung durch IS vornehmen. Danach ist sichergestellt, daß der Zugriff auf bestimmte Komponenten einer übergebenen Variablen nicht ins „Leere“ geht.
Die Prozedur LET weist den Wert einer Variablen einer anderen zu, wenn entweder beide Variablen zur gleichen Klasse gehören - in diesem Fall wird der gesamte Wert kopiert - oder die Klasse der Ziel variablen die Klasse der Quellvariablen beerbt hat - dann wird nur der Bereich kopiert, den die Zielvariable umfaßt. In beiden Fällen gibt die Prozedur den Wert „TRUE“ zurück; sind die beiden Variablen jedoch inkompatibel, erhält man den Wert „FALSE“.
Die Prozedur ASSIGN alloziert Speicher in der Größe der Klasse ObId, kopiert den Inhalt der durch ObId identifizierten Variable in diesen Speicher und gibt seine Adresse in ObPtr zurück. Sollte nicht genügend Speicherplatz vorhanden sein, steht hier der Wert NIL. Diese Prozedur ist im Zusammenhang mit Bäumen wichtig, deren Knoten von einem beliebigen Typ sein können: Bibliotheksprozeduren können hiermit Knoten erzeugen, ohne die Klasse einer von einem Klienten übergebenen Variablen zu „kennen“.
Ein mit ASSIGN allozierter Speicherplatz kann mit FREE wieder freigegeben werden.
Erstes Beispiel: Point und Box
Das Beispiel in den Listings 2 bis 4 greift die oben genannte Idee der Datentypen Punkt und Kreis auf - allerdings wird als Erweiterung des Typs Punkt hier der Einfachheit halber Rechteck genommen.
Der Typ Point.Type besteht aus dem Eintrag für die Klassenzugehörigkeit und zwei INTEGER-Werten. Eine Variable dieses Typs wird mit Point.INIT initialisiert. Point.DRAW zeichnet einen Punkt auf dem Bildschirm. Dabei wird jedoch nicht die gesamte Variable übergeben, sondern nur deren Klassenzugehörigkeit.
Damit wird sichergestellt, daß Erweiterungen des Typs Point.Type auch als Punkt dargestellt werden können. Die notwendige Typprüfung geschieht im Innern der Prozedur Point.DRAW. Damit diese Prozedur jedoch Zugriff auf den gesamten Inhalt einer Variablen hat, muß deren Klassenzugehörigkeit als Referenzparameter übergeben werden. Ähnliches gilt für die Prozedur Point.MOVE, die einen Punkt von einem Startpunkt in kleinen Schritten zu einem Zielpunkt bewegt. Dabei wird die übergebene Prozedur Draw zum Zeichnen der Punkte benutzt. Der Typ Box.Type wiederholt zunächst die Definitionen des Typs Point.Type und wird durch zwei weitere INTEGER-Werte ergänzt. Die Prozeduren Box.INIT und Box.DRAW verhalten sich wie ihre Gegenstücke des Moduls Point. Dabei ist zu beachten, daß die Prozedurköpfe von Point.DRAW und Box.DRAW identisch sind: Die Prozedur Point.MOVE kann somit zum Bewegen von Punkten als auch von Rechtecken (sowie anderen Erweiterungen von Point.Type, Box.Type etc.) benutzt werden. Listing 4 besteht aus einer kleinen Demonstration der Module Point und Box.
Zweites Beispiel: LIFO
Das Modul LIFO (Listing 5) stellt eine einfache Stack-Verwaltung zur Verfügung, die dank MOBS vollkommen unabhängig von den zu speichernden Daten ist und insbesondere auch gemischte Daten innerhalb eines Stacks verwalten kann.
Der Datentyp Node enthält nur die für die Stack-Verwaltung notwendigen Informationen. Er soll später erweitert werden.
Init initialisiert einen leeren Knoten. Für eigene Erweiterungen sollten neue entsprechende Routinen geschrieben werden. ID sollte dabei die Klassenzugehörigkeit erhalten, NEXT den Wert NIL.
Push legt einen Knoten auf einen Stack ab. Da hier nur die ID-Komponente als Referenzparameter übergeben wird, können auch beliebige Erweiterungen der Klasse Node übergeben werden.
Pull löscht den zuletzt abgelegten Knoten von einem Stack - daher der Name LIFO = Last In First Out.
Clear schließlich löscht alle Knoten eines Stacks. Dies sollte immer am Ende eines Programms erfolgen.
Ein Stack muß zu Beginn eines Programms grundsätzlich mit NIL belegt werden. Der oberste Knoten eines Stacks ist durch die Dereferenzierung des Stacks selbst sichtbar.
Das Beispielprogramm (Listing 6) kann per Benutzereingabe einen gemischten Stack erzeugen. Die Einzelheiten dieses Programms sollten nach den bisherigen Ausführungen klar sein.
Die benutzten BasicLib-Befehle
BasicLib ist ein Bibliotheksmodul des SPC Modula-2-Entwicklungssystems und stellt die Befehle von GFA-BASIC zur Verfügung.
Die in den hier besprochenen Modulen verwendeten Befehle werden im folgenden kurz erläutert:
- Der Befehl BMOVE(Source,Dest,Size) kopiert den Speicherbereich der Größe Size (in Bytes) von Source nach Dest.
- PCIRCLE(x,y,r) zeichnet einen ausgefüllten Kreis um x,y mit Radius r. (Diesen Punkt kann man besser sehen!)
- GRAPHMODE(m) schaltet gewisse Zeichenmodi ein. Wert m = 3 bedeutet XOR-Modus, womit man sich das Neuzeichnen des Hintergrundes sparen kann.
- PAUSE(t) läßt t/50 Sekunden vergehen.
- BOX(x1,y1,x2,y2) zeichnet ein Rechteck; x1,y1 ist die linke obere, x2,y2 die rechte untere Ecke.
Anmerkung: Außer dem Modul BasicLib wurden keine Besonderheiten von SPC Modula-2 benutzt, so daß die Programme ohne größeren Aufwand auf andere Modularsysteme, die den Wirthschen Standard unterstützen, übertragen werden können (auch auf Macintosh u.a., mit größerem Aufwand auch auf IBM-Kompatible).
Literatur:
[1] N.Wirth: „Programming in Modula-2", Springer- Verlag
[2] N.Wirth: „Type Extensions", ACM Trans, on Prog. Languages and Systems, 10,2 (April 1988) 204-214
[3] N. Wirth: „From Modula to Oberon / The Programming Language Oberon" Gelbe Berichte des Departement Informatik, 143, November 1990, erhältlich bei folgender Adresse: Institut für Computersysteme, ETH-Zentrum, CH-8092 Zürich, Schweiz
[4] M.Reiser/N. Wirth: „The Oberon language - steps beyond Pascal and Modula" Addison Wesley, wird demnächst veröffentlicht
(* Listing 1 *)
DEFINITION MODULE MOBS;
(* programmed by P.Costanza *)
(* Date : 19:51 24.11.1990 *)
IMPORT SYSTEM;
TYPE CLASS;
CLASSDEF = RECORD SUPER : CLASS;
SIZE : LONGINT
END;
PROCEDURE NEW(VAR DEF : CLASSDEF;
SUPER : CLASS;
SIZE : LONGINT) : CLASS;
PROCEDURE IS(VAR ObId : CLASS;
Class : CLASS) :
SYSTEM.ADDRESS;
PROCEDURE LET(VAR DestinId,
SourceId : CLASS) : BOOLEAN;
PROCEDURE ASSIGN(VAR ObPtr :
SYSTEM.ADDRESS;
VAR ObId : CLASS);
PROCEDURE FREE(VAR ObPtr : SYSTEM.ADDRESS);
END MOBS.
IMPLEMENTATION MODULE MOBS;
(* programmed by P.Costanza *)
(* Date : 19:56 24.11.1990 *)
IMPORT SYSTEM, BasicLib, Storage;
TYPE CLASS = POINTER TO CLASSDEF;
PROCEDURE NEW(VAR DEF : CLASSDEF;
SUPER : CLASS;
SIZE : LONGINT) : CLASS;
BEGIN
DEF.SUPER := SUPER;
DEF.SIZE := SIZE;
RETURN SYSTEM.ADR(DEF)
END NEW;
PROCEDURE IS(VAR ObId : CLASS;
Class : CLASS) :
SYSTEM.ADDRESS;
VAR c : CLASS;
BEGIN c := ObId;
WHILE (c # NIL) & (c # Class) DO
c := c^.SUPER
END;
IF c = NIL THEN RETURN NIL
ELSE RETURN SYSTEM.ADR(ObId)
END
END IS;
PROCEDURE LET(VAR DstId,
SrcId : CLASS) : BOOLEAN;
VAR IdMem : CLASS;
BEGIN
IF IS(SrcId,DstId) # NIL THEN
IdMem := DstId;
BasicLib.BMOVE( SYSTEM.ADR(SrcId),
SYSTEM.ADR(DstId),
DstId^.SIZE );
DstId := IdMem;
RETURN TRUE
ELSE RETURN FALSE
END
END LET;
PROCEDURE ASSIGN(VAR ObPtr :
SYSTEM.ADDRESS ;
VAR ObId : CLASS);
BEGIN
IF Storage.Available(ObId^.SIZE) THEN
Storage.ALLOCATE(ObPtr,ObId^.SIZE);
BasicLib.BMOVE( SYSTEM.ADR(ObId),ObPtr, ObId^.SIZE )
ELSE ObPtr := NIL
END
END ASSIGN;
PROCEDURE FREE(VAR ObPtr : SYSTEM.ADDRESS);
BEGIN Storage.DEALLOCATE(ObPtr)
END FREE;
(* Diese Prozedur muss durch folgende
ersetzt werden, falls Storage.DEALLOCATE
die Angabe einer Groesse erfordert:
PROCEDURE FREE(VAR ObPtr : SYSTEM.ADDRESS);
VAR c : CLASS;
BEGIN c := ObPtr;
Storage.DEALLOCATE(ObPtr, c^.SIZE)
END FREE;
*)
END MOBS.
(* Listing 2 *)
DEFINITION MODULE Point;
IMPORT MOBS;
TYPE DrawProc = PROCEDURE(VAR MOBS.CLASS);
Type = RECORD
ID : MOBS.CLASS;
x, y : INTEGER
END;
PROCEDURE INIT( VAR p : Type; x, y : INTEGER );
PROCEDURE DRAW( VAR PointID : MOBS.CLASS );
PROCEDURE MOVE( VAR SrcID, DetId : MOBS.CLASS; Draw : DrawProc );
VAR Class : MOBS.CLASS;
END Point.
IMPLEMENTATION MODULE Point;
IMPORT BasicLib, MOBS;
TYPE PPtr = POINTER TO Type;
VAR PointDef : MOBS.CLASSDEF;
PROCEDURE DRAW( VAR ID : MOBS.CLASS );
VAR p : PPtr;
BEGIN p := MOBS.IS(ID, Class);
IF p # NIL
THEN BasicLib.PCIRCLE(p^.x,p^.y,5)
END
END DRAW;
PROCEDURE INIT( VAR p : Type; x, y : INTEGER );
BEGIN p.ID := Class; p.x := x; p.y := y
END INIT;
PROCEDURE MOVE ( VAR SrcId, DstId : MOBS.CLASS; Draw : DrawProc );
VAR s, d, p : PPtr;
BEGIN s := MOBS.IS(SrcId, Class);
d := MOBS.IS(DstId, Class);
IF (s # NIL) & (d # NIL) THEN
BasicLib.GRAPHMODE(3);
MOBS.ASSIGN(p,s^.ID);
WHILE (p^.x < d^.x) & (p^.y < d^.y) DO
Draw(p^.ID); BasicLib.PAUSE(2);
Draw(p^.ID);
INC(p^.x,5); INC(p^.y,5)
END;
MOBS.FREE(p)
END
END MOVE;
BEGIN Class := MOBS.NEW(PointDef,NIL, SIZE(Type))
END Point.
(* Listing 3 *)
DEFINITION MODULE Box;
IMPORT MOBS, Point;
TYPE Type = RECORD
ID : MOBS.CLASS;
x, y : INTEGER;
w, h : INTEGER
END;
PROCEDURE INIT(VAR b : Type;
x, y, w, h : INTEGER);
PROCEDURE DRAW(VAR BoxID : MOBS.CLASS);
VAR Class : MOES.CLASS;
(* Subclass of Point.Class *)
END Box.
IMPLEMENTATION MODULE Box;
IMPORT BasicLib, MOBS, Point;
TYPE BPtr = POINTER TO Type;
VAR BoxDef : MOBS.CLASSDEF;
PROCEDURE DRAW(VAR ID : MOBS.CLASS);
VAR b : BPtr;
BEGIN b := MOBS.IS(ID, Class);
IF b # NIL
THEN BasicLib.BOX(b^.x,b^.y,
b^.x+b^.w,
b^.y+b^.h)
END
END DRAW;
PROCEDURE INIT (VAR b : Type;
x, y, w, h : INTEGER);
BEGIN b.ID := Class;
b.x := x; b.y := y; b.w := w; b.h := h
END INIT;
BEGIN Class :=
MOBS.NEW(BoxDef,Point.Class,SIZE(Type))
END BOX.
(* Listing 4 *)
MODULE GraphMOB;
IMPORT Box, Point;
VAR p : Point.Type;
b : Box.Type;
BEGIN Box.INIT(b,10,10,50,50);
Point.INIT(p,400,400);
Point.MOVE(b.ID,p.ID,Point.DRAW);
Point.MOVE(b.ID,p.ID,Box.DRAW);
HALT
END GraphMOB.
(* Listing 5 *)
DEFINITION MODULE LIFO;
(* programmed by P.Costanza *)
(* Date : 0:15 14. 9.1990 *)
IMPORT MOBS;
TYPE Stack = POINTER TO Node;
Node = RECORD
ID : MOBS.CLASS;
NEXT : Stack
END;
VAR NodeClass : MOBS.CLASS;
PROCEDURE Init(VAR s : Node);
PROCEDURE Push(VAR s : Stack; VAR NodeID : MOBS.CLASS);
PROCEDURE Pull(VAR s : Stack);
PROCEDURE Clear(VAR s : Stack);
END LIFO.
IMPLEMENTATION MODULE LIFO;
(* programmed by P.Costanza *)
(* Date : 20: 6 24.11.1990 *)
IMPORT MOBS;
VAR NodeDef : MOBS.CLASSDEF;
PROCEDURE Init(VAR s : Node);
BEGIN s.ID := NodeClass; s.NEXT := NIL
END Init;
PROCEDURE Push(VAR s : Stack;VAR NodeID : MOBS.CLASS);
VAR m : Stack;
BEGIN IF MOBS.IS(NodeID, NodeClass) # NIL THEN
MOBS.ASSIGN(m,NodeID);
IF m # NIL THEN
m^.NEXT := s; s := m
END
END
END Push;
PROCEDURE Pull(VAR s : Stack);
VAR m : Stack;
BEGIN IF s # NIL THEN
m := s.NEXT;
MOBS.FREE(s); s := m
END
END Pull;
PROCEDURE Clear(VAR s : Stack);
VAR m : stack;
BEGIN WHILE s # NIL DO
m := s^.NEXT;
MOBS.FREE(s); s := m
END
END Clear;
BEGIN NodeClass :=
MOBS.NEW(NodeDef,NIL,SIZE(Stack))
END LIFO.
(* Listing 6 *)
MODULE LIFOTest;
(* programmed by P.Costanza *)
(* Date : 16:44 4. 2.1991 *)
IMPORT InOut, LIFO, MOBS;
TYPE INTNode = RECORD
ID : MOBS.CLASS;
NEXT : LIFO.Stack;
VALUE : INTEGER
END;
CHRNode = RECORD
ID : MOBS.CLASS;
NEXT : LIFO.Stack;
VALUE : CHAR
END;
VAR INTNodeDef : MOBS.CLASSDEF;
INTNodeClass : MOBS.CLASS;
CHRNodeDef : MOBS.CLASSDEF;
CHRNodeClass : MOBS.CLASS;
Stack : LIFO.Stack;
InI : INTNode; OutI : POINTER TO INTNode;
InC : CHRNode; OutC : POINTER TO CHRNode;
choice : CHAR;
PROCEDURE IntNotChr() : BOOLEAN;
VAR c : CHAR;
BEGIN InOut.WriteString(" Integer- or Charobject (I/C)?");
REPEAT InOut.Read(c); c := CAP(c)
UNTIL (c = "I") OR (c = "C");
InOut.WriteLn;
RETURN c = "I"
END IntNotChr;
BEGIN INTNodeClass :=
MOBS.NEW(INTNodeDef,
LIFO.NodeClass,
SIZE(INTNode));
CHRNodeClass :=
MOBS.NEW(CHRNodeDef,
LIFO.NodeClass,
SIZE(CHRNode));
InI.ID := INTNodeClass;
InI.NEXT := NIL;
InI.VALUE := 0;
InC.ID := CHRNodeClass;
InC.NEXT := NIL;
InC.VALUE := 0C;
Stack := NIL; choice := "V";
WHILE choice # "X" DO
CASE choice OF
"V" : InOut.WriteString("V = Verbose commands”);
InOut.WriteLn;
InOut.WriteString("S = Push values");
InOut.WriteLn;
InOut.WriteString("P = Pull values");
InOut-WriteLn;
InOut.WriteString("L = Look values");
InOut.WriteLn;
InOut.WriteString("C = Clear stack");
InOut.WriteLn;
InOut.WriteString("H = HALT (Debug)");
InOut.WriteLn;
InOut.WriteString("X = Quit")
| "S" : IF IntNotChr() THEN
InOut.WriteString(" >");
InOut.Readlnt(InI.VALUE);
LIFO.Push(Stack,InI.ID)
ELSE
InOut.WriteString(" >");
InOut.Read(InC.VALUE);
LIFO.Push(Stack,InC.ID)
END
| "P" : LIFO.Pull(Stack);
InOut.WriteString(" O.k.")
| "L" : IF Stack # NIL THEN
OutI := MOBS.IS(Stack^.ID, INTNodeClass);
OutC := MOBS.IS(Stack^.ID, CHRNodeClass);
IF OutI # NIL THEN
InOut.WriteString(" Integerobject = ");
InOut.WriteInt(OutI^.VALUE,1) ELSIF OutC # NIL THEN InOut.WriteString(" Charobject = ");
InOut.Write(OutC^.VALUE)
ELSE InOut.WriteString(" Unknown object!")
END
ELSE InOut.WriteString(" Stack is empty!")
END
| "C" : LIFO.Clear(Stack);
InOut.WriteString(" O.k.")
| "H" : HALT; InOut.WriteString(" O.k.")
ELSE END;
InOut.WriteLn;
InOut.Read(choice);
choice := CAP(choice);
InOut.WriteLn
END(* WHILE *);
LIFO.Clear(Stack)
END LIFOTest.
Pascal Costanza