Category : Pascal Source Code
Archive   : MULTI.ZIP
Filename : QUEUE.PAS

{//////////////////////////////////////////////////////////////////////////////
/// ///
/// Universelle Verwaltung doppelt verketteter Listen ///
/// ///
/// (c) Christian Philipps, Moers ///
/// im November 1988 ///
/// ///
/// Dieses System erfordert Turbo-Pascal V5.0 ///
/// und die Unit CpMulti ///
/// ///
/// Wann immer ein Element entfernt werden soll, das sich am Kopf bzw. ///
/// Ende der Queue befindet, ist der Aufwand fr die L”schung konstant. ///
/// Die durchschnittliche L”schzeit bei Elementen aus der Mitte der Queue, ///
/// w„chst proportional zur Anzahl der Elemente in der Kette. ///
/// ///
//////////////////////////////////////////////////////////////////////////////}

{$R-,S-,I-,D-,F-,V-,B-,N-,L-,O-}

UNIT Queue;

INTERFACE

USES CpMulti, CpMisc;

TYPE QueuePtrType = ^QueueRecType;
QueueRecType = RECORD {Queue-Element}
Data : Pointer; {Zeiger auf Datenbereich}
Next : QueuePtrType; {Zeiger auf n„chstes Element}
Prev : QueuePtrType; {Zeiger auf Vorg„nger}
END;
QueDataType = LongInt;
QueueType = RECORD {Anker der Queue}
Critical : Pointer; {Semaphore fr Update-Zugriff}
Elements : Pointer; {Element-Count}
QueData : QueDataType; {User-Defined Data}
First : QueuePtrType; {Zeiger auf Queue-Anfang}
Last : QueuePtrType; {Zeiger auf Queue-Ende}
END;
VergFuncType = FUNCTION(Vergleichswert, Data:Pointer):BOOLEAN;

PROCEDURE AppendRec(VAR QueueRec:QueueType; Data:Pointer);
FUNCTION RemoveRec(VAR QueueRec:QueueType; Data:Pointer):Pointer;
PROCEDURE CreQueue(VAR Q:QueueType);
FUNCTION DeleteQueue(VAR Q:QueueType):BOOLEAN;
FUNCTION FindRec(VAR QueueRec:QueueType; Vergleichswert:Pointer;
ElemFound:VergFuncType):Pointer;

{-----------------------------------------------------------------------------}

IMPLEMENTATION

TYPE QueueErrType = (QueCreSem, QueRemSem, QueHeap);

VAR SearchQueue : Pointer;

{-----------------------------------------------------------------------------}

PROCEDURE QueueErr(ErrNo:QueueErrType);

BEGIN {QueueErr}
Write(^G'Queue: ');
CASE ErrNo OF
QueHeap: Writeln('Zuwenig dynamischer Speicher vorhanden!');
QueCreSem: Writeln('Fehler beim Anlegen einer Semaphore!');
QueRemSem: Writeln('Fehler beim L”schen einer Semaphore!');
ELSE Writeln('Unbekannter Fehler: ',Byte(ErrNo));
END;
Halt(1);
END; {QueueErr}

{-----------------------------------------------------------------------------}

PROCEDURE AppendRec(VAR QueueRec:QueueType; Data:Pointer);

{ Anh„ngen eines Elementes an die durch QueueRec verwaltete Queue.
Fr das Element wird ein Verwaltungssatz angelegt. Fehlt der hierfr er-
forderliche dynamische Speicher, so wird die Aktion abgebochen!
Zum Abschluá der Aktion wird der Element-Count der Queue erh”ht!
}

VAR Elem : QueuePtrType;

BEGIN {AppendRec}
IF MaxAvail < SizeOf(QueueRecType)
THEN QueueErr(QueHeap);

SafeGetMem(Elem,SizeOf(Elem^)); {erzeuge Verwaltungssatz}
Elem^.Next := NIL; {Bildet das Kettenende}
Elem^.Data := Data; {h„nge Datenbereich ein}

WITH QueueRec DO
BEGIN
SemWait(Critical); {Kritischer Bereich}
IF First = NIL {erstes Kettenelement}
THEN First := Elem
ELSE BEGIN
Last^.Next := Elem; {Verketten}
END;
Elem^.Prev := Last; {Vorg„nger merken}
Last := Elem; {neues Kettenende merken}
SemSignal(Critical); {Freigeben der Queue}
SemSignal(Elements); {Erh”he Anzahl Elemente}
END;
END; {AppendRec}

{-----------------------------------------------------------------------------}

FUNCTION RemoveRec(VAR QueueRec:QueueType; Data:Pointer):Pointer;

{
Entfernen des Queue-Elementes auf dessen Datenbereich der Zeiger Data
verweist. Dieser Zeiger MUSS auf ein gltiges Kettenelement verweisen, da
zur Verbesserung der Performance von dieser Voraussetzung ausgegangen wird.
Fehlerhafte Datenbereichszeiger werden mit einiger Sicherheit im Nirwana
enden; gnstigsten Falles jedoch mit einer ungltige Pointeroperation.
Der Verwaltungssatz zu diesem Element wird freigegeben.
ACHTUNG!!! Der Element-Count wird NICHT ver„ndert, da in der Regel auf die
Warteschlange ber ein SemWait(Elements) zugegriffen wird, wenn die Entnahme
von Daten beabsichtigt ist. Durch diesen Aufruf wurde der Element-Count be-
reits vor Aufruf von RemoveRec erniedrigt.
}

LABEL ExitRemove;

VAR Elem : QueuePtrType;

BEGIN {RemoveRec}
RemoveRec := Data; { Zeiger auf Elem zurckliefern }

WITH QueueRec DO
BEGIN
SemWait(Critical); { Exclusiver Zugriff erforderlich}
Elem := First; { fr 2 F„lle zutreffend }
IF First = Last { nur 1 Kettenelement }
THEN BEGIN
First := NIL;
Last := NIL;
Goto ExitRemove;
END;

IF First^.Data = Data { erstes Element! }
THEN BEGIN
First := First^.Next;
First^.Prev := NIL;
Goto ExitRemove;
END;

IF Last^.Data = Data { letztes Element }
THEN BEGIN
Elem := Last; { fr FreeMem }
Last^.Prev^.Next := NIL; { Vorw„rtskette abschlieáen }
Last := Last^.Prev; { Last aktualisieren }
Goto ExitRemove;
END;

Elem := First; { suche den Verwaltungssatz }
WHILE Elem^.Data <> Data DO
Elem := Elem^.Next;

Elem^.Prev^.Next := Elem^.Next; { Vorw„rtsverweis durchreichen }
Elem^.Next^.Prev := Elem^.Prev; { und rckverketten }

ExitRemove:
SafeFreeMem(Elem,SizeOf(Elem^)); { Freigeben Verwaltungssatz}
SemSignal(Critical); { Freigeben der Queue }
END;
END; {RemoveRec}

{-----------------------------------------------------------------------------}

PROCEDURE CreQueue(VAR Q:QueueType);

{ Anlegen und Initialisieren einer Queue }

BEGIN {CreQueue}
WITH Q DO
BEGIN
IF (CreateSem(Critical) <> Sem_Ok) OR
(CreateSem(Elements) <> Sem_Ok)
THEN QueueErr(QueCreSem);

SemClear(Elements);
First := NIL;
Last := NIL;
END;
END; {CreQueue}

{-----------------------------------------------------------------------------}

FUNCTION DeleteQueue(VAR Q:QueueType):BOOLEAN;
{
L”schen einer Queue, sofern diese derzeit keine Elemente enth„lt.
Aller durch die Semaphoren belegte Speicherplatz wird wieder freigegeben.
Ist die Warteschlange einer Semaphore nicht leer, oder enth„lt die Queue
noch Elemente, so zeigt der Funktionswert FALSE Miáerfolg an.
}
BEGIN {DeleteQueue}
DeleteQueue := False;
WITH Q DO
BEGIN
IF (First <> NIL) OR
SemSoWaiting(Critical) OR
SemSoWaiting(Elements)
THEN Exit;

IF (RemoveSem(Critical) <> Sem_OK) OR
(RemoveSem(Elements) <> Sem_OK)
THEN QueueErr(QueRemSem);
END;
DeleteQueue := True;
END; {DeleteQueue}

{-----------------------------------------------------------------------------}

FUNCTION FindRec(VAR QueueRec:QueueType; Vergleichswert:Pointer;
ElemFound:VergFuncType):Pointer;

{
Durchsuchen einer Queue nach einem bestimmten Element.
Der Parameter Data ist ein Zeiger auf ein irgendwie geartetes Datenelement,
das die durch Func angesprochene Funktion als Vergleichswert ben”tigt.
Func ist ein Zeiger auf eine Funktion, die als Parameter zwei Zeiger, einen
auf den Vergleichswert und einen auf den Datenbereich eines Queue-Elements
erh„lt. Der Funktionswert dieser Funktion zeigt an, ob das gesuchte Element
gefunden werden konnte. True = Gefunden. Diese Funktion muá eine FAR-Funk-
tion sein, also z. B. mit dem Compilerswitch F+ compiliert worden sein.
Kann in der gesamten Queue kein passendes Element gefunden werden, so lie-
fert FindRec NIL, anderenfalls einen Zeiger auf den Datenbereich des ge-
fundenen Kettenelementes.
W„hrend der Suche wird die Queue blockiert, um gleichzeitige Updates auszu-
schlieáen. Ferner wird durch die Semaphore SearchQueue gew„hrleistet, daá
zu einem Zeitpunkt immer nur eine Suchanforderung aktiv sein kann. Dies ist
erforderlich, da jede Suchanforderung die globale Variable ProcAddr ver„n-
dert, die auf die Vergleichsfunktion verweist.
}

LABEL ExitFindRec;

VAR Elem : QueuePtrType;

BEGIN {FindRec}
SemWait(SearchQueue); {ProcAddr exclusiv anfordern}
FindRec := NIL;
WITH QueueRec DO
BEGIN
SemWait(Critical); {blockiere die Queue}
IF First = NIL
THEN Goto ExitFindRec {Queue leer}
ELSE Elem := First; {initialisiere Arbeitspointer}

WHILE (Elem <> NIL) DO
IF ElemFound(Vergleichswert,Elem^.Data)
THEN BEGIN {Eintrag gefunden}
FindRec := Elem^.Data;
Goto ExitFindRec;
END
ELSE Elem := Elem^.Next; {weiter mit Folgeelement}

ExitFindRec:
SemSignal(Critical);
SemSignal(SearchQueue);
END;
END; {FindRec}

{-----------------------------------------------------------------------------}

BEGIN {Initialisierung}
IF CreateSem(SearchQueue) <> Sem_OK
THEN QueueErr(QueCreSem);
END. {Initialisierung}

{//////////////////////////////////////////////////////////////////////////////
/// Ende des Moduls ///
//////////////////////////////////////////////////////////////////////////////}