This module implements Pickles. See the interface for documentation
UNSAFE MODULESyntax of a pickle, and constants pertaining thereto; IMPORT BuiltinSpecials, Rd, RT0, RTAllocator, RTCollector, RTHeap; IMPORT RTHeapRep, RTType, RTTypeFP, RTTypeMap, Thread, Word, Wr, Fingerprint; Pickle
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 *)Constants, types and revelations
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 *)Global variables (gasp!); initialized in main body
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 *)Top-level sugar: Write and Read
PROCEDUREWriter methods and subroutinesWrite (wr: Wr.T; r: REFANY) RAISES { Error, Wr.Failure, Thread.Alerted } = BEGIN NEW (Writer, wr := wr).write(r); END Write; PROCEDURERead (rd: Rd.T): REFANY RAISES { Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted } = BEGIN RETURN NEW (Reader, rd := rd).read(); END Read;
PROCEDUREReader methods and subroutinesHash (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; PROCEDUREExtendWriterRefs (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; PROCEDUREWriteRef (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; PROCEDUREExtendWriterTypes (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; PROCEDUREWriteType (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; PROCEDUREWriteInt (writer: Writer; i: INTEGER) RAISES { Wr.Failure, Thread.Alerted } = BEGIN Wr.PutString(writer.wr, LOOPHOLE(ADR(i), UNTRACED REF CharInt32)^); END WriteInt;
PROCEDUREExtendReaderTypes (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; PROCEDUREGetBinaryInt (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; PROCEDUREReadFP (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; PROCEDURETCFromIndex (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; PROCEDUREInvokeSpecial (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; PROCEDUREReadRef (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---------------------------------------------------------------- specials ---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; PROCEDUREReadInt (reader: Reader): INTEGER RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted} = BEGIN RETURN GetBinaryInt(reader.rd) END ReadInt; PROCEDURENoteRef (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---------------------------------------------------------- initialization ---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; PROCEDUREInitSpecials () = (* 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; PROCEDUREExpandSpecials () = (* 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; PROCEDUREFindBestSpecial (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; PROCEDURERegisterSpecial (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; PROCEDUREVisitWrite (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; PROCEDURERootSpecialWrite (<*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; PROCEDUREVisitRead (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; PROCEDURERootSpecialRead (<*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;
PROCEDUREInitHeader () = 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.