Copyright (1994-1998) Petra Fabian, Günter Dotzel, ModulaWare
3rd. ed. 10-Nov-1994.
0. Einleitung
2. Kennenlernen der objektorientierten Denkweise
3. Sprachstandardisierung und verfügbare Compiler
4. Zusammenfassung
5. Literaturverzeichnis
Anhang 1.
Anhang 2.
Wer bisher mit FORTRAN, C oder Pascal gearbeitet hat, wird mit den Schlagworten Objekt, Erweiterbarkeit von Programmen und Persistenz nicht viel anfangen können. Warum macht es Sinn sich mit diesen Konzepten auseinanderzusetzen und wie arbeitet man sich in die Thematik ein? Wer sich nun als Einstieg mit dem, zur Zeit als Synonym für Objektorientiertheit gehandelten C++ beschäftigt, wird so schnell auch kein Licht sehen. C++ ist konzeptuell nicht geeignet, die Grundprinzipien der objekt-orientierten Programmierung zu studieren. Auch die Funktionalität von C++ steht, was das erweiterbare Programmieren angeht, z.B. hinter der von Oberon-2 zurück [Temp94a]. Auch gibt es in absehbarer Zukunft keine international einheitliche Sprachnorm für C++. Die Stabilität einer Sprachdefinition ist wichtig für den professionellen Einsatz. Es kann nicht angehen, daß jahrelang an einer Sprache gebastelt wird. Zu viele Änderungen geschehen in zu kurzer Zeit.
Wiederverwendbarkeit von Modulen ist eine der zentralen Probleme in der Softwareentwicklung.
Wie kann man die Funktionalität eines Moduls von aussen erweitern, ohne daß man Zugang zur Quelle des Originalmoduls hat oder sie nicht verändern will?
Antwort: Dazu braucht man nicht viel mehr als Typerweiterung und Polymorphie.
Dieser Artikel beschreibt an einem realistischen Beispiel, wie man einen in Modula-2 geschriebenen AVL-Baum-Verwalter (ausgeglichener Baum) vom konventionellen, prozeduralen Ansatz in Oberon-2 mit Gewinn an Struktur, Geschwindigkeit, Sicherheit, Lesbarkeit und Erweiterbarkeit verwirklicht.
Nach Analyse der unten beschriebenen Vorgehensweise entdeckt man, daß die Objektorientierung nicht so wichtig ist, wie die Erweiterbarkeit und daß eine, auf das wirklich Wesentliche reduzierte OOP-Sprache, keine Probleme in der Handhabung bringt. Denn eine OO-Programmiersprache darf keinen zusätzlichen Ballast bringen und die Konzepte müssen klar, leicht verständlich und intuitiv sein, sonst wird die Sprache und deren Compiler zum Teil des Problems. Die Ausbildung der Softwareentwickler reduziert sich damit auf das Erlernen der Konzepte.
Bevor man an erweiterbare Programmierung denken kann, kommt also erst mal die Reduktion. Reduktion, nicht nur der Komplexität der Sprachdefinition, sondern auch des Laufzeitsystems und der Bibliothek. Nur mit wirklich einfachen, parxiserprobten und robusten Konzepten kann man komplexe Applikationen entwickeln.
Ziel dieses Artikels ist es auch aufzuzeigen, was Persistenz mit Objekten zu tun hat und daß nicht nur die Daten, ohne Einsatz von objektorientierten Datenbanken, die Anwendungen überdauern können, sondern auch deren Verarbeitungsmethoden. Das einfache Konzept der Persistenz von Objekten, die keinesfalls eine Eigenschaft der Programmiersprache sein muss (und damit nicht sein darf), reicht aus, um mit Objekten umgehen zu können, die die Programmlaufzeit überleben.
Auf Permanentspeicher abgelegt können sie jederzeit wieder zum Leben erweckt werden, da man ihnen, wie schon damals den Pharaonen in den Pyramiden, alles mitgibt, was sie im Jenseits brauchen. Persistente Objekte können sich bei Aktivierung wieder an den eigenen Datentyp, deren Verträglichkeit mit anderen Typen und an Ihre ureigenen Methoden erinnern, mit denen sie üblicherweise verarbeitet werden.
Alles was man dazu braucht ist eine persistenz-unterstützende Basisklasse, die in der Regel vom Compilerhersteller als Bibliotheksmodul mitgeliefert wird. Alle davon abgeleiteten Klassen erben die Eigenschaft der Basisklasse. Der Compiler produziert bei der Codegenerierung zusätzlich noch statische Datentyp-Information, so daß zur Laufzeit die Typinformation aller Objekte zur Verfügung steht und somit dem Erzeugen, Kopieren und Klonen von Objekten nichts im Wege steht. Ein Traum der Pharaonen wird wahr. Aus einem einzelnen Gen kann man das komplette Objekt mit allen Eigenschaften wieder erschaffen.
Zum Verständnis der technischen Verwirklichung von generischen Prozeduren, die mit Objekten arbeiten können, deren Deklaration zum Zeitpunkt der Entwicklung noch garnicht bekannt ist, folgt zunächst eine kurze Einführung in die Sprachen Modula-2 und Oberon-2. Zu einer Sprache gehören Bibliotheken, die eine systemunabhängige Schnittstelle bieten (meist mit systemabhängigen Eigenschaften implementiert). Die Schnittstelle der Bibliotheken sollte standardisiert sein, so daß Applikationen weitgehend systemunabhängig realisierbar sind.
Modula-2 ist eine prozedurale Programmiersprache. Sie wurde 1980 von
Niklaus Wirth entwickelt und ist als logischer Nachfolger von Pascal
anzusehen.
Modula-2 erweitert Pascal um ein Modulkonzept.
Ein Modul ist eine logische Einheit von Konstanten, Typen, Variablen
und Prozeduren, das für sich kompiliert werden kann.
Der Definitionmodul bietet eine nach außen sichtbare Schnittstelle.
Die Implementationsdetails verbergen sich im Implementationsmodul.
Modula-2 ist eine universell anwendbare Programmiersprache, die Dank der Standardisierung maschinen- und betriebssystemunabhängig einsetzbar ist.
Oberon ist eine objektorientierte, prozedurale Programmiersprache. Sie wurde von Niklaus Wirth und Jürg Gutknecht in den Jahren 1985 - 1987 entwickelt und in Zusammenarbeit mit Hanspeter Mössenböck im Jahre 1991 durch Einführung von polymorphen Objekten auf Oberon-2 erweitert.
Oberon-2 zeichnet sich durch einen kleinen, leicht verständlichen und leicht erlernbaren Sprachumfang aus. Oberon-2 ist eine aufwärtskompatible Erweiterung von Oberon und bringt als wesentliche Neuerung typgebundene Prozeduren (Methoden) und damit eine leicht handhabbare Polymorphie, sowie außerdem dynamisch erzeugbare Felder, schreibgeschützten Export von Variablen und syntaktisch einen regionalen Type-Guard mit Varianten und die bereits von Modula-2 bekannte FOR-Schleife. Im Folgenden wird Oberon im Sinne von Oberon-2 verwendet.
In Oberon gibt es keine explizite Trennung zwischen Implementations- und Definitionsmodul.
Oberon erlaubt keine mehrfache Vererbung. Wie man Strukturen, die Mehrfachvererbungsmerkmale aufweisen, in einfache Vererbung abbilden kann, wurde in wissenschaftlichen Veröffentlichungen gezeigt.
Oberon bietet zusätzlich zur Schnittstellenprüfung von getrennt übersetzten Modulen auch Feldgrenzenüberwachung, Prüfung von dynamischen Datentypen und Zeigersicherheit.
Oberon-2 besitzt keine explizite Speicherplatzfreigabe, sondern führt eine automatische Garbage-Collection durch.
Diese Einführung ist keine vollständige Oberon-2 Sprachbeschreibung. Sie soll lediglich die Sprachkonstrukte erklären, die andere prozedurale Programmiersprachen, wie z. B. Pascal vermissen lassen.
Ein Objekt wird als Datensatz oder als Zeiger auf einen Datensatz definiert. Will man sich bezüglich der Grunddaten nicht festlegen, kann man als Basisklasse einen leeren Datensatz definieren.
TYPE
ob = POINTER TO object;
object = RECORD END;
Das Arbeiten mit Zeigern erweist sich als vorteilhaft, z. B. für die dynamische Bindung (siehe Kapitel 1.3).
Zu den Objekten gehörige Prozeduren (siehe Kapitel 2) werden als Methoden bezeichnet.
PROCEDURE (VAR o: object) operation;
END operation;
PROCEDURE (o: ob) compare * (s: ob);
END compare;
Die Methoden operation und compare sind an ein Objekt vom Type object gebunden. Der Parameter o wird als Empfänger (Receiver) bezeichnet.
Zu exportierende Konstanten, Variablen, Typen bzw. Prozeduren werden in Oberon-2 mit "*" gekennzeichnet.
Hätte man z. B. eine Variable o vom Typ object, dann könnte man mit o.operation die Methode operation ausführen.
Die Vererbung (siehe Kapitel 2.1) wird in Oberon folgendermaßen realisiert:
TYPE
ob1 = POINTER TO object1;
object1 = RECORD (object) a: type; END;
object1 ist eine Erweiterung von object. Das object1 hat zusätzlich zur Datenstruktur von object das Element a und die Methode write.
PROCEDURE (o: ob1) write;
BEGIN
Write(o.a);
END write;
Will man die Methode von der Basisklasse überschreiben, ändert man den Typen des Empfängers entsprechend ab. Die eigentliche Parameterliste (in der Methode operation nicht vorhanden) muß identisch sein.
PROCEDURE (VAR o: object1) operation;
END operation;
VAR c: ob1;
Mit c.operation ruft man nun die Methode operation zur Klasse object1 auf. Will man die Methode der Basisklasse aufrufen, so geschieht dies mit c.operation^.
Welche Methode für das Objekt aufgerufen wird, wird erst zur Laufzeit und zwar abhängig vom Typ der übergebenen Variablen entschieden. Diesen Vorgang nennt man dynamische Bindung.
Zur Übersetzungszeit ist dem Compiler nicht bekannt, von welchem Typ das jeweilige Objekt ist. Der Compiler kann nicht davon ausgehen, daß das Objekt statisch gebunden ist, d. h., daß das Objekt von dem Typen ist, mit dem es deklariert wurde. Folglich kann der Compiler den Methodenaufruf nicht statisch generieren.
Welche Methode für das Objekt aufgerufen wird, wird erst zur Laufzeit entschieden. Diesen Vorgang nennt man dynamische Bindung. Da der Basistyp mit seinen Erweiterungen kompatibel ist, kann eine Variable zur Laufzeit nicht nur ein Objekt des Typs enthalten, mit dem sie deklariert wurde, sondern auch Objekte mit beliebigen Erweiterungen dieses Typs.
Da der dynamische Typ zur Laufzeit ein anderer als der Statische sein kann, sind Laufzeittypprüfungen erforderlich. (siehe z. B. Kapitel 2.2 PROCEDURE CompareItem)
Erweitertes Beispiel zu Oberon-2 Beschreibung aus Kapitel 1.2)
VAR
d: ob;
e: ob1;
NEW(d);
NEW(e);
d := e;
Nach oben beschriebener Zuweisung hat d den statischen Typ object, aber den dynamischen Typ object1.
Ein Aufruf d.operation würde zum Aufruf der Methode führen, die zum object1 gehört.
Wären d und e nicht vom Zeigertyp, sondern Variablen vom Typ Record, so wäre die Zuweisung 'd := e' zwar erlaubt, d würde aber den gleichen dynamischen wie statischen Typ haben, da der Speicherplatz für d nicht beliebig erweitert werden kann. Bei der Zuweisung würden die restlichen Daten von e (hier a) einfach ignoriert (Projektion).
Umgekehrt wäre die Zuweisung e := d nicht erlaubt, da d keine Erweiterung von e ist.
Ist aber bekannt, daß d den gleichen dynamischen Typ wie e hat, ist die Zuweisung mit einer entsprechenden Typzusicherung erlaubt.
e := d(object1);
Der Typtest 'd IS object1' würde in unserem Beispiel TRUE liefern, da der dynamische Typ von d vom Typ object1 ist.
Unbedingt empfehlenswert ist das Buch [Möss93], das gleichermassen für die Ausbildung als auch für professionelle Softwareentwickler geeignet ist.
Die objektorientierte Denkweise stellt im Gegensatz zum konventionellen, funktionalen Programmierstil, die Daten und die zu ihnen gehörigen Operationen in den Mittelpunkt der Betrachtung und nicht die Funktionen.
Die Daten und die dazu gehörenden Operationen werden als eine Einheit (ein Objekt) betrachtet, der man Aufträge erteilen kann. Dabei braucht man sich als 'Auftraggeber' nicht um die Art des Objektes zu kümmern. Jedes Objekt interpretiert den Auftrag auf seine Weise und führt von selbst die zu ihm passende Operation aus.
- Beispiel:
Wunsch ist es, ein Objekt auf den Bildschirm zu zeichnen. Der Auftraggeber erteilt dem Objekt den Auftrag 'Zeichne Dich' und das Objekt wählt die zu ihm gehörige Operation aus.
Der Auftraggeber interessiert sich nicht dafür, ob das Objekt ein Kreis oder ein Rechteck ist.
Objektorientierung unterstützt Datenabstraktion und Datenkapselung (Geheimnisprinzip).
Der Auftraggeber aus obigem Beispiel benötigt weder Kenntnisse der Objektdaten, noch Kenntnisse über die Implementierung der Funktion 'Zeichne Dich'.
Datenkapselung besagt, daß die Implementation komplexer Daten in einem Baustein verborgen wird, und der Klient nur eine abstrakte Sicht auf diese Daten hat. Der Klient kann auf gekapselte Daten nicht direkt, sondern nur über zum Baustein gehörige Operationen zugreifen. Dadurch werden Klienten nicht mit Implementierungsdetails belastet. Die Bausteine sind leichter wartbar, da Änderungen der Implementierung die Anwendung nicht betreffen, solange die nach außen sichtbare Schnittstelle gleichbleibt.
Datenabstraktion ist eine Weiterführung des Geheimnisprinzips. Sie bietet die Möglichkeit, mehrere Exemplare eines Bausteins anzulegen. Ein abstrakter Datentyp ist eine Einheit aus Daten und Operationen.
Datenkapselung und Datenabstraktion sind keine speziellen Themen der objektorientierten Programmierung, können aber mit dieser Methode gut realisiert werden.
Ein wesentlicher Bestandteil der Objektorientierung ist die Vererbung. Sie bietet die Möglichkeit, einen abstrakten Datentyp zu einem neuen zu erweitern, der die Eigenschaften des alten Datentyps erbt und zusätzlich weitere Eigenschaften erhält. Geerbte Operationen dürfen geändert werden, so daß eine große Flexibilität in der Gestaltung der Datentypen vorhanden ist.
Diese Methode bietet die Möglichkeit, 'Halbfabrikate' zu erzeugen, die später zu endgültigen Datentypen ausgebaut werden können.
Der Vorteil der Vererbung liegt darin, daß der erweiterte Datentyp mit dem ursprünglichen kompatibel bleibt, d. h., daß alle Algorithmen, die mit dem ursprünglichen Datentyp arbeiten können, auch für die Erweiterung zu verwenden sind.
Dieser Vorteil bietet die Möglichkeit, generische Bausteine zu schaffen. Generische Bausteine sind in der Lage, mit verschiedenen Objekten zu arbeiten.
Ein Beispiel für einen generischen Baustein ist ein Binärbaum. Algorithmen zum Einfügen, Suchen von Objekten, usw. sind unabhängig von der Datenstruktur der Objekte. Als Beispiel diene hier der Algorithmus für einen Binärbaum, der von einem vorhandenen Modula-2 Programm nach Oberon-2 umgeschrieben wurde:
Schnittstelle des Binärbaums:
MODULE TreeHandler;
TYPE
LINKS * = POINTER TO NODES;
NODES * = RECORD
LeftTree,RightTree: LINKS;
END;
TREES * = POINTER TO TREEDETAILS;
TREEDETAILS * = RECORD
Root: LINKS;
END;
PROCEDURE (Tree: TREES) NewTree *;
END NewTree;
PROCEDURE (Tree: TREES) AddItem * (ThisItem: LINKS);
END AddItem;
PROCEDURE (Tree: TREES) DeleteItem * (ThisItem: LINKS);
END DeleteItem;
PROCEDURE (Tree: TREES) WalkTreeInOrder *;
END WalkTreeInOrder;
PROCEDURE (Tree: TREES) ModifyItem * (Item: LINKS);
END ModifyItem;
Das Objekt NODES kann durch beliebige Objekte erweitert werden, ohne die Funktionalität des Binärbaumes zu beeinträchtigen.
Ein Binärbaum benötigt lediglich die Annahme, daß zwei Knoten miteinander vergleichbar sind.
Diese Annahme wird als Methode zum Objekt NODES realisiert.
PROCEDURE (Node: LINKS) CompareItem* (Item: LINKS): INTEGER;
END CompareItem;
END TreeHandler.
Diese Methode liefert einen der folgenden Werte
CONST LESS=-1; EQUAL=0; GREATER=1;
zurück und soll entsprechend den Erweiterungen überschrieben werden.
Diese Annahme reicht aus, um die Funktionalität eines Binärbaums zu implementieren. Als Beispiel diene hier die Methode AddItem.
PROCEDURE (Tree: TREES) AddItem* (ThisItem: LINKS);
Die Methode bekommt einen Zeiger auf ein einzufügendes Objekt als Parameter.
VAR this,father: LINKS;
result : INTEGER;
BEGIN
this := Tree.Root;
Der Baum wird von der Wurzel ausgehend durchsucht, um den Platz für das neue Objekt zu bestimmen. Da es sich um einen nicht balancierten Baum handelt, werden neue Knoten immer am Ende der Äste eingefügt. Daher wird folgende Schleife durchlaufen, bis als Nachfolgewert der leere Knoten (NIL) gefunden wird. Zum Einfügen wird der Vorgänger des leeren Knotens benötigt (father).
WHILE this # NIL DO
father := this;
result := ThisItem.CompareItem(this);
Die Ordnungsmethode hängt, wie oben erwähnt, an dem einzufügenden Objekt.
IF result = EQUAL THEN
ThisItem.There;
RETURN; (* ignore duplicates *)
ELSIF result = LESS THEN
this := this.LeftTree;
ELSE
this := this.RightTree;
END;
END;
Je nachdem, ob die zurückgelieferten Werte LESS oder GREATER sind, wird der linke Ast (LESS) oder der rechte Ast (GREATER) weiter durchsucht. Sollte der Datensatz schon vorhanden sein (EQUAL), wird eine entsprechende Meldung ausgegeben und die Prozedur beendet.
Wenn der Baum leer ist (Wurzelknoten = NIL) wird der Knoten als Wurzel eingehängt.
IF Tree.Root = NIL THEN
Tree.Root := ThisItem;
Hat man den Knoten gefunden, nach dem der neue Knoten eingehängt werden soll, wird durch einen weiteren Aufruf der Methode CompareItem festgestellt, ob der Knoten links (LESS) oder rechts (GREATER) einzuhängen ist.
ELSIF ThisItem.CompareItem(father) = LESS THEN
father.LeftTree := ThisItem;
ELSE
father.RightTree := ThisItem;
END;
END AddItem;
Objekte können nach dem Import des Modules TreeHandler folgendermaßen in einem Baum verwaltet werden:
ITEMS* = POINTER TO ITEM;
ITEM * = RECORD(TreeHandler.NODES)
ItemName * : STRING;
END;
Das Objekt ITEM ist eine Erweiterung des Objektes TreeHandler.NODES.
PROCEDURE (Item1: ITEMS) CompareItem* (Item2: TreeHandler.LINKS)
: INTEGER;
BEGIN
WITH Item2: ITEMS DO (* Typzusicherung *)
IF Item1.ItemName < Item2.ItemName THEN RETURN LESS;
ELSIF Item1.ItemName > Item2.ItemName THEN RETURN GREATER;
ELSE RETURN EQUAL;
ELSE error('wrong Type')
END;
END CompareItem;
Die Methode CompareItem wird entsprechend den Erfordernissen des erweiterten Objektes angepaßt. Die Methode gehört zu dem Empfänger Item1, der ein Objekt des Typs ITEM ist. Der Kopf (Header) bzw. die Deklaration der Methode muß mit dem Methodenkopf der Basisklasse übereinstimmen. Da Item2 auch vom Typ des erweiterten Objektes ITEM sein muß, um einen Vergleich durchführen zu können, ist eine Typzusicherung erforderlich. Für die Typzusicherung erhält das Schlüsselwort WITH, welches schon aus Pascal bzw. MODULA bekannt ist, eine andere Funktionalität.
(* Programmbeispiel *)
VAR MyTree : TreeHandler.TREES;
b : ITEMS; i : INTEGER;
BEGIN
NEW(MyTree);
MyTree.NewTree;
FOR i:= 1 TO 5 DO
NEW(b);
Read(b.ItemName);
MyTree.AddItem(b);
END;
END;
Dieses kleine Programmbeispiel erzeugt fünf Knoten im Binärbaum.
Ein weiterer Wunsch in diesem Programmbeispiel war es, beliebig viele neue zulässige Objekte aufzunehmen. Diese sollten jeweils durch ein Modul, dem Basismodul (Modul der Basisklasse) vorgestellt werden. Gemeinsam sollte diesen Objekten ein Ordnungsschlüssel sein, so daß alle in einem Binärbaum zu verwalten wären.
Dazu wurde folgende Lösung entwickelt:
Die einzelnen Objekte werden durch ein repräsentatives Objekt, welches
dynamisch erzeugt wird, und durch den Namen des Moduls, in dem das
Objekt deklariert ist, gekennzeichnet.
Das Basismodul verwaltet ein beliebig langes Feld dieser Kennzeichnungen. Die Feldgröße wird hier durch eine Konstante maxElem festgelegt. In Oberon-2 könnte das Feld unter Nutzung der dynamischen Felder auch mit variabler Größe angelegt werden.
00 TYPE
01 Nodet = RECORD
02 node : ITEMS;
03 modul : STRING;
04 END;
05 Elemt = ARRAY maxElem OF Nodet;
Die Objekte sind alle eine Erweiterung des Objekts ITEM und haben daher den Schlüssel ItemName als Ordnungskriterium gemeinsam.
06 ITEMS* = POINTER TO ITEM;
07 ITEM* = RECORD(TH.NODES)
08 ItemName* : STRING;
09 END;
Das Objekt Item ist wie unter 2.2 eine Erweiterung des Objektes aus dem Baummodul. An der Implementierung des Baummoduls ändert sich durch diese Erweiterung nichts.
Beim Programmstart wird automatisch jeder Modulinitialisierungsteil (module body) durchlaufen. Hier wird jedes Objekt in die Tabelle des Basismoduls geschrieben. Der Basismodul stellt eine Prozedur Install bereit, die den ersten freien Feldplatz sucht und mit den Objektdaten belegt.
Bei der Eingabeaufforderung an den Benutzer wird die Tabelle durchlaufen. Zu jedem Objekt gehört eine Methode, die eine Beschreibung der erforderlichen Daten enthält. Der Benutzer kann einen Index eingeben, um ein Objekt auszuwählen. Die Einlesemethode des entsprechenden Objekts wird daraufhin aktiviert. Nach Eingabe soll das Objekt in den Baum eingehängt werden. Der Baum erhält einen Zeiger auf das Objekt. Deswegen muß das Objekt aus der Tabelle des Basismoduls entfernt werden. Das geschieht durch die Prozedur Destall, die den entsprechenden Tabellenplatz einfach wieder als frei initialisiert.
PROCEDURE Destall (i: INTEGER);
BEGIN
elem[i].node := NIL; elem[i].modul := '';
END Destall;
Da das Objekt dem Benutzer weiterhin zur Verfügung stehen soll, muß es erneut in die Tabelle eingetragen werden. Dieses geschieht durch eine an das Objekt gebundene Methode InstallHim, die in dem entsprechenden Modul eine Prozedur aufruft, die ein neues Objekt erzeugt und mit diesen Daten die Prozedur Install (siehe oben) aus dem Basismodul aufruft.
PROCEDURE New(a : ITEMS);
BEGIN
NEW(a);
OI.Install('OItemC',a);
END New;
PROCEDURE (Item : ITEMS) InstallHim*;
BEGIN
New(a);
END InstallHim;
Ein Nachteil dieser Methode ist, daß immer Speicherplatz für jedes verfügbare Objekt belegt wird, obwohl dieser gar nicht benötigt wird. Außerdem müssen bei dieser Methode sämtliche Module, die Objekte beschreiben, vom Hauptprogramm importiert werden. Das hat zur Folge, daß für jedes hinzukommendes Objekt das Hauptprogramm neu erstellt und übersetzt werden muß. Ein kleines Beispiel für ein zugehöriges Hauptprogramm wäre folgender Programmausschnitt:
MODULE OUseItem;
IMPORT OI := OItemS, ST := STextIO, OItemC, OItemR;
BEGIN
REPEAT
ST.WriteString('building tree');
ST.WriteLn;
UNTIL ~ OI.Read(); (* Eingaberoutine aus Basismodul *)
OI.Show; (* zeigt Elemente aus Baum *)
END OUseItem.
Eine verbessere Lösungsmöglichkeit wird unten beschrieben (siehe Kapitel 2.6).
Die Erfahrungen aus diesem Programm lassen sich gut in die darauf folgende Aufgabe einbinden.
Hier handelt es sich um ein Beispiel aus der täglichen Programmierpraxis. Ein Anwender übermittelte ein Modula-2 Programm mit der Bitte zu überprüfen, ob ein Programmlaufzeitfehler durch einen Compilerfehler bedingt ist. Zusätzlich wurde eine umfangreiche Datei mit Testdaten zur Verfügung gestellt, da der vermeindliche Compilerfehler nicht einfach zu reproduzieren war und auch von den verarbeiteten Daten abhing.
Dieses Programm implementiert einen generischen AVL - Baum zur Verwaltung und Bearbeitung beliebiger Datensätze. Es stellte sich heraus, daß kein Compilerfehler vorlag. Modula-2 unterstützt Generizität nicht. Deswegen wurde zur Definition und Implementierung eines generischen Baumverwalters mit systemnahen Eigenschaften von Modula-2 (SYSTEM.ADDRESS, POINTER TO SYSTEM.LOC, ARRAY OF SYSTEM.BYTE) gearbeitet.
In Oberon-2 kann man das Problem systemunabhängig lösen und deshalb wäre dieser Programmfehler in Oberon-2 von vorneherein vermeidbar gewesen. Deshalb versuchten wir eine Alternativlösung zur Veranschaulichung der Praxistauglichkeit von Oberon-2 zu erstellen. Aufgabe war es, diesen generischen Baum objektorientiert zu realisieren, um dem Anwender die Vorteile der Sprache Oberon-2 zu demonstrieren.
In der Modula-2 Lösung wird in dem Baumknoten die Adresse eines beliebigen Objektes gespeichert (Zeile 09). Die Vergleichsoperation, die der Baum als Ordnungskriterium benötigt, wird vom rufenden Programm als Prozedurparameter übergeben (Zeile 00) und im Wurzelknoten des AVL-Baums gespeichert (Zeilen 03 und 04).
IMPLEMENTATION MODULE OAVL_TREE;
00 TYPE ordertype = PROCEDURE( ADDRESS, ADDRESS ): BOOLEAN;
01 tableheader = RECORD
02 adr : ADDRESS;
03 equal : ordertype;
04 order : ordertype;
05 size : CARDINAL;
06 root : nodepointer;
07 END (* record *);
08 tablenode = RECORD
09 info : ADDRESS;
10 left : nodepointer;
11 right : nodepointer;
12 bal : [ -1..1 ];
13 END (* record *);
Das Modul OAVL_TREE stellt eine Prozedur define zur Verfügung, mit der das rufende Programm die entsprechenden Parameter übergeben kann.
14 PROCEDURE define (VAR t : table; equal, order : ordertype;
15 item : ARRAY OF BYTE);
16 BEGIN
17 NEW(t);
18 t^.adr := ADR(t);
19 t^.root := NIL;
20 t^.equal := equal;
21 t^.order := order;
22 t^.size := HIGH(item) + 1;
23 END define;
Um einen neuen Knoten zu erzeugen, wird die Größe der Datenstruktur aus dem rufenden Programm benötigt, die im Wurzelknoten des AVL-Baums (Zeile 05) unter dem Bezeichner size abgelegt ist.
24 PROCEDURE getnode ( size : CARDINAL; item : ADDRESS): nodepointer;
25 VAR newnode : nodepointer;
26 bytecount : CARDINAL;
27 from,to: POINTER TO BYTE;
28 BEGIN
29 NEW( newnode );
30 newnode^.left := NIL; newnode^.right := NIL; newnode^.bal := 0;
31 ALLOCATE(newnode^.info, size);
32 from:=item; to:=newnode^.info;
33 FOR bytecount := 0 TO size - 1 DO
34 to^:=from^; to:= ADDADR( CAST(ADDRESS, to), 1 );
35 from := ADDADR( CAST(ADDRESS, from), 1 );
36 END;
37 RETURN newnode;
38 END getnode;
END OAVL_TREE;
Der entsprechende Speicherplatz wird in Zeile 31 mit der Funktion ALLOCATE bereitgestellt. Die Daten müssen byteweise von der Datenstruktur des rufenden Programms (Adresse der Struktur in item) auf den Speicherplatz, auf den die Adresse newnode^.info zeigt, kopiert werden.
Da Modula-2 weder Objekte noch Generizität hat, kann man die Schnittstelle zur Modula-2 Implementierung von AVL nicht typsicher gestalten. Das wird durch die Verwendung des Datentyps ADDRESS angezeigt.
Im Oberon-2 Programm wird in dem Baumknoten ein Zeiger auf ein Objekt gespeichert (Zeile 09). Das Objekt erbt seine Eigenschaften aus der Basiskalsse des Moduls Objects_Types. Diese Modul ist Teil des Laufzeitsystems und gehört zur Oberon-2 Compiler Bibliothek (Siehe Anhang 1).
Nach außen ist die Basisklasse des Moduls Objects_Types ein leerer Datensatz, der vom Anwender beliebig erweitert werden kann (Zeile 02). Objects_Types unterstützt die Erzeugung persistenter Objekte (siehe Kapitel 2.5). Außerdem erlaubt es die explizite Speicherplatzfreigabe von Objekten in Abhängigkeit vom dynamischen Typ. Üblicherweise wird in Oberon-2 der Speicherplatz nach jedem Programmlauf bzw., falls eine Speichergrenze erreicht wird, automatisch durch die sog. Garbage-Collection freigegeben. Die verwendete Implementierung unter OpenVMS erlaubt jedoch auch die explizite Deallokation von Objekten beliebigen Typs durch eine Bibliotheksfunktion.
MODULE OAVL_TREE;
IMPORT OT := Objects_Types
00 TYPE
01 Object* = POINTER TO ObjectDesc;
02 ObjectDesc* = RECORD (OT.ObjectDesc) END;
03 Type* = OT.Type;
04 nodepointer = POINTER TO tablenode;
05 tablenode = RECORD
06 left: nodepointer;
07 right: nodepointer;
08 bal : INTEGER;
09 info : Object;
10 END;
11 table* = POINTER TO tableheader;
12 tableheader = RECORD
13 root: nodepointer;
14 objtype: Type;
15 END;
Die Vergleichsoperationen, die der Baum als Ordnungskriterium benötigt, hängen direkt am Objekt (siehe 2.2). Das Balancefeld (Zeile 08) kann hier leider nur als INTEGER deklariert werden, da Oberon keine Aufzählungstypen erlaubt.
Der Wurzelknoten bestand ursprünglich nur aus dem Wurzelzeiger. Auf Wunsch des Anwenders wurde eine Testmöglichkeit hinzugefügt, die garantiert, daß der Baum nur Knoten eines Datentyps aufnimmt. Hierzu wird aus dem rufenden Programm ein Objekttyp übergeben.
Das Modul OAVL_TREE stellt für diese Übergabe eine Prozedur define (Zeile 16) zur Verfügung.
16 PROCEDURE define* (VAR t : table; type: Type);
17 BEGIN
18 NEW(t);
19 t.init(type);
20 END define;
Getestet wird mit der Abfrage 'IF (OT.TypeOf(w) = tree^.type) THEN'. Nur wenn dieser Test TRUE zurückliefert, wird die entsprechende Bearbeitung veranlaßt.
Die Funktion getnode wird einfacher und übersichtlicher:
21 PROCEDURE getnode (item : Object) : nodepointer;
22 VAR newnode : nodepointer;
23 BEGIN
24 NEW(newnode);
25 newnode^.left := NIL; newnode^.right := NIL;
26 newnode^.bal := 0;
27 newnode^.info := item;
28 RETURN newnode;
29 END getnode;
Das zu speichernde Objekt wird hier allerdings vom rufenden Programm mit NEW erzeugt. Die Daten werden gleich in das entsprechende Objekt geschrieben.
Da der AVL-Baum unter Modula-2 generisch geschrieben wurde, waren bezüglich der Baumprozeduren keine großen Änderungen erforderlich. Der Baum wurde allerdings hier als Methode zu dem Objekt tableheader implementiert, um eventuelle Erweiterungen zu gewährleisten, z.B:
Oberon-2: PROCEDURE (tree : table) insert* (w : Object);
Modula-2: PROCEDURE insert (VAR t : table; item : ADDRESS);
Ein Vergleich mit den Testdaten von der Modula-2 Version mit dem Oberon-2 Programm ergab bezüglich der Laufzeit keine Unterschiede. Das heißt, daß die Anwendung einer objektorientierten Sprache nicht inhärent ineffizient sein muss. Tatsächlich ist der Aufruf von dynamisch gebundenen Methoden nicht langsamer verglichen mit einer konventionell implementierten Variantenauswahl, z.B. mit einem nicht erweiterbaren Case-Statement.
Persistente Objekte bezeichnen Objekte, die das Programm überleben, welches sie erzeugt hat. Eine Möglichkeit, dieses zu erreichen, ist, die Objekte auf Datei zu schreiben. Das Problem liegt darin, daß das weiterverarbeitende Programm die Struktur des Objektes nicht kennen kann, zumindest wenn eine Forderung nach generischen Bausteinen besteht.
Daher schreibt man zusätzlich zu dem Wert des Objektes seinen Typ auf die Datei. Das geschieht in der Praxis nicht explizit, sondern automatisch und zwar über die Store-Funktion der persistenten Basisklasse.
Dazu benötigt man die Möglichkeit, aus einem Objekt einen eindeutigen Typnamen bzw. aus einem Typnamen ein Objekt zu erzeugen.
In Oberon-2 enthält jedes Objekt einen Typdeskriptor. Dieser beinhaltet unter anderem den Typnamen des Objekts. Alle Objekte einer Klasse haben denselben Typdeskriptor.
Mit Hilfe der Prozedur TypeName aus dem Modul Objects_Types (OT) wird der Typname des Objektes bestimmt. Er besteht aus dem Modulnamen (in verschiedenen Modulen können die Typnamen übereinstimmen) und dem Typnamen.
Die Deklaration der verwendeten Ausgabeprozedure WriteNBytes ist:
PROCEDURE WriteNBytes (VAR f: IOChan.ChanId; bufPtr: SYSTEM.PTR;
reqBytes: CARDINAL; VAR ok : BOOLEAN);
30 TYPE
31 Stream = RECORD
32 file : IOChan.ChanId;
33 tab: ARRAY maxNames OF TypeName;
34 end: INTEGER; (* höchstens bis maxNames - 1 *)
35 END;
36 PROCEDURE WriteObj (VAR r: Stream; x: Object; VAR ok : BOOLEAN);
37 VAR module,name: TypeName;
38 BEGIN
39 IF x=NIL THEN r.WriteString(noName);
40 ELSE
41 OT.TypeName(OT.TypeOf(x), module,name);
42 r.WriteString(module);
43 r.WriteString(name);
44 WriteNBytes(r.file, x, OT.SizeOf(x), ok);
45 END;
46 END WriteObj;
Die Daten werden (in diesem Fall) in einer ASCII - Datei gespeichert. Um Platz zu sparen, werden die Typnamen in der Datei in komprimierter Form gespeichert. Bei seinem ersten Auftreten wird der Typname in seiner vollen Länge gespeichert. Die verarbeitenden Programme legen eine Tabelle an, in der die Typnamen nach der Reihenfolge des Auftretens in der Datei abgelegt werden. Sind die Typnamen in der Tabelle angelegt, wird beim nächsten Auftreten nur der Index aus der Tabelle gespeichert.
Da eine solche Vorgehensweise den Ein- bzw. Ausgabemechanismus genau festlegt, wäre es empfehlenswert, ein Modul für diese Operationen in Form einer Methode auf einem E/A-Kanal zur Verfügung zu stellen. RawIO ist ein Modul aus der ISO Modula-2 Standardbibliothek [Baum92].
47 PROCEDURE (VAR r: Stream) WriteString (s: TypeName);
48 VAR i: INTEGER;
49 BEGIN
50 i:=0;
51 LOOP (* search s in r.tab *)
52 IF i=r.end THEN (* first occurence of s *)
53 RawIO.Write(r.file,i); RawIO.Write(r.file,s);
55 r.tab[r.end] := s; INC(r.end); EXIT
56 ELSIF s=r.tab[i] THEN
57 RawIO.Write(r.file,i); EXIT;
58 ELSE INC(i);
59 END;
60 END;
61 END WriteString;
Beim Lesen aus der Datei wird zunächst der Typname rekonstruiert, um dann ein neues Objekt mit dem entsprechenden dynamischen Typ zu erzeugen.
Die Deklaration der verwendeten Eingabeprozedure ReadNBytes ist:
PROCEDURE ReadNBytes (VAR f: IOChan.ChanId; bufPtr: SYSTEM.PTR;
reqBytes: CARDINAL; VAR ok: BOOLEAN);
62 PROCEDURE ReadObj (VAR r:Stream; VAR x:Object; VAR ok:BOOLEAN);
63 VAR module,name: TypeName; y: OT.Object;
64 BEGIN
65 r.ReadString(module);
(* Methode genau gegensätzlich zu WriteString *)
66 IF module="" THEN x:=NIL; ok:=TRUE;
67 ELSE r.ReadString(name);
68 OT.NewObj(y, OT.This(module, name));
69 x:=y(Object);
70 ReadNBytes(r.file, x, OT.SizeOf(x), ok);
71 END;
72 END ReadObj;
Die Prozedur This aus Objects_Types erzeugt aus dem Typnamen den entsprechenden Typ (Zeile 68).
Aus der Datei wird solange eingelesen, bis kein Typname mehr gefunden wird. Als letztes Objekt wird daher beim Schreiben NoName weggeschrieben. Somit muß die Datei keine besondere Dateiendekennung (EOF) besitzen.
Die vollständige Lösung mit Oberon-2 Quellcode ist im Anhang 2 zu finden. Es ist vielleicht ganz interessant, diese mit der ursprünglichen Modula-2 Definition des Baumverwalters zu vergleichen (siehe Anhang 2.3).
Diese Lösung wurde in syntaktisch leicht modifizierter Form als Beispiel in [Dotz93] veröffentlicht. Eine nähere Beschreibung der Handhabung von persistenten Objecten findet sich in [Goeb93].
Das Modul Objects_Types bietet wie oben (Kapitel 2.5) erwähnt die Möglichkeit, ein Objekt durch Bestimmung eines Typ- und Modulnamens eindeutig zu kennzeichnen. Eine Prozedur NewObj ist in der Lage, anhand dieser Kennzeichnung ein Objekt zu erzeugen.
Es wäre also ausreichend in der Tabelle (aus Kapitel 2.3) des Basismoduls den Typnamen und den Modulnamen zu merken, um erst auf Verlangen des Anwenders dynamisch ein Objekt dieses Typs zu erzeugen.
00 TYPE
01 Nodet = RECORD
02 typname : STRING;
03 modulname : STRING;
04 END;
Außerdem besteht die Möglichkeit, Module dynamisch nachzuladen. So wäre es z. B. möglich, im Hauptprogramm eine Liste verschiedener Sätze vom Typ Nodet einem Anwender anzubieten und erst aufgrund seiner Eingaben, das Modul mit der entsprechenden Objektbeschreibung, zu laden.
Die Firma ModulaWare ist aktives Mitglied der internationalen Standardisierungsgruppe für Modula-2 (SC22.WG13). Ein wesentlicher Erfolg dieses Komitees ist eine ausgereifte Standard-Bibliothek für Modula-2, deren Semantik ebenfalls formal genau spezifiziert ist.
Ein bis zweimal im Jahr findet ein internationales Standardisierungstreffen statt. Die deutsche Arbeitsgruppe des DIN-AK22.13 trifft sich mehrmals im Jahr. Nach ca. 9 Jahren ist der internationale Standard abgeschlossen. Das im Juni 1994 erschienene Standardisierungsdokument hat einen Umfang von 700 Seiten. Was diesen Sprachstandard von anderen unterscheidet und was auch gleichzeitig für den gewaltigen Umfang dieses Werkes verantwortlich ist, ist die formale Beschreibung nicht nur der Syntax, sondern auch der Semantik aller Sprachkonstrukte und Bibliotheksroutinen.
Die Arbeit des Modula-2 Standardisierungs-Komitees geht allerdings weiter. Zur Zeit untersucht man, wie Modula-2 objektorientiert erweitert werden könnte. ModulaWare wird sich an den Arbeiten dieser Spracherweiterung nicht mehr beteiligen, da es nicht Aufgabe eines Standardisierungskomitees ist und sein kann, eine Sprache zu entwerfen. Die Aufgabe eines solchen Komitees, existierende Praxis zu standardisieren, ist mit den, über die Jahre eingeflossenen erheblichen Erweiterungen bereits übererfüllt worden.
Von der Firma ModulaWare gibt es sowohl für DEC VAX als auch für Alpha unter OpenVMS entsprechende Modula-2 Compiler. Mit allen Bibliotheks-Schnittstellen umfaßt das Produkt MVR für die VAX bzw. MaX für die Alpha ca. 185.000 Zeilen Quellcode. Enthalten ist eine Implementierung der ISO Modula-2 Standard Bibliothek. Der Compiler richtet sich weitgehend nach ISO Modula-2 10154.
Prof. N. Wirth hat mit Oberon einen würdigen Nachfolger ganz im Geiste von Modula-2 geschaffen. Oberon bietet gegenüber Modula-2 erheblich gesteigerte Ausdrucksfähigkeiten, bei gleichzeitig stark vereinfachtem Sprachumfang.
Für die Sprache Oberon-2 gibt es eine de-facto Norm der ETH-Zürich. Wenn man Oberon sagt, so ist damit aber nicht nur eine Programmiersprache, sondern auch ein Konzept gemeint, das aus Compiler, graphischer Benutzeroberfläche, Bibliothek und Betriebssystem besteht. Dieses Konzept, das eine völlig neue Philosophie verkörpert, wird Oberon System genannt. Innerhalb des Oberon Systems, das übrigens inklusive Compiler völlig offengelegt wurde [Wirt92], gibt es zwar Standardmodule, diese sind jedoch für stand-alone Compiler nicht alle brauchbar. Der gesamte Quellcode des Oberon Systems, sowie Oberon Systeme für fast alle verbreiteten Rechnersysteme sind auf CD-ROM [Temp94] verfügbar. Da es für stand-alone Oberon-2 also noch keine komplett genormte Bibliothek gibt, ist es besonders vorteilhaft, wenn Module aus der ISO Modula-2 Bibliothek in Oberon-Programme eingebunden werden können.
Die Firma ModulaWare hat im Jahre 1992 einen Oberon-2 Compiler für die VAX und 1994 für die Alpha unter OpenVMS entwickelt. Wesentliche Merkmale des Oberon-2 Compilers sind:
Das Produkt H2O (VAX) bzw. A2O (Alpha) umfaßt ca. 40.000 Zeilen Quellcode (ohne Schnittstellen- bzw. Definitionsmodule, Bibliothek und Dokumentation). ModulaWare's Oberon-2 Compiler erlauben die Verwendung des symbolischen Laufzeitdebuggers von OpenVMS und halten sich an die Prozeduraufrufkonventionen von OpenVMS. Dadurch ist es möglich, die Bibliotheksmodule von ISO Modula-2 in Oberon-2 zu verwenden. ModulaWare realisiert keine automatische Speicherplatzfreigabe bzw. Garbage-Collection (GC), bietet aber die Möglichkeit, den Speicher über eine Bibliotheksfunktion explizit freizugeben. Das Betriebssystem OpenVMS gewährleistet ausserdem, daß der gesamte Speicher nach Programmende selbständig freigegeben wird.
Das Alpha Oberon Systems (AOS), ModulaWare's Implementierung des Oberon Systems V4 enthällt einen, in das Oberon System eingebetten Oberon-2 Compiler. Dieses System hat natürlich einen eingebauten GC.
Was Modula-2 im Gegensatz zu Pascal interessant macht, ist unter anderem, daß es sich bei Modula-2 um eine kleinere, aber funktionell erweiterte Sprache handelt. Neu ist vor allem das Modulkonzept, das auch die Bewältigung von großen Projekten ermöglicht.
Oberon-2 ist recht jung und schränkt den Sprachumfang von Modula-2 weiter ein, erlaubt aber durch seine Objektorientiertheit die Entwicklung von erweiterbarer Software.
Sowohl Modula-2 als auch Oberon-2 sind hinreichend standardisiert, d. h. alle Programme sollten von jedem standard-konformen Compiler übersetzbar sein. Kritikpunkte an Pascal [Kern81] sind für Modula-2 und Oberon-2 nicht mehr zutreffend.
Die Übersichtlichkeit beider Sprachen bietet eine gute Grundlage für Programmieranfänger. Oberon-2 eignet sich auch deshalb gut für den Programmiereinstieg, da diese Sprache einen minimalen Sprachumfang hat und sich auf das Wesentliche konzentriert.
Zu Oberon-2 gibt es sehr gute Einsteigerbücher in deutscher und englischer Sprache [Möss93], [Wirt94]. Insgesamt würde durch eine generelle Einführung von Oberon-2 in der Ausbildung der modulare Programmierstil und die Disziplin der Studenten gefördert. Die wohl herausragendste Spracheigenschaft ist, daß Oberon-2 keine versteckten Mechanismen in den Sprachkonstrukten und -konzepten enthält.
[Baum92] Elmar Baumgart: The ISO Modula-2 for Oberon-2 - Definition of Interface Modules with example and test programs, The ModulaTor, Vol. 2, Nr. 8, ModulaWare, Sep-1992.
[Dotz93] Dotzel, Günter: A modest proposal for Object-Oriented Extension of ISO Modula-2. The ModulaTor, Vol 3, Nr. 4, ModulaWare, Mai-1993.
[Goeb93] Hartmut Goebel, Günter Dotzel: Persistent Objects in Oberon-2 on OpenVMS Alpha and VAX, The ModulaTor, Vol 3, Nr. 1, ModulaWare, Feb-1993 (2nd ed. Nov-94).
[Möss93] Mössenböck, Hanspeter: Objektorientierte Programmierung in Oberon-2 Springer-Verlag Berlin Heidelberg, 1993. Auch in englischer Sprache verfügbar.
[Kern81] Kernighan, Brian W.: Why Pascal is not my favorite programming language, Bell Labs, Computing Science, Technical Report Nr. 100, 1981.
[Temp94] Templ, Josef: Oberon CD-ROM. Addison Wesley (Deutschland), 1994.
[Temp94a] Templ, Josef: Oberon vs. C++, The ModulaTor, Vol 4, Nr. 9, ModulaWare, Oct-1994.
[Wirt92] Wirth, Niklaus; Gutknecht, Jürg: Project Oberon. Addison Wesley, 1992.
[Wirt94] Reiser, Martin; Wirth, Niklaus: Programmieren in Oberon. Addison Wesley (Deutschland), 1994 (übersetzt aus dem Englischen von Josef Templ).
DEFINITION Objects_Types;
IMPORT SYSTEM;
CONST
QuadwordSize = 8;
adrSize = 8;
maxIdentLen = 32;
tagSize = 8;
TYPE
ADDRESS_64 = SYSTEM.SIGNED_64;
Name = ARRAY 32 OF CHAR;
NamePtr = POINTER TO RECORD
name: Name;
END ;
Object = POINTER TO ObjectDesc;
ObjectDesc = RECORD END ;
Size = SYSTEM.SIGNED_64;
Tag = SYSTEM.SIGNED_64;
Type = POINTER TO TypeDesc;
TypeDesc = RECORD
module: NamePtr;
name: Name;
END ;
VAR
Modules: ARRAY 256 OF ModEntryDesc;
PROCEDURE DisposeDynArray (VAR o: SYSTEM.PTR; obolete1, obsolete2: LONGINT);
PROCEDURE DisposeObj (VAR o: Object);
PROCEDURE NewObj (VAR o: Object; t: Type);
PROCEDURE SizeOf (o: Object): LONGINT;
PROCEDURE StoreModObjects (typeDescBase: TypesArray);
PROCEDURE This (module, name: ARRAY OF CHAR): Type;
PROCEDURE TypeName (typ: Type; VAR module, name: ARRAY OF CHAR);
PROCEDURE TypeOf (o: Object): Type;
END Objects_Types.
MODULE OAVL_ISO;
(* Oberon-2 version of Modula-2's module Table.
In contrast to Table,
- Full type safety is guaranteed for all extensions of
the data type OAVL.Object
- Full generic with persistent objects support for data stored/loaded
to/from file.
See module Use_OAVL.Mod and Use_OAVL1.Mod for an example how to use
OAVL.
Derived from module Table by Petra Fabian, ModulaWare, Erlangen, 08-Apr-1993
*)
IMPORT TTIO := STextIO, OT := Objects_Types, SYSTEM, Storage, CTR,
RawIO, IOChan, SF := SeqFile;
CONST
insertionerror* = 0;
deletionerror* = 1;
readerror* = 2;
writeerror* = 3;
treeerror* = 4;
(* persistent object support *)
maxIdentLen = OT.maxIdentLen; (* maximal length of Oberon-2 identifiers *)
maxNames = 256; (* index compression for the first 256 names provided *)
noName = "";
TYPE
Type* = OT.Type;
INTEGER* = LONGINT;
CARDINAL* = CTR.CARDINAL;
Object* = POINTER TO ObjectDesc;
ObjectDesc* = RECORD (OT.ObjectDesc) END;
nodepointer = POINTER TO tablenode;
tablenode = RECORD (OT.ObjectDesc)
(* GD/05-Nov-1994: now based on OT.ObjectDesc,
just to be able to use OT.DisposeObj *)
left: nodepointer;
right: nodepointer;
bal : INTEGER;
info : Object;
END;
table* = POINTER TO tableheader;
tableheader = RECORD
root: nodepointer;
objtype: Type;
END;
tableerror* = INTEGER;
visittype* = PROCEDURE( VAR a: Object );
(* persistent object support *)
TypeName = ARRAY maxIdentLen OF CHAR;
ModuleTypeName = RECORD
module, type: TypeName;
END;
Stream = RECORD
file : IOChan.ChanId;
tab: ARRAY maxNames OF TypeName; (* tab[0]="" *)
end: INTEGER (* tab[0..end-1] are filled *)
END;
VAR ok* : BOOLEAN;
(* This variable is set after each operation. A value
of true indicates that the last operation was
successful. A value of false indicates that the
last operation was unsuccessful and that the user
defined error handler was called. This variable is
also set to false if define was not called prior to
any other operation. In this case, the user defined
error handler is not called. *)
PROCEDURE Dispose* (o: Object);
VAR item : OT.Object;
BEGIN
item := o;
OT.DisposeObj(item);
END Dispose;
PROCEDURE TypeOf* (o: Object): Type;
BEGIN
RETURN OT.TypeOf(o);
END TypeOf;
PROCEDURE (t: table) type* (): Type;
BEGIN
RETURN t.objtype;
END type;
PROCEDURE ReadNBytes ( VAR f : IOChan.ChanId;
bufPtr : SYSTEM.PTR;
reqBytes: CARDINAL;
VAR ok: BOOLEAN );
VAR i, read : CARDINAL;
BEGIN
read := 0;
FOR i := 1 TO reqBytes DO
RawIO.Read( f, bufPtr^ );
bufPtr := SYSTEM.VAL(SYSTEM.PTR, SYSTEM.VAL(LONGINT, bufPtr) + 1);
INC( read );
END (* for *);
ok := read = reqBytes;
END ReadNBytes;
PROCEDURE WriteNBytes ( VAR f : IOChan.ChanId;
bufPtr : SYSTEM.PTR;
reqBytes: CARDINAL;
VAR ok : BOOLEAN);
VAR i, written : CARDINAL;
BEGIN
written := 0;
FOR i := 1 TO reqBytes DO
RawIO.Write( f, bufPtr^);
bufPtr := SYSTEM.VAL(SYSTEM.PTR, SYSTEM.VAL(LONGINT, bufPtr) + 1);
INC( written );
END (* for *);
ok := written = reqBytes;
END WriteNBytes;
PROCEDURE (VAR r: Stream) WriteString (s: TypeName);
(* see The ModulaTor [3,1] *)
VAR i: INTEGER;
BEGIN
i:=0;
LOOP (* search s in r.tab *)
IF i=r.end THEN (* first occurence of s *)
RawIO.Write(r.file,i);
RawIO.Write(r.file,s);
r.tab[r.end] := s; INC(r.end);
EXIT
ELSIF s=r.tab[i] THEN
RawIO.Write(r.file,i);
EXIT;
ELSE INC(i);
END;
END;
END WriteString;
PROCEDURE (VAR r: Stream) ReadString (VAR s: TypeName);
(* see The ModulaTor [3,1] *)
VAR i: INTEGER;
BEGIN
RawIO.Read(r.file,SYSTEM.VAL(SYSTEM.WORD, i));
IF i = r.end THEN (* full text follows *)
RawIO.Read(r.file,s);
r.tab[r.end] := s; INC(r.end);
ELSE
s := r.tab[i];
END;
END ReadString;
PROCEDURE WriteObj (VAR r: Stream; x: Object; VAR ok : BOOLEAN);
(* see The ModulaTor [3,1], modified to WriteNBytes instead of calling
a store method *)
VAR module,name: TypeName;
BEGIN
IF x=NIL THEN r.WriteString(noName);
ok := TRUE;
ELSE
OT.TypeName(OT.TypeOf(x),module,name);
r.WriteString(module);
r.WriteString(name);
WriteNBytes(r.file, x, OT.SizeOf(x), ok);
END;
END WriteObj;
PROCEDURE ReadObj (VAR r: Stream; VAR x: Object; VAR ok : BOOLEAN);
(* see The ModulaTor [3,1], modified to ReadNBytes instead of calling
a load method *)
VAR module,name: TypeName; y: OT.Object;
BEGIN
r.ReadString(module);
IF module="" THEN
x:=NIL;
ok:=TRUE;
ELSE
r.ReadString(name);
OT.NewObj(y,OT.This(module,name));
(* temporary variable y of base type and type test necessary.
There is an error in OOPiO2 on p 106 *)
x:=y(Object);
ReadNBytes(r.file,x,OT.SizeOf(x), ok);
END;
END ReadObj;
PROCEDURE error*
( err: tableerror (* in *) );
BEGIN
CASE err OF
| insertionerror:
TTIO.WriteString( "Illegal insert operation. " );
TTIO.WriteString( "The item already exists in the table." );
TTIO.WriteLn;
| deletionerror:
TTIO.WriteString( "Illegal delete operation. " );
TTIO.WriteString( "The item is not in the table." );
TTIO.WriteLn;
| readerror:
TTIO.WriteString( "Error while opening or reading the file." );
TTIO.WriteLn;
| writeerror:
TTIO.WriteString( "Error while saving the table " );
TTIO.WriteString( "into the file." );
TTIO.WriteLn;
| treeerror:
TTIO.WriteString( "Illegal insert operation. " );
TTIO.WriteString( "The item does'nt belong to the table." );
TTIO.WriteLn;
END (* case *)
END error;
PROCEDURE getnode (item : Object) : nodepointer;
VAR newnode : nodepointer;
BEGIN
NEW(newnode);
newnode^.left := NIL;
newnode^.right := NIL;
newnode^.bal := 0;
newnode^.info := item;
RETURN newnode;
END getnode;
PROCEDURE freenode (VAR oldnode : nodepointer);
(* GD/05-Nov-1994: replaced the system dependent way
of disposing an object manually:
VAR size : CARDINAL;
BEGIN
size := SIZE(tablenode);
oldnode := SYSTEM.VAL(nodepointer, SYSTEM.VAL(LONGINT, oldnode) - 4);
Storage.DEALLOCATE(SYSTEM.VAL(CTR.ADDRESS,oldnode), size + 4);
by using a library procedure:
*)
VAR o: OT.Object;
BEGIN
o:=oldnode;
OT.DisposeObj(o);
oldnode:=NIL;
END freenode;
PROCEDURE (info : Object) order* (item : Object): BOOLEAN;
BEGIN
HALT(20);
END order;
PROCEDURE (info : Object) equal* (item : Object): BOOLEAN;
BEGIN
HALT(20);
END equal;
PROCEDURE (item : table) init (type: Type);
BEGIN
item.root := NIL;
item.objtype := type;
END init;
PROCEDURE define* (VAR t : table; type: Type);
BEGIN
NEW(t);
t.init(type);
END define;
PROCEDURE (t : table) empty* (): BOOLEAN;
BEGIN
ok := FALSE;
IF ( t # NIL )
THEN
ok := TRUE
END (* if then *);
RETURN t.root = NIL
END empty;
PROCEDURE (tree : table) insert* (w : Object);
VAR p1, p2 : nodepointer;
h : BOOLEAN;
PROCEDURE AVLInsert (w : Object; VAR p : nodepointer; VAR h: BOOLEAN);
BEGIN
IF p = NIL
THEN
h := TRUE;
p := getnode(w);
ELSIF w.order(p^.info)
THEN
AVLInsert( w, p^.left, h );
IF h
THEN
CASE p^.bal OF
| 1 :
p^.bal := 0;
h := FALSE;
| 0 :
p^.bal := -1;
| -1 :
p1 := p^.left;
IF p1^.bal = -1
THEN
(* single left rotation *)
p^.left := p1^.right;
p1^.right := p;
p^.bal := 0;
p := p1;
ELSE
(* left right rotation *)
p2 := p1^.right;
p1^.right := p2^.left;
p2^.left := p1;
p^.left := p2^.right;
p2^.right := p;
IF p2^.bal = -1
THEN
p^.bal := 1;
ELSE
p^.bal := 0;
END (* if then *);
IF p2^.bal = 1
THEN
p1^.bal := -1;
ELSE
p1^.bal := 0;
END (* if then *);
p := p2;
END (* if then *);
p^.bal := 0;
h := FALSE;
END (* case *);
END (* if then *);
ELSIF (~ w.equal(p^.info)) & (~ w.order(p^.info))
THEN
AVLInsert( w, p^.right, h );
IF h
THEN
CASE p^.bal OF
| -1 :
p^.bal := 0;
h := FALSE;
| 0 :
p^.bal := 1;
| 1 :
p1 := p^.right;
IF p1^.bal = 1
THEN
(* single right rotation *)
p^.right := p1^.left;
p1^.left := p;
p^.bal := 0;
p := p1;
ELSE
(* right left rotation *)
p2 := p1^.left;
p1^.left := p2^.right;
p2^.right := p1;
p^.right := p2^.left;
p2^.left := p;
IF p2^.bal = 1
THEN
p^.bal := -1
ELSE
p^.bal := 0;
END (* if then *);
IF p2^.bal = -1
THEN
p1^.bal := 1
ELSE
p1^.bal := 0;
END (* if then *);
p := p2;
END (* if then *);
p^.bal := 0;
h := FALSE;
END (* case *);
ELSE
h := FALSE;
END (* if then *);
ELSE
ok := FALSE;
error( insertionerror );
h := FALSE;
END (* if then *);
END AVLInsert;
BEGIN (* insert *)
ok := FALSE;
IF (tree # NIL) THEN
IF (OT.TypeOf(w) # tree^.objtype) THEN
error( treeerror);
ELSE
ok := TRUE;
AVLInsert(w,tree^.root,h);
END (* if then *)
END;
END insert;
PROCEDURE (tree : table) delete* (item : Object);
VAR h : BOOLEAN;
PROCEDURE AVLDelete (x : Object;
p : nodepointer (* in/out *);
VAR h : BOOLEAN (* in/out *) );
VAR
q,mark : nodepointer;
PROCEDURE balance1 ( p : nodepointer;
VAR h : BOOLEAN (* in/out *) );
VAR
p1,p2 : nodepointer;
b1,b2 : INTEGER;
BEGIN
CASE p^.bal OF
| -1 :
p^.bal := 0;
| 0 :
p^.bal := 1;
h := FALSE;
| 1 :
p1 := p^.right;
b1 := p1^.bal;
IF b1 >= 0
THEN
p^.right := p1^.left;
p1^.left := p;
IF b1 = 0
THEN
p^.bal := 1;
p1^.bal := -1;
h := FALSE;
ELSE
p^.bal := 0;
p1^.bal := 0;
END (* if then *);
p := p1;
ELSE
p2 := p1^.left;
b2 := p2^.bal;
p1^.left := p2^.right;
p2^.right := p1;
p^.right := p2^.left;
p2^.left := p;
IF b2 = 1
THEN
p^.bal := -1
ELSE
p^.bal := 0;
END (* if then *);
IF b2 = -1
THEN
p1^.bal := 1
ELSE
p1^.bal := 0;
END (* if then *);
p := p2;
p2^.bal := 0;
END (* if then *);
END (* case *);
END balance1;
PROCEDURE balance2 (p : nodepointer (* in/out *);
VAR h : BOOLEAN (* in/out *) );
VAR
p1,p2 : nodepointer;
b1,b2 : INTEGER;
BEGIN
CASE p^.bal OF
| 1 :
p^.bal := 0;
| 0 :
p^.bal := -1;
h := FALSE;
| -1 :
p1 := p^.left;
b1 := p1^.bal;
IF b1 <= 0
THEN
p^.left := p1^.right;
p1^.right := p;
IF b1 = 0
THEN
p^.bal := -1;
p1^.bal := 1;
h := FALSE;
ELSE
p^.bal := 0;
p1^.bal := 0;
END (* if then *);
p := p1;
ELSE
p2 := p1^.right;
b2 := p2^.bal;
p1^.right := p2^.left;
p2^.left := p1;
p^.left := p2^.right;
p2^.right := p;
IF b2 = -1
THEN
p^.bal := 1
ELSE
p^.bal := 0;
END (* if then *);
IF b2 = 1
THEN
p1^.bal := -1
ELSE
p1^.bal := 0;
END (* if then *);
p := p2;
p2^.bal := 0;
END (* if then *);
END (* case *);
END balance2;
PROCEDURE del (r : nodepointer (* in/out *);
VAR h : BOOLEAN (* in/out *) );
BEGIN
IF ~ ( r^.right = NIL )
THEN
del( r^.right, h );
IF h
THEN
balance2( r, h );
END (* if then *);
ELSE
Dispose(p^.info);
p^.info := r^.info;
mark := r;
r := r^.left;
freenode(r);
h := TRUE;
END (* if then *);
END del;
BEGIN (* AVLDelete *)
IF p = NIL
THEN
ok := FALSE;
error( deletionerror );
h := FALSE;
ELSIF x.order(p^.info)
THEN
AVLDelete( x, p^.left, h );
IF h
THEN
balance1( p, h );
END (* if then *);
ELSIF ( ~ x.equal(p^.info)) & ( ~ x.order(p^.info))
THEN
AVLDelete( x, p^.right, h );
IF h
THEN
balance2( p, h );
END (* if then *);
ELSIF p^.right = NIL
THEN
q := p;
p := q^.left;
h := TRUE;
freenode(q);
ELSIF p^.left = NIL
THEN
q := p;
p := q^.right;
h := TRUE;
freenode(q);
ELSE
del( p^.left, h );
IF h
THEN
balance1( p, h );
END (* if then *);
END (* if then *);
END AVLDelete;
BEGIN (* delete *)
ok := FALSE;
IF ( tree # NIL ) THEN
IF (OT.TypeOf(item) # tree^.objtype) THEN
error( treeerror);
ELSE
ok := TRUE;
AVLDelete( item, tree^.root, h )
END (* if then *);
END;
END delete;
PROCEDURE ( t: table) visit* (visitproc : visittype (* in *));
PROCEDURE visitation ( p : nodepointer (* in *) );
BEGIN
IF p # NIL
THEN
visitation( p^.left );
visitproc( p^.info );
visitation( p^.right );
END (* if then *);
END visitation;
BEGIN (* visit *)
ok := FALSE;
IF ( t # NIL )
THEN
IF t.empty()
THEN
ok := FALSE;
ELSE
visitation( t^.root );
ok := TRUE;
END (* if then *)
END (* if then *)
END visit;
PROCEDURE ( t : table) visitelement* (item : Object (* in *);
visitproc: visittype (* in *) );
VAR
current : nodepointer;
found : BOOLEAN;
BEGIN (* visitelement *)
ok := FALSE;
found := FALSE;
IF (OT.TypeOf(item) # t^.objtype) THEN
error( treeerror);
ELSIF ( t # NIL )
THEN
current := t.root;
WHILE ( current # NIL ) & ( ~ found ) DO
IF item.equal( current^.info )
THEN
visitproc( current^.info );
found := TRUE;
ELSE
IF item.order( current^.info )
THEN
current := current^.left;
ELSE
current := current^.right;
END (* if then *);
END (* if then *);
END (* while loop *);
ok := TRUE;
END (* if then *);
END visitelement;
PROCEDURE ( t : table) ispresent* (item : Object (* in *) ): BOOLEAN;
VAR
current : nodepointer;
found : BOOLEAN;
BEGIN
ok := FALSE;
found := FALSE;
IF ( t # NIL ) THEN
IF (OT.TypeOf(item) # t^.objtype) THEN
error( treeerror);
ELSE
current := t^.root;
WHILE ( current # NIL ) & ( ~ found ) DO
IF item.equal( current^.info )
THEN
found := TRUE;
ELSIF item.order( current^.info )
THEN
current := current^.left;
ELSE
current := current^.right;
END (* if then *);
END (* while loop *);
ok := TRUE
END (* if then *);
END (* if then *);
RETURN found;
END ispresent;
PROCEDURE ( t : table) makeempty*;
PROCEDURE posttrav ( VAR n: nodepointer (* in *) );
VAR item1 : Object;
BEGIN
IF n # NIL
THEN
posttrav( n^.left );
posttrav( n^.right );
item1 := n^.info;
n^.info := NIL;
Dispose(item1);
freenode( n );
END (* if then *);
END posttrav;
BEGIN (* makeempty *)
ok := FALSE;
IF ( t # NIL )
THEN
posttrav( t.root );
t.root := NIL;
ok := TRUE;
END (* if then *);
END makeempty;
PROCEDURE InitStream(VAR s: Stream);
BEGIN
s.tab[0]:="";
s.end:=1;
END InitStream;
PROCEDURE ( t : table) save* (fn: ARRAY OF CHAR (* in *) );
(* Generic save routine. Stores type information for persistent
objects
*)
VAR alright : BOOLEAN;
s : Stream;
ores : SF.OpenResults;
PROCEDURE visitsave( p: nodepointer );
VAR ok : BOOLEAN;
BEGIN (* visitsave *)
IF p # NIL THEN
visitsave( p^.left );
WriteObj(s,p.info,ok);
IF ~ ok THEN
error( writeerror );
END; (* IF *)
visitsave( p^.right );
END (* if *);
END visitsave;
BEGIN (* save *)
InitStream(s);
ok := FALSE;
IF ( t # NIL )
THEN
IF ~ t.empty() THEN
SF.OpenWrite(s.file, fn, SF.raw, ores );
IF ores = SF.opened THEN
visitsave( t^.root );
WriteObj(s,NIL,alright); (* eof *)
ok := TRUE;
SF.Close( s.file );
END; (* IF *)
END; (* IF *)
END; (* IF *)
END save;
PROCEDURE load* (VAR t : table; fn: ARRAY OF CHAR (* in *));
(* Generic load routine. Loads type information for persistent
objects and generates an object pointer of the
associated dynamic type
*)
VAR r : BOOLEAN;
new : Object;
s : Stream;
ores: SF.OpenResults;
BEGIN (* load *)
InitStream(s);
ok := FALSE;
IF ( t # NIL ) THEN
t.makeempty;
SF.OpenRead( s.file, fn, SF.raw, ores );
IF ores = SF.opened THEN
LOOP
ReadObj(s,new,r);
IF new = NIL THEN
EXIT;
ELSIF r THEN
t.insert( new );
ELSE
error( readerror );
END; (* IF *)
END;
SF.Close( s.file );
ok := TRUE;
ELSE
error( readerror );
END (* IF *);
END; (* IF *)
END load;
PROCEDURE loadmerge* (VAR t : table (* in/out *);
fn: ARRAY OF CHAR (* in *) );
VAR r : BOOLEAN;
new : Object;
s : Stream;
ores: SF.OpenResults;
BEGIN (* loadmerge *)
InitStream(s);
ok := FALSE;
IF t # NIL THEN
SF.OpenRead( s.file, fn, SF.raw, ores);
IF ores = SF.opened THEN
LOOP
ReadObj(s,new,r);
IF new = NIL THEN
EXIT;
ELSIF r THEN
t.insert( new );
ELSE
error( readerror );
END; (* IF *)
END;
SF.Close( s.file );
ok := TRUE;
ELSE
error( readerror );
END (* IF *);
END; (* IF *)
END loadmerge;
BEGIN
ok := TRUE;
END OAVL_ISO.
MODULE USE_OAVL_ISO_1;
IMPORT OAVL_ISO, SRealIO;
CONST max=1000;
datafile="x.dat";
TYPE
Object = POINTER TO ObjectDesc;
ObjectDesc = RECORD (OAVL_ISO.ObjectDesc)
pu: REAL;
END;
VAR myobj, out: Object;
mytype: OAVL_ISO.Type;
tab: OAVL_ISO.table;
i: INTEGER;
PROCEDURE PrintOutRec(VAR obj: OAVL_ISO.Object);
BEGIN
WITH obj : Object DO
SRealIO.WriteReal(obj^.pu, 13);
ELSE HALT(20);
END;
END PrintOutRec;
PROCEDURE (obj1 : Object) equal* (obj2 : OAVL_ISO.Object) : BOOLEAN;
BEGIN
WITH obj2 : Object DO
RETURN obj1^.pu = obj2^.pu;
END;
END equal;
PROCEDURE (obj1 : Object) order (obj2 : OAVL_ISO.Object) : BOOLEAN;
BEGIN
WITH obj2 : Object DO
RETURN obj1^.pu < obj2^.pu;
END;
END order;
BEGIN
NEW(myobj);
mytype := OAVL_ISO.TypeOf(myobj);
OAVL_ISO.Dispose(myobj);
OAVL_ISO.define(tab, mytype);
FOR i:=max TO 0 BY -1 DO
NEW(out);
out^.pu:=i;
tab.insert(out);
END;
tab.visit(PrintOutRec);
tab.save(datafile);
OAVL_ISO.load(tab,datafile);
IF tab.type() = mytype THEN
tab.visit(PrintOutRec);
ELSE HALT(20);
END;
tab.makeempty;
END USE_OAVL_ISO_1.
DEFINITION MODULE table;
(*
This module defines the public interface to the generic
search table. The type ADDRESS is used as a parameter
to permit generic elements to be stored in the search
table. Strong type checking is lost for those
parameters of type ADDRESS. *)
FROM SYSTEM IMPORT
(* type *) ADDRESS, BYTE;
VAR ok : BOOLEAN;
(* This variable is set after each operation. A value
of true indicates that the last operation was
successful. A value of false indicates that the
last operation was unsuccessful and that the user
defined error handler was called. This variable is
also set to false if define was not called prior to
any other operation. In this case, the user defined
error handler is not called. *)
TYPE
table;
TYPE tableerror = ( deletionerror, insertionerror,
readerror, writeerror );
(* This enumeration type defines the error conditions that
are checked for in the implementation.
Error Raised By Reason For Error
-------------------------------------------------------
insertionerror insert Attempt to insert an
item that already
exists in the table.
deletionerror delete Attempt to delete an
item that is not in
the table.
readerror load, Error while reading an
loadmerge item.
writeerror save Error while saving an
item.
*)
TYPE errorhandler = PROCEDURE( tableerror );
(*
The user is required to write an error handler
procedure to handle the errors of type tabletype that
can occur during execution. A sample error handler is
given by the procedure error below, which is also exported.
PROCEDURE error
( err: tableerror (* in *) );
BEGIN
CASE err OF
insertionerror:
WriteString( "Illegal insert operation. " );
WriteString( "The item already exists in table." );
WriteLn; |
deletionerror:
WriteString( "Illegal delete operation. " );
WriteString( "The item is not in the table." );
WriteLn; |
readerror:
WriteString( "Error while opening or reading the file." );
WriteLn; |
writeerror:
WriteString( "Error while saving the table " );
WriteString( "into the file." );
WriteLn;
END (* case *)
END error;
*)
TYPE ordertype = PROCEDURE( ADDRESS, ADDRESS ):
BOOLEAN;
(* The user is required to write two procedures of type
ordertype. One procedure defines equality for two
items in the search table, the other procedure defines
an order relation for the items in the search table.
These procedures must be compatible.
*)
TYPE visittype = PROCEDURE( VAR ADDRESS );
(* The user is required to write a procedure of type
visittype that defines the processing of each item
in the search table when the the search table node
item containing the item is visited. For example,
the item could be printed. *)
PROCEDURE error
( err: tableerror (* in *) );
(*
Standard-Errorhandler, vgl. oben.
*)
PROCEDURE define
( VAR t : table (* in/out *);
error : errorhandler (* in *);
equal : ordertype (* in *);
order : ordertype (* in *);
item : ARRAY OF BYTE (* in *) );
(*
Creates an empty search table and binds to the table
variable the user defined procedures for handling
errors, defining equality of two items in the table
and defining the order relation for the items in the
table. The sample item is used to determine the size
of the elements that will be in the search table.
This procedure must be called for each new table prior
to any other search table operations.
Input Parameters
----------------
t - A search table variable.
error - The name of a user defined error handler
procedure.
equal - The name of a user defined equal procedure
that defines equality for two items in the
search table.
order - The name of a user defined order procedure
that defines an order relation for the items
in the search table.
item - Sample element that will be in the search
table. All elements in the search table must
be of the same size.
Output Parameters
-----------------
t - The search table variable initialized to the
empty search table with the user defined
error handler, equal and order procedures
bound to the search table variable.
*)
PROCEDURE empty
( VAR t : table (* in *) ) :
BOOLEAN;
(*
Returns true if the table does not contain any entries.
Input Parameters
----------------
t - A search table variable.
Returns
-------
True - If the search table is empty.
False - If the search table is not empty.
*)
PROCEDURE delete
( VAR t : table (* in/out *);
item : ADDRESS (* in *) );
(*
Removes the item from table t, if it is present.
If item is not present, a delete error is raised.
Input Parameters
----------------
t - A search table variable.
item - The ADDRESS of the search table item that is
to be deleted from the search table.
Output Parameters
-----------------
t - The search table with item deleted.
Error Conditions
----------------
ok = False --> The delete was unsuccessful. The
search table did not contain the
item so the user defined error
handler was called with tableerror =
deletionerror.
*)
PROCEDURE insert
( VAR t : table (* in/out *);
item : ADDRESS (* in *) );
(*
Inserts the item into table t if it is not present.
If the item is already present in the table, an
insertion error is raised.
Input Parameters
----------------
t - A search table variable.
item - The ADDRESS of the item that is to be inserted
into the search table.
Output Parameters
-----------------
t - The search table with item inserted.
Error Conditions
----------------
ok = False --> The insert was unsuccessful. The
search table already contained the
item so the user defined error
handler was called with tableerror =
insertionerror.
*)
PROCEDURE visit
( VAR t : table (* in *);
visitproc : visittype (* in *) );
(*
Visits each node of the search table exactly once.
The action taken during each visit is dependent on the
user's visit procedure. Most often a user may wish
to display a portion of the item stored in the table
node that is visited. The user may wish to use
several different visit procedures.
Input Parameters
----------------
t - A search table variable.
visitproc - A user defined procedure that specifies
the operations to be performed on each
item in the search table as each node of
the search table is visited.
Error Conditions
----------------
ok = False --> The search table is empty so no
processing took place. The user
defined error handler is not
called in this case.
*)
PROCEDURE visitelement
( VAR t : table (* in *);
item : ADDRESS (* in *);
visitproc: visittype (* in *) );
(*
Takes the action specified by visitproc on the item
specified by item
Input Parameters
----------------
t - A search table variable.
visitproc - A user defined procedure that specifies
the operations to be performed on the
item in the search table specified by item.
item - The ADDRESS of the item to be processed in
the search table.
Error Conditions
----------------
ok = False --> The item specified is not in the table
so no processing took place. The user
defined error handler is not called in
this case.
*)
PROCEDURE ispresent
( VAR t : table (* in *);
item : ADDRESS (* in *) ):
BOOLEAN;
(*
Returns true if item is present in table otherwise
false.
Input Parameters
----------------
t - A search table variable.
item - The ADDRESS of the item to be checked for in
the search table.
Returns
-------
True - The item is present in the search table.
False - The item is not present in the search table.
*)
PROCEDURE makeempty
( VAR t : table (* in/out *) );
(*
This procedure deletes all the storage associated
with table t. The table t is left in the same
state as if it had just been defined.
Input Parameters
----------------
t - A search table variable.
Output Parameters
-----------------
t - The search table variable reinitialized to
empty search table.
*)
PROCEDURE save
( VAR t : table (* in *);
fn: ARRAY OF CHAR (* in *) );
(*
Speichert den Inhalt der Tabelle t im File mit dem Namen
fn ab. Kann mit load oder loadmerge wieder in die Tabelle
eingelesen werden.
t muss als Variable deklariert werden, da ADR auf t ange-
wendet wird. *)
PROCEDURE load
( VAR t : table (* in/out *);
fn: ARRAY OF CHAR (* in *) );
(*
Löscht den Inhalt der Tabelle t und lädt den Inhalt des
Files mit dem Namen fn in die Tabelle t. *)
PROCEDURE loadmerge
( VAR t : table (* in/out *);
fn: ARRAY OF CHAR (* in *) );
(*
Fügt den Inhalt des Files mit dem Namen fn der Tabelle t
bei, ohne den schon vorhandenen Inhalt zu löschen. *)
END table.
Zuerst veröffentlicht in leicht modifierter Form in "Software-Entwicklung" x/1995, AWi-Verlag, D-85630 Grasbrunn
[ Home |
Site_index |
Legal |
OpenVMS_compiler |
Alpha_Oberon_System |
ModulaTor |
Bibliography |
Oberon[-2]_links |
Modula-2_links |
General interesting book recommendations ]