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
DIRECTORY Basics, Rope, Xl, XlEndianPrivate;
XlPrivate: CEDAR DEFINITIONS
SHARES Xl
~ BEGIN OPEN Xl, XlEndianPrivate;
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
BadImplError: PROC [c: Connection];
For certain self-checks; wedges connection.
PaddingBytes: PROC [n: INT] RETURNS [INT];
Computes padding necesary to get multiple of 4.
DoWithLocks: PROC [c: Connection, action: PROC [c: Connection], details: Xl.Details];
Executes action within monitor locks and all required UNWIND's.
RequestHeader: TYPE = MACHINE DEPENDENT RECORD [
opCode: BYTE,
minor: BYTE,
length: CARD16 --in 32 bit word units
];
Buffer allocation and flushing [all INTERNAL]
AssertBuffer: PROC [c: Connection, bytes: CARD] = INLINE {
--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 
IF (c.bufLimit-c.bufNext)<bytes THEN RealAssertBuffer[c, bytes]
};
RealAssertBuffer: PRIVATE PROC [c: Connection, bytes: CARD];
FineAssertBuffer: PROC [c: Connection, bytes: CARD] = INLINE {
--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) 
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 {
--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
IF c.bufReady#0 THEN RealFlushBuffer[c, delay]
};
HardFlushBuffer: PROC [c: Connection, delay: BOOL ¬ FALSE] = INLINE {
--Like SoftFlushBuffer but also flushes the communication buffer 
--Does NOT raise errors (errors are accumulated hiddenly) 
IF c.bufReady#0 OR c.needFlushing THEN RealFlushBuffer[c, delay]
};
RealFlushBuffer: PRIVATE PROC [c: Connection, delay: BOOL ¬ FALSE];
Buffer output operations [all INTERNAL]
All buffer operations are aligned properly or crash...
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];
--length: length of request in 32 bit words. Asserts full buffer size.
BInitPartial: PROC [c: Connection, opCode: BYTE, minor: BYTE ¬ 0, length: INT, assertBytes: CARD ¬ 0];
--length: length of request in 32 bit words. Asserts assertBytes bytes in buffer.
--assertBytes may be more, or, less.
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]];
--Short ropes only
BPutRope: PROC [c: Connection, rope: ROPE, start: INT ¬ 0, len: INT ¬ LAST[INT]];
--NOT padded
--Short ropes only
BContinueWithBlock: PROC [c: Connection, blockBytes: CARD] RETURNS [LONG POINTER];
--Returns pointer to next blockBytes bytes. Buffer must be aligned.
--No tests; The blockBytes are NOT asserted
BRequestWithBlock: PROC [c: Connection, opCode: BYTE, blockBytes: CARD, additionalBytes: CARD ¬ 0] RETURNS [LONG POINTER];
--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.
BPutPad: PROC [c: Connection, len: INT] = INLINE {
Assuming len bytes written, adds padding to next multiple of 4
BSkip[c, PaddingBytes[len]];
};
BPutRectangles: PROC [c: Xl.Connection, rects: Xl.PackedRects, start, num: INT];
--... (used by extensions)
Direct output Procedures; [all INTERNAL]
ContinueDirectRequest: PROC [c: Connection];
Flushes buffer and makes it ready for continueing as direct request
StartDirectRequest: PROC [c: Connection, opCode: BYTE, minor: BYTE ¬ 0, length: CARD16];
Flushes buffer and starts a direct request
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];
Assuming len bytes written, puts padding to next multiple of 4
Utilities, unmonitored
scanning events
GetTextCARD16: PROC [text: REF TEXT, startPos: INT] RETURNS [CARD16];
GetTextCARD32: PROC [text: REF TEXT, startPos: INT] RETURNS [CARD32];
procedures mapping from X name space to Cedar types
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]]
};
procedures mapping from Cedar types to C type
ToCBool: PROC [b: BOOL] RETURNS [BYTE] = INLINE {
RETURN [ORD[b]]
};
Utilities, [INTERNAL]
UseGContext: <<INTERNAL>> PROC [c: Connection, drawable: Drawable, gc: GContext, partialDetails: Details] RETURNS [id: ID];
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.
InternalRoundTrip: PROC [c: Connection];
Reply stuff
Reply: TYPE = REF ReplyRec;
ReplyRec: TYPE = MACHINE DEPENDENT RECORD [
cheat: PACKED ARRAY [0..0) OF BYTE,
--Avoid bounds checking hack for fix
--Use this since LOOPHOLE to [0..32) has size ambiguity on PrincOps
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
];
--Replies are requested by exactly one client process; this is the only process allowed to fool with next
RopeFromRaw: UNSAFE PROC [p: LONG POINTER TO Basics.RawBytes, start: CARD, len: INT] RETURNS [Rope.ROPE];
FinishWithReply: --INTERNAL-- PROC [c: Connection] RETURNS [reply: Reply];
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.
FinishWithMultipleReplies: --INTERNAL-- PROC [c: Connection, callback: ReplyGotProc, data: REF ¬ NIL];
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.
ReplyGotProc: TYPE = PROC [c: Connection, reply: Reply, data: REF] RETURNS [more: BOOL ¬ FALSE];
Called to return a reply; must return whether more replies are following.
Does not automatically dispose reply.
FinishWithDetails: --INTERNAL-- PROC [c: Connection, details: Details ¬ NIL];
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.
FinishWithDetailsNoErrors: --INTERNAL-- PROC [c: Connection, details: Details ¬ NIL] RETURNS [errors: REF Xl.EventRep.errorNotify ¬ NIL];
Like FinishWithDetails but does not raise any errors directly. In case of errors returns an event.
FinishWithPartialDetailsNoErrors: --INTERNAL-- PROC [c: Connection, details: Details] 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.
DisposeReply: PROC [c: Connection, r: Reply];
Allows reusing of reply without memory allocation.
Disaster if r still used afterwards.
May be used inside and outside monitors.
CheckReply: PROC [r: Reply];
Checks whether r really is an X reply and not an error
Raises the XError if not
Also does SetPos[1]
SetPos: PROC [r: Reply, startByte: INT ¬ 0] = INLINE {r.next ¬ startByte};
Set position for next reply reading
Skip: PROC [r: Reply, bytes: INT ¬ 1] = INLINE {r.next ¬ r.next+bytes};
Skip bytes for next read operation on reply
Read8: PROC [r: Reply] RETURNS [b: BYTE] = TRUSTED INLINE {
"Reads" next byte [from fixed part only]
b ¬ r.cheat[r.next]; r.next ¬ r.next+1;
};
Read16: PROC [r: Reply] RETURNS [c: CARD16] = TRUSTED INLINE {
"Reads" next two bytes [from fixed part only]
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 {
"Reads" next four bytes [from fixed part only]
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 {
"Reads" byte at fixed position [from fixed part only]
RETURN [r.cheat[pos]] --avoid the bounds check...
};
Get16: PROC [r: Reply, pos: INT] RETURNS [CARD16] = TRUSTED INLINE {
"Reads" two bytes at fixed position [from fixed part only]
RETURN [ r.cheat[pos+highOff]*256+r.cheat[pos+lowOff] ];
};
Get32: PROC [r: Reply, pos: INT] RETURNS [CARD32] = TRUSTED INLINE {
"Reads" four bytes at fixed position [from fixed part only]
RETURN [LOOPHOLE[ FourBytes[
hh: r.cheat[pos+hhOff],
hl: r.cheat[pos+hlOff],
lh: r.cheat[pos+lHOff],
ll: r.cheat[pos+llOff]
]]];
};
The following routines can "read" stuff from either fix or varpart but may crash if used on positions not used by the X protocol
ERead8: PROC [r: Reply] RETURNS [BYTE];
ERead16: PROC [r: Reply] RETURNS [CARD16];
ERead32: PROC [r: Reply] RETURNS [CARD32];
EReadRope: PROC [r: Reply] RETURNS [ROPE];
And removes trailing null chars
Debugging
debugX: BOOL = FALSE; --used for conditional compiling debug stuff
END.