[_CDCSL_93-16_]<1>Cedar>release>X11>XlImplMainLoop.mesa

XlImplMainLoop.mesa

Created by Christian Jacobi, April 7, 1988 6:13:15 pm PST

Christian Jacobi, October 19, 1993 3:39 pm PDT

DIRECTORY

Atom, Basics, ForkOps, IO, Process, Rope, RuntimeError, SafeStorage, Xl, XlDispatch, XlEndianPrivate, XlExtensions, XlKeyButPrivate, XlPrivate, XlPrivateErrorHandling, XlPrivateSplit, XlPrivateTypes, XlRecycleMotionEvents, XlService, XlSpeedHacks, XlPrivateDebug;

XlImplMainLoop: CEDAR MONITOR LOCKS c USING c: Connection

IMPORTS Atom, Basics, ForkOps, IO, Process, RuntimeError, SafeStorage, Xl, XlDispatch, XlExtensions, XlKeyButPrivate, XlPrivate, XlPrivateErrorHandling, XlRecycleMotionEvents, XlService

EXPORTS Xl, XlSpeedHacks, XlPrivate, XlPrivateSplit, XlPrivateDebug

SHARES XlDispatch, XlPrivateTypes =

BEGIN OPEN Xl, XlPrivate;

ConnectionPrivateImplRec: TYPE = XlPrivateTypes.ConnectionPrivateImplRec;

<<Xl.>>ConnectionPrivate: PUBLIC TYPE = XlPrivateTypes.ConnectionPrivateImplRec;

ReplyGotProc: TYPE = XlPrivate.ReplyGotProc;

weAreDebugging: BOOL ~ TRUE; --manifest constant for evential compile time code omissions!

maxReplyLeng: CARD32 = LAST[INT16];

replyTimeout: Process.Ticks ¬ Process.MsecToTicks[10000];

untracedZone: ZONE;

RRead16: PROC [r: Reply] RETURNS [CARD16] = {

RETURN [Read16[r]];

};

RRead32: PROC [r: Reply] RETURNS [CARD32] = {

RETURN [Read32[r]]

};

IReadTime: PROC [c: Connection, r: Reply] RETURNS [t: TimeStamp] = INLINE {

t ¬ [Read32[r]];

c.lastTimeStamp ¬ t;

};

ReadWindow: PROC [r: Reply] RETURNS [Window] ~ {

RETURN [ToWindow[NIL, Read32[r]]]

};

InlineReadWindow: PROC [r: Reply] RETURNS [Window] ~ INLINE {

RETURN [ToWindow[NIL, Read32[r]]]

};

InlineReadINT16: PROC [r: Reply] RETURNS [INT16] = INLINE {

RETURN [LOOPHOLE[Read16[r], INT16]]

};

ReadINT16: PROC [r: Reply] RETURNS [INT16] ~ {

RETURN [LOOPHOLE[Read16[r], INT16]]

};

ReadGeometry: PROC [r: Reply] RETURNS [g: Geometry] ~ {

g.pos.x ¬ ReadINT16[r];

g.pos.y ¬ ReadINT16[r];

g.size.width ¬ RRead16[r];

g.size.height ¬ RRead16[r];

g.borderWidth ¬ RRead16[r];

};

CheckReplyPos: PROC [r: Reply, i: INT¬0] ~ INLINE {

IF r.next+i#32 THEN ERROR;

};

FreeExts: PROC [replyStuff: REF ImplReplyStuffRep] = {

IF replyStuff#NIL THEN {

replyStuff.freeVarPart1 ¬ NIL;

replyStuff.freeVarPart2 ¬ NIL;

replyStuff.freeVarPart3 ¬ NIL;

replyStuff.freeReply1 ¬ NIL;

replyStuff.freeReply2 ¬ NIL;

replyStuff.freeReply3 ¬ NIL;

};

NewExt: PROC [replyStuff: REF ImplReplyStuffRep, reply: Reply, sz: CARD32] = TRUSTED {

--Called only inside Connection Reader process

--Order important since not monitored for speed reasons

t: REF Basics.RawBytes;

leng: CARD;

t ¬ replyStuff.freeVarPart1;

IF t#NIL THEN {

IF (leng ¬ LOOPHOLE[t, REF CARD]) >= sz THEN {

replyStuff.freeVarPart1 ¬ NIL;

reply.varLength ¬ leng;

reply.varPart ¬ t;

RETURN

};

t ¬ replyStuff.freeVarPart2;

IF t#NIL THEN {

IF (leng ¬ LOOPHOLE[t, REF CARD]) >= sz THEN {

replyStuff.freeVarPart2 ¬ NIL;

reply.varLength ¬ leng;

reply.varPart ¬ t;

RETURN

};

t ¬ replyStuff.freeVarPart3;

IF t#NIL THEN {

IF (leng ¬ LOOPHOLE[t, REF CARD]) >= sz THEN {

replyStuff.freeVarPart3 ¬ NIL;

reply.varLength ¬ leng;

reply.varPart ¬ t;

RETURN

};

leng ¬ sz+8; -- increase size for higher probability of reuse

reply.varPart ¬ untracedZone.NEW[Basics.RawBytes[leng]];

reply.varLength ¬ leng;

};

DisposeReply: PUBLIC PROC [c: Connection, r: Reply] = {

rp: REF ImplReplyStuffRep ~ c.replyStuff;

IF r#NIL THEN {

vp: REF Basics.RawBytes ¬ r.varPart;

IF vp#NIL AND r.varLength>3 THEN {

FreeVarpart: PROC [rp: REF ImplReplyStuffRep, vp: REF Basics.RawBytes, bytes: CARD] = TRUSTED {

t: REF Basics.RawBytes;

t ¬ rp.freeVarPart3;

IF t#NIL AND LOOPHOLE[t, POINTER TO CARD] < bytes THEN {

rp.freeVarPart3 ¬ vp; RETURN

};

t ¬ rp.freeVarPart2;

IF t#NIL AND LOOPHOLE[t, POINTER TO CARD] < bytes THEN {

rp.freeVarPart2 ¬ vp; RETURN

};

rp.freeVarPart1 ¬ vp; --give cache a chance to shrink in size

};

TRUSTED {

LOOPHOLE[vp, POINTER TO CARD] ¬ r.varLength

};

SELECT TRUE FROM

rp.freeVarPart1=NIL => rp.freeVarPart1 ¬ vp;

rp.freeVarPart2=NIL => rp.freeVarPart2 ¬ vp;

rp.freeVarPart3=NIL => rp.freeVarPart3 ¬ vp;

ENDCASE => FreeVarpart[rp, vp, r.varLength];

};

r.varPart ¬ NIL; r.varLength ¬ 0;

SELECT TRUE FROM

rp.freeReply1=NIL => rp.freeReply1 ¬ r;

rp.freeReply2=NIL => rp.freeReply2 ¬ r;

rp.freeReply3=NIL => rp.freeReply3 ¬ r;

ENDCASE => {};

};

SafeNewReply: PROC [] RETURNS [r: Reply] = {

r ¬ NEW[ReplyRec];

};

NewReply: PROC [rp: REF ImplReplyStuffRep] RETURNS [r: Reply] = INLINE {

--Not monitored because

--called only inside Connection Reader process

r ¬ rp.freeReply1;

IF r#NIL THEN {rp.freeReply1 ¬ NIL; RETURN};

r ¬ rp.freeReply2;

IF r#NIL THEN {rp.freeReply2 ¬ NIL; RETURN};

r ¬ rp.freeReply3;

IF r#NIL THEN {rp.freeReply3 ¬ NIL; RETURN};

r ¬ SafeNewReply[];

};

DispatchDead: PROC [c: Connection] = {

dispatchHandle: XlDispatch.DispatchHandle ¬ XlDispatch.GetDispatchHandle[c];

ev: REF EventRep.local ~ NEW[EventRep.local];

ev.connection ¬ c;

ev.who ¬ $XlImpl;

ev.key ¬ $ConnectionDead;

ev.data ¬ $ConnectionDead;

XlDispatch.Dispatch[dispatchHandle, ev];

};

MarkDead: PROC [c: Connection] = {

IF c#NIL THEN {

cPriv: REF ConnectionPrivateImplRec ¬ c.cPriv;

FreeExts[c.replyStuff];

c.alive ¬ FALSE;

IF c.bufProblem=NIL THEN c.bufProblem ¬ $dead;

IF cPriv#NIL THEN {

x: REF Connection ¬ cPriv.refRefSelf;

IF x#NIL THEN x ¬ NIL;

};

TRUSTED {Process.Detach[FORK DispatchDead[c]]}; --forked so wedge wouldn't matter

};

HandleKeyPress: PROC [c: Connection, reply: Reply] RETURNS [e: REF EventRep.keyPress ¬ NEW[EventRep.keyPress]] = {

e.keyCode ¬ VAL[Read8[reply]];

e.seq ¬ RRead16[reply];

e.timeStamp ¬ IReadTime[c, reply];

e.root ¬ ReadWindow[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.child ¬ ReadWindow[reply];

e.rootP.x ¬ ReadINT16[reply];

e.rootP.y ¬ ReadINT16[reply];

e.pos.x ¬ ReadINT16[reply];

e.pos.y ¬ ReadINT16[reply];

e.state ¬ XlKeyButPrivate.SetFromWire[Read16[reply]];

e.sameScreen ¬ Read8[reply]#0 ;

CheckReplyPos[reply, 1];

};

HandleKeyRelease: PROC [c: Connection, reply: Reply] RETURNS [e: REF EventRep.keyRelease ¬ NEW[EventRep.keyRelease]] = {

e.keyCode ¬ VAL[Read8[reply]];

e.seq ¬ RRead16[reply];

e.timeStamp ¬ IReadTime[c, reply];

e.root ¬ ReadWindow[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.child ¬ ReadWindow[reply];

e.rootP.x ¬ ReadINT16[reply];

e.rootP.y ¬ ReadINT16[reply];

e.pos.x ¬ ReadINT16[reply];

e.pos.y ¬ ReadINT16[reply];

e.state ¬ XlKeyButPrivate.SetFromWire[Read16[reply]];

e.sameScreen ¬ Read8[reply]#0 ;

CheckReplyPos[reply, 1];

};

HandleButtonPress: PROC [c: Connection, reply: Reply] RETURNS [e: REF EventRep.buttonPress ¬ NEW[EventRep.buttonPress]] = {

e.button ¬ Read8[reply];

e.seq ¬ RRead16[reply];

e.timeStamp ¬ IReadTime[c, reply];

e.root ¬ ReadWindow[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.child ¬ ReadWindow[reply];

e.rootP.x ¬ ReadINT16[reply];

e.rootP.y ¬ ReadINT16[reply];

e.pos.x ¬ ReadINT16[reply];

e.pos.y ¬ ReadINT16[reply];

e.state ¬ XlKeyButPrivate.SetFromWire[Read16[reply]];

e.sameScreen ¬ Read8[reply]#0 ;

CheckReplyPos[reply, 1];

};

HandleButtonRelease: PROC [c: Connection, reply: Reply] RETURNS [e: REF EventRep.buttonRelease ¬ NEW[EventRep.buttonRelease]] = {

e.button ¬ Read8[reply];

e.seq ¬ RRead16[reply];

e.timeStamp ¬ IReadTime[c, reply];

e.root ¬ ReadWindow[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.child ¬ ReadWindow[reply];

e.rootP.x ¬ ReadINT16[reply];

e.rootP.y ¬ ReadINT16[reply];

e.pos.x ¬ ReadINT16[reply];

e.pos.y ¬ ReadINT16[reply];

e.state ¬ XlKeyButPrivate.SetFromWire[Read16[reply]];

e.sameScreen ¬ Read8[reply]#0 ;

CheckReplyPos[reply, 1];

};

HandleEnterNotify: PROC [c: Connection, reply: Reply] RETURNS [e: REF EventRep.enterNotify ¬ NEW[EventRep.enterNotify]] = {

x: BYTE;

e.detail ¬ VAL[Read8[reply]];

e.seq ¬ RRead16[reply];

e.timeStamp ¬ IReadTime[c, reply];

e.root ¬ ReadWindow[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.child ¬ ReadWindow[reply];

e.rootP.x ¬ ReadINT16[reply];

e.rootP.y ¬ ReadINT16[reply];

e.eventP.x ¬ ReadINT16[reply];

e.eventP.y ¬ ReadINT16[reply];

e.state ¬ XlKeyButPrivate.SetFromWire[Read16[reply]];

e.mode ¬ VAL[Read8[reply]];

x ¬ Read8[reply];

e.sameScreen ¬ (x/2) MOD 2 # 0;

e.focus ¬ x MOD 2 # 0;

CheckReplyPos[reply, 0];

};

HandleLeaveNotify: PROC [c: Connection, reply: Reply] RETURNS [e: REF EventRep.leaveNotify ¬ NEW[EventRep.leaveNotify]] = {

x: BYTE;

e.detail ¬ VAL[Read8[reply]];

e.seq ¬ RRead16[reply];

e.timeStamp ¬ IReadTime[c, reply];

e.root ¬ ReadWindow[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.child ¬ ReadWindow[reply];

e.rootP.x ¬ ReadINT16[reply];

e.rootP.y ¬ ReadINT16[reply];

e.eventP.x ¬ ReadINT16[reply];

e.eventP.y ¬ ReadINT16[reply];

e.state ¬ XlKeyButPrivate.SetFromWire[Read16[reply]];

e.mode ¬ VAL[Read8[reply]];

x ¬ Read8[reply];

e.sameScreen ¬ (x/2) MOD 2 # 0;

e.focus ¬ x MOD 2 # 0;

CheckReplyPos[reply, 0];

};

HandleFocusIn: PROC [reply: Reply] RETURNS [e: REF EventRep.focusIn] = {

e ¬ NEW[EventRep.focusIn];

e.detail ¬ VAL[Read8[reply]];

e.seq ¬ RRead16[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.mode ¬ VAL[Read8[reply]];

CheckReplyPos[reply, 23];

};

HandleFocusOut: PROC [reply: Reply] RETURNS [e: REF EventRep.focusOut ¬ NEW[EventRep.focusOut]] = {

e.detail ¬ VAL[Read8[reply]];

e.seq ¬ RRead16[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.mode ¬ VAL[Read8[reply]];

CheckReplyPos[reply, 23];

};

HandleKeymapNotify: PROC [reply: Reply, lastEvent: Event] RETURNS [e: REF EventRep.keymapNotify ¬ NEW[EventRep.keymapNotify]] = {

e.dispatchDrawable ¬ nullDrawable;

FOR i: INT IN [1..31] DO e.keys[i] ¬ Read8[reply] ENDLOOP;

e.previousEvent ¬ lastEvent;

CheckReplyPos[reply, 0];

};

HandleExpose: PROC [reply: Reply] RETURNS [e: REF EventRep.expose ¬ NEW[EventRep.expose]] = {

[] ¬ Read8[reply];

e.seq ¬ RRead16[reply];

e.window ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.window.drawable;

e.pos.x ¬ ReadINT16[reply];

e.pos.y ¬ ReadINT16[reply];

e.size.width ¬ RRead16[reply];

e.size.height ¬ RRead16[reply];

e.count ¬ RRead16[reply];

CheckReplyPos[reply, 14];

};

HandleGraphicsExposure: PROC [reply: Reply] RETURNS [e: REF EventRep.graphicsExposure ¬ NEW[EventRep.graphicsExposure]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.drawable ¬ e.dispatchDrawable ¬ [RRead32[reply]];

e.pos.x ¬ ReadINT16[reply];

e.pos.y ¬ ReadINT16[reply];

e.size.width ¬ RRead16[reply];

e.size.height ¬ RRead16[reply];

e.minorOpcode ¬ RRead16[reply];

e.count ¬ RRead16[reply];

e.majorOpcode ¬ Read8[reply];

CheckReplyPos[reply, 11];

};

HandleNoExposure: PROC [reply: Reply] RETURNS [e: REF EventRep.noExposure ¬ NEW[EventRep.noExposure]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.drawable ¬ e.dispatchDrawable ¬ [RRead32[reply]];

e.minorOpcode ¬ RRead16[reply];

e.majorOpcode ¬ Read8[reply];

CheckReplyPos[reply, 21];

};

HandleVisibilityNotify: PROC [reply: Reply] RETURNS [e: REF EventRep.visibilityNotify ¬ NEW[EventRep.visibilityNotify]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.window ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.window.drawable;

e.state ¬ VAL[Read8[reply]];

CheckReplyPos[reply, 23];

};

HandleCreateNotify: PROC [reply: Reply] RETURNS [e: REF EventRep.createNotify ¬ NEW[EventRep.createNotify]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.parent ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.parent.drawable;

e.window ¬ ReadWindow[reply];

e.geometry ¬ ReadGeometry[reply];

e.overrideRedirect ¬ Read8[reply]#0;

CheckReplyPos[reply, 9];

};

HandleDestroyNotify: PROC [reply: Reply] RETURNS [dne: REF EventRep.destroyNotify ¬ NEW[EventRep.destroyNotify]] = {

Skip[reply, 1];

dne.seq ¬ RRead16[reply];

dne.eventWindow ¬ ReadWindow[reply];

dne.dispatchDrawable ¬ dne.eventWindow.drawable;

dne.window ¬ ReadWindow[reply];

CheckReplyPos[reply, 20];

};

HandleUnmapNotify: PROC [reply: Reply] RETURNS [e: REF EventRep.unmapNotify ¬ NEW[EventRep.unmapNotify]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.window ¬ ReadWindow[reply];

e.fromConfigure ¬ Read8[reply]#0;

CheckReplyPos[reply, 19];

};

HandleMapNotify: PROC [reply: Reply] RETURNS [e: REF EventRep.mapNotify ¬ NEW[EventRep.mapNotify]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.window ¬ ReadWindow[reply];

e.overrideRedirect ¬ Read8[reply]#0;

CheckReplyPos[reply, 19];

};

HandleMapRequest: PROC [reply: Reply] RETURNS [e: REF EventRep.mapRequest ¬ NEW[EventRep.mapRequest]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.parent ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.parent.drawable;

e.window ¬ ReadWindow[reply];

CheckReplyPos[reply, 20];

};

HandleReparentNotify: PROC [reply: Reply] RETURNS [e: REF EventRep.reparentNotify ¬ NEW[EventRep.reparentNotify]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.window ¬ ReadWindow[reply];

e.parent ¬ ReadWindow[reply];

e.pos.x ¬ ReadINT16[reply];

e.pos.y ¬ ReadINT16[reply];

e.overrideRedirect ¬ Read8[reply]#0;

CheckReplyPos[reply, 11];

};

HandleConfigureNotify: PROC [reply: Reply] RETURNS [e: REF EventRep.configureNotify ¬ NEW[EventRep.configureNotify]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.window ¬ ReadWindow[reply];

e.aboveSibling ¬ ReadWindow[reply];

e.geometry ¬ ReadGeometry[reply];

e.overrideRedirect ¬ Read8[reply];

CheckReplyPos[reply, 5];

};

HandleConfigureRequest: PROC [reply: Reply] RETURNS [cre: REF EventRep.configureRequest ¬ NEW[EventRep.configureRequest]] = {

cre.stackMode ¬ VAL[Read8[reply]];

cre.seq ¬ RRead16[reply];

cre.parent ¬ ReadWindow[reply];

cre.dispatchDrawable ¬ cre.parent.drawable;

cre.window ¬ ReadWindow[reply];

cre.sibling ¬ ReadWindow[reply];

cre.geometry ¬ ReadGeometry[reply];

cre.valueMask ¬ RRead16[reply];

CheckReplyPos[reply, 4];

};

HandleGravityNotify: PROC [reply: Reply] RETURNS [e: REF EventRep.gravityNotify ¬ NEW[EventRep.gravityNotify]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.window ¬ ReadWindow[reply];

e.pos.x ¬ ReadINT16[reply];

e.pos.y ¬ ReadINT16[reply];

CheckReplyPos[reply, 16];

};

HandleResizeRequest: PROC [reply: Reply] RETURNS [rre: REF EventRep.resizeRequest ¬ NEW[EventRep.resizeRequest]] = {

Skip[reply, 1];

rre.seq ¬ RRead16[reply];

rre.window ¬ ReadWindow[reply];

rre.dispatchDrawable ¬ rre.window.drawable;

rre.size.width ¬ RRead16[reply];

rre.size.height ¬ RRead16[reply];

CheckReplyPos[reply, 20];

};

HandleCirculateNotify: PROC [reply: Reply] RETURNS [e: REF EventRep.circulateNotify ¬ NEW[EventRep.circulateNotify]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.eventWindow ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.eventWindow.drawable;

e.window ¬ ReadWindow[reply];

[] ¬ ReadWindow[reply];

e.place ¬ VAL[Read8[reply]];

CheckReplyPos[reply, 15];

};

HandleCirculateRequest: PROC [reply: Reply] RETURNS [cre: REF EventRep.circulateRequest ¬ NEW[EventRep.circulateRequest]] = {

Skip[reply, 1];

cre.seq ¬ RRead16[reply];

cre.parent ¬ ReadWindow[reply];

cre.dispatchDrawable ¬ cre.parent.drawable;

cre.window ¬ ReadWindow[reply];

[] ¬ RRead32[reply];

cre.place ¬ VAL[Read8[reply]];

CheckReplyPos[reply, 15];

};

HandlePropertyNotify: PROC [reply: Reply] RETURNS [e: REF EventRep.propertyNotify ¬ NEW[EventRep.propertyNotify]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.window ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.window.drawable;

e.atom.a ¬ RRead32[reply];

e.timeStamp.t ¬ RRead32[reply];

e.state ¬ VAL[Read8[reply]];

CheckReplyPos[reply, 15];

};

HandleSelectionClear: PROC [c: Connection, reply: Reply] RETURNS [e: REF EventRep.selectionClear ¬ NEW[EventRep.selectionClear]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.timeStamp ¬ IReadTime[c, reply];

e.owner ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.owner.drawable;

e.selection.a ¬ RRead32[reply];

CheckReplyPos[reply, 16];

};

HandleSelectionRequest: PROC [c: Connection, reply: Reply] RETURNS [e: REF EventRep.selectionRequest ¬ NEW[EventRep.selectionRequest]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.timeStamp ¬ IReadTime[c, reply];

e.owner ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.owner.drawable;

e.requestor ¬ ReadWindow[reply];

e.selection.a ¬ RRead32[reply];

e.target.a ¬ RRead32[reply];

e.property.a ¬ RRead32[reply];

CheckReplyPos[reply, 4];

};

HandleSelectionNotify: PROC [c: Connection, reply: Reply] RETURNS [e: REF EventRep.selectionNotify ¬ NEW[EventRep.selectionNotify]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.timeStamp ¬ IReadTime[c, reply];

e.requestor ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.requestor.drawable;

e.selection.a ¬ RRead32[reply];

e.target.a ¬ RRead32[reply];

e.property.a ¬ RRead32[reply];

CheckReplyPos[reply, 8];

};

HandleColormapNotify: PROC [reply: Reply] RETURNS [e: REF EventRep.colorMapNotify ¬ NEW[EventRep.colorMapNotify]] = {

Skip[reply, 1];

e.seq ¬ RRead16[reply];

e.window ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.window.drawable;

e.colorMap ¬ [RRead32[reply]];

e.new ¬ Read8[reply]#0;

e.installed ¬ Read8[reply]=1;

CheckReplyPos[reply, 18];

};

HandleClientMessage: PROC [reply: Reply] RETURNS [e: REF EventRep.clientMessage ¬ NEW[EventRep.clientMessage.b]] = {

e.format ¬ Read8[reply];

e.seq ¬ RRead16[reply];

e.window ¬ ReadWindow[reply];

e.dispatchDrawable ¬ e.window.drawable;

e.typeAtom.a ¬ RRead32[reply];

SELECT e.format FROM

16 => FOR i: [0..10) IN [0..10) DO e.h[i] ¬ RRead16[reply] ENDLOOP;

32 => FOR i: [0..5) IN [0..5) DO e.w[i] ¬ RRead32[reply] ENDLOOP;

ENDCASE => FOR i: [0..20) IN [0..20) DO e.b[i] ¬ Read8[reply] ENDLOOP;

CheckReplyPos[reply, 0];

};

HandleMapping: PROC [c: Connection, reply: Reply] RETURNS [mne: REF EventRep.mappingNotify ¬ NEW[EventRep.mappingNotify]] = {

cp: REF ConnectionPrivateImplRec ~ c.cPriv;

mne.dispatchDrawable ¬ nullDrawable;

Skip[reply, 1];

mne.seq ¬ RRead16[reply];

mne.request ¬ VAL[Read8[reply]];

mne.firstKeycode ¬ Read8[reply];

mne.count ¬ Read8[reply];

CheckReplyPos[reply, 25];

<<flush caches!>>

SELECT mne.request FROM

modifier => {

XlService.PutServiceProp[c, $x11PrivateMMappings, NIL]; --order!

cp.mMappings ¬ NIL;

};

keyboard => {

XlService.PutServiceProp[c, $x11PrivateKMappings, NIL]; --order!

cp.kMappings ¬ NIL;

};

pointer => {

BEGIN -- because the keyboard mapping might include some buttons

XlService.PutServiceProp[c, $x11PrivateKMappings, NIL];

cp.kMappings ¬ NIL;

END;

XlService.PutServiceProp[c, $x11PrivatePMappings, NIL]; --order!

cp.pMappings ¬ NIL;

};

ENDCASE => {

--This is an error; but It is not disabling further access to the connection

};

--caching on service might not prevent multiple get-mapping requests since one connection might issue the get-mapping request before an other connection flushed the cache; however this is unusual, and would not lead to wrong data but only to an efficiency loss.

};

PartialIOError: ERROR = CODE; --Raised when stream stops with only partial information on it

ConnectionReader: PROC [data: REF] ~ {

This is forked as a process to handle all the errors, replys, and events. Since this is the only process that reads, it does so without a monitor. It calls ENTRY procs to dispense the gathered data.

ENABLE {

UNWIND => {MarkDead[NARROW[data]]};

ABORTED => {MarkDead[NARROW[data]]};

IO.EndOfStream => {

c: Connection ~ NARROW[data];

MarkDead[c];

IF c.recv=stream OR c.recv=IO.noInputStream OR c.recv=NIL THEN GOTO exitQuietly;

};

IO.Error => {

c: Connection ~ NARROW[data];

MarkDead[c];

IF c.recv=stream OR c.recv=IO.noInputStream OR c.recv=NIL THEN GOTO exitQuietly;

};

PartialIOError => {

c: Connection ~ NARROW[data];

MarkDead[c];

GOTO exitQuietly;

};

RuntimeError.UNCAUGHT => {

c: Connection ¬ NARROW[data];

c.alive ¬ FALSE

--Not caught; please debug this and then put in a specific catch phrase

};

DetachReply: PROC [] RETURNS [r: Reply] = INLINE {

--Inline to get rid of intermediate level variables in ConnectionReader

r ¬ reply;

reply ¬ NewReply[c.replyStuff];

};

c: Connection ¬ NARROW[data];

dispatchHandle: XlDispatch.DispatchHandle ¬ XlDispatch.GetDispatchHandle[c];

event, lastEvent: REF EventRep ¬ NIL;

reply: Reply ¬ SafeNewReply[];

mEventCache: REF XlRecycleMotionEvents.EventCache ¬ XlRecycleMotionEvents.GetCache[c, [[LAST[CARD]]]];

readyExtEvent: REF EventRep.extension ¬ NEW[EventRep.extension];

TRUSTED {

cnt: INT = IO.UnsafeGetBlock[c.recv, [base: LOOPHOLE[@reply.fix], count: 32]];

IF cnt#32 THEN {

c.alive ¬ FALSE;

IF cnt=0 AND IO.EndOf[c.recv]

THEN GOTO exitQuietly

ELSE ERROR PartialIOError;

};

SetPos[reply, 1];

SELECT (Get8[reply, 0] MOD 128) FROM

1 => {--Reply; should be fast

detached: Reply ~ DetachReply[];

sequenceNumber: Xl.SequenceNo ~ Get16[detached, 2];

more: CARD32 ~ Get32[detached, 4];

IF more>0 THEN {

nBytesRead: CARD32;

replyBytes: CARD32 ~ more*4;

NewExt[c.replyStuff, detached, replyBytes];

TRUSTED {

nBytesRead ¬ IO.UnsafeGetBlock[self: c.recv,

block: [base: LOOPHOLE[detached.varPart], startIndex: 0, count: replyBytes]

];

};

IF nBytesRead#replyBytes THEN { --ByteCountWrong

c.alive ¬ FALSE;

ERROR PartialIOError;

};

QueueReply[c, sequenceNumber, detached];

LOOP

};

ORD[EventCode[motionNotify]] => {--should be fast

HandleMotion: PROC [reply: Reply] RETURNS [mne: REF EventRep.motionNotify] = INLINE {

mne ¬ mEventCache.m1; mEventCache.m1 ¬ NIL;

IF mne=NIL THEN {

mne ¬ mEventCache.m2; mEventCache.m2 ¬ NIL;

IF mne=NIL THEN mne ¬ NEW[EventRep.motionNotify];

};

mne.detail ¬ VAL[Read8[reply]];

mne.seq ¬ Read16[reply];

mne.timeStamp ¬ [Read32[reply]];

mne.root ¬ InlineReadWindow[reply];

mne.eventWindow ¬ InlineReadWindow[reply];

mne.dispatchDrawable ¬ mne.eventWindow.drawable;

mne.child ¬ InlineReadWindow[reply];

mne.rootP.x ¬ InlineReadINT16[reply];

mne.rootP.y ¬ InlineReadINT16[reply];

mne.pos.x ¬ InlineReadINT16[reply];

mne.pos.y ¬ InlineReadINT16[reply];

mne.state ¬ XlKeyButPrivate.SetFromWire[Read16[reply]];

mne.sameScreen ¬ Read8[reply]#0;

CheckReplyPos[reply, 1];

RETURN [mne]

};

event ¬ HandleMotion[reply];

};

ORD[EventCode[keyPress]] => event ¬ HandleKeyPress[c, reply];

ORD[EventCode[keyRelease]] => event ¬ HandleKeyRelease[c, reply];

ORD[EventCode[buttonPress]] => event ¬ HandleButtonPress[c, reply];

ORD[EventCode[buttonRelease]] => event ¬ HandleButtonRelease[c, reply];

ORD[EventCode[enterNotify]] => event ¬ HandleEnterNotify[c, reply];

ORD[EventCode[leaveNotify]] => event ¬ HandleLeaveNotify[c, reply];

ORD[EventCode[focusIn]] => event ¬ HandleFocusIn[reply];

ORD[EventCode[focusOut]] => event ¬ HandleFocusOut[reply];

ORD[EventCode[keymapNotify]] => event ¬ HandleKeymapNotify[reply, lastEvent];

ORD[EventCode[expose]] => event ¬ HandleExpose[reply];

ORD[EventCode[graphicsExposure]] => event ¬ HandleGraphicsExposure[reply];

ORD[EventCode[noExposure]] => event ¬ HandleNoExposure[reply];

ORD[EventCode[visibilityNotify]] => event ¬ HandleVisibilityNotify[reply];

ORD[EventCode[createNotify]] => event ¬ HandleCreateNotify[reply];

ORD[EventCode[destroyNotify]] => {

dne: REF EventRep.destroyNotify ~ HandleDestroyNotify[reply];

event ¬ dne;

--Normal dispatch and then remove of data structures.

--It would look more elegant if removal of data structures were registered like a normal dispatch, but we want to keep the dispatch lists short and prefer special code for efficiency reasons.

event.originalCodeByte ¬ Get8[reply, 0];

event.connection ¬ c;

XlDispatch.Dispatch[dispatchHandle, event];

IF dne.window=dne.eventWindow AND event.originalCodeByte=ORD[EventCode[destroyNotify]] THEN { --we are not interested in inferiors nor in clients sending this event

XlDispatch.RemoveWindow[c, dne.window]; --NOT eventWindow!

};

lastEvent ¬ dne;

LOOP

};

ORD[EventCode[unmapNotify]] => event ¬ HandleUnmapNotify[reply];

ORD[EventCode[mapNotify]] => event ¬ HandleMapNotify[reply];

ORD[EventCode[mapRequest]] => event ¬ HandleMapRequest[reply];

ORD[EventCode[reparentNotify]] => event ¬ HandleReparentNotify[reply];

ORD[EventCode[configureNotify]] => event ¬ HandleConfigureNotify[reply];

ORD[EventCode[configureRequest]] => event ¬ HandleConfigureRequest[reply];

ORD[EventCode[gravityNotify]] => event ¬ HandleGravityNotify[reply];

ORD[EventCode[resizeRequest]] => event ¬ HandleResizeRequest[reply];

ORD[EventCode[circulateNotify]] => event ¬ HandleCirculateNotify[reply];

ORD[EventCode[circulateRequest]] => event ¬ HandleCirculateRequest[reply];

ORD[EventCode[propertyNotify]] => event ¬ HandlePropertyNotify[reply];

ORD[EventCode[selectionClear]] => event ¬ HandleSelectionClear[c, reply];

ORD[EventCode[selectionRequest]] => event ¬ HandleSelectionRequest[c, reply];

ORD[EventCode[selectionNotify]] => event ¬ HandleSelectionNotify[c, reply];

ORD[EventCode[colorMapNotify]] => event ¬ HandleColormapNotify[reply];

ORD[EventCode[clientMessage]] => event ¬ HandleClientMessage[reply];

ORD[EventCode[mappingNotify]] => event ¬ HandleMapping[c, reply];

0 => {--error

detached: Reply ~ DetachReply[];

sequenceNumber: Xl.SequenceNo ¬ Get16[detached, 2];

QueueReply[c, sequenceNumber, detached];

LOOP

};

ENDCASE => {

readyExtEvent.dispatchDrawable ¬ nullDrawable;

readyExtEvent.bytes ¬ reply.fix;

readyExtEvent.originalCodeByte ¬ Get8[reply, 0];

readyExtEvent.connection ¬ c;

lastEvent ¬ readyExtEvent;

IF ~XlExtensions.ProcessExtensionEvent[readyExtEvent].reuse THEN {

readyExtEvent ¬ NEW[EventRep.extension];

};

LOOP;

};

event.originalCodeByte ¬ Get8[reply, 0];

event.connection ¬ c;

lastEvent ¬ event;

XlDispatch.Dispatch[dispatchHandle, event];

ENDLOOP;

EXITS

exitQuietly => {};

};

QueueError: INTERNAL PROC [c: Connection, sequenceNumber: Xl.SequenceNo, replyText: Reply] ~ {

err: REF EventRep.errorNotify ¬ XlPrivateErrorHandling.NewErrorEvent[replyText, c, sequenceNumber];

Enqueue[c.errorMatch.tq, c.errorMatch.proc, c.errorMatch.data, err];

};

KillReplies: PUBLIC PROC [c: Connection, wedged: BOOL ¬ TRUE] = TRUSTED {

rp: REF ImplReplyStuffRep ~ c.replyStuff;

IF rp#NIL THEN {

p: Acceptor ¬ rp.dequeuePoint;

rp.enqueuePoint ¬ NIL; --not monitored, but this procedure is idempotent

rp.dequeuePoint ¬ NIL;

WHILE p#NIL DO

next: Acceptor ¬ p.next;

p.replyText ¬ NewFakeErrorReply[p.sequenceNo, (IF wedged THEN connectionWedged ELSE requestFromDeadConnection)];

p.mayContinue ¬ TRUE;

p ¬ next;

ENDLOOP

};

--Its not necessary to notify: replyReceived will time out.

--This makes KillReplies callable external and internal

};

NewReplyStuff: PROC [] RETURNS [rp: REF ImplReplyStuffRep] = TRUSTED {

rp ¬ NEW[ImplReplyStuffRep];

Process.InitializeCondition[@rp.gotGeneralReply, replyTimeout];

};

--good if modular arithmetic on SequenceNo works

--e.g. bitnumber of container allows it and SequenceNo fills container

InOrderStrictly: PROC [s1, s2: SequenceNo] RETURNS [BOOL] = INLINE {

--returns s1 happened strictly before s2

--INT32 for modulo 2**32 arithmetic

RETURN [(LOOPHOLE[s2, INT32]-LOOPHOLE[s1, INT32]) > 0]

};

InOrderOrSame: PROC [s1, s2: SequenceNo] RETURNS [BOOL] = INLINE {

--returns s1 happened before s2 or at the same time but not later

--INT32 for modulo 2**32 arithmetic

RETURN [(LOOPHOLE[s2, INT32]-LOOPHOLE[s1, INT32]) >= 0]

};

--good if modular arithmetic on SequenceNo does not work

--e.g. If machine has no modular arithmetic

--e.g. SequenceNo does not fill container

sequenceHalf: Xl.SequenceNo = LAST[CARD16]/2; --half of used range; independent on container

InOrderStrictly: PROC [s1, s2: SequenceNo] RETURNS [BOOL] = INLINE {

--returns s1 happened strictly before s2

IF s2>s1

THEN RETURN [(s2-s1) < sequenceHalf]

ELSE RETURN [(s1-s2) > sequenceHalf]

};

InOrderOrSame: PROC [s1, s2: SequenceNo] RETURNS [BOOL] = INLINE {

--returns s1 happened before s2 or at the same time but not later

IF s2>=s1

THEN RETURN [(s2-s1) < sequenceHalf]

ELSE RETURN [(s1-s2) > sequenceHalf]

};

ArrivalExpected: PROC [c: Connection, s: SequenceNo] RETURNS [BOOL] = INLINE {

--Returns "waiting for arrival of reply makes sense"

--under the assumption that the request s really sends a reply

rp: REF ImplReplyStuffRep ~ c.replyStuff;

IF InOrderStrictly[rp.lastAnswerdSeq, s] THEN {

--it isn't here yet!

--find out whether request is already initiated...

--[note: c.sequenceNumber is incremented before request is on the wire]

RETURN [ InOrderOrSame[s, c.sequenceNumber] ]

};

--its already here, ==> its arrival won't happen again

RETURN [FALSE]

};

ReportedSequenceNumber: PUBLIC PROC [c: Connection] RETURNS [SequenceNo] = {

rp: REF ImplReplyStuffRep ~ c.replyStuff;

RETURN [rp.lastAnswerdSeq]

};

WaitInitiatedRange: PUBLIC PROC [c: Connection, s: SequenceNo, flush: BOOL ¬ TRUE] = {

--If s reasonable and not too old then waits until reply is sent

--If s is too old or not reasonable, returns immediately

--Use 3 little monitors instead a big one so we don't need to catch UNWIND

Enter: ENTRY PROC [c: Connection, rp: REF ImplReplyStuffRep] = INLINE {

rp.generalWaiters ¬ rp.generalWaiters+1;

};

Leave: ENTRY PROC [c: Connection, rp: REF ImplReplyStuffRep] = INLINE {

rp.generalWaiters ¬ MAX[rp.generalWaiters-1, 0];

};

Wait: ENTRY PROC [c: Connection, rp: REF ImplReplyStuffRep] = {

WAIT rp.gotGeneralReply;

};

Flush: ENTRY PROC [c: Connection] = {

XlPrivate.HardFlushBuffer[c];

};

rp: REF ImplReplyStuffRep ~ c.replyStuff;

flushed: BOOL ¬ FALSE;

IF rp=NIL THEN RETURN;

Enter[c, rp];

WHILE ArrivalExpected[c, s] AND c.alive AND c.bufProblem=NIL DO

IF flush THEN {Flush[c]; flush ¬ FALSE};

Wait[c, rp];

ENDLOOP;

Leave[c, rp];

};

InitiateRoundTrip: PUBLIC ENTRY PROC [c: Connection, flush: BOOL] RETURNS [seq: SequenceNo ¬ 0] = {

rp: REF ImplReplyStuffRep ~ c.replyStuff;

p: Acceptor ¬ NewAcceptor[rp, ignoreAndFree];

BInit[c, 43, 0, 1]; --GetInputFocus

seq ¬ c.sequenceNumber;

ActivateAcceptor[rp, p, seq];

FinishRequest[c];

IF flush THEN XlPrivate.HardFlushBuffer[c];

DontWaitForReplies[c, p];

};

ReplyStuffRep: PUBLIC TYPE = ImplReplyStuffRep;

ImplReplyStuffRep: TYPE = RECORD [

--Free lists

freeReply1, freeReply2, freeReply3: Reply ¬ NIL, --free'd unprotected

freeVarPart1, freeVarPart2, freeVarPart3: REF Basics.RawBytes ¬ NIL, --free'd unprotected

freeAcceptors: Acceptor,

--Implementing pending requests

enqueuePoint: Acceptor, --youngest element of queue for new requests

dequeuePoint: Acceptor, --oldest element of queue not yet notified Acceptor

--Implementing WaitInitiatedRange

generalWaiters: INT ¬ 0, --count of waiters without explicit Acceptor

lastAnswerdSeq: SequenceNo ¬ 0,

gotGeneralReply: CONDITION

];

AcceptingCase: TYPE = {normalSingle, errorsAndOver, multiple, ignoreAndFree, specialDebugSingle};

Acceptor: TYPE = REF AcceptorRec;

AcceptorRec: TYPE = RECORD [

next: PRIVATE Acceptor ¬ NIL,

sequenceNo: Xl.SequenceNo,

case: AcceptingCase,

inQueue, doneWaiting: BOOL ¬ FALSE, --acceptor may be put on free list only if inQueue=FALSE and doneWaiting=TRUE

mayContinue: BOOL ¬ FALSE,

condition: CONDITION ¬ [],

errorMatch, overMatch: Xl.Match ¬ NIL,

replyText: Reply ¬ NIL,--used for requests with single replys

reportPartOfMultiple: ReplyGotProc ¬ NIL, --used for requests with multiple replies

data: REF ¬ NIL --used for requests with multiple replies

];

NewAcceptor: INTERNAL PROC [i: REF ImplReplyStuffRep, case: AcceptingCase] RETURNS [Acceptor] = {

--Get acceptor from free list or allocate one

--Caller must either call WaitForReplies or DontWaitForReplies so we know when to free it again

p: Acceptor ¬ i.freeAcceptors;

IF p=NIL

THEN {

p ¬ NEW[AcceptorRec];

--Just for the case when connection dies

TRUSTED {Process.InitializeCondition[@p.condition, replyTimeout]};

}

ELSE {

i.freeAcceptors ¬ p.next;

p.next ¬ NIL;

p.doneWaiting ¬ FALSE;

p.mayContinue ¬ FALSE;

};

p.case ¬ case;

RETURN [p];

};

FreeAcceptor: INTERNAL PROC [i: REF ImplReplyStuffRep, p: Acceptor] = {

--Put acceptor on free list

p.next ¬ i.freeAcceptors;

i.freeAcceptors ¬ p;

p.replyText ¬ NIL;

p.data ¬ NIL;

p.overMatch ¬ p.errorMatch ¬ NIL;

};

ActivateAcceptor: INTERNAL PROC [i: REF ImplReplyStuffRep, p: Acceptor, seq: Xl.SequenceNo] = {

--Enable acceptor to receive replies

prev: Acceptor ¬ i.enqueuePoint;

IF weAreDebugging AND p.inQueue THEN ERROR;

IF weAreDebugging AND p.next#NIL THEN ERROR;

p.inQueue ¬ TRUE;

p.sequenceNo ¬ seq;

IF prev = NIL

THEN i.dequeuePoint ¬ p

ELSE prev.next ¬ p;

i.enqueuePoint ¬ p;

};

DeActivateAcceptor: INTERNAL PROC [i: REF ImplReplyStuffRep, p: Acceptor] = {

--No replies will be accepted anymore

--Acceptor is freed if there is no waiter

IF weAreDebugging AND ~p.inQueue THEN ERROR;

IF weAreDebugging AND i.dequeuePoint#p THEN ERROR;

p.inQueue ¬ FALSE;

IF (i.dequeuePoint ¬ p.next)=NIL THEN i.enqueuePoint ¬ NIL;

IF p.doneWaiting THEN FreeAcceptor[i, p];

};

WaitForReplies: INTERNAL PROC [c: Xl.Connection, p: Acceptor] RETURNS [replyText: Reply] = <<INLINE>> {

WHILE ~p.mayContinue AND c.alive DO

WARNING: This test is possible only because a periodical process requesting replies prevents p.sequenceNo to increase a whole 2**15 over the i.lastAnswerdSeq

IF weAreDebugging THEN {

i: REF ImplReplyStuffRep ~ c.replyStuff;

IF InOrderOrSame[p.sequenceNo, i.lastAnswerdSeq] THEN ERROR

};

WAIT p.condition;

ENDLOOP;

p.doneWaiting ¬ TRUE;

replyText ¬ p.replyText;

IF ~p.inQueue THEN FreeAcceptor[c.replyStuff, p];

};

DontWaitForReplies: INTERNAL PROC [c: Xl.Connection, p: Acceptor] = {

--don't activate acceptor after calling DontWaitForReplies

p.doneWaiting ¬ TRUE;

IF ~p.inQueue THEN FreeAcceptor[c.replyStuff, p];

};

NotifyReceiptOfReply: INTERNAL PROC [p: Acceptor] = INLINE {

p.mayContinue ¬ TRUE;

NOTIFY p.condition; --only one waiter

};

FinishRequest: PROC [c: Connection] = INLINE {

IF c.bufNext+c.bufSkipped#c.bufExpected THEN XlPrivate.BadImplError[c];

c.bufReady ¬ c.bufNext;

c.needFlushing ¬ TRUE;

};

NewFakeErrorReply: PROC [sequenceNumber: CARD, error: Xl.ErrorKind] RETURNS [reply: Reply] = {

used: CARD16 ¬ Basics.LowHalf[sequenceNumber];

reply ¬ SafeNewReply[];

reply.fix[0] ¬ 0;

reply.fix[1] ¬ ORD[error];

reply.fix[2+XlEndianPrivate.highOff] ¬ Basics.HighByte[used];

reply.fix[2+XlEndianPrivate.lowOff] ¬ Basics.LowByte[used];

};

FinishWithReply: PUBLIC INTERNAL PROC [c: Connection] RETURNS [replyText: Reply ¬ NIL] = {

rp: REF ImplReplyStuffRep ~ c.replyStuff;

p: Acceptor ¬ NewAcceptor[rp, specialDebugSingle];

ActivateAcceptor[rp, p, c.sequenceNumber];

FinishRequest[c];

XlPrivate.HardFlushBuffer[c];

replyText ¬ WaitForReplies[c, p];

};

DebugFinishWithReply: PUBLIC INTERNAL PROC [c: Connection] RETURNS [replyText: Reply ¬ NIL] = {

rp: REF ImplReplyStuffRep ~ c.replyStuff;

p: Acceptor ¬ NewAcceptor[rp, normalSingle];

ActivateAcceptor[rp, p, c.sequenceNumber];

FinishRequest[c];

XlPrivate.HardFlushBuffer[c];

replyText ¬ WaitForReplies[c, p];

};

debugArrayCnt: INT = 4000; --same as in XlImplUtilities

DebugArray: TYPE = ARRAY [0..debugArrayCnt) OF BYTE ¬ ALL[0];

debugReplyNotExpected: SIGNAL ~ CODE;

debugTheNotExpectedReply: Reply;

debugTheNotExpectedFix: REF PACKED ARRAY [0..32) OF BYTE ¬ NIL;

debugSignalOnNotExpectedReply: BOOL ¬ FALSE;

DebugNotExpectedRepliesTRUE: PROC [] = {debugSignalOnNotExpectedReply ¬ TRUE};

DebugNotExpectedRepliesFALSE: PROC [] = {debugSignalOnNotExpectedReply ¬ FALSE};

In production we want to prevent to wedge the connection, even if something went wrong.

For debugging we prefer to raise problems as early as possible.

ExpectedReply: INTERNAL PROC [c: Connection, p: Acceptor, replyText: Reply] = <<INLINE>> {

SELECT p.case FROM

normalSingle => {

p.replyText ¬ replyText;

NotifyReceiptOfReply[p];

DeActivateAcceptor[c.replyStuff, p];

};

multiple => {

more: BOOL;

IF p.data=doneWithMultiple THEN {

--make an error, or, forget about it

RETURN

};

more ¬ p.reportPartOfMultiple[c, replyText, p.data];

IF ~more THEN {p.data ¬ doneWithMultiple; NotifyReceiptOfReply[p]};

};

errorsAndOver => {

errorMatch: Xl.Match ~ p.errorMatch;

IF errorMatch#NIL THEN {

tq: Xl.TQ ¬ errorMatch.tq;

err: REF EventRep.errorNotify ~ NEW[EventRep.errorNotify];

err.seq ¬ p.sequenceNo;

err.connection ¬ c;

err.originalCodeByte ¬ replyText.fix[0];

err.replyText ¬ replyText;

IF tq=NIL THEN tq ¬ Xl.CreateTQ[];

Xl.Enqueue[tq, errorMatch.proc, errorMatch.data, err];

p.overMatch ¬ NIL;

};

p.replyText ¬ replyText;

NotifyReceiptOfReply[p];

};

ignoreAndFree => {

IF replyText.fix[0]=1 THEN DisposeReply[c, replyText];

DeActivateAcceptor[c.replyStuff, p];

NotifyReceiptOfReply[p];

};

specialDebugSingle => {

IF p.data=$gotit THEN {

specialDebugCount ¬ specialDebugCount+1;

Atom.PutProp[$XlDebug, $XlDebugSP, NEW[INT ¬ specialDebugCount]];

};

p.data ¬ $gotit;

p.replyText ¬ replyText;

NotifyReceiptOfReply[p];

};

ENDCASE => ERROR;

};

specialDebugCount: INT ¬ 0;

AbsenceOfReply: INTERNAL PROC [c: Connection, p: Acceptor] = <<INLINE>> {

SELECT p.case FROM

ignoreAndFree => {

--ok; maybe somebody waits (dependent on who set up)

};

errorsAndOver => {

--this is expected

--maybe somebody waits (dependent on who set up)

IF p.overMatch#NIL THEN {

overMatch: Xl.Match ~ p.overMatch;

tq: Xl.TQ ¬ overMatch.tq;

ev: REF Xl.EventRep.local ¬ NEW[Xl.EventRep.local];

ev.connection ¬ c;

ev.who ¬ $noreply;

ev.key ¬ $noreply;

IF tq=NIL THEN tq ¬ Xl.CreateTQ[];

Xl.Enqueue[tq, overMatch.proc, overMatch.data, ev];

};

normalSingle => {

--we didn't get the expected reply (or error)

p.replyText ¬ NewFakeErrorReply[p.sequenceNo, otherLocal]

};

specialDebugSingle => {

--we have to check whether we got a reply or not

IF p.data=$gotit

THEN NULL --normal case; looks like absence because we didn't remove acceptor yet

ELSE {

p.replyText ¬ NewFakeErrorReply[p.sequenceNo, otherLocal]

};

multiple => {

IF p.data#doneWithMultiple THEN {

--Must abort the waiter

p.replyText ¬ NewFakeErrorReply[p.sequenceNo, otherLocal]

};

ENDCASE => ERROR;

NotifyReceiptOfReply[p];

};

UnexpectedReplyOrError: INTERNAL PROC [c: Connection, sequenceNumber: SequenceNo, replyText: Reply] = {

IF ~c.alive THEN RETURN; --pending list may have been freed before reply arrived

SELECT replyText.fix[0] FROM

0 => { --error event

<<a regular client error event, reported by the X server>>

};

1 => { --reply "event"

--An un-expected reply

--Could this be generated by a dying connection? I'm not sure but that is why debugging this is optional.

cPriv: REF ConnectionPrivateImplRec ¬ c.cPriv;

fix: REF PACKED ARRAY [0..32) OF BYTE ¬ NEW[PACKED ARRAY [0..32) OF BYTE ¬ replyText.fix];

debugTheNotExpectedReply ¬ replyText;

debugTheNotExpectedFix ¬ fix;

Atom.PutProp[$XlDebug, $XlDebug0, c];

Atom.PutProp[$XlDebug, $XlDebug1, NEW[INT ¬ sequenceNumber]];

Atom.PutProp[$XlDebug, $XlDebug2, fix];

WITH cPriv.debug SELECT FROM

da: REF DebugArray => {

copy: REF DebugArray ¬ NEW[DebugArray ¬ da]; This copy used not to work correctly; I'm suspecting the C compiler but have no prove yet!!

copy: REF DebugArray ¬ NEW[DebugArray];

FOR i: [0..debugArrayCnt) IN [0..debugArrayCnt) DO

copy[i] ¬ da[i]

ENDLOOP;

Atom.PutProp[$XlDebug, $XlDebug3, copy];

WITH Atom.GetProp[$XlDebug, $DebugStream] SELECT FROM

s: IO.STREAM => {

idx: INT ¬ (sequenceNumber MOD debugArrayCnt) + 2*debugArrayCnt; --make it positive enough that simple mod will work

IO.PutRope[s, "un-expected reply\ntext:"];

FOR i: INT IN [0..32) DO

IO.PutF1[s, " %g", IO.int[fix[i]]]

ENDLOOP;

IO.PutF1[s, "\nsequencenumber %g \n", IO.int[sequenceNumber]];

IO.PutF[s, "request codes: %g %g %g\n", IO.int[da[(idx-1) MOD debugArrayCnt]], IO.int[da[idx MOD debugArrayCnt]], IO.int[da[(idx+1) MOD debugArrayCnt]]]

};

ENDCASE => {};

};

ENDCASE => { <<debugging this wasn't set up>> };

IF debugSignalOnNotExpectedReply OR Atom.GetProp[$XlDebug, $SignalReplyNotExpected] # NIL THEN {

SIGNAL debugReplyNotExpected;

};

ENDCASE => ERROR; --Program logic should not call UnexpectedReplyOrError in this case

QueueError[c, sequenceNumber, replyText];

};

QueueReply: ENTRY PROC [c: Connection, sequenceNumber: SequenceNo, replyText: Reply] ~ TRUSTED {

Called from the event dipatcher loop only: therefore calls are in order of sequenceNumber

i: REF ImplReplyStuffRep ~ c.replyStuff;

--I tried to check for InOrderStrictly, but that might not be possible if 2**15 requests don't need replies.

i.lastAnswerdSeq ¬ sequenceNumber;

IF i.generalWaiters>0 THEN BROADCAST i.gotGeneralReply;

p: Acceptor ¬ i.dequeuePoint;

IF p=NIL THEN {

UnexpectedReplyOrError[c, sequenceNumber, replyText];

RETURN

};

IF p.sequenceNo=sequenceNumber THEN {

ExpectedReply[c, p, replyText]; --might or might not dequeue p

RETURN

};

IF InOrderStrictly[sequenceNumber, p.sequenceNo] THEN {

--leave p alone!

UnexpectedReplyOrError[c, sequenceNumber, replyText];

RETURN

};

AbsenceOfReply[c, p];

DeActivateAcceptor[i, p];

ENDLOOP

};

doneWithMultiple: REF ~ NEW[INT ¬ 0];

FinishWithMultipleReplies: PUBLIC INTERNAL PROC [c: Connection, callback: ReplyGotProc, data: REF ¬ NIL] ~ TRUSTED {

rp: REF ImplReplyStuffRep ~ c.replyStuff;

p: Acceptor ¬ NewAcceptor[rp, multiple];

p.reportPartOfMultiple ¬ callback;

p.data ¬ data;

ActivateAcceptor[rp, p, c.sequenceNumber];

FinishRequest[c];

XlPrivate.HardFlushBuffer[c];

[] ¬ WaitForReplies[c, p];

};

FinishWithPartialDetailsNoErrors: PUBLIC INTERNAL PROC [c: Connection, details: Details ¬ NIL] RETURNS [errors: REF Xl.EventRep.errorNotify ¬ NIL] = {

--Like FinishWithDetailsNoErrors but uses only errorMatch and synchronous of details.

--This is useful to implement multi-request commands.

FinishRequest[c];

IF details#NIL

THEN {

details.sequenceNo ¬ c.sequenceNumber;

IF details.synchronous THEN {errors ¬ FinishSynchToCheckForErrors[c]; RETURN};

IF details.errorMatch#NIL THEN {

p: Acceptor ¬ NewAcceptor[c.replyStuff, errorsAndOver];

p.errorMatch ¬ details.errorMatch;

ActivateAcceptor[c.replyStuff, p, c.sequenceNumber];

DontWaitForReplies[c, p];

}

ELSE {

IF c.synchCount>0 THEN errors ¬ FinishSynchToCheckForErrors[c];

};

InlineFinishWithDetailsNoErrors: INTERNAL PROC [c: Connection, details: Details ¬ NIL] RETURNS [errors: REF Xl.EventRep.errorNotify ¬ NIL] = <<INLINE>> {

FinishRequest[c];

IF details#NIL

THEN {

--note: c.synchCount is only consulted with details=NIL

details.sequenceNo ¬ c.sequenceNumber;

IF details.synchronous THEN {errors ¬ FinishSynchToCheckForErrors[c]; RETURN};

IF details.errorMatch#NIL OR details.overMatch#NIL THEN {

p: Acceptor ~ NewAcceptor[c.replyStuff, errorsAndOver];

p.errorMatch ¬ details.errorMatch;

p.overMatch ¬ details.overMatch;

ActivateAcceptor[c.replyStuff, p, c.sequenceNumber];

DontWaitForReplies[c, p];

};

IF details.flush=now THEN XlPrivate.HardFlushBuffer[c];

}

ELSE {

IF c.synchCount>0 THEN errors ¬ FinishSynchToCheckForErrors[c];

};

FinishWithDetailsNoErrors: PUBLIC INTERNAL PROC [c: Connection, details: Details ¬ NIL] RETURNS [errors: REF Xl.EventRep.errorNotify ¬ NIL] = {

errors ¬ InlineFinishWithDetailsNoErrors[c, details];

};

FinishWithDetails: PUBLIC INTERNAL PROC [c: Connection, details: Details ¬ NIL] = {

errors: REF Xl.EventRep.errorNotify ¬ InlineFinishWithDetailsNoErrors[c, details];

IF errors#NIL THEN XlPrivateErrorHandling.RaiseErrorEvent[errors];

};

FinishSynchToCheckForErrors: INTERNAL PROC [c: Connection] RETURNS [error: REF EventRep.errorNotify ¬ NIL] ~ TRUSTED {

--Use only when no replies are expected

IF c.alive THEN {

rp: REF ImplReplyStuffRep ~ c.replyStuff;

clientReply: Reply;

clientAcceptor, extraAcceptor: Acceptor;

clientAcceptor ¬ NewAcceptor[rp, errorsAndOver];

ActivateAcceptor[rp, clientAcceptor, c.sequenceNumber];

StartDirectRequest[c, 43, 0, 1]; --GetInputFocus

FinishRequest[c];

extraAcceptor ¬ NewAcceptor[rp, ignoreAndFree];

ActivateAcceptor[rp, extraAcceptor, c.sequenceNumber];

XlPrivate.HardFlushBuffer[c];

clientReply ¬ WaitForReplies[c, clientAcceptor];

IF clientReply#NIL THEN {

error ¬ XlPrivateErrorHandling.NewErrorEvent[clientReply, c];

DontWaitForReplies[c, extraAcceptor];

RETURN;

};

DontWaitForReplies[c, extraAcceptor];

[] ¬ WaitForReplies[c, extraAcceptor];

};

StartMainLoop: PUBLIC PROC [c: Connection] = {

cp: REF ConnectionPrivateImplRec ~ c.cPriv;

c.replyStuff ¬ NewReplyStuff[];

IF Xl.Alive[c] THEN {

ForkOps.Fork[ConnectionReader, c, Process.priorityClient3<<the user waits and looks at the terminal>>];

};

TRUSTED {

untracedZone ¬ SafeStorage.GetUntracedZone[];

};

END.