Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MULTSKTP.ZIP/QUEUE.PAS

Pascal/Delphi Source File | 1988-08-20 | 10.9 KB | 303 lines

{//////////////////////////////////////////////////////////////////////////////
///                                                                         ///
///           Universelle Verwaltung einfach verketteter Listen             ///
///                                                                         ///
///                 (c) Christian Philipps, Moers                           ///
///                         im Juli 1988                                    ///
///                                                                         ///
///              Dieses System erfordert Turbo-Pascal V4.0                  ///
///              und die Unit TP4MULTI                                      ///
///                                                                         ///
//////////////////////////////////////////////////////////////////////////////}

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

UNIT Queue;

INTERFACE

USES Tp4Multi;

TYPE  QueuePtrType  = ^QueueRecType;
      QueueRecType  = RECORD                     {Queue-Element}
                        Data     : Pointer;      {Zeiger auf Datenbereich}
                        Next     : QueuePtrType; {Zeiger auf nächstes Element}
                      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;

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, Func:Pointer):Pointer;
PROCEDURE SafeGetMem(VAR x; Size:Word);
PROCEDURE SafeFreeMem(VAR x; Size:Word);

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

IMPLEMENTATION

TYPE QueueErrType  = (QueCreSem, QueRemSem, QueHeap);

VAR  ProcAddr    : Pointer;
     SearchQueue : Pointer;

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

PROCEDURE SafeFreeMem(VAR x; Size:Word);
{
  Freigabe von Speicher unter Blockierung der CPU
}

VAR  P : Pointer absolute x;

BEGIN {SafeFreeMem}
  BindCPU;
  FreeMem(P,Size);
  ReleaseCPU;
END;  {SafeFreeMem}

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

PROCEDURE SafeGetMem(VAR x; Size:Word);
{
  Freigabe von Speicher unter Blockierung der CPU
}

VAR  P : Pointer absolute x;

BEGIN {SafeGetMem}
  BindCPU;
  GetMem(P,Size);
  ReleaseCPU;
END;  {SafeGetMem}

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

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 Last^.Next := Elem;                  {Verketten}
    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   zElem : QueuePtrType;
      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;
              Goto ExitRemove;
            END;

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

    zElem := First;                           { suche Vorgänger von "Elem" }
    WHILE zElem^.Next <> Elem DO
      zElem := zElem^.Next;

    zElem^.Next := Elem^.Next;                { Element ausketten }

    IF Elem = Last                            { ggf. Last-Zeiger aktualisieren }
       THEN Last := zElem;

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 ElemFound(Vergleichswert, Data:Pointer):BOOLEAN;
  INLINE($FF/$1E/ProcAddr);   { CALL FAR [ProcAddr] }

{ siehe Turbo 4.0 Beispielprogramm PROCPTR.PAS }

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

FUNCTION FindRec(VAR QueueRec:QueueType; Vergleichswert, Func:Pointer):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}
  ProcAddr := Func;                              {bereite Funktionsaufruf vor}
  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                                      ///
//////////////////////////////////////////////////////////////////////////////}