Copyright (C) 1994, Digital Equipment Corp. UNSAFE MODULE-- T --; IMPORT Ctypes, OSError, OSErrorPosix, Uipc, Ushm, Thread; JVBuffer
REVEAL T = Public BRANDED OBJECT count, users: CARDINAL := 0; next : T := NIL; (* for linked list *) pool : Pool; METHODS inc () := Inc; OVERRIDES init := InitT; free := Free; END; PROCEDURE-- Pool --Inc (t: T) = BEGIN LOCK t DO INC(t.count) END END Inc; PROCEDUREInitT (t: T; shmid: Ctypes.int; address: ADDRESS): T RAISES {OSError.E} = VAR shmid_ds: Ushm.struct_shmid_ds; BEGIN IF Ushm.shmctl(shmid, Uipc.IPC_STAT, ADR(shmid_ds)) = -1 THEN OSErrorPosix.Raise(); END; LOCK t DO t.length := shmid_ds.shm_segsz; t.shmid := shmid; t.addr := address; END; RETURN t; END InitT; PROCEDUREFree (t: T) = VAR pool := t.pool; BEGIN IF t.ready # NIL THEN TRY t.ready.apply() EXCEPT Thread.Alerted => END; t.ready := NIL END; LOCK pool DO LOCK t DO <* ASSERT t.count > 0 *> DEC(t.count); IF t.users > 0 THEN DEC(t.users) END; IF t = pool.current AND t.users = 0 AND t.count = 1 THEN DEC(t.count); pool.current := NIL; Thread.Broadcast(pool.changeEvent) END; IF t.count = 0 THEN Return(pool, t); END; END END; END Free;
REVEAL Pool = PoolPublic BRANDED OBJECT closed := FALSE; current : T := NIL; (* most recently inserted image *) freeList: T := NIL; freeBuffers : CARDINAL := 0; (* num buffers in free list *) totalBuffers: CARDINAL := 0; maxBuffers : CARDINAL; factory : Factory; bufferFree : Thread.Condition; changeEvent: Thread.Condition; clients : CARDINAL := 0; clientEvent: Thread.Condition; OVERRIDES init := Init; setSize := SetSize; getCurrentBuffer := GetCurrentBuffer; waitForChange := WaitForChange; getFreeBuffer := GetFreeBuffer; insert := Insert; join := Join; leave := Leave; signalClosed := SignalClosed; clearClosed := ClearClosed; END; PROCEDURErestore this buffer to the free list. If there are now more buffers than maxBuffers, this will be sorted out in GetFreeBuffer. This avoids having to manage extra exception handling all over the place for the factory.destroy method LL >= pool Old Return procedure PROCEDURE Return (pool: Pool; buffer: T) = BEGIN buffer.next := pool.freeList; pool.freeList := buffer; INC(pool.freeBuffers); <* ASSERT pool.freeBuffers <= pool.totalBuffers *>Init (pool: Pool; factory: Factory; maxBuffers: CARDINAL): Pool = BEGIN LOCK pool DO pool.factory := factory; pool.maxBuffers := maxBuffers; pool.bufferFree := NEW(Thread.Condition); pool.changeEvent := NEW(Thread.Condition); pool.clientEvent := NEW(Thread.Condition); END; RETURN pool; END Init; PROCEDURESetSize (pool: Pool; maxBuffers: CARDINAL) RAISES {Thread.Alerted, OSError.E} = VAR broadcast := FALSE; BEGIN LOCK pool DO broadcast := pool.maxBuffers < maxBuffers; pool.maxBuffers := maxBuffers; (* get rid of excess buffers *) WHILE pool.totalBuffers > pool.maxBuffers AND pool.freeBuffers > 0 DO DEC(pool.totalBuffers); pool.factory.destroy(Pop(pool)); END; END; IF broadcast THEN Thread.Broadcast(pool.bufferFree); END; END SetSize; PROCEDUREGetCurrentBuffer (pool: Pool): T = BEGIN LOCK pool DO IF pool.current # NIL THEN pool.current.inc(); END; RETURN pool.current; END; END GetCurrentBuffer; PROCEDUREWaitForChange (pool: Pool): T RAISES {Thread.Alerted, Closed} = VAR oldSerial: Serial; BEGIN LOCK pool DO IF pool.current = NIL THEN WHILE NOT pool.closed AND pool.current = NIL DO Thread.AlertWait(pool, pool.changeEvent); END; ELSE oldSerial := pool.current.serial; WHILE NOT pool.closed AND (pool.current = NIL OR oldSerial = pool.current.serial) DO Thread.AlertWait(pool, pool.changeEvent); END; END; <* ASSERT pool.closed OR pool.current # NIL *> IF Thread.TestAlert() THEN RAISE Thread.Alerted; END; IF pool.closed THEN RAISE Closed; END; pool.current.inc(); RETURN pool.current; END; END WaitForChange; PROCEDUREGetFreeBuffer (pool: Pool; wait := FALSE; subtype: CARDINAL): T RAISES {Thread.Alerted, OSError.E} = VAR res: T := NIL; BEGIN LOOP LOCK pool DO (* only release buffers if someone is listening *) WHILE pool.clients = 0 DO IF wait THEN Thread.AlertWait(pool, pool.clientEvent); ELSE RETURN NIL; END; END; WHILE pool.totalBuffers >= pool.maxBuffers AND pool.freeBuffers = 0 DO (* cannot create any more buffers *) IF wait THEN Thread.AlertWait(pool, pool.bufferFree); ELSE RETURN NIL; END; END; <* ASSERT pool.totalBuffers < pool.maxBuffers OR pool.freeBuffers > 0 *> IF Thread.TestAlert() THEN RAISE Thread.Alerted; END; IF pool.freeBuffers > 0 THEN WITH free = Pop(pool) DO free.inc(); RETURN free; END; END; INC(pool.totalBuffers); END; VAR ok := FALSE; BEGIN TRY res := pool.factory.make(FALSE, subtype); ok := TRUE FINALLY IF res = NIL OR NOT ok THEN LOCK pool DO DEC(pool.totalBuffers) END END END END; LOCK pool DO IF res # NIL THEN res.pool := pool; res.inc(); RETURN res ELSIF NOT wait THEN RETURN NIL END END; Thread.Pause(0.5D0) END END GetFreeBuffer; PROCEDUREInsert (pool: Pool; buffer: T) = BEGIN LOCK pool DO buffer.users := pool.clients; IF pool.current # NIL THEN WITH curr = pool.current DO (* free the previous current, with different locking *) LOCK curr DO <* ASSERT curr.count > 0 *> DEC(curr.count); IF curr.count = 0 THEN Return(pool, curr); END; END; END; END; pool.current := buffer; END; Thread.Broadcast(pool.changeEvent); END Insert; PROCEDUREJoin (pool: Pool) = BEGIN LOCK pool DO INC(pool.clients); END; IF pool.clients = 1 THEN Thread.Signal(pool.clientEvent); END; END Join; PROCEDURELeave (pool: Pool) = BEGIN <* ASSERT pool.clients > 0 *> LOCK pool DO DEC(pool.clients); END; END Leave; PROCEDURESignalClosed (pool: Pool) = BEGIN LOCK pool DO pool.closed := TRUE; END; Thread.Broadcast(pool.changeEvent); END SignalClosed; PROCEDUREClearClosed (pool: Pool) = BEGIN LOCK pool DO pool.closed := FALSE; END; END ClearClosed;
IF pool.freeBuffers = 1 AND pool.totalBuffers <= pool.maxBuffers THEN Thread.Broadcast(pool.bufferFree); END; END Return;
LL >= pool, buffer
PROCEDUREget the top buffer from the free list LL >= poolReturn (pool: Pool; buffer: T) = BEGIN IF pool.current = buffer THEN pool.current := NIL END; DEC(pool.totalBuffers); TRY pool.factory.destroy(buffer); EXCEPT OSError.E => | Thread.Alerted => Thread.Alert(Thread.Self()) END; Thread.Broadcast(pool.bufferFree); END Return;
PROCEDUREPop (pool: Pool): T = VAR res: T; BEGIN <* ASSERT pool.freeList # NIL AND pool.freeBuffers > 0 *> res := pool.freeList; pool.freeList := res.next; res.next := NIL; DEC(pool.freeBuffers); RETURN res; END Pop; BEGIN END JVBuffer.