unit BoundedBuf;
 
{Martin Harvey 24/4/2000}
 
interface
 
uses Windows, SysUtils;
 
const
 DefaultWaitTime = 5000; { Cinco segundos de espera por el mutex }
 
type
 { No me agradan particularmente los arreglos dinmicos, de modo que har las cosas
 al estilo de “C”, asignando la memoria explcitamente
 Piensa en TBufferEntries como ^(array of pointer) }
 
 TBufferEntries = ^Pointer;
 
 TBoundedBuffer = class
 private
 FBufInit: boolean;
 FBufSize: integer;
 FBuf: TBufferEntries;
 FReadPtr, { ReadPtr apunta a la siguiente entrada usada en el buffer}
 FWritePtr: integer; { WritePtr apunta a la siguiente entrada libre en el buffer}
 FEntriesFree, FEntriesUsed: THandle; { Semforos de control de flujo }
 FCriticalMutex: THandle; { Mutex de seccin crtica }
 protected
 procedure SetSize(NewSize: integer);
 public
 procedure ResetState;
 destructor Destroy; override;
 function PutItem(NewItem: Pointer): boolean;
 function GetItem: Pointer;
 published
 property Size: integer read FBufSize write SetSize;
 end;
 
 { No se necesita ningn constructor porque los valores por defecto de 0, false, etc son aceptables }
 
implementation
 
const
 FailMsg1 = 'Fallo en el control de flujo o buffer no inicializado';
 FailMsg2 = 'Fallo en la seccin crtica o buffer no inicializado.';
 
procedure TBoundedBuffer.SetSize(NewSize: integer);
 
{ Inicializa los manejadores y asigna la memoria.
 Si el tamao del buffer ha sido establecido con anterioridad, entonces aqui
 podra solicitar un reiniciado del buffer. }
 
begin
 if FBufInit then ResetState;
 if NewSize < 2 then NewSize := 2;
 FBufSize := NewSize;
 GetMem(FBuf, Sizeof(Pointer) * FBufSize);
 FillMemory(FBuf, Sizeof(Pointer) * FBufSize, 0);
 FBufInit := true;
 FCriticalMutex := CreateMutex(nil, false, nil); { notese la carencia de nombre }
 { El coteo inciial del semforo require pensar un poco,
 El conteo mximo require pensar un poco ms.
 Nuevamente, todos los objetos de sincronizacin son annimos. }
 FEntriesFree := CreateSemaphore(nil, FBufSize - 1, FBufSize, nil);
 FEntriesUsed := CreateSemaphore(nil, 0, FBufSize, nil);
 if (FCriticalMutex = 0)
 or (FEntriesFree = 0)
 or (FEntriesUsed = 0) then ResetState
end;
 
procedure TBoundedBuffer.ResetState;
 
{ Cierra los manejadores y libera la memoria.
 Ntese que aqu se deben desbloquear los hilos de manera tal que puedan
 terminar limpiamente. }
 
begin
 if FBufInit then
 begin
 WaitForSingleObject(FCriticalMutex, DefaultWaitTime);
 FBufInit := false;
 FBufSize := 0;
 FreeMem(FBuf);
 { Ahora reactiva todos los hilos esperando.
 Actualmente solo asume un hilo productor y un productor.
 Un montn de detalles sobre ordenamiento y trampas se discutirn aqu.}
 ReleaseSemaphore(FEntriesFree, 1, nil);
 ReleaseSemaphore(FEntriesUsed, 1, nil);
 CloseHandle(FEntriesFree);
 CloseHandle(FEntriesUsed);
 { Si los hilos lector y escritor estn esperando,
 entonces estarn esperando por el mutex.
 Cerraremos el manejador y los dejaremos caer en time out. }
 CloseHandle(FCriticalMutex);
 end;
end;
 
function TBoundedBuffer.PutItem(NewItem: Pointer): boolean;
 
{ Llamado por el hilo productor }
var
 NthItem: TBufferEntries;
 
begin
 result := false;
 { ESPERA(EntriesFree) }
 if WaitForSingleObject(FEntriesFree, INFINITE) <> WAIT_OBJECT_0 then
 exit;
 if (WaitForSingleObject(FCriticalMutex, DefaultWaitTime) <> WAIT_OBJECT_0)
 or not FBufInit then
 exit;
 NthItem := FBuf;
 Inc(NthItem, FWritePtr);
 NthItem^ := NewItem;
 FWritePtr := (FWritePtr + 1) mod FBufSize;
 ReleaseMutex(FCriticalMutex);
 { MARCA(EntriesUsed) }
 ReleaseSemaphore(FEntriesUsed, 1, nil);
 result := true;
end;
 
function TBoundedBuffer.GetItem: Pointer;
 
{ Llamado por el hilo consumidor }
var
 NthItem: TBufferEntries;
 
begin
 result := nil;
 { ESPERA(EntriesUsed) }
 if WaitForSingleObject(FEntriesUsed, INFINITE) <> WAIT_OBJECT_0 then
 exit;
 if (WaitForSingleObject(FCriticalMutex, DefaultWaitTime) <> WAIT_OBJECT_0)
 or not FBufInit then
 exit;
 NthItem := FBuf;
 Inc(NthItem, FReadPtr);
 Result := NthItem^;
 FReadPtr := (FReadPtr + 1) mod FBufSize;
 ReleaseMutex(FCriticalMutex);
 { MARCA(EntriesFree) }
 ReleaseSemaphore(FEntriesFree, 1, nil);
end;
 
destructor TBoundedBuffer.Destroy;
begin
 ResetState;
 inherited Destroy;
end;
 
end.