Oberon/A2/Oberon.Objects.Mod

(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich. Refer to the "General ETH Oberon System Source License" contract available at : http : //www.oberon.ethz.ch/ *) MODULE Objects IN Oberon;	(** portable *) (* JG 21.9.93/comments jm 28.2.95 *) (** Module Objects forms the basis of the object-oriented part of the Oberon system. It provides the system with the type Object and defines what messages objects understand. Most entities in Oberon are derived from this base type. &#42;) &#160;&#160;IMPORT SYSTEM, Kernel, Files, Modules; &#160;&#160;CONST &#160;&#160;&#160;&#160;enum* &#61; 0; get* &#61; 1; set* &#61; 2; (** AttrMsg and LinkMsg id *) &#160;&#160;&#160;&#160;shallow* &#61; 0; deep* &#61; 1; (** CopyMsg id *) &#160;&#160;&#160;&#160;load* &#61; 0; store* &#61; 1; (** FileMsg id*) &#160;&#160;&#160;&#160;(** AttrMsg class *) &#160;&#160;&#160;&#160;Inval* &#61; 0; String* &#61; 2; Int* &#61; 3; Real* &#61; 4; LongReal* &#61; 5; Char* &#61; 6; Bool* &#61; 7; &#160;&#160;&#160;&#160;MaxNews &#61; 64; MaxRuns &#61; 64; &#9;StepSize &#61; 64; 	(* number of elems to grow an index block *) &#9;Version &#61; 052454942H; &#160;&#160;TYPE &#160;&#160;&#160;&#160;Name* &#61; ARRAY 256 OF CHAR; &#160;&#160;&#160;&#160;Object* &#61; POINTER TO ObjDesc; &#160;&#160;&#160;&#160;Dummy* &#61; POINTER TO DummyDesc; &#160;&#160;&#160;&#160;Library* &#61; POINTER TO LibDesc; &#160;&#160;&#160;&#160;ObjMsg* &#61; RECORD	(** Base type of all messages sent to objects. *) &#160;&#160;&#160;&#160;&#160;&#160;stamp* : LONGINT;	(** Message time stamp. *) &#160;&#160;&#160;&#160;&#160;&#160;dlink* : Object	(** Sender of the message. *) &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;Handler* &#61; PROCEDURE (obj : Object; VAR M : ObjMsg); &#160;&#160;&#160;&#160;ObjDesc* &#61; RECORD	(** Base type of all objects. *)	(* Note : SIZE used in Fonts.GetCharObj *) &#160;&#160;&#160;&#160;&#160;&#160;stamp* : LONGINT;	(** Time stamp of last message processed by object. *) &#160;&#160;&#160;&#160;&#160;&#160;dlink*,	(** Next object in the message thread. *) &#160;&#160;&#160;&#160;&#160;&#160;slink* : Object;	(** Next object in a list of objects. *) &#160;&#160;&#160;&#160;&#160;&#160;lib* : Library; ref* : INTEGER;	(** Library and reference number of object. *) &#160;&#160;&#160;&#160;&#160;&#160;handle* : Handler	(** Message handler. *) &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;(** Set, get and enumerate the attributes of an object. *) &#9;AttrMsg* &#61; RECORD (ObjMsg) &#9;&#9;id* : INTEGER;	(** get, set or enum. *) &#9;&#9;Enum* : PROCEDURE (CONST name : ARRAY OF CHAR);	(** Called by object to enumerate attribute names. *) &#9;&#9;name* : Name;	(** Name of the attribute to be set or retrieved. *) &#9;&#9;res* : INTEGER;	(** Return result : &#60; 0 &#61; no response, &#62;&#61; 0 action completed. *) &#9;&#9;class* : INTEGER;	(** Attribute class (Inval, String, Int, Real, LongReal, Char or Bool). *) &#9;&#9;i* : LONGINT; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;x* : REAL; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;y* : LONGREAL; &#9;&#9;c* : CHAR; &#9;&#9;b* : BOOLEAN; &#9;&#9;s* : ARRAY 256 OF CHAR &#9;END; &#9;(** Link objects with each other or retrieve the link structure between objects *) &#9;LinkMsg* &#61; RECORD (ObjMsg) &#9;&#9;id* : INTEGER;	(** get, set or enum. *) &#9;&#9;Enum* : PROCEDURE (CONST name : ARRAY OF CHAR);	(** Called by object to enumerate link names. *) &#9;&#9;name* : Name;	(** Link name. *) &#9;&#9;res* : INTEGER;	(** Return result : &#60; 0 &#61; no response, &#62;&#61; 0 action completed. *) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;obj* : Object	(** Value of the link to be set, or link result. *) &#9;END; &#9;(** Request to an object to make a copy of itself *) &#160;&#160;&#160;&#160;CopyMsg* &#61; RECORD (ObjMsg) &#160;&#160;&#160;&#160;&#160;&#160;id* : INTEGER;	(** Copy style : deep or shallow. *) &#160;&#160;&#160;&#160;&#160;&#160;obj* : Object	(** Result of the copy operation. *) &#160;&#160;&#160;&#160;END; &#9;(** Request to an object to bind itself to a library. *) &#160;&#160;&#160;&#160;BindMsg* &#61; RECORD (ObjMsg) &#160;&#160;&#160;&#160;&#160;&#160;lib* : Library	(** Library where object should be bound. *) &#160;&#160;&#160;&#160;END; &#9;(** Request to an object to load/store itself. *) &#160;&#160;&#160;&#160;FileMsg* &#61; RECORD (ObjMsg) &#160;&#160;&#160;&#160;&#160;&#160;id* : INTEGER;	(** load or store *) &#160;&#160;&#160;&#160;&#160;&#160;len* : LONGINT;	(** Length of the object data on loading. *) &#160;&#160;&#160;&#160;&#160;&#160;R* : Files.Rider	(** Rider with which to load or store data. *) &#160;&#160;&#160;&#160;END; &#9;(** Search request for an object with the specified name. *) &#160;&#160;&#160;&#160;FindMsg* &#61; RECORD (ObjMsg) &#160;&#160;&#160;&#160;&#160;&#160;name* : Name; &#160;&#160;&#160;&#160;&#160;&#160;obj* : Object	(** Result object, if found. *) &#160;&#160;&#160;&#160;END; &#9;(** A placeholder object created for objects that cannot be loaded. *) &#9;DummyDesc* &#61; RECORD (ObjDesc) &#9;&#9;GName* : Name;	(** Generator procedure of failed object. *) &#9;&#9;len : LONGINT;	(* length of data block *) &#9;&#9;blk : POINTER TO ARRAY OF CHAR	(* stores the data on file *) &#160;&#160;&#160;&#160;END; &#9;(** (Hidden) Data structure containing the objects of a library. *) &#160;&#160;&#160;&#160;Index* &#61; POINTER TO IndexDesc; &#160;&#160;&#160;&#160;IndexDesc* &#61; RECORD END; &#9;(** (Hidden) Map of (ref) numbers and corresponding object names. *) &#9;Dictionary* &#61; POINTER TO DictionaryDesc; &#9;DictionaryDesc* &#61; RECORD END; &#160;&#160;&#160;&#160;Block &#61; POINTER TO ARRAY OF Object; &#9;ArrayIndex &#61; POINTER TO ArrayIndexDesc; &#9;ArrayIndexDesc &#61; RECORD (IndexDesc) &#9;&#9;index : Block;	(* index block, containing the objects *) &#9;&#9;org : LONGINT;	(* offset in libfile where index block starts *) &#9;&#9;size : INTEGER	(* size of the actual index block *) &#9;END; &#160;&#160;&#160;&#160;Entry &#61; POINTER TO EntryDesc; &#160;&#160;&#160;&#160;EntryDesc &#61; RECORD &#160;&#160;&#160;&#160;&#160;&#160;next : Entry; &#160;&#160;&#160;&#160;&#160;&#160;key : INTEGER; &#160;&#160;&#160;&#160;&#160;&#160;name : Name &#160;&#160;&#160;&#160;END; &#9;ListDict &#61; POINTER TO ListDictDesc; &#9;ListDictDesc &#61; RECORD (DictionaryDesc) &#9;&#9;key : INTEGER; &#9;&#9;first : Entry &#9;END; &#9;GenName &#61; ARRAY 256 OF CHAR; &#160;&#160;&#160;&#160;LibDesc* &#61; RECORD	(** Container for persistent objects. *) &#160;&#160;&#160;&#160;&#160;&#160;next&#123;UNTRACED&#125; : Library; (* offset used by Fonts.GetCharObj, also next offset *) &#160;&#160;&#160;&#160;&#160;&#160;ind* : Index;	(** Library contents. *) &#160;&#160;&#160;&#160;&#160;&#160;f : Files.File;	(* file containing data *) &#160;&#160;&#160;&#160;&#160;&#160;R : Files.Rider;	(* a rider on the lib file *) &#160;&#160;&#160;&#160;&#160;&#160;name* : Name;	(** name of the library. Private library when "", else public library. *) &#160;&#160;&#160;&#160;&#160;&#160;dict* : Dictionary;	(** Object names. *) &#160;&#160;&#160;&#160;&#160;&#160;maxref* : INTEGER;	(** Highest ref number used in library. *) &#160;&#160;&#160;&#160;&#160;&#160;GName : POINTER TO ARRAY OF GenName; &#160;&#160;&#160;&#160;&#160;&#160;(** Return a free reference number. *) &#160;&#160;&#160;&#160;&#160;&#160;GenRef* : PROCEDURE (L : Library; VAR ref : INTEGER); &#160;&#160;&#160;&#160;&#160;&#160;(** Return the object with the indicated reference number. *) &#160;&#160;&#160;&#160;&#160;&#160;GetObj* : PROCEDURE (L : Library; ref : INTEGER; VAR obj : Object); &#160;&#160;&#160;&#160;&#160;&#160;(** Insert an object under the indicated reference number. *) &#160;&#160;&#160;&#160;&#160;&#160;PutObj* : PROCEDURE (L : Library; ref : INTEGER; obj : Object); &#160;&#160;&#160;&#160;&#160;&#160;(** Free object with indicated reference number. *) &#160;&#160;&#160;&#160;&#160;&#160;FreeObj* : PROCEDURE (L : Library; ref : INTEGER); &#160;&#160;&#160;&#160;&#160;&#160;(** Initialize/load library with L.name. *) &#160;&#160;&#160;&#160;&#160;&#160;Load* : PROCEDURE (L : Library); &#160;&#160;&#160;&#160;&#160;&#160;(** Store library under L.name. *) &#160;&#160;&#160;&#160;&#160;&#160;Store* : PROCEDURE (L : Library) &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;NewProc* &#61; PROCEDURE : Library;	(** Library generator. *) &#160;&#160;&#160;&#160;EnumProc* &#61; PROCEDURE (L : Library);	(** Enumerator of public libraries *) &#9;RunRec &#61; RECORD beg, end : INTEGER END; &#9;Alias &#61; POINTER TO AliasDesc; &#9;AliasDesc &#61; RECORD &#9;&#9;next : Alias; &#9;&#9;name : Name; &#9;&#9;lib&#123;UNTRACED&#125; : Library &#9;END; &#160;&#160;VAR &#160;&#160;&#160;&#160;LibBlockId* : CHAR;	(** Identification character as first character of a Library file. *) &#160;&#160;&#160;&#160;FirstLib : Library; &#9;NoObj : Object; &#160;&#160;&#160;&#160;NewObj* : Object;	(** Newly generated objects are returned here. *) &#160;&#160;&#160;&#160;stamp : LONGINT; &#160;&#160;&#160;&#160;nofreg : INTEGER; &#160;&#160;&#160;&#160;LibExt : ARRAY 8, 8 OF CHAR; &#160;&#160;&#160;&#160;LibNew : ARRAY 8 OF NewProc; &#160;&#160;&#160;&#160;FirstAlias : Alias; &#160;&#160;PROCEDURE Stamp* (VAR M : ObjMsg);	(** Timestamp a message. *) &#160;&#160;BEGIN M.stamp : &#61; stamp; &#160;&#160;&#160;&#160;IF stamp # MAX(LONGINT) THEN INC(stamp) ELSE stamp : &#61; MIN(LONGINT) END &#160;&#160;END Stamp; &#160;&#160;(*general library management*) &#9;(* Delete library L from the list, without changing L.next. *) &#9;PROCEDURE Cleanup(L : ANY); &#9;VAR p0, p : Library; a0, a : Alias; &#9;BEGIN &#9;&#9;WITH L : Library DO &#9;&#9;&#9;p0 : &#61; FirstLib; p : &#61; p0.next; &#9;&#9;&#9;WHILE (p # NIL) &#38; (p # L) DO p0 : &#61; p; p : &#61; p.next END; &#9;&#9;&#9;IF p &#61; L THEN (* found in list *) &#9;&#9;&#9;&#9;p0.next : &#61; p.next &#9;&#9;&#9;END; &#9;&#9;&#9;a0 : &#61; FirstAlias; a : &#61; a0.next; &#9;&#9;&#9;WHILE (a # NIL) &#38; (a.lib # L) DO a0 : &#61; a; a : &#61; a.next END; &#9;&#9;&#9;IF a # NIL THEN a0.next : &#61; a.next END &#9;&#9;END &#9;END Cleanup; (* Check if end of s matches ext. len returns length of ext. *) &#9;PROCEDURE Match(CONST s, ext : ARRAY OF CHAR; VAR len : LONGINT ) : BOOLEAN; &#9;VAR i, j : LONGINT ; &#9;BEGIN &#9;&#9;i : &#61; 0; WHILE ext&#91;i&#93; # 0X DO INC(i) END; len : &#61; i; &#9;&#9;j : &#61; 0; WHILE s&#91;j&#93; # 0X DO INC(j) END; &#9;&#9;REPEAT DEC(i); DEC(j) &#9;&#9;UNTIL (i &#60; 0) OR (j &#60; 0) OR (ext&#91;i&#93; # s&#91;j&#93;); &#9;&#9;RETURN i &#60; 0 &#9;END Match; (** Search, load and cache a public library. *) &#160;&#160;PROCEDURE ThisLibrary* (CONST name : ARRAY OF CHAR) : Library; &#160;&#160;&#160;&#160;VAR L : Library; len, n, n0, t : LONGINT; proc : NewProc; A : Alias; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;A : &#61; FirstAlias.next; &#160;&#160;&#160;&#160;WHILE (A # NIL) &#38; (name # A.name) DO A : &#61; A.next END; &#160;&#160;&#160;&#160;IF A # NIL THEN &#160;&#160;&#160;&#160;&#160;&#160;L : &#61; A.lib &#160;&#160;&#160;&#160;ELSE &#160;&#160;&#160;&#160;&#160;&#160;L : &#61; FirstLib.next; &#160;&#160;&#160;&#160;&#160;&#160;WHILE (L # NIL) &#38; (name # L.name) DO L : &#61; L.next END; &#160;&#160;&#160;&#160;&#160;&#160;IF L &#61; NIL THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;n : &#61; nofreg; n0 : &#61; 0; len : &#61; -1; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;WHILE n0 # nofreg DO	(* find longest matching extension *) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF Match(name, LibExt&#91;n0&#93;, t) &#38; (t &#62;&#61; len) THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;n : &#61; n0; len : &#61; t &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;INC(n0) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF n # nofreg THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;proc : &#61; LibNew&#91;n&#93;; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;L : &#61; proc; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;COPY(name, L.name); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;L.Load(L); Kernel.RegisterObject(L, Cleanup, FALSE); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;IF name &#61; L.name THEN &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;L.next : &#61; FirstLib.next; FirstLib.next : &#61; L &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;ELSE &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;NEW(A); COPY(name, A.name); A.lib : &#61; L; A.next : &#61; FirstAlias.next; FirstAlias.next : &#61; A; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;(*Kernel.WriteString("Alias : "); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;Kernel.WriteString(name); Kernel.WriteString(" -&#62; ");  Kernel.WriteString(L.name); &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; Kernel.WriteLn*) &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;&#160;&#160;&#160;RETURN L &#160;&#160;&#160;&#160;&#160;&#160;END &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;(* found existing library -- but in A2 it is possible that the file referenced in L has been finalized meanwhile (concurrent finalization of libraries and files !) *) &#160;&#160;&#160;&#160;L.f : &#61; Files.Old(L.name); &#160;&#160;&#160;&#160;IF L.f # NIL THEN Files.Set(L.R, L.f, Files.Pos(L.R)) END; &#160;&#160;&#160;&#160;RETURN L &#160;&#160;END ThisLibrary; (** Free library from public library cache *) &#160;&#160;PROCEDURE FreeLibrary* (CONST name : ARRAY OF CHAR); &#160;&#160;&#160;&#160;VAR L : Library; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;L : &#61; FirstLib.next; &#160;&#160;&#160;&#160;WHILE L # NIL DO &#160;&#160;&#160;&#160;&#160;&#160;IF name &#61; L.name THEN Cleanup(L) END; &#160;&#160;&#160;&#160;&#160;&#160;L : &#61; L.next &#160;&#160;&#160;&#160;END &#160;&#160;END FreeLibrary; (** Enumerate public libraries. Don&#39;t free libraries during enumeration! *) &#160;&#160;PROCEDURE Enumerate* (P : EnumProc); &#160;&#160;&#160;&#160;VAR L : Library; &#160;&#160;BEGIN &#160;&#160;&#160;&#160;L : &#61; FirstLib.next; &#160;&#160;&#160;&#160;WHILE L # NIL DO P(L); L : &#61; L.next END &#160;&#160;END Enumerate; (** Register a new library file extension and its associated generator procedure. *) &#160;&#160;PROCEDURE Register* (CONST ext : ARRAY OF CHAR; new : NewProc); &#160;&#160;&#160;&#160;VAR n, len : LONGINT; L : Library; &#160;&#160;BEGIN n : &#61; 0; &#160;&#160;&#160;&#160;WHILE (n # nofreg) &#38; (ext # LibExt&#91;n&#93;) DO INC(n) END; &#160;&#160;&#160;&#160;IF n # nofreg THEN LibNew&#91;n&#93; : &#61; new &#160;&#160;&#160;&#160;&#160;&#160;ELSE COPY(ext, LibExt&#91;nofreg&#93;); LibNew&#91;nofreg&#93; : &#61; new; INC(nofreg) &#160;&#160;&#160;&#160;END; &#160;&#160;&#160;&#160;(* free library entries that match *) &#160;&#160;&#160;&#160;L : &#61; FirstLib.next; &#160;&#160;&#160;&#160;WHILE L # NIL DO &#160;&#160;&#160;&#160;&#9;IF Match(L.name, ext, len) THEN Cleanup(L) END; &#160;&#160;&#160;&#160;&#9;L : &#61; L.next &#160;&#160;&#160;&#160;END &#160;&#160;END Register; &#160;&#160;(*standard libraries*) &#160;&#160;PROCEDURE ReadName (VAR R : Files.Rider; VAR name : ARRAY OF CHAR); &#160;&#160;&#160;&#160;VAR i : LONGINT; ch : CHAR; &#160;&#160;BEGIN i : &#61; 0; Files.Read(R, ch); &#160;&#160;&#160;&#160;WHILE (ch # ".") &#38; (ch # 0X) DO name&#91;i&#93; : &#61; ch; INC(i); Files.Read(R, ch) END; &#160;&#160;&#160;&#160;name&#91;i&#93; : &#61; "."; INC(i); Files.Read(R, ch); &#160;&#160;&#160;&#160;WHILE ch # 0X DO name&#91;i&#93; : &#61; ch; INC(i); Files.Read(R, ch) END; &#160;&#160;&#160;&#160;name&#91;i&#93; : &#61; 0X &#160;&#160;END ReadName; &#160;&#160;PROCEDURE SplitName (CONST name : ARRAY OF CHAR; VAR MName, PName : ARRAY OF CHAR); &#160;&#160;&#160;&#160;VAR i, j : LONGINT; &#160;&#160;BEGIN i : &#61; 0; &#160;&#160;&#160;&#160;WHILE name&#91;i&#93; # "." DO MName&#91;i&#93; : &#61; name&#91;i&#93;; INC(i) END; &#160;&#160;&#160;&#160;MName&#91;i&#93; : &#61; 0X; INC(i); j : &#61; 0; &#160;&#160;&#160;&#160;WHILE name&#91;i&#93; # 0X DO PName&#91;j&#93; : &#61; name&#91;i&#93;; INC(i); INC(j) END; &#160;&#160;&#160;&#160;PName&#91;j&#93; : &#61; 0X &#160;&#160;END SplitName; &#9;PROCEDURE HandleDummy (obj : Object; VAR M : ObjMsg); &#9;&#9;VAR dum : Dummy; &#9;BEGIN &#9;&#9;WITH obj : Dummy DO &#9;&#9;&#9;IF M IS AttrMsg THEN &#9;&#9;&#9;&#9;WITH M : AttrMsg DO &#9;&#9;&#9;&#9;&#9;IF (M.id &#61; get) &#38; (M.name &#61; "Gen") THEN COPY(obj.GName, M.s) END &#9;&#9;&#9;&#9;END &#9;&#9;&#9;ELSIF M IS CopyMsg THEN &#9;&#9;&#9;&#9;WITH M : CopyMsg DO &#9;&#9;&#9;&#9;&#9;IF M.stamp &#61; obj.stamp THEN M.obj : &#61; obj.dlink &#9;&#9;&#9;&#9;&#9;ELSE &#9;&#9;&#9;&#9;&#9;&#9;NEW(dum); obj.stamp : &#61; M.stamp; obj.dlink : &#61; dum; &#9;&#9;&#9;&#9;&#9;&#9;dum.handle : &#61; obj.handle; &#9;&#9;&#9;&#9;&#9;&#9;COPY(obj.GName, dum.GName); dum.len : &#61; obj.len; dum.blk : &#61; obj.blk; &#9;&#9;&#9;&#9;&#9;&#9;M.obj : &#61; dum &#9;&#9;&#9;&#9;&#9;END &#9;&#9;&#9;&#9;END &#9;&#9;&#9;ELSIF M IS FileMsg THEN &#9;&#9;&#9;&#9;WITH M : FileMsg DO &#9;&#9;&#9;&#9;&#9;IF M.id &#61; load THEN &#9;&#9;&#9;&#9;&#9;&#9;obj.len : &#61; M.len; NEW(obj.blk, obj.len); &#9;&#9;&#9;&#9;&#9;&#9;Files.ReadBytes(M.R, obj.blk^, obj.len) &#9;&#9;&#9;&#9;&#9;ELSIF M.id &#61; store THEN &#9;&#9;&#9;&#9;&#9;&#9;Files.WriteBytes(M.R, obj.blk^, obj.len) &#9;&#9;&#9;&#9;&#9;END &#9;&#9;&#9;&#9;END &#9;&#9;&#9;END &#9;&#9;END &#9;END HandleDummy; &#9;PROCEDURE NewDummy (CONST GName : ARRAY OF CHAR); &#9;&#9;VAR dum : Dummy; &#9;BEGIN &#9;&#9;NEW(dum); dum.handle : &#61; HandleDummy; &#9;&#9;COPY(GName, dum.GName); &#9;&#9;NewObj : &#61; dum &#9;END NewDummy; &#9;PROCEDURE GetObj (L : Library; ref : INTEGER; VAR obj : Object); &#9;&#9;VAR objOrg : LONGINT; ind : ArrayIndex; MName, PName : ARRAY 256 OF CHAR; n : INTEGER; nl : LONGINT; &#9;&#9;&#9;&#9;Mod : Modules.Module; Cmd : Modules.Command; M : FileMsg; &#9;BEGIN &#9;&#9;ind : &#61; L.ind(ArrayIndex); &#9;&#9;IF (ref &#60; 0) OR (ref &#62;&#61; ind.size) THEN obj : &#61; NIL; RETURN END; &#9;&#9;obj : &#61; ind.index&#91;ref&#93;; &#9;&#9;IF obj &#61; NIL THEN &#9;&#9;&#9;IF L.f # NIL THEN &#9;&#9;&#9;&#9;Files.Set(L.R, L.f, ind.org + LONG(ref)*4); &#9;&#9;&#9;&#9;Files.ReadLInt(L.R, objOrg); &#9;&#9;&#9;&#9;IF objOrg &#62; ind.org THEN &#9;&#9;&#9;&#9;&#9;NewObj : &#61; NIL; &#9;&#9;&#9;&#9;&#9;Files.Set(L.R, L.f, objOrg); &#9;&#9;&#9;&#9;&#9;Files.ReadInt(L.R, n); &#9;&#9;&#9;&#9;&#9;IF n &#60; 0 THEN nl : &#61; MAX(LONGINT) - n ELSE nl : &#61; n END; (* fof *) &#9;&#9;&#9;&#9;&#9;SplitName(L.GName&#91;nl&#93;, MName, PName); &#9;&#9;&#9;&#9;&#9;Mod : &#61; Modules.ThisMod(MName); &#9;&#9;&#9;&#9;&#9;IF Modules.res &#61; 0 THEN &#9;&#9;&#9;&#9;&#9;&#9;Cmd : &#61; Modules.ThisCommand(Mod, PName); &#9;&#9;&#9;&#9;&#9;&#9;IF Modules.res &#61; 0 THEN Cmd &#9;&#9;&#9;&#9;&#9;&#9;ELSE NewDummy(L.GName&#91;nl&#93;) &#9;&#9;&#9;&#9;&#9;&#9;END &#9;&#9;&#9;&#9;&#9;ELSE NewDummy(L.GName&#91;nl&#93;) &#9;&#9;&#9;&#9;&#9;END; &#9;&#9;&#9;&#9;&#9;obj : &#61; NewObj; &#9;&#9;&#9;&#9;&#9;IF obj # NIL THEN &#9;&#9;&#9;&#9;&#9;&#9;obj.lib : &#61; L; obj.ref : &#61; ref; &#9;&#9;&#9;&#9;&#9;&#9;ind.index&#91;ref&#93; : &#61; obj; &#9;&#9;&#9;&#9;&#9;&#9;(* read in data *) &#9;&#9;&#9;&#9;&#9;&#9;M.id : &#61; load; Stamp(M); &#9;&#9;&#9;&#9;&#9;&#9;Files.ReadLInt(L.R, M.len); &#9;&#9;&#9;&#9;&#9;&#9;Files.Set(M.R, L.f, Files.Pos(L.R)); &#9;&#9;&#9;&#9;&#9;&#9;IF M.len &#62; 0 THEN obj.handle(obj, M) END &#9;&#9;&#9;&#9;&#9;ELSE ind.index&#91;ref&#93; : &#61; NoObj &#9;&#9;&#9;&#9;&#9;END &#9;&#9;&#9;&#9;ELSE ind.index&#91;ref&#93; : &#61; NoObj &#9;&#9;&#9;&#9;END &#9;&#9;&#9;ELSE ind.index&#91;ref&#93; : &#61; NoObj &#9;&#9;&#9;END &#9;&#9;ELSIF obj &#61; NoObj THEN obj : &#61; NIL &#9;&#9;END &#9;END GetObj; &#9;PROCEDURE PutObj (L : Library; ref : INTEGER; obj : Object); &#9;&#9;VAR index : Block; ind : ArrayIndex; i ,size : LONGINT; &#9;BEGIN &#9;&#9;IF (ref &#60; 0) OR (obj &#61; NIL) THEN RETURN END; &#9;&#9;ind : &#61; L.ind(ArrayIndex); &#9;&#9;IF ref &#62;&#61; ind.size THEN &#9;&#9;&#9;size : &#61; (ref DIV StepSize + 1) * StepSize; &#9;&#9;&#9;NEW(index, size); &#9;&#9;&#9;IF ind.index # NIL THEN SYSTEM.MOVE(ADDRESSOF(ind.index^), ADDRESSOF(index^), LONG(ind.size)*SIZEOF(ADDRESS)) END; &#9;&#9;&#9;FOR i : &#61; ind.size TO size-1 DO index&#91;i&#93; : &#61; NoObj END; &#9;&#9;&#9;ind.size : &#61; SHORT( size); ind.index : &#61; index &#9;&#9;END; &#9;&#9;ind.index&#91;ref&#93; : &#61; obj; obj.lib : &#61; L; obj.ref : &#61; ref; &#9;&#9;IF ref &#62;&#61; L.maxref THEN L.maxref : &#61; ref + 1 END &#9;END PutObj; &#9;PROCEDURE FreeObj (L : Library; ref : INTEGER); &#9;BEGIN &#9;&#9;IF (ref &#62;&#61; 0) &#38; (ref &#60; L.ind(ArrayIndex).size) THEN L.ind(ArrayIndex).index&#91;ref&#93; : &#61; NoObj END &#9;END FreeObj; &#9;PROCEDURE GenRef (L : Library; VAR ref : INTEGER); &#9;BEGIN ref : &#61; L.maxref; INC(L.maxref) &#9;END GenRef; (* Load a standard object library (old format) from position pos in file f. *) &#9;PROCEDURE OldLoadLibrary (L : Library; f : Files.File; pos : LONGINT; VAR len : LONGINT); &#9;&#9;VAR R, S : Files.Rider; Mod : Modules.Module; Cmd : Modules.Command; NofRuns, key, N, i, k, m : INTEGER; &#9;&#9;&#9;&#9;clen, dlen : LONGINT; type, n : SHORTINT; ch : CHAR; entry : Entry; &#9;&#9;&#9;&#9;obj : Object; M : FileMsg; MName, PName : Name; GName : ARRAY MaxNews OF Name; &#9;&#9;&#9;&#9;run : ARRAY MaxRuns OF RunRec; ind : ArrayIndex; dict : ListDict; &#9;BEGIN &#9;&#9;ind : &#61; L.ind(ArrayIndex); dict : &#61; L.dict(ListDict); &#9;&#9;Files.Set(R, f, pos); Files.Read(R, type); &#9;&#9;Files.ReadLInt(R, clen); &#9;&#9;Files.Set(S, f, pos + 1 + clen); &#9;&#9;Files.ReadLInt(S, dlen); &#9;&#9;Files.ReadInt(S, key); &#9;&#9;WHILE key # MIN(INTEGER) DO NEW(entry); &#9;&#9;&#9;Files.ReadString(S, entry.name); &#9;&#9;&#9;entry.key : &#61; key; &#9;&#9;&#9;entry.next : &#61; dict.first; dict.first : &#61; entry; &#9;&#9;&#9;IF key &#60; dict.key THEN dict.key : &#61; key END; &#9;&#9;&#9;Files.ReadInt(S, key) &#9;&#9;END; &#9;&#9;IF type &#62;&#61; 0 THEN (*old format*) &#9;&#9;&#9;Files.Read(R, ch); Files.Read(R, ch); &#9;&#9;&#9;Files.ReadInt(R, i); Files.ReadInt(R, i); Files.ReadInt(R, i); &#9;&#9;&#9;Files.ReadInt(R, i); Files.ReadInt(R, i) &#9;&#9;END; &#9;&#9;Files.ReadInt(R, NofRuns); &#9;&#9;k : &#61; 0; &#9;&#9;&#160;WHILE k # NofRuns DO &#9;&#9;&#9;Files.ReadInt(R, run&#91;k&#93;.beg); Files.ReadInt(R, run&#91;k&#93;.end); &#9;&#9;&#9;INC(k) &#9;&#9;END; &#9;&#9;N : &#61; 0; k : &#61; 0; m : &#61; 0; &#9;&#9;WHILE k &#60; NofRuns DO m : &#61; run&#91;k&#93;.beg; &#9;&#9;&#9;WHILE m &#60; run&#91;k&#93;.end DO Files.Read(R, n); &#9;&#9;&#9;&#9;IF n &#61; N THEN ReadName(R, GName&#91;N&#93;); INC(N) END; &#9;&#9;&#9;&#9;SplitName(GName&#91;n&#93;, MName, PName); &#9;&#9;&#9;&#9;Mod : &#61; Modules.ThisMod(MName); &#9;&#9;&#9;&#9;IF Modules.res &#61; 0 THEN &#9;&#9;&#9;&#9;&#9;Cmd : &#61; Modules.ThisCommand(Mod, PName); &#9;&#9;&#9;&#9;&#9;IF Modules.res &#61; 0 THEN Cmd &#9;&#9;&#9;&#9;&#9;ELSE NewDummy(GName&#91;n&#93;) &#9;&#9;&#9;&#9;&#9;END &#9;&#9;&#9;&#9;ELSE NewDummy(GName&#91;n&#93;) &#9;&#9;&#9;&#9;END; &#9;&#9;&#9;&#9;PutObj(L, m, NewObj); &#9;&#9;&#9;&#9;NewObj.lib : &#61; L; NewObj.ref : &#61; m; &#9;&#9;&#9;&#9;INC(m) &#9;&#9;&#9;END; &#9;&#9;&#9;INC(k) &#9;&#9;END; &#9;&#9;L.maxref : &#61; m; &#9;&#9;M.id : &#61; load; Stamp(M); &#9;&#9;Files.Set(M.R, f, Files.Pos(R)); &#9;&#9;k : &#61; 0; m : &#61; 0; &#9;&#9;WHILE k &#60; NofRuns DO m : &#61; run&#91;k&#93;.beg; &#9;&#9;&#9;WHILE m &#60; run&#91;k&#93;.end DO &#9;&#9;&#9;&#9;Files.ReadLInt(M.R, M.len); &#9;&#9;&#9;&#9;pos : &#61; Files.Pos(M.R)+M.len; &#9;&#9;&#9;&#9;IF M.len # 0 THEN &#9;&#9;&#9;&#9;&#9;obj : &#61; ind.index&#91;m&#93;; &#9;&#9;&#9;&#9;&#9;obj.handle(obj, M) &#9;&#9;&#9;&#9;END; &#9;&#9;&#9;&#9;IF Files.Pos(M.R) &#60; pos THEN (*ejz skip rest of obj data *) &#9;&#9;&#9;&#9;&#9;Files.Set(M.R, f, pos) &#9;&#9;&#9;&#9;ELSIF Files.Pos(M.R) &#62; pos THEN (*ejz object read too much *) &#9;&#9;&#9;&#9;&#9;HALT(99) &#9;&#9;&#9;&#9;END; &#9;&#9;&#9;&#9;INC(m) &#9;&#9;&#9;END; &#9;&#9;&#9;INC(k) &#9;&#9;END; &#9;&#9;len : &#61; 1 + clen + dlen &#9;END OldLoadLibrary; (** Load a standard object library from position pos in file f. *) &#9;PROCEDURE LoadLibrary* (L : Library; f : Files.File; pos : LONGINT; VAR len : LONGINT); &#9;&#9;VAR ind : ArrayIndex; dict : ListDict; i, n, N, version, dorg, gorg : LONGINT; key : INTEGER; entry : Entry; &#9;&#9;&#9;&#9;R : Files.Rider; &#9;BEGIN &#9;&#9;ind : &#61; L.ind(ArrayIndex); &#9;&#9;Files.Set(R, f, pos); &#9;&#9;Files.ReadLInt(R, version); &#9;&#9;IF version &#61; Version THEN &#9;&#9;&#9;Files.ReadLInt(R, gorg); Files.ReadLInt(R, dorg); &#9;&#9;&#9;Files.ReadInt(R, L.maxref); ind.size : &#61; L.maxref; ind.org : &#61; Files.Pos(R); &#9;&#9;&#9;IF L.maxref &#62; 0 THEN NEW(ind.index, L.maxref) END; &#9;&#9;&#9;FOR i : &#61; 0 TO L.maxref - 1 DO ind.index&#91;i&#93; : &#61; NIL END; &#9;&#9;&#9;(* read generator table *) &#9;&#9;&#9;Files.Set(R, f, gorg); &#9;&#9;&#9;Files.ReadInt(R, key); N : &#61; key; &#9;&#9;&#9;IF N &#62; 0 THEN &#9;&#9;&#9;&#9;NEW(L.GName, N); &#9;&#9;&#9;&#9;FOR n : &#61; 0 TO N - 1 DO Files.ReadString(R, L.GName&#91;n&#93;) END &#9;&#9;&#9;ELSE &#9;&#9;&#9;&#9;L.GName : &#61; NIL &#9;&#9;&#9;END; &#9;&#9;&#9;(* read dict *) &#9;&#9;&#9;dict : &#61; L.dict(ListDict); &#9;&#9;&#9;Files.Set(R, f, dorg); &#9;&#9;&#9;Files.ReadInt(R, key); &#9;&#9;&#9;WHILE (key # MIN(INTEGER)) &#38; &#126;R.eof DO &#9;&#9;&#9;&#9;NEW(entry); &#9;&#9;&#9;&#9;Files.ReadString(R, entry.name); &#9;&#9;&#9;&#9;entry.key : &#61; key; &#9;&#9;&#9;&#9;entry.next : &#61; dict.first; dict.first : &#61; entry; &#9;&#9;&#9;&#9;IF key &#60; dict.key THEN dict.key : &#61; key END; &#9;&#9;&#9;&#9;Files.ReadInt(R, key) &#9;&#9;&#9;END; &#9;&#9;&#9;L.f : &#61; f; Files.Set(L.R, f, ind.org); &#9;&#9;&#9;len : &#61; Files.Pos(R) - pos &#9;&#9;ELSE &#9;&#9;&#9;ind.org : &#61; 0; ind.size : &#61; 0; ind.index : &#61; NIL; &#9;&#9;&#9;L.f : &#61; NIL; Files.Set(L.R, NIL, 0); &#9;&#9;&#9;OldLoadLibrary(L, f, pos, len) &#9;&#9;END &#9;END LoadLibrary; (** Store a standard object library at position pos in file f. *) &#9;PROCEDURE StoreLibrary* (L : Library; f : Files.File; pos : LONGINT; VAR len : LONGINT); &#9;&#9;VAR obj : Object; ind : ArrayIndex; i, olen, org, indorg,n,N : LONGINT; m : INTEGER; entry : Entry; &#9;&#9;&#9;&#9;ch : CHAR; GName : ARRAY MaxNews OF GenName; R, indR : Files.Rider; M : FileMsg; A : AttrMsg; &#9;BEGIN &#9;&#9;ind : &#61; L.ind(ArrayIndex); &#9;&#9;Files.Set(R, f, pos); &#9;&#9;Files.Write(R, LibBlockId); &#9;&#9;Files.WriteLInt(R, Version); &#9;&#9;Files.WriteLInt(R, -1);	(* place holder genTable pos *) &#9;&#9;Files.WriteLInt(R, -1);	(* place holder dict pos *) &#9;&#9;Files.WriteInt(R, L.maxref); &#9;&#9;indorg : &#61; Files.Pos(R); Files.Set(indR, f, indorg); &#9;&#9;IF L.maxref &#62; 0 THEN Files.WriteBytes(R, ind.index^, LONG(L.maxref)*4) END; &#9;&#9;(* store obj data *) &#9;&#9;A.id : &#61; get; A.name : &#61; "Gen"; &#9;&#9;N : &#61; 0; &#9;&#9;M.id : &#61; store; Stamp(M); &#9;&#9;FOR i : &#61; 0 TO L.maxref-1 DO &#9;&#9;&#9;obj : &#61; ind.index&#91;i&#93;; &#9;&#9;&#9;IF obj &#61; NIL THEN	(* object is not load yet *) &#9;&#9;&#9;&#9;Files.Set(L.R, L.f, ind.org + 4*i); &#9;&#9;&#9;&#9;Files.ReadLInt(L.R, org); &#9;&#9;&#9;&#9;IF org &#62;&#61; 0 THEN	(* there is an object in the file *) &#9;&#9;&#9;&#9;&#9;Files.Set(L.R, L.f, org); &#9;&#9;&#9;&#9;&#9;Files.ReadInt(L.R, m); Files.ReadLInt(L.R, olen); &#9;&#9;&#9;&#9;&#9;COPY(L.GName&#91;m&#93;, GName&#91;N&#93;); &#9;&#9;&#9;&#9;&#9;n : &#61; 0; &#9;&#9;&#9;&#9;&#9;WHILE GName&#91;n&#93; # GName&#91;N&#93; DO INC(n) END; &#9;&#9;&#9;&#9;&#9;IF n &#61; N THEN INC(N) END; &#9;&#9;&#9;&#9;&#9;Files.WriteLInt(indR, Files.Pos(R));	(* write index *) &#9;&#9;&#9;&#9;&#9;Files.WriteInt(R, SHORT(n)); &#9;&#9;&#9;&#9;&#9;Files.WriteLInt(R, olen); &#9;&#9;&#9;&#9;&#9;WHILE olen &#62; 0 DO Files.Read(L.R, ch); Files.Write(R, ch); DEC(olen) END &#9;&#9;&#9;&#9;ELSE	(* there was never an object with this ref *) &#9;&#9;&#9;&#9;&#9;Files.WriteLInt(indR, -1) &#9;&#9;&#9;&#9;END &#9;&#9;&#9;ELSIF obj # NoObj THEN	(* there is an object to store *) &#9;&#9;&#9;&#9;A.res : &#61; -1; obj.handle(obj, A); COPY(A.s, GName&#91;N&#93;); &#9;&#9;&#9;&#9;n : &#61; 0; &#9;&#9;&#9;&#9;WHILE GName&#91;n&#93; # GName&#91;N&#93; DO INC(n) END; &#9;&#9;&#9;&#9;IF n &#61; N THEN INC(N) END; &#9;&#9;&#9;&#9;Files.WriteLInt(indR, Files.Pos(R));	(* write index *) &#9;&#9;&#9;&#9;Files.WriteInt(R, SHORT(n)); &#9;&#9;&#9;&#9;Files.Set(M.R, f, Files.Pos(R)); &#9;&#9;&#9;&#9;Files.WriteLInt(M.R, 0); obj.handle(obj, M); &#9;&#9;&#9;&#9;olen : &#61; Files.Pos(M.R) - Files.Pos(R) - 4; &#9;&#9;&#9;&#9;Files.WriteLInt(R, olen); &#9;&#9;&#9;&#9;Files.Set(R, f, Files.Pos(M.R)) &#9;&#9;&#9;ELSE	(* no object *) &#9;&#9;&#9;&#9;Files.WriteLInt(indR, -1) &#9;&#9;&#9;END &#9;&#9;END; &#9;&#9;(* write generator table *) &#9;&#9;i : &#61; Files.Pos(R); &#9;&#9;Files.Set(R, f, pos + 5); Files.WriteLInt(R, i); Files.Set(R, f, i); &#9;&#9;Files.WriteInt(R, SHORT(N)); &#9;&#9;IF N &#62; 0 THEN &#9;&#9;&#9;NEW(L.GName, N); &#9;&#9;&#9;FOR n : &#61; 0 TO N-1 DO &#9;&#9;&#9;&#9;Files.WriteString(R, GName&#91;n&#93;); &#9;&#9;&#9;&#9;COPY(GName&#91;n&#93;, L.GName&#91;n&#93;) &#9;&#9;&#9;END &#9;&#9;END; &#9;&#9;(* store dict *) &#9;&#9;i : &#61; Files.Pos(R); &#9;&#9;Files.Set(R, f, pos + 9); Files.WriteLInt(R, i); Files.Set(R, f, i); &#9;&#9;entry : &#61; L.dict(ListDict).first; &#9;&#9;WHILE entry # NIL DO &#9;&#9;&#9;Files.WriteInt(R, entry.key); i : &#61; 0; &#9;&#9;&#9;Files.WriteString(R, entry.name); &#9;&#9;&#9;entry : &#61; entry.next &#9;&#9;END; &#9;&#9;Files.WriteInt(R, MIN(INTEGER)); &#9;&#9;len : &#61; Files.Pos(R) - pos; &#9;&#9;L.f : &#61; f; ind.org : &#61; indorg; &#9;&#9;Files.Set(L.R, L.f, ind.org) &#9;END StoreLibrary; &#9;PROCEDURE LoadFileLib (L : Library); &#9;&#9;VAR f : Files.File; R : Files.Rider; len : LONGINT; id : CHAR; &#9;BEGIN &#9;&#9;f : &#61; Files.Old(L.name); &#9;&#9;IF f # NIL THEN &#9;&#9;&#9;Files.Set(R, f, 0); Files.Read(R, id); &#9;&#9;&#9;IF id &#61; LibBlockId THEN LoadLibrary(L, f, 1, len) &#9;&#9;&#9;ELSE L.f : &#61; NIL; L.ind(ArrayIndex).size : &#61; 0; L.ind(ArrayIndex).index : &#61; NIL &#9;&#9;&#9;END &#9;&#9;END &#9;END LoadFileLib; &#9;PROCEDURE StoreFileLib (L : Library); &#9;&#9;VAR f : Files.File; len : LONGINT; &#9;BEGIN &#9;&#9;f : &#61; Files.New(L.name); &#9;&#9;IF f # NIL THEN StoreLibrary(L, f, 0, len); Files.Register(f) END &#9;END StoreFileLib; (** Initialize a standard object library. *) &#9;PROCEDURE OpenLibrary* (L : Library); &#9;&#9;VAR ind : ArrayIndex; dict : ListDict; &#9;BEGIN &#9;&#9;L.Load : &#61; LoadFileLib; L.Store : &#61; StoreFileLib; &#9;&#9;L.GenRef : &#61; GenRef; L.GetObj : &#61; GetObj; &#9;&#9;L.PutObj : &#61; PutObj; L.FreeObj : &#61; FreeObj; &#9;&#9;NEW(ind); ind.org : &#61; 0; ind.size : &#61; 0; ind.index : &#61; NIL; L.ind : &#61; ind; &#9;&#9;NEW(dict); dict.first : &#61; NIL; dict.key : &#61; 0; L.dict : &#61; dict; &#9;&#9;L.maxref : &#61; 0 &#9;END OpenLibrary; &#160;&#160;PROCEDURE NewLibrary : Library; &#160;&#160;&#160;&#160;VAR L : Library; &#160;&#160;BEGIN NEW(L); OpenLibrary(L); RETURN L &#160;&#160;END NewLibrary; (** Given an object name, return the object reference number from the dictionary. *) &#9;PROCEDURE GetRef* (VAR D : Dictionary; CONST name : ARRAY OF CHAR; VAR ref : INTEGER); &#9;&#9;VAR cur : Entry; &#9;BEGIN &#9;&#9;IF D IS ListDict THEN &#9;&#9;&#9;cur : &#61; D(ListDict).first; &#9;&#9;&#9;WHILE (cur # NIL) &#38; ((cur.key &#60; 0) OR (cur.name # name)) DO cur : &#61; cur.next END; &#9;&#9;&#9;IF cur &#61; NIL THEN ref : &#61; MIN(INTEGER) ELSE ref : &#61; cur.key END &#9;&#9;ELSE ref : &#61; MIN(INTEGER) &#9;&#9;END &#9;END GetRef; (** Allocate a key (any integer &#60; 0) to a name. *) &#160;&#160;PROCEDURE GetKey* (VAR D : Dictionary; CONST name : ARRAY OF CHAR; VAR key : INTEGER); &#9;&#9;VAR cur : Entry; &#9;BEGIN &#9;&#9;IF D IS ListDict THEN &#9;&#9;&#9;WITH D : ListDict DO &#9;&#9;&#9;&#9;cur : &#61; D.first; &#9;&#9;&#9;&#9;WHILE (cur # NIL) &#38; ((cur.key &#62;&#61; 0) OR (cur.name # name)) DO cur : &#61; cur.next END; &#9;&#9;&#9;&#9;IF cur &#61; NIL THEN DEC(D.key); &#9;&#9;&#9;&#9;&#9;NEW(cur); cur.key : &#61; D.key; COPY(name, cur.name); cur.next : &#61; D.first; D.first : &#61; cur &#9;&#9;&#9;&#9;END; &#9;&#9;&#9;&#9;key : &#61; cur.key &#9;&#9;&#9;END &#9;&#9;ELSE key : &#61; MIN(INTEGER) &#9;&#9;END &#160;&#160;END GetKey; (** Get name associated with a key/reference number. *) &#9;PROCEDURE GetName* (VAR D : Dictionary; key : INTEGER; VAR name : ARRAY OF CHAR); &#9;&#9;VAR cur : Entry; &#9;BEGIN &#9;&#9;IF D IS ListDict THEN &#9;&#9;&#9;cur : &#61; D(ListDict).first; &#9;&#9;&#9;WHILE (cur # NIL) &#38; (cur.key # key) DO cur : &#61; cur.next END; &#9;&#9;&#9;IF cur &#61; NIL THEN name&#91;0&#93; : &#61; 0X ELSE COPY(cur.name, name) END &#9;&#9;ELSE name&#91;0&#93; : &#61; 0X &#9;&#9;END &#9;END GetName; (** Associate a name with a reference number. *) &#160;&#160;PROCEDURE PutName* (VAR D : Dictionary; key : INTEGER; CONST name : ARRAY OF CHAR); (* Note : D could be value parameter *) &#9;&#9;VAR cur : Entry; &#9;BEGIN &#9;&#9;IF D IS ListDict THEN &#9;&#9;&#9;IF key &#62;&#61; 0 THEN &#9;&#9;&#9;&#9;WITH D : ListDict DO &#9;&#9;&#9;&#9;&#9;cur : &#61; D.first; &#9;&#9;&#9;&#9;&#9;WHILE (cur # NIL) &#38; (cur.key # key) DO cur : &#61; cur.next END; &#9;&#9;&#9;&#9;&#9;IF cur &#61; NIL THEN &#9;&#9;&#9;&#9;&#9;NEW(cur); cur.key : &#61; key; cur.next : &#61; D.first; D.first : &#61; cur &#9;&#9;&#9;&#9;&#9;END; &#9;&#9;&#9;&#9;&#9;COPY(name, cur.name) &#9;&#9;&#9;&#9;END &#9;&#9;&#9;END &#9;&#9;END &#160;&#160;END PutName; BEGIN LibBlockId : &#61; 0DBX; &#9;NEW(FirstLib); FirstLib.next : &#61; NIL; &#9;NEW(FirstAlias); FirstAlias.next : &#61; NIL; &#9;stamp : &#61; MIN(LONGINT); &#9;NEW(NoObj); &#9;nofreg : &#61; 0; &#9;Register("Lib", NewLibrary) END Objects. (** Remarks : 1. Objects and Messages Objects and the messages sent to them are both types in the Oberon system. Just as we can extend an object by defining an object-subtype, we can extend a message by defining a message sub-type. As root of the object and message type hierarchies we have the types Objects.Object and Object.ObjMsg respectively. We will be referring to extensions of these types as Objects and Messages respectively. This way of organizing things allows us to send a message of any type to an object of any type (even when the receiving object might not make sense of the message). As an examples of an object we can mention the Frames of module Display (visual objects). Frames have a set of associated messages called frame messages (i.e. messages sent to frames). A base type called Display.FrameMsg is an extension of Object.ObjMsg and the base of the frame messages. The module Objects define the object messages, i.e. the messages that all objects understand. Objects are allocated on the heap and messages temporarily on the stack. 2. Message Handlers Message handlers process the message sent to an object. A message handler is a procedure with the definition Objects.Handler. A message handler receives as first parameter the object the message is sent to, and as second parameter the message itself. The message handler does message type tests to discrimate between the different message types it receives, and acts accordingly to each message type (most of the actions are prescribed the messages defined in modules like Objects and Display). The message handler of a newly created object is "installed" in an object by assigning it to the field handle of the object. A typical handler might look as follows : &#9;PROCEDURE MyHandler(obj : Object; VAR M : ObjMsg); &#9;BEGIN &#9;&#9;IF M IS Objects.AttrMsg THEN &#9;&#9;&#9;WITH M : Objects.AttrMsg DO &#9;&#9;&#9;&#9;... &#9;&#9;&#9;END &#9;&#9;ELSIF M IS Objects.CopyMsg THEN &#9;&#9;&#9;WITH M : Objects.CopyMsg DO &#9;&#9;&#9;&#9;... &#9;&#9;&#9;END &#9;&#9;ELSE &#9;&#9;&#9;(* message not understood by handler. *) &#9;&#9;END &#9;END MyHandler; To create a new object, we first have to introduce a new object type, allocate a new instance on the heap and attach the message handler : &#9;TYPE &#9;&#9;MyObj &#61; POINTER TO MyObjDesc; &#9;&#9;MyObjDesc &#61; RECORD (Objects.ObjDesc)	(* Extension of Objects.ObjDesc. *) &#9;&#9;&#9;A, B : LONGINT;	(* Object instance variables. *) &#9;&#9;END; &#9;PROCEDURE CreateObj; &#9;VAR obj : MyObj; &#9;BEGIN &#9;&#9;NEW(obj);	(* allocate a new object on the heap *) &#9;&#9;obj.handle : &#61; MyHandler;	(* attach the message handler. *) &#9;END CreateObj; Here we created a new object type with two additional instance variables A and B. To open up access to the instance variables in the message handler, we will need to modify the message handler slightly : &#9;PROCEDURE MyHandler(obj : Object; VAR M : ObjMsg); &#9;BEGIN &#9;&#9;WITH obj : MyObj DO	(* Open up access to the instance variables of MyObj. *) &#9;&#9;&#9;IF M IS Objects.AttrMsg THEN &#9;&#9;&#9;&#9;WITH M : Objects.AttrMsg DO &#9;&#9;&#9;&#9;&#9;... &#9;&#9;&#9;&#9;END &#9;&#9;&#9;ELSIF M IS Objects.CopyMsg THEN &#9;&#9;&#9;&#9;WITH M : Objects.CopyMsg DO &#9;&#9;&#9;&#9;&#9;... &#9;&#9;&#9;&#9;END &#9;&#9;&#9;ELSE &#9;&#9;&#9;&#9;(* message not understood by handler. *) &#9;&#9;&#9;END &#9;&#9;END &#9;END MyHandler; This change also means that MyHandler can only be safely attached to objects (or extensions) of type MyObj; attaching the handler to objects of other types will cause a runtime exception (trap) when trying to open access to the fields of MyObj. Sending a message to an object involves allocating it on the stack, filling out the message fields, and calling the object message handler. For example : &#9;VAR obj : MyObj; &#9;PROCEDURE GetName; &#9;VAR M : Objects.AttrMsg;	(* Allocate message on the stack. *) &#9;BEGIN &#9;&#9;M.id : &#61; Objects.get; M.name : &#61; "Name"; M.res : &#61; -1;	(* Fill out message fields *) &#9;&#9;obj.handle(obj, M);	(* Send message. *) &#9;&#9;Out.String(M.s); Out.Ln;	(* Process result. *) &#9;END GetName; You are allowed to define new message types for your own objects, in a similar manner as shown in the message definitions above. Note how many of the messages have id fields; these indicate different sub-operations a message requests. The id values are declared per message as INTEGER constants at the beginning of the module. 3. Forwarding and Broadcasts Objects may forward messages to other objects. This is typically done when an object cannot handle a message itself or does not even know the message. Sometimes messages are sent in such a way that each object does some handle of a message, and then forwards it anyway to all other objects it controls. This we call message broadcasting. Messages thus pass from one object to another in ways only known to the objects themselves. The route a message follows we call the message path. 4. Time stamps During a message broadcast, more than one message path may lead to the same object, resulting in the object receiving a the message many times (i.e. exactly once for each message path). To allow an object to determine if it has already processed a message, each message that is broadcast is given a timestamp. The receiving object remembers the message timestamp in its field stamp, and can compare it against a later message received. Due to message broadcasts occuring during a message broadcast itself (i.e. recursive broadcasts), you should not assume that message arrive in time stamp sequence. The stamp is a LONGINT value incremented on each broadcast by the procedure Stamp. 5. The Message Thread The message thread informs an object of the path a message followed to reach it, and can be used to implement path dependent behaviour. The dlink field in the ObjMsg points to the last forwarder of the message. The dlink field of the latter object contains the previous object in the path, and so onwards until the beginning of the path (the thread points backwards). Due to recursive message broadcasts the dlink field in the message and the objects themselves should be saved on the stack before the values are changed : &#9;(* Forward a message from one object to another. *) &#9;PROCEDURE SendMsg(from, to : Objects.Object; VAR M : Objects.ObjMsg); &#9;VAR p, p0; Objects.Object; &#9;BEGIN &#9;&#9;p : &#61; from.dlink; p0 : &#61; M.dlink; (* save *) &#9;&#9;from.dlink : &#61; M.dlink; (* hook sender in dlink chain *) &#9;&#9;M.dlink : &#61; from; (* set sender of the message *) &#9;&#9;to.handle(to, M); &#9;&#9;from.dlink : &#61; p; M.dlink : &#61; p0 (* restore *) &#9;END SendMsg; A message sender may refuse to add itself to the message thread (for optimization purposes). This has no effect but to make it invisible to further recipients in the message path. The message thread is typically used in the display space (see module Display) to find out how a message travelled from the display root to an object located somewhere in the display space. 6. The slink field The slink field links objects together in a list so that they can be passed around as a group. Never assume that the slink list remains the same before and after a message broadcast. 7. Libraries Libraries are indexed collections of objects. An object belonging to a library is said to be bound to the library (otherwise it is free). When bound, an objects obtains an index or reference number (&#62;&#61; 0) in its library (and its lib and ref fields are set accordingly). The Objects module implements the standard object libraries. These allow you to store the library and its contents in an atomic action to disk. On disk, reference numbers instead of pointers are used to refer to objects. Thus pointers and reference numbers are swizzled (exchanged) when loading or storing libraries. The procedures Gadgets.ReadRef and Gadgets.WriteRef use the library mechanism to transparently read and write object pointers to disk. The library dictionary mechanism allows you to attach names to objects (more concretely to reference numbers). An object belonging to public library L and having the name O in the dictionary, is refered to as "L.O" (note the similarity with "M.P"). Sometimes the dictionary is also used to attach keys (&#60; 0) to strings. Keys are used to save string space when storing libraries. Libraries are divided into public and private libraries. Public libraries are named (i.e. L.name # "") and are cached in memory on loading. The garbage collector will uncache a library automatically if it is not required any more. The Libraries.Panel allow you to manipulate the contents of public libraries. Private libraries are primarily used as a means to make objects persistent in documents and are never cached. The default public library file extension is "Lib". It is possible to add new types of libraries by registering new library extensions and the associated library generator. 8. The Object Messages All objects should implement handlers for the so-called object messages defined in this module. The object messages are the LinkMsg (for structure building and exploration), the CopyMsg (for copying an object), the BindMsg (for binding an object to a library), the AttrMsg (for setting and getting attributes), the FileMsg (for loading and storing), and the FindMsg (for locating named objects). 9. The LinkMsg The LinkMsg is used to link objects between each other i.e. setting a pointer in one object to point to another. The links must be identified by name. Most displayable gadgets have a "Model" link that points to a model gadget. 10. The CopyMsg Shallow copy means copying an object but reusing its descendants, and deep copy means copying all objects reachable from a certain root object. Due to the DAG nature of the display space, the deep copy message arrives once or more times at an object, in which case it only should copy itself once to guarantee structure preserving copies. The following shows that an object should cache the first copy that it makes of itself in the dlink field, which is then returned on receiving the message a second time : &#9;&#9;VAR F0 : Frame; (* the copy goes here *) &#9;&#9;IF M IS Objects.CopyMsg THEN &#9;&#9;&#9;WITH M : Objects.CopyMsg DO &#9;&#9;&#9;&#9;IF M.stamp &#61; F.stamp THEN M.obj : &#61; F.dlink	(* copy msg arrives again *) &#9;&#9;&#9;&#9;ELSE	(* first time copy message arrives *) &#9;&#9;&#9;&#9;&#9;NEW(F0); F.stamp : &#61; M.stamp; F.dlink : &#61; F0; CopyFrame(M, F, F0); M.obj : &#61; F0 &#9;&#9;&#9;&#9;END &#9;&#9;&#9;END &#9;&#9;END 11. The BindMsg The BindMsg is a request to an object to bind itself to a library. By convention, an object can migrate from library to library, except when bound to a public library. Binding allocates a reference number to an object which is conveniently used as a pointer alias between objects stored in a file. &#9;PROCEDURE BindObj(obj : Objects.Object; lib : Objects.Library); &#9;VAR ref : INTEGER; name : ARRAY 256 OF CHAR; &#9;BEGIN &#9;&#9;IF lib # NIL THEN &#9;&#9;&#9;IF (obj.lib &#61; NIL) OR (obj.lib.name&#91;0&#93; &#61; 0X) &#38; (obj.lib # lib) THEN (* free, or belongs to a private library *) &#9;&#9;&#9;&#9;lib.GenRef(lib, ref);	(* allocate reference number *) &#9;&#9;&#9;&#9;IF ref &#62;&#61; 0 THEN	(* successful *) &#9;&#9;&#9;&#9;&#9;lib.PutObj(lib, ref, obj); &#9;&#9;&#9;&#9;END &#9;&#9;&#9;END &#9;&#9;END &#9;END BindObj; 12. The AttrMsg The attribute message is used to enumerate, set or retrieve an object attribute. The class field of the AttrMsg indicate what the type of an attribute is. Each object should have a Name attribute and a Gen attribute (both of type String). The name attribute refers to the intrinsic name of an object (it should not be confused with the name the object might have in a dictionary). Copying an object results in two objects with the same names. The FindMsg locates an object with a certain intrinsic name. The Gen attribute indicates the name of the object generator (in the form "M.P"). Calling the generator of an object results in the freshly created object attached to Objects.NewObj, from where it is picked up by commands like Gadgets.Insert. 13. The FileMsg The FileMsg is a request to an object to write or read its state to or from a Rider. An object should always read and write the same number of bytes, otherwise traps may result. It is recommended to use version numbers to distinguish objects of different generations from each other and so allow for smooth upgrading to new file formats for older objects. The FileMsg is typically used when reading or writing a library from or to disk. 14. The FindMsg The FindMsg is a request to an object to locate the object with the indicated intrinsic name. Should an object not know of an object with such a name, it should forward the message to all objects it controls (children). By convention, searching should be done in a bread-first manner between descendants of a container. 15. Keys Each library has a dictionary of (key, name) pairs. The key is either positive or zero, in which case it is regarded as a reference number in the library (with associated object name), or negative, in which case it is simply a short way of refering to a string (an atom). The latter reduces the space used when the same string appears many times in a library file. 16. Dummies Dummies are objects created in place of objects that cannot be loaded into memory (module missing). Pointers to Dummies are often set to NIL by the application itself. 17. Extended Libraries It is possible to add new library types to the system. New types are distinguished by filename extensions that are registered by Objects.Register. The NewProc is called by Objects.ThisLibrary to create an empty instance of the new library type. The name field is filled in, after which the Load procedure of the library is called to load the library from disk. In accordance, the Store procedure stores the library under its name to disk. The LoadLibrary and StoreLibrary procedures implement the default behaviour for the standard object libraries. &#42;)