blackbox-linux-console/BlackBox/System/Mod/Stores.txt

MODULE Stores;

	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Stores.odc *)
	(* DO NOT EDIT *)

	IMPORT SYSTEM, Kernel, Dialog, Strings, Files;

	CONST
		(** Alien.cause, Reader.TurnIntoAlien cause - flagged by internalization procs **)
		alienVersion* = 1; alienComponent* = 2;
		(** Alien.cause - internally detected **)
		inconsistentVersion* = -1; inconsistentType* = -2;
		moduleFileNotFound* = -3; invalidModuleFile* = -4;
		inconsModuleVersion* = -5; typeNotFound* = -6;

		dictLineLen = 32;	(* length of type & elem dict lines *)

		newBase = 0F0X;	(* new base type (level = 0), i.e. not yet in dict *)
		newExt = 0F1X;	(* new extension type (level = 1), i.e. not yet in dict *)
		oldType = 0F2X;	(* old type, i.e. already in dict *)

		nil = 080X;	(* nil store *)
		link = 081X;	(* link to another elem in same file *)
		store = 082X;	(* general store *)
		elem = 083X;	(* elem store *)
		newlink = 084X;	(* link to another non-elem store in same file *)

		minVersion = 0; maxStoreVersion = 0;

		elemTName = "Stores.ElemDesc";		(* type of pre-1.3 elems *)
		modelTName = "Models.ModelDesc";	(* the only known family of pre-1.3 elems *)
		
		inited = TRUE; anonymousDomain = FALSE;	(* values to be used when calling NewDomain *)
		
		compatible = TRUE;


	TYPE
		TypeName* = ARRAY 64 OF CHAR;
		TypePath* = ARRAY 16 OF TypeName;
		OpName* = ARRAY 32 OF CHAR;

		Domain* = POINTER TO LIMITED RECORD 
			sequencer: ANYPTR;
			dlink: Domain;
			initialized, copyDomain: BOOLEAN;
			level, copyera, nextElemId:  INTEGER;
			sDict: StoreDict;
			cleaner: TrapCleaner;
			s: Store	(* used for CopyOf *)
		END;

		Operation* = POINTER TO ABSTRACT RECORD END;

		Store* = POINTER TO ABSTRACT RECORD
			dlink: Domain;
			era, id: INTEGER;	(* externalization era and id *)
			isElem: BOOLEAN	(* to preserve file format: is this an elem in the old sense? *)
		END;


		AlienComp* = POINTER TO LIMITED RECORD
			next-: AlienComp
		END;

		AlienPiece* = POINTER TO LIMITED RECORD (AlienComp)
			pos-, len-: INTEGER
		END;

		AlienPart* = POINTER TO LIMITED RECORD (AlienComp)
			store-: Store
		END;

		Alien* = POINTER TO LIMITED RECORD (Store)
			path-: TypePath;	(** the type this store would have if it were not an alien **)
			cause-: INTEGER;	(** # 0, the cause that turned this store into an alien **)
			file-: Files.File;	(** base file holding alien pieces **)
			comps-: AlienComp	(** the constituent components of this alien store **)
		END;

		ReaderState = RECORD
			next: INTEGER;	(* position of next store in current level *)
			end: INTEGER	(* position just after last read store *)
		END;

		WriterState = RECORD
			linkpos: INTEGER	(* address of threading link *)
		END;

		TypeDict = POINTER TO RECORD
			next: TypeDict;
			org: INTEGER;	(* origin id of this dict line *)
			type: ARRAY dictLineLen OF TypeName;	(* type[org] .. type[org + dictLineLen - 1] *)
			baseId: ARRAY dictLineLen OF INTEGER
		END;

		StoreDict = POINTER TO RECORD
			next: StoreDict;
			org: INTEGER;	(* origin id of this dict line *)
			elem: ARRAY dictLineLen OF Store	(* elem[org] .. elem[org + dictLineLen - 1] *)
		END;

		Reader* = RECORD
			rider-: Files.Reader;
			cancelled-: BOOLEAN;	(** current Internalize has been cancelled **)
			readAlien-: BOOLEAN;	(** at least one alien read since ConnectTo **)
			cause: INTEGER;
			nextTypeId, nextElemId, nextStoreId: INTEGER;	(* next id of non-dict type, "elem", store *)
			tDict, tHead: TypeDict;	(* mapping (id <-> type) - self-organizing list *)
			eDict, eHead: StoreDict;	(* mapping (id -> elem) - self-organizing list *)
			sDict, sHead: StoreDict;	(* mapping (id -> store) - self-organizing list *)
			st: ReaderState;
			noDomain: BOOLEAN;
			store: Store
		END;

		Writer* = RECORD
			rider-: Files.Writer;
			writtenStore-: Store;
			era: INTEGER;	(* current externalization era *)
			noDomain: BOOLEAN;	(* no domain encountered yet *)
			modelType: Kernel.Type;
			domain: Domain;	(* domain of current era *)
			nextTypeId, nextElemId, nextStoreId: INTEGER;	(* next id of non-dict type or elem *)
			tDict, tHead: TypeDict;	(* mapping (id -> type) - self-organizing list *)
			st: WriterState
		END;

		TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) 
			d: Domain
		END;

	VAR
		nextEra: INTEGER;	(* next externalization era *)
		thisTypeRes: INTEGER;	(* side-effect res code of ThisType *)
		logReports: BOOLEAN;


	(** Cleaner **)

	PROCEDURE (c: TrapCleaner) Cleanup;
	BEGIN
		c.d.level := 0;
		c.d.sDict := NIL;
		c.d.s := NIL
	END Cleanup;

	PROCEDURE (d: Domain) SetSequencer* (sequencer: ANYPTR), NEW;
	BEGIN
		ASSERT(d.sequencer = NIL);
		d.sequencer := sequencer
	END SetSequencer;
	
	PROCEDURE (d: Domain) GetSequencer*(): ANYPTR, NEW;
	BEGIN
		RETURN d.sequencer
	END GetSequencer;


	PROCEDURE^ Report* (IN msg, p0, p1, p2: ARRAY OF CHAR);
	
	PROCEDURE^ (VAR rd: Reader) SetPos* (pos: INTEGER), NEW;
	PROCEDURE^ (VAR rd: Reader) ReadVersion* (min, max: INTEGER; OUT version: INTEGER), NEW;
	PROCEDURE^ (VAR rd: Reader) ReadSChar* (OUT x: SHORTCHAR), NEW;
	PROCEDURE^ (VAR rd: Reader) ReadInt* (OUT x: INTEGER), NEW;
	PROCEDURE^ (VAR rd: Reader) ReadXString* (OUT x: ARRAY OF CHAR), NEW;
	PROCEDURE^ (VAR rd: Reader) ReadStore* (OUT x: Store), NEW;
	
	PROCEDURE^ (VAR wr: Writer) SetPos* (pos: INTEGER), NEW;
	PROCEDURE^ (VAR wr: Writer) WriteVersion* (version: INTEGER), NEW;
	PROCEDURE^ (VAR wr: Writer) WriteSChar* (x: SHORTCHAR), NEW;
	PROCEDURE^ (VAR wr: Writer) WriteInt* (x: INTEGER), NEW;
	PROCEDURE^ (VAR wr: Writer) WriteXString* (IN x: ARRAY OF CHAR), NEW;
	PROCEDURE^ (VAR wr: Writer) WriteStore* (x: Store), NEW;
	
	PROCEDURE^ Join* (s0, s1: Store);


	(** Operation **)

	PROCEDURE (op: Operation) Do* (), NEW, ABSTRACT;


	(** Store **)

	PROCEDURE NewDomain (initialized: BOOLEAN): Domain;
		VAR d: Domain;
	BEGIN
		NEW(d); d.level := 0; d.sDict := NIL; d.cleaner := NIL;
		d.initialized := initialized; d.copyDomain := FALSE;
		RETURN d
	END NewDomain;

	PROCEDURE DomainOf (s: Store): Domain;
		VAR d, p, q, r: Domain;
	BEGIN
		d := s.dlink;
		IF (d # NIL) & (d.dlink # NIL) THEN
			p := NIL; q := d; r := q.dlink;
			WHILE r # NIL DO q.dlink := p; p := q; q := r; r := q.dlink END;
			d := q;
			WHILE p # NIL DO q := p; p := q.dlink; q.dlink := d END;
			s.dlink := d
		END;
		RETURN d
	END DomainOf;

	PROCEDURE (s: Store) Domain*(): Domain, NEW;
		VAR d: Domain;
	BEGIN
		d := DomainOf(s);
		IF (d # NIL) & ~d.initialized THEN d := NIL END;
		RETURN d
	END Domain;
	
	PROCEDURE (s: Store) CopyFrom- (source: Store), NEW, EMPTY;

	PROCEDURE (s: Store) Internalize- (VAR rd: Reader), NEW, EXTENSIBLE;
		VAR thisVersion: INTEGER;
	BEGIN
		rd.ReadVersion(minVersion, maxStoreVersion, thisVersion);
		IF ~rd.cancelled & s.isElem THEN
			rd.ReadVersion(minVersion, maxStoreVersion, thisVersion)
			(* works since maxStoreVersion = maxElemVersion = 0 in pre-1.3 *)
		END	
	END Internalize;

	PROCEDURE (s: Store) ExternalizeAs- (VAR s1: Store), NEW, EMPTY;

	PROCEDURE (s: Store) Externalize- (VAR wr: Writer), NEW, EXTENSIBLE;
	BEGIN
		wr.WriteVersion(maxStoreVersion);
		IF s.isElem THEN wr.WriteVersion(maxStoreVersion) END
	END Externalize;


	(** Alien **)

	PROCEDURE^ CopyOf* (s: Store): Store;

	PROCEDURE (a: Alien) CopyFrom- (source: Store);
		VAR s, c, cp: AlienComp; piece: AlienPiece; part: AlienPart;
	BEGIN
		WITH source: Alien DO
			a.path := source.path;
			a.cause := source.cause;
			a.file := source.file;
			a.comps := NIL;
			s := source.comps; cp := NIL;
			WHILE s # NIL DO
				WITH s: AlienPiece DO
					NEW(piece); c := piece;
					piece.pos := s.pos; piece.len := s.len
				| s: AlienPart DO
					NEW(part); c := part;
					IF s.store # NIL THEN part.store := CopyOf(s.store); Join(part.store, a) END
				END;
				IF cp # NIL THEN cp.next := c ELSE a.comps := c END;
				cp := c;
				s := s.next
			END
		END
	END CopyFrom;

	PROCEDURE (a: Alien) Internalize- (VAR rd: Reader);
	BEGIN
		HALT(100)
	END Internalize;

	PROCEDURE (a: Alien) Externalize- (VAR w: Writer);
	BEGIN
		HALT(100)
	END Externalize;


	(* types *)

	PROCEDURE GetThisTypeName (t: Kernel.Type; VAR type: TypeName);
		VAR i, j: INTEGER; ch: CHAR; name: Kernel.Name;
	BEGIN
		Kernel.GetTypeName(t, name); type := t.mod.name$;
		i := 0; ch := type[0]; WHILE ch # 0X DO INC(i); ch := type[i] END;
		type[i] := "."; INC(i);
		j := 0; REPEAT ch := name[j]; type[i] := ch; INC(i); INC(j) UNTIL ch = 0X;
		IF compatible THEN
			IF type[i-2] = "^" THEN	(* for backward compatibility *)
				type[i-2] := "D"; type[i-1] := "e"; type[i] := "s"; type[i+1] := "c"; type[i+2] := 0X 
			END
		END
	END GetThisTypeName;

	PROCEDURE ThisType (type: TypeName): Kernel.Type;
		VAR m: Kernel.Module; t: Kernel.Type; i, j: INTEGER; ch: CHAR;
			typ: Kernel.Name; mod: ARRAY 256 OF CHAR; res: INTEGER; str: ARRAY 256 OF CHAR;
	BEGIN
		ASSERT(type # "", 20);
		i := 0; ch := type[0];
		WHILE (ch # ".") & (ch # 0X) DO mod[i] := SHORT(ch); INC(i); ch := type[i] END;
		ASSERT(ch = ".", 21);
		mod[i] := 0X; INC(i);
		m := Kernel.ThisMod(mod);
		IF m # NIL THEN
			j := 0; REPEAT ch := type[i]; typ[j] := SHORT(ch); INC(i); INC(j) UNTIL ch = 0X;
			t := Kernel.ThisType(m, typ);
			IF (t = NIL) & (j >= 5) THEN	(* try pointer type *)
				IF (typ[j-5] = "D") & (typ[j-4] = "e") & (typ[j-3] = "s") & (typ[j-2] = "c") THEN
					typ[j-5] := "^"; typ[j-4] := 0X;
					t := Kernel.ThisType(m, typ)
				END
			END;
			IF t = NIL THEN thisTypeRes := typeNotFound END
		ELSE
			t := NIL;
			Kernel.GetLoaderResult(res, str, str, str);
			CASE res OF
			| Kernel.fileNotFound: thisTypeRes := moduleFileNotFound
			| Kernel.syntaxError: thisTypeRes := invalidModuleFile
			| Kernel.objNotFound: thisTypeRes := inconsModuleVersion
			| Kernel.illegalFPrint: thisTypeRes := inconsModuleVersion
			| Kernel.cyclicImport: thisTypeRes := invalidModuleFile	(* cyclic import ... *)
			ELSE thisTypeRes := invalidModuleFile
			END
		END;
		RETURN t
	END ThisType;
	
	PROCEDURE SameType (IN x, y: TypeName): BOOLEAN;
		VAR i: INTEGER;
	BEGIN
		IF x = y THEN RETURN TRUE
		ELSE
			i := 0; WHILE x[i] = y[i] DO INC(i) END;
			RETURN
				(x[i] = "^") & (x[i+1] = 0X) & (y[i] = "D") & (y[i+1] = "e") & (y[i+2] = "s") & (y[i+3] = "c") & (y[i+4] = 0X)
				OR (y[i] = "^") & (y[i+1] = 0X) & (x[i] = "D") & (x[i+1] = "e") & (x[i+2] = "s") & (x[i+3] = "c") & (x[i+4] = 0X)
		END
	END SameType;

	PROCEDURE SamePath (t: Kernel.Type; VAR path: TypePath): BOOLEAN;
	(* check whether t coincides with path *)
		VAR tn: TypeName; i, n: INTEGER;
	BEGIN
		i := -1; n := Kernel.LevelOf(t);
		REPEAT
			GetThisTypeName(t.base[n], tn);
			DEC(n); INC(i)
		UNTIL (n < 0) OR ~SameType(tn, path[i]);
		RETURN SameType(tn, path[i])
	END SamePath;

	PROCEDURE NewStore (t: Kernel.Type): Store;
		VAR p: ANYPTR;
	BEGIN
		ASSERT(t # NIL, 20);
		Kernel.NewObj(p, t); ASSERT(p # NIL, 100);
		ASSERT(p IS Store, 21);
		RETURN p(Store)
	END NewStore;


	(* type dictionary *)

	PROCEDURE GetThisType (VAR d: TypeDict; id: INTEGER; VAR type: TypeName);
	(* pre: (id, t) IN dict *)
		VAR h, p: TypeDict; org, k: INTEGER;
	BEGIN
		k := id MOD dictLineLen; org := id - k;
		h := NIL; p := d; WHILE p.org # org DO h := p; p := p.next END;
		IF h # NIL THEN h.next := p.next; p.next := d; d := p END;
		type := p.type[k];
		ASSERT(type # "", 100)
	END GetThisType;

	PROCEDURE ThisId (VAR d: TypeDict; t: TypeName): INTEGER;
	(* pre: t # "" *)
	(* post: res = id if (t, id) in dict, res = -1 else *)
		VAR h, p: TypeDict; k, id: INTEGER;
	BEGIN
		h := NIL; p := d; id := -1;
		WHILE (p # NIL) & (id < 0) DO
			k := 0; WHILE (k < dictLineLen) & (p.type[k, 0] # 0X) & (p.type[k] # t) DO INC(k) END;
			IF (k < dictLineLen) & (p.type[k, 0] # 0X) THEN id := p.org + k
			ELSE h := p; p := p.next
			END
		END;
		IF (id >= 0) & (h # NIL) THEN h.next := p.next; p.next := d; d := p END;
		RETURN id
	END ThisId;

	PROCEDURE ThisBaseId (VAR d: TypeDict; id: INTEGER): INTEGER;
	(* post: res = id if base(t) # NIL, res = -1 if base(t) = NIL; res >= 0 => T(res) = base(t) *)
		VAR h, p: TypeDict; k, org, baseId: INTEGER;
	BEGIN
		k := id MOD dictLineLen; org := id - k;
		h := NIL; p := d; WHILE p.org # org DO h := p; p := p.next END;
		IF h # NIL THEN h.next := p.next; p.next := d; d := p END;
		baseId := p.baseId[k];
		RETURN baseId
	END ThisBaseId;

	PROCEDURE AddType (VAR d, h: TypeDict; id: INTEGER; type: TypeName);
		VAR k: INTEGER;
	BEGIN
		k := id MOD dictLineLen;
		IF (h = NIL) OR ((k = 0) & (h.org # id)) THEN
			NEW(h); h.org := id - k; h.next := d; d := h
		END;
		h.type[k] := type; h.baseId[k] := -1
	END AddType;

	PROCEDURE AddBaseId (h: TypeDict; id, baseId: INTEGER);
		VAR k: INTEGER;
	BEGIN
		k := id MOD dictLineLen;
		h.baseId[k] := baseId
	END AddBaseId;

	PROCEDURE InitTypeDict (VAR d, h: TypeDict; VAR nextID: INTEGER);
	BEGIN
		d := NIL; h := NIL; nextID := 0
	END InitTypeDict;


	(* store dictionary - used to maintain referential sharing *)

	PROCEDURE ThisStore (VAR d: StoreDict; id: INTEGER): Store;
	(* pre: (id, s) IN dict *)
		VAR h, p: StoreDict; s: Store; k, org: INTEGER;
	BEGIN
		k := id MOD dictLineLen; org := id - k;
		h := NIL; p := d; WHILE p.org # org DO h := p; p := p.next END;
		IF h # NIL THEN h.next := p.next; p.next := d; d := p END;
		s := p.elem[k];
		ASSERT(s # NIL, 100);
		RETURN s
	END ThisStore;

	PROCEDURE AddStore (VAR d, h: StoreDict; s: Store);
		VAR k: INTEGER;
	BEGIN
		k := s.id MOD dictLineLen;
		IF (h = NIL) OR ((k = 0) & (h.org # s.id)) THEN
			NEW(h); h.org := s.id - k; h.next := d; d := h
		END;
		h.elem[k] := s
	END AddStore;

	PROCEDURE InitStoreDict (VAR d, h: StoreDict; VAR nextID: INTEGER);
	BEGIN
		d := NIL; h := NIL; nextID := 0
	END InitStoreDict;


	(* support for type mapping *)

	PROCEDURE ReadPath (VAR rd: Reader; VAR path: TypePath);
		VAR h: TypeDict; id, extId: INTEGER; i: INTEGER; kind: SHORTCHAR;

		PROCEDURE AddPathComp (VAR rd: Reader);
		BEGIN
			IF h # NIL THEN AddBaseId(h, extId, rd.nextTypeId) END;
			AddType(rd.tDict, rd.tHead, rd.nextTypeId, path[i]);
			h := rd.tHead; extId := rd.nextTypeId
		END AddPathComp;

	BEGIN
		h := NIL; i := 0; rd.ReadSChar(kind);
		WHILE kind = newExt DO
			rd.ReadXString(path[i]);
			AddPathComp(rd); INC(rd.nextTypeId);
			IF path[i] # elemTName THEN INC(i) END;
			rd.ReadSChar(kind)
		END;
		IF kind = newBase THEN
			rd.ReadXString(path[i]);
			AddPathComp(rd); INC(rd.nextTypeId); INC(i)
		ELSE
			ASSERT(kind = oldType, 100);
			rd.ReadInt(id);
			IF h # NIL THEN AddBaseId(h, extId, id) END;
			REPEAT
				GetThisType(rd.tDict, id, path[i]); id := ThisBaseId(rd.tDict, id);
				IF path[i] # elemTName THEN INC(i) END
			UNTIL id = -1
		END;
		path[i] := ""
	END ReadPath;

	PROCEDURE WritePath (VAR wr: Writer; VAR path: TypePath);
		VAR h: TypeDict; id, extId: INTEGER; i, n: INTEGER;
	BEGIN
		h := NIL;
		n := 0; WHILE path[n] # "" DO INC(n) END;
		i := 0;
		WHILE i < n DO
			id := ThisId(wr.tDict, path[i]);
			IF id >= 0 THEN
				IF h # NIL THEN AddBaseId(h, extId, id) END;
				wr.WriteSChar(oldType); wr.WriteInt(id); n := i
			ELSE
				IF i + 1 < n THEN wr.WriteSChar(newExt) ELSE wr.WriteSChar(newBase) END;
				wr.WriteXString(path[i]);
				IF h # NIL THEN AddBaseId(h, extId, wr.nextTypeId) END;
				AddType(wr.tDict, wr.tHead, wr.nextTypeId, path[i]);
				h := wr.tHead; extId := wr.nextTypeId;
				INC(wr.nextTypeId);
				IF path[i] = modelTName THEN	
					id := ThisId(wr.tDict, elemTName); ASSERT(id < 0, 100); ASSERT(i + 2 = n, 101);
					wr.WriteSChar(newExt); wr.WriteXString(elemTName);
					IF h # NIL THEN AddBaseId(h, extId, wr.nextTypeId) END;
					AddType(wr.tDict, wr.tHead, wr.nextTypeId, elemTName);
					h := wr.tHead; extId := wr.nextTypeId;
					INC(wr.nextTypeId)
				END
			END;
			INC(i)
		END
	END WritePath;

	PROCEDURE WriteType (VAR wr: Writer; t: Kernel.Type);
		VAR path: TypePath; n, i: INTEGER;
	BEGIN
		i := 0; n := Kernel.LevelOf(t);
		WHILE n >= 0 DO
			GetThisTypeName(t.base[n], path[i]);
			DEC(n); INC(i)
		END;
		path[i] := "";
		WritePath(wr, path)
	END WriteType;


	(* support for alien mapping *)

	PROCEDURE InternalizeAlien (VAR rd: Reader; VAR comps: AlienComp; down, pos, len: INTEGER);
		VAR h, p: AlienComp; piece: AlienPiece; part: AlienPart; file: Files.File;
			next, end, max: INTEGER;
	BEGIN
		file := rd.rider.Base(); max := file.Length();
		end := pos + len; h := NIL;
		IF down # 0 THEN next := down ELSE next := end END;
		WHILE pos < end DO
			ASSERT(end <= max, 100);
			IF pos < next THEN
				NEW(piece); piece.pos := pos; piece.len := next - pos;
				p := piece; pos := next
			ELSE
				ASSERT(pos = next, 101);
				rd.SetPos(next);
				NEW(part); rd.ReadStore(part.store);
				ASSERT(rd.st.end > next, 102);
				p := part; pos := rd.st.end;
				IF rd.st.next > 0 THEN
					ASSERT(rd.st.next > next, 103); next := rd.st.next
				ELSE next := end
				END
			END;
			IF h = NIL THEN comps := p ELSE h.next := p END;
			h := p
		END;
		ASSERT(pos = end, 104);
		rd.SetPos(end)
	END InternalizeAlien;

	PROCEDURE ExternalizePiece (VAR wr: Writer; file: Files.File; p: AlienPiece);
		VAR r: Files.Reader; w: Files.Writer; b: BYTE; l, len: INTEGER;
	BEGIN
		l := file.Length(); len := p.len;
		ASSERT(0 <= p.pos, 100); ASSERT(p.pos <= l, 101);
		ASSERT(0 <= len, 102); ASSERT(len <= l - p.pos, 103);
		r := file.NewReader(NIL); r.SetPos(p.pos);
		w := wr.rider;
		WHILE len # 0 DO r.ReadByte(b); w.WriteByte(b); DEC(len) END
	END ExternalizePiece;

	PROCEDURE ExternalizeAlien (VAR wr: Writer; file: Files.File; comps: AlienComp);
		VAR p: AlienComp;
	BEGIN
		p := comps;
		WHILE p # NIL DO
			WITH p: AlienPiece DO
				ExternalizePiece(wr, file, p)
			| p: AlienPart DO
				wr.WriteStore(p.store)
			END;
			p := p.next
		END
	END ExternalizeAlien;


	(** Reader **)

	PROCEDURE (VAR rd: Reader) ConnectTo* (f: Files.File), NEW;
	(** pre: rd.rider = NIL  OR  f = NIL **)
	BEGIN
		IF f = NIL THEN
			rd.rider := NIL
		ELSE
			ASSERT(rd.rider = NIL, 20);
			rd.rider := f.NewReader(rd.rider); rd.SetPos(0);
			InitTypeDict(rd.tDict, rd.tHead, rd.nextTypeId);
			InitStoreDict(rd.eDict, rd.eHead, rd.nextElemId);
			InitStoreDict(rd.sDict, rd.sHead, rd.nextStoreId);
			rd.noDomain := TRUE
		END;
		rd.readAlien := FALSE
	END ConnectTo;

	PROCEDURE (VAR rd: Reader) SetPos* (pos: INTEGER), NEW;
	BEGIN
		rd.rider.SetPos(pos)
	END SetPos;

	PROCEDURE (VAR rd: Reader) Pos* (): INTEGER, NEW;
	BEGIN
		RETURN rd.rider.Pos()
	END Pos;

	PROCEDURE (VAR rd: Reader) ReadBool* (OUT x: BOOLEAN), NEW;
		VAR b: BYTE;
	BEGIN
		rd.rider.ReadByte(b); x := b # 0
	END ReadBool;

	PROCEDURE (VAR rd: Reader) ReadSChar* (OUT x: SHORTCHAR), NEW;
	BEGIN
		rd.rider.ReadByte(SYSTEM.VAL(BYTE, x))
	END ReadSChar;

	PROCEDURE (VAR rd: Reader) ReadXChar* (OUT x: CHAR), NEW;
		VAR c: SHORTCHAR;
	BEGIN
		rd.rider.ReadByte(SYSTEM.VAL(BYTE,c)); x := c
	END ReadXChar;

	PROCEDURE (VAR rd: Reader) ReadChar* (OUT x: CHAR), NEW;
		VAR le: ARRAY 2 OF BYTE;	(* little endian, big endian *)
	BEGIN
		rd.rider.ReadBytes(le, 0, 2);
		x := CHR(le[0] MOD 256 + (le[1] MOD 256) * 256)
	END ReadChar;

	PROCEDURE (VAR rd: Reader) ReadByte* (OUT x: BYTE), NEW;
	BEGIN
		rd.rider.ReadByte(x)
	END ReadByte;

	PROCEDURE (VAR rd: Reader) ReadSInt* (OUT x: SHORTINT), NEW;
		VAR le, be: ARRAY 2 OF BYTE;	(* little endian, big endian *)
	BEGIN
		rd.rider.ReadBytes(le, 0, 2);
		IF Kernel.littleEndian THEN
			x := SYSTEM.VAL(SHORTINT, le)
		ELSE
			be[0] := le[1]; be[1] := le[0];
			x := SYSTEM.VAL(SHORTINT, be)
		END
	END ReadSInt;

	PROCEDURE (VAR rd: Reader) ReadXInt* (OUT x: INTEGER), NEW;
		VAR le, be: ARRAY 2 OF BYTE;	(* little endian, big endian *)
	BEGIN
		rd.rider.ReadBytes(le, 0, 2);
		IF Kernel.littleEndian THEN
			x := SYSTEM.VAL(SHORTINT, le)
		ELSE
			be[0] := le[1]; be[1] := le[0];
			x := SYSTEM.VAL(SHORTINT, be)
		END
	END ReadXInt;

	PROCEDURE (VAR rd: Reader) ReadInt* (OUT x: INTEGER), NEW;
		VAR le, be: ARRAY 4 OF BYTE;	(* little endian, big endian *)
	BEGIN
		rd.rider.ReadBytes(le, 0, 4);
		IF Kernel.littleEndian THEN
			x := SYSTEM.VAL(INTEGER, le)
		ELSE
			be[0] := le[3]; be[1] := le[2]; be[2] := le[1]; be[3] := le[0];
			x := SYSTEM.VAL(INTEGER, be)
		END
	END ReadInt;

	PROCEDURE (VAR rd: Reader) ReadLong* (OUT x: LONGINT), NEW;
		VAR le, be: ARRAY 8 OF BYTE;	(* little endian, big endian *)
	BEGIN
		rd.rider.ReadBytes(le, 0, 8);
		IF Kernel.littleEndian THEN
			x := SYSTEM.VAL(LONGINT, le)
		ELSE
			be[0] := le[7]; be[1] := le[6]; be[2] := le[5]; be[3] := le[4];
			be[4] := le[3]; be[5] := le[2]; be[6] := le[1]; be[7] := le[0];
			x := SYSTEM.VAL(LONGINT, be)
		END
	END ReadLong;

	PROCEDURE (VAR rd: Reader) ReadSReal* (OUT x: SHORTREAL), NEW;
		VAR le, be: ARRAY 4 OF BYTE;	(* little endian, big endian *)
	BEGIN
		rd.rider.ReadBytes(le, 0, 4);
		IF Kernel.littleEndian THEN
			x := SYSTEM.VAL(SHORTREAL, le)
		ELSE
			be[0] := le[3]; be[1] := le[2]; be[2] := le[1]; be[3] := le[0];
			x := SYSTEM.VAL(SHORTREAL, be)
		END
	END ReadSReal;

	PROCEDURE (VAR rd: Reader) ReadXReal* (OUT x: REAL), NEW;
		VAR le, be: ARRAY 4 OF BYTE;	(* little endian, big endian *)
	BEGIN
		rd.rider.ReadBytes(le, 0, 4);
		IF Kernel.littleEndian THEN
			x := SYSTEM.VAL(SHORTREAL, le)
		ELSE
			be[0] := le[3]; be[1] := le[2]; be[2] := le[1]; be[3] := le[0];
			x := SYSTEM.VAL(SHORTREAL, be)
		END
	END ReadXReal;

	PROCEDURE (VAR rd: Reader) ReadReal* (OUT x: REAL), NEW;
		VAR le, be: ARRAY 8 OF BYTE;	(* little endian, big endian *)
	BEGIN
		rd.rider.ReadBytes(le, 0, 8);
		IF Kernel.littleEndian THEN
			x := SYSTEM.VAL(REAL, le)
		ELSE
			be[0] := le[7]; be[1] := le[6]; be[2] := le[5]; be[3] := le[4];
			be[4] := le[3]; be[5] := le[2]; be[6] := le[1]; be[7] := le[0];
			x := SYSTEM.VAL(REAL, be)
		END
	END ReadReal;

	PROCEDURE (VAR rd: Reader) ReadSet* (OUT x: SET), NEW;
		VAR le, be: ARRAY 4 OF BYTE;	(* little endian, big endian *)
	BEGIN
		rd.rider.ReadBytes(le, 0, 4);
		IF Kernel.littleEndian THEN
			x := SYSTEM.VAL(SET, le)
		ELSE
			be[0] := le[3]; be[1] := le[2]; be[2] := le[1]; be[3] := le[0];
			x := SYSTEM.VAL(SET, be)
		END
	END ReadSet;

	PROCEDURE (VAR rd: Reader) ReadSString* (OUT x: ARRAY OF SHORTCHAR), NEW;
		VAR i: INTEGER; ch: SHORTCHAR;
	BEGIN
		i := 0; REPEAT rd.ReadSChar(ch); x[i] := ch; INC(i) UNTIL ch = 0X
	END ReadSString;

	PROCEDURE (VAR rd: Reader) ReadXString* (OUT x: ARRAY OF CHAR), NEW;
		VAR i: INTEGER; ch: CHAR;
	BEGIN
		i := 0; REPEAT rd.ReadXChar(ch); x[i] := ch; INC(i) UNTIL ch = 0X
	END ReadXString;

	PROCEDURE (VAR rd: Reader) ReadString* (OUT x: ARRAY OF CHAR), NEW;
		VAR i: INTEGER; ch: CHAR;
	BEGIN
		i := 0; REPEAT rd.ReadChar(ch); x[i] := ch; INC(i) UNTIL ch = 0X
	END ReadString;

	PROCEDURE AlienReport (cause: INTEGER);
		VAR s, e: ARRAY 32 OF CHAR;
	BEGIN
		CASE cause OF
		| alienVersion: s := "#System:AlienVersion"
		| alienComponent: s := "#System:AlienComponent"
		| inconsistentVersion: s := "#System:InconsistentVersion"
		ELSE s := "#System:UnknownCause"
		END;
		Strings.IntToString(cause, e);
		Report("#System:AlienCause ^0 ^1 ^2", s, e, "")
	END AlienReport;

	PROCEDURE AlienTypeReport (cause: INTEGER; t: ARRAY OF CHAR);
		VAR s: ARRAY 64 OF CHAR; 
	BEGIN
		CASE cause OF
		| inconsistentType: s := "#System:InconsistentType ^0"
		| moduleFileNotFound: s := "#System:CodeFileNotFound ^0"
		| invalidModuleFile: s := "#System:InvalidCodeFile ^0"
		| inconsModuleVersion: s := "#System:InconsistentModuleVersion ^0"
		| typeNotFound: s := "#System:TypeNotFound ^0"
		END;
		Report(s, t, "", "")
	END AlienTypeReport;

	PROCEDURE (VAR rd: Reader) TurnIntoAlien* (cause: INTEGER), NEW;
	BEGIN
		ASSERT(cause > 0, 20);
		rd.cancelled := TRUE; rd.readAlien := TRUE; rd.cause := cause;
		AlienReport(cause)
	END TurnIntoAlien;

	PROCEDURE (VAR rd: Reader) ReadVersion* (min, max: INTEGER; OUT version: INTEGER), NEW;
		VAR v: BYTE;
	BEGIN
		rd.ReadByte(v); version := v;
		IF (version < min) OR (version > max) THEN
			rd.TurnIntoAlien(alienVersion)
		END
	END ReadVersion;

	PROCEDURE (VAR rd: Reader) ReadStore* (OUT x: Store), NEW;
		VAR a: Alien; t: Kernel.Type;
			len, pos, pos1, id, comment, next, down, downPos, nextTypeId, nextElemId, nextStoreId: INTEGER;
			kind: SHORTCHAR; path: TypePath; type: TypeName;
			save: ReaderState;
	BEGIN
		rd.ReadSChar(kind);
		IF kind = nil THEN
			rd.ReadInt(comment); rd.ReadInt(next);
			rd.st.end := rd.Pos();
			IF (next > 0) OR ((next = 0) & ODD(comment)) THEN rd.st.next := rd.st.end + next ELSE rd.st.next := 0 END;
			x := NIL
		ELSIF kind = link THEN
			rd.ReadInt(id); rd.ReadInt(comment); rd.ReadInt(next);
			rd.st.end := rd.Pos();
			IF (next > 0) OR ((next = 0) & ODD(comment)) THEN rd.st.next := rd.st.end + next ELSE rd.st.next := 0 END;
			x := ThisStore(rd.eDict, id)
		ELSIF kind = newlink THEN
			rd.ReadInt(id); rd.ReadInt(comment); rd.ReadInt(next);
			rd.st.end := rd.Pos();
			IF (next > 0) OR ((next = 0) & ODD(comment)) THEN rd.st.next := rd.st.end + next ELSE rd.st.next := 0 END;
			x := ThisStore(rd.sDict, id)
		ELSIF (kind = store) OR (kind = elem) THEN
			IF kind = elem THEN
				id := rd.nextElemId; INC(rd.nextElemId)
			ELSE
				id := rd.nextStoreId; INC(rd.nextStoreId)
			END;
			ReadPath(rd, path); type := path[0];
			nextTypeId := rd.nextTypeId; nextElemId := rd.nextElemId; nextStoreId := rd.nextStoreId;
			rd.ReadInt(comment);
			pos1 := rd.Pos();
			rd.ReadInt(next); rd.ReadInt(down); rd.ReadInt(len);
			pos := rd.Pos();
			IF next > 0 THEN rd.st.next := pos1 + next + 4 ELSE rd.st.next := 0 END;
			IF down > 0 THEN downPos := pos1 + down + 8 ELSE downPos := 0 END;
			rd.st.end := pos + len;
			rd.cause := 0;
			ASSERT(len >= 0, 101);
			IF next # 0 THEN
				ASSERT(rd.st.next > pos1, 102);
				IF down # 0 THEN
					ASSERT(downPos < rd.st.next, 103)
				END
			END;
			IF down # 0 THEN
				ASSERT(downPos > pos1, 104);
				ASSERT(downPos < rd.st.end, 105)
			END;
			t := ThisType(type);
			IF t # NIL THEN
				x := NewStore(t); x.isElem := kind = elem
			ELSE
				rd.cause := thisTypeRes; AlienTypeReport(rd.cause, type);
				x := NIL
			END;
			IF x # NIL THEN
				IF SamePath(t, path) THEN
					IF kind = elem THEN
						x.id := id; AddStore(rd.eDict, rd.eHead, x)
					ELSE
						x.id := id; AddStore(rd.sDict, rd.sHead, x)
					END;
					save := rd.st; rd.cause := 0; rd.cancelled :=  FALSE;
					x.Internalize(rd);
					rd.st := save;
					IF rd.cause # 0 THEN x := NIL
					ELSIF (rd.Pos() # rd.st.end) OR rd.rider.eof THEN
						rd.cause := inconsistentVersion; AlienReport(rd.cause);
						x := NIL
					END
				ELSE
					rd.cause := inconsistentType; AlienTypeReport(rd.cause, type);
					x := NIL
				END
			END;
			
			IF x # NIL THEN
				IF rd.noDomain THEN
					rd.store := x;
					rd.noDomain := FALSE
				ELSE
					Join(rd.store, x)
				END
			ELSE	(* x is an alien *)
				rd.SetPos(pos);
				ASSERT(rd.cause # 0, 107);
				NEW(a); a.path := path; a.cause := rd.cause; a.file := rd.rider.Base();
				IF rd.noDomain THEN
					rd.store := a;
					rd.noDomain := FALSE
				ELSE
					Join(rd.store, a)
				END;
				IF kind = elem THEN
					a.id := id; AddStore(rd.eDict, rd.eHead, a)
				ELSE
					a.id := id; AddStore(rd.sDict, rd.sHead, a)
				END;
				save := rd.st;
				rd.nextTypeId := nextTypeId; rd.nextElemId := nextElemId; rd.nextStoreId := nextStoreId;
				InternalizeAlien(rd, a.comps, downPos, pos, len);
				rd.st := save;
				x := a;
				ASSERT(rd.Pos() = rd.st.end, 108);
				rd.cause := 0; rd.cancelled :=  FALSE; rd.readAlien := TRUE
			END
		ELSE
			pos := rd.Pos();
			HALT(20)
		END
	END ReadStore;


	(** Writer **)

	PROCEDURE (VAR wr: Writer) ConnectTo* (f: Files.File), NEW;
	(** pre: wr.rider = NIL  OR  f = NIL **)
	BEGIN
		IF f = NIL THEN
			wr.rider := NIL
		ELSE
			ASSERT(wr.rider = NIL, 20);
			wr.rider := f.NewWriter(wr.rider); wr.SetPos(f.Length());
			wr.era := nextEra; INC(nextEra);
			wr.noDomain := TRUE;
			wr.modelType := ThisType(modelTName);
			InitTypeDict(wr.tDict, wr.tHead, wr.nextTypeId);
			wr.nextElemId := 0; wr.nextStoreId := 0;
			wr.st.linkpos := -1
		END;
		wr.writtenStore := NIL
	END ConnectTo;

	PROCEDURE (VAR wr: Writer) SetPos* (pos: INTEGER), NEW;
	BEGIN
		wr.rider.SetPos(pos)
	END SetPos;

	PROCEDURE (VAR wr: Writer) Pos* (): INTEGER, NEW;
	BEGIN
		RETURN wr.rider.Pos()
	END Pos;

	PROCEDURE (VAR wr: Writer) WriteBool* (x: BOOLEAN), NEW;
	BEGIN
		IF x THEN wr.rider.WriteByte(1) ELSE wr.rider.WriteByte(0) END
	END WriteBool;

	PROCEDURE (VAR wr: Writer) WriteSChar* (x: SHORTCHAR), NEW;
	BEGIN
		wr.rider.WriteByte(SYSTEM.VAL(BYTE, x))
	END WriteSChar;

	PROCEDURE (VAR wr: Writer) WriteXChar* (x: CHAR), NEW;
		VAR c: SHORTCHAR;
	BEGIN
		c := SHORT(x); wr.rider.WriteByte(SYSTEM.VAL(BYTE, c))
	END WriteXChar;

	PROCEDURE (VAR wr: Writer) WriteChar* (x: CHAR), NEW;
		TYPE a = ARRAY 2 OF BYTE;
		VAR le, be: a;	(* little endian, big endian *)
	BEGIN
		IF Kernel.littleEndian THEN
			le := SYSTEM.VAL(a, x)
		ELSE
			be := SYSTEM.VAL(a, x);
			le[0] := be[1]; le[1] := be[0]
		END;
		wr.rider.WriteBytes(le, 0, 2)
	END WriteChar;

	PROCEDURE (VAR wr: Writer) WriteByte* (x: BYTE), NEW;
	BEGIN
		wr.rider.WriteByte(x)
	END WriteByte;

	PROCEDURE (VAR wr: Writer) WriteSInt* (x: SHORTINT), NEW;
		TYPE a = ARRAY 2 OF BYTE;
		VAR le, be: a;	(* little endian, big endian *)
	BEGIN
		IF Kernel.littleEndian THEN
			le := SYSTEM.VAL(a, x)
		ELSE
			be := SYSTEM.VAL(a, x);
			le[0] := be[1]; le[1] := be[0]
		END;
		wr.rider.WriteBytes(le, 0, 2)
	END WriteSInt;

	PROCEDURE (VAR wr: Writer) WriteXInt* (x: INTEGER), NEW;
		TYPE a = ARRAY 2 OF BYTE;
		VAR y: SHORTINT; le, be: a;	(* little endian, big endian *)
	BEGIN
		y := SHORT(x);
		IF Kernel.littleEndian THEN
			le := SYSTEM.VAL(a, y)
		ELSE
			be := SYSTEM.VAL(a, y);
			le[0] := be[1]; le[1] := be[0]
		END;
		wr.rider.WriteBytes(le, 0, 2)
	END WriteXInt;

	PROCEDURE (VAR wr: Writer) WriteInt* (x: INTEGER), NEW;
		TYPE a = ARRAY 4 OF BYTE;
		VAR le, be: a;	(* little endian, big endian *)
	BEGIN
		IF Kernel.littleEndian THEN
			le := SYSTEM.VAL(a, x)
		ELSE
			be := SYSTEM.VAL(a, x);
			le[0] := be[3]; le[1] := be[2]; le[2] := be[1]; le[3] := be[0]
		END;
		wr.rider.WriteBytes(le, 0, 4)
	END WriteInt;

	PROCEDURE (VAR wr: Writer) WriteLong* (x: LONGINT), NEW;
		TYPE a = ARRAY 8 OF BYTE;
		VAR le, be: a;	(* little endian, big endian *)
	BEGIN
		IF Kernel.littleEndian THEN
			le := SYSTEM.VAL(a, x)
		ELSE
			be := SYSTEM.VAL(a, x);
			le[0] := be[7]; le[1] := be[6]; le[2] := be[5]; le[3] := be[4];
			le[4] := be[3]; le[5] := be[2]; le[6] := be[1]; le[7] := be[0]
		END;
		wr.rider.WriteBytes(le, 0, 8)
	END WriteLong;

	PROCEDURE (VAR wr: Writer) WriteSReal* (x: SHORTREAL), NEW;
		TYPE a = ARRAY 4 OF BYTE;
		VAR le, be: a;	(* little endian, big endian *)
	BEGIN
		IF Kernel.littleEndian THEN
			le := SYSTEM.VAL(a, x)
		ELSE
			be := SYSTEM.VAL(a, x);
			le[0] := be[3]; le[1] := be[2]; le[2] := be[1]; le[3] := be[0]
		END;
		wr.rider.WriteBytes(le, 0, 4)
	END WriteSReal;

	PROCEDURE (VAR wr: Writer) WriteXReal* (x: REAL), NEW;
		TYPE a = ARRAY 4 OF BYTE;
		VAR y: SHORTREAL; le, be: a;	(* little endian, big endian *)
	BEGIN
		y := SHORT(x);
		IF Kernel.littleEndian THEN
			le := SYSTEM.VAL(a, y)
		ELSE
			be := SYSTEM.VAL(a, y);
			le[0] := be[3]; le[1] := be[2]; le[2] := be[1]; le[3] := be[0]
		END;
		wr.rider.WriteBytes(le, 0, 4)
	END WriteXReal;

	PROCEDURE (VAR wr: Writer) WriteReal* (x: REAL), NEW;
		TYPE a = ARRAY 8 OF BYTE;
		VAR le, be: a;	(* little endian, big endian *)
	BEGIN
		IF Kernel.littleEndian THEN
			le := SYSTEM.VAL(a, x)
		ELSE
			be := SYSTEM.VAL(a, x);
			le[0] := be[7]; le[1] := be[6]; le[2] := be[5]; le[3] := be[4];
			le[4] := be[3]; le[5] := be[2]; le[6] := be[1]; le[7] := be[0]
		END;
		wr.rider.WriteBytes(le, 0, 8)
	END WriteReal;

	PROCEDURE (VAR wr: Writer) WriteSet* (x: SET), NEW;
		(* SIZE(SET) = 4 *)
		TYPE a = ARRAY 4 OF BYTE;
		VAR le, be: a;	(* little endian, big endian *)
	BEGIN
		IF Kernel.littleEndian THEN
			le := SYSTEM.VAL(a, x)
		ELSE
			be := SYSTEM.VAL(a, x);
			le[0] := be[3]; le[1] := be[2]; le[2] := be[1]; le[3] := be[0]
		END;
		wr.rider.WriteBytes(le, 0, 4)
	END WriteSet;

	PROCEDURE (VAR wr: Writer) WriteSString* (IN x: ARRAY OF SHORTCHAR), NEW;
		VAR i: INTEGER; ch: SHORTCHAR;
	BEGIN
		i := 0; ch := x[0]; WHILE ch # 0X DO wr.WriteSChar(ch); INC(i); ch := x[i] END;
		wr.WriteSChar(0X)
	END WriteSString;

	PROCEDURE (VAR wr: Writer) WriteXString* (IN x: ARRAY OF CHAR), NEW;
		VAR i: INTEGER; ch: CHAR;
	BEGIN
		i := 0; ch := x[0]; WHILE ch # 0X DO wr.WriteXChar(ch); INC(i); ch := x[i] END;
		wr.WriteSChar(0X)
	END WriteXString;

	PROCEDURE (VAR wr: Writer) WriteString* (IN x: ARRAY OF CHAR), NEW;
		VAR i: INTEGER; ch: CHAR;
	BEGIN
		i := 0; ch := x[0]; WHILE ch # 0X DO wr.WriteChar(ch); INC(i); ch := x[i] END;
		wr.WriteChar(0X)
	END WriteString;

	PROCEDURE (VAR wr: Writer) WriteVersion* (version: INTEGER), NEW;
	BEGIN
		wr.WriteByte(SHORT(SHORT(version)))
	END WriteVersion;

	PROCEDURE (VAR wr: Writer) WriteStore* (x: Store), NEW;
		VAR t: Kernel.Type; pos1, pos2, pos: INTEGER;
			save: WriterState;
	BEGIN
		ASSERT(wr.rider # NIL, 20);
		IF x # NIL THEN
			IF wr.noDomain THEN
				wr.domain := x.Domain(); wr.noDomain := FALSE
			ELSE ASSERT(x.Domain() = wr.domain, 21)
			END;
			x.ExternalizeAs(x); IF x = NIL THEN wr.writtenStore := NIL; RETURN END
		END;
		IF wr.st.linkpos > 0 THEN	(* link to previous block's <next> or up block's <down> *)
			pos := wr.Pos();
			IF pos - wr.st.linkpos = 4 THEN
				(* hack to resolve ambiguity between next = 0 because of end-of-chain, or because of offset = 0.
					above guard holds only if for the latter case.
					ASSUMPTION:
						this can happen only if linkpos points to a next (not a down)
						and there is a comment byte just before
				*)
				wr.SetPos(wr.st.linkpos - 4); wr.WriteInt(1); wr.WriteInt(pos - wr.st.linkpos - 4)
			ELSE
				wr.SetPos(wr.st.linkpos); wr.WriteInt(pos - wr.st.linkpos - 4)
			END;
			wr.SetPos(pos)
		END;
		IF x = NIL THEN
			wr.WriteSChar(nil);
			wr.WriteInt(0);	(* <comment> *)
			wr.st.linkpos := wr.Pos();
			wr.WriteInt(0)	(* <next> *)
		ELSIF x.era >= wr.era THEN
			ASSERT(x.era = wr.era, 23);
			IF x.isElem THEN wr.WriteSChar(link) ELSE wr.WriteSChar(newlink) END;
			wr.WriteInt(x.id);
			wr.WriteInt(0);	(* <comment> *)
			wr.st.linkpos := wr.Pos();
			wr.WriteInt(0)	(* <next> *)
		ELSE
			x.era := wr.era;
			WITH x: Alien DO
				IF x.isElem THEN
					wr.WriteSChar(elem); x.id := wr.nextElemId; INC(wr.nextElemId)
				ELSE
					wr.WriteSChar(store); x.id := wr.nextStoreId; INC(wr.nextStoreId)
				END;
				WritePath(wr, x.path)
			ELSE
				t := Kernel.TypeOf(x);
				x.isElem := t.base[1] = wr.modelType;
				IF x.isElem THEN
					wr.WriteSChar(elem); x.id := wr.nextElemId; INC(wr.nextElemId)
				ELSE
					wr.WriteSChar(store); x.id := wr.nextStoreId; INC(wr.nextStoreId)
				END;
				WriteType(wr, t)
			END;
			wr.WriteInt(0);	(* <comment> *)
			pos1 := wr.Pos(); wr.WriteInt(0); wr.WriteInt(0);	(* <next>, <down> *)
			pos2 := wr.Pos(); wr.WriteInt(0);	(* <len> *)
			save := wr.st;	(* push current writer state; switch to structured *)
			wr.st.linkpos := pos1 + 4;
			WITH x: Alien DO ExternalizeAlien(wr, x.file, x.comps)
			ELSE 
				x.Externalize(wr)
			END;
			wr.st := save;	(* pop writer state *)
			wr.st.linkpos := pos1;
			pos := wr.Pos();
			wr.SetPos(pos2); wr.WriteInt(pos - pos2 - 4);	(* patch <len> *)
			wr.SetPos(pos)
		END;
		wr.writtenStore := x
	END WriteStore;


	(** miscellaneous **)

	PROCEDURE Report* (IN msg, p0, p1, p2: ARRAY OF CHAR);
	BEGIN
		IF logReports THEN
			Dialog.ShowParamMsg(msg, p0, p1, p2)
		END
	END Report;

	PROCEDURE BeginCloning (d: Domain);
	BEGIN
		ASSERT(d # NIL, 20);
		INC(d.level);
		IF d.level = 1 THEN
			d.copyera := nextEra; INC(nextEra); d.nextElemId := 0;
			IF d.cleaner = NIL THEN NEW(d.cleaner); d.cleaner.d := d END;
			Kernel.PushTrapCleaner(d.cleaner)
		END
	END BeginCloning;
	
	PROCEDURE EndCloning (d: Domain);
	BEGIN
		ASSERT(d # NIL, 20);
		DEC(d.level);
		IF d.level = 0 THEN 
			d.sDict := NIL;
			Kernel.PopTrapCleaner(d.cleaner);
			d.s := NIL
		END
	END EndCloning;

	PROCEDURE CopyOf* (s: Store): Store;
		VAR h: Store; c: StoreDict; d: Domain; k, org: INTEGER;
	BEGIN
		ASSERT(s # NIL, 20);
		
		d := DomainOf(s);
		IF d = NIL THEN d := NewDomain(anonymousDomain); s.dlink := d; d.copyDomain := TRUE END;

		BeginCloning(d);
		IF s.era >= d.copyera THEN	(* s has already been copied *)
			ASSERT(s.era = d.copyera, 21);
			k := s.id MOD dictLineLen; org := s.id - k;
			c := d.sDict;
			WHILE (c # NIL) & (c.org # org) DO c := c.next END;
			ASSERT((c # NIL) & (c.elem[k] # NIL), 100);
			h := c.elem[k]
		ELSE
			s.era := d.copyera;
			s.id := d.nextElemId; INC(d.nextElemId);
			Kernel.NewObj(h, Kernel.TypeOf(s));
			k := s.id MOD dictLineLen;
			IF k = 0 THEN NEW(c); c.org := s.id; c.next := d.sDict; d.sDict := c 
			ELSE c := d.sDict
			END;
			ASSERT((c # NIL) & (c.org = s.id - k) & (c.elem[k] = NIL), 101);
			c.elem[k] := h;
			IF d.s = NIL THEN d.s := h ELSE Join(h, d.s) END;
			h.CopyFrom(s)
		END;
		EndCloning(d);
		RETURN h
	END CopyOf;
	
	PROCEDURE ExternalizeProxy* (s: Store): Store;
	BEGIN
		IF s # NIL THEN s.ExternalizeAs(s) END;
		RETURN s
	END ExternalizeProxy;
	
	PROCEDURE InitDomain* (s: Store);
		VAR d: Domain;
	BEGIN
		ASSERT(s # NIL, 20);
		d := DomainOf(s);
		IF d = NIL THEN d := NewDomain(inited); s.dlink := d
		ELSE d.initialized := TRUE
		END			
	END InitDomain;
	
	PROCEDURE Join* (s0, s1: Store);
		VAR d0, d1: Domain;
	BEGIN
		ASSERT(s0 # NIL, 20); ASSERT(s1 # NIL, 21);
		d0 := DomainOf(s0); d1 := DomainOf(s1);
		IF (d0 = NIL) & (d1 = NIL) THEN
			s0.dlink := NewDomain(anonymousDomain); s1.dlink := s0.dlink
		ELSIF d0 = NIL THEN
			s0.dlink := d1; d1.copyDomain := FALSE
		ELSIF d1 = NIL THEN
			s1.dlink := d0; d0.copyDomain := FALSE
		ELSIF d0 # d1 THEN
			ASSERT(~d0.initialized OR ~d1.initialized, 22);
				(* PRE 22	s0.Domain() = NIL OR s1.Domain() = NIL OR s0.Domain() = s1.Domain() *)
			IF ~d0.initialized & (d0.level = 0) THEN d0.dlink := d1; d1.copyDomain := FALSE
			ELSIF ~d1.initialized & (d1.level = 0) THEN d1.dlink := d0; d0.copyDomain := FALSE
			ELSE HALT(100)
			END
		END
	END Join;
	
	PROCEDURE Joined* (s0, s1: Store): BOOLEAN;
		VAR d0, d1: Domain;
	BEGIN
		ASSERT(s0 # NIL, 20); ASSERT(s1 # NIL, 21);
		d0 := DomainOf(s0); d1 := DomainOf(s1);
		RETURN (s0 = s1) OR ((d0 = d1) & (d0 # NIL))
	END Joined;

	PROCEDURE Unattached* (s: Store): BOOLEAN;
	BEGIN
		ASSERT(s # NIL, 20);
		RETURN  (s.dlink = NIL) OR s.dlink.copyDomain
	END Unattached;

BEGIN
	nextEra := 1; logReports := FALSE
END Stores.