MODULEThe pickling routine for this shared object. We will register a pickler for ObValue.ReplObj, and then handle both ReplObj and ReplObjStd. Pickling subtypes of ReplObjStd is illegal.ObValueSO EXPORTSObValuePickle ,ObValue ,ObValueProxy ; IMPORT PickleStubs, EmbProxiedObj, EventProtocol, ObjectSpace, SharedObj, Pickle2 AS Pickle, Rd, SharedObjRep, ThreadF, Wr, EventStubLib, Event, ObValue, ObValueRep, AtomList, Thread, SharedObjError, SharedObjStubLib, ObValueCB, WeakRef; CONST SharedObj_Protocol: EventProtocol.StubProtocol = 1; EXCEPTION DuplicateSpecial; TYPE ReplObjStd_SOMethods = {InvokeUpdate, init, Update}; REVEAL ReplObjStd = ReplObj BRANDED "Shared ObValue.ReplObjStd v1.0" OBJECT OVERRIDES makeProxy := MakeProxy_ReplObjStd; applyUpdate := ApplyUpdate_ReplObjStd; InvokeUpdate := Shared_InvokeUpdate_ReplObjStd; init := Shared_init_ReplObjStd; Who := Shared_Who_ReplObjStd; Select := Shared_Select_ReplObjStd; Invoke := Shared_Invoke_ReplObjStd; Update := Shared_Update_ReplObjStd; Has := Shared_Has_ReplObjStd; Obtain := Shared_Obtain_ReplObjStd; END; PROCEDUREMakeProxy_ReplObjStd (self: ReplObjStd) = BEGIN IF MkProxyReplObjStd # NIL THEN MkProxyReplObjStd(self); END; END MakeProxy_ReplObjStd; PROCEDUREApplyUpdate_ReplObjStd (self: ReplObjStd; ev: Event.T; h: EventStubLib.Handle) RAISES {SharedObj.Error, Event.Error, Rd.Failure, Thread.Alerted} = BEGIN IF ev.prot # SharedObj_Protocol THEN EventStubLib.RaiseUnmarshalFailure(); END; WITH meth = SharedObjStubLib.InInt32(h) DO TRY TRY SharedObjStubLib.AcquireWriteLock(self); self.updating := ThreadF.MyId(); CASE meth OF | ORD(ReplObjStd_SOMethods.InvokeUpdate) => Stub_InvokeUpdate_ReplObjStd(self, h); | ORD(ReplObjStd_SOMethods.init) => Stub_init_ReplObjStd(self, h); | ORD(ReplObjStd_SOMethods.Update) => Stub_Update_ReplObjStd(self, h); ELSE EventStubLib.RaiseUnmarshalFailure(); END; FINALLY self.updating := -1; SharedObjStubLib.ReleaseWriteLock(self); END; EXCEPT ServerError, Exception, Error=> (* ignore these exceptions quietly *) END; END; END ApplyUpdate_ReplObjStd; PROCEDUREShared_InvokeUpdate_ReplObjStd (self: ReplObj; label_arg: TEXT; argNo_arg: INTEGER; READONLY args_arg: Vals; VAR hint_arg: INTEGER): Val RAISES {Error, Exception, ServerError, SharedObj.Error} = VAR out: SharedObjStubLib.Handle; id := ThreadF.MyId(); dataPresent: BOOLEAN; <* NOWARN *> BEGIN IF NOT self.ok THEN SharedObjError.RaiseDeadObject() END; TRY SharedObjStubLib.AcquireReadLock(self); IF self.updating = id THEN (* do a simple, non-update call to the method *) RETURN ReplObj.InvokeUpdate(self, label_arg, argNo_arg, args_arg, hint_arg); END; FINALLY SharedObjStubLib.ReleaseReadLock(self); END; TRY out := SharedObjStubLib.StartCall(self); IF SharedObjStubLib.MarshalArgs(out) THEN SharedObjStubLib.OutInt32(out, ORD(ReplObjStd_SOMethods.InvokeUpdate)); SharedObjStubLib.OutRef(out, label_arg); SharedObjStubLib.OutInteger(out, argNo_arg); SharedObjStubLib.OutInteger(out, NUMBER(args_arg)); dataPresent := TRUE; SharedObjStubLib.OutBoolean(out, dataPresent); IF dataPresent THEN FOR n1 := 0 TO LAST(args_arg) DO SharedObjStubLib.OutRef(out, args_arg[n1]); END; END; SharedObjStubLib.OutInteger(out, hint_arg); END; SharedObjStubLib.SequenceCall(out, SharedObj_Protocol); TRY SharedObjStubLib.AcquireWriteLock(self); self.updating := id; Callback_pre_InvokeUpdate_ReplObjStd(self, label_arg, argNo_arg, args_arg, hint_arg); WITH res = ReplObj.InvokeUpdate(self, label_arg, argNo_arg, args_arg, hint_arg) DO Callback_post_InvokeUpdate_ReplObjStd(self, label_arg, argNo_arg, args_arg, hint_arg); RETURN res; END; FINALLY self.updating := -1; SharedObjStubLib.ReleaseWriteLock(self); SharedObjStubLib.EndCall(out); END; EXCEPT | Wr.Failure (ec) => SharedObjError.RaiseCommFailure(ec); <*ASSERT FALSE*> | Thread.Alerted => SharedObjError.RaiseAlerted(); <*ASSERT FALSE*> END; END Shared_InvokeUpdate_ReplObjStd; PROCEDUREShared_init_ReplObjStd (self: ReplObj): ReplObj RAISES {SharedObj.Error} = VAR out: SharedObjStubLib.Handle; id := ThreadF.MyId(); dataPresent: BOOLEAN; <* NOWARN *> BEGIN (**************************************************) (* This get's done once. After that, it's a noop. *) (**************************************************) self := NARROW(SharedObj.Init(self), ReplObjStd); self.makeProxy(); (**************************************************) IF NOT self.ok THEN SharedObjError.RaiseDeadObject() END; TRY SharedObjStubLib.AcquireReadLock(self); IF self.updating = id THEN (* do a simple, non-update call to the method *) RETURN ReplObj.init(self); END; FINALLY SharedObjStubLib.ReleaseReadLock(self); END; TRY out := SharedObjStubLib.StartCall(self); IF SharedObjStubLib.MarshalArgs(out) THEN SharedObjStubLib.OutInt32(out, ORD(ReplObjStd_SOMethods.init)); END; SharedObjStubLib.SequenceCall(out, SharedObj_Protocol); TRY SharedObjStubLib.AcquireWriteLock(self); self.updating := id; Callback_pre_init_ReplObjStd(self); WITH res = ReplObj.init(self) DO Callback_post_init_ReplObjStd(self); RETURN res; END; FINALLY self.updating := -1; SharedObjStubLib.ReleaseWriteLock(self); SharedObjStubLib.EndCall(out); END; EXCEPT | Wr.Failure (ec) => SharedObjError.RaiseCommFailure(ec); <*ASSERT FALSE*> | Thread.Alerted => SharedObjError.RaiseAlerted(); <*ASSERT FALSE*> END; END Shared_init_ReplObjStd; PROCEDUREShared_Who_ReplObjStd (self: ReplObj; VAR protected_arg: BOOLEAN) : TEXT RAISES {SharedObj.Error} = BEGIN IF NOT self.ok THEN SharedObjError.RaiseDeadObject() END; TRY SharedObjStubLib.AcquireReadLock(self); RETURN ReplObj.Who(self, protected_arg); FINALLY SharedObjStubLib.ReleaseReadLock(self); END; END Shared_Who_ReplObjStd; PROCEDUREShared_Select_ReplObjStd (self: ReplObj; label_arg: TEXT; VAR hint_arg: INTEGER): Val RAISES {Error, Exception, ServerError, SharedObj.Error} = BEGIN IF NOT self.ok THEN SharedObjError.RaiseDeadObject() END; TRY SharedObjStubLib.AcquireReadLock(self); RETURN ReplObj.Select(self, label_arg, hint_arg); FINALLY SharedObjStubLib.ReleaseReadLock(self); END; END Shared_Select_ReplObjStd; PROCEDUREShared_Invoke_ReplObjStd (self: ReplObj; label_arg: TEXT; argNo_arg: INTEGER; READONLY args_arg: Vals; VAR hint_arg: INTEGER): Val RAISES {Error, Exception, ServerError, SharedObj.Error} = BEGIN IF NOT self.ok THEN SharedObjError.RaiseDeadObject() END; TRY SharedObjStubLib.AcquireReadLock(self); RETURN ReplObj.Invoke(self, label_arg, argNo_arg, args_arg, hint_arg); FINALLY SharedObjStubLib.ReleaseReadLock(self); END; END Shared_Invoke_ReplObjStd; PROCEDUREShared_Update_ReplObjStd (self: ReplObj; label_arg: TEXT; val_arg: Val; internal_arg: BOOLEAN; VAR hint_arg: INTEGER) RAISES {ServerError, SharedObj.Error} = VAR out: SharedObjStubLib.Handle; id := ThreadF.MyId(); dataPresent: BOOLEAN; <* NOWARN *> BEGIN IF NOT self.ok THEN SharedObjError.RaiseDeadObject() END; TRY SharedObjStubLib.AcquireReadLock(self); IF self.updating = id THEN (* do a simple, non-update call to the method *) ReplObj.Update(self, label_arg, val_arg, internal_arg, hint_arg); RETURN; END; FINALLY SharedObjStubLib.ReleaseReadLock(self); END; TRY out := SharedObjStubLib.StartCall(self); IF SharedObjStubLib.MarshalArgs(out) THEN SharedObjStubLib.OutInt32(out, ORD(ReplObjStd_SOMethods.Update)); SharedObjStubLib.OutRef(out, label_arg); SharedObjStubLib.OutRef(out, val_arg); SharedObjStubLib.OutInteger(out, ORD(internal_arg)); SharedObjStubLib.OutInteger(out, hint_arg); END; SharedObjStubLib.SequenceCall(out, SharedObj_Protocol); TRY SharedObjStubLib.AcquireWriteLock(self); self.updating := id; Callback_pre_Update_ReplObjStd(self, label_arg, val_arg, internal_arg, hint_arg); ReplObj.Update(self, label_arg, val_arg, internal_arg, hint_arg); Callback_post_Update_ReplObjStd(self, label_arg, val_arg, internal_arg, hint_arg); FINALLY self.updating := -1; SharedObjStubLib.ReleaseWriteLock(self); SharedObjStubLib.EndCall(out); END; EXCEPT | Wr.Failure (ec) => SharedObjError.RaiseCommFailure(ec); | Thread.Alerted => SharedObjError.RaiseAlerted(); END; END Shared_Update_ReplObjStd; PROCEDUREShared_Has_ReplObjStd (self: ReplObj; label_arg: TEXT; VAR hint_arg: INTEGER): BOOLEAN RAISES {SharedObj.Error} = BEGIN IF NOT self.ok THEN SharedObjError.RaiseDeadObject() END; TRY SharedObjStubLib.AcquireReadLock(self); RETURN ReplObj.Has(self, label_arg, hint_arg); FINALLY SharedObjStubLib.ReleaseReadLock(self); END; END Shared_Has_ReplObjStd; PROCEDUREShared_Obtain_ReplObjStd (self: ReplObj; internal_arg: BOOLEAN) : REF ObValue.ObjFields RAISES {ServerError, SharedObj.Error} = BEGIN IF NOT self.ok THEN SharedObjError.RaiseDeadObject() END; TRY SharedObjStubLib.AcquireReadLock(self); RETURN ReplObj.Obtain(self, internal_arg); FINALLY SharedObjStubLib.ReleaseReadLock(self); END; END Shared_Obtain_ReplObjStd; PROCEDUREStub_InvokeUpdate_ReplObjStd (self: ReplObj; <* NOWARN *> in: EventStubLib.Handle) RAISES {SharedObj.Error, Rd.Failure, Thread.Alerted, Error, Exception, ServerError} = VAR label_arg: TEXT; argNo_arg: INTEGER; args_arg: REF ObValue.Vals; hint_arg: INTEGER; dataPresent: BOOLEAN <* NOWARN *>; BEGIN label_arg := SharedObjStubLib.InRef(in, -1); argNo_arg := SharedObjStubLib.InInteger(in); WITH n1 = SharedObjStubLib.InInteger(in) DO args_arg := NEW(REF ObValue.Vals, n1); END; dataPresent := SharedObjStubLib.InBoolean(in); IF dataPresent THEN FOR n1 := 0 TO LAST(args_arg^) DO args_arg[n1] := SharedObjStubLib.InRef(in, TYPECODE(ObValue.Val)); END; END; hint_arg := SharedObjStubLib.InInteger(in); Callback_pre_InvokeUpdate_ReplObjStd(self, label_arg, argNo_arg, args_arg^, hint_arg); EVAL ReplObj.InvokeUpdate(self, label_arg, argNo_arg, args_arg^, hint_arg); Callback_post_InvokeUpdate_ReplObjStd(self, label_arg, argNo_arg, args_arg^, hint_arg); END Stub_InvokeUpdate_ReplObjStd; PROCEDUREStub_init_ReplObjStd (self: ReplObj; <* NOWARN *> in: EventStubLib.Handle) RAISES {SharedObj.Error} = BEGIN Callback_pre_init_ReplObjStd(self); EVAL ReplObj.init(self); Callback_post_init_ReplObjStd(self); END Stub_init_ReplObjStd; PROCEDUREStub_Update_ReplObjStd (self: ReplObj; <* NOWARN *> in: EventStubLib.Handle) RAISES {SharedObj.Error, Rd.Failure, Thread.Alerted, ServerError} = VAR label_arg: TEXT; val_arg: Val; internal_arg: BOOLEAN; hint_arg: INTEGER; dataPresent: BOOLEAN <* NOWARN *>; BEGIN label_arg := SharedObjStubLib.InRef(in, -1); val_arg := SharedObjStubLib.InRef(in, TYPECODE(ObValue.Val)); internal_arg := VAL(SharedObjStubLib.InInteger(in, 0,1), BOOLEAN); hint_arg := SharedObjStubLib.InInteger(in); Callback_pre_Update_ReplObjStd(self, label_arg, val_arg, internal_arg, hint_arg); ReplObj.Update(self, label_arg, val_arg, internal_arg, hint_arg); Callback_post_Update_ReplObjStd(self, label_arg, val_arg, internal_arg, hint_arg); END Stub_Update_ReplObjStd; PROCEDURECallback_pre_InvokeUpdate_ReplObjStd (self: ReplObjStd; label_arg: TEXT; argNo_arg: INTEGER; READONLY args_arg: Vals; VAR hint_arg: INTEGER) = VAR cbs := self.callbacks; BEGIN WHILE cbs # NIL DO IF cbs.head.ready THEN WITH ref = WeakRef.ToRef(cbs.head.weakRef) DO IF ref # NIL THEN WITH cb = NARROW(ref, ObValueCB.ReplObjStd) DO IF NOT cb.pre_InvokeUpdate(self, label_arg, argNo_arg, args_arg, hint_arg) THEN cb.pre_anyChange(self); END; END; END; END; END; cbs := cbs.tail; END; END Callback_pre_InvokeUpdate_ReplObjStd; PROCEDURECallback_post_InvokeUpdate_ReplObjStd (self: ReplObjStd; label_arg: TEXT; argNo_arg: INTEGER; READONLY args_arg: Vals; VAR hint_arg: INTEGER) = VAR cbs := self.callbacks; BEGIN WHILE cbs # NIL DO IF cbs.head.ready THEN WITH ref = WeakRef.ToRef(cbs.head.weakRef) DO IF ref # NIL THEN WITH cb = NARROW(ref, ObValueCB.ReplObjStd) DO IF NOT cb.post_InvokeUpdate(self, label_arg, argNo_arg, args_arg, hint_arg) THEN cb.post_anyChange(self); END; END; END; END; END; cbs := cbs.tail; END; END Callback_post_InvokeUpdate_ReplObjStd; PROCEDURECallback_pre_init_ReplObjStd (self: ReplObjStd) = VAR cbs := self.callbacks; BEGIN WHILE cbs # NIL DO IF cbs.head.ready THEN WITH ref = WeakRef.ToRef(cbs.head.weakRef) DO IF ref # NIL THEN WITH cb = NARROW(ref, ObValueCB.ReplObjStd) DO IF NOT cb.pre_init(self) THEN cb.pre_anyChange(self); END; END; END; END; END; cbs := cbs.tail; END; END Callback_pre_init_ReplObjStd; PROCEDURECallback_post_init_ReplObjStd (self: ReplObjStd) = VAR cbs := self.callbacks; BEGIN WHILE cbs # NIL DO IF cbs.head.ready THEN WITH ref = WeakRef.ToRef(cbs.head.weakRef) DO IF ref # NIL THEN WITH cb = NARROW(ref, ObValueCB.ReplObjStd) DO IF NOT cb.post_init(self) THEN cb.post_anyChange(self); END; END; END; END; END; cbs := cbs.tail; END; END Callback_post_init_ReplObjStd; PROCEDURECallback_pre_Update_ReplObjStd (self: ReplObjStd; label_arg: TEXT; val_arg: Val; internal_arg: BOOLEAN; VAR hint_arg: INTEGER) = VAR cbs := self.callbacks; BEGIN WHILE cbs # NIL DO IF cbs.head.ready THEN WITH ref = WeakRef.ToRef(cbs.head.weakRef) DO IF ref # NIL THEN WITH cb = NARROW(ref, ObValueCB.ReplObjStd) DO IF NOT cb.pre_Update(self, label_arg, val_arg, internal_arg, hint_arg) THEN cb.pre_anyChange(self); END; END; END; END; END; cbs := cbs.tail; END; END Callback_pre_Update_ReplObjStd; PROCEDURECallback_post_Update_ReplObjStd (self: ReplObjStd; label_arg: TEXT; val_arg: Val; internal_arg: BOOLEAN; VAR hint_arg: INTEGER) = VAR cbs := self.callbacks; BEGIN WHILE cbs # NIL DO IF cbs.head.ready THEN WITH ref = WeakRef.ToRef(cbs.head.weakRef) DO IF ref # NIL THEN WITH cb = NARROW(ref, ObValueCB.ReplObjStd) DO IF NOT cb.post_Update(self, label_arg, val_arg, internal_arg, hint_arg) THEN cb.post_anyChange(self); END; END; END; END; END; cbs := cbs.tail; END; END Callback_post_Update_ReplObjStd;
REVEAL ReplObjStdSpecial = SharedObj.Special BRANDED "ObValue.ReplObjStdSpecial" OBJECT OVERRIDES write := DefaultSpWrite_ReplObjStd; read := DefaultSpRead_ReplObjStd; END; TYPE ReplObjStd_Special = Pickle.Special OBJECT mu: MUTEX; sp: ReplObjStdSpecial; registered: BOOLEAN := FALSE; OVERRIDES write := Write_ReplObjStd; read := Read_ReplObjStd; END; PROCEDUREDefaultSpWrite_ReplObjStd (<*UNUSED*>self: ReplObjStdSpecial; shobj: SharedObj.T; out: Pickle.Writer) RAISES {Pickle.Error, Wr.Failure, Thread.Alerted} = VAR obj := NARROW(shobj, ReplObj); BEGIN PickleStubs.OutRef(out, obj.who); PickleStubs.OutRef(out, obj.self); PickleStubs.OutInteger(out, ORD(obj.protected)); PickleStubs.OutRef(out, obj.fields); PickleStubs.OutRef(out, obj.pickleIn); PickleStubs.OutRef(out, obj.pickleOut); END DefaultSpWrite_ReplObjStd; PROCEDUREWrite_ReplObjStd (<*UNUSED*>ts: ReplObjStd_Special; ref: REFANY; out: Pickle.Writer) RAISES {Pickle.Error, Wr.Failure, Thread.Alerted} = VAR obj: ReplObj; sp: ReplObjStdSpecial; tc := TYPECODE(ref); BEGIN IF tc # TYPECODE(ReplObj) AND tc # TYPECODE(ReplObjStd) THEN RAISE Pickle.Error("Can't pickle subtypes of ObValue.ReplObjStd"); END; obj := NARROW(ref, ReplObj); out.writeType(tc); SharedObjStubLib.StartWritePickle(obj, out); LOCK spReplObjStd.mu DO sp := spReplObjStd.sp; END; sp.write(obj, out); SharedObjStubLib.EndWritePickle(obj, out); END Write_ReplObjStd; PROCEDUREDefaultSpRead_ReplObjStd (<*UNUSED*>self: ReplObjStdSpecial; shobj: SharedObj.T; in: Pickle.Reader) RAISES { Pickle.Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted} = VAR obj := NARROW(shobj, ReplObj); BEGIN obj.who := PickleStubs.InRef(in, -1); obj.self := PickleStubs.InRef(in, TYPECODE(ObValue.ValReplObj)); obj.protected := VAL(PickleStubs.InInteger(in, 0,1), BOOLEAN); obj.fields := PickleStubs.InRef(in, -1); obj.pickleIn := PickleStubs.InRef(in, -1); obj.pickleOut := PickleStubs.InRef(in, -1); END DefaultSpRead_ReplObjStd; PROCEDURERead_ReplObjStd (<*UNUSED*>ts: ReplObjStd_Special; in: Pickle.Reader; id: Pickle.RefID):REFANY RAISES { Pickle.Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted} = VAR space: ObjectSpace.T; obj: ReplObj; sp: ReplObjStdSpecial; proxy: EmbProxiedObj.Proxy; tc := in.readType(); BEGIN IF tc = TYPECODE(ReplObjStd) THEN obj := NEW(ReplObjStd); ELSIF tc = TYPECODE(ReplObj) THEN obj := NEW(ReplObj); ELSE RAISE Pickle.Error("Can't unpickle subtypes of ObValue.ReplObjStd"); END; space := in.read(); SharedObjStubLib.StartReadPickle(obj, in, space); LOCK spReplObjStd.mu DO sp := spReplObjStd.sp; END; sp.read(obj, in); IF tc = TYPECODE(ReplObjStd) THEN obj := SharedObjStubLib.SetupNewCopy(obj, in, id, space); proxy := PickleStubs.InRef(in); IF obj.proxy = NIL THEN obj.proxy := proxy; END; obj.makeProxy(); ELSE obj.proxy := NIL; obj.proxy := PickleStubs.InRef(in); END; RETURN obj; END Read_ReplObjStd; PROCEDURERegisterSpecial_ReplObjStd (sp: ReplObjStdSpecial) = <* FATAL DuplicateSpecial *> BEGIN (* we will need to NEW it here if RegisterSpecial_ReplObjStd is called from ObValue *) IF spReplObjStd = NIL THEN spReplObjStd := NEW(ReplObjStd_Special, sc := TYPECODE(ReplObj), mu := NEW(MUTEX)); END; LOCK spReplObjStd.mu DO IF spReplObjStd.registered THEN RAISE DuplicateSpecial; END; spReplObjStd.registered := TRUE; spReplObjStd.sp := sp; END; END RegisterSpecial_ReplObjStd; VAR spReplObjStd: ReplObjStd_Special := NIL; BEGIN IF spReplObjStd = NIL THEN spReplObjStd := NEW(ReplObjStd_Special, sc := TYPECODE(ReplObj), mu := NEW(MUTEX), sp := NEW(ReplObjStdSpecial)); END; Pickle.RegisterSpecial(spReplObjStd); END ObValueSO.