ModulaTor logo, 7.8KB

The ModulaTor

Oberon-2 and Modula-2 Technical Publication

Ubaye's First Independent Modula-2 & Oberon-2 Journal! Nr. PF, Sep-1993


Von Modula-2 nach Oberon-2

oder

Wie Objekte ein Programm überleben können

oder

Ein Traktat über Objekte, Erweiterungen und Persistenz

Copyright (1994-1998) Petra Fabian, Günter Dotzel, ModulaWare

3rd. ed. 10-Nov-1994.

Inhalt

0. Einleitung
2. Kennenlernen der objektorientierten Denkweise
3. Sprachstandardisierung und verfügbare Compiler
4. Zusammenfassung
5. Literaturverzeichnis
Anhang 1.
Anhang 2.

0. Einleitung

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.

1.1 Modula-2

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.

1.2 Oberon-2

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.

Wesentliche Merkmale von Oberon-2:

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.

Kurze Einführung in Oberon-2:

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.

1.3 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.

Laufzeittypprüfungen:

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.

2.Kennenlernen der objektorientierten Denkweise

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.

2.1 Datenkapselung, Datenabstraktion und Vererbung

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.

2.2 Generische Bausteine

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.

2.3 Heterogene Datenstrukturen

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.

2.4 Umschreiben eines AVL - Baum-Verwalters von Modula-2 nach Oberon-2

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.

2.4.1 Modula-2 Realisierung

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.

2.4.2 Oberon-2 Alternative

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.

2.5 Persistente Objekte

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].

2.6 Andere Realisierungsmöglichkeit des Problems aus 2.3

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.

3. Sprachstandardisierung und verfügbare Compiler

3.1. ISO Modula-2

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.

3.2. Oberon-2

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.

4. Zusammenfassung

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.

5. Literaturverzeichnis

[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).

Anhang 1.

Schnittstelle des Moduls Objects_Types



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.ADDRESS_64; 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.

Anhang 2.

A2.1. Oberon-2 AVL-Baumverwalter OAVL_ISO



MODULE CTR;
(* central definition of 64 bit INTEGER and CARDINAL: ctr.mod64 *)
IMPORT SYSTEM;

TYPE 
  INTEGER * = SYSTEM.SIGNED_64; (* 64 Bit signed whole number type *)
  CARDINAL* = SYSTEM.SIGNED_64;
  ADDRESS * = SYSTEM.SIGNED_64;

(* select your enumeration types carefully: *)
  ENUM8 * = SYSTEM.SIGNED_8;  (* ORD(MAX(corresponding_Modula_2_enum) < 256 *)
  ENUM16* = SYSTEM.SIGNED_16; (* ORD(MAX(corresponding_Modula_2_enum) < 65536 *)
  ENUM32* = SYSTEM.SIGNED_32; (* ORD(MAX(corresponding_Modula_2_enum) < 2^31 *)

(* WORD and QUADWORD are extension of the Oberon-2 module SYSTEM.
   Sorry, there was no other way! *)

  WORD* = SYSTEM.WORD; (* 32 Bit *)
  (* WORD is used in ConvType only (no recursive procedure definitions) *)

  QUADWORD* = SYSTEM.QUADWORD; (* 64 Bit *)
  (* QUADWORD is used in RndFile only (no structured function values) *)

END CTR.

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.

A2.2. Oberon-2 Anwendungsbeispiel zu 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.

A2.3. Modula-2 AVL-Baumverwalter-Schnittstelle Table



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 ]
Webdesign by www.otolo.com/webworx, 21-Nov-1998, last revised 13-Jan-2016 (module CTR added). © (1998-2016) ModulAware.com