Copyright (C) 1994, Digital Equipment Corp.
StubLib.m3
UNSAFE MODULEmost if not all of the following could be inline in stub code; (* unsafe because of marshalling code *) IMPORT NetObj, NetObjRep, NetObjRT, Pickle, Protocol, Transport, TransportUtils, Voucher, WireRep; IMPORT Atom, AtomList, Rd, RTType, Wr, Text, TextF, Thread, RdClass, WrClass, UnsafeRd, UnsafeWr, FloatMode, Swap; FROM Protocol IMPORT MsgHeader, CallHeader, Op; REVEAL RdClass.Private <: MUTEX; REVEAL WrClass.Private <: MUTEX; StubLib
Since clients of Conn
must avoid accessing them concurrently,
we operate on the embedded streams without locking them.
TYPE ObjectStack = RECORD pos: CARDINAL := 0; objs: REF ARRAY OF NetObj.T := NIL; END; CONST DefaultObjStackSize = 8; REVEAL Conn = Transport.Conn BRANDED OBJECT objStack: ObjectStack := ObjectStack {}; inObj: BOOLEAN := FALSE; END;The field
t.objStack
is used to record the set of network objects
marshalled during any single method invocation (at either client or
server). This record is required for cleanup at the termination of
the call. The t.objStack
field is managed by the network object
runtime and should not be modified by any transport implementation.
REVEAL Transport.T = TransportUtils.Public BRANDED OBJECT OVERRIDES serviceCall := ServiceCall; END;Pickle.Reader and Pickle.Writer subtypes and free list headers
TYPE SpecWr = Pickle.Writer OBJECT c: Conn; next: SpecWr; END; TYPE SpecRd = Pickle.Reader OBJECT c: Conn; rep: DataRep; next: SpecRd; END; VAR mu: MUTEX; freeWr: SpecWr; freeRd: SpecRd; PROCEDUREexports to StubLibServiceCall (<*UNUSED*> tt: Transport.T; c: Conn) : BOOLEAN RAISES {Thread.Alerted} = BEGIN TRY VAR dispatcher: Dispatcher; obj: NetObj.T; rd := c.rd; h := LOOPHOLE(ADR(rd.buff[rd.st+rd.cur-rd.lo]), UNTRACED REF CallHeader); BEGIN IF rd.hi - rd.cur < BYTESIZE(CallHeader) OR h.hdr.private # ORD(Op.MethodCall) THEN RaiseUnmarshalFailure(); END; INC(rd.cur, BYTESIZE(CallHeader)); IF h.hdr.intFmt # NativeRep.intFmt THEN IF NOT NativeEndian(h.hdr) THEN h.prot := Swap.Swap4(h.prot); END; END; obj := NetObjRT.FindTarget(h.obj, h.prot, dispatcher); TRY c.objStack.pos := 0; dispatcher(c, obj, h.hdr, h.prot); IF (c.objStack.pos # 0) THEN c.wr.nextMsg(); IF NOT rd.nextMsg() OR rd.hi - rd.cur < BYTESIZE(MsgHeader) THEN RETURN FALSE; END; VAR hh := LOOPHOLE(ADR(rd.buff[rd.st+rd.cur-rd.lo]), UNTRACED REF MsgHeader)^; BEGIN INC(rd.cur, BYTESIZE(MsgHeader)); IF hh.hdr.private # ORD(Op.ResultAck) THEN RETURN FALSE; END; END; ELSE c.wr.nextMsg(); END; FINALLY IF (c.objStack.pos # 0) THEN NetObjRT.Unpin(SUBARRAY(c.objStack.objs^, 0, c.objStack.pos)); FOR i := 0 TO c.objStack.pos-1 DO c.objStack.objs[i] := NIL; END; END; END; END; EXCEPT | Rd.Failure, Wr.Failure => RETURN FALSE; | NetObj.Error(ec) => TRY (* this test checks whether we have started marshalling results *) IF c.wr.cur = 0 THEN VAR wr := c.wr; h := LOOPHOLE(ADR(wr.buff[wr.st+wr.cur-wr.lo]), UNTRACED REF MsgHeader); BEGIN h.hdr := NativeRep; h.hdr.private := ORD(Op.CallFailed); INC(wr.cur, BYTESIZE(MsgHeader)); END; OutRef(c, ec); END; c.wr.nextMsg(); EXCEPT | Wr.Failure => RETURN FALSE; END; END; RETURN TRUE; END ServiceCall;
PROCEDUREthis code is integer-length dependent we also rely on the invariant that MsgRd/MsgWr will provide contiguous 8-byte chunks at proper alignment .. as long as there is no intervening flushStartCall (obj: NetObj.T; stubProt: StubProtocol) : Conn RAISES {NetObj.Error, Thread.Alerted} = VAR c := NARROW(obj.r, Transport.Location).new(); BEGIN c.objStack.pos := 0; c.inObj := FALSE; VAR wr := c.wr; h := LOOPHOLE(ADR(wr.buff[wr.st+wr.cur-wr.lo]), UNTRACED REF CallHeader); BEGIN <* ASSERT (wr.hi - wr.cur >= BYTESIZE(CallHeader)) *> INC(wr.cur, BYTESIZE(CallHeader)); h.hdr := NativeRep; h.hdr.private := ORD(Op.MethodCall); h.prot := stubProt; h.obj := obj.w; END; RETURN c; END StartCall; PROCEDUREAwaitResult (c: Conn) : DataRep RAISES {NetObj.Error, Rd.Failure, Wr.Failure, Thread.Alerted} = VAR h: MsgHeader; rd := c.rd; BEGIN c.wr.nextMsg(); TRY IF NOT rd.nextMsg() OR rd.hi - rd.cur < BYTESIZE(MsgHeader) THEN RaiseUnmarshalFailure(); END; h := LOOPHOLE(ADR(rd.buff[rd.st+rd.cur-rd.lo]), UNTRACED REF MsgHeader)^; INC(rd.cur, BYTESIZE(MsgHeader)); EXCEPT | Thread.Alerted => RAISE NetObj.Error(AtomList.List1(NetObj.Alerted)); END; CASE h.hdr.private OF | ORD(Op.Return) => | ORD(Op.CallFailed) => RAISE NetObj.Error(InRef(c, h.hdr, TYPECODE(AtomList.T))); ELSE RaiseUnmarshalFailure(); END; RETURN h.hdr; END AwaitResult; PROCEDUREEndCall (c: Conn; reUse: BOOLEAN) RAISES {Wr.Failure, Thread.Alerted} = BEGIN TRY IF c.objStack.pos # 0 THEN NetObjRT.Unpin(SUBARRAY(c.objStack.objs^, 0, c.objStack.pos)); FOR i := 0 TO c.objStack.pos-1 DO c.objStack.objs[i] := NIL; END; END; IF reUse AND c.inObj (* OR NOT UnsafeRd.FastEOF(c.rd) *) THEN VAR wr := c.wr; h := LOOPHOLE(ADR(wr.buff[wr.st+wr.cur-wr.lo]), UNTRACED REF MsgHeader); BEGIN h.hdr := NativeRep; h.hdr.private := ORD(Op.ResultAck); INC(wr.cur, BYTESIZE(MsgHeader)); wr.nextMsg(); END; END; FINALLY c.loc.free(c, reUse); END; END EndCall; PROCEDUREStartResult (c: Conn) = VAR wr := c.wr; h := LOOPHOLE(ADR(wr.buff[wr.st+wr.cur-wr.lo]), UNTRACED REF MsgHeader); BEGIN h.hdr := NativeRep; h.hdr.private := ORD(Op.Return); INC(wr.cur, BYTESIZE(MsgHeader)); END StartResult; PROCEDUREInChars (c: Conn; rep: DataRep; VAR arr: ARRAY OF CHAR) RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = BEGIN IF rep.charSet # NativeRep.charSet THEN RaiseError(NetObj.UnsupportedDataRep); END; IF c.rd.getSub(arr) # NUMBER(arr) THEN RaiseUnmarshalFailure(); END; END InChars; PROCEDUREOutChars (c: Conn; READONLY arr: ARRAY OF CHAR) RAISES {Wr.Failure, Thread.Alerted} = BEGIN c.wr.putString(arr); END OutChars; PROCEDUREInBytes (c: Conn; VAR arr: ARRAY OF Byte8) RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR p := LOOPHOLE(ADR(arr[0]), UNTRACED REF ARRAY [0..65335] OF CHAR); BEGIN IF c.rd.getSub(SUBARRAY(p^, 0, NUMBER(arr))) # NUMBER(arr) THEN RaiseUnmarshalFailure(); END; END InBytes; PROCEDUREOutBytes (c: Conn; READONLY arr: ARRAY OF Byte8) RAISES {Wr.Failure, Thread.Alerted} = VAR p := LOOPHOLE(ADR(arr[0]), UNTRACED REF ARRAY [0..65335] OF CHAR); BEGIN c.wr.putString(SUBARRAY(p^, 0, NUMBER(arr))); END OutBytes; CONST BigEndianFmt = 16; IntFmt32Little = 0; IntFmt64Little = 1; IntFmt32Big = BigEndianFmt; IntFmt64Big = BigEndianFmt + 1; FloatIEEE = 0; FloatOther = 1; TYPE Int64 = ARRAY [0..1] OF Int32;
PROCEDUREInInteger (c: Conn; rep: DataRep; min := FIRST(INTEGER); max := LAST(INTEGER)): INTEGER RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR i: INTEGER; BEGIN IF rep.intFmt = NativeRep.intFmt THEN i := LOOPHOLE(AlignRd(c.rd, BYTESIZE(INTEGER)), UNTRACED REF INTEGER)^; INC(c.rd.cur, BYTESIZE(INTEGER)); ELSE CASE rep.intFmt OF | IntFmt32Little, IntFmt32Big => VAR ii: Int32 := LOOPHOLE(AlignRd(c.rd, BYTESIZE(Int32)), UNTRACED REF Int32)^; BEGIN INC(c.rd.cur, BYTESIZE(Int32)); IF NOT NativeEndian(rep) THEN ii := Swap.Swap4(ii); END; i := ii; END; | IntFmt64Little => (* this can only be 64 -> 32 bit conversion *) (* no 64 -> 64 bit byte swap at this point in time *) VAR ip := LOOPHOLE(AlignRd(c.rd, BYTESIZE(Int64)), UNTRACED REF Int64); BEGIN INC(c.rd.cur, BYTESIZE(Int64)); IF NativeEndian(rep) THEN i := ip[0]; ELSE i := Swap.Swap4(ip[0]); END; (* Don't need to swap ip[1] to do this check, since -1 and 0 are the same regardless *) IF (i < 0 AND ip[1] # -1) OR (i >= 0 AND ip[1] # 0) THEN RaiseError(NetObj.UnsupportedDataRep); END; END; ELSE RaiseError(NetObj.UnsupportedDataRep); END; END; IF i < min OR i > max THEN RaiseUnmarshalFailure(); END; RETURN i; END InInteger; PROCEDUREInInt32 (c: Conn; rep: DataRep; min := FIRST(Int32); max := LAST(Int32)): Int32 RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR i: Int32; BEGIN IF rep.intFmt = NativeRep.intFmt THEN i := LOOPHOLE(AlignRd(c.rd, BYTESIZE(Int32)), UNTRACED REF Int32)^; INC(c.rd.cur, BYTESIZE(Int32)); ELSE CASE rep.intFmt OF | IntFmt32Little, IntFmt32Big, IntFmt64Little => i := LOOPHOLE(AlignRd(c.rd, BYTESIZE(Int32)), UNTRACED REF Int32)^; INC(c.rd.cur, BYTESIZE(Int32)); IF NOT NativeEndian(rep) THEN i := Swap.Swap4(i); END; ELSE RaiseError(NetObj.UnsupportedDataRep); END; END; IF i < min OR i > max THEN RaiseUnmarshalFailure(); END; RETURN i; END InInt32; PROCEDUREAlignRd (rd: Rd.T; nb: CARDINAL) : ADDRESS RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR diff := rd.cur MOD nb; res: ADDRESS; BEGIN (* here we rely on the alignment invariants of MsgRd.T *) IF diff # 0 THEN VAR n := rd.cur + nb - diff; BEGIN IF n > rd.hi THEN RaiseUnmarshalFailure(); END; rd.cur := n; END; END; IF rd.cur = rd.hi THEN EVAL rd.seek(rd.cur, FALSE); END; IF rd.hi - rd.cur < nb THEN RaiseUnmarshalFailure(); END; res := ADR(rd.buff[rd.st + rd.cur - rd.lo]); RETURN res; END AlignRd; (* A MsgRd fragment must be 64-bit aligned. Fragments of types call, return, or call-failed, must either be a multiple of 8 bytes in length, or else contain the end-of-message. MsgRd buffers must be 64-bit aligned in length. *) PROCEDUREOutInteger (c: Conn; i: INTEGER) RAISES {Wr.Failure, Thread.Alerted} = VAR ip := LOOPHOLE(AlignWr(c.wr, BYTESIZE(INTEGER)), UNTRACED REF INTEGER); BEGIN ip^ := i; INC(c.wr.cur, BYTESIZE(INTEGER)); END OutInteger; PROCEDUREOutInt32 (c: Conn; i: Int32) RAISES {Wr.Failure, Thread.Alerted} = VAR ip := LOOPHOLE(AlignWr(c.wr, BYTESIZE(Int32)), UNTRACED REF Int32); BEGIN ip^ := i; INC(c.wr.cur, BYTESIZE(Int32)); END OutInt32; PROCEDUREAlignWr (wr: Wr.T; align: CARDINAL) : ADDRESS RAISES {Wr.Failure, Thread.Alerted} = VAR diff := wr.cur MOD align; res: ADDRESS; BEGIN (* here we rely on the alignment invariants of MsgWr.T *) IF diff # 0 THEN INC(wr.cur, align-diff); END; IF wr.cur = wr.hi THEN wr.seek(wr.cur); END; res := ADR(wr.buff[wr.st + wr.cur - wr.lo]); RETURN res; END AlignWr; (* A MsgWr fragment must be 64-bit aligned. Fragments of types call, return, or call-failed, must either be a multiple of 8 bytes in length, or else contain the end-of-message. MsgWr buffers must be 64-bit aligned in length. *) PROCEDUREInByte (c: Conn; max := LAST(Byte8)): Byte8 RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR b: Byte8; BEGIN TRY b := LOOPHOLE(UnsafeRd.FastGetChar(c.rd), Byte8); EXCEPT | Rd.EndOfFile => RaiseUnmarshalFailure(); END; IF b > max THEN RaiseUnmarshalFailure(); END; RETURN b END InByte; PROCEDUREOutByte (c: Conn; b: Byte8) RAISES {Wr.Failure, Thread.Alerted} = BEGIN UnsafeWr.FastPutChar(c.wr, LOOPHOLE(b, CHAR)); END OutByte; TYPE MSpec = {Pickle, Text, NetObj, Reader, Writer, Texts}; PROCEDUREInRef (c: Conn; rep: DataRep; tc: INTEGER): REFANY RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR r: REFANY; srd: SpecRd; BEGIN CASE InByte(c) OF | ORD(MSpec.Pickle) => TRY srd := NewRd(c, rep); VAR ok := FALSE; BEGIN TRY r := srd.read(); ok := TRUE; FINALLY IF ok THEN FreeRd(srd); END; END; END; EXCEPT | Rd.EndOfFile => RaiseUnmarshalFailure(); | Pickle.Error(cause) => RAISE NetObj.Error( AtomList.List2(UnmarshalFailure, Atom.FromText(cause))); END; IF tc # -1 AND NOT RTType.IsSubtype(TYPECODE(r), tc) THEN RaiseUnmarshalFailure(); END; | ORD(MSpec.Text) => r := InText(c, rep); | ORD(MSpec.NetObj) => r := InObject(c, tc); | ORD(MSpec.Reader) => r := InReader(c); | ORD(MSpec.Writer) => r := InWriter(c); | ORD(MSpec.Texts) => r := InTexts(c, rep); ELSE RaiseUnmarshalFailure(); END; RETURN r; END InRef; PROCEDUREOutRef (c: Conn; r: REFANY) RAISES {Wr.Failure, Thread.Alerted} = BEGIN TYPECASE r OF | TEXT(x) => OutByte(c, ORD(MSpec.Text)); OutText(c, x); | NetObj.T(x) => OutByte(c, ORD(MSpec.NetObj)); OutObject(c, x); | Rd.T(x) => OutByte(c, ORD(MSpec.Reader)); OutReader(c, x); | Wr.T(x) => OutByte(c, ORD(MSpec.Writer)); OutWriter(c, x); | REF ARRAY OF TEXT(x) => OutByte(c, ORD(MSpec.Texts)); OutTexts(c, x); ELSE OutByte(c, ORD(MSpec.Pickle)); TRY VAR swr := NewWr(c); ok := FALSE; BEGIN TRY swr.write(r); ok := TRUE; FINALLY IF ok THEN FreeWr(swr); END; END; END; EXCEPT | Pickle.Error(cause) => RAISE Wr.Failure(AtomList.List1(Atom.FromText(cause))); END; END; END OutRef; PROCEDUREInCardinal (c: Conn; rep: DataRep; lim: CARDINAL := LAST(CARDINAL)): CARDINAL RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = BEGIN RETURN InInteger(c, rep, 0, lim); END InCardinal; PROCEDUREOutCardinal (c: Conn; card: CARDINAL) RAISES {Wr.Failure, Thread.Alerted} = BEGIN OutInteger(c, card); END OutCardinal; PROCEDUREInReal (c: Conn; rep: DataRep): REAL RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR i: REAL; BEGIN IF rep.floatFmt # NativeRep.floatFmt THEN RaiseError(NetObj.UnsupportedDataRep); END; IF c.rd.getSub( LOOPHOLE(i, ARRAY [0..BYTESIZE(REAL)-1] OF CHAR)) # BYTESIZE(REAL) THEN RaiseUnmarshalFailure(); END; IF NOT NativeEndian(rep) THEN i := SwapReal(i); END; RETURN i; END InReal; PROCEDUREOutReal (c: Conn; i: REAL) RAISES {Wr.Failure, Thread.Alerted} = BEGIN c.wr.putString(LOOPHOLE(i, ARRAY [0..BYTESIZE(REAL)-1] OF CHAR)); END OutReal; PROCEDUREInLongreal (c: Conn; rep: DataRep): LONGREAL RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR i: LONGREAL; BEGIN IF rep.floatFmt # NativeRep.floatFmt THEN RaiseError(NetObj.UnsupportedDataRep); END; IF c.rd.getSub( LOOPHOLE(i, ARRAY [0..BYTESIZE(LONGREAL)-1] OF CHAR)) # BYTESIZE(LONGREAL) THEN RaiseUnmarshalFailure(); END; IF NOT NativeEndian(rep) THEN i := SwapLongReal(i); END; RETURN i; END InLongreal; PROCEDUREOutLongreal (c: Conn; i: LONGREAL) RAISES {Wr.Failure, Thread.Alerted} = BEGIN c.wr.putString(LOOPHOLE(i, ARRAY [0..BYTESIZE(LONGREAL)-1] OF CHAR)); END OutLongreal; PROCEDUREInExtended (c: Conn; rep: DataRep): EXTENDED RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = BEGIN RETURN LOOPHOLE(InLongreal(c, rep), EXTENDED); END InExtended; PROCEDUREOutExtended (c: Conn; i: EXTENDED) RAISES {Wr.Failure, Thread.Alerted} = BEGIN c.wr.putString(LOOPHOLE(i, ARRAY [0..BYTESIZE(EXTENDED)-1] OF CHAR)); END OutExtended; PROCEDUREInBoolean (c: Conn) : BOOLEAN RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR res: BOOLEAN; BEGIN TRY res := UnsafeRd.FastGetChar(c.rd) # '\000'; EXCEPT | Rd.EndOfFile => RaiseUnmarshalFailure(); END; RETURN res; END InBoolean; PROCEDUREOutBoolean (c: Conn; bool: BOOLEAN) RAISES {Wr.Failure, Thread.Alerted} = BEGIN IF bool THEN UnsafeWr.FastPutChar(c.wr, '\001'); ELSE UnsafeWr.FastPutChar(c.wr, '\000'); END; END OutBoolean; PROCEDUREInText (c: Conn; rep: DataRep) : TEXT RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR len: INTEGER; VAR text: TEXT; BEGIN len := InInt32(c, rep); IF len = -1 THEN RETURN NIL; ELSIF len < 0 THEN RaiseUnmarshalFailure(); ELSE text := NEW(TEXT, len+1); InChars(c, rep, SUBARRAY(text^, 0, len)); text[len] := '\000'; END; RETURN text; END InText; PROCEDUREOutText (c: Conn; text: TEXT) RAISES {Wr.Failure, Thread.Alerted} = VAR len: INTEGER; BEGIN IF text # NIL THEN len := Text.Length(text); ELSE len := -1; END; OutInt32(c, len); IF len > 0 THEN OutChars(c, SUBARRAY(text^, 0, len)); END; END OutText; PROCEDUREInTexts (c: Conn; rep: DataRep) : REF ARRAY OF TEXT RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR n: CARDINAL; VAR rt: REF ARRAY OF TEXT; BEGIN n := InInt32(c, rep, 0); IF n = 0 THEN RETURN NIL; END; rt := NEW(REF ARRAY OF TEXT, n); IF n > 0 THEN FOR i := 0 TO n-1 DO rt[i] := InText(c, rep); END; END; RETURN rt; END InTexts; PROCEDUREOutTexts (c: Conn; rt: REF ARRAY OF TEXT) RAISES {Wr.Failure, Thread.Alerted} = VAR n: CARDINAL; BEGIN IF (rt = NIL) THEN n := 0 ELSE n := NUMBER(rt^); END; OutInt32(c, n); IF n > 0 THEN FOR i := 0 TO n-1 DO OutText(c, rt[i]); END; END; END OutTexts; TYPE VT = Voucher.T OBJECT stream: REFANY; OVERRIDES claimRd := ClaimRd; claimWr := ClaimWr; END;
PROCEDURE CleanupVT(<*UNUSED*> READONLY w: WeakRef.T; r: REFANY) = VAR v := NARROW(r, VT); <*FATAL Thread.Alerted*> BEGIN TRY TYPECASE v.stream OF
Rd.T(rd) => Rd.Close(rd); Wr.T(wr) => Wr.Close(wr);ELSE END; EXCEPT
Rd.Failure, Wr.Failure =>END; END CleanupVT;
PROCEDUREProcedures for Pickling -- free list managementInReader (c: Conn) : Rd.T RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR obj: NetObj.T := NIL; rd: Rd.T := NIL; BEGIN obj := InObject(c); TYPECASE obj OF | NULL => | Voucher.T(v) => rd := v.claimRd(); ELSE RaiseUnmarshalFailure(); END; RETURN rd; END InReader; PROCEDUREOutReader (c: Conn; rd: Rd.T) RAISES {Wr.Failure, Thread.Alerted} = VAR obj: NetObj.T := NIL; BEGIN IF rd # NIL THEN obj := NEW(VT, stream := rd); (* EVAL WeakRef.FromRef(obj, CleanupVT); *) END; OutObject(c, obj); END OutReader; PROCEDUREInWriter (c: Conn) : Wr.T RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR obj: NetObj.T := NIL; wr: Wr.T := NIL; BEGIN obj := InObject(c); TYPECASE obj OF | NULL => | Voucher.T(v) => wr := v.claimWr(); ELSE RaiseUnmarshalFailure(); END; RETURN wr; END InWriter; PROCEDUREOutWriter (c: Conn; wr: Wr.T) RAISES {Wr.Failure, Thread.Alerted} = VAR obj: NetObj.T := NIL; BEGIN IF wr # NIL THEN obj := NEW(VT, stream := wr); (* EVAL WeakRef.FromRef(obj, CleanupVT); *) END; OutObject(c, obj); END OutWriter; PROCEDUREClaimRd (v: VT) : Rd.T = BEGIN TYPECASE v.stream OF | Rd.T(rd) => RETURN rd; ELSE RETURN NIL; END; END ClaimRd; PROCEDUREClaimWr (v: VT) : Wr.T = BEGIN TYPECASE v.stream OF | Wr.T(wr) => RETURN wr; ELSE RETURN NIL; END; END ClaimWr; CONST Align64 = 8; (* to achieve 64-bit alignment *) PROCEDUREOutObject (c: Conn; o: NetObj.T) RAISES {Wr.Failure, Thread.Alerted} = VAR (* we believe that 16-byte records are 32-bit aligned!! *) wr := c.wr; pwrep := LOOPHOLE(AlignWr(wr, Align64), UNTRACED REF WireRep.T); BEGIN IF wr.hi - wr.cur >= BYTESIZE(WireRep.T) THEN IF o = NIL THEN pwrep^ := WireRep.NullT; ELSE pwrep^ := NetObjRT.InsertAndPin(o); END; INC(wr.cur, BYTESIZE(WireRep.T)); ELSE IF o = NIL THEN OutBytes(c, WireRep.NullT.byte); ELSE OutBytes(c, NetObjRT.InsertAndPin(o).byte); END; END; VAR s := c.objStack.objs; BEGIN IF s = NIL THEN s := NEW(REF ARRAY OF NetObj.T, DefaultObjStackSize); c.objStack.objs := s; ELSIF c.objStack.pos = NUMBER(s^) THEN s := NEW(REF ARRAY OF NetObj.T, 2 * c.objStack.pos); SUBARRAY(s^, 0, c.objStack.pos) := c.objStack.objs^; c.objStack.objs := s; END; s[c.objStack.pos] := o; INC(c.objStack.pos); END; END OutObject; PROCEDUREInObject (c: Conn; tc: INTEGER := -1): NetObj.T RAISES {NetObj.Error, Rd.Failure, Thread.Alerted} = VAR o: NetObj.T; rd := c.rd; pwrep := LOOPHOLE(AlignRd(rd, Align64), UNTRACED REF WireRep.T); BEGIN IF rd.hi - rd.cur >= BYTESIZE(WireRep.T) THEN INC(rd.cur, BYTESIZE(WireRep.T)); IF pwrep^ = WireRep.NullT THEN RETURN NIL END; o := NetObjRT.Find(pwrep^, c.loc); ELSE VAR w: WireRep.T; BEGIN InBytes(c, w.byte); IF w = WireRep.NullT THEN RETURN NIL END; o := NetObjRT.Find(w, c.loc); END; END; IF tc # -1 AND NOT RTType.IsSubtype(TYPECODE(o), tc) THEN RaiseUnmarshalFailure(); END; c.inObj := TRUE; RETURN o; END InObject;
PROCEDUREPickle Special routinesNewWr (c: Conn): SpecWr = VAR pwr: SpecWr; BEGIN LOCK mu DO IF freeWr # NIL THEN pwr := freeWr; freeWr := freeWr.next; ELSE pwr := NEW(SpecWr, next:=NIL); END; END; pwr.wr := c.wr; pwr.c := c; RETURN pwr END NewWr; PROCEDUREFreeWr (pwr: SpecWr) = BEGIN LOCK mu DO pwr.next := freeWr; pwr.c := NIL; pwr.wr := NIL; freeWr := pwr; END; END FreeWr; PROCEDURENewRd (c: Conn; rep: DataRep): SpecRd = VAR prd: SpecRd; BEGIN LOCK mu DO IF freeRd # NIL THEN prd := freeRd; freeRd := freeRd.next; ELSE prd := NEW(SpecRd, next:=NIL); END; END; prd.rd := c.rd; prd.c := c; prd.rep := rep; RETURN prd END NewRd; PROCEDUREFreeRd (prd: SpecRd) = BEGIN LOCK mu DO prd.c := NIL; prd.rd := NIL; prd.next := freeRd; freeRd := prd; END; END FreeRd;
PROCEDUREOutSpecial (self: Pickle.Special; r: REFANY; writer: Pickle.Writer) RAISES {Pickle.Error, Wr.Failure, Thread.Alerted} = BEGIN TYPECASE writer OF | SpecWr => VAR c := NARROW(writer, SpecWr).c; BEGIN OutRef(c, r); END; ELSE TYPECASE r OF | NetObj.T(x) => IF NOT ISTYPE(x.r, Transport.Location) THEN (* This will gratuitously pickle the ExportInfo ref embedded in x.r. It would be better to exclude this if and when possible, but it shouldn't hurt for now. *) Pickle.Special.write(self, r, writer); ELSE RAISE Pickle.Error("Can't pickle a surrogate object"); END; ELSE RAISE Pickle.Error("Can't Pickle Rd.T or Wr.T"); END; END; END OutSpecial; PROCEDUREInSpecial (self: Pickle.Special; reader: Pickle.Reader; id: Pickle.RefID): REFANY RAISES { Pickle.Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted } = BEGIN TRY TYPECASE reader OF | SpecRd => VAR c := NARROW(reader, SpecRd).c; BEGIN RETURN InRef(c, NARROW(reader, SpecRd).rep, self.sc); END; ELSE TYPECASE Pickle.Special.read(self, reader, id) OF | NetObj.T(x) => x.w := WireRep.NullT; x.r := NIL; RETURN x; ELSE RAISE Pickle.Error("Can't Unpickle Rd.T or Wr.T"); END; END; EXCEPT NetObj.Error(cause) => RAISE Pickle.Error(Atom.ToText(cause.head)); END; END InSpecial; PROCEDURERaiseUnmarshalFailure () RAISES {NetObj.Error} = BEGIN RaiseError(UnmarshalFailure); END RaiseUnmarshalFailure; PROCEDURERaiseCommFailure (ec: AtomList.T) RAISES {NetObj.Error} = BEGIN RAISE NetObj.Error(AtomList.Cons(NetObj.CommFailure, ec)); END RaiseCommFailure; PROCEDURERaiseError (a: Atom.T) RAISES {NetObj.Error} = BEGIN RAISE NetObj.Error(AtomList.List1(a)); END RaiseError;
PROCEDURE Swap32(i: Int32) : Int32 = VAR res: Int32; BEGIN WITH p = LOOPHOLE(ADR(i), UNTRACED REF ARRAY [0..3] OF Byte8) DO WITH r = LOOPHOLE(ADR(res), UNTRACED REF ARRAY [0..3] OF Byte8) DO r[0] := p[3]; r[1] := p[2]; r[2] := p[1]; r[3] := p[0]; END; END; RETURN res; END Swap32;
PROCEDURESwapReal (i: REAL) : REAL = BEGIN RETURN LOOPHOLE(Swap.Swap4(LOOPHOLE(i, Int32)), REAL); END SwapReal; TYPE LR = RECORD a, b: Int32; END; PROCEDURESwapLongReal (i: LONGREAL) : LONGREAL = VAR res: LONGREAL; BEGIN WITH p = LOOPHOLE(ADR(i), UNTRACED REF LR) DO WITH r = LOOPHOLE(ADR(res), UNTRACED REF LR) DO r.a := Swap.Swap4(p.b); r.b := Swap.Swap4(p.a); END; END; RETURN res; END SwapLongReal; PROCEDURENativeEndian (rep: DataRep) : BOOLEAN = BEGIN RETURN (rep.intFmt >= BigEndianFmt) = (Swap.endian = Swap.Endian.Big); END NativeEndian; PROCEDUREChooseIntFmt (): Byte8 = BEGIN IF BYTESIZE(INTEGER) = 8 THEN IF Swap.endian = Swap.Endian.Little THEN RETURN IntFmt64Little; ELSE RETURN IntFmt64Big; END; ELSE IF Swap.endian = Swap.Endian.Little THEN RETURN IntFmt32Little; ELSE RETURN IntFmt32Big; END; END; END ChooseIntFmt; PROCEDUREChooseFloatFmt (): Byte8 = BEGIN IF FloatMode.IEEE THEN RETURN FloatIEEE; ELSE RETURN FloatOther; END; END ChooseFloatFmt; BEGIN NativeRep := DataRep{private := 0, intFmt := ChooseIntFmt(), charSet := 0, floatFmt := ChooseFloatFmt()}; UnmarshalFailure := Atom.FromText("NetObj.UnmarshalFailure"); (* Initialization for Pickle specials and free list *) mu := NEW(MUTEX); Pickle.RegisterSpecial( NEW(Pickle.Special, sc:= TYPECODE(NetObj.T), write := OutSpecial, read := InSpecial)); Pickle.RegisterSpecial( NEW(Pickle.Special, sc:= TYPECODE(Rd.T), write := OutSpecial, read := InSpecial)); Pickle.RegisterSpecial( NEW(Pickle.Special, sc:= TYPECODE(Wr.T), write := OutSpecial, read := InSpecial)); END StubLib.