vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 19:12:25 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

ulmAssertions, ulmIndirectDisciplines

Browse source
This commit is contained in:
Norayr Chilingarian 2013-10-22 16:37:44 +04:00
parent e05e466d38
commit 26711501d0
2 changed files with 243 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

121
src/lib/ulm/ulmAssertions.Mod Normal file
View file

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

122
src/lib/ulm/ulmIndirectDisciplines.Mod Normal file
View file

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