<> <> <> <> <<>> DIRECTORY GCCallBack, UXProcs; GCCallBackImpl: CEDAR MONITOR IMPORTS UXProcs EXPORTS GCCallBack ~ BEGIN <> <> <> <> dontGC: LIST OF REF ¬ NIL; DontGC: ENTRY PROC [x: REF] = { dontGC ¬ CONS[x, dontGC]; }; ProcDescritorBody: TYPE = RECORD [proc: UXProcs.CProc ¬ 0, data: WORD ¬ 0]; WrapRec: TYPE = RECORD [ oldDescriptor: ProcDescritorBody, oldProc: PROC[REF], oldData: REF, thisProc: PROC[REF], thisData: REF ]; WrapLast: PROC [wrap: REF WrapRec] = { IF wrap.oldDescriptor.proc#0 THEN wrap.oldProc[wrap.oldData]; wrap.thisProc[wrap.thisData]; }; RegisterBefore: PUBLIC PROC [proc: PROC[REF], clientData: REF ¬ NIL] = TRUSTED { XRRegisterGCCallBackBefore: PROC [proc: UXProcs.CProc, clientdata: WORD, oldproc: POINTER TO UXProcs.CProc, oldclientdata: POINTER TO REF] = TRUSTED MACHINE CODE { ".XR_RegisterGCCallBackBefore" }; wrap: REF WrapRec ¬ NEW[WrapRec]; wrap.thisProc ¬ proc; wrap.thisData ¬ clientData; wrap.oldProc ¬ LOOPHOLE[@wrap.oldDescriptor.proc]; --do this before installing callback (Do this instead of UXProcs.ToCedarProc so it is immediately ready (with XRRegisterGCCallBackBefore) and won't do allocations if done inside WrapLast.) DontGC[wrap]; XRRegisterGCCallBackBefore[proc: UXProcs.FromCedarProc[WrapLast], clientdata: LOOPHOLE[wrap], oldproc: LOOPHOLE[@wrap.oldDescriptor.proc], oldclientdata: @wrap.oldData]; }; RegisterAfter: PUBLIC PROC [proc: PROC[REF], clientData: REF ¬ NIL] = TRUSTED { XRRegisterGCCallBackAfter: PROC [proc: UXProcs.CProc, clientdata: WORD, oldproc: POINTER TO UXProcs.CProc, oldclientdata: POINTER TO REF] = TRUSTED MACHINE CODE { ".XR_RegisterGCCallBackAfter" }; wrap: REF WrapRec ¬ NEW[WrapRec]; wrap.thisProc ¬ proc; wrap.thisData ¬ clientData; wrap.oldProc ¬ LOOPHOLE[@wrap.oldDescriptor.proc]; --do this before installing callback... DontGC[wrap]; XRRegisterGCCallBackAfter[proc: UXProcs.FromCedarProc[WrapLast], clientdata: LOOPHOLE[wrap], oldproc: LOOPHOLE[@wrap.oldDescriptor.proc], oldclientdata: @wrap.oldData]; }; <> <<--Necessary for debugging only>> <.XR_GCollect"};>> <> <<};>> END.