XlDispatchImpl.mesa
Copyright Ó 1990, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Christian Jacobi, November 12, 1990 5:42 pm PST
Christian Jacobi, September 14, 1993 4:16 pm PDT
DIRECTORY
Basics,
CardTab,
Xl,
XlDetails,
XlDispatch,
XlExtensions,
XlRecycleMotionEvents,
XlPrivate,
XlPrivateResources;
XlDispatchImpl:
CEDAR
MONITOR
IMPORTS Basics, CardTab, Xl, XlDetails, XlPrivate, XlPrivateResources
EXPORTS Xl, XlDispatch, XlRecycleMotionEvents
SHARES XlPrivate, XlPrivateResources ~
BEGIN OPEN Xl, XlPrivate;
DispatchHandle: TYPE = REF DispatchHandleRec;
DispatchHandleRec: <<XlDispatch>>
PUBLIC
TYPE =
RECORD [
wDataTab: CardTab.Ref ¬ NIL,
priviledgeds: DispatchList ¬ NIL,
junkies: REF DispatchList ¬ NIL, --REF to make type intersting only...
cache: REF XlRecycleMotionEvents.EventCache
];
DispatchStuffRep: <<Xl>>PUBLIC TYPE = DispatchHandleRec;
DispatchList: TYPE = REF DispatchListRep;
DispatchListRep:
TYPE =
RECORD [
currLength: NAT ¬ 0,
s: SEQUENCE maxLength: NAT OF DispatchRec
];
DispatchRec: TYPE = RECORD [activate: EventCodes, tq: TQ, proc: EventProcType, data: REF, activateExtensions: LIST OF REF ¬ NIL, events: SetOfEvent ¬ unspecifiedEvents];
WindowData: TYPE = REF WindowDataRec;
WindowDataRec:
PUBLIC
TYPE =
RECORD [
All fields protected with C-Lock
dl: DispatchList ¬ NIL,
externalEvents: SetOfEvent ¬ unspecifiedEvents, --best guess on what external clients want
internalEvents: SetOfEvent ← unspecifiedEvents, --All events required by matchlists (removed because computed)
actualEvents: SetOfEvent ¬ unspecifiedEvents --believed server settings
];
NotYetDefined: EventProcType = {--prevent trapping if called before initialized--};
ProcRemoved: EventProcType = {--prevent trapping if called after removal--};
dummy: REF XlRecycleMotionEvents.EventCache ¬ NEW[XlRecycleMotionEvents.EventCache];
GetCache: <<XlRecycleMotionEvents>>
PUBLIC
PROC [c: Xl.Connection, w: Xl.Window]
RETURNS [cache:
REF XlRecycleMotionEvents.EventCache ¬ dummy] = {
h: DispatchHandle ¬ GetDispatchHandle[c];
IF Xl.WindowId[w]=CARD.LAST THEN RETURN [h.cache]; --sentinell for allocator
WITH CardTab.Fetch[h.wDataTab, w.id].val
SELECT
FROM
wd: WindowData => {
dl: DispatchList ¬ wd.dl;
IF dl#
NIL
THEN {
count: INT ¬ 0;
FOR i:
NAT
IN [0..dl.currLength)
DO
IF dl[i].activate[motionNotify] THEN count ¬ count+1
ENDLOOP;
IF count=1 THEN cache ¬ h.cache
};
};
ENDCASE => {};
};
GetDispatchHandle:
PUBLIC
PROC [c: Connection]
RETURNS [DispatchHandle] = {
RETURN [c.dispatchStuff]
};
InlineDispatch:
PROC [handle: DispatchHandle, event: Event] =
INLINE {
WITH CardTab.Fetch[handle.wDataTab, event.dispatchDrawable.id].val
SELECT
FROM
wd: WindowData => DispatchOneList[event, wd.dl];
ENDCASE => DispatchOneList[event, handle.junkies];
IF handle.priviledgeds#NIL THEN DispatchOneList[event, handle.priviledgeds];
};
FindAndDispatch:
PUBLIC
PROC [event: Event] = {
InlineDispatch[event.connection.dispatchStuff, event];
};
Dispatch:
PUBLIC
PROC [handle: DispatchHandle, event: Event] = {
InlineDispatch[handle, event];
};
DispatchExplicite:
PUBLIC
PROC [wd: WindowData, event: Event] = {
DispatchOneList[event, wd.dl];
};
DispatchOneList:
PROC [e: Event, dl: DispatchList] = {
checks event against dispatch list and queues calls on match
IF dl=NIL THEN RETURN;
IF Basics.
BITAND[e.originalCodeByte, 127]>=XlExtensions.firstExtension
THEN {
--extension event
WITH e
SELECT
FROM
xEvent: ExtensionEvent => {
FOR i:
NAT
IN [0..dl.currLength)
DO
FOR xl:
LIST
OF
REF
ANY ¬ dl[i].activateExtensions, xl.rest
WHILE xl#
NIL
DO
IF xl.first=xEvent.match
THEN {
p: EventProcType ~ dl[i].proc; --order!
Enqueue[dl[i].tq, p, dl[i].data, e]; EXIT --innermost loop
}
ENDLOOP
ENDLOOP
};
ENDCASE => {}
}
ELSE {
--normal case: standard event
FOR i:
NAT
IN [0..dl.currLength)
DO
IF dl[i].activate[e.type]
THEN {
p: EventProcType ~ dl[i].proc; --order!
Enqueue[dl[i].tq, p, dl[i].data, e];
};
ENDLOOP;
};
};
RemoveWindowData: <<C-Lock>>
PROC [c: Connection, w: Window] = {
h: DispatchHandle ~ c.dispatchStuff;
[] ¬ CardTab.Delete[h.wDataTab, w.id];
};
GetWindowData:
PUBLIC
PROC [c: Connection, w: Window]
RETURNS [WindowData] = {
h: DispatchHandle ~ c.dispatchStuff;
RETURN [NARROW[CardTab.Fetch[h.wDataTab, w.id].val]];
};
GetOrCreateWindowData: <<C-Lock>>
PROC [c: Connection, w: Window]
RETURNS [wd: WindowData] = {
C-Lock to prevent interference of removing and creating WindowData
h: DispatchHandle ~ c.dispatchStuff;
wd ¬ NARROW[CardTab.Fetch[h.wDataTab, w.id].val];
IF wd=
NIL
THEN {
wd ¬ NEW[WindowDataRec];
IF CardTab.Insert[h.wDataTab, w.id, wd] THEN RETURN [wd];
wd ¬ GetOrCreateWindowData[c, w];
};
};
UsedLength:
PROC [dl: DispatchList]
RETURNS [n:
CARD ¬ 0] = {
Returns number of used entries in DispatchList
IF dl#
NIL
THEN
FOR i:
NAT
IN [0..dl.currLength)
DO
IF dl[i].proc#ProcRemoved THEN n ¬ n+1;
ENDLOOP;
};
Convention
container: REF DispatchList => use DispatchList (for junkies)
container: WindowData => use wd.dl (for normal events)
container: REF DispatchHandleRec => use h.priviledged (for priviledged events)
In languages with VAR parameters this would be easy.
With trace and sweep garbage collection using the ADDRESS would work.
Using this convention allows reference counted runtime of Dorado.
SetDispatchList:
INTERNAL
PROC [container:
REF, dl: DispatchList] = {
WITH container
SELECT
FROM
wd: WindowData => wd.dl ¬ dl;
rdl: REF DispatchList => rdl ¬ dl;
h: REF DispatchHandleRec => h.priviledgeds ¬ dl;
ENDCASE => ERROR;
};
GetDispatchList:
INTERNAL
PROC [container:
REF]
RETURNS [dl: DispatchList] = {
WITH container
SELECT
FROM
wd: WindowData => dl ¬ wd.dl;
rdl: REF DispatchList => dl ¬ rdl;
h: REF DispatchHandleRec => dl ¬ h.priviledgeds;
ENDCASE => ERROR;
};
EnsureEntry:
INTERNAL
PROC [container:
REF]
RETURNS [i:
NAT, dl: DispatchList] = {
Returns index in DispatchList ready to be filled in (fields reasonably initialized)
Also returns dl; but only reason is to be optimizer proof
dl ¬ GetDispatchList[container];
IF dl=
NIL
THEN {dl ¬ NEW[DispatchListRep[4]]; SetDispatchList[container, dl]}
ELSE
IF dl.currLength >= dl.maxLength
THEN {
use: NAT ¬ UsedLength[dl];
IF use>=
NAT.
LAST-4
THEN {
--silly error too long dispatch list,
--wedge or crash the connection but not inside global monitor please
dl.currLength ¬ dl.currLength-1;
}
ELSE {
new: NAT ¬ use+4;
dl2: DispatchList ¬ NEW[DispatchListRep[new]];
dl2.currLength ¬ 0;
IF dl#
NIL
THEN {
FOR i:
NAT
IN [0..dl.currLength)
DO
IF dl[i].proc#ProcRemoved
THEN {
dl2[dl2.currLength] ¬ dl[i]; dl2.currLength ¬ dl2.currLength + 1;
};
ENDLOOP;
};
dl ¬ dl2;
SetDispatchList[container, dl];
};
};
--order of (dl.currLength) !
i ¬ dl.currLength;
dl[i].activate ¬ ALL[FALSE];
dl[i].activateExtensions ¬ NIL;
dl[i].proc ¬ NotYetDefined;
dl.currLength ¬ dl.currLength+1;
};
AddMatchToList:
ENTRY
PROC [container:
REF, match: Match, events: SetOfEvent ¬ unspecifiedEvents] = {
IF match#
NIL
THEN {
activate: EventCodes;
tq: TQ ¬ match.tq;
handles: EventFilter ¬ match.handles;
proc: EventProcType ¬ match.proc;
IF tq=NIL THEN tq ¬ CreateTQ[];
IF handles=NIL OR proc=NIL OR (handles.activate=ALL[FALSE] AND handles.activateExtensions=NIL) THEN RETURN;
BEGIN
n: NAT; dl: DispatchList;
[n, dl] ¬ EnsureEntry[container];
--get order right as dispatching is not monitored
dl[n].data ¬ match.data;
dl[n].tq ¬ tq;
dl[n].events ¬ events;
dl[n].proc ¬ proc;
dl[n].activateExtensions ¬ handles.activateExtensions;
dl[n].activate ¬ handles.activate;
END;
};
};
RemoveMatchFromList:
ENTRY
PROC [container:
REF, proc: EventProcType, tq: Xl.
TQ, data:
REF] = {
--makes entry a noop; still needs external removing
--entry and indirection to safe against allocating a new list
dl: DispatchList ¬ GetDispatchList[container];
IF dl#
NIL
THEN
FOR i:
NAT
IN [0..dl.currLength)
DO
IF dl[i].proc = proc
AND dl[i].tq=tq
AND dl[i].data=data
THEN {
order optional !
dl[i].activate ¬ ALL[FALSE];
dl[i].activateExtensions ¬ NIL;
dl[i].proc ¬ ProcRemoved;
};
ENDLOOP
};
GetInternalEvents:
PROC [dl: DispatchList]
RETURNS [events: SetOfEvent ¬ unspecifiedEvents] = {
IF dl#
NIL
THEN
FOR i:
NAT
IN [0..dl.currLength)
DO
IF dl[i].proc#ProcRemoved
THEN
events ¬ Xl.ORSetOfEvents[events, dl[i].events];
ENDLOOP;
};
PrivateChangeEvents: <<C-Lock>>
PROC [c: Connection, w: Window, e: SetOfEvent, details: Details ¬
NIL] = {
IF w=Xl.nullWindow THEN ERROR;
BInit[c, 2, 0, 3+1]; --ChangeWindowAttributes
BPutDrawable[c, w];
BPut32[c, 0800H]; --use event-mask field
BPut32[c, LOOPHOLE[e]];
FinishWithDetails[c, details];
IF details=
NIL
THEN {
XlPrivate.HardFlushBuffer[c: c, delay: XlPrivateResources.ValidID[c, w]];
Thoughts about damage if destroy happens in small not yet active time:
If w is owned by this connection no immediate flush is required as the worst case behaviour is either only a memory leak, or a very fast re-creation of the window. Re-creation will however remove the dispatchlist first so no old events are dispatched.
If the window was owned by a different connection we can not do this test. We hope that clients requesting events on different connections do an extra test themselves using details#NIL.
XError ought to be caught.
};
};
InternalAddMatch:
PUBLIC <<C-Lock>>
PROC [c: Connection, w: Window, match: Match, generate: SetOfEvent] = {
wd: WindowData ¬ GetOrCreateWindowData[c, w];
generate.structureNotify ¬ TRUE;
wd.actualEvents ¬ Xl.ORSetOfEvents[generate, wd.actualEvents]; --trust the caller to actually set it
AddMatchToList[wd, match, generate];
};
AddMatches:
PUBLIC
PROC [c: Connection, w: Window, matchList: MatchList, generate: SetOfEvent, details: Details ¬
NIL] = {
FOR l: MatchList ¬ matchList, l.rest
WHILE l#
NIL
DO
AddMatch[c, w, l.first, generate, details];
ENDLOOP
};
AddMatch:
PUBLIC
PROC [c: Connection, w: Window, match: Match, generate: SetOfEvent, details: Details] = {
--You wouldn't believe it, but the nullWindow is ok (used for mapping changes)
action:
PROC [c: Connection] = {
wd: WindowData ¬ GetOrCreateWindowData[c, w];
newEvents: Xl.SetOfEvent ¬ Xl.ORSetOfEvents[wd.externalEvents, wd.actualEvents];
newEvents ¬ Xl.ORSetOfEvents[newEvents, generate];
newEvents.structureNotify ¬ TRUE;
AddMatchToList[wd, match, generate];
--Make sure the right events are requested.
--Can ignore internalEvents as (except for generate) they are included in actualEvents.
IF newEvents#wd.actualEvents
THEN {
wd.actualEvents ¬ newEvents;
IF w#Xl.nullWindow THEN PrivateChangeEvents[c, w, wd.actualEvents, details];
};
};
generate.structureNotify ¬ TRUE;
DoWithLocks[c, action, details];
};
RemoveMatch:
PUBLIC
PROC [c: Connection, w: Window, match: Match, details: Details] = {
action:
PROC [c: Connection] = {
--Need C-Lock to protect wd.dl and wd.externalEvents
RemoveMatchFromList[wd, proc, match.tq, match.data];
IF ~XlPrivateResources.ValidID[c, w]
THEN {
--other connection owns this w
n: NAT ¬ UsedLength[wd.dl];
IF n=0 THEN RemoveWindowData[c, w];
};
BEGIN
internal: SetOfEvent ¬ GetInternalEvents[wd.dl]; --necessary structureNotifies are embedded
new: SetOfEvent ¬ ORSetOfEvents[internal, wd.externalEvents];
IF new#wd.actualEvents
THEN {
wd.actualEvents ¬ new;
IF w#Xl.nullWindow THEN PrivateChangeEvents[c, w, new, details];
};
END;
};
--local copy prevents troubles inside monitor
proc: EventProcType ¬ match.proc;
wd: WindowData = GetWindowData[c, w];
IF wd#NIL AND match#NIL THEN DoWithLocks[c, action, details];
};
AddMatchForUnregistered:
PUBLIC
PROC [c: Connection, match: Match] = {
action:
PROC [c: Connection] = {
h: DispatchHandle ~ c.dispatchStuff;
AddMatchToList[h.junkies, match];
};
DoWithLocks[c, action, XlDetails.ignoreErrors];
};
EnforcedSetOfEvent:
PUBLIC <<C-Lock>>
PROC [c: Connection, w: Window, external: SetOfEvent]
RETURNS [SetOfEvent ¬ unspecifiedEvents] = {
IF external#unspecifiedEvents
THEN {
wd: WindowData = GetOrCreateWindowData[c, w];
internal: SetOfEvent ¬ GetInternalEvents[wd.dl];
wd.externalEvents ¬ external;
external ¬ Xl.ORSetOfEvents[internal, external];
external.structureNotify ¬ TRUE; --enforce future removal of WindowData
RETURN [external];
};
};
AddPriviledgedMatch:
PUBLIC
PROC [c: Connection, match: Match] = {
action:
PROC [c: Connection] = {
h: DispatchHandle ~ c.dispatchStuff;
AddMatchToList[h, match];
};
DoWithLocks[c, action, XlDetails.ignoreErrors];
};
RemovePriviledgedMatch:
PUBLIC
PROC [c: Connection, match: Match] = {
action:
PROC [c: Connection] = {
CheckForEmpty:
ENTRY
PROC [h: DispatchHandle] = {
--speed up normal case of no priviledgeds; normally there aren't any
IF UsedLength[h.priviledgeds]=0 THEN h.priviledgeds ¬ NIL
};
h: DispatchHandle ~ c.dispatchStuff;
RemoveMatchFromList[h, proc, match.tq, match.data];
CheckForEmpty[h];
};
proc: EventProcType ¬ match.proc;
DoWithLocks[c, action, XlDetails.ignoreErrors];
InitWindow:
PUBLIC
PROC [c: Connection, w: Window] = {
Paranoia: remove previous dispatchlist just in case due to errors it would be still around
h: DispatchHandle ~ c.dispatchStuff;
[] ¬ CardTab.Delete[h.wDataTab, w.id];
};
RemoveWindow:
PUBLIC
PROC [c: Connection, w: Window] = {
h: DispatchHandle ~ c.dispatchStuff;
IF w#nullWindow
THEN {
deleted: BOOL ¬ CardTab.Delete[h.wDataTab, w.id];
--Check for deleted; "openwin-3.0-beta" used to send multiple DestroyNotify events!
--A window id leak for windows without not beeing included in the table is benign enough to accept for the benefit of not debugging openwin-3.0-beta again and again.
IF deleted AND XlPrivateResources.ValidID[c, w.id] THEN XlPrivateResources.EntryFreeResourceID[c, w.id];
}
};
InitConnection:
PUBLIC
PROC [c: Connection] = {
c.dispatchStuff ¬
NEW[DispatchHandleRec ¬ [
wDataTab: CardTab.Create[],
junkies: NEW[DispatchList],
cache: NEW[XlRecycleMotionEvents.EventCache]
]];
[] ¬ GetOrCreateWindowData[c, Xl.nullWindow];
FOR i:
NAT
IN [0..Xl.ScreenCount[c])
DO
[] ¬ GetOrCreateWindowData[c, Xl.NthScreen[c, i].root];
ENDLOOP
};
END.