This module implements Pickles. See the interface for documentation

UNSAFE MODULE Pickle;

IMPORT BuiltinSpecials, Rd, RT0, RTAllocator, RTCollector, RTHeap;
IMPORT RTHeapRep, RTType, RTTypeFP, RTTypeMap, Thread, Word, Wr, Fingerprint;

Pickle:: Header Value Trailer Header:: Header1 - verify it's a pickle Header2 - verify it's a pickle Version - version of this syntax CharRep - character encoding Endian - byte order IntSize - size of an INTEGER RealRep - format of REAL and such CharRep:: CharRepISOLatin1 Endian:: LittleEndian | BigEndian IntSize:: IntSize16 | IntSize32 | IntSize64 RealRep:: RealRepNative Value:: '0' - r=NIL '1' 4-byte-integer - pickle-relative index of r (0 based) '2' 8-bytes - COMPATIBILITY, old fingerprint '3' scInt acInt Contents - COMPATIBILITY, old value - '4' is not used, but occurs in Trailer as blunder check. '5' sc Contents - an actual value FingerPrint:: bytes - 8 bytes, details t.b.d. sc:: LocalCode - typecode of Special writing the value Contents:: ( bytes | Value )* - Special.write output Trailer:: Trailer1 Trailer2 - verify the parse was OK

- Note that LocalCode may occur within the bytes written by a special. E.g. the root special does this to record the allocated type of the value. It is written by WriteType and parsed by ReadType.

LocalCode:: 0 8-bytes | - first occurence of a fingerprint. [1..254] | - subsequent occurrence, n IN [1..254]. 255 4-byte-integer - subsequent occurence, other cases.

CONST
  Header1 = '&';
  Header2 = '%';
  Version = '2';                       (* current syntax *)
  OldVersion = '1';                    (* old FP and ac syntax *)
  CharRepISOLatin1 = 'I';              (* 8-bit ISO Latin 1 *)
  LittleEndian = 'L';                  (* l.s. byte first *)
  BigEndian = 'B';                     (* m.s. byte first *)
  IntSize16 = '4';                     (* 16 bit INTEGER *)
  IntSize32 = '5';                     (* 32 bit INTEGER *)
  IntSize64 = '6';                     (* 64 bit INTEGER *)
  RealRepNative = 'N';                 (* whatever the writing
                                          host used *)
  Trailer1 = '4';                      (* # main cases *)
  Trailer2 = '\n';                     (* keeps editors happy *)

TYPE
  RefTable = REF ARRAY OF RECORD
      (* hash table keyed by REFANY, yields index in pickle *)
      r: REFANY := NIL;        (* the Ref *)
      index: INTEGER := 0;     (* pickle-relative index of this
                                  ref, 0-based *)
      nextUsed: INTEGER := 0;  (* index in this table of next
                                  used entry *)
    END;
  RefArray = REF ARRAY OF REFANY;
    (* array indexed by index in pickle, yields REFANY *)
  TypeTable = REF ARRAY OF INTEGER;
    (* indexed by RTType.TypeCode, yields pickle-relative typecode *)
    (* Or indexed by pickle-relative typecode, yields RTTypes.TypeCode *)

REVEAL
  Writer = WriterPublic BRANDED "Pickle.Writer 1.0" OBJECT
      level := 0;
      refCount: INTEGER;         (* count of refs written in this pickle *)
      firstUsed: INTEGER;        (* index in "refs" of first used entry *)
      refs: RefTable := NIL;     (* hash table of refs in this pickle *)
      tcCount: INTEGER;          (* count of typecodes in this pickle *)
      tcToPkl: TypeTable := NIL; (* process TC -> pickle TC *)
      pklToTC: TypeTable := NIL; (* pickle TC -> process TC, for erasing tcToPkl *)
      nextAddr: ADDRESS;         (* Used within RootSpecialWrite *)
      collisions: INTEGER := 0;  (* Performance measure *)
      visitor: WriteVisitor := NIL;
    OVERRIDES
      write := WriteRef;
      writeType := WriteType;
      writeInt := WriteInt;
    END;

  Reader = ReaderPublic BRANDED "Pickle.Reader 1.0" OBJECT
      level := 0;
      acPending := 0;            (* COMPATIBILITY - OldVersion *)
      refCount: INTEGER;         (* count of refs read in this pickle *)
      tcCount: INTEGER;          (* count of typecodes in this pickle *)
      refs: RefArray := NIL;     (* array of refs in this pickle *)
      pklToTC: TypeTable := NIL; (* pickle TC -> process TC *)
      nextAddr: ADDRESS;         (* Used within RootSpecialWrite *)
      visitor: ReadVisitor := NIL;
    OVERRIDES
      read := ReadRef;
      readType := ReadType;
      readInt := ReadInt;
      noteRef := NoteRef;
    END;

  Special = SpecialPublic BRANDED "Pickle.Special 1.0" OBJECT
    OVERRIDES
      write := RootSpecialWrite;
      read := RootSpecialRead;
    END;

TYPE
  WriteVisitor = RTTypeMap.Visitor OBJECT
      writer: Writer := NIL;
    OVERRIDES
      apply := VisitWrite;
    END;

  ReadVisitor = RTTypeMap.Visitor OBJECT
      reader: Reader := NIL;
    OVERRIDES
      apply := VisitRead;
    END;

CONST
  RefFields = RTTypeMap.Mask { RTTypeMap.Kind.Ref,
                               RTTypeMap.Kind.UntracedRef,
                               RTTypeMap.Kind.Proc };

TYPE (* for binary I/O loopholes *)
  CharInt32 = ARRAY [0..3] OF CHAR;  (* 32 bits only *)
  CharFP    = ARRAY [0..BYTESIZE(Fingerprint.T)-1] OF CHAR;
  ToChars   = UNTRACED REF ARRAY [0..100000000] OF CHAR; (* for misc. data *)

TYPE
  HC = { h1, h2, v, c, e, i, r }; (* the chars in a pickle header *)
  HT = { t1, t2 };                (* the chars in a pickle trailer *)
  Header = ARRAY HC OF CHAR;      (* a pickle header string *)
  Trailer = ARRAY HT OF CHAR;     (* a pickle trailer string *)

CONST
  InitRefCapacity  = 99;          (* Init size of {Reader,Writer}.refs *)
  InitTypeCapacity = 99;          (* Init size of *.pklToTC *)

VAR myHeader: Header;             (* header for pickles we write *)
VAR myTrailer: Trailer;           (* trailer for pickles we write *)
VAR nullReaderRef: REF INTEGER;   (* null value for reader.refs entries *)

PROCEDURE Write(wr: Wr.T; r: REFANY)
        RAISES { Error, Wr.Failure, Thread.Alerted } =
  BEGIN
    NEW (Writer, wr := wr).write(r);
  END Write;

PROCEDURE Read(rd: Rd.T): REFANY
      RAISES { Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted } =
  BEGIN
    RETURN NEW (Reader, rd := rd).read();
  END Read;

PROCEDURE Hash(r: REFANY; table: RefTable): INTEGER =
  (* Considerations for the hash function:
        - use positive numbers
        - multiply to avoid collisions between equally
          distributed patterns
        - don't overflow 31-bit positive numbers
        - keep it efficient
        - result is in [0..LAST(table)]
  *)
  BEGIN
    RETURN ((Word.And(LOOPHOLE(r, Word.T), 16_7FFFFFFF) DIV
             65536) * (LOOPHOLE(r, Word.T) MOD 65536)
           ) MOD NUMBER(table^)
  END Hash;

PROCEDURE ExtendWriterRefs(writer: Writer) =
    (* Make writer.refs bigger *)
    VAR old := writer.refs;
    VAR oldFirst := writer.firstUsed;
    VAR h: INTEGER;
  BEGIN
    writer.firstUsed := -1;
    writer.refs := NEW(RefTable, NUMBER(writer.refs^) * 2 - 1);
    WHILE oldFirst >= 0 DO
      (* for each entry in "old" *)
      WITH oldEntry = old[oldFirst] DO
        h := Hash(oldEntry.r, writer.refs);
        LOOP
          WITH entry = writer.refs[h] DO
            IF entry.r = NIL THEN
              entry.r := oldEntry.r;
              entry.index := oldEntry.index;
              entry.nextUsed := writer.firstUsed;
              writer.firstUsed := h;
              EXIT
            ELSE
              <* ASSERT(entry.r # oldEntry.r) *>
              INC(h);
              IF h >= NUMBER(writer.refs^) THEN h := 0 END;
            END;(*IF*)
          END;(*WITH*)
        END;(*LOOP*)
        oldFirst := oldEntry.nextUsed;
      END;(*WITH oldEntry*)
    END;(*WHILE*)
  END ExtendWriterRefs;

PROCEDURE WriteRef(writer: Writer; r: REFANY)
        RAISES { Error, Wr.Failure, Thread.Alerted } =
    VAR h: INTEGER;
    VAR sp: Special;
  BEGIN
    IF writer.level = 0 THEN
      (* Start of a pickle; do the overhead and call ourselves
         recursively *)
      IF writer.visitor = NIL THEN
        writer.visitor := NEW (WriteVisitor, writer := writer);
      END;
      IF writer.refs = NIL THEN
        (* deferred allocation *)
        writer.refs := NEW(RefTable, InitRefCapacity * 2 - 1);
        WITH refs = writer.refs^ DO
          FOR i := 0 TO LAST(refs) DO refs[i].r := NIL END;
        END;
        writer.firstUsed := -1;
        writer.tcCount := 0; (* prevent excessive initialization *)
        writer.tcToPkl := NEW(TypeTable, RTType.MaxTypecode()+1);
        writer.pklToTC := NEW(TypeTable, InitTypeCapacity);
        WITH tcs = writer.tcToPkl^ DO
          FOR i := 0 TO LAST(tcs) DO tcs[i] := 0 END;
        END;
      END;
      (* (Re-)initialize the writer's state *)
      <*ASSERT (writer.firstUsed = -1)*>
          (* cleaned up last time *)
      writer.refCount := 0;
      FOR i := 1 TO writer.tcCount DO writer.tcToPkl[writer.pklToTC[i]] := 0 END;
      writer.tcCount := 0;
      writer.collisions := 0;
      Wr.PutString(writer.wr, myHeader);
      RTCollector.DisableMotion();
      INC(writer.level);
      TRY
        WriteRef(writer, r);
      FINALLY
        RTCollector.EnableMotion();
        DEC(writer.level);
        (* Flush the refs table now, to encourage the garbage
           collector. It must be flushed before re-use anyway *)
        h := writer.firstUsed;
        WHILE h >= 0 DO
          WITH entry = writer.refs[h] DO
            entry.r := NIL;
            h := entry.nextUsed;
          END;
        END;
        writer.firstUsed := -1;
      END;(*TRY*)
      Wr.PutString(writer.wr, myTrailer);
    ELSE
      (* Normal case: level#0 *)
      IF r = NIL THEN
        Wr.PutChar(writer.wr, '0');
      ELSE
        (* check refTable *)
        (* The following loop includes the entire hash table
           implementation. Considerations for the hash table
           algorithm:
             - mostly, we're adding new entries; looking up old
               entries is rare
             - we need to flush the table completely once per
               pickle
             - beware of relocating garbage collectors
           *)
        h := Hash(r, writer.refs);
        LOOP
          WITH entry = writer.refs[h] DO
            IF entry.r = NIL THEN
              (* virgin: insert in hash table *)
              entry.r := r;
              entry.index := writer.refCount;
              entry.nextUsed := writer.firstUsed;
                (* for fast flushing *)
              writer.firstUsed := h;
              INC(writer.refCount);
              IF writer.refCount * 2 > NUMBER(writer.refs^) THEN
                ExtendWriterRefs(writer);
              END;
              (* CAUTION: don't use "entry" after here, because
                 it might be invalidated by extendWriterRefs *)
              Wr.PutChar(writer.wr, '5');
              sp := GetSpecial (TYPECODE (r));
              writer.writeType(sp.sc);
              sp.write(r, writer);
              EXIT
            ELSIF entry.r = r THEN
              (* recycled *)
              Wr.PutChar(writer.wr, '1');
              writer.writeInt(entry.index);
              EXIT
            ELSE
              (* Hash collision *)
              INC(h);
              IF h >= NUMBER(writer.refs^) THEN h := 0 END;
              INC(writer.collisions);
            END;
          END;(*WITH*)
        END;(*LOOP*)
      END;(*r#NIL*)
    END;(*IF level=0 THEN ELSE*)
  END WriteRef;

PROCEDURE ExtendWriterTypes(writer: Writer) =
  (* Extend writer.pklToTC *)
    VAR old := writer.pklToTC;
  BEGIN
    writer.pklToTC := NEW(TypeTable, NUMBER(writer.pklToTC^) * 2);
    SUBARRAY(writer.pklToTC^, 0, NUMBER(old^)) := old^;
  END ExtendWriterTypes;

PROCEDURE WriteType(writer: Writer; tc: INTEGER)
        RAISES { Wr.Failure, Thread.Alerted } =
    VAR fp: Fingerprint.T;
  BEGIN
    WITH pickleTC = writer.tcToPkl[tc] DO
      IF pickleTC = 0 THEN
        INC(writer.tcCount);
        IF writer.tcCount >= NUMBER(writer.pklToTC^) THEN
          ExtendWriterTypes(writer);
        END;
        pickleTC := writer.tcCount;
        writer.pklToTC[writer.tcCount] := tc;
        fp := RTTypeFP.ToFingerprint(tc);
        Wr.PutChar(writer.wr, VAL(0, CHAR));
        Wr.PutString(writer.wr, LOOPHOLE(fp, CharFP));
      ELSIF pickleTC < 255 THEN
        Wr.PutChar(writer.wr, VAL(pickleTC, CHAR));
      ELSE
        Wr.PutChar(writer.wr, VAL(255, CHAR));
        writer.writeInt(pickleTC);
      END;
    END;
  END WriteType;

PROCEDURE WriteInt(writer: Writer; i: INTEGER)
        RAISES { Wr.Failure, Thread.Alerted } =
  BEGIN
    Wr.PutString(writer.wr, LOOPHOLE(ADR(i), UNTRACED REF CharInt32)^);
  END WriteInt;

PROCEDURE ExtendReaderTypes(reader: Reader) =
  (* Extend reader.pklToTC *)
    VAR old := reader.pklToTC;
  BEGIN
    reader.pklToTC := NEW(TypeTable, NUMBER(reader.pklToTC^) * 2);
    SUBARRAY(reader.pklToTC^, 0, NUMBER(old^)) := old^;
  END ExtendReaderTypes;

PROCEDURE GetBinaryInt(rd: Rd.T): INTEGER
        RAISES { Rd.EndOfFile, Rd.Failure, Thread.Alerted } =
    VAR i: INTEGER := 0;
  BEGIN
    IF Rd.GetSub(rd,
      LOOPHOLE (ADR(i), UNTRACED REF CharInt32)^) # BYTESIZE(CharInt32) THEN
        RAISE Rd.EndOfFile
    END;
    RETURN i;
  END GetBinaryInt;

PROCEDURE ReadFP(reader: Reader): TypeCode
      RAISES { Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted } =
    (* Read a fingerprint (8 bytes), store in reader.pklToTC,
       and return typecode *)
    VAR fp: Fingerprint.T; tc: TypeCode;
  BEGIN
    IF Rd.GetSub(reader.rd, LOOPHOLE(fp, CharFP)) # BYTESIZE(CharFP) THEN
      RAISE Rd.EndOfFile
    END;
    INC(reader.tcCount);
    IF reader.tcCount >= NUMBER(reader.pklToTC^) THEN
      ExtendReaderTypes(reader);
    END;
    tc := RTTypeFP.FromFingerprint(fp);
    IF tc = RTType.NoSuchType THEN
      RAISE Error(
             "Can't read pickle (type not known in this program)")
    END;
    reader.pklToTC[reader.tcCount] := tc;
    RETURN tc
  END ReadFP;

PROCEDURE TCFromIndex(reader: Reader; index: INTEGER): TypeCode
      RAISES { Error } =
  BEGIN
    IF index > reader.tcCount THEN
      RAISE Error("Malformed pickle (TC index too large)")
    END;
    RETURN reader.pklToTC[index]
  END TCFromIndex;

PROCEDURE InvokeSpecial(reader: Reader; sc: TypeCode): REFANY
  RAISES { Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted } =
  VAR sp: Special; r: REFANY; id: RefID;
  BEGIN
    sp := GetSpecial (sc);
    IF sp.sc # sc THEN
      RAISE Error("Can't read pickle (Special not defined)")
    END;
    IF reader.refCount >= NUMBER(reader.refs^) THEN
      VAR old := reader.refs;
      BEGIN
        reader.refs := NEW(RefArray, NUMBER(reader.refs^) * 2);
        SUBARRAY(reader.refs^, 0, NUMBER(old^)) := old^;
      END;
    END;
    id := reader.refCount;
    reader.refs[id] := nullReaderRef;
    INC(reader.refCount);
    INC(reader.level);
    r := sp.read(reader, id);
    DEC(reader.level);
    reader.noteRef(r, id);
    RETURN r
  END InvokeSpecial;

PROCEDURE ReadRef(reader: Reader): REFANY
      RAISES { Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted } =
    VAR r: REFANY; (* the result *)
    VAR repCase: CHAR;
  BEGIN
    IF reader.level = 0 THEN
      (* Start of a pickle *)
      IF reader.visitor = NIL THEN
        reader.visitor := NEW (ReadVisitor, reader := reader);
      END;
      IF reader.refs = NIL THEN
        (* deferred allocation *)
        reader.refs := NEW(RefArray, InitRefCapacity);
        reader.pklToTC := NEW(TypeTable, InitTypeCapacity);
      END;
      (* (Re-)initialize the reader's state *)
      reader.refCount := 0;
      reader.tcCount := 0;
      (* Header *)
      VAR headerChars: Header;
      BEGIN
        IF Rd.GetSub(reader.rd, headerChars) # NUMBER(HC) THEN
          RAISE Rd.EndOfFile
        ELSIF (headerChars[HC.h1] # myHeader[HC.h1]) OR
                (headerChars[HC.h2] # myHeader[HC.h2]) THEN
          RAISE Error("Malformed pickle (wrong signature)")
        ELSIF (headerChars[HC.v] # myHeader[HC.v]) AND
              (headerChars[HC.v] # OldVersion) THEN
          RAISE Error("Can't read pickle (wrong version)")
        ELSIF headerChars[HC.c] # myHeader[HC.c] THEN
          RAISE Error("Can't read pickle (char rep)")
        ELSIF headerChars[HC.e] # myHeader[HC.e] THEN
          RAISE Error("Can't read pickle (endian)")

ELSIF headerChars[HC.i] # myHeader[HC.i] THEN RAISE Error(Can't read pickle (INTEGER size))

        ELSIF headerChars[HC.r] # myHeader[HC.r] THEN
          RAISE Error("Can't read pickle (REAL rep)")
        END;
      END;
    END;
    LOOP
      (* COMPATIBILITY: OldVersion uses '2 fingerprint' *)
      repCase := Rd.GetChar(reader.rd);
      IF repCase # '2' THEN EXIT END;
      EVAL ReadFP(reader)
    END;
    IF repCase = '0' THEN
      r := NIL;
    ELSIF repCase = '1' THEN
      VAR refIndex := reader.readInt();
      BEGIN
        IF refIndex >= reader.refCount THEN
          RAISE Error("Malformed pickle (ref index too large)")
        END;
        r := reader.refs[refIndex];
      END;
    ELSIF repCase = '3' THEN
      (* COMPATIBILITY: OldVersion uses 3 sc ac contents *)
      VAR sc := GetBinaryInt(reader.rd);
      BEGIN
        reader.acPending := GetBinaryInt(reader.rd);
        r := InvokeSpecial(reader, TCFromIndex(reader, sc));
        reader.acPending := 0;
      END
    ELSIF repCase = '5' THEN
      r := InvokeSpecial(reader, reader.readType());
    ELSE
      RAISE Error("Malformed pickle (unknown switch)")
    END;
    IF reader.level = 0 THEN
      IF (Rd.GetChar(reader.rd) # Trailer1) OR
              (Rd.GetChar(reader.rd) # Trailer2) THEN
        RAISE Error("Malformed pickle (wrong trailer)")
      END;
      (* flush the ref table to encourage the garbage collector *)
      WITH refs = reader.refs^ DO
        FOR i := 0 TO reader.refCount-1 DO refs[i] := NIL END;
      END;
    END;
    RETURN r
  END ReadRef;

PROCEDURE ReadType(reader: Reader): TypeCode
      RAISES { Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted } =
    VAR c: CHAR; ac: INTEGER;
  BEGIN
    IF reader.acPending # 0 THEN
      (* COMPATIBILITY *)
      ac := reader.acPending; reader.acPending := 0;
      RETURN TCFromIndex(reader, ac);
    ELSE
      c := Rd.GetChar(reader.rd);
      IF ORD(c) = 0 THEN
        RETURN ReadFP(reader)
      ELSIF ORD(c) < 255 THEN
        RETURN TCFromIndex(reader, ORD(c));
      ELSE
        RETURN TCFromIndex(reader, reader.readInt());
      END;
    END;
  END ReadType;

PROCEDURE ReadInt(reader: Reader): INTEGER
        RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  BEGIN
    RETURN GetBinaryInt(reader.rd)
  END ReadInt;

PROCEDURE NoteRef(reader: Reader; ref: REFANY; id: RefID) =
  BEGIN
    WITH rr = reader.refs[id] DO
      <* ASSERT (rr = nullReaderRef) OR (rr = ref) *>
      rr := ref;
    END;
  END NoteRef;

TYPE
  SpecialTable = REF ARRAY OF Special;
    (* indexed by RTType.TypeCode, yields Special for nearest super-type *)

VAR
  specialsMu     := NEW(MUTEX);
  specials       : SpecialTable := NIL;     (* LL >= specialsMu *)
  theRootSpecial : Special;                 (* LL >= specialsMu *)

PROCEDURE GetSpecial (tc: TypeCode): Special =
  (* LL = 0 *)
  BEGIN
    LOCK specialsMu DO
      IF (specials = NIL) THEN InitSpecials (); END;
      IF (tc >= NUMBER (specials^)) THEN ExpandSpecials (); END;
      RETURN specials[tc];
    END;
  END GetSpecial;

PROCEDURE InitSpecials() =
  (* LL >= specialsMu *)
  VAR max_type := RTType.MaxTypecode ();
  BEGIN
    theRootSpecial := NEW(Special, sc := RT0.NilTypecode);
    specials := NEW(SpecialTable, max_type+1);
    FOR i := 0 TO LAST(specials^) DO
      specials[i] := theRootSpecial;
    END;
    Thread.Release (specialsMu);
    TRY BuiltinSpecials.Register ();
    FINALLY Thread.Acquire (specialsMu);
    END;
  END InitSpecials;

PROCEDURE ExpandSpecials() =
  (* LL >= specialsMu *)
  VAR max_type := RTType.MaxTypecode ();
  BEGIN
    IF (max_type > LAST (specials^)) THEN
      VAR new_sp := NEW (SpecialTable, max_type+1);  BEGIN
        SUBARRAY (new_sp^, 0, NUMBER (specials^)) := specials^;
        FOR i := NUMBER (specials^) TO LAST (new_sp^) DO
          new_sp[i] := FindBestSpecial (i);
        END;
      END;
    END;
  END ExpandSpecials;

PROCEDURE FindBestSpecial (tc: TypeCode): Special =
  VAR sp: Special;
  BEGIN
    LOOP
      tc := RTType.Supertype (tc);
      IF (tc = RTType.NoSuchType) THEN
        RETURN theRootSpecial;
      END;
      IF (0 <= tc) AND (tc < NUMBER (specials^)) THEN
        sp := specials [tc];
        IF (sp # NIL) THEN RETURN sp; END;
      END;
    END;
  END FindBestSpecial;

EXCEPTION DuplicateSpecial;

PROCEDURE RegisterSpecial(sp: Special) =
  <* FATAL DuplicateSpecial *>
  VAR xp: Special;
  BEGIN
    xp := GetSpecial (sp.sc);
    IF xp.sc = sp.sc THEN RAISE DuplicateSpecial; END;
    LOCK specialsMu DO
      FOR i := 0 TO LAST(specials^) DO
        IF (i#RT0.NilTypecode) AND RTType.IsSubtype(i,sp.sc) THEN
          (* i is a sub-type of this special *)
          IF (specials[i].sc = RT0.NilTypecode) OR
                      RTType.IsSubtype(sp.sc, specials[i].sc) THEN
            (* previous special for i isn't more specific than sp.sc *)
            specials[i] := sp;
          END;
        END;
      END;
    END;
  END RegisterSpecial;

PROCEDURE VisitWrite(v: WriteVisitor; field: ADDRESS; kind: RTTypeMap.Kind)
  RAISES ANY =
  (* Call-back from RTType.Visit for RootSpecialWrite *)
  VAR writer := v.writer;
  BEGIN
    (* write data fields preceding the ref *)
    IF field # writer.nextAddr THEN
      Wr.PutString(writer.wr,
                   SUBARRAY(LOOPHOLE(writer.nextAddr, ToChars)^,
                                     0, field - writer.nextAddr));
    END;
    IF kind = RTTypeMap.Kind.Ref THEN
      writer.write(LOOPHOLE(field, UNTRACED REF REFANY)^);
    ELSE
      (* Other REF fields, including procedures, are discarded on
         write *)
    END;
    writer.nextAddr := field + ADRSIZE(ADDRESS);
  END VisitWrite;

PROCEDURE RootSpecialWrite(<*UNUSED*> sp: Special;
                           r: REFANY; writer: Writer)
        RAISES { Error <*NOWARN*>, Wr.Failure, Thread.Alerted } =
    VAR nDim: INTEGER;
    VAR shape: UNTRACED REF ARRAY [0..999] OF INTEGER;
    VAR limit: ADDRESS;
  BEGIN
    writer.writeType(TYPECODE(r));
    RTHeapRep.UnsafeGetShape (r, nDim, shape);
    FOR i := 0 TO nDim-1 DO
      writer.writeInt(shape[i]);
    END;
    writer.nextAddr := RTHeap.GetDataAdr(r);
    limit := writer.nextAddr + RTHeap.GetDataSize(r);
    <*FATAL ANY*> BEGIN
      RTTypeMap.WalkRef(r, RefFields, writer.visitor);
    END;
    (* Write remainder of the data fields *)
    IF limit # writer.nextAddr THEN
      Wr.PutString(writer.wr,
                   SUBARRAY(LOOPHOLE(writer.nextAddr, ToChars)^,
                                      0, limit-writer.nextAddr));
    END;
  END RootSpecialWrite;

PROCEDURE VisitRead(v: ReadVisitor; field: ADDRESS; kind: RTTypeMap.Kind)
  RAISES ANY =
  (* Call-back from RTType.Visit for RootSpecialRead *)
  VAR reader := v.reader;
  BEGIN
    (* read data fields preceding the ref *)
    EVAL Rd.GetSub(reader.rd,
                   SUBARRAY(LOOPHOLE(reader.nextAddr, ToChars)^,
                                     0, field - reader.nextAddr));
    IF kind = RTTypeMap.Kind.Ref THEN
      LOOPHOLE(field, UNTRACED REF REFANY)^ := reader.read();
    ELSE
      (* Other REF fields, including procedures, are discarded on
         write *)
      LOOPHOLE(field, UNTRACED REF REFANY)^ := NIL;
    END;
    reader.nextAddr := field + ADRSIZE(ADDRESS);
  END VisitRead;

PROCEDURE RootSpecialRead(<*UNUSED*> sp: Special;
                          reader: Reader; id: RefID): REFANY
    RAISES { Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted } =
    VAR nDim: INTEGER;
    VAR shape: ARRAY [0..10] OF INTEGER;
    VAR limit: ADDRESS;
    VAR r: REFANY;
    VAR ac := reader.readType();
  BEGIN
    TRY
      nDim := RTType.GetNDimensions(ac);
      IF nDim > 0 THEN
        FOR i := 0 TO nDim-1 DO
          shape[i] := reader.readInt();
        END;
        r := RTAllocator.NewTracedArray(ac, SUBARRAY(shape, 0, nDim));
      ELSE
        r := RTAllocator.NewTraced(ac);
      END;
    EXCEPT RTAllocator.OutOfMemory =>
      RAISE Error("Can't red pickle (out of memory)")
    END;
    reader.noteRef(r, id);
    reader.nextAddr := RTHeap.GetDataAdr(r);
    limit := reader.nextAddr + RTHeap.GetDataSize(r);
    <*FATAL ANY*> BEGIN
      RTTypeMap.WalkRef(r, RefFields, reader.visitor);
    END;
    (* Read remainder of the data fields *)
    EVAL Rd.GetSub(reader.rd,
                   SUBARRAY(LOOPHOLE(reader.nextAddr, ToChars)^,
                                     0, limit-reader.nextAddr));
    RETURN r
  END RootSpecialRead;

PROCEDURE InitHeader() =
    VAR test: BITS 16 FOR [0..32767];
    TYPE EndianTest = ARRAY[0..1] OF BITS 8 FOR [0..255];
  BEGIN
    myHeader[HC.h1] := Header1;
    myHeader[HC.h2] := Header2;
    myHeader[HC.v] := Version;
    myHeader[HC.c] := CharRepISOLatin1;
    test := 1;
    IF LOOPHOLE(test, EndianTest)[0] = 1 THEN
      myHeader[HC.e] := LittleEndian
    ELSE
      myHeader[HC.e] := BigEndian;
    END;
    IF BITSIZE(INTEGER) = 16 THEN
      myHeader[HC.i] := IntSize16
    ELSIF BITSIZE(INTEGER) = 32 THEN
      myHeader[HC.i] := IntSize32
    ELSIF BITSIZE(INTEGER) = 64 THEN
      myHeader[HC.i] := IntSize64
    ELSE
      myHeader[HC.i] := '?'
    END;
    myHeader[HC.r] := RealRepNative;
    myTrailer[HT.t1] := Trailer1;
    myTrailer[HT.t2] := Trailer2;
  END InitHeader;

BEGIN

  InitHeader();
  nullReaderRef := NEW(REF INTEGER);

END Pickle.