* QUEUE - Task-Kommunikatiossystem unter RTOS/PEARL
*
* Autor:   Karl Hermann Fuchs
*          MPI f. biophys Chemie
*          3400 Goettingen
*
* Datum:   19. Februar 1988 erzeugt
*          12. April 1988 revidiert
*
* Beschreibung siehe auch "Schlangenpfade", c' t 10/88, S. 148
*
*
* RTOS mnemonics
*
*
RETN     OPD      $4E4C             Return von PEARL Prozedur
REQU     OPD      $4E46             Request Semaphor
RELEA    OPD      $4E47             Release Semaphor
OFF      OPD      $4E4F             Scheduler off
QDPC     OPD      $4E43             Dispatcher Call
*
*
* trap 10
*
WSBS     OPD      $A00C             Get Workspace
RWSP     OPD      $A02A             Release Workspace
*
*
* Hyperprocessor Kommandos
*
ENTR     OPD.V    29                Prozedur Eingang
EPAR     OPD.V    19                Ende der Parameter Liste
VARW     OPD.V    10                FIXED(15) by reference
INVW     OPD.V    14                FIXED(15) by value
MPXF     OPD.V    139               Misc Parameter passing
*
*
*
*
* Typ-Definition
*
*
*   Link und Modul Offsets
*
TYPE     EQU      8               Modul Typ
NAME     EQU      10              Modul Name
FORT     EQU      10              Forward Link
BACKT    EQU      14              Backward Link
*
*
* Struktur eines Queue Descriptors:
*
HEAD     EQU      0               Adresse des Queue Head-Elements
TAIL     EQU      HEAD+4          Adresse des Queue Tail-Elements
ACCESS   EQU      TAIL+4          Semaphor fuer Zugangskontrolle
THRESH   EQU      ACCESS+2        Threshold Semaphor
LENGTH   EQU      THRESH+2        Laengen Semaphor
QSIZE    EQU      LENGTH+2        Groesse des Descriptors
*
*
* Struktur eines Queue Elements:
*
NEXT     EQU      0               Adresse des naechsten Queue Element
ELTLEN   EQU      NEXT+4          Groesse der transportierten Daten
ESIZE    EQU      ELTLEN+2        Groesse dieses Kopfes
*
*
*
*
* Konstanten Definition
*
*
NIL      EQU      0               NIL
LOCK     EQU      -1              Markierung zur Sperrung einer Queue
*
*
*
* Queue i/o Rueckgabe Meldungen
*
NOMEM    EQU      -1              Speicher Ueberlauf
OK       EQU      0               Erfolgreicher Operation
CLOSED   EQU      1               Queue ist geschlossen
*
*
*
*   Modul Kopf
*
         DC.L     0
         DC.L     0
         DC.W     $10
         DC.B     '$ITCQ$'
*
*
*
*
* Prozedur Implementation
*
*
* QOpen eroeffnet eine neue Queue. Speicher fuer den Descriptor wird
* alloziert und dieser mit den initialen Werten versehen. Die Adresse
* des Descriptor wird in der uebergebenen BIT(32) Variablen zurueck-
* gegeben. Falls kein Speicher zugeteilt werden konnte, enthaelt sie
* den Wert NIL.
*
*
* Parameter Workspace:
*
QID      EQU      0               Adresse des Queue Identifier
THOLD    EQU      QID+4           Threshold Wert
OWSP     EQU      THOLD+2         Groesse des Workspace
*
*
* Prozedur Eingang
*
>QOpen   ENTR     OWSP.L
         MPXF     R32,QID.Z       ID by reference
         INVW     THOLD.X         Threshold Level
         EPAR                     Parameter Ende
         MOVE.L   =QSIZE,D1       Groesse des Queue Descriptors -> D1
         MOVEA.L  QID.X,A0        Adresse des Identifier -> A0
         JSR      Alloc           Reserviere Speicher
         MOVE.L   A1,(A0)         und plaziere Adresse in Identifier
         BEQ      NOQMEM          Speicher Ueberlauf
         MOVE.L   =NIL,HEAD(A1)   Kein Head-Element
         MOVE.L   =NIL,TAIL(A1)   Kein Tail-Element
         MOVE.W   =1,ACCESS(A1)   Preset ACCESS Sema auf 1 Release
         CLR.W    LENGTH(A1)      Queue ist leer
         MOVE.W   THOLD.X,THRESH(A1)  Preset Threshold auf Maximum
NOQMEM   RETN
*
*
*
*
* QClose schliesst eine Queue fuer den weiteren Zugriff. Die Queue
* wird nicht geloescht, so dass eventuell noch vorhandene Elemente
* ausgelesen werden koennen. Ein Schreibzugriff ist nach QClose
* nicht mehr moeglich.
*
* Parameter Workspace
*
CID      EQU      0               ID der Queue
CWSP     EQU      CID+4           Benoetigter Workspace
*
*
* Prozedur Eingang
*
>QClose  ENTR     CWSP.L
         MPXF     V32,CID.X       ID by value
         EPAR                     Ende der Parameter Liste
         MOVEA.L  CID.X,A0        Adresse des Identifdiers -> A0
         LEA      ACCESS(A0),A1   Adresse des Access Semaphor -> A1
         REQU                     Request Access
         TST.L    TAIL(A0)        Adresse des letzten Queue Elements
         BEQ      CEMPTY          Queue ist leer
         MOVEA.L  TAIL(A0),A2
         MOVE.L   =LOCK,NEXT(A2)  Markiere Link des letzten Elements
         BRA      CDONE
CEMPTY   MOVE.L   =LOCK,TAIL(A0)  Markiere Tail Feld
         MOVE.L   =LOCK,HEAD(A0)  Markiere Head Feld
CDONE    LEA      LENGTH(A0),A1   Release Laengen Semaphor
         RELEA
         LEA      ACCESS(A0),A1   Adresse des Access Semaphor
         RELEA                    Release Queue
         RETN
*
*
*
*
* QDelet gibt den fuer den Descriptor reservierten Speicher wieder
* frei. Diese Prozedur darf nur gerufen werden, wenn keine Task mehr
* Zugriff auf diese Queue beantragt. Nach Aufruf von QDelet fuehrt
* ein weiterer Zugriff auf die Queue garantiert zum Absturz.
*
* Parameter workspace
*
DID      EQU      0               ID der Queue
DWSP     EQU      DID+4           Benoetigter Workspace
*
*
* Prozedur Eingang
*
>QDelet  ENTR     DWSP.L
         MPXF     V32,DID.X       ID by value
         EPAR                     Ende der Parameter Liste
         MOVEA.L  DID.X,A0        Queue ID -> A0
         MOVEA.L  HEAD(A0),A2     Adresse des Queue Head -> A2

* Alle noch vorhanden Elemente in der Queue werden geloescht
NEXTD    MOVE.L   A2,D1           Element vorhanden?
         BLE      DDONE           Nein, alle Elemente sind entfernt
         MOVEA.L  A2,A1           Adresse des Speichersegments -> A1
         MOVEA.L  NEXT(A2),A2     Adresse des vorigen Elements -> A2
         JSR      Free            Freigabe des Speichers
         BRA      NEXTD           Naechstes Element

* Freigabe des Descriptors
DDONE    MOVEA.L  A0,A1           Adresse des Queue Descriptors
         JSR      Free            Freigabe
         RETN
*
*
*
*
* QRead wartet auf den Zutritt zur Queue wenn ein Element verfueg-
* bar ist. Das Element wird in die uebergebene Datenstruktur kopiert
* und das fuer das allozierte Element reservierte Speichersegment
* an das OS zurueckgegeben. Wurde die Queue vorher geschlossen,
* so arbeitet QRead bis alle Elemente ausgelesen wurden. Sind
* keine Elemente mehr vorhanden, so kehrt QRead zurueck, ohne ein
* Element zur Verfuegug zu stellen. Damit ist gewaehrleistet,
* dass ein Lesezugriff auf eine geschlossene Queue nicht die Task
* mit dem Versuch, Zutritt zur Queue zu erlangen, blockiert.
* Wurde kein Element gelesen, so enthaelt das size Feld der Daten-
* struktur den Wert 0.

* Parameter Workspace
*
RID      EQU      0               ID der Queue
RDATA    EQU      RID+4           Adresse der Datenstruktur
RRETN    EQU      RDATA+4         Adresse des Rueckgabe Wertes
RWSP     EQU      RRETN+4         Workspace fuer diese Prozedur
*
*
* Prozedur Eingang
*
>QRead   ENTR     RWSP.L
         MPXF     V32,RID.X       ID by value
         VARW     RDATA.Z         Adresse der Datenstruktur
         VARW     RRETN.Z         Adresse des Rueckgabewertes
         EPAR                     Ende der Parameter Liste
         MOVEA.L  RID.X,A0        Identifier -> A0
         MOVEA.L  RDATA.X,A2      Adresse der Datenstruktur -> A2
         MOVEA.L  RRETN.X,A3      Adresse des Rueckgabewertes -> A3

* Fordere Zugang zur Queue an
         LEA      LENGTH(A0),A1   Request Laengen Semaphor
         REQU
         LEA      ACCESS(A0),A1   Request Queue Access
         REQU

* Pruefe, ob die Queue geschlossen ist
         TST.L    HEAD(A0)        Ist Queue geschlossen?
         BPL      ROPEN           Nein, Zutritt ist erlaubt
         CLR.W    (A2)            Nichts gelesen, loesche size Feld
         BRA      RCLOSE          Nicht erfolgreiche Rueckkehr

* Queue ist offen, kopiere Element in die Datenstruktur
ROPEN    MOVEA.L  HEAD(A0),A1     Adresse des Queue Head -> A1
         LEA      ELTLEN(A1),A1   A1 zeigt auf Beginn der Daten
         MOVE.W   (A1),D1         D1 enthaelt Groesse diese Elements
         ADDQ.W   =2,D1           +2 Bytes fuer das size Feld
         EXT.L    D1              Extend
         JSR      Copy            Kopiere Element in Datenstruktur

* Linke Element aus der Queue und gib den Speicher an das OS zu-
* rueck.
         MOVEA.L  HEAD(A0),A1     Adresse des Queue Head -> A1
         MOVE.L   NEXT(A1),HEAD(A0) Naechstes ist neuer Head
         JSR      Free            Gib Speicher frei
         TST.L    HEAD(A0)        Ist Head CLOSED oder NIL?
         BGT      ROK             nein
         MOVE.L   HEAD(A0),TAIL(A0) Queue ist leer, erneuere Tail
         BMI      RCLOSE          Queue ist auch geschlossen
ROK      MOVE.W   =OK,(A3)        Gib OK zurueck
         LEA      THRESH(A0),A1   Ein Element mehr in der Queue
         RELEA
         BRA      RDONE           Release Queue Access

* Gib Zutritt wieder frei
RCLOSE   MOVE.W   =CLOSED,(A3)    Gib CLOSED zurueck
         LEA      LENGTH(A0),A1   Laenge wird dennoch erhoeht um
         RELEA                    weitere Requests zu ermoeglichen
RDONE    LEA      ACCESS(A0),A1   Gib Zugang frei
         RELEA
         RETN
*
*
*
*
* QWrite erhaelt ueber den Threshold Semaphor Zugang zur Queue.
* Solange dieser Semaphor nicht freigegeben ist, hat die Queue
* ihre maximale Laenge erreicht und die zugreifende Task wird
* suspendiert. Nach erfolgreichem Eintritt alloziert QWrite ein
* fuer die Datenstruktur passendes Speichersegment und kopiert
* die Information in diese Element. Diese Element wird sodann
* an die Queue angehaengt, der Laengen Semaphor um 1 erhoeht.
*
* Parameter Workspace
*
WID      EQU      0               Queue ID         
WDATA    EQU      WID+4           Adresse der Datenstruktur
WRETN    EQU      WDATA+4         Adresse des Rueckgabewertes
WWSP     EQU      WRETN+4         Workspace fuer diese Prozedur
*
* Prozedure Eingang
*
>QWrite  ENTR     WWSP.L
         MPXF     V32,WID.X       ID by value
         VARW     WDATA.Z         Adresse der Datenstruktur
         VARW     WRETN.Z         Adresse des Rueckgabewertes
         EPAR                     Ende der Parameter Liste
         MOVEA.L  WID.X,A0        Identifier -> A0
         MOVEA.L  WDATA.X,A2      Adresse der Datenstruktur -> A2
         MOVEA.L  WRETN.X,A3      Adresse des Resultats -> A3

* Fordere Zugang an
         LEA      THRESH(A0),A1   Request Threshold
         REQU
         LEA      ACCESS(A0),A1   Request Access
         REQU

* Pruefe, ob die Queue geschlossen ist
         TST.L    TAIL(A0)        Teste Tail Element
         BMI      WCLOSE          Queue ist geschlossen
         BEQ      WOPEN           Queue ist leer, aber offen
         MOVEA.L  TAIL(A0),A1     Adresse des Queue Tail -> A1
         TST.L    NEXT(A1)        geschlossen markiert?
         BPL      WOPEN           Nein, Queue ist offen
WCLOSE   MOVE.W   =CLOSED,(A3)    Liefere CLOSED zurueck
         BRA      WDONE           Kein Erfolg

* Alloziere neues Element
WOPEN    MOVE.W   (A2),D1         Groesse der Daten -> D1
         ADDQ.W   =ESIZE,D1       Addiere Verwaltungsbedarf
         EXT.L    D1              Extend
         MOVE.L   D1,D4           Rette fuer spaeter
         JSR      Alloc           Reserviere Speicher
         MOVE.L   A1,D3
         BEQ      WNOMEM          Speicher Ueberlauf
         MOVEA.L  WDATA.X,A2      Adresse der Datenstruktur -> A2

* Die Speicherzuteilung ist erfolgreich, kopiere die Datenstruktur
* in das Queue Element.
         MOVE.L   =NIL,NEXT(A1)   Markiere letztes Feld mit NIL
         MOVEA.L  A2,A1           Copy Start
         MOVEA.L  D3,A2           Copy Ziel
         LEA      ELTLEN(A2),A2   Link Feld wird nicht kopiert
         MOVE.L   D4,D1           Daten Groesse zurueck -> D1
         SUBQ.L   =4,D1           Subtrahiere Groesse des Link Feld
         JSR      Copy            Kopiere Datenstruktur ins Element

* Verkette das neue Element mit der Queue
         TST.L    TAIL(A0)        Adresse des letzten Elements
         BEQ      WEMPTY          Keins vorhanden
         MOVEA.L  TAIL(A0),A1     Adresse des letzten Elements
         MOVE.L   D3,NEXT(A1)     Haenge hinten an
         BRA      NOHEAD          und aendere nicht das Head Feld
WEMPTY   MOVE.L   D3,HEAD(A0)     Dieses Element ist auch neuer Head
NOHEAD   MOVE.L   D3,TAIL(A0)     Dieses Element ist neuer Tail
         MOVE.W   =OK,(A3)        Alles erfolgreich

* Gib Zutritt wieder frei
         LEA      LENGTH(A0),A1   Erhoehe die Queue Laenge
         RELEA
WDONE    LEA      ACCESS(A0),A1   Gib Zutritt frei
         RELEA
         RETN

* Speicher Ueberlauf
WNOMEM   MOVE.W   =NOMEM,(A3)     Gib NOMEM zurueck
         BRA      WDONE
*
*
*
*
* Copy - kopiert einen Speicher-Block mit gerader Startaddresse an
* eine andere gerade Zieladresse. Beide Bereiche duerfen sich nicht
* ueberlappen. Copy benuetzt Langwort-Transfers fuer eine optimale
* Effizienz.
*
Copy     MOVEQ    =3,D2
         AND.L    D1,D2           D1 MOD 4, Anzahl uebriger Bytes
         ASR.L    =2,D1           D1 DIV 4, Anzahl Langworte
         SUBQ.L   =1,D2           DBF zaehlt bis -1
         SUBQ.L   =1,D1           Auch in D1
         BMI      NOLONG          Kein Langwort
NEXTL    MOVE.L   (A1)+,(A2)+     Kopiere vier Bytes
         DBF      D1,NEXTL
NOLONG   TST.L    D2
         BMI      NOBYTE          Keine einzelnen Bytes uebrig
NEXTB    MOVE.B   (A1)+,(A2)+     Kopiere uebrigen Bytes
         DBF      D2,NEXTB
NOBYTE   RTS
*
*
*
*
* Alloc reserviert ein Speichersegment, dessen Groesse in D1 ueber-
* geben wird. Nach Rueckkehr enthaelt A1 die Start-Adresse des Seg-
* mentes oder NIL, falls kein Speicher zur Verfuegung gestanden hat.
* Alloc beruecksictigt den Verwaltungsbereich, den RTOS fuer jeden
* reservierten Workspace benoetigt, so dass die gelieferte Adresse
* den Beginn des tatsaechlich verfuegbaren Raumes reflektiert.
*
Alloc    ADD.L    =$20,D1         Addiere Verwaltungsbereich
         WSBS                     Alloziere Workspace
         BNE      FAIL            Kein Speicher verfuegbar
         OFF                      Ab jetzt keine Unterbrechung
         MOVEA.L  BACKT(A1),A2    Adresse des linken Elements -> A2
         MOVE.L   FORT(A1),FORT(A2)    verkette Forward link
         MOVEA.L  FORT(A1),A2          Adresse des rechten El ->A2
         MOVE.L   BACKT(A1),BACKT(A2)  verkette backward Link
         MOVE     =$10,TYPE(A1)        Bereich wird Modul
         MOVE     =$2441,NAME(A1)      Name des Moduls
         MOVE.L   =$6C6C6F63,NAME+2(A1)
         ANDI     =$D8FF,SR       Scheduler wieder an
         QDPC                     Rufe Dispatcher
         ADDA.L   =$20,A1         Addiere RTOS Verwaltungsbereich
         RTS
FAIL     MOVEA.L   =NIL,A1        Liefere NIL zurueck
         RTS
*
*
*
*
* Free gibt ein zuvor mit Alloc reserviertes Speichersegment zurueck.
* Die Adresse des Segmentes muss sich in A1 befinden.
*
Free     SUBA.L   =$20,A1         Subtrahiere Verwaltungsbereich
         RWSP                     Freigabe
         RTS
*
*
*
*
*   Parameter Descriptoren
*
R32      DC.B     32,$0C          BIT(32) by reference
V32      DC.B     32,$0D          BIT(32) by value
*
*
         END