0DQ 
          IDENT  0DQ,DQFX 
          PERIPH J
          BASE   MIXED
          SST 
*COMMENT  0DQ - DEQUEUE FILE. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  0DQ - DEQUEUE FILE.
          SPACE  4,10 
***       0DQ - DROP QUEUE FILE.
* 
*         D. R. HILGREN.     79/10/30.
*         R. M. DESSEL.      81/03/26.
*         P. D. HAAS.        81/06/18.
          SPACE  4,10 
***              *0DQ* IS A LOCATION-FREE ROUTINE USED TO DROP
*         A QFT ENTRY.  *0DQ* PERFORMS THE FOLLOWING -
*         1.  SEARCH FOR QFT ENTRY. 
*         2.  CLEAR QFT ENTRY.
*         3.  DROP DISK SPACE IF REQUESTED. 
*         4.  INCREMENT MASS STORAGE PRU COUNTER IF DISK SPACE DROPPED. 
*         5.  ISSUE ACCOUNT FILE MESSAGE IF FILE REMOVED FROM QUEUE.
          SPACE  4,15 
***       ENTRY CONDITIONS. 
* 
*         (QA) = 0.  USE EQUIPMENT AND FIRST TRACK TO FIND QFT ENTRY. 
*                THE QFT ENTRY WILL BE INTERLOCKED BY *0DQ* PRIOR TO
*                DELETION FOR FUNCTIONS 0 AND 1.
*         (QA) = QFT ORDINAL.  USE QFT ORDINAL TO FIND ENTRY.  THE
*                CALLER OF *0DQ* MUST INTERLOCK THE QFT ENTRY PRIOR TO
*                CALLING *0DQ*. 
*         ((LA)-1) = 0   RELEASE QFT ENTRY AND DISK SPACE.
*                  = 1   RELEASE QFT ENTRY ONLY.
*                  = 2   RELEASE DISK SPACE ONLY (FILE NOT IN QFT). 
*         (FS - FS+4) = FST INFORMATION.
          SPACE  4,10 
***       EXIT CONDITIONS.
* 
*         (A) = 0 IF REQUESTED DEQUEUEING OPERATION PERFORMED.
*             .LT. 0 IF QUEUE FILE DEVICE INACCESSIBLE. 
*         (T5) = QUEUE FILE DEVICE EST ORDINAL, IF DEVICE INACCESSIBLE. 
* 
*         (QA) = QFT ORDINAL, IF QFT ENTRY FOUND AND DEQUEUED.
*         (QA) = 0, IF QFT ENTRY NOT FOUND. 
* 
*         THE QUEUED FILE SYSTEM SECTOR WILL BE READ ON A RELEASE QFT 
*         ONLY REQUEST (((LA)-1) =1) ONLY IF CREATION MODE IS NOT SET 
*         IN THE QFT ENTRY. 
          SPACE  4,10 
***       USES. 
* 
*         USES   CM - CM+4, T1 - T7.
          SPACE  4,10 
*         COMMON DECK MACROS AND DEFINITIONS. 
  
  
*CALL     COMPMAC 
*CALL     COMPREL 
*CALL     COMSCPS 
*CALL     COMSSSE 
*CALL     COMSZOL 
          SPACE  4,10 
****      DIRECT LOCATION ASSIGNMENTS.
  
  
 FS       EQU    20 - 24     FST INFORMATION (5 LOCATIONS)
 QA       EQU    26          QFT ORDINAL
  
****
          TITLE  MAIN ROUTINE.
**        DQF - MAIN ROUTINE. 
  
  
          ORG    5
 DQF      SUBR               ENTRY/EXIT 
          UJN    DQF2        CHECK CALL PARAMETERS
  
 DQF1     RJM.   EXR         CALL *0QM* TO ISSUE ACCOUNTING MESSAGE 
          LDN    0           SET OPERATION COMPLETE 
          UJN    DQFX        RETURN 
  
          VFD    24/0LAEQP   *AEQP* MESSAGE IDENTIFIER
 OVLA     EQU    *           *0QM* LOAD ADDRESS 
  
 DQF2     LDD    FS+1 
          STD    T6          SET FIRST TRACK
          ADD    QA 
          ZJN    DQFX        IF FILE UNUSED/NULL REQUEST
          LDD    FS 
          STD    T5          SET EST ORDINAL
          LDM    -1 
          STI    LA          PRESERVE DEQUEUE OPTION
          SBN    2
          ZJN    DQF3        IF FILE NOT IN QFT 
          RJM    IFP         INITIALIZE QFT PROCESSOR 
          RJM    SGQ         SEARCH GLOBAL QUEUE
          ZJN    DQFX        IF FILE NOT FOUND
          LDD    T4 
          LPN    4
 DQF3     NJN    DQF4        IF CREATION MODE 
          RJM    RSS         READ QUEUE FILE SYSTEM SECTOR
          MJN    DQF6        IF RECOVERABLE MASS STORAGE ERROR
          NJN    DQF4        IF ERROR IN SYSTEM SECTOR
          LDI    LA 
          SBN    1
          ZJN    DQF4        IF NOT TO DROP DISK SPACE
          RJM    DDS         DROP DISK SPACE
          MJN    DQF6        IF DEVICE INACCESSIBLE 
 DQF4     LDI    LA 
          SBN    2
          ZJN    DQF5        IF FILE NOT IN QFT 
          LDD    QA 
          STD    CM+1 
          LDN    PQFT 
          STD    CM+2 
          MONITOR  MTRM      RELEASE QFT ENTRY
 DQF5     LDM    FIQF 
          ZJN    DQF8        IF FILE NOT QUEUED 
          LDN    OVLA        SET *0QM* LOAD ADDRESS 
          RAD    LA 
          EXECUTE  0QM,*
          LJM    DQF1-OVLA   CALL *0QM* TO ISSUE ACCOUNTING MESSAGE 
  
 DQF6     LDM    QFIF 
          ZJN    DQF7        IF QFT INTERLOCK NOT SET BY *0DQ*
          LDN    CFIN        SET CLEAR INTERLOCK FUNCTION 
          RJM    IQF         CLEAR QFT INTERLOCK
 DQF7     LCN    0           SET DEVICE INACCESSIBLE
 DQF8     LJM    DQFX        RETURN 
  
  
 FIQF     CON    0           FILE QUEUED FLAG 
 QFIF     CON    0           QFT INTERLOCK SET BY *0DQ* FLAG
          TITLE  SUBROUTINES. 
 DDS      SPACE  4,15 
**        DDS - DROP QUEUE FILE DISK SPACE. 
* 
*         ENTRY  (FIQF) .NE. 0 IF FILE QUEUED.
* 
*         EXIT   (A) .GE. 0 IF DISK SPACE DROPPED.
*                (A) .LT. 0 IF DEVICE INACCESSIBLE. 
*                MASS STORAGE SECTOR LIMIT INCREMENTED IF FILE NOT
*                  QUEUED.
* 
*         USES   (CM - CM+2). 
* 
*         MACROS MONITOR. 
  
  
 DDS      SUBR               ENTRY/EXIT 
          LDD    T6 
          STD    CM+2 
          LDD    T5          RELEASE TRACK CHAIN
          LMC    5000        CHECKPOINT / RETURN ON INACCESSIBLE DEVICE 
          STD    CM+1 
          MONITOR  DTKM 
          LDD    CM+1 
          SHN    21-11
          MJN    DDSX        IF DEVICE INACCESSIBLE 
          LDM    FIQF 
          NJN    DDSX        IF FILE QUEUED 
  
*         ACTUAL COUNT OF SECTORS RETURNED VIA *DTKM* IS IN CM+3 - CM+4.
  
          LDN    CICS        INCREMENT CP AREA FIELD FUNCTION CODE
          STD    CM 
          LDK    ACLW        ADDRESS OF MASS STORAGE SECTOR LIMIT 
          STD    CM+1 
          LDN    0D*100+18D  POSISTION AND WIDTH OF LIMIT FIELD 
          STD    CM+2 
          LDD    MA          UADM FUNCTION MESSAGE BUFFER CONTENTS
          CWD    CM 
          LDN    1           SET UADM REQUEST COUNT AND NO DROP OF PPU
          STD    CM+1 
          STD    CM+2 
          MONITOR UADM       INCREMENT MASS STORAGE SECTOR LIMIT
*         LDN    0
          LJM    DDSX        RETURN 
 IQF      SPACE  4,15 
**        IQF - SET OR CLEAR QFT INTERLOCK. 
* 
*         ENTRY  (A) = FUNCTION CODE FOR *SFI*. 
*                (QA) = QFT ORDINAL.
* 
*         EXIT   (A) = 0 IF OPERATION COMPLETE. 
*                (A) .NE. 0 IF ERROR (OPERATOR OVERRIDE). 
* 
*         USES   T1.
* 
*         CALLS  SFI. 
* 
*         MACROS SFA. 
  
  
 IQF      SUBR               ENTRY/EXIT 
          STD    T1          SET FUNCTION CODE
          SFA    QFT,QA      SET QFT ADDRESS
          RJM    SFI         INTERLOCK QFT ENTRY
          UJN    IQFX        RETURN 
 RSS      SPACE  4,20 
**        RSS - READ QUEUE FILE SYSTEM SECTOR.
* 
*         ENTRY  (A) = 0. 
*                (T5) = EST ORDINAL OF QUEUE FILE.
*                (T6) = FIRST TRACK OF QUEUE FILE.
* 
*         EXIT   (A) = 0 IF NO ERROR. 
*                (A) .LT. 0 IF RECOVERABLE MASS STORAGE ERROR.
*                (A) .GT. 0 IF UNRECOVERABLE MASS STORAGE ERROR OR
*                  ERROR IN SYSTEM SECTOR.
*                (FIQF) .NE. 0 IF FILE QUEUED.
*                (FIQF) = 0 IF FILE NOT QUEUED. 
* 
*         USES   T7.
* 
*         CALLS  RDS. 
* 
*         MACROS ENDMS, SETMS.
  
  
 RSS3     LMC    2000 
          SHN    21-12       (A) .LT. 0 IF ERROR RECOVERABLE
  
 RSS      SUBR               ENTRY/EXIT 
          STD    T7          SET SYSTEM SECTOR READ 
          SETMS  IO 
          LDC    BFMS        READ SYSTEM SECTOR 
          RJP    RDS
          MJN    RSS3        IF READ ERROR
          ENDMS 
          LDP    BFMS+1 
          LMN    77 
          NJN    RSSX        IF NOT SYSTEM SECTOR LINKAGE 
          LDP    BFMS 
          LMC    3777 
          NJN    RSSX        IF NOT SYSTEM SECTOR LINKAGE 
          LDP    FTSS 
          LMD    T6 
 RSS1     NJN    RSSX        IF INCORRECT SYSTEM SECTOR 
          LDP    FNSS+4      CHECK FILE TYPE
          SHN    -6 
          LMN    QFFT 
          ZJN    RSS2        IF QUEUE FILE
          LMN    INFT&QFFT
          NJN    RSS1        IF NOT QUEUE FILE
 RSS2     LDP    FGSS        SET FILE QUEUED STATUS 
          LPN    1
          STM    FIQF 
          LDN    0           SET NO ERROR 
          LJM    RSSX        RETURN WITH ERROR STATUS 
 SGQ      SPACE  4,25 
**        SGQ - SEARCH GLOBAL QUEUE.
* 
*         ENTRY  (QA) = 0 IF QFT SEARCH REQUIRED. 
*                     = QFT ORDINAL IF SPECIFIED. 
*                (FS - FS+4) = FST INFORMATION. 
*                QFT INTERLOCKED IF (QA) .NE. 0.
* 
*         EXIT   (A) = 0, IF QFT ENTRY NOT FOUND OR ERROR IN
*                      INTERLOCKING QFT ENTRY (OPERATOR OVERRIDE).
*                (QA) = QFT ORDINAL, IF ENTRY FOUND.
*                (T4) = CREATION MODE FLAG. 
*                (T5) = EST ORDINAL.
*                (T6) = FIRST TRACK.
*                (QFIF) .NE. 0 IF QFT ENTRY INTERLOCKED BY *0DQ*. 
* 
*         USES   QA, CM - CM+4, T0 - T7.
* 
*         CALLS  IQF. 
* 
*         MACROS ISTORE, SFA. 
  
  
 SGQ1     LDN    QFTP        READ QFT POINTERS
          CRD    CM 
 SGQ2     AOD    QA          ADVANCE ORDINAL
          LMD    CM+2 
          ZJN    SGQX        IF END OF QFT
 SGQ3     SFA    QFT,QA      SET QFT ADDRESS
          ADK    JSNQ        READ CREATION MODE FLAG
          CRD    T0 
          ADN    ENTQ-JSNQ   READ MASS STORAGE PARAMETERS 
          CRD    T5 
 SGQA     LDD    T6          COMPARE FIRST TRACK
*         UJN    SGQX        (QFT ORDINAL SPECIFIED)
          LMD    FS+1 
          NJN    SGQ2        IF NO MATCH
          LDD    T5 
          LMD    FS 
          NJN    SGQ2        IF NOT SAME EQUIPMENT
          LDN    SFIN        SET INTERLOCK FUNCTION 
          RJM    IQF         INTERLOCK QFT ENTRY
          ZJN    SGQ4        IF ENTRY INTERLOCKED 
          LDN    1
 SGQ4     LMN    1
          STM    QFIF        SET INTERLOCK FLAG 
  
 SGQ      SUBR               ENTRY/EXIT 
          LDD    QA 
          ZJN    SGQ1        IF QFT ORDINAL NOT SPECIFIED 
          ISTORE SGQA,(UJN SGQX)  BYPASS QFT SEARCH 
          UJN    SGQ3        FETCH MASS STORAGE PARAMETERS
          SPACE  4,10 
**        COMMON DECKS. 
  
  
 QFT$     EQU    1           ASSEMBLE QFT PROCESSOR 
 IFP$     EQU    1           ASSEMBLE REMOTE INITIALIZATION CODE
*CALL     COMPGFP 
*CALL     COMPSFI 
  
  
 IFP      HERE               *COMPGFP* INITIALIZATION 
  
  
          RSTR
          SPACE  4,10 
          ERRNG  ZDQL-OVLA-ZQML  *0QM* OVERFLOWS *0DQ*
  
          OVERFLOW  5,ZDQL
          SPACE  4,10 
          END 
