Copyright (C) 1994, Digital Equipment Corp.
UNSAFE MODULE JvsBuffer;
IMPORT Atom, AtomList, IntRefTbl, JVBuffer, Jvs, OSError,
OSErrorPosix, Thread, Ushm;
REVEAL
Factory = FactoryPublic BRANDED OBJECT
jvs : Jvs.T;
type: Jvs.BufferType;
OVERRIDES
init := Init;
make := Make;
reset := Reset;
destroy := Destroy;
END;
PROCEDURE Init (f: Factory; jvs: Jvs.T; type: Jvs.BufferType): Factory =
BEGIN
f.jvs := jvs;
f.type := type;
RETURN f;
END Init;
PROCEDURE Make (f: Factory; wait := TRUE; subtype: CARDINAL := 0):
JVBuffer.T RAISES {Thread.Alerted, OSError.E} =
BEGIN
IF subtype = 0 THEN subtype := f.subtype END;
WITH res = f.newBuf(),
buffId = AllocateBuffer(f.jvs, f.type, wait, subtype) DO
res.subtype := subtype;
IF buffId = 0 THEN
RETURN NIL
ELSE
WITH address = BufferAddress(buffId) DO
RETURN res.init(buffId, address);
END
END
END
END Make;
PROCEDURE Reset (<* UNUSED*> f: Factory; <* UNUSED *> t: JVBuffer.T) =
BEGIN
(* dummy procedure *)
END Reset;
PROCEDURE Destroy (f: Factory; jv: JVBuffer.T) =
BEGIN
FreeBuffer(f.type, jv.shmid, jv.subtype);
END Destroy;
jvdriver doesn't recognise Deallocate requests, it deallocates shm
buffers when the client breaks the connection. So we want to stash shm
buffers here for reuse until the process dies
TYPE
BuffElt = REF RECORD
id : Jvs.ShmBufId;
subtype: CARDINAL;
next : BuffElt := NIL;
END;
RefAddr = REF RECORD address: ADDRESS; END;
VAR
mutex := NEW(MUTEX);
cond := NEW(Thread.Condition);
noMem := FALSE;
lists := ARRAY Jvs.BufferType OF BuffElt{NIL, ..};
pacer, water, lowater := ARRAY Jvs.BufferType OF INTEGER{0, ..};
thread : Thread.T;
jvsglobal : Jvs.T := NIL;
addresses := NEW(IntRefTbl.Default).init(5);
PROCEDURE NoMemApply (<* UNUSED *> t: Thread.Closure): REFANY =
VAR
cnt := 0;
pacers: BOOLEAN;
waters: INTEGER;
los := ARRAY Jvs.BufferType OF BuffElt{NIL, ..};
p : BuffElt;
j, k : INTEGER;
junk : REFANY;
addr : RefAddr;
BEGIN
LOOP
Thread.Pause(5.0D0);
LOCK mutex DO
pacers := noMem;
waters := 0;
FOR i := FIRST(Jvs.BufferType) TO LAST(Jvs.BufferType) DO
pacers := pacers OR pacer[i] > 0;
pacer[i] := 0;
INC(waters, water[i]);
j := lowater[i];
IF j > 0 THEN
j := MIN((j + 1) DIV 2, Pace);
DEC(water[i], j);
k := 0;
p := lists[i];
WHILE p # NIL DO INC(k); p := p.next END;
k := k - j;
IF k = 0 THEN
los[i] := lists[i];
lists[i] := NIL
ELSE
p := lists[i];
WHILE k > 1 DO p := p.next; DEC(k) END;
los[i] := p.next;
p.next := NIL
END
ELSE
los[i] := NIL
END;
lowater[i] := water[i]
END;
IF noMem THEN noMem := FALSE; Thread.Broadcast(cond) END;
END;
IF waters > 0 OR pacers THEN cnt := 0 ELSE INC(cnt) END;
IF cnt > 30 THEN LOCK mutex DO thread := NIL; RETURN NIL END END;
FOR i := FIRST(Jvs.BufferType) TO LAST(Jvs.BufferType) DO
p := los[i];
WHILE p # NIL DO
LOCK mutex DO
IF jvsglobal # NIL THEN
TRY
jvsglobal.deallocateBuffer(p.id)
EXCEPT
Thread.Alerted, OSError.E =>
END;
IF addresses.delete(p.id, junk) THEN
addr := junk;
EVAL Ushm.shmdt(addr.address);
END
END;
Thread.Broadcast(cond)
END;
p := p.next
END
END
END;
END NoMemApply;
CONST Pace = 10;
CONST
Width = ARRAY [0 .. 11] OF
CARDINAL{
0, 1024 + 12, 768 + 12, 640 + 12, 512 + 12, 384 + 12, 320 + 12,
256 + 12, 192 + 12, 160 + 12, 128 + 12, 64 + 12};
Height = ARRAY [0 .. 11] OF
CARDINAL{
0, 800, 576, 480, 400, 288, 240, 200, 144, 120, 100, 50};
Length = ARRAY [0 .. 5] OF
CARDINAL{
0, 192 * 1024, 64 * 1024, 32 * 1024, 16 * 1024, 8 * 1024};
PROCEDURE Subtype (width, height: CARDINAL): CARDINAL =
BEGIN
FOR i := LAST(Width) TO 1 BY -1 DO
IF width + 12 <= Width[i] AND height <= Height[i] THEN RETURN i END
END;
RETURN 0
END Subtype;
PROCEDURE Subtype2 (len: CARDINAL): CARDINAL =
BEGIN
FOR i := LAST(Length) TO 1 BY -1 DO
IF len <= Length[i] THEN RETURN i END
END;
RETURN 0
END Subtype2;
PROCEDURE AllocateBuffer (jvs : Jvs.T;
type : Jvs.BufferType;
wait := TRUE;
subtype: CARDINAL := 0 ):
Jvs.ShmBufId RAISES {OSError.E, Thread.Alerted} =
BEGIN
LOCK mutex DO
jvsglobal := jvs;
LOOP
VAR head, ptr := lists[type];
BEGIN
IF thread = NIL THEN
thread := Thread.Fork(NEW(Thread.Closure, apply := NoMemApply))
END;
WHILE head # NIL AND head.subtype # subtype DO
head := head.next
END;
IF head # NIL THEN
IF head = ptr THEN
lists[type] := head.next
ELSE
WHILE ptr.next # head DO ptr := ptr.next END;
ptr.next := head.next
END;
DEC(water[type]);
lowater[type] := MIN(lowater[type], water[type]);
RETURN head.id;
END;
END;
IF noMem THEN
IF wait THEN Thread.AlertWait(mutex, cond) ELSE RETURN 0 END
ELSE
(* otherwise we need to allocate a new one *)
VAR id := 0;
BEGIN
IF pacer[type] < Pace THEN
IF type = Jvs.BufferType.Compress THEN
id := jvs.allocateBuffer(type, Length[subtype], 0)
ELSE
id :=
jvs.allocateBuffer(type, Width[subtype], Height[subtype])
END
END;
IF id = 0 THEN
noMem := TRUE;
ELSE
VAR addr := LOOPHOLE(Ushm.shmat(id, NIL, 0), ADDRESS);
BEGIN
IF LOOPHOLE(addr, INTEGER) = -1 THEN
OSErrorPosix.Raise();
END;
INC(pacer[type]);
EVAL addresses.put(id, NEW(RefAddr, address := addr));
RETURN id;
END;
END
END
END
END
END;
END AllocateBuffer;
PROCEDURE FreeBuffer (type : Jvs.BufferType;
id : Jvs.ShmBufId;
subtype: CARDINAL ) =
BEGIN
LOCK mutex DO
WITH new = NEW(BuffElt, subtype := subtype, id := id,
next := lists[type]) DO
lists[type] := new;
INC(water[type]);
Thread.Broadcast(cond)
END;
END;
END FreeBuffer;
PROCEDURE BufferAddress (id: Jvs.ShmBufId): ADDRESS RAISES {OSError.E} =
VAR ref: REFANY;
BEGIN
LOCK mutex DO
IF NOT addresses.get(id, ref) THEN
RAISE OSError.E(shmNotAttached);
END;
RETURN NARROW(ref, RefAddr).address;
END
END BufferAddress;
BEGIN
shmNotAttached :=
NEW(AtomList.T,
head := Atom.FromText("JvsBuffer.SharedMem segment not attached"));
END JvsBuffer.