ulmAssertions, ulmIndirectDisciplines

Former-commit-id: 26711501d0

src/lib/ulm/ulmAssertions.Mod

@@ -0,0 +1,121 @@
+(* Ulm's Oberon Library
+   Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+   ----------------------------------------------------------------------------
+   Ulm's Oberon Library is free software; you can redistribute it
+   and/or modify it under the terms of the GNU Library General Public
+   License as published by the Free Software Foundation; either version
+   2 of the License, or (at your option) any later version.
+
+   Ulm's Oberon Library is distributed in the hope that it will be
+   useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+   of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Library General Public License for more details.
+
+   You should have received a copy of the GNU Library General Public
+   License along with this library; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+   ----------------------------------------------------------------------------
+   E-mail contact: oberon@mathematik.uni-ulm.de
+   ----------------------------------------------------------------------------
+   $Id: Assertions.om,v 1.2 1996/01/04 16:50:59 borchert Exp $
+   ----------------------------------------------------------------------------
+   $Log: Assertions.om,v $
+   Revision 1.2  1996/01/04  16:50:59  borchert
+   some fixes because event types are now an extension of Services.Object
+
+   Revision 1.1  1994/02/22  20:06:01  borchert
+   Initial revision
+
+   ----------------------------------------------------------------------------
+   AFB 11/91
+   ----------------------------------------------------------------------------
+*)
+
+MODULE ulmAssertions;
+
+   (* general error handling of library routines *)
+
+   IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, IO := ulmIO, Priorities := ulmPriorities, RelatedEvents := ulmRelatedEvents, Services := ulmServices;
+
+   TYPE
+      Object = Disciplines.Object;
+      Identifier* = ARRAY 32 OF CHAR; (* should be sufficient *)
+      Event* = POINTER TO EventRec;
+      EventRec* =
+	 RECORD
+	    (Events.EventRec)
+	    object*: Object;      (* may be NIL *)
+	    module*: Identifier;
+	    proc*: Identifier;
+	 END;
+      EventType = POINTER TO EventTypeRec;
+      EventTypeRec* =
+	 RECORD
+	    (Events.EventTypeRec)
+	    (* private components *)
+	    module: Identifier;
+	 END;
+
+   VAR
+      failedAssertion*: Events.EventType;
+      eventTypeType: Services.Type;
+
+   PROCEDURE Define*(VAR type: Events.EventType; module: ARRAY OF CHAR);
+      (* create a new event type which will be of type Assertions.EventType *)
+      VAR
+	 newtype: EventType;
+   BEGIN
+      NEW(newtype);
+      Services.Init(newtype, eventTypeType);
+      Events.Init(newtype);
+      Events.SetPriority(newtype, Priorities.assertions);
+      COPY(module, newtype.module);
+      type := newtype;
+   END Define;
+
+   PROCEDURE Raise*(object: RelatedEvents.Object;
+		   type: Events.EventType;
+		   proc: ARRAY OF CHAR;
+		   text: ARRAY OF CHAR);
+      (* raise Assertions.failedAssertion;
+	 create a event of the given type and pass it
+	 to RelatedEvents.Raise (if object # NIL)
+	 or Events.Raise (if object = NIL);
+      *)
+      VAR
+	 event: Event;
+
+      PROCEDURE CreateEvent(VAR event: Event; etype: Events.EventType);
+      BEGIN
+	 NEW(event);
+	 event.type := etype;
+	 COPY(text, event.message);
+	 event.object := object;
+	 IF type IS EventType THEN
+	    COPY(type(EventType).module, event.module);
+	 ELSE
+	    event.module[0] := 0X;
+	 END;
+	 COPY(proc, event.proc);
+      END CreateEvent;
+
+   BEGIN
+      IO.WriteString("assertion failed: ");
+      IO.WriteString(text); IO.WriteString(" in procedure ");
+      IO.WriteString(proc); IO.WriteLn;
+      CreateEvent(event, failedAssertion); Events.Raise(event);
+      CreateEvent(event, type);
+      IF object = NIL THEN
+	 Events.Raise(event);
+      ELSE
+	 RelatedEvents.Raise(object, event);
+      END;
+   END Raise;
+
+BEGIN
+   Events.Define(failedAssertion);
+   Events.SetPriority(failedAssertion, Priorities.assertions);
+   Events.Ignore(failedAssertion);
+   Services.CreateType(eventTypeType,
+      "Assertions.EventType", "Events.EventType");
+END ulmAssertions.

src/lib/ulm/ulmIndirectDisciplines.Mod

@@ -0,0 +1,122 @@
+(* Ulm's Oberon Library
+   Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+   ----------------------------------------------------------------------------
+   Ulm's Oberon Library is free software; you can redistribute it
+   and/or modify it under the terms of the GNU Library General Public
+   License as published by the Free Software Foundation; either version
+   2 of the License, or (at your option) any later version.
+
+   Ulm's Oberon Library is distributed in the hope that it will be
+   useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+   of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Library General Public License for more details.
+
+   You should have received a copy of the GNU Library General Public
+   License along with this library; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+   ----------------------------------------------------------------------------
+   E-mail contact: oberon@mathematik.uni-ulm.de
+   ----------------------------------------------------------------------------
+   $Id: IndirectDis.om,v 1.2 1995/03/17 13:56:51 borchert Exp $
+   ----------------------------------------------------------------------------
+   $Log: IndirectDis.om,v $
+   Revision 1.2  1995/03/17  13:56:51  borchert
+   support of Forwarders added
+
+   Revision 1.1  1994/06/27  09:50:43  borchert
+   Initial revision
+
+   ----------------------------------------------------------------------------
+*)
+
+MODULE ulmIndirectDisciplines;
+
+   IMPORT Disciplines := ulmDisciplines, Forwarders := ulmForwarders;
+
+   TYPE
+      Object* = Disciplines.Object;
+      ObjectRec* = Disciplines.ObjectRec;
+      Discipline* = Disciplines.Discipline;
+      DisciplineRec* = Disciplines.DisciplineRec;
+      Identifier* = Disciplines.Identifier;
+
+   TYPE
+      IndDiscipline = POINTER TO IndDisciplineRec;
+      IndDisciplineRec =
+	 RECORD
+	    (DisciplineRec)
+	    forwardTo: Object;
+	 END;
+   VAR
+      discID: Identifier;
+
+   PROCEDURE Forward*(from, to: Object);
+      VAR
+	 disc: IndDiscipline;
+   BEGIN
+      IF to = NIL THEN
+	 Disciplines.Remove(from, discID);
+      ELSE
+	 NEW(disc); disc.id := discID;
+	 disc.forwardTo := to;
+	 Disciplines.Add(from, disc);
+      END;
+   END Forward;
+
+   PROCEDURE InternalForward(from, to: Forwarders.Object);
+   BEGIN
+      Forward(from, to);
+   END InternalForward;
+
+   PROCEDURE Add*(object: Object; discipline: Discipline);
+      VAR
+	 disc: IndDiscipline;
+   BEGIN
+      WHILE Disciplines.Seek(object, discID, disc) DO
+	 object := disc.forwardTo;
+      END;
+      Disciplines.Add(object, discipline);
+   END Add;
+
+   PROCEDURE Remove*(object: Object; id: Identifier);
+      VAR
+	 dummy: Discipline;
+	 disc: IndDiscipline;
+   BEGIN
+      LOOP
+	 IF Disciplines.Seek(object, id, dummy) THEN
+	    Disciplines.Remove(object, id);
+	    EXIT
+	 END;
+	 IF ~Disciplines.Seek(object, discID, disc) THEN
+	    EXIT
+	 END;
+	 object := disc.forwardTo;
+      END;
+   END Remove;
+
+   PROCEDURE Seek*(object: Object; id: Identifier;
+		  VAR discipline: Discipline) : BOOLEAN;
+      VAR
+	 disc: IndDiscipline;
+   BEGIN
+      LOOP
+	 IF Disciplines.Seek(object, id, discipline) THEN
+	    RETURN TRUE
+	 END;
+	 IF ~Disciplines.Seek(object, discID, disc) THEN
+	    RETURN FALSE
+	 END;
+	 object := disc.forwardTo;
+      END;
+   END Seek;
+
+   PROCEDURE Unique*() : Identifier;
+   BEGIN
+      RETURN Disciplines.Unique()
+   END Unique;
+
+BEGIN
+   discID := Disciplines.Unique();
+   Forwarders.Register("", InternalForward);
+END ulmIndirectDisciplines.