GCCallBackImpl.mesa
Copyright Ó 1990, 1991 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, May 30, 1990 3:18:36 pm PDT
Christian Jacobi, June 1, 1990 10:56 am PDT
DIRECTORY
GCCallBack, UXProcs;
GCCallBackImpl: CEDAR MONITOR
IMPORTS UXProcs
EXPORTS GCCallBack
~ BEGIN
Note that this module
a) Converts the C level features of /xr/GC.h into Cedar level.
b) Takes charge that previous registrations are called.
c) Takes charge of the semantics difference. /xr/GC.h might be dependent of this particular garbage collector, while GCCallBack abstracts from it. This implementation adds the semantic specification that it notifies the stop-the-world effect (even if it is very short); not the collector dependent phase "garbage collection happens".
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/GC.h>.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/GC.h>.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];
};
DoCollectNow: PROC [] = {
--Necessary for debugging only
XRGCollect: PROC [] = TRUSTED MACHINE CODE {"<xr/GC.h>.XR←GCollect"};
XRGCollect[];
};
END.