XlShmPixmapsImpl.mesa
Copyright Ó 1990, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Christian Jacobi, January 29, 1990 2:41 pm PST
Christian Jacobi, August 17, 1993 1:19 pm PDT
DIRECTORY
Atom, ImagerSample, Process, Rope, SafeStorage, SF, UnixErrno, UnixShm0, UnixTypes, VMChunks, Xl, XlAccess, XlDetails, XlExtensions, XlPrivate, XlPrivateErrorHandling, XlPrivateResources, XlShmMonitor, XlShmPixmaps, XlShmPixmapsExtras;
XlShmPixmapsImpl: CEDAR MONITOR LOCKS c USING c: Xl.Connection
IMPORTS Atom, ImagerSample, Process, Rope, SafeStorage, SF, UnixErrno, UnixShm0, VMChunks, Xl, XlAccess, XlDetails, XlExtensions, XlPrivate, XlPrivateErrorHandling, XlPrivateResources
EXPORTS XlShmPixmaps, XlShmMonitor, XlShmPixmapsExtras
SHARES Xl, XlPrivate =
BEGIN OPEN XlShmPixmaps;
This module contains data on two levels
a) bare "XLib" level calls to Xl
b) higher level hiding SHM stuff for XlBitmapWindows
Maybe once I will split the module into two parts so the bare level extension could also be used for other applications.
ROPE: TYPE = Rope.ROPE;
shmExtensionKey: ATOM = Atom.MakeAtom["MIT-SHM"];
shmQueryVersionMinor: BYTE = 0;
shmQueryAttachMinor: BYTE = 1;
shmQueryDetachMinor: BYTE = 2;
shmQueryPutImageMinor: BYTE = 3;
shmQueryGetImageMinor: BYTE = 4;
shmQueryCreatePixmapMinor: BYTE = 5;
neverUseThis: BOOL ¬ FALSE;
DebugSetNeverUseThis: PROC [b: BOOL] = {neverUseThis ¬ b};
GetShmConnectionData: PROC [c: Xl.Connection] RETURNS [d: REF ShmConnectionData] = INLINE {
d ¬ NARROW [Xl.GetConnectionPropAndInit[c, privateKey, InitShmExtension]];
};
privateKey: REF INT ~ NEW[INT];
InitShmExtension: Xl.InitializeProcType = {
--For this connection
shmd: REF ShmConnectionData ¬ NEW[ShmConnectionData];
IF ~Disabled1[c] THEN {
shmd.ex ¬ XlExtensions.StartExtension[c, shmExtensionKey];
IF shmd.ex#NIL AND ~Disabled2[c] THEN {
shmd.supportAndLocal ¬ TRUE;
shmd.sv ¬ UncachedSHMQueryVersion[c, shmd ! ANY => {shmd.supportAndLocal ¬ FALSE; CONTINUE}];
shmd.supportLocalAndPixmaps ¬ shmd.supportAndLocal AND shmd.sv.pixmaps;
IF ~shmd.sv.hasExtension THEN {shmd­ ¬ []}; --inconsistent
};
};
RETURN [shmd]
};
GetShmConnectionDataAndTest: PROC [c: Xl.Connection] RETURNS [shmd: REF ShmConnectionData] = {
shmd ¬ GetShmConnectionData[c];
IF shmd.ex=NIL THEN { --extension is not supported
err: REF Xl.EventRep.errorNotify ¬ NEW[Xl.EventRep.errorNotify];
err.connection ¬ c;
ERROR Xl.XError[err];
};
};
XShmID: TYPE ~ Xl.ID;
Ignore the event for now.
SHMAttach: PUBLIC PROC [c: Xl.Connection, shmInfo: ShmInfoRec, details: Xl.Details ¬ NIL] RETURNS [xShmID: XShmID ¬ 0] = {
shmd: REF ShmConnectionData ~ GetShmConnectionDataAndTest[c];
action: PROC [c: Xl.Connection] = {
xShmID ¬ XlPrivateResources.NewResourceID[c];
XlPrivate.BInit[c, shmd.ex.majorOpcode, shmQueryAttachMinor, 4];
XlPrivate.BPut32[c, xShmID]; --X id
XlPrivate.BPut32[c, shmInfo.shmId.val];
XlPrivate.BPut8[c, ORD[shmInfo.readonly]];
XlPrivate.BSkip[c, 3];
XlPrivate.FinishWithDetails[c, details];
};
XlPrivate.DoWithLocks[c, action, details];
};
SHMCreatePixmap: PUBLIC PROC [c: Xl.Connection, drawable: Xl.Drawable, xShmID: XShmID, offset: CARD32, size: Xl.Size, depth: BYTE, details: Xl.Details] RETURNS [p: Xl.Pixmap ¬ Xl.nullPixmap] = {
--assumed memory layout of pixmap is not documented
--therefore: nice numbers please
shmd: REF ShmConnectionData ~ GetShmConnectionDataAndTest[c];
action: PROC [c: Xl.Connection] = {
p ¬ [[XlPrivateResources.NewResourceID[c]]];
XlPrivate.BInit[c, shmd.ex.majorOpcode, shmQueryCreatePixmapMinor, 7];
XlPrivate.BPutPixmap[c, p];
XlPrivate.BPutDrawable[c, drawable];
XlPrivate.BPutSize[c, size];
XlPrivate.BPut8[c, depth];
XlPrivate.BSkip[c, 3];
XlPrivate.BPut32[c, xShmID];
XlPrivate.BPut32[c, offset];
XlPrivate.FinishWithDetails[c, details];
};
IF size.width MOD (32/depth) # 0 THEN --XXX Warning: machine dependency 32 introduced
XlPrivateErrorHandling.RaiseClientError[c, $widthOfShmPixmap]; --size not reasonable
XlPrivate.DoWithLocks[c, action, details];
};
SHMDetach: PUBLIC PROC [c: Xl.Connection, xShmID: XShmID, details: Xl.Details] = {
action: PROC [c: Xl.Connection] = {
XlPrivate.BInit[c, shmd.ex.majorOpcode, shmQueryDetachMinor, 2];
XlPrivate.BPut32[c, xShmID];
XlPrivate.FinishWithDetails[c, details];
};
shmd: REF ShmConnectionData ~ GetShmConnectionDataAndTest[c];
XlPrivate.DoWithLocks[c, action, details];
};
ShmConnectionData: TYPE ~ PRIVATE RECORD [
--property of connection
ex: XlExtensions.Extension, --NIL if extension not supported
sv: SHMVersion ¬ [hasExtension: FALSE, major: 0, minor: 0, pixmaps: FALSE],
supportAndLocal: BOOL ¬ FALSE,
supportLocalAndPixmaps: BOOL ¬ FALSE
];
UncachedSHMQueryVersion: PROC [c: Xl.Connection, shmd: REF ShmConnectionData] RETURNS [sv: SHMVersion ¬ [hasExtension: FALSE, major: 0, minor: 0, pixmaps: FALSE]] = {
reply: XlPrivate.Reply;
action: PROC [c: Xl.Connection] = {
XlPrivate.BInit[c, shmd.ex.majorOpcode, shmQueryVersionMinor, 1];
reply ¬ XlPrivate.FinishWithReply[c];
};
IF shmd.ex#NIL THEN {
XlPrivate.DoWithLocks[c, action, NIL];
XlPrivate.CheckReply[reply];
sv.pixmaps ¬ XlPrivate.ERead8[reply]#0;
XlPrivate.Skip[reply, 6];
sv.major ¬ XlPrivate.ERead16[reply];
sv.minor ¬ XlPrivate.ERead16[reply];
uid ← XlPrivate.ERead16[reply];
gid ← XlPrivate.ERead16[reply];
sv.hasExtension ¬ TRUE;
};
};
SHMQueryVersion: PUBLIC PROC [c: Xl.Connection] RETURNS [SHMVersion] = {
shmd: REF ShmConnectionData ~ GetShmConnectionData[c];
RETURN [shmd.sv];
};
SHMVersion: TYPE ~ RECORD [hasExtension: BOOL, major, minor: INT, pixmaps: BOOL];
SHMPutImage: PROC [] = {
ERROR; --not yet impl
};
SHMGetImage: PROC [] = {
ERROR; --not yet impl
};
------------------------------
ShmInfoRec: TYPE = RECORD [
shmId: UnixShm0.SharedMemoryIdentifier,
addr: POINTER, --local address of shared memory segment
readonly: BOOL ¬ FALSE
];
ShmAllocSegmentateSystemId: PROC [nbytes: INT, permissions: [0..512) ¬ UnixShm0.allPerms.val] RETURNS [shmId: UnixShm0.SharedMemoryIdentifier] = {
Creates new shared memory identifier
shmId ¬ UnixShm0.ShmGet[key: UnixShm0.ipcPRIVATE, size: nbytes, shmflg: [UnixShm0.ipcCREAT.val+permissions]];
IF LOOPHOLE[shmId, INT] = -1 THEN SignalUnixError[];
};
ShmAllocSegmentateNew: PROC [nbytes: INT] RETURNS [info: ShmInfoRec] = {
vmAddr: POINTER; i: INT;
info.shmId ¬ ShmAllocSegmentateSystemId[nbytes];
vmAddr ¬ UnixShm0.VMReserve[nbytes]; --untraced
IF vmAddr = NIL THEN ERROR;
i ¬ UnixShm0.ShmAt[id: info.shmId, addr: vmAddr, flags: UnixShm0.noFlags];
IF i = -1 THEN SignalUnixError[];
info.addr ¬ LOOPHOLE[i];
IF info.addr # vmAddr THEN ERROR;
};
SignalUnixError: PROC [] = {
errno: UnixErrno.Errno ~ UnixErrno.GetErrno[];
UnixError[errno];
};
UnixError: ERROR [errno: UnixErrno.Errno] = CODE;
------------------------------
LinkedSegment: TYPE = RECORD [
domain: VMChunks.Domain ¬ NIL,
shmInfo: ShmInfoRec,
bytes: CARD,
key: REF ¬ NIL,
next: REF LinkedSegment ¬ NIL
];
rootSegment: REF LinkedSegment ¬ NIL;
lastUnixErrno: UnixErrno.Errno ¬ ok;
maxSegmentSize: CARD = 4*1024*1024; --oops, some kernels don't allow more then 1 meg, but for now this will simply fail. However we try defaultSegmentSize if ever possible.
defaultSegmentSize: INT = 1024*1024;
fakeConnection: Xl.Connection = NEW[Xl.ConnectionRep]; --delivers a MONITOR
Next: PUBLIC <<for monitoring only>> PROC [segment: REF ¬ NIL] RETURNS [REF] = {
WITH segment SELECT FROM
ls: REF LinkedSegment => RETURN [ls.next];
ENDCASE => RETURN [rootSegment];
};
Info: PUBLIC <<for monitoring only>> PROC [segment: REF] RETURNS [addr: CARD, bytes: CARD, id: CARD] = {
ls: REF LinkedSegment ~ NARROW[segment];
RETURN [LOOPHOLE[ls.shmInfo.addr], ls.bytes, LOOPHOLE[ls.shmInfo.shmId]];
};
PreAllocate: PUBLIC PROC [nbytes: CARD] = {
nbytes ¬ MAX[nbytes, defaultSegmentSize];
nbytes ¬ MIN[nbytes, maxSegmentSize];
[] ¬ AllocateSegment[nbytes];
};
AllocateSegment: PROC [nbytes: CARD ¬ defaultSegmentSize] RETURNS [ls: REF LinkedSegment ¬ NIL] = {
Link: ENTRY PROC [c: Xl.Connection<<fakeConnection for monitor lock>>, ls: REF LinkedSegment] = {
ls.next ¬ rootSegment;
rootSegment ¬ ls
};
Alloc: PROC [nbytes: CARD] RETURNS [ls: REF LinkedSegment] = {
ENABLE {
UnixError => {
--Don't worry about shared memory, it is optional
lastUnixErrno ¬ errno;
GOTO oops;
};
UNCAUGHT => {
GOTO oops;
};
};
ls ¬ NEW[LinkedSegment];
ls.shmInfo ¬ ShmAllocSegmentateNew[nbytes];
ls.domain ¬ VMChunks.CreateDomain[LOOPHOLE[ls.shmInfo.addr], nbytes];
ls.bytes ¬ nbytes;
ls.key ¬ NEW[INT];
EXITS oops => RETURN [NIL];
};
IF nbytes>maxSegmentSize THEN RETURN [NIL];
ls ¬ Alloc[nbytes];
IF ls#NIL THEN Link[fakeConnection, ls];
};
Block: TYPE = RECORD [ls: REF LinkedSegment, chunk: VMChunks.Chunk];
Do no keep on to block, as finalization of chunk is important
AllocateBlock: PROC [nbytes: CARD] RETURNS [REF Block ¬ NIL] = {
ls: REF LinkedSegment ¬ rootSegment;
nbytes ¬ nbytes+63/64*64; --chunkize to reduce fragmentation
--linear search, starting in front may be simplistic, but the list is short (each segment is large)
WHILE ls#NIL DO
c: VMChunks.Chunk ¬ VMChunks.AllocateChunk[ls.domain, nbytes];
IF c#NIL THEN RETURN [NEW[Block ¬ [ls, c]]];
ls ¬ ls.next
ENDLOOP;
--try hard to reuse a segment, but don't garbage collect in start up code
ls ¬ rootSegment;
IF ls#NIL THEN {
SafeStorage.ReclaimCollectibleObjects[];
Process.Yield[]; --give the finalizations a chance
WHILE ls#NIL DO
c: VMChunks.Chunk ¬ VMChunks.AllocateChunk[ls.domain, nbytes];
IF c#NIL THEN RETURN [NEW[Block ¬ [ls, c]]];
ls ¬ ls.next
ENDLOOP;
};
--prevent small segments
IF nbytes<defaultSegmentSize THEN
nbytes ¬ defaultSegmentSize; --You won't believe this, but one of the include files defines MAX
ls ¬ AllocateSegment[nbytes];
IF ls#NIL THEN {
c: VMChunks.Chunk ¬ VMChunks.AllocateChunk[ls.domain, nbytes];
IF c#NIL THEN RETURN [NEW[Block ¬ [ls, c]]];
};
};
UNTHREADEDBeforeQuitWorld: PROC [x: REF] = {
neverUseThis ¬ TRUE;
FOR ls: REF LinkedSegment ¬ rootSegment, ls.next WHILE ls#NIL DO
shmId: UnixShm0.SharedMemoryIdentifier ~ ls.shmInfo.shmId;
IF LOOPHOLE[shmId, INT] # -1 THEN TRUSTED {
[] ¬ UnixShm0.UNTHREADEDShmCtl[shmId, UnixShm0.ipcRMID, NIL];
};
ENDLOOP;
};
NewSharedSampleMap: PUBLIC PROC [box: SF.Box, bitsPerSample: ImagerSample.BitsPerSample ¬ 1] RETURNS [sm: ImagerSample.RasterSampleMap] = {
block: REF Block;
chunk: VMChunks.Chunk;
addr: CARD;
w: CARD ¬ SF.SizeF[box];
h: CARD ¬ SF.SizeS[box];
nbytes: CARD;
IF w=0 OR h=0 THEN ERROR;
BEGIN
--Enlarge box to have width which fullfills all (undocumented, unknown) alignment conditions.
--We dont use ImagerSample.BitsForSamples because we want alignment of the server, not the host.
--For sparc use double words (8 bytes).
SELECT bitsPerSample FROM
1 => w ¬ (w+63) / 64 * 64; --8
8 => w ¬ (w+ 7) / 8 * 8; --8
4 => w ¬ (w+15) / 16 * 16; --8
2 => w ¬ (w+31) / 32 * 32; --8
24 => w ¬ (w+ 3) / 4 * 4; --align for egret
32 => w ¬ (w+ 1) / 2 * 2; --8
16 => w ¬ (w+ 3) / 4 * 4; --8
ENDCASE => RETURN [NIL]; -- don't support this bitsPerSample
box.max.f ¬ INT[box.min.f] + LOOPHOLE[w, INT];
END;
nbytes ¬ (w*bitsPerSample)/8*h;
IF nbytes<=maxSegmentSize THEN block ¬ AllocateBlock[nbytes];
IF block=NIL THEN RETURN [NIL]; --not enough space
addr ¬ VMChunks.AddressOfChunk[block.chunk];
TRUSTED {
sm ¬ ImagerSample.UnsafeNewSampleMap[box: box, bitsPerSample: bitsPerSample, bitsPerLine: w*bitsPerSample, base: [word: LOOPHOLE[addr], bit: 0], ref: block, words: nbytes / BYTES[WORD]];
};
Should disable (recycle) Pixmap's when sm is garbage collected, but I'm to lazy
};
Disabled1: PROC [c: Xl.Connection] RETURNS [BOOL] = {
--Many protocol translaters faithfully translate a servers claim to support shared memory; even if they use a remote server... This supports one test against that.
--First easy tests without actually accessing server
IF c=NIL THEN RETURN [TRUE];
RETURN [ Xl.GetConnectionProp[c, $PreventSharedMemory]#NIL ]
};
ServerHostFromConvention: PROC [c: Xl.Connection] RETURNS [Rope.ROPE ¬ NIL] = {
ENABLE ANY => GOTO Oops;
serverHostAtom: Xl.XAtom ~ Xl.MakeAtom[c, "PARC←ServerHost"];
prr: Xl.PropertyReturnRec ~ Xl.GetProperty[c: c, w: Xl.FirstRoot[c], property: serverHostAtom, supposedFormat: 8];
WITH prr.value SELECT FROM
r: Rope.ROPE => RETURN [r];
ENDCASE => {}
EXITS Oops => {}
};
Disabled2: PROC [c: Xl.Connection] RETURNS [BOOL ¬ FALSE] = {
--Slightly slower and harder tests.
--Tests whether server is local at all.
--Test whether server knows its name and whether it matches with the host.
name: Rope.ROPE; isLocalhost: BOOL;
IF Disabled1[c] THEN RETURN [TRUE];
name ¬ Xl.ServerName[c];
isLocalhost ¬ XlAccess.IsLocalHost[Xl.ServerName[c]];
IF ~isLocalhost THEN RETURN [TRUE];
name ¬ ServerHostFromConvention[c];
isLocalhost ¬ Rope.IsEmpty[name] OR XlAccess.IsLocalHost[name];
IF ~isLocalhost THEN RETURN [TRUE];
};
TestWorking: PROC [c: Xl.Connection] RETURNS [ok: BOOL] = {
Well, sometimes a connection claims it supports shared memory, but when you try using it it will not work nevertheless (E.g. proxy servers, xscope).
This is the ultimate test
someXSR: REF LinkedSegment ¬ rootSegment;
shmd: REF ShmConnectionData ~ GetShmConnectionData[c];
IF shmd=NIL OR ~shmd.supportAndLocal OR someXSR=NIL THEN RETURN [FALSE];
[] ¬ GetXShmId[c, someXSR ! Xl.XError => {shmd.supportAndLocal ¬ FALSE; CONTINUE}];
IF ~shmd.supportAndLocal THEN {
Xl.PutConnectionProp[c, $PreventSharedMemory, $PreventSharedMemory]
};
RETURN [shmd.supportAndLocal];
};
ConnectionSupportsThis: PUBLIC PROC [c: Xl.Connection] RETURNS [BOOL] = {
IF neverUseThis THEN RETURN [FALSE];
IF c=NIL THEN RETURN [~neverUseThis];
IF Disabled1[c] THEN RETURN [FALSE];
RETURN [TestWorking[c]];
};
ConnectionSupportsPixmaps: PUBLIC PROC [c: Xl.Connection] RETURNS [BOOL ¬ FALSE] = {
IF ~neverUseThis THEN {
shmd: REF ShmConnectionData ¬ GetShmConnectionData[c];
IF shmd.supportLocalAndPixmaps THEN RETURN [TestWorking[c]];
};
};
SampleMapSupportsThis: PUBLIC PROC [sm: ImagerSample.SampleMap] RETURNS [BOOL] = {
IF neverUseThis THEN RETURN [FALSE];
RETURN [SampleMapPiece[sm]#NIL]
};
SampleMapPiece: PROC [sm: ImagerSample.SampleMap] RETURNS [REF Block ¬ NIL] = {
WITH sm SELECT FROM
rsm: ImagerSample.RasterSampleMap =>
WITH ImagerSample.GetRef[rsm] SELECT FROM
p: REF Block => RETURN [p];
ENDCASE => RETURN [NIL];
ENDCASE => {};
};
GetXShmId: PROC [c: Xl.Connection, ls: REF LinkedSegment] RETURNS [xshmid: XShmID] = {
GetXShmInit: Xl.InitializeProcType = {
refXId: REF XShmID ¬ NEW[XShmID];
refXId­ ¬ SHMAttach[c, ls.shmInfo, XlDetails.synchronousErrors ! Xl.XError => {
shmd: REF ShmConnectionData ~ GetShmConnectionData[c];
IF shmd#NIL THEN {
shmd.supportAndLocal ¬ FALSE;
shmd.supportLocalAndPixmaps ¬ FALSE;
};
refXId­ ¬ 0;
CONTINUE
}];
RETURN [refXId]
};
refXId: REF XShmID ¬ NARROW[Xl.GetConnectionPropAndInit[c, ls.key, GetXShmInit]];
RETURN [refXId­]
};
UnsafeCreatePixmap: PUBLIC PROC [c: Xl.Connection, drawable: Xl.Drawable ¬ Xl.nullDrawable, sm: ImagerSample.RasterSampleMap] RETURNS [p: Xl.Pixmap] = {
Unsafe: Pixmap is not returned when sm is garbage collected
block: REF Block ¬ SampleMapPiece[sm];
sz: SF.Vec ¬ ImagerSample.GetSize[sm];
bps: NAT ¬ ImagerSample.GetBitsPerSample[sm];
xshmid: XShmID;
offset: CARD32;
IF ~ConnectionSupportsThis[c] THEN ERROR;
IF block=NIL THEN ERROR; --sm not created with this module
offset ¬ LOOPHOLE[ImagerSample.GetBase[sm].word, CARD32] - LOOPHOLE[block.ls.shmInfo.addr, CARD32];
xshmid ¬ GetXShmId[c, block.ls];
p ¬ SHMCreatePixmap[c: c, drawable: drawable, xShmID: xshmid, offset: offset, size: [sz.f, sz.s], depth: bps, details: XlDetails.synchronousErrors]
};
ProcessExtension: XlExtensions.ProcessExtensionEventProc = {
};
PreAllocate[defaultSegmentSize];
XlExtensions.DefineExtensionClass[key: shmExtensionKey, processEvents: ProcessExtension];
TRUSTED {
[] ¬ UnixShm0.RegisterUNTHREADEDTerminationCleanupProc[UNTHREADEDBeforeQuitWorld];
};
END.