
DIRECTORY Basics, Rope, Xl, XlEndianPrivate;

XlPrivate: CEDAR DEFINITIONS
SHARES Xl
~ BEGIN OPEN Xl, XlEndianPrivate;

BadImplError: PROC [c: Connection];

PaddingBytes: PROC [n: INT] RETURNS [INT];
DoWithLocks: PROC [c: Connection, action: PROC [c: Connection], details: Xl.Details];
RequestHeader: TYPE = MACHINE DEPENDENT RECORD [
opCode: BYTE,
minor: BYTE,
length: CARD16 --in 32 bit word units
];

AssertBuffer: PROC [c: Connection, bytes: CARD] = INLINE {
IF (c.bufLimit-c.bufNext)<bytes THEN RealAssertBuffer[c, bytes]
};
RealAssertBuffer: PRIVATE PROC [c: Connection, bytes: CARD];

FineAssertBuffer: PROC [c: Connection, bytes: CARD] = INLINE {
IF (c.bufLimit-c.bufNext)<bytes THEN RealFineAssertBuffer[c, bytes]
};
RealFineAssertBuffer: PRIVATE PROC [c: Connection, bytes: CARD];

SoftFlushBuffer: PROC [c: Connection, delay: BOOL ¬ FALSE] = INLINE {
IF c.bufReady#0 THEN RealFlushBuffer[c, delay]
};
HardFlushBuffer: PROC [c: Connection, delay: BOOL ¬ FALSE] = INLINE {
IF c.bufReady#0 OR c.needFlushing THEN RealFlushBuffer[c, delay]
};
RealFlushBuffer: PRIVATE PROC [c: Connection, delay: BOOL ¬ FALSE];


PWArray: TYPE = LONG POINTER TO PACKED ARRAY [0..0) OF CARD32;
PHArray: TYPE = LONG POINTER TO PACKED ARRAY [0..0) OF CARD16;

IBPut8: PROC [c: Connection, b: BYTE] = TRUSTED INLINE {
n: CARD ~ c.bufNext;
c.buf[n] ¬ b; 
c.bufNext ¬ n+1;
};

IBPut16: PROC [c: Connection, b: CARD16] = TRUSTED INLINE {
n: CARD ~ c.bufNext;
p: PHArray ~ LOOPHOLE[c.buf];
p[n/2] ¬ b;
c.bufNext ¬ n+2
};

IBPut32: PROC [c: Connection, b: CARD32] = TRUSTED INLINE {
p: PWArray ~ LOOPHOLE[c.buf];
n: CARD ~ c.bufNext;
p[n/4] ¬ b;
c.bufNext ¬ n+4;
};

BInit: PROC [c: Connection, opCode: BYTE, minor: BYTE ¬ 0, length: INT];
BInitPartial: PROC [c: Connection, opCode: BYTE, minor: BYTE ¬ 0, length: INT, assertBytes: CARD ¬ 0];
BPut8: PROC [c: Connection, b: BYTE];
BPut16: PROC [c: Connection, b: CARD16];
BPut32: PROC [c: Connection, b: CARD32];
BSkip: PROC [c: Connection, cnt: INT] = INLINE {c.bufNext ¬ c.bufNext+LOOPHOLE[cnt]};

BPut0s: PROC [c: Connection, cnt: INT];
BPutBool: PROC [c: Connection, b: BOOL];
BPutINT16: PROC [c: Connection, i: INT16];
BPutINT32as16: PROC [c: Connection, i: INT32];
BPutDrawable: PROC [c: Connection, d: Drawable];
BPutPoint: PROC [c: Connection, p: Point];
BPutSize: PROC [c: Connection, s: Size];
BPutRect: PROC [c: Connection, p: Point, s: Size];
BPutPixmap: PROC [c: Connection, p: Pixmap];
BPutColorMap: PROC [c: Connection, m: ColorMap];
BPutTime: PROC [c: Connection, t: TimeStamp];
BPutVisual: PROC [c: Connection, v: Visual];
BPutCursor: PROC [c: Connection, cursor: Cursor];

BPutSetOfEvent: PROC [c: Connection, s: SetOfEvent];

BPutPaddedRope: PROC [c: Connection, rope: ROPE, start: INT ¬ 0, len: INT ¬ LAST[INT]];
BPutRope: PROC [c: Connection, rope: ROPE, start: INT ¬ 0, len: INT ¬ LAST[INT]];
BContinueWithBlock: PROC [c: Connection, blockBytes: CARD] RETURNS [LONG POINTER];
BRequestWithBlock: PROC [c: Connection, opCode: BYTE, blockBytes: CARD, additionalBytes: CARD ¬ 0] RETURNS [LONG POINTER];
BPutPad: PROC [c: Connection, len: INT] = INLINE {
BSkip[c, PaddingBytes[len]];
};

BPutRectangles: PROC [c: Xl.Connection, rects: Xl.PackedRects, start, num: INT];
ContinueDirectRequest: PROC [c: Connection];
StartDirectRequest: PROC [c: Connection, opCode: BYTE, minor: BYTE ¬ 0, length: CARD16];

DPutBYTE: PROC [c: Connection, byte: BYTE];
DPutCARD16: PROC [c: Connection, val: CARD16];
DPutINT16: PROC [c: Connection, i: INT16] ~ INLINE {DPutCARD16[c, LOOPHOLE[i]]};
DPutCARD32: PROC [c: Connection, val: CARD32];
DPutWindow: PROC [c: Connection, w: Window];
DPutTime: PROC [c: Connection, t: TimeStamp] = INLINE {DPutCARD32[c, t.t]};
DPutPaddedRope: PROC [c: Connection, rope: ROPE, start: INT ¬ 0, len: INT ¬ LAST[INT]];
DPutPad: PROC [c: Connection, len: INT];
GetTextCARD16: PROC [text: REF TEXT, startPos: INT] RETURNS [CARD16];
GetTextCARD32: PROC [text: REF TEXT, startPos: INT] RETURNS [CARD32];

ToWindow: PROC [c: Connection, id: ID] RETURNS [w: Window] = INLINE {
RETURN [[[id]]]
};

ToPixmap: PROC [c: Connection, id: ID] RETURNS [p: Pixmap] = INLINE {
RETURN [[[id]]]
};

ToVisual: PROC [c: Connection, id: ID] RETURNS [v: Visual] = INLINE {
RETURN [[id]]
};
ToCBool: PROC [b: BOOL] RETURNS [BYTE] = INLINE {
RETURN [ORD[b]]
};

UseGContext: <<INTERNAL>> PROC [c: Connection, drawable: Drawable, gc: GContext, partialDetails: Details] RETURNS [id: ID];
InternalRoundTrip: PROC [c: Connection];

Reply: TYPE = REF ReplyRec; 
ReplyRec: TYPE = MACHINE DEPENDENT RECORD [
cheat: PACKED ARRAY [0..0) OF BYTE,  
fix: PACKED ARRAY [0..32) OF BYTE ¬ ALL[0],  
varPart: REF Basics.RawBytes ¬ NIL,
varLength: CARD ¬ 0, --length of allocated varPart (maybe longer then necessary)
next: INT ¬ 0 --position for reading next field
];

RopeFromRaw: UNSAFE PROC [p: LONG POINTER TO Basics.RawBytes, start: CARD, len: INT] RETURNS [Rope.ROPE];

FinishWithReply: --INTERNAL-- PROC [c: Connection] RETURNS [reply: Reply];
FinishWithMultipleReplies: --INTERNAL-- PROC [c: Connection, callback: ReplyGotProc, data: REF ¬ NIL];
ReplyGotProc: TYPE = PROC [c: Connection, reply: Reply, data: REF] RETURNS [more: BOOL ¬ FALSE];
FinishWithDetails: --INTERNAL-- PROC [c: Connection, details: Details ¬ NIL];
FinishWithDetailsNoErrors: --INTERNAL-- PROC [c: Connection, details: Details ¬ NIL] RETURNS [errors: REF Xl.EventRep.errorNotify ¬ NIL];
FinishWithPartialDetailsNoErrors: --INTERNAL-- PROC [c: Connection, details: Details] RETURNS [errors: REF Xl.EventRep.errorNotify ¬ NIL];
DisposeReply: PROC [c: Connection, r: Reply];

CheckReply: PROC [r: Reply];

SetPos: PROC [r: Reply, startByte: INT ¬ 0] = INLINE {r.next ¬ startByte};

Skip: PROC [r: Reply, bytes: INT ¬ 1] = INLINE {r.next ¬ r.next+bytes};

Read8: PROC [r: Reply] RETURNS [b: BYTE] = TRUSTED INLINE {
b ¬ r.cheat[r.next]; r.next ¬ r.next+1;
};

Read16: PROC [r: Reply] RETURNS [c: CARD16] = TRUSTED INLINE {
c ¬ r.cheat[r.next+highOff]*256+r.cheat[r.next+lowOff];
r.next ¬ r.next+2;
};

Read32: PROC [r: Reply] RETURNS [CARD32] = TRUSTED INLINE {
four: FourBytes = [
hh: r.cheat[r.next+hhOff],
hl: r.cheat[r.next+hlOff],
lh: r.cheat[r.next+lHOff],
ll: r.cheat[r.next+llOff]
];
r.next ¬ r.next+4;
RETURN [LOOPHOLE[four]];
};
Get8: PROC [r: Reply, pos: INT] RETURNS [BYTE] = TRUSTED INLINE {
RETURN [r.cheat[pos]] --avoid the bounds check...
};

Get16: PROC [r: Reply, pos: INT] RETURNS [CARD16] = TRUSTED INLINE {
RETURN [ r.cheat[pos+highOff]*256+r.cheat[pos+lowOff] ];
};

Get32: PROC [r: Reply, pos: INT] RETURNS [CARD32] = TRUSTED INLINE {
RETURN [LOOPHOLE[ FourBytes[
hh: r.cheat[pos+hhOff],
hl: r.cheat[pos+hlOff],
lh: r.cheat[pos+lHOff],
ll: r.cheat[pos+llOff]
]]];
};

ERead8: PROC [r: Reply] RETURNS [BYTE];
ERead16: PROC [r: Reply] RETURNS [CARD16];
ERead32: PROC [r: Reply] RETURNS [CARD32];
EReadRope: PROC [r: Reply] RETURNS [ROPE];

debugX: BOOL = FALSE;	--used for conditional compiling debug stuff 

END.


   P  XlPrivate.mesa
Copyright س 1988, 1990, 1991, 1992, 1993 by Xerox Corporation.  All rights reserved.
Christian Jacobi, April 13, 1988 12:24:42 pm PDT
Christian Jacobi, September 14, 1993 4:23 pm PDT 


Private interface to split implementation of Xl and to make extensions for it. 

All features are private against Xl clients.  Features explicitely called PRIVATE are private for the base implementation of Xl and should probably not be used by implementors of extensions of Xl.  

This module is DANGEROUS in the following sense: 
Its ""internal"" procedures might wait with object monitors; If the caller wasn't monitored using the same object monitors this would probably produce chaos.
Handy
For certain self-checks; wedges connection.
Computes padding necesary to get multiple of 4.

Executes action within monitor locks and all required UNWIND's.

Buffer allocation and flushing [all INTERNAL]
--Guarantees bytes free space in buffer; callable at beginning of request only 
--Might cause a flush of completed requests to make space	
--Does NOT raise errors (errors are accumulated hiddenly)	
--Buffer is allocated even in error case for memory safety reason	
--Guarantees bytes free space in buffer; callable with partial request but aligned buffer only. 
--Might cause a flush of completed and un-completed requests to make space	
--Does NOT raise errors (errors are accumulated hiddenly)	
--Guarantees buffer "empty" ()c.bufReady=0 by flushing all completed requests into real communication buffer  	
--Does NOT raise errors (errors are accumulated hiddenly)	
--Warning: Flush on real wire only with non-empty buffer contents
--Like SoftFlushBuffer but also flushes the communication buffer	
--Does NOT raise errors (errors are accumulated hiddenly)	
Buffer output operations [all INTERNAL]
All buffer operations are aligned properly or crash...
--length: length of request in 32 bit words.  Asserts full buffer size.

--length: length of request in 32 bit words.  Asserts assertBytes bytes in buffer.
--assertBytes may be more, or, less.

--Short ropes only

--NOT padded
--Short ropes only

--Returns pointer to next blockBytes bytes. Buffer must be aligned. 
--No tests; The blockBytes are NOT asserted 

--Optional tests whether previous command is finished properly and asserts a block of "blockBytes" bytes in buffer, and, establishes self check for next command.  opCode is NOT assigned but used for checking.

Assuming len bytes written, adds padding to next multiple of 4 
--... (used by extensions)
Direct output Procedures; [all INTERNAL]
Flushes buffer and makes it ready for continueing as direct request  

Flushes buffer and starts a direct request
Assuming len bytes written, puts padding to next multiple of 4 
Utilities, unmonitored
scanning events
procedures mapping from X name space to Cedar types

procedures mapping from Cedar types to C type
Utilities, [INTERNAL]
Does not raise immediate errors but returns a zero id on failure
Always returns id, such that a NIL gc might fail command but won't wedge connection.


Reply stuff 
--Avoid bounds checking hack for fix
--Use this since LOOPHOLE to [0..32) has size ambiguity on PrincOps
--Replies are requested by exactly one client process; this is the only process allowed to fool with next
Waits for reply with current sequence number
Also initializes "next" field of reply to 1
Asumes all bytes already written but monitor lock never released since starting request.

I found a single request which returns multiple replies.
Waits for replies with current sequence number.
callback is called within monitor locks and must be well behaved.  
Called to return a reply; must return whether more replies are following.
Does not automatically dispose reply.

Finishes up request.
Asumes monitor lock never released since starting request.  Very essential because stuff catching event needs to be prepared before event can arrive.

Like FinishWithDetails but does not raise any errors directly.  In case of errors returns an event.

Like FinishWithDetailsNoErrors but uses only errorMatch and synchronous of details.
This is useful to implement multi-request commands.

Allows reusing of reply without memory allocation.
Disaster if r still used afterwards.
May be used inside and outside monitors.
Checks whether r really is an X reply and not an error
Raises the XError if not
Also does SetPos[1]
Set position for next reply reading
Skip bytes for next read operation on reply

"Reads" next byte [from fixed part only]
"Reads" next two bytes [from fixed part only]
"Reads" next four bytes [from fixed part only]

"Reads" byte at fixed position [from fixed part only]
"Reads" two bytes at fixed position [from fixed part only]
"Reads" four bytes at fixed position [from fixed part only]

The following routines can "read" stuff from either fix or varpart but may crash if used on positions not used by the X protocol
And removes trailing null chars
Debugging
 ‌ت  •NewlineDelimiter
–(cedarcode) styleک codeڑœ™Kڑœ
دeœI™TKڑœ-دk™0K™1K™ —ڑ‍	œ#ک,Kک —ڑدn	œ‍œ‍کKڑ‍œک	—Kڑœ‍œ‍œک!K™ K™OK™ ™ئK™ —ڑœ1™1Kڑœ‌™‌—headڑœ™Kک ڑںœ‍œک#K™+—Kک ڑ
ںœ‍œ‍œ‍œ‍œک*J™/—K™ ڑںœ‍œ‍œ'کUK™?K™ —ڑ	œ‍œ‍œ‍	œ‍œک0Kڑœ‍œکKڑœ‍œکKڑœ‍œدcک%Kک——ڑœ-™-Kک ڑںœ‍œ‍œ‍œک:Jڑœ)دb%œ™OJڑœ:™:Jڑœ،œ0™:JڑœB™BKڑ‍œ‍œک?KکKڑںœ‍œ‍œ‍œک<—Kک ڑںœ‍œ‍œ‍œک>JڑœK،œ™`Jڑœ#،œ™KJڑœ،œ0™:Kڑ‍œ‍œکCKکKڑںœ‍œ‍œ‍œک@Kک —ڑںںœ‍œ‍œ‍œ‍œکEJ™oJڑœ،œ0™:JڑœA™AKڑ‍œ‍œک.Kک—ڑ
ںœ‍œ‍œ‍œ‍œکEJ™AJڑœ،œ0™:Kڑ‍œ‍œ‍œک@KکKڑ
ںœ‍œ‍œ‍œ‍œکCKک ——ڑœ'™'Kک Kڑں6™6Kک Kڑœ	‍œ‍œ‍œ‍œ‍œ‍œ‍œک>Kڑœ	‍œ‍œ‍œ‍œ‍œ‍œ‍œک>Kک ڑ
ںœ‍œ‍œ‍œ‍œک8Kڑœ‍œکKڑœکKڑœکKکKک —ڑ
ںœ‍œ‍œ‍œ‍œک;Kڑœ‍œکKڑœ‍œکKڑœکKڑœکKکKک —ڑ
ںœ‍œ‍œ‍œ‍œک;Kڑœ‍œکKڑœ‍œکKڑœکKڑœکKک—Kک ڑ
ںœ‍œ‍œ	‍œ‍œکHKڑœG™GK™ —ڑںœ‍œ‍œ	‍œ‍œ‍œکfKڑœR™RKڑœ$™$K™ —Kڑںœ‍œ‍œک%Kڑںœ‍œ‍œک(Kڑںœ‍œ‍œک(Kڑ
ںœ‍œ‍œ‍œ‍œکUKک Kڑںœ‍œ‍œک'Kڑںœ‍œ‍œک(Kڑں	œ‍œ‍œک*Kڑںœ‍œ‍œک.Kڑںœ‍œک0Kڑں	œ‍œک*Kڑںœ‍œک(Kڑںœ‍œ$ک2Kڑں
œ‍œک,Kڑںœ‍œک0Kڑںœ‍œک-Kڑں
œ‍œک,Kڑں
œ‍œ!ک1Kک Kڑںœ‍œ ک4Kک ڑںœ‍œ‍œ	‍œ‍œ‍œ‍œکWKڑœ™K™ —ڑںœ‍œ‍œ	‍œ‍œ‍œ‍œکQKڑœ™Kڑœ™K™ —ڑںœ‍œ‍œ‍œ‍œ‍œکRJڑœD™DJڑœ,™,J™ —ڑںœ‍œ‍œ‍œ‍œ‍œ‍œ‍œکzJ™ذJ™ —ڑںœ‍œ‍œ‍œک2Kڑœ?™?KڑœکKکKک —ڑںœ‍œ7‍œœکPJ™——™(ڑںœ‍œک,KڑœE™EK™ —ڑ
ںœ‍œ‍œ	‍œ‍œکXKڑœ*™*—Kک Kڑںœ‍œ‍œک+Kڑں
œ‍œ‍œک.Kڑ
ں	œ‍œ‍œ‍œ‍œکPKڑں
œ‍œ‍œک.Kڑں
œ‍œک,Kڑںœ‍œ!‍œکKKڑںœ‍œ‍œ	‍œ‍œ‍œ‍œکWڑںœ‍œ‍œک(Kڑœ?™?——™L™Kڑںœ‍œ‍œ‍œ‍œ‍œ‍œکEKڑںœ‍œ‍œ‍œ‍œ‍œ‍œکEKک L™3ڑ
ںœ‍œ‍œ‍œ‍œکEKڑ‍œ	کKڑœک—Kک ڑ
ںœ‍œ‍œ‍œ‍œکEKڑ‍œ	کKڑœکKک —ڑ
ںœ‍œ‍œ‍œ‍œکEKڑ‍œکKڑœک—K™ L™-ڑںœ‍œ‍œ‍œ‍œ‍œک1Kڑ‍œ‍œکKک——ڑœ‍
™Kک ڑ
ںœ œ‍œL‍œ‍œک{Kڑ @™@Kڑ T™T—K™ ڑںœ‍œک(Kک —K™ —ڑœ™Kڑœ‍œ‍œ
 کڑ	œ
‍œ‍œ‍	œ‍œک+ڑ	œ‍œ‍œ‍œ‍œک%Jڑœ$™$JڑœC™C—Kڑœ‍œ‍œ	‍œ‍œ‍œک-Kڑœ	‍œ‍œک#Kڑœ‍œ ;کPKڑœ‍œ !ک/KکJڑœi™iKک —Kڑںœ‍œ‍œ‍œ‍œ‍œ‍œ‍œ‍œکiKک ڑ
ںœ ذci œ‍œ‍œکJJڑœ,™,Jڑœ 
œ 
œ ™+JڑœX™XJ™ ڑںœ ¢ œ‍œ/‍œ‍œکfK™8Kڑœ/™/Kڑœ،œ*™Cڑœ‍œ‍œ%‍œ‍œ‍œ‍œک`K™IKڑœ%™%—K™ ——ڑ
ںœ ¢ œ‍œ$‍œکMJڑœ™Jڑœ•™•J™ —ڑںœ ¢ œ‍œ$‍œ‍œ
‍œ‍œک‰Jڑœc™cJ™ —ڑں œ ¢ œ‍œ#‍œ
‍œ‍œکٹJڑœS™SJ™3J™ —ڑںœ‍œک-Jڑœ2™2J™$J™(—Kک ڑں
œ‍œکJڑœ6™6J™Jڑœ
ںœ™Kک —ڑںœ‍œ‍œ‍œکJJ™#—Kک ڑںœ‍œ‍œ‍œکGJ™+—J™ Kک ڑ
ںœ‍œ‍œ‍œ‍œک;J™(Kڑœ'ک'KکKک —ڑ
ںœ‍œ‍œ‍œ‍œک>J™-Kڑœ7ک7KڑœکKڑœکKک —ڑ
ںœ‍œ‍œ‍œ‍œک;Jڑœ.™.ڑœکKڑœکKڑœکKڑœکKڑœکKک—KڑœکKڑ‍œ‍œکKک—J™ ڑںœ‍œ‍œ‍œ‍œ‍œ‍œکAJڑœ5™5Kڑ‍œ ک1Kک—Kک ڑںœ‍œ‍œ‍œ‍œ‍œکDJڑœ:™:Kڑ‍œ2ک8Kک—Kک ڑںœ‍œ‍œ‍œ‍œ‍œکDJڑœ;™;ڑ‍œ‍œکKڑœکKڑœکKڑœکKڑœکKک—Kک—J™ Jڑœ€™€Kک Kڑںœ‍œ‍œ‍œک'Kڑںœ‍œ‍œ‍œک*Kڑںœ‍œ‍œ‍œک*ڑں	œ‍œ‍œ‍œک*Jڑœ™——Kک ™	Kڑœ‍œ‍œ -کC—Kک Kڑ‍œکKک Kک — …—      ;…  