Retro1.org codex

          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