COMCQFP 
COMMON
          CTEXT  COMCQFP - QUEUE FILE PROCESSORS. 
          SPACE  4,10 
          IF     -DEF,QUAL$ 
          QUAL   COMCQFP
          ENDIF 
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 QFP      SPACE  4,10 
***       QFP - QUEUE FILE PROCESSORS.
* 
*         G. A. KERSTEN      81/10/08.
          SPACE  4,10 
***       *COMCQFP* CONTAINS ROUTINES USED BY THE QUEUE PROCESSING
*         UTILITIES.
          SPACE  4,10 
***       ENTRY CONDITIONS. 
* 
*         THE FOLLOWING ADDRESSES ARE REQUIRED BY CERTAIN ROUTINES
*         IN THIS COMMON DECK - 
* 
*         BLOCK - *DSP* PARAMETER BLOCK.
*         BUFFL - DEFAULT END OF PROGRAM BUFFERS LENGTH.
*         IQFE - TEMPORARY IQFT ENTRY BLOCK.
*         JACA - VALID JOB ACCESS LEVELS. 
*         QFTA - QFT POINTER ADDRESS. 
*         RBUF - BUFFER TO READ FNT OR QFT INTO.
*         TACF - BUFFER FOR TABLE OF ACTIVE FAMILIES. 
*         TARA - PROCESSED ARGUMENTS TABLE ADDRESS. 
*         TDAA - TABLE OF DEVICE ACCESS LEVELS. 
*         TEQA - FWA OF MASS STORAGE EQUIPMENT TABLE. 
          SPACE  4,10 
*         COMMON DATA.
  
 CEQP     CON    0           CURRENT EST ORDINAL
 FNTA     CON    -0          FNT POINTER ADDRESS
 FNTS     CON    0           FNT LENGTH 
 NAQS     CON    0           NUMBER OF AVAILABLE QFT SLOTS
 QFTS     CON    0           QFT LENGTH 
 QFTT     CON    0           QFT THRESHOLD
 RSBS     CON    0           *RSB* STATUS WORD
          SPACE  4,10 
*         *RSB* CONTROL WORDS.
  
 FPTR     VFD    12/0,12/1,18/FNTP,18/FNTA  FNT POINTER WORD
 QPTR     VFD    12/0,12/1,18/QFTP,18/QFTA  QFT POINTER WORD
 CAS      SPACE  4,10 
**        CAS - CALCULATE NUMBER OF AVAILABLE QFT SLOTS.
* 
*         ENTRY  (QFTT) = CALCULATED QFT THRESHOLD. 
* 
*         EXIT   (NAQS) = NUMBER OF QFT SLOTS AVAILABLE FOR REQUEUING.
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 2, 6, 7.
* 
*         MACROS SYSTEM.
* 
*         XREF   COMSQFS. 
  
  
 CAS      SUBR               ENTRY/EXIT 
          MX6    1           SET ABSOLUTE MEMORY
          SA6    QFTA 
          SYSTEM RSB,R,QPTR 
          SA1    QFTA        GET NUMBER OF AVAILABLE ENTRIES
          MX0    -12
          LX1    -12
          SA2    QFTT        CALCULATED QFT THRESHOLD 
          BX7    -X0*X1 
          IX7    X7-X2       NUMBER AVAILABLE - NUMBER RESERVED 
          SA7    NAQS 
          EQ     CASX        RETURN 
 CBL      SPACE  4,10 
**        CBL - CLEAR *DSP* CALL BLOCK. 
* 
*         CLEAR THE PARAMETER BLOCK USED TO CALL *DSP*. 
* 
*         USES   X - 7. 
*                A - 7. 
*                B - 2. 
  
  
 CBL      SUBR               ENTRY/EXIT 
          BX7    X7-X7       CLEAR BLOCK
          SB2    EPBL-1 
 CBL1     SA7    BLOCK+B2 
          SB2    B2-1 
          PL     B2,CBL1     IF NOT END OF BLOCK
          EQ     CBLX        RETURN 
 CER      SPACE  4,20 
**        CER - CHECK FOR *CIO*, *LFM*, OR *QFM* ERROR. 
* 
*         CHECK THE GIVEN FET FOR AN ERROR CODE AND IF FOUND, 
*         CLEAR THE ERROR AND RETURN THE CODE.
* 
*         ENTRY  (A0) = FET ADDRESS.
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = ERROR CODE OTHERWISE. 
*                (A0) = FET ADDRESS.
* 
*         USES   X - 2, 4, 5, 6.
*                A - 2, 6.
  
  
 CER      SUBR               ENTRY/EXIT 
          SA2    A0          CHECK FOR ERROR
          SX4    17BS10 
          BX5    X4*X2
          ZR     X5,CERX     IF NO ERROR
          LX5    -10
          BX6    -X4*X2      CLEAR ERROR CODE 
          SA6    A0 
          EQ     CERX        RETURN 
 CTF      SPACE  4,10 
**        CTF - CREATE TABLE OF ACTIVE FAMILIES.
* 
*         EXIT   (TACF) = LIST OF ACTIVE FAMILIES.
* 
*         USES   X - 0, 2, 3, 4, 6, 7.
*                A - 2, 3, 6. 
*                B - 2, 3, 4, 5.
* 
*         CALLS  RFT. 
* 
*         XREF   COMSACC, COMSQFS.
  
  
 CTF      SUBR               ENTRY/EXIT 
  
*         READ SYSTEM FNT.
  
 CTF1     RJ     RFT         READ SYSTEM FNT
          SB3    FNTE        BUFFER INDEX 
          SB5    TACF        INITIALIZE ACTIVE FAMILY LIST
          SB2    X2          LENGTH OF FNT
 CTF2     SA3    B3+RBUF
          MX0    -12         CLEAR LINKAGE FIELD
          BX6    X0*X3
          ZR     X6,CTF3     IF UNUSED SLOT 
          MX2    -6 
          AX3    6
          BX4    -X2*X3      FILE TYPE
          SB4    X4-FAFT     CHECK FOR FAST ATTACH
          LX3    6
          NZ     B4,CTF3     IF NOT FAST ATTACH FILE
          SA2    CTFA 
          MX7    42 
          BX3    X3-X2       CHECK FOR *VALIDUS*
          SA2    A3+B1       GET *FST* ENTRY
          BX3    X7*X3
          NZ     X3,CTF3     IF NOT *VALIDUS* 
          LX2    12          CREATE *TACF* ENTRY
          BX2    -X0*X2      EST ORDINAL
          SA3    TEQA+X2     GET FAMILY NAME
          BX6    X3 
          SA6    B5 
          SB5    B5+1 
 CTF3     SB3    B3+FNTE
          LT     B3,B2,CTF2  IF NOT END OF FNT
          BX6    X6-X6       SET END OF FAMILY LIST 
          SA6    B5 
          EQ     CTFX        RETURN 
  
  
 CTFA     DATA   C*"APFN"*
 DAL      SPACE  4,15 
**        DAL - DETERMINE VALID ACCESS LEVEL. 
* 
*         ENTRY  (X3) = *TDAA* ENTRY FOR SELECTED DEVICE. 
* 
*         EXIT   (X3) = ACCESS LEVEL VALID FOR DEVICE AND JOB.
*                (X3) .LT. 0, IF NO VALID ACCESS LEVEL FOUND. 
* 
*         USES   X - 0, 1, 2, 3, 4. 
*                A - 1, 4.
*                B - 3. 
  
  
 DAL3     SX3    -1          SET ERROR EXIT 
  
 DAL      SUBR               ENTRY/EXIT 
          SA4    SECA 
          LX4    12 
          MX0    -3 
          BX4    -X0*X4 
          NZ     X4,DAL1     IF SECURE SYSTEM 
          BX3    X3-X3       USE ZERO FOR ACCESS LEVEL
          EQ     DALX        RETURN 
  
 DAL1     BX4    X3          GET LOWER LIMIT
          AX4    3
          BX3    -X0*X3      GET UPPER LIMIT
          SA1    JACA        GET JOB ACCESS LEVELS
          SX2    59          CALCULATE SHIFT COUNT
          IX2    X2-X3
          SB3    X2 
 DAL2     LX1    B3          GET ACCESS LEVEL BIT 
          NG     X1,DALX     IF ACCESS LEVEL FOUND
          IX2    X3-X4
          ZR     X2,DAL3     IF END OF ACCESS LEVELS
          SX3    X3-1 
          SB3    B1          RESET SHIFT COUNT
          EQ     DAL2        CHECK NEXT ACCESS LEVEL
 DND      SPACE  4,20 
**        DND - DETERMINE NEXT DEVICE.
* 
*         RETURN THE NEXT DEVICE TO PROCESS GIVEN THE RESTRAINTS
*         OF THE PARAMETER BLOCK PASSED BY *QFSP*.
* 
*         ENTRY  (CEQP) = LAST EST ORDINAL PROCESSED. 
* 
*         EXIT   (X4) = EQUIPMENT TABLE ENTRY IF NOT END OF TABLE.
*                     = 0 IF END OF TABLE.
*                (X6) = EST ORDINAL.
*                (CEQP) = EST ORDINAL.
* 
*         USES   X - 0, 1, 2, 3, 4, 6.
*                A - 1, 2, 4, 6.
* 
*         XREF   COMSQFS. 
  
  
 DND3     BX4    X4-X4       SET END OF TABLE 
  
 DND      SUBR               ENTRY/EXIT 
          SA2    TARA+ARDN
          NZ     X2,DND2     IF DEVICE NUMBER SPECIFIED 
  
*         RETRIEVE NEXT SEQUENTIAL DEVICE.
  
 DND1     SA1    CEQP        INCREMENT INDEX
          SX6    X1+B1
          SA6    A1 
          SA4    X6+TEQA
          ZR     X4,DNDX     IF END OF TABLE
          SX3    X4+1 
          ZR     X3,DND1     IF NOT MASS STORAGE
          SA2    TARA+ARFM
          ZR     X2,DNDX     IF FAMILY NOT SPECIFIED
  
*         RETRIEVE DEVICE FROM SPECIFIC FAMILY. 
  
          MX0    42 
          BX3    X0*X2
          BX1    X0*X4
          BX2    X3-X1
          NZ     X2,DND1     IF NOT THIS FAMILY 
          EQ     DNDX        RETURN 
  
*         RETRIEVE SPECIFIC DEVICE. 
  
 DND2     SX6    X2          EST ORDINAL
          SA4    X6+TEQA
          SX3    X4+B1
          ZR     X3,DND3     IF NOT MASS STORAGE
          SA2    CEQP 
          IX3    X2-X6
          ZR     X3,DND3     IF DEVICE PROCESSED
          SA6    A2 
          EQ     DNDX        RETURN 
 PLE      SPACE  4,20 
**        PLE - PROCESS LENGTH ERROR. 
* 
*         *PLE* IDENTIFIES A QUEUED FILE THAT HAS BEEN NOTED
*         AS HAVING A LENGTH ERROR.  THAT IS THE *TRT* EOI IS 
*         NOT A VALID EOI.  A MESSAGE IS ISSUED IDENTIFYING 
*         THIS FILE.
* 
*         ENTRY  (IQFE - IQFE+15) = IQFT ENTRY FOR FILE IN ERROR. 
*                (CEQP) = EST ORDINAL.
* 
*         EXIT   MESSAGE IDENTIFYING FILE ISSUED. 
* 
*         USES   X - 0, 1, 2, 4, 6. 
*                A - 1, 2, 6. 
* 
*         CALLS  COD, SFN.
* 
*         MACROS MESSAGE. 
* 
*         XREF   COMCCOD, COMCSFN.
  
  
 PLE      SUBR               ENTRY/EXIT 
  
*         PROCESS JSN.
  
          SA1    IQFE 
          MX0    24 
          BX1    X0*X1
          RJ     SFN         SPACE FILL JSN 
          SA2    PLEA 
          LX0    -6 
          BX2    -X0*X2      CLEAR OLD JSN
          LX6    -6 
          BX6    X0*X6
          IX6    X2+X6       ADD JSN
          SA6    A2 
  
*         PROCESS EST ORDINAL.
  
          SA1    CEQP        EST ORDINAL
          SX1    X1+10000B   FORCE ZERO FILL
          RJ     COD
          MX0    24 
          SA2    PLEA+1 
          LX6    36 
          BX2    -X0*X2      CLEAR PREVIOUS EST ORDINAL 
          BX6    X0*X6       CLEAR SPACES 
          IX6    X6+X2
          SA6    A2 
  
*         PROCESS TRACK NUMBER. 
  
          MX0    -12         GET TRACK NUMBER 
          SA1    IQFE+1 
          LX1    24 
          BX1    -X0*X1 
          RJ     COD
          MX0    24 
          LX6    30 
          SA2    PLEA+2 
          LX0    -6 
          BX6    X0*X6       CLEAR SPACES 
          BX2    -X0*X2      CLEAR OLD TRACK
          BX6    X6+X2
          SA6    A2 
  
*         ISSUE MESSAGE.
  
          MESSAGE PLEA
          EQ     PLEX        RETURN 
  
  
 PLEA     DATA   C* JSN    EQNNNN TRACK TTTT LENGTH ERROR. *
 RFT      SPACE  4,15 
**        RFT - READ FNT TABLE. 
* 
*         *RFT* READS THE FNT INTO THE FIELD LENGTH STARTING
*         AT *RBUF*, INCREASING THE FIELD LENGTH IF NECESSARY.
* 
*         ENTRY  (RFTA) = *RSB* STATUS WORD, IF ALREADY FORMATTED.
* 
*         EXIT   FNT READ INTO FIELD LENGTH STARTING AT *RBUF* AND
*                OVERLAYING FOLLOWING BUFFERS.
*                (X2) = *FNTS*, LENGTH OF FNT.
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 2, 4, 5, 6, 7. 
*                B - 2. 
* 
*         MACROS MEMORY, SYSTEM.
  
  
 RFT      SUBR               ENTRY/EXIT 
          SA4    FNTS 
          SA5    RFTA 
          BX7    X4 
          AX7    6
          NZ     X5,RFT0     IF *RSB* STATUS WORD IS ALREADY FORMATTED
          SYSTEM RSB,R,FPTR  READ FNT POINTER WORD
  
*         FORMAT *RSB* CALL TO READ FNT.
  
          SA2    FNTA 
          MX7    -24
          LX2    24 
          BX6    -X7*X2      FWA OF FNT 
          SX1    B1 
          LX1    6+18 
          BX6    X1+X6
          SX4    RBUF 
          LX6    18 
          IX6    X6+X4
          SA6    A5 
          LX2    12          GET FNT LENGTH 
          MX7    -12
          BX2    -X7*X2 
 .A       IFEQ   FNTE,2 
          LX7    X2,B1       NUMBER OF ENTRIES * 2
 .A       ELSE
          SX3    FNTE 
          IX7    X2*X3       NUMBER OF ENTRIES * ENTRY LENGTH 
 .A       ENDIF 
          SA7    A4 
          BX5    X6          SAVE *RSB* STATUS WORD 
  
*         DETERMINE IF BUFFER LARGE ENOUGH FOR FNT. 
  
          AX7    6           ROUND UP TO MULTIPLE OF 100B 
 RFT0     SX7    X7+B1
          LX7    6
          SX2    X7-BUFFL+RBUF  BUFFER SPACE AFTER *RBUF* 
          NG     X2,RFT1     IF ROOM IN BUFFERS 
          SX3    X2+BUFFL 
          MEMORY CM,,R,X3 
  
 RFT1     SA4    FNTS        FNT LENGTH 
          SX3    100B 
  
*         READ FNT INTO *RBUF*. 
  
 RFT2     BX6    X5          *RSB* STATUS WORD
          MX7    1
          SA6    RSBS 
          SA7    X5          SET ABSOLUTE MEMORY
  
          SYSTEM RSB,R,RSBS  READ FNT 
  
          IX5    X5+X3       INCREMENT ADDRESS TO READ TO 
          LX3    18 
          IX5    X3+X5       INCREMENT CM ADDRESS TO READ FROM
          LX3    42 
          IX4    X4-X3
          SB2    X4 
          GT     B2,RFT2     IF NOT ALL OF FNT
          SA2    FNTS        FNT LENGTH 
          EQ     RFTX        RETURN 
  
 RFTA     CON    0           *RSB* STATUS WORD
 RQT      SPACE  4,15 
**        RQT - READ QFT. 
* 
*         *RQT* READS THE QFT INTO THE FIELD LENGTH STARTING
*         AT *RBUF*, INCREASING THE FIELD LENGTH IF NECESSARY.
* 
*         ENTRY  (RQTA) = *RSB* STATUS WORD FOR QFT READ. 
*                (QFTS) = QFT LENGTH. 
* 
*         EXIT   QFT READ INTO FIELD LENGTH STARTING AT *RBUF* AND
*                OVERLAYING FOLLOWING BUFFERS.
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 4, 5, 6, 7. 
*                B - 2. 
* 
*         MACROS MEMORY, SYSTEM.
  
  
 RQT      SUBR               ENTRY/EXIT 
  
*         DETERMINE IF BUFFER LARGE ENOUGH FOR QFT. 
  
          SA1    QFTS 
          AX1    6           ROUND UP TO MULTIPLE OF 100B 
          SX1    X1+B1
          LX1    6
          SX2    X1-BUFFL+RBUF  BUFFER SPACE AFTER *RBUF* 
          NG     X2,RQT1     IF ROOM IN BUFFERS 
          SX3    X2+BUFFL 
          MEMORY CM,,R,X3 
  
 RQT1     SA4    QFTS        DECREMENT QFT WORD COUNT 
          SX3    100B 
          SA5    RQTA        *RSB* STATUS WORD
  
*         READ QFT INTO *RBUF*. 
  
 RQT2     BX6    X5 
          MX7    1           SET ABSOLUTE MEMORY
          SA6    RSBS 
          SA7    X5 
  
          SYSTEM RSB,R,RSBS  READ QFT 
  
          IX5    X5+X3       INCREMENT ADDRESS TO READ TO 
          LX3    18 
          IX5    X3+X5       INCREMENT CM ADDRESS TO READ FROM
          LX3    42 
          IX4    X4-X3
          SB2    X4 
          GT     B2,RQT2     IF NOT ALL OF QFT
          EQ     RQTX        RETURN 
  
 RQTA     CON    0           *RSB* STATUS WORD
 SPF      SPACE  4,20 
**        SPF - SET *QFM* PARAMETERS IN FET.
* 
*         ENTRY  (A1) = ADDRESS OF FET. 
* 
*         EXIT   *QFM* PARAMETERS ARE SET IN THE FET. 
*                VALUES SET TO ZERO IF *U* PROCESSING OPTION SELECTED.
* 
*T FET+5  42/ FAMILY FOR USER INDEX,18/ USER INDEX LB 
*T,FET+6  18/ DATE LB,6/ 0,18/ DATE UB,18/ USER INDEX UB
*T,FET+8  12/ MACHINE ID,24/ FILE SIZE LB,24/ FILE SIZE UB
* 
*         LB = LOWER BOUND. 
*         UB = UPPER BOUND. 
* 
*         USES   X - 2, 3, 4, 6, 7. 
*                A - 2, 3, 4, 6, 7. 
  
  
 SPF1     SA7    A1+5        CLEAR FET FIELDS 
          SA7    A1+6 
          SA7    A1+8 
  
 SPF      SUBR               ENTRY/EXIT 
          SA2    TARA+ARFC
          BX7    X7-X7
          LX2    59-52
          NG     X2,SPF1     IF UNCONDITIONAL PROCESSING
          SA3    TARA+ARFU   FAMILY 
          SA2    TARA+ARUI   USER INDEX LOWER BOUND 
          BX6    X3+X2
          SA4    TARA+ARDA   DATE LOWER LIMIT 
          LX4    42 
          SA3    TARA+ARU1   USER INDEX UPPER BOUND 
          SA2    TARA+ARD1   DATE UPPER LIMIT 
          SA6    A1+5 
          LX2    18 
          BX6    X4+X2
          BX7    X6+X3
          SA7    A6+B1
          SA3    TARA+ARFS   FILE SIZE LOWER LIMIT
          SA4    TARA+ARF1   FILE SIZE UPPER LIMIT
          LX3    24 
          BX6    X3+X4
          SA2    TARA+ARMI   MACHINE ID 
          BX6    X2+X6
          SA6    A1+8 
          EQ     SPFX        RETURN 
  
  
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 CAS      EQU    /COMCQFP/CAS 
 CBL      EQU    /COMCQFP/CBL 
 CEQP     EQU    /COMCQFP/CEQP
 CER      EQU    /COMCQFP/CER 
 CTF      EQU    /COMCQFP/CTF 
 DAL      EQU    /COMCQFP/DAL 
 DND      EQU    /COMCQFP/DND 
 NAQS     EQU    /COMCQFP/NAQS
 PLE      EQU    /COMCQFP/PLE 
 QFTS     EQU    /COMCQFP/QFTS
 QFTT     EQU    /COMCQFP/QFTT
 RQT      EQU    /COMCQFP/RQT 
 RQTA     EQU    /COMCQFP/RQTA
 SPF      EQU    /COMCQFP/SPF 
 QUAL$    ENDIF 
 QFP      ENDX
