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 or up block's *) 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); (* *) wr.st.linkpos := wr.Pos(); wr.WriteInt(0) (* *) 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); (* *) wr.st.linkpos := wr.Pos(); wr.WriteInt(0) (* *) 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); (* *) pos1 := wr.Pos(); wr.WriteInt(0); wr.WriteInt(0); (* , *) pos2 := wr.Pos(); wr.WriteInt(0); (* *) 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 *) 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.