QAP 
          IDENT  QAP,BCA     QAP - QUEUE AUXILIARY PROCESSOR
          PERIPH
          BASE   MIXED
          SST 
 QUAL$    SET    0           FORCE UNQUALIFIED COMMON DECKS 
*COMMENT  QAP - QUEUE AUXILIARY PROCESSOR.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  QAP - QUEUE AUXILIARY PROCESSOR. 
          SPACE  4
***       QAP - QUEUE AUXILIARY PROCESSOR.
* 
*         G. R. MANSFIELD.   70/09/11.
*         P. D. HAAS.        74/04/19.
*         R. M. YASUHARA.    75/01/17.
*         R. A. JAPS.        77/09/25.  (RENAMED) 
          SPACE  4
***              *QAP* IS CALLED BY SUBSYSTEMS SUCH AS *BATCHIO* OR 
*         *RBF* TO PROCESS SPECIAL REQUESTS THAT ARE IMPOSSIBLE OR
*         INCONVENIENT TO BE PERFORMED BY THE SUBSYSTEM.
          SPACE  4,10 
***       QAP CALL. 
* 
*T IR     18/ QAP , 6/ , 12/ SF , 6/ , 18/ FET
*         SF     *BATCHIO* DRIVER STATUS BLOCK FLAGS. 
*         FET    FWA OF FET.
* 
* 
*         FORMAT OF *QAP* FET. (REFER TO *COMSBIO* FOR FET FORMAT 
*         FOR *BATCHIO*.) 
* 
*T FET+0  42/ FILE NAME , 8/  , 9/ FC , 1/C 
*T,FET+1  42/ 0 , 18/ FIRST 
*T,FET+2  42/ 0 , 18/ IN
*T,FET+3  42/ 0 , 18/ OUT 
*T,FET+4  12/ FNT ,12/ ORD ,12/ SC ,6/ 0 ,18/ LIMIT 
*T,FET+5  12/ CONTROL, 1/ B, 1/ V, 1/ F, 1/ L, 8/ PS, 24/ 0, 12/ ORIGIN 
* 
*         FC     FUNCTION CODE. (REFER TO *COMSBIO*). 
*         C      COMPLETE BIT.
*         FNT    FNT ADDRESS OF FILE. 
*         ORD    QFT ORDINAL. 
*         SC     SPACE CODE (PFC PRINTERS). 
*         CONTROL  BANNER PAGE CONTROL INFORMATION. CALLING PROGRAM 
*                SHOULD SET THIS FIELD TO ZERO ON THE INITIAL CALL
*                TO THE GENERATE BANNER PAGE FUNCTION. *QAP* RETURNS
*                BANNER PAGE INFORMATION TO BE USED ON FUTURE 
*                GENERATE BANNER PAGE CALLS.
*         B      SET IF NO BOTTOM OF FORM POSITIONING (NON-*BATCHIO*) 
*         V      ELECTRONIC VERTICAL FORMAT UNIT FLAG.  SET IF PRINTER
*                FOR WHICH THE CALL WAS MADE IS EQUIPPED WITH THE 
*                ELECTRONIC VERTICAL FORMAT UNIT (NON-*BATCHIO*)
*         F      NOT FIRST PAGE FLAG.  SET IF THIS CALL IS FOR A SECOND 
*                OR SUBSEQUENT BANNER PAGE (NON-*BATCHIO*)
*         L      NOT LAST PAGE FLAG.  SET IF THERE WILL BE A SUBSEQUENT 
*                CALL FOR ANOTHER BANNER PAGE (NON-*BATCHIO*) 
*         PS     PRINT PAGE SIZE (*NON-BATCHIO*)
*         ORIGIN ORIGIN TYPE ASSOCIATED WITH SPECIFIED FILE.
*                0 = SYSTEM.
*                1 = BATCH. 
*                2 = REMOTE.
          SPACE  4
***       DAYFILE MESSAGES. 
* 
*         *QAP - BUFFER ARGUMENT ERROR.*
*         CAN INDICATE ONE OF THE FOLLOWING CONDITIONS. 
*         1. BUFFER DOES NOT CONTAIN THE REQUIRED NUMBER OF WORDS OF
*         DATA FOR THE PARTICULAR FUNCTION. 
*         2. BUFFER POINTERS (FIRST, IN, OUT, LIMIT) ARE OUT OF RANGE.
* 
*         * QAP - INCORRECT REQUEST.* 
*         CAN INDICATE ONE OF THE FOLLOWING CONDITIONS. 
*         1. USER IS NOT VALIDATED TO CALL *QAP*. 
*         2. FWA OR LWA OF FET IS OUT OF RANGE. 
*         3. THE FUNCTION CODE IS INCORRECT.
*         4. AN FNT ADDRESS WAS NOT SPECIFIED WHEN IT WAS REQUIRED. 
*         5. COMPLETE BIT WAS SET IN THE FET. 
 BIO      SPACE  4,10 
***       MESSAGES ISSUED AT *BIO* CONTROL POINT. 
* 
*         *END XXX,YY.* = OPERATOR ENTERED *END* COMMAND. 
* 
*         *REP XXX,YY.* = OPERATOR ENTERED *REPEAT* COMMAND.
* 
*         *SUP XXX,YY.* = OPERATOR ENTERED *SUPPRESS* COMMAND.
* 
*         *RRN XXX,YY.* = OPERATOR ENTERED *REPRINT*/*REPUNCH* COMMAND. 
* 
*         *HLD XXX.* = OPERATOR ENTERED *STOP* COMMAND. 
* 
*         *CON XXX.* = OPERATOR ENTERED *CONTINUE* COMMAND. 
* 
*         *BKP XXX,YY.* = OPERATOR ENTERED *BKSP* COMMAND.
* 
*         *BKR XXX,YY.* = OPERATOR ENTERED *BKSPRU* COMMAND.
* 
*         *BKF XXX,YY.* = OPERATOR ENTERED *BKSPF* COMMAND. 
* 
*         *SKP XXX,YY.* = OPERATOR ENTERED *SKIP* COMMAND.
* 
*         *SKR XXX,YY.* = OPERATOR ENTERED *SKIPRU* COMMAND.
* 
*         *SKF XXX,YY.* = OPERATOR ENTERED *SKIPF* COMMAND. 
* 
*         WHERE-
*         XXX = EST ORDINAL.
*         YY = OPTIONAL COUNT SPECIFED ON COMMAND.
          SPACE  4,10 
***       OPERATOR MESSAGES.
* 
*         *INCOMPLETE BANNER PAGE.* 
*                AN INFORMATIVE MESSAGE INDICATING THAT *BIO* IS
*                UNABLE TO PRINT THE ENTIRE BANNER PAGE.  TO CORRECT
*                THIS PROBLEM, THE SIZE OF THE CM BUFFER RESERVED 
*                FOR PRINTERS MUST BE INCREASED OR THE AMOUNT OF DATA 
*                GENERATED BY THE *GENERATE BANNER PAGE* FUNCTION 
*                MUST BE REDUCED.  ENTER THE COMMAND *GO,BIO.* TO 
*                CLEAR THIS MESSAGE.
* 
*         *REQUEST *I* DISPLAY.*
*                *BIO* HAS DETECTED AN ABNORMAL CONDITION ON AN 
*                ASSIGNED UNIT RECORD DEVICE.  CHECK THE STATUS 
*                FIELD ON THE *I* DISPLAY FOR MORE SPECIFIC INFORMATION.
*                THE MESSAGE WILL REMAIN UNTIL THE CONDITION IS 
*                CORRECTED. 
* 
*         *TRACK LIMIT.*
*                INFORMATIVE MESSAGE INDICATING *BIO* IS UNABLE TO
*                ASSIGN MASS STORAGE SPACE TO AN INPUT FILE.  *BIO* 
*                WILL CONTINUE TO ATTEMPT TO ASSIGN SPACE UNTIL THE 
*                SPACE IS ACTUALLY ASSIGNED OR *BIO* IS DROPPED BY
*                THE OPERATOR.
          SPACE  4
          SPACE  4
***       ERRLOG MESSAGES.
* 
*         *EQXXX CHANNEL PARITY ERROR.* = A PARITY ERROR WAS DETECTED 
*                ON A CONVERTER OR EQUIPMENT. 
* 
*         *EQXXX COMPARE ERROR.* = COMPARE ERROR WAS DETECTED.
* 
*         *EQXXX CONTROLLER HUNG BUSY.* = THE CONTROLLER DOES NOT DROP
*                BUSY STATUS. 
* 
*         *EQXXX FEED FAILURE.* = CARD FEED PROBLEM WAS DETECTED. 
* 
*         *EQXXX FUNCTION TIMEOUT* = A FUNCTION TIMEOUT WAS DETECTED
*                ON A CONVERTER OR EQUIPMENT FUNCTION.
* 
*         *EQXXX INCOMPLETE DATA TRANSFER.* = AN INCOMPLETE DATA
*                TRANSFER WAS DETECTED. 
* 
*         *EQXXX INTERNAL/EXTERNAL REJECT.* = AN INTERNAL OR EXTERNAL 
*                REJECT WAS DETECTED. 
* 
*         *EQXXX NNNN PRINT ERRORS.* = PRINT ERRORS DETECTED. 
* 
*         *EQXXX PFC ERROR.* = ERROR LOADING PFC MEMORY.
* 
*         *EQXXX PRINT ERROR LIMIT EXCEEDED.* = PRINT ERROR LIMIT WAS 
*                EXCEEDED.
* 
*         *EQXXX TRANSMISSION PARITY ERROR.* = A TRANSMISSION PARITY
*                ERROR WAS DETECTED.
* 
*         *EQXXX TURNED OFF BY SYSTEM.* = FAULTY EQUIPMENT
*                WAS TURNED OFF BY THE SYSTEM.
* 
*         WHERE - 
*         EQ = EQUIPMENT MNEMONIC.
*         XXX = EST ORDINAL.
*         NNNN = NUMBER OF PRINT ERRORS.
          SPACE  4
**        ROUTINES USED.
* 
* 
*         0BF - BEGIN FILE. 
          SPACE  4
***       *1CD* - *QAP* INTERFACE.
* 
* 
*         *1CD* AND *QAP* COMMUNICATE PRIMARILY VIA BYTE 4 OF THE 
*         FIRST WORD OF THE FET.  WHEN *1CD* MAKES A REQUEST, 
*         THIS BYTE IS SET WITH THE REQUEST CODE AND BIT 0
*         IS CLEARED, INDICATING THAT THIS BUFFER 
*         IS BUSY.  UPON COMPLETION OF THE REQUESTED TASK,
*         *QAP* WILL SET BIT 0 OF THIS BYTE, INDICATING THE 
*         BUFFER IS NO LONGER BUSY. 
          SPACE  4
*CALL     COMPMAC 
*CALL     COMSACC 
          LIST   X
*CALL     COMSBIO 
          LIST   *
*CALL     COMSCIO 
*CALL     COMSCPS 
*CALL     COMSDFS 
*CALL     COMSDSP 
*CALL     COMSEVT 
*CALL     COMSJIO 
*CALL     COMSMSP 
*CALL     COMSPIM 
*CALL     COMSSSD 
*CALL     COMSSSE 
*CALL     COMSZOL 
          SPACE  4
****      DIRECT LOCATION ASSIGNMENTS.
  
  
 NI       EQU    17          MAXIMUM NUMBER USER SUPPLIED PFC IMAGES
 ES       EQU    20 - 24     EST BUFFER 
 FS       EQU    20 - 24     FST ENTRY
 EQ       EQU    25          EST ORDINAL
 FP       EQU    26 - 32     FILE PARAMETER AREA
 CN       EQU    33 - 37     CM WORD BUFFER (5 LOCATIONS) 
 F6       EQU    33 - 37     FILE PARAMETER WORD (5 LOCATIONS)
 CS       EQU    F6          CONVERTER STATUS (FET+6 - BYTE 0)
 ST       EQU    F6+1        EQUIPMENT STATUS (FET+6 - BYTE 1)
 FG       EQU    F6+2        *BATCHIO* FLAGS
 BS       EQU    40 - 44     BUFFER STATUS
 FC       EQU    45          FUNCTION CODE
 BF       EQU    46          BUFFER POINT OFFSET
 FO       EQU    47          QFT ORDINAL
 BA       EQU    47          BUFFER ADDRESS 
 ET       EQU    IR          EQUIPMENT TYPE 
 FA       EQU    57          FST ADDRESS
 FT       EQU    60 - 61     FIRST POINTER
 IN       EQU    62 - 63     INPUT POINTER
 OT       EQU    64 - 65     OUTPUT POINTER 
 LM       EQU    66 - 67     LIMIT POINTER
****
          SPACE  4,10 
*         DEFINE QUAL BLOCK ORDER.
  
  
          QUAL   ACT
          QUAL   LPM
          QUAL   5BA
          QUAL   5BB
          QUAL   5BC
          QUAL   5BD
          QUAL   PHD
          QUAL   POR
          QUAL   CEC
          QUAL   PFC
          QUAL   GBP
          QUAL
          SPACE  4
          TITLE  MACRO DEFINITIONS. 
 ABORT    SPACE  4,10 
**        ABORT - ABORT MACRO.
* 
*         ABORT ADDR
* 
*         *ADDR* = FWA OF ERROR MESSAGE.
  
  
          PURGMAC ABORT 
  
 ABORT    MACRO  A
          LDC    A
          RJM    ABT
          ENDM
 DFMSG    SPACE  4
**        DFMSG - DEFINE DAYFILE MESSAGE TABLE. 
* 
*TAG      DFMSG  PROC,(MESSAGE CHARACTER STRING)
* 
*         ENTRY  *TAG* - IF PRESENT, TABLE BASE ADDRESS.
*                PROC - ADDRESS OF DAYFILE MESSAGE PROCESSOR. 
  
          MACRO  DFMSG,TAG,PROC,MESS
          IFC    NE,$TAG$$
 MSGN     SET    0
 TAG      EQU    *-2
 DFMT     RMT 
 MSGN     SET    0
          RMT 
          ENDIF 
 MSGN     SET    MSGN+1 
 MSGA     DECMIC MSGN 
          CON    PROC,MSG."MSGA"
          IFC    NE,$MESS$$ 
 DFMT     RMT 
 MSGN     SET    MSGN+1 
 MSGA     DECMIC MSGN 
 MSG."MSGA" DATA   C$MESS$
          RMT 
          ELSE
 MSG."MSGA" EQU    0
 DFMT     RMT 
 MSGN     SET    MSGN+1 
          RMT 
          ENDIF 
          ENDM
 DBMLT    SPACE  4,10 
**        DBMLT - DEFINE BML MESSAGE TABLE. 
* 
*         DBMLT  MSGCD,PROC,SYMPC,NBYTES,TXTADR 
* 
*         ENTRY  MSGCD = MESSAGE CODE.
*                PROC = ADDRESS OF BML MESSAGE PROCESSOR. 
*                SYMPC = SYMPTOM CODE FOR BML MESSAGE.
*                NBYTES = NUMBER OF BYTES IN BML MESSAGE. 
*                TXTADR = ERROR LOG MESSAGE TEXT ADDRESS. 
  
  
 DBMLT    MACRO  MSGCD,PROC,SYMPC,NBYTES,TXTADR 
 DTPR     RMT 
          INDEX  MSGCD-ERRF,PROC
          RMT 
 DTSY     RMT 
          INDEX  MSGCD-ERRF,SYMPC 
          RMT 
 DTNB     RMT 
          INDEX  MSGCD-ERRF,NBYTES
          RMT 
 DTTA     RMT 
          INDEX  MSGCD-ERRF,TXTADR
          RMT 
          ENDM
 LDA      SPACE  4,10 
**        LDA - LOAD ADDRESS MACRO. 
* 
*         LDA    D,M
* 
*         (D - D+1) = RELATIVE ADDRESS. 
*         M      IF SPECIFIED, LOWER 5 BITS OF *D* WILL BE USED.
  
  
          PURGMAC  LDA
  
 LDA      MACRO  X,M
          LDD    X
          IFC    NE,*M**,1
          LPN    37 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    X+1
          ENDM
          TITLE  MAIN PROGRAM.
 BCA      SPACE  4
**        BCA - MAIN PROGRAM. 
  
  
          ORG    PPFW 
 BCA      LJM    PRS         PRESET PROGRAM 
  
*         EXIT. 
  
 BCAX     AOD    BS+4        SET STATUS COMPLETE
          RJM    WSB         STORE STATUS BLOCK (IF LOADED) 
          LDA    IR+3        STORE BUFFER STATUS
          CWD    BS 
 BCA1     MONITOR DPPM       DROP PP
          LJM    PPR         EXIT TO PP RESIDENT
          TITLE  ERROR PROCESSORS.
 ABT      SPACE  4,10 
**        ABT - ABORT ERROR PROCESSOR.
* 
*         ENTRY  (A) = FWA OF ERROR MESSAGE.
* 
*         EXIT   ERROR MESSAGE ISSUED.
*                CONTROL POINT ABORTED. 
* 
*         CALLS  DFM, WSB.
  
  
 ABT      SUBR               ENTRY
          RJM    DFM         ISSUE MESSAGE
 ABTA     LDN    0
*         LDN    1           (IF FET ADDRESS VALID) 
          ZJN    ABT1        IF FET ADDRESS INCORRECT 
          AOD    BS+4        SET FET COMPLETE 
          RJM    WSB         STORE STATUS BLOCK (IF LOADED) 
          LDA    IR+3 
          CWD    BS 
 ABT1     MONITOR ABTM       ABORT CONTROL POINT
          LJM    PPR
          SPACE  4
*         ERROR MESSAGES. 
  
  
 ERBA     DATA   C* QAP - BUFFER ARGUMENT ERROR.* 
 ERIR     DATA   C* QAP - INCORRECT REQUEST.* 
          TITLE  SUBROUTINES. 
 ECB      SPACE  4,10 
**        ECB - EMPTY CENTRAL BUFFER. 
* 
*         ENTRY  (FT - FT+1) = FIRST POINTER. 
*                (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   (A) = ADDRESS OF OUT POINTER WORD. 
*                (CM - CM+4) = IN/OUT POINTER WORD. 
  
  
 ECB      SUBR               ENTRY/EXIT 
          LDN    ZERL 
          CRD    CM 
          LDD    FT+1        SET IN = OUT = FIRST 
          STD    CM+4 
          LDD    FT 
          STD    CM+3 
          LDA    IR+3        STORE IN POINTER 
          ADN    2
          CWD    CM 
          ADN    3-2         STORE OUT POINTER
          CWD    CM 
          UJN    ECBX        RETURN 
 SLL      SPACE  4,10 
**        SLL - SET LINE LIMIT FOR PAGE.
* 
*         ENTRY  (FG) = *BATCHIO* FLAGS.
* 
*         USES   CM - CM+4. 
  
  
 SLL      SUBR               ENTRY/EXIT 
          LDD    FG 
          LPN    10 
          ZJN    SLL1        IF NOT PRINTER WITH SHORT FORMS
          SOM    SLLA 
          LDM    LL8L        FORCE 8 LPI CHARGE ON PFC
          STM    LL6L 
 SLL1     LDN    IPPL        FETCH DEFAULT LIMITS 
          CRD    CM 
          LDC    0
 LL6L     EQU    *-1
          NJN    SLL2        IF 6 LPI LIMIT FOUND IN PFC ARRAY
          LDD    CM 
 SLL2     STM    EQSB+LP6L
          STM    EQSB+LPLL   SET PAGE CHARGE FOR 6 LPI PRINTING 
          LDC    0
 LL8L     EQU    *-1
          NJN    SLL3        IF 8 LPI LIMIT FOUND IN PFC ARRAY
 SLLA     LDD    CM+1 
*         LDD    CM          (SHORT FORMS PRINTER)
 SLL3     STM    EQSB+LP8L
          UJN    SLLX        RETURN 
 WSB      SPACE  4,10 
**        WSB - WRITE DRIVER STATUS BLOCK.
* 
*         ENTRY  (IR+2) = STATUS BLOCK UPDATE FLAGS.
*                (IR+3 - IR+4) = FET ADDRESS. 
* 
*         USES   CM.
* 
*         MACROS LDA. 
  
  
 WSB      SUBR               ENTRY/EXIT 
          LDD    IR+2 
          LPN    2
          ZJN    WSBX        IF STATUS BLOCK NOT LOADED 
          LDN    EDSBL
          STD    CM 
          LDN    0           CLEAR INTERLOCK
          STM    EQSB+CMSB
          LDA    IR+3        STORE STATUS BLOCK 
          ADN    EDSO 
          CWM    EQSB,CM
          UJN    WSBX        RETURN 
 VCA      SPACE  4,10 
**        VCA - VALIDATE CENTRAL MEMORY ADDRESS.
* 
*         ENTRY  (IR+3 - IR+4) = RELATIVE ADDRESS.
*                (T2) = BLOCK LENGTH. 
* 
*         EXIT   CONTROL POINT ABORTED IF ADDRESS OUTSIDE OF FL.
  
  
 VCA      SUBR               ENTRY/EXIT 
          LDD    IR+3 
          LPN    37 
          SHN    14 
          ADD    IR+4 
          ADD    T2 
          SHN    -6 
          SBD    FL 
          MJN    VCAX        IF VALID ADDRESS 
          ABORT  ERIR        * QAP - INCORRECT REQUEST.*
          TITLE  FUNCTION PROCESSORS. 
          TITLE  FUNCTION PROCESSORS. 
 ACT      SPACE  4
**        ACT - PROCESS ACCOUNTING. 
  
  
 ACT      EXECUTE 3BA 
          NJN    CPR         IF ANOTHER PPU TO BE CALLED
          LJM    BCAX        RETURN 
 CEC      SPACE  4,10 
**        CHANNEL ERROR CLEANUP PROCESSOR.
  
  
 CEC      EXECUTE 3BE 
 CPR      SPACE  4,10 
**        CPR - CALL PP ROUTINE INTO THIS PP. 
* 
*         ENTRY  (A) = NAME OF REQUESTED PP ROUTINE.
*                (IR+2, IR+3, IR+4) = SET CORRECTLY FOR PP CALL.
  
  
 CPR      SHN    14          SET UP PP CALL 
          STD    IR 
          SHN    -6 
          LMD    IR+1 
          SCN    77 
          LMD    IR+1 
          STD    IR+1 
          LDD    IA          CALL PP ROUTINE
          CWD    IR 
          LJM    PPR
 IIF      SPACE  4
**        IIF - INITIATE INPUT FILE.
  
  
 IIF      BSS    0
          LDD    BS+4        SET *CIO* FUNCTION 
          LPN    30 
          LMN    4
          STD    BS+4 
  
*         SET FILE NAME TO *ZEQN*.
  
          LDD    EQ          CONVERT EST ORDINAL
          RJM    C2D
          STD    BS+1 
          LDD    EQ 
          SHN    -6 
          RJM    C2D
          LMC    2LZZ&2LZ0
          STD    BS 
          SFA    EST,EQ      READ EST ENTRY 
          ADK    EQAE 
          CRD    CN 
          LDD    CN+3        EQUIPMENT LOWER ACCESS LEVEL LIMIT 
          LPN    70 
          SHN    3
          LMC    4000        ACCESS LEVEL SELECTION FLAG
          STM    IIFA 
          LMC    5004        SET ACCESS LEVEL FLAG AND FUNCTION 
          STM    OVL-1
          LDA    IR+3        STORE FILE NAME IN FET 
          CWD    BS 
          ADN    4           READ LIMIT WORD
          CRD    CN 
  
*         ESTABLISH THE FILE. 
  
          LDN    NEEQ        ASSIGN TO NULL EQUIPMENT 
          STD    FS 
          EXECUTE 0BF,OVL 
          ZJN    IIF1        IF FILE CREATED
  
*         HANG IF LOCAL FILE LIMIT OR FILE ALREADY EXISTS 
*         (ADVANCE EXIT FROM *0BF*).
  
          MONITOR  HNGM      HANG PP
          LJM    BCA1        EXIT TO DROP PP
  
 IIF1     LDD    FA          SET FNT ADDRESS IN LIMIT WORD
          STD    CN 
          LDA    IR+3        STORE LIMIT WORD 
          ADN    4
          CWD    CN 
          AOD    FS+4 
 IIF2     LDN    ZERL        CLEAR REQUEST WORD 
          CRD    CM 
          LDN    INPS        SET *MSAL* PARAMETER FOR INPUT FILE
          STD    CM+2 
          LDC    **          SET ACCESS LEVEL/SELECTION FLAG
 IIFA     EQU    *-1
          STD    CM+3 
          MONITOR  RTCM      REQUEST TRACK
          LDD    CM+4 
          NJN    IIF3        IF TRACK ASSIGNED
          LDD    CP          STORE CONTROL POINT MESSAGE
          ADN    MS2W 
          CWM    IIFB,TR
          DELAY 
          PAUSE 
          LDD    CM+1 
          ZJN    IIF2        IF NO ERROR FLAG SET 
          LMN    IDET 
          ZJN    IIF2        IF IDLEDOWN
          NFA    FA,R        STORE FST INFORMATION
          ADN    FSTL 
          CWD    FS 
          LJM    BCAX        DROP PPU 
  
 IIF3     STD    FS+1 
          LDD    CM+1        SET EQUIPMENT
          STD    FS 
  
*         STORE FILE NAME IN *BATCHIO* COMMUNICATION AREA.
  
          LDN    0           CLEAR OPERATOR FLAGS 
          STD    BS+4 
          LDD    EQ          SET EQUIPMENT
          STD    BS+3 
          NFA    BF,R        STORE BUFFER POINT WORD
          CWD    BS 
  
*         STORE FST INFORMATION.
  
          NFA    FA,R 
          ADN    FSTL 
          CWD    FS 
  
*         ENTER HERE TO CALL *CIO*. 
  
 CIO      LDC    2RCI        SET PP PACKAGE NAME
          STD    IR 
          LDC    1RO*100-1RP*100
          RAD    IR+1 
          LDN    ZERL 
          CRD    CM 
          EXECUTE  CIO,=
          LDD    MA          STORE REQUEST
          CWD    IR 
          ADN    1
          CWD    CM 
          MONITOR  RPPM      CALL *CIO* 
          LJM    BCA1        DROP PP
  
 IIFB     DATA   C*TRACK LIMIT.*
 LPH      SPACE  4
**        LPH - LOAD PUNCH DATA.
  
  
 LPH      EXECUTE 3BC 
          LJM    BCAX        EXIT 
 POR      SPACE  4
**        POR - PROCESS OPERATOR REQUEST. 
  
  
 POR      EXECUTE 3BD 
 LPR      SPACE  4
**        LPR - LOAD PRINT DATA.
  
  
 LPR      LDD    BF 
          ZJN    LPR3        IF NOT *BATCHIO* CALL
          LDD    ES          CHECK EQUIPMENT
          LPC    200
          ZJN    LPR2        IF NOT PFC PRINTER 
 LPR1     EXECUTE 3BB        LOAD PFC MEMORY
          LDN    0           CLEAR BANNER PAGE CONTROL INFORMATION
 LPR2     STD    FP 
          LDD    F6+2        SAVE 8/12 ASCII PRINT FILE FLAG
          LPN    4
          STD    FP+2 
          RJM    SLL         SET LINE LIMITS
  
*         GENERATE BANNER PAGE. 
  
 LPR3     EXECUTE 3BG 
          LDD    BF 
          NJN    LPR5        IF *BIO* CALL
          STD    FP+2 
          STD    FP+3 
          LDA    IR+3        RETURN BANNER PAGE CONTROL INFORMATION 
          ADN    5
          CWD    FP 
          LDD    T1          SET FET CONTROL INFORMATION
          STD    BS+4 
 LPR4     LJM    BCAX        RETURN 
  
 LPR5     LDD    T1 
          LMC    1030 
          ZJN    LPR4        IF COMPLETE BANNER PAGE
          LDD    CP 
          ADN    MS2W 
          CWM    LPRA,TR
          UJN    LPR4        RETURN 
  
  
 LPRA     DATA   C*$INCOMPLETE BANNER PAGE.*
 PLE      SPACE  4,10 
**        PLE - PROCESS LIMIT EXCEEDED. 
  
  
 PLE      SFA    QFT,FO      READ QFT ENTRY 
          ADK    JSNQ 
          CRD    CM 
          LDD    CM+4        CHECK QUEUE FILE TYPE
          SHN    -11
          LMN    PHQT 
          NJN    PLE1        IF NOT PUNCH FILE
          LJM    LPH         PROCESS PUNCH FILE LIMIT 
  
 PLE1     LMN    PRQT&PHQT
          ZJN    TPF         IF PRINT FILE
          LJM    BCAX        EXIT 
 TPF      SPACE  4,10 
**        TPF - TERMINATE PRINT FILE. 
  
  
 TPF      RJM    ECB         EMPTY CENTRAL BUFFER 
          LDA    CM+3        STORE MESSAGE IN BUFFER
          CWM    TPFB,TR
*         CWM    PFCA,TR     (USER ACCESS NOT VALID)
 TPFA     EQU    *-1
          LDN    3           SET IN = FIRST+3 
          RAD    CM+4 
          SHN    -14
          RAD    CM+3 
  
*         ENTERED HERE FROM *3BF*.
  
 TPF1     LDC    1030        SET EOI
          STD    BS+4 
          LDD    BF 
          ZJN    TPF2        IF NOT *BATCHIO* CALL
          LDD    F6+2        SET ABORT FLAG 
          SCN    2
          LMN    2
          STD    F6+2 
          LDA    IR+3        STORE FILE PARAMETER WORD
          ADN    FPW2 
          CWD    F6 
 TPF2     LDA    IR+3        STORE IN POINTER 
          ADN    2
          CWD    CM 
          LJM    BCAX        RETURN 
  
 TPFB     DATA   C=-**LINE LIMIT EXCEEDED.**= 
          BSSZ   TPFB+3*5-* 
 PDF      SPACE  4
**        PDF - PROCESS DAYFILE MESSAGES. 
* 
*         EXIT IS MADE TO RETURN ADDRESS *PDFA*, WHICH MUST BE
*         PRESET IF RETURN IS TO CALLING ROUTINES OTHER THAN *BCA*. 
  
  
 PDF      LDN    3           SET COMPLETE STATUS FOR DRIVER 
          RAD    BS+4 
  
*         ENTER HERE IF EXIT NOT TO *BCA1*. 
  
 PDF1     LDA    IR+3        STORE BUFFER STATUS
          CWD    BS 
          NFA    BF,R        READ BUFFER POINT WORD 
          ADN    1
          CRD    CM 
          LDD    CM+1        SET TABLE INDEX
          NJN    PDF2        IF MESSAGE CODE PRESENT
          LJM    PDF10       RETURN (*BATCHIO* RECOVERY)
  
*         *PDF2* IS A SECONDARY ENTRY POINT FOR *PDF*.
* 
*         ENTRY  (A) = DAYFILE MESSAGE CODE.
*                (CM - CM+4) = SECOND BUFFER POINT WORD.
  
 PDF2     SBN    CMME        CHECK IF *QAP* MESSAGE CODE
          PJN    PDF3        IF INCORRECT REQUEST 
          ADN    CMME 
          NJN    PDF4        IF LEGAL REQUEST 
 PDF3     LDN    0           SET NO ERROR FLAG
          STD    CM+2 
          LDC    *           SET ADDRESS WHERE ERROR DETECTED 
          STD    CM+1 
          MONITOR  CHGM      CONDITIONALLY HANG PP
          LJM    PDF10       RETURN 
  
 PDF4     SBN    FPRE 
          MJN    PDF5        IF OPERATOR REQUEST
          RJM    IBE         ISSUE BML AND ERROR LOG MESSAGES 
          UJN    PDF10       RETURN 
  
 PDF5     ADN    FPRE 
          SHN    1
          STD    T1 
          LDM    TDFP+1,T1   SET MESSAGE ADDRESS
          STD    T2 
          LDD    EQ          CONVERT EST ORDINAL
          SHN    -3 
          RJM    C2D
          STM    2,T2 
          LDD    EQ 
          LPN    7
          SHN    6
          RAM    3,T2 
          LDM    TDFP,T1     SET POSTPROCESSOR ADDRESS
          STD    T1 
          LJM    0,T1        COMPLETE MESSAGE PROCESSING
  
 PDF8     LDD    CM+2        CONVERT CHANNEL/OPERATOR REQUEST 
          RJM    C2D
          STM    4,T2        STORE IN MESSAGE 
 PDF9     LDD    T2 
          RJM    DFM
  
*         *PDFA* IS THE RETURN ADDRESS FOR *PDF*. 
  
 PDF10    LJM    BCA1        EXIT 
 PDFA     EQU    *-1
 TDFP     SPACE  4,10 
**        TDFP - TABLE OF PROCESSORS AND MESSAGES.
* 
* 
*         *TDFP* IS INDEXED WITH THE DAYFILE MESSAGE CODES DEFINED
*         IN *COMSBIO*. 
*         *TDFP* IS A PARTIAL TABLE OF MESSAGES CONTAINING ONLY 
*         THOSE MESSAGES THAT ARE ISSUED BY *QAP*.
* 
*         ENTRY = 2 WORDS.
*                (MESSAGE TEXT IN REMOTE CODE.) 
* 
*         INDEXED BY MESSAGE NUMBER * 2.
  
  
 TDFP     DFMSG  PDF8,(END 000,00.) 
          DFMSG  PDF8,(REP 000,00.) 
          DFMSG  PDF8,(SUP 000,00.) 
          DFMSG  PDF8,(RRN 000,00.) 
          DFMSG  PDF9,(HLD 000.)
          DFMSG  PDF9,(CON 000.)
          DFMSG  PDF8,(BKP 000,00.) 
          DFMSG  PDF8,(BKR 000,00.) 
          DFMSG  PDF8,(BKF 000,00.) 
          DFMSG  PDF8,(SKP 000,00.) 
          DFMSG  PDF8,(SKR 000,00.) 
          DFMSG  PDF8,(SKF 000,00.) 
          DFMSG  PDF10
          DFMSG  PDF10
          DFMSG  PDF10
 IBE      SPACE  4,10 
**        IBE - ISSUE BML AND ERROR LOG MESSAGES. 
* 
*         ENTRY  (A) = INDEX INTO *TIPR*, *TISY*, *TINB*, *TMTA*. 
*                (EQ) = EST ORDINAL.
*                (ES - ES+4) = EST ENTRY. 
*                (CM - CM+4) = SECOND BUFFER POINT WORD.
*                (CS) = CONVERTER STATUS. 
*                (ST) = EQUIPMENT STATUS. 
* 
*         USES   T0, T5, T6, T7.
* 
*         CALLS  C2D, DFM, DMI. 
* 
*         MACROS BLMSIDT, DBMLT.
  
  
 IBE      SUBR               ENTRY/EXIT 
          STD    T7          (T7) = ERROR MESSAGE INDEX MINUS *ERRF*
          LDM    TMTA,T7     GET ERROR LOG MESSAGE ADDRESS
          STD    T6          (T6) = ERROR LOG MESSAGE TEXT ADDRESS
          LDM    TISY,T7     SYMPTOM CODE 
          STM    IBEA+1 
          LDD    CM+3        PP NUMBER
          SHN    6
          LMD    ES+1        APPEND CHANNEL NUMBER
          SCN    37 
          LMD    ES+1 
          STM    IBEA+2 
          LDD    ES+4        GET EQUIPMENT NUMBER 
          SHN    0-11 
          SHN    6
          STM    IBEA+3 
          LDD    ES+3        EQUIPMENT TYPE 
          STI    T6          STORE IN ERROR LOG MESSAGE TEXT
          RJM    DMI
          ZJN    IBEX        IF EQUIPMENT NOT FOUND 
          STM    IBEA 
          LDM    TIPR,T7
          STD    T5          SET POSTPROCESSOR ADDRESS
          LJM    0,T5        COMPLETE MESSAGE PROCESSING
  
*         ACCOUNTING DATA.
  
 IBE5     LDD    ES+1        SET CHANNEL NUMBER 
          LPN    37 
          STM    IBEA+2 
          LJM    IBE18       COMPLETE BML MESSAGE 
  
*         FUNCTION REJECT, TRANSMISSION PARITY ERROR. 
  
 IBE6     LDD    CS          LOAD STATUS
          LPN    4
          ZJN    IBE7        IF REJECT MESSAGE
          AOD    T7 
          LDM    TISY,T7
          STM    IBEA+1      SYMPTOM CODE 
          LDM    TMTA,T7
          STD    T6          RESET MESSAGE TEXT ADDRESS 
          LDD    ES+3        RESET EQUIPMENT TYPE 
          STI    T6          STORE IN ERROR LOG MESSAGE TEXT
 IBE7     LDD    CM+4        FUNCTION CODE
          STM    IBEC+2 
          UJN    IBE13       COMPLETE BML MESSAGE 
  
*         PRINT ERRORS. 
  
 IBE8     LDD    CM+4 
          STM    IBEC+4 
          RJM    C2D         CONVERT LOWER TWO DIGITS 
          STM    4,T6 
          LDD    CM+4 
          SHN    -6 
          RJM    C2D         CONVERT UPPER TWO DIGITS 
          STM    3,T6 
          UJN    IBE12       COMPLETE BML MESSAGE 
  
*         PFC ERROR.
  
 IBE9     LDD    CM+4 
          STM    IBEC+3 
          UJN    IBE11       COMPLETE BML MESSAGE 
  
*         FUNCTION TIMEOUT, CONTROLLER HUNG BUSY. 
  
 IBE10    LDD    CM+4 
          STM    IBEC+2 
  
*         FEED FAILURE, COMPARE ERROR.
  
 IBE11    LDD    ST          EQUIPMENT STATUS 
          STM    IBEC+1 
          LDD    CS          CONVERTER STATUS 
          STM    IBEC 
 IBE12    UJN    IBE17       COMPLETE BML MESSAGE 
  
*         PRINT ERROR LIMIT.
  
 IBE13    LDD    ST          EQUIPMENT STATUS 
          STM    IBEC+1 
          LDD    CS          CONVERTER STATUS 
          STM    IBEC 
          UJN    IBE16       COMPLETE BML MESSAGE 
  
*         INCOMPLETE DATA TRANSFER. 
  
 IBE14    LDD    CS          CONVERTER STATUS 
          STM    IBEC 
*         UJN    IBE15       COMPLETE BML MESSAGE 
  
*         CHANNEL PARITY ERROR. 
  
 IBE15    LDD    CM+4        FUNCTION CODE
          STM    IBEC+2 
*         UJN    IBE16       COMPLETE BML MESSAGE 
  
*         EQUIPMENT TURNED OFF. 
  
 IBE16    LDD    CM+2        RETRY COUNT/UNRECOVERED FLAG 
          STM    IBEB+1 
  
*         CHECK IF ERROR RECOVERED. 
  
          ZJN    IBE17       IF ERROR NOT RETRIED 
          LPN    1
          ZJN    IBE18       IF RECOVERED ERROR 
  
*         FORMAT ERROR LOG MESSAGE. 
  
 IBE17    LDD    EQ          CONVERT UPPER TWO DIGITS OF EST ORDINAL
          SHN    -3 
          RJM    C2D
          STM    1,T6        STORE IN MESSAGE TEXT
          LDD    EQ 
          LPN    7
          SHN    6
          RAM    2,T6        ADD LOWER DIGIT INTO TEXT
  
*         ISSUE ERROR LOG MESSAGE.
  
          LDD    T6 
          ADC    ERLN        ERROR LOG MESSAGE
          RJM    DFM         ISSUE DAYFILE MESSAGE
  
*         ISSUE BML MESSAGE.
  
 IBE18    LDN    ZERL        SETUP FOR BML MESSAGE
          CRD    CM 
          LDM    TINB,T7     SET BYTE COUNT FOR MESSAGE 
          STD    CM+1 
          LDC    IBEA+BMLN
          RJM    DFM         SEND MESSAGE TO BML
          LJM    IBEX        RETURN 
          SPACE  4,10 
**        BML MESSAGE TABLE 
  
  
 IBEA     VFD    12/0,12/0,6/0,6/0,6/0,18/0   BML WORD 2
 IBEB     VFD    12/0,6/0,6/0,12/0,12/0,12/0  BML WORD 3
 IBEC     VFD    12/0,12/0,12/0,12/0,12/0     BML WORD 4
          SPACE  4,10 
**        DEFINE BML PROCESSORS, SYMPTOM CODES, AND LENGTHS.
  
  
          DBMLT  ECEM,IBE11,/COMSDFS/BS0101,3*5,ECEA
          DBMLT  EPEM,IBE8,/COMSDFS/LS0103,3*5,EPEA 
          DBMLT  EPLM,IBE13,/COMSDFS/LS0101,3*5,EPLA
          DBMLT  EFFM,IBE11,/COMSDFS/BS0102,3*5,EFFA
          DBMLT  EPFC,IBE9,/COMSDFS/LS0102,3*5,EPFA 
          DBMLT  EACT,IBE5,/COMSDFS/LS0100,3*5,ECEA 
          DBMLT  ERJM,IBE6,/COMSDFS/HS0025,3*5,ERJA 
          DBMLT  ETPE,IBE6,/COMSDFS/HS0010,3*5,ETPA 
          DBMLT  EFTM,IBE10,/COMSDFS/HS0050,3*5,EFTA
          DBMLT  EITM,IBE14,/COMSDFS/HS0005,3*5,EITA
          DBMLT  EEOM,IBE16,/COMSDFS/HS0030,2*5,EEOA
          DBMLT  ECBM,IBE10,/COMSDFS/HS0044,3*5,ECBA
          DBMLT  ECRE,IBE15,/COMSDFS/HS0024,3*5,ECRA
          SPACE  4,10 
          BLMSIDT 
 TIPR     SPACE  4,10 
**        TIPR - TABLE OF PROCESSING ROUTINES.
  
  
 TIPR     INDEX 
          DUP    CMME-ERRF,1
          CON    IBEX 
          ORG    TIPR 
 DTPR     HERE
          INDEX  CMME-ERRF
 TISY     SPACE  4,10 
**        TISY - TABLE OF SYMPTOM CODES 
  
  
 TISY     INDEX 
 DTSY     HERE
          INDEX  CMME-ERRF
 TINB     SPACE  4,10 
**        TINB - TABLE OF NUMBER OF BML BYTES 
  
  
 TINB     INDEX 
 DTNB     HERE
          INDEX  CMME-ERRF
 TMTA     SPACE  4,10 
**        TMTA - TABLE OF MESSAGE TEXT ADDRESSES. 
  
  
 TMTA     INDEX 
 DTTA     HERE
          INDEX  CMME-ERRF
          SPACE  4,10 
**        ERROR LOG MESSAGE TEXTS.
  
  
 ECEA     DATA   C*EQ000 COMPARE ERROR.*
 EPEA     DATA   C*EQ000 0000 PRINT ERRORS.*
 EPLA     DATA   C*EQ000 PRINT ERROR LIMIT EXCEEDED.* 
 EFFA     DATA   C*EQ000 FEED FAILURE.* 
 EPFA     DATA   C*EQ000 PFC ERROR.*
 ERJA     DATA   C*EQ000 INTERNAL/EXTERNAL REJECT.* 
 ETPA     DATA   C*EQ000 TRANSMISSION PARITY ERROR.*
 EFTA     DATA   C*EQ000 FUNCTION TIMEOUT.* 
 EITA     DATA   C*EQ000 INCOMPLETE DATA TRANSFER.* 
 EEOA     DATA   C*EQ000 TURNED OFF BY SYSTEM.* 
 ECBA     DATA   C*EQ000 CONTROLLER HUNG BUSY.* 
 ECRA     DATA   C*EQ000 CHANNEL PARITY ERROR.* 
  
  
  
  
 DFMT     HERE               ASSEMBLE DAYFILE MESSAGE TABLE 
          TITLE  COMMON DECKS AND BUFFER DEFINITIONS. 
          SPACE  4
**        COMMON DECKS. 
  
  
*CALL     COMPACS 
*CALL     COMPCIB 
*CALL     COMPCOB 
*CALL     COMPC2D 
 EJT$     EQU    0           DEFINE *COMPGFP* ACCESS TO EJT 
 QFT$     EQU    0           DEFINE *COMPGFP* ACCESS TO QFT 
 IFP$     EQU    0           GENERATE *IFP* REMOTE CODE 
*CALL     COMPGFP 
*CALL     COMPRBB 
*CALL     COMPWBB 
          SPACE  4
**        EQSB - DRIVER STATUS BLOCK BUFFER.
  
  
 EQSB     BSS    0
          SPACE  4,10 
 OVL      EQU    EQSB+5*EDSBL+5  OVERLAY LOAD ADDRESS 
          ERRNG  EPFW-OVL-ZBFL  ENSURE SPACE FOR *0BF*
          TITLE  PRESET.
 TOPC     SPACE  4
**        TOPC - TABLE OF FUNCTION REQUEST PROCESSORS.
* 
*         INDEXED BY FUNCTION CODE / 10B - 40B. 
  
  
 TOPC     INDEX 
          INDEX  PDMF/10-40,PDF    PROCESS DAYFILE MESSAGE
          INDEX  WTIF/10-40,IIF    INITIATE INPUT WITH WRITE
          INDEX  WRIF/10-40,IIF    INITIATE INPUT WITH WRITE EOR
          INDEX  WFIF/10-40,IIF    INITIATE INPUT WITH WRITE EOF
          INDEX  CECF/10-40,CEC    CHANNEL ERROR CLEANUP
          INDEX  PORF/10-40,POR    PROCESS OPERATOR REQUEST 
          INDEX  RQFF/10-40,CEC    REQUEUE FILE 
          INDEX  PFCF/10-40,LPR1   LOAD USER IMAGE TO 580 PFC 
          INDEX  GBPF/10-40,LPR    GENERATE BANNER PAGE 
          INDEX  GLCF/10-40,LPH    GENERATE LACE CARD 
          INDEX  PLEF/10-40,PLE    PROCESS USER LIMIT EXCEEDED
          INDEX  ACTF/10-40,ACT    PROCESS ACCOUNTING 
          INDEX  QAPFE/10-40
          TITLE  PRESET.
 PRS      SPACE  4
**        PRS - PRESET PROGRAM. 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   TO FUNCTION PROCESSOR. 
*                (FA) = FNT ADDRESS.
*                (BF) = BUFFER POINT ADDRESS IF *BATCHIO* CALL. 
*                (BF) = 0 IF NOT *BATCHIO* CALL.
*                (EQ) = EST ORDINAL (*BATCHIO* ONLY). 
*                (ET) = EQUIPMENT TYPE (*BATCHIO* ONLY) 
*                (BS+4) = REQUEST.
*                (FO) = QFT ORDINAL.
*                (FT - FT+1) = FIRST POINTER. 
*                (IN - IN+1) = IN POINTER.
*                (OT - OT+1) = OUT POINTER. 
*                (LM - LM+1) = LIMIT POINTER. 
*                (ES - ES+4) = EST ENTRY. (*BATCHIO* ONLY). 
*                (ES)        = PAGE SIZE (NON-*BATCHIO* ONLY) 
*                (FP - FP+4) = FILE PARAMETER WORD (FET+5). 
*                (F6 - F6+4) = FILE PARAMETER WORD (FET+6). 
  
  
 PRS      BSS    0           ENTRY
          LDK    MMFL 
          CRD    CM 
          LDD    CM          MACHINE ID 
          STM    IBEB+3 
          LDA    IR+3        READ BUFFER STATUS 
          CRD    BS 
          ADN    FPW2        READ FILE PARAMETERS 
          CRD    F6 
          SBN    FPW2-5 
          CRD    FP 
          SBN    1
          CRD    LM-3        READ LIMIT 
          CRD    T1 
          SBN    1           READ OUT 
          CRD    OT-3 
          SBN    1           READ IN
          CRD    IN-3 
          SBN    1           READ FIRST 
          CRD    CM 
          ADN    EDSO-1+CMEN/5
          CRD    ES 
          LDD    ES+CMEN-CMEN/5*5 
          LPN    7           SET EQUIPMENT TYPE CODE
          STD    ET 
          LDD    T1+1        SET QFT ORDINAL
          STD    FO 
          LDD    CM+3        SET FIRST
          LPN    37 
          STD    FT 
          LDD    CM+4 
          STD    FT+1 
          LDD    FP+1        GET PAGE SIZE (NON-*BATCHIO*)
          STD    ES          ASSUME NON-*BATCHIO* CALL
          LDN    5           SET FET LENGTH 
          STD    T2 
          LDD    CP          READ SUBSYSTEM ID
          ADN    JCIW 
          CRD    CM 
          LDD    CM+2 
          LMC    BISI 
          NJN    PRS1        IF NOT *BATCHIO* CALL
          STM    PRSA 
          LDN    QFFL        ADJUST FET LENGTH
          STD    T2 
          LDD    FP          SET BUFFER POINT OFFSET
          STD    BF 
          NFA    BF,R        READ BUFFER POINT WORD 
          CRD    CM 
          LDD    CM+3        SET EST ORDINAL
          STD    EQ 
          STM    IBEB 
          SFA    EST         READ EST ENTRY 
          ADK    EQDE 
          CRD    ES 
 PRS1     RJM    VCA         VALIDATE FET ADDRESS 
          AOM    ABTA        SET VALID FET ADDRESS
          RJM    IFP         INITIALIZE TABLE ACCESS ROUTINES 
          RJM    CBP         CHECK BUFFER PARAMETERS
          LDD    BS+4 
          SHN    21-0 
          MJN    PRS5        IF FET NOT BUSY
          SHN    1-3
          SBN    40 
          MJN    PRS5        IF INCORRECT REQUEST 
          STD    T2 
          SBN    QAPFE/10-40
          PJN    PRS2        IF INCORRECT REQUEST 
          LDD    T1          SET FNT ADDRESS
          STD    FA 
          NJN    PRS3        IF DEFINED 
          LDD    T2 
          SBN    CECF/10-40+1 
 PRS2     PJN    PRS6        IF REQUEST INCORRECT WITHOUT FNT OFFSET
 PRS3     UJN    PRS4        VALIDATE NON-*BATCHIO* CALLER
 PRSA     EQU    PRS3 
*         PSN                (*BATCHIO* CALL) 
          LJM    PRS10       JUMP TO PROCESSOR
  
 PRS4     LDD    T2 
          SBN    GBPF/10-40 
 PRS5     MJN    PRS6        IF REQUEST FOR *BATCHIO* FUNCTION
          LDD    FA          VALIDATE FNT OFFSET
          SBK    FNTN+LENF
          MJN    PRS6        IF INCORRECT FNT POINTER 
          LDD    CP          FETCH EJT ORDINAL
          ADN    TFSW 
          CRD    T7 
          SBN    TFSW-FLSW   GET NFL VALUE
          CRD    CM 
          LDD    FA          CHECK FNT OFFSET WITHIN NFL
          SHN    -6 
          SBD    CM 
          MJN    PRS7        IF VALID FNT POINTER 
 PRS6     ABORT  ERIR        * QAP - INCORRECT REQUEST.*
  
 PRS7     SFA    EJT,T7 
          ADN    SCLE 
          CRD    CM 
          LDD    CM          CHECK JOB ORIGIN TYPE
          LPN    17 
          LMK    SYOT 
          STD    BF 
          NJN    PRS6        IF NOT SYSTEM ORIGIN 
          STD    ET 
          STD    IR+2 
          LDN    QFTP 
          CRD    CM 
          LDD    FO          CHECK QFT ORDINAL
          ZJN    PRS6        IF ORDINAL ZERO
          SBD    CM+2 
          PJN    PRS6        IF INCORRECT ORDINAL 
          SFA    QFT,FO      READ QFT ENTRY 
          CRD    CM 
          LDD    CM 
          ADD    CM+1 
          ZJN    PRS6        IF EMPTY QFT ENTRY 
          LDD    ES 
          LPC    4000 
          ZJN    PRS9        IF POSITION TO BOTTOM OF FORM AVAILABLE
          LDD    ES 
          LPC    PSUL        ISOLATE PAGE SIZE
          NJN    PRS8        IF *PS* VALUE GIVEN
          NFA    JPPN        GET DEFAULT PAGE SIZE
          CRD    CM 
          LDD    CM+2 
          LPN    17 
          SHN    14 
          LMD    CM+3 
          SHN    -10
          LPC    PSUL        MASK UPPER LIMIT 
 PRS8     STD    ES 
          SBN    PSLL 
          PJN    PRS10       IF WITHIN LIMITS 
          LDN    PSLL        USE LOWER LIMIT
 PRS9     STD    ES 
 PRS10    LDM    TOPC,T2
          STD    T2 
          ERRNG  *-EQSB-EDSBL*5 
          RJM    RSB         LOAD DRIVER STATUS BLOCK 
          LJM    0,T2        JUMP TO PROCESSOR
  
  
 IFP      HERE               DUMP *IFP* REMOTE CODE 
 CBP      SPACE  4,10 
**        CBP - CHECK BUFFER PARAMETERS.
* 
*         ENTRY  (FT - FT+1) = FIRST. 
*                (IN - IN+1) = IN.
*                (OT - OT+1) = OUT. 
*                (LM - LM+1) = LIMIT. 
* 
*         EXIT   FET POINTERS VALIDATED.
  
  
 CBP      SUBR               ENTRY/EXIT 
          LDD    LM          SET LIMIT
          LPN    37 
          STD    LM          (LIMIT-1)/100 - FL 
          SHN    14 
          LMD    LM+1 
          SBN    1
          SHN    -6 
          SBD    FL 
          PJN    CBP1        IF LIMIT .GE. FL 
  
          LDD    OT          OUT - LIMIT
          LPN    37 
          STD    OT 
          SBD    LM 
          SHN    14 
          ADD    OT+1 
          SBD    LM+1 
          PJN    CBP1        IF OUT .GE. LIMIT
  
          LDD    OT          OUT - FIRST
          SBD    FT 
          SHN    14 
          ADD    OT+1 
          SBD    FT+1 
          PJN    CBP2        IF OUT .GE. FIRST
 CBP1     ABORT  ERBA        * QAP - BUFFER ARGUMENT ERROR.*
  
 CBP2     LDD    IN          IN - LIMIT 
          LPN    37 
          STD    IN 
          SBD    LM 
          SHN    14 
          ADD    IN+1 
          SBD    LM+1 
          PJN    CBP1        IF IN .GE. LIMIT 
  
          LDD    IN          IN - FIRST 
          SBD    FT 
          SHN    14 
          ADD    IN+1 
          SBD    FT+1 
          MJN    CBP1        IF IN .LT. FIRST 
          LJM    CBPX        RETURN 
 RSB      SPACE  4,10 
**        RSB - READ DRIVER STATUS BLOCK. 
* 
*         ENTRY  (IR+2) = STATUS BLOCK UPDATE FLAGS.
*                (IR+3 - IR+4) = FET ADDRESS. 
* 
*         USES   CM.
* 
*         MACROS DELAY, LDA, PAUSE. 
  
  
 RSB      SUBR               ENTRY/EXIT 
          LDD    IR+2 
          LPN    6
          ZJN    RSBX        IF NO UPDATE REQUIRED
 RSB1     LDN    EDSBL
          STD    CM 
          LDA    IR+3        READ STATUS BLOCK
          ADN    EDSO 
          CRM    EQSB,CM
          LDM    EQSB+CMSB
          LMD    IR+2 
          ZJN    RSBX        IF DRIVER HAS NOTED INTERLOCK
          DELAY 
          PAUSE  NE 
          UJN    RSB1        LOOP 
          TTL    QAP/3BA - ACCOUNTING.
          TITLE 
          QUAL   ACT
          IDENT  3BA,ACTX    ACCOUNTING 
*COMMENT  QAP - ACCOUNTING. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
***       ENTRY CONDITIONS. 
* 
*         FOR *BATCHIO* 
*         ((FT - FT+1)) = 12/ ,12/ DV ,12/ ,24/ CNT1
* 
*         FOR ALL OTHER CALLERS.
*         ((OT - OT+1)) = 12/ ,12/ DV ,12/ ,24/ CNT2
*         ((OT - OT+1)+1) = 42/ TERMINAL NAME OR EQ NUMBER ,18/ 
* 
* 
*         DV     DEVICE TYPE. 
*                0 = LINE PRINTER.
*                1 = CARD PUNCH.
*                2 = CARD READER. 
*                3 = PLOTTER. 
* 
*         CNT1   (USER VALIDATION LIMIT) - (RECORD COUNT) 
*         CNT2   RECORD COUNT.
* 
*         (RECORD COUNT) = NUMBER OF CARDS READ, CARDS PUNCHED, LINES 
*                PRINTED AND PRUS PLOTTED.
* 
*         EXIT CONDITIONS.
* 
*         FOR PRINT FILES.
*         1. ACCOUNT FILE MESSAGE RETURNED TO CM BUFFER.
*         2. IN POINTER UPDATED IN FET. 
* 
*         FOR INPUT FILES.
*         1. FNT POINTER CLEARED IN FET.
*         2. *DSP* CALLED TO QUEUE INPUT FILE.
          SPACE  4
***       ACCOUNT FILE MESSAGES.
* 
* 
*         *ABCN, CHARGENUMBER, PROJECTNUMBER.* = BEGINNING OF A CHARGE
*         SEQUENCE. 
* 
*         *ABUN, USERNAME, FAMILY.* = BEGINNING OF OUTPUT FOR 
*         USER *USERNAME*.
* 
*         *AESR, .* = NULL SRU UNITS FOR END OF JOB.
* 
*         *UCCR, MI,EQN, XXXXXX.XXXKCDS.* = KILO CARDS READ.
*                                          (ISSUED BY *1AJ*)
*         *UCLP, MI,EQN, XXXXXX.XXXKLNS.* = KILO LINES PRINTED. 
*         *UCLV, MI,EQN, XXXXXX.XXXKLNS.* = KILO LINES PRINTED. 
*                                          (USER SUPPLIED FORMAT) 
*         *UCPC, MI,EQN, XXXXXX.XXXKCDS.* = KILO CARDS PUNCHED. 
*         *UCPL, MI,EQN, XXXXXX.XXXKPLS.* = KILO UNITS PLOTTED. 
* 
*                MI = MACHINE ID. 
*                EQN = LOCAL EST ORDINAL / REMOTE TERMINAL NAME.
          SPACE  4
 ACT      SPACE  4
**        ACT - MAIN ROUTINE. 
  
  
          ORG    OVL
  
 ACT      SUBR               ENTRY/EXIT 
          LDD    BF 
          ZJN    ACT1        IF NOT *BATCHIO* 
          LDA    FT          READ ACCOUNTING INFORMATION
          CRM    BUF,ON 
          LDD    EQ          SET EST ORDINAL
          RJM    C2D
          SHN    6
          STM    BUF+5*1+1
          LDD    EQ 
          SHN    -3 
          RJM    C2D
          STM    BUF+1*5
          UJN    ACT3        INITIALIZE ACCOUNT MESSAGE 
  
*         CHECK CM BUFFER.
  
 ACT1     RJM    COB         CHECK OUTPUT BUFFER
          SBN    2
          PJN    ACT2        IF ENOUGH DATA PRESENT 
          ABORT  ERBA        * QAP - BUFFER ARGUMENT ERROR.*
  
 ACT2     LDN    2           SET NUMBER OF WORDS TO READ
          STD    T3 
          LDC    BUF         READ BINARY BUFFER 
          RJM    RBB
          LDN    ZERL        UPDATE OUT 
          CRD    CM 
          LDD    OT 
          STD    CM+3 
          LDD    OT+1 
          STD    CM+4 
          LDA    IR+3 
          ADN    3
          CWD    CM 
  
*         INITIALIZE ACCOUNT FILE MESSAGE.
  
 ACT3     LDM    BUF+0*5+1   SET DEVICE TYPE
          SBN    TQTPL
          MJN    ACT4        IF VALID QUEUE TYPE CODE 
          ABORT  ERIR        * QAP - INCORRECT REQUEST.*
  
 ACT4     ADN    TQTPL       SET TABLE ADDRESS
          STD    FA 
          SHN    1
          ADD    FA 
          RAM    POFA 
          ADN    TOAU-TOAC
          STM    POFB 
          LDM    TQTP,FA     SET QUEUE TYPE PROCESSOR 
          STD    T1 
          LDC    1030        SET *EOI*
          STD    BS+4 
          RJM    0,T1 
          LJM    ACTX        RETURN 
          SPACE  4,10 
**        TOAC - TABLE OF ACCOUNTING CODES. 
  
  
 TOAC     BSS    0
          LOC    0
          VFD    36/4LUCLP
*         VFD    36/4LUCLV   (USER FORMAT SUPPLIED) 
          VFD    36/4LUCPC
          VFD    36/4LUCCR   (ISSUED BY *1AJ*)
          VFD    36/4LUCPL
          LOC    *O 
 TOAU     SPACE  4,10 
**        TOAU - TABLE OF ACCOUNTING UNITS. 
  
  
 TOAU     BSS    0
          LOC    0
          VFD    36/5LKLNS. 
          VFD    36/5LKCDS. 
          VFD    36/5LKCDS.  (ISSUED BY *1AJ*)
          VFD    36/5LKPLS. 
          LOC    *O 
 TQTP     SPACE  4,10 
**        TQTP - TABLE OF QUEUE TYPE PROCESSORS.
  
  
 TQTP     BSS    0
          LOC    0
          CON    POF         PRINT FILE PROCESSOR 
          CON    POF         PUNCH FILE PROCESSOR 
          CON    PIF         INPUT FILE PROCESSOR 
          CON    POF         PLOT FILE PROCESSOR
          LOC    *O 
 TQTPL    EQU    *-TQTP      NUMBER OF ACCOUNT MESSAGES 
          TITLE  ACCOUNTING SUBROUTINES.
 GCM      SPACE  4,15 
**        GCM - GENERATE CHARGE MESSAGES. 
* 
*         ENTRY  (T5) = EQUIPMENT.
*                (T6) = FIRST TRACK OF QUEUED FILE. 
* 
*         EXIT   (A) = ADDRESS OF TERMINATING MESSAGE SEGMENT.
*                (T5) = ASSEMBLY BUFFER ADDRESS.
* 
*         USES   T1, T5, T6, T7.
* 
*         CALLS  ACS, DFM, RSS. 
* 
*         MACROS ENDMS, SETMS.
  
  
 GCM2     LDC    GCMA        RETURN WITH ERROR MESSAGE
  
 GCM      SUBR               ENTRY/EXIT 
          SETMS  IO 
          LDN    0           READ SYSTEM SECTOR 
          RJM    RSS
          STD    T7          SAVE *RSS* REPLY 
          ENDMS 
          LDC    ACTB        SET ASSEMBLY BUFFER ADDRESS
          STD    T1 
          STD    T5 
          LDN    0
          STI    T1 
          LDC    =Z*ABUN, *  ENTER ACCOUNTING CODE IN BUFFER
          RJM    ACS
          LDD    T7 
          NJN    GCM2        IF SYSTEM SECTOR ERROR 
          LDM    ACSS+3      INSURE ZERO TERMINATOR 
          SCN    77 
          STM    ACSS+3 
          LDC    ACSS        SET CREATION USER NAME 
          STD    T7 
          LDI    T7 
          NJN    GCM1        IF USER NAME PRESENT 
          LDC    =Z*SYSTEMX*
          STD    T7 
 GCM1     LDD    T7          ENTER USER NAME
          RJM    ACS
          LDC    =Z*, *      SET SEPARATOR
          RJM    ACS
          LDM    FMSS+3      INSURE ZERO TERMINATOR 
          SCN    77 
          STM    FMSS+3 
          LDC    FMSS        ENTER FAMILY NAME
          RJM    ACS
          LDC    =Z*.*       ADD PERIOD 
          RJM    ACS
          LDC    AJNN+ACTA   ISSUE ACCOUNT FILE MESSAGE 
          RJM    DFM
          LDD    T5          RESET ASSEMBLY BUFFER ADDRESS
          STD    T1 
          LDC    PJSS        SET ADDRESS OF PROJECT NUMBER
          STD    T7 
          LDN    0
          STI    T1 
          LDC    =Z*ABCN, *  ENTER ACCOUNTING CODE
          RJM    ACS
          LDI    T7          SAVE LEADING CHARACTERS OF PROJECT NUMBER
          STD    T6 
          LDN    0
          STI    T7 
          STM    PJSS+2*5 
          LDC    CHSS        ENTER CHARGE NUMBER
          RJM    ACS
          LDC    =Z*, *      SET SEPARATOR
          RJM    ACS
          LDD    T6          RESTORE PROJECT NUMBER 
          STI    T7 
          LDD    T7          ENTER PROJECT NUMBER 
          RJM    ACS
          LDC    =Z*.*
          LJM    GCMX        RETURN 
  
 GCMA     DATA   C*SYSTEM SECTOR ERROR.*
          SPACE  4,10 
**        POF - PROCESS OUTPUT FILE ACCOUNTING. 
* 
*         ENTRY  (FA) = EQUIPMENT TYPE. 
*                (FO) = QFT ORDINAL.
* 
*         EXIT   (A) = 0. 
* 
*         USES   T1, T5, T6, T7, CM - CM+4, CN - CN+4.
* 
*         CALLS  ACS, DFM, GCM, GRU, IBE, RAM.
* 
*         MACROS MONITOR, SFA.
  
  
  
 POF      SUBR               ENTRY/EXIT 
          SFA    QFT,FO      GET JSN FOR MESSAGE
          ADK    JSNQ 
          CRM    ACTA,ON
          ADK    ENTQ-JSNQ-1 SET MASS STORAGE PARAMETERS
          CRD    T5 
          ADN    SCLQ-ENTQ   GET SERVICE CLASS
          CRD    CM 
          LDD    CM          SET SERVICE CLASS
          SHN    -6 
          STM    ACTA+4 
          LDM    BUF+1*5+3   SET END OF TERMINAL NAME 
          SCN    77 
          STM    BUF+1*5+3
          LDC    2R 
          STM    ACTA+2 
          STM    ACTA+3 
          RJM    GCM         GENERATE CHARGE MESSAGE
          RJM    ACS
          LDC    AJNN+ACTA   ISSUE ACCOUNTING MESSAGE 
          RJM    DFM
*         LDN    0
          STI    T5 
          RJM    GRU         GET RECORDS USED 
          LDD    CM+3 
          ADD    CM+4 
          NJN    POF0        IF VALID RECORD COUNT
          LDN    2           SET MINIMUM CHARGE 
          STD    CM+4 
 POF0     LDD    MA          SET RECORD COUNT 
          CWD    CM 
          CRM    IBEC,ON     PRESERVE BINARY RECORD COUNT 
          LDD    T5          RESET ASSEMBLY BUFFER ADDRESS
          STD    T1 
          LDC    TOAC        ENTER ACCOUNTING CODE
 POFA     EQU    *-1
          RJM    ACS
          LDC    =Z*, * 
          RJM    ACS
  
*         SET MID AND EQUIPMENT IF *BATCHIO*.  SET MID AND TERMINAL 
*         NAME IF NOT *BATCHIO*.
  
          LDC    MMFL        FETCH MACHINE ID 
          CRD    CM 
          LDC    2R,         SET TERMINATOR 
          STD    CM+1 
          LDN    0           TERMINATE MESSAGE STRING 
          STD    CM+2 
          LDN    CM          APPEND MID TO MESSAGE
          RJM    ACS
          LDC    BUF+1*5     SET TERMINAL NAME OR EQUIPMENT 
          RJM    ACS
          LDC    =Z*, *      SET SEPARATOR
          RJM    ACS
          LDN    0
          STD    CM+1 
          MONITOR RDCM       REQUEST DATA CONVERSION
*         LDN    0
          STM    BUF+2*5
          LDD    MA          READ DATA CONVERSION 
          CRM    BUF+1*5,ON 
          LDC    BUF+1*5     SET RECORD COUNT 
          RJM    ACS
          LDC    TOAU        ENTER ACCOUNTING UNITS 
 POFB     EQU    *-1
          RJM    ACS
 POF1     AOD    T1          CLEAR REMAINING PART OF BUFFER 
          ADC    -ACTC
          PJN    POF2        IF END OF BUFFER 
          LDN    0
          STI    T1 
          UJN    POF1        LOOP 
  
 POF2     LDC    ACTA+AJNN   ISSUE ACCOUNTING MESSAGE 
          RJM    DFM
          LDD    FA 
          NJN    POF4        IF NOT PRINT FILE
          RJM    RAM         RETURN ACCOUNTING MESSAGE TO CM BUFFER 
          LDD    MA 
          CRM    ACTA,ON     RESTORE MESSAGE HEADER 
 POF4     LDN    0
          STI    T5 
          LDD    T5          RESET ASSEMBLY BUFFER ADDRESS
          STD    T1 
          LDC    =Z*AESR, .* ISSUE NULL USAGE MESSAGE 
          RJM    ACS
          LDC    AJNN+ACTA   ISSUE ACCOUNTING MESSAGE 
          RJM    DFM
          LDN    EACT-ERRF   ISSUE BML ACCOUNTING MESSAGE 
          RJM    IBE
*         LDN    0
          LJM    POFX        RETURN 
 RAM      SPACE  4,10 
**        RAM - RETURN ACCOUNTING MESSAGE TO CM BUFFER. 
* 
*         ENTRY  *ACTA* = FWA OF ACCOUNTING MESSAGE.
* 
*         EXIT   ACCOUNT FILE MESSAGE RETURNED TO CM BUFFER.
*                BUFFER POINTERS UPDATED IN FET.
* 
*         USES   T1, CM - CM+4. 
* 
*         CALLS  CIB, WBB.
* 
*         MACROS ABORT. 
  
  
  
 RAM      SUBR               ENTRY/EXIT 
          RJM    CIB         CHECK INPUT BUFFER 
          ZJN    RAMX        IF BUFFER FULL 
          PJN    RAM1        IF NO ERROR
          ABORT  ERBA        * QAP - BUFFER ARGUMENT ERROR.*
  
 RAM1     STD    T1          SET WORD COUNT 
          SBN    ACTD/5 
          MJN    RAM2        IF LESS THAN MESSAGE LENGTH
          LDN    ACTD/5 
          STD    T1 
 RAM2     LDN    TIML        SET TIME 
          CRM    ACTA,ON
          LDD    BF 
          ZJN    RAM4        IF NOT *BATCHIO* CALL
          LDD    ET 
          LMK    LPDT 
          NJN    RAM3        IF NOT LINE PRINTER
          LDD    FP+1 
          NJN    RAM4        IF DAYFILE PRESENT 
 RAM3     LCN    1R -1R1
          SHN    6           SET PAGE EJECT 
          RAM    ACTA 
 RAM4     LDC    ACTA        WRITE BINARY BUFFER
          RJM    WBB
          LDN    ZERL        UPDATE IN
          CRD    CM 
          LDD    IN 
          STD    CM+3 
          LDD    IN+1 
          STD    CM+4 
          LDA    IR+3        WRITE IN 
          ADN    2
          CWD    CM 
          LJM    RAMX        RETURN 
 PIF      SPACE  4,10 
**        PIF - PROCESS INPUT FILE ACCOUNTING.
* 
*         ENTRY  (BF) = BUFFER POINT ADDRESS. 
*                (ES - ES+4) = EST ENTRY. 
* 
*         EXIT   *DSP* PARAMETER BLOCK SET. 
*                (A) = *DSP*. 
*                FNT POINTER IN FET CLEARED.
*                *UCCR* ACCOUNTING MESSAGE ISSUED BY *1AJ*. 
* 
*         USES   T1, T2, CM - CM+4. 
* 
*         CALLS  C2D, IBE, *DSP*. 
* 
*         MACROS EXECUTE. 
  
  
 PIF      SUBR               ENTRY/EXIT 
          LDD    BF 
          ZJN    PIFX        IF NOT *BATCHIO* CALL
  
*         INITIALIZE *DSP* PARAMETER BLOCK. 
  
          LDA    IR+3        SET FILE NAME FROM FET 
          CRM    DSPB,ON
          ADN    4-1         READ *LIMIT* WORD
          CRD    CM 
          LDC    DSPB+4      CLEAR *DSP* PARAMETER BLOCK
          STD    T1 
 PIF1     LDN    0
          STI    T1 
          AOD    T1 
          LMC    DSPB+DSPBL*5 
          NJN    PIF1        IF MORE TO CLEAR 
          STD    CM          CLEAR FNT POINTER
          STD    IR+2 
  
*         ENTER *DSP* PARAMETERS. 
  
          LDC    200         SET QUEUE FILE IF JOB COMMAND ERROR
          STM    DSPB+1*5+1 
          LDC    2RIN        SET DISPOSITION CODE 
          STM    DSPB+1*5+2 
          LDK    FRAC/10000  SET ACCOUNTING FLAG
          STM    DSPB+1*5+3 
          LDK    FRDC+FRCS+FRTI  SET DISP., CENTRAL SITE, TID FLAGS 
          STM    DSPB+1*5+4 
          LDM    BUF+3       SET RECORDS USED 
          STM    DSPB+5*5+3 
          STM    IBEC+3 
          LDM    BUF+4
          STM    DSPB+5*5+4 
          STM    IBEC+4 
          LDM    BUF+1*5+0   SET EQUIPMENT IDENTIFICATION 
          STM    DSPB+6*5+0 
          LDM    BUF+1*5+1
          STM    DSPB+6*5+1 
          LDD    ES+4        SET ID FOR OUTPUT FILES
          LPN    77 
          STM    DSPB+2*5+4 
          LDD    FP+1 
          ZJN    PIF2        IF NO BINARY SEQUENCE/HOLLERITH ERRORS 
          STM    DSPB+5*5+1 
          LDD    FP+2        SET RECORD NUMBER
          LPC    3777 
          STM    DSPB+5*5 
          LDD    FP+2        SET FORCED ABORT CODE
          SHN    0-13 
          ADN    BCIE 
          ERRNZ  BCIE+1-HDIE CODE DEPENDS ON VALUE
          STM    DSPB+4*5+2 
          LDD    HN          SET BINARY SEQUENCE/HOLLERITH ERROR FLAG 
          RAM    DSPB+1*5+1 
  
*         CALL *DSP* INTO THIS PP.
  
 PIF2     LDN    DSPBL       WRITE *DSP* PARAMETER BLOCK
          STD    T1 
          ADN    QAPO-1 
          STD    T2 
          RJM    VCA         VALIDATE CENTRAL ADDRESS 
          LDA    IR+3 
          CWD    BS 
          ADN    4
          CWD    CM 
          ADN    QAPO-4      STORE PARAMETER BLOCK
          CWM    DSPB,T1
          LDN    QAPO        SET *DSP* PARAMETER BLOCK ADDRESS
          RAD    IR+4 
          SHN    -14
          RAD    IR+3 
          LDN    EACT-ERRF   ISSUE BML ACCOUNTING MESSAGE 
          RJM    IBE
          EXECUTE DSP,* 
          LJM    PIFX        RETURN 
 GRU      SPACE  4,10 
**        GRU - GET RECORDS USED. 
* 
*         ENTRY  (BUF+3 - BUF+4) = UNIT RECORD COUNT. 
*                (FP - FP+4) = FILE PARAMETER WORD (FET+5). 
*                (F6 - F6+4) = FILE PARAMETER WORD (FET+6). 
* 
*         EXIT   (CM+2 - CM+4) = NUMBER OF RECORDS USED.
  
  
 GRU      SUBR               ENTRY/EXIT 
          LDN    ZERL 
          CRD    CM 
          LDM    BUF+0*5+3
          STD    CM+3 
          LDM    BUF+0*5+4
          STD    CM+4 
          LDD    BF 
          ZJN    GRUX        IF NOT *BATCHIO* CALL
          LDD    FP+3        CHECK NORMAL FORMAT IMAGE ALTERED
          ZJN    GRU1        IF NO USER SUPPLIED FORMS CONTROL
          LDN    1RV-1RP     MODIFY ACCOUNTING MESSAGE
          RAM    TOAC+1 
 GRU1     LDD    F6+3        CHECK FOR UNLIMITED USER 
          LMC    7777 
          ZJN    GRU3        IF UNLIMITED USER
          LDD    CM+3        CHECK FOR POSITIVE RECORD COUNT
          SHN    21-13
          PJN    GRU3        IF POSITIVE RECORD COUNT 
  
*         CALCULATE RECORD COUNT FOR LIMITED USER WITH NEGATIVE RECORD
*         COUNT.
  
          LCN    0
          LMD    CM+3 
          LPC    7777 
          ADD    F6+3 
          STD    CM+3 
          LCN    0
          LMD    CM+4 
          LPC    7777 
          ADD    F6+4 
          STD    CM+4 
          SHN    -14
          RAD    CM+3 
 GRU2     LJM    GRUX        RETURN 
  
*         CALCULATE RECORDS USED FOR UNLIMITED USER OR
*         LIMITED USER WITH POSITIVE RECORD COUNT.
  
 GRU3     LDD    F6+3        CALCULATE RECORDS USED 
          SBD    CM+3 
          STD    CM+3 
          LDD    F6+4 
          SBD    CM+4 
          STD    CM+4 
          PJN    GRU2        IF NO UNDERFLOW, RETURN
          AOD    CM+4 
          SOD    CM+3 
          UJN    GRU2        RETURN 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPRSS 
          SPACE  4,10 
          USE    LITERALS 
  
  
          OVERFLOW  OVL 
 DSPB     SPACE  4,10 
**        DSPB - *DSP* PARAMETER BLOCK BUFFER.
  
  
 DSPB     EQU    *           *DSP* PARAMETER BLOCK BUFFER FWA 
 BUF      EQU    DSPB+DSPBL*5  ACCOUNT INFORMATION BUFFER 
 ACTA     EQU    BUF+3*5     JSN BUFFER 
 ACTB     EQU    ACTA+5      ACCOUNT MESSAGE BUFFER 
 ACTC     EQU    ACTB+5*4    END OF ACCOUNT MESSAGE BUFFER
 ACTD     EQU    ACTC-ACTA   LENGTH OF ACCOUNTING MESSAGE 
  
          ERRPL  ACTB-BFMS   MESSAGE HEADER OVERLAID WITH SYSTEM SECTOR 
          QUAL   *
          TTL    QAP/3BB - LOAD PFC ARRAY.
          TITLE 
          QUAL   LPM
          IDENT  3BB,LPMX    LOAD PRINTER PFC IMAGE MEMORY
*COMMENT  QAP - LOAD PRINTER PFC IMAGE MEMORY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 LPM      SPACE  4,10 
***       LPM  - LOAD PFC IMAGE MEMORY. 
          SPACE  4,10 
**        ENTRY CONDITIONS. 
* 
*         (BF) = BUFFER POINT ADDRESS.
*         (EQ) = EST ORDINAL. 
*         (BS+4) = REQUEST. 
*         (IR+3 - IR+4) = FET ADDRESS.
*         (OT - OT+1) = OUT POINTER.
*         (ES - ES+4) = EST ENTRY.
*         (FP - FP+4) = FILE PARAMETER WORD (FET+5).
*         (F6 - F6+4) = FILE PARAMETER WORD (FET+6).
          SPACE  4,10 
*CALL     COMPCHI 
          SPACE  4,10 
**        ASSEMBLY CONSTANT.
  
  
 CH       EQU    12          CHANNEL NUMBER 
          SPACE  4,10 
**        MACRO DEFINITIONS.
  
  
**        TABL - DEFINE PFC OVERLAY TABLE.
* 
*         CALL -
*         TABL   A,B
* 
*         WHERE  A IS THE SPACING CODE (SC PARAMETER) AND B IS
*                THE PFC OVERLAY NAME.  THE SC PARAMETER CAN
*                BE ANY 6 BIT VALUE FROM 1 TO 77B.  B IS A 12 BIT 
*                OVERLAY NAME.
  
  
 TABL     MACRO  A,B
          CON    A
          CON    2L_B 
          ENDM
          SPACE  4,10 
**        DPFC - DEFINE PFC CODES.
* 
*         CALL -
*         DPFC   A,B,C,D
*         WHERE  A,B,C AND D ARE PFC CODES FOR 6 OR 
*                8 LPI.  THESE CODES MAY BE ANY VALUE 
*                FROM ZERO (0) TO FIFTEEN (17B).
  
  
 DPFC     MACRO  A,B,C,D
          VFD    6/A,6/B
          IFEQ   A,17,1 
          SKIP
          IFNE   B,17,1 
          VFD    6/C,6/D
          ENDIF 
          ENDM
          TITLE  MAIN PROGRAM.
          SPACE  4
**        LPM - MAIN ROUTINE. 
  
  
          ORG     OVL 
  
 LPM      SUBR               ENTRY/EXIT 
          LDK    PPCP 
          CRD    CM 
          LDD    IA          INPUT REGISTER ADDRESS 
          SBD    CM+4        FWA OF PP COMMUNICATIONS AREA
          SHN    0-3
          STM    ERRB        PP NUMBER
          LDD    BS+4        CHECK REQUEST
          LMC    PFCF 
          NJN    LPM1        IF NOT USER PFC LOAD 
          EXECUTE 3BF 
  
*         *3BF* DOES NOT RETURN HERE. 
  
 LPM1     LDD    FG          GET BATCHIO FLAGS
          LPN    10          SHORT PAPER FLAG 
          SHN    6-3         ADD 100B TO SPACE CODE IF SHORT PAPER
          STD    T1 
          LDA    IR+3        FETCH SPACING CODE PARAMETER 
          ADN    4
          CRD    CM 
          LDD    CM+2 
          LPN    77 
 LPM1.1   ADD    T1          SC + 100B = SHORT PAPER CODE 
          STD    T5 
          LDN    0           CLEAR USER FORMS CONTROL INDICATOR 
          STD    FP+3 
          STD    T2          INITIALIZE TABLE POINTER 
 LPM2     LDD    T5 
          LMM    PFCO,T2     COMPARE ENTRY
          ZJN    LPM3        IF MATCH 
          LDN    2           ADVANCE TABLE INDEX
          RAD    T2 
          LMN    PFCOL
          NJN    LPM2        IF NOT END OF TABLE
          UJN    LPM1.1      SET DEFAULT SPACING CODE 
  
 LPM3     LDM    PFCO+1,T2   SET OVERLAY NAME 
          LMC    1L5
          EXECUTE 5BA,= 
          EXECUTE 5BB,= 
          EXECUTE 5BC,= 
          EXECUTE 5BD,= 
          RJM    EXR         LOAD OVERLAY 
          STD    T5          SET LENGTH OF 8 LPI IMAGE
          RJM    CON         CONNECT EQUIPMENT
          RJM    FCP         FIND 6/8 COINCIDENT POINT
          LDN    17          LOAD 8 LPI IMAGE 
          RJM    LPI
          STM    LL8L 
          LDD    T5          SET START OF 6 LPI ARRAY 
          RAM    LPIA 
          LDD    T7          SET LENGTH OF 6 LPI ARRAY
          STD    T5 
          RJM    WNB         WAIT INITIALIZATION COMPLETE 
          LDN    16          LOAD 6 LPI IMAGE 
          RJM    LPI
          STM    LL6L 
          RJM    WNB         WAIT INITIALIZATION COMPLETE 
          RJM    RAD         RELEASE AND DISCONNECT 
          LDD    ES          CHECK USER PFC IMAGE ON LAST JOB 
          SHN    21-6 
          MJN    LPM4        IF USER FORMS CONTROL
          LDD    T3          CHECK NUMBER OF SINGLE SPACES
          LMN    5
          ZJN    LPM5        IF ONE LINE ADVANCE TO COINCIDENT POINT
 LPM4     LDD    ES          CLEAR USER FORMS CONTROL INDICATOR 
          LPC    7677 
          STD    ES 
          SFA    EST,EQ      STORE EST ENTRY
          ADK    EQDE 
          CWD    ES 
          NFA    BF,R        READ BUFFER POINT WORD 
          ADN    1
          CRD    CM 
          LDN    ECPA        SET MESSAGE *CHECK PAPER ALIGNMENT*
          STD    CM 
          NFA    BF,R        STORE MESSAGE CODE 
          ADN    1
          CWD    CM 
          LDD    CP          STORE *B* DISPLAY MESSAGE
          ADN    MS2W 
          CWM    LPMA,TR
          LDN    4           INDICATE PRINTER HOLDING TO DRIVER 
          RAD    BS+4 
 LPM5     LJM    LPMX        EXIT 
  
 LPMA     DATA   C+$REQUEST *I* DISPLAY.+ 
          TITLE  SUBROUTINES. 
 CON      SPACE  4,10 
**        CON - CONNECT EQUIPMENT.
* 
*         ENTRY  (ES - ES+4) = EST ENTRY. 
* 
*         EXIT   EQUIPMENT CONNECTED. 
*                CHANNEL RESERVED.
* 
*         USES   FC, T1, T2.
* 
*         CALLS  GST, IFN.
* 
*         MACROS RCHAN. 
  
  
 CON4     DCN    CH+40
          RJM    GST         GET STATUS OF 6681 AND EQUIPMENT 
  
 CON      SUBR               ENTRY/EXIT 
          LDC    TCHS 
          STD    T1 
          UJN    CON2        MODIFY CHANNEL INSTRUCTIONS
  
 CON1     RAI    T2 
          AOD    T1 
 CON2     LDI    T1 
          STD    T2 
          LDD    ES+1 
          LPN    37 
          CHTL   *
          SBN    CH 
          NJN    CON1        IF MORE CHANNEL INSTRUCTIONS TO MODIFY 
          LDD    ES+1        RESERVE CHANNEL
          RCHAN 
          LDN    10          SELECT MODE II CONNECT 
          RJM    IFN
          LDD    ES+4        OUTPUT CONNECT CODE
          LPC    7000        SAVE CONNECT CODE
          STD    FC 
          OAN    CH+40
          LCN    0           TIME OUT CONNECT 
 CON3     EJM    CON4,CH     IF CONNECT RESPONSE RECEIVED 
          SBN    1
          NJN    CON3        IF NOT TIMED OUT 
          LDN    EFTM        *FUNCTION TIMEOUT* ERROR 
*         LJM    ERR         PROCESS ERROR
 ERR      SPACE  4,10 
**        ERR - ERROR PROCESSOR.
* 
*         ENTRY  (A) = ERROR CODE.
*                (ES+1) = CHANNEL (RESERVED). 
* 
*         EXIT   (FET+6) SET WITH ERROR STATUS. 
* 
*         CALLS  WSB. 
* 
*         MACROS DCHAN, NFA.
  
  
 ERR      STM    ERRA+1      STORE ERROR CODE 
          IJM    ERR1,CH     IF CHANNEL INACTIVE
          DCN    CH+40
 ERR1     LDD    FC          SET FUNCTION CODE
          STM    ERRA+4 
          NFA    BF,R        STORE SECOND BUFFER POINT WORD 
          ADN    1
          CWM    ERRA,ON
 ERR2     LDD    ES+1        RELEASE CHANNEL
          DCHAN 
          LDA    IR+3        STORE FILE PARAMETER WORD
          ADN    FPW2 
          CWD    F6 
          RJM    WSB         CLEAR STATUS BLOCK INTERLOCK (IF SET)
          LDC    CECF        CHANGE REQUEST TO *CHANNEL ERROR*
 ERRC     EQU    *-1
*         LDC    CECF+4000   REQUEUE FILE ON READY DROP 
          STD    BS+4 
          LJM    CEC         PROCESS HARDWARE ERROR / REQUEUE FILE
  
 ERRA     CON    EOHE 
          CON    0           ERROR CODE 
          CON    0
 ERRB     CON    0           PP NUMBER
 FCN      SPACE  4,10 
**        FCN - ISSUE FUNCTION TO EQUIPMENT.
* 
*         ENTRY  (A) = FUNCTION CODE. 
* 
*         EXIT   FUNCTION COMPLETED.
*                IF THE FUNCTION IS NOT ACCEPTED AND A FUNCTION 
*                TIMEOUT OCCURS, EXIT IS MADE TO *ERR*. 
* 
*         USES   FC, T6.
* 
*         CALLS  ERR, GST.
  
  
 FCN3     RJM    GST         GET 6681 AND EQUIPMENT STATUS
          ZJN    FCNX        IF NO ERRORS RETURN
          LDN    ERJM        REJECT/TRANSMISSION PARITY ERROR 
          UJN    FCN2        PROCESS ERROR
  
 FCN      SUBR               ENTRY/EXIT 
          FAN    CH          ISSUE FUNCTION 
          STD    FC          SAVE FUNCTION
          LCN    0           SET TIMEOUT LIMIT
 FCN1     IJM    FCN3,CH     IF FUNCTION ACCEPTED 
          SBN    1
          NJN    FCN1        IF NOT TIMED OUT 
          LDN    EFTM        *FUNCTION TIMEOUT* 
 FCN2     LJM    ERR         PROCESS ERROR
 FCP      SPACE  4,10 
**        FCP - FIND 6/8 LINE COINCIDENT POINT. 
* 
*         ENTRY  (EQ) = EST ORDINAL.
*                (ES - ES+4) = EST ENTRY. 
* 
*         EXIT   (T3) = SINGLE LINE SPACE INDICATOR.
*                BIT 6 SET IN (ES) IF PAPER ALIGNMENT CHECK REQUIRED. 
*                PRINTER AT 6/8 LINE COINCIDENT POINT.
* 
*         CALLS  FCN, GMS, WNB. 
* 
*         MACROS SFA. 
  
  
 FCP      SUBR               ENTRY/EXIT 
          LDN    6           SET SINGLE SPACE LIMIT 
          STD    T3 
          RJM    WNB         WAIT NOT BUSY
          LDN    30          DESELECT AUTO EJECT
          RJM    FCN
          RJM    GMS         GET MAINTENANCE STATUS 
          LPN    2
          NJN    FCP3        IF PFC ERROR 
          LDD    FG          CHECK FOR PFC SIZE CHANGE
          SHN    10-3        LAST PFC BIT 
          LMD    ES          COMPARE WITH CURRENT PFC 
          SHN    21-10
          PJN    FCP0        IF PAPER SIZE HAS NOT CHANGED
          LDD    ES 
          LPC    7677        SET USER PFC FLAG
          LMC    500         CHANGE LAST PFC BIT
          STD    ES 
 FCP0     LDD    ES          CHECK FOR USER PFC 
          SHN    21-6 
          MJN    FCP2        IF USER FORMS CONTROL
          LDN    61          SKIP TO CHANNEL 9
 FCP1     RJM    FCN
          RJM    WNB         WAIT NOT BUSY
 FCP2     LDD    ST          CHECK STATUS 
          SHN    21-13
          MJP    FCPX        IF 6-8 LINE COINCIDENT 
          SOD    T3 
          ZJN    FCP4        IF SINGLE SPACE LIMIT
          LDN    1           SELECT SINGLE SPACE
          UJN    FCP1        ISSUE FUNCTION 
  
 FCP3     LDD    ES          SET PAPER ALIGNMENT CHECK
          LPC    7677 
          LMD    HN 
          STD    ES 
          LDD    ST          CHECK EQUIPMENT READY
          LPN    1
          NJN    FCP2        IF NOT ERROR 3 (READY DROP)
 FCP4     SFA    EST,EQ      STORE EST ENTRY
          ADK    EQDE 
          CWD    ES 
          LJM    LPI1        SET *PFC ERROR*
 GMS      SPACE  4,10 
**        GMS - GET MAINTENANCE STATUS. 
* 
*         EXIT   (A) = PFC STATUS.
*                (T2) = MAINTENANCE STATUS. 
* 
*         CALLS  FCN. 
  
  
 GMS      SUBR               ENTRY/EXIT 
          LDN    65          SELECT MAINTENANCE STATUS MODE 
          RJM    FCN
          LDD    ST          SAVE MAINTENANCE STATUS
          STD    T2 
          LDN    66          CLEAR MAINTENANCE STATUS MODE
          RJM    FCN
          LDD    T2          EXTRACT PFC STATUS 
          SHN    6+3
          LPN    3
          UJN    GMSX        RETURN 
 GST      SPACE  4,10 
**        GST - GET STATUS OF 6681 AND EQUIPMENT. 
* 
*         EXIT   (A) = BITS 0 - 2 OF 6681 STATUS. 
*                (CS) = 6681 STATUS.
*                (ST) = EQUIPMENT STATUS. 
*                IF FUNCTION 65 WAS PREVIOUSLY ISSUED,
*                (ST) WILL CONTAIN THE MAINTENANCE STATUS.
* 
*         CALLS  RST. 
  
  
 GST      SUBR               ENTRY/EXIT 
          LDN    13          GET EQUIPMENT STATUS 
          RJM    RST
          LDN    12          GET CONVERTER STATUS 
          RJM    RST
          LDD    CS          CHECK CONVERTER STATUS 
          LPN    7
          UJN    GSTX        RETURN 
 IFN      SPACE  4,10 
**        IFN - ISSUE FUNCTION TO CONVERTER.
* 
*         ENTRY  (A) = FUNCTION CODE/100. 
* 
*         EXIT   (T1) = FUNCTION CODE.
*                CHANNEL ACTIVE.
* 
*         USES   T1, FC.
* 
*         CALLS  ERR. 
  
  
 IFN2     ACN    CH 
  
 IFN      SUBR               ENTRY/EXIT 
          SHN    6
          FAN    CH          ISSUE FUNCTION 
          STD    T1          SAVE FUNCTION CODE 
          LDN    6
 IFN1     IJM    IFN2,CH     IF FUNCTION ACCEPTED 
          SBN    1
          NJN    IFN1        IF NOT TIMED OUT 
          LDD    T1 
          STD    FC 
          LDN    EFTM        *FUNCTION TIMEOUT* ERROR 
          LJM    ERR         PROCESS ERROR
 LPI      SPACE  4,10 
**        LPI - LOAD PFC IMAGE. 
* 
*         ENTRY  (A) = FUNCTION CODE FOR 6/8 LPI. 
*                (T5) = LENGTH OF PFC IMAGE.
* 
*         EXIT   (A) = VALUE ON RETURN FROM *SBF*.
*                TO *ERR* IF ERROR. 
* 
*         USES   FC.
* 
*         CALLS  ERR, FCN, GST, GMS, IFN, SBF.
  
  
 LPI5     LDN    13          SELECT EXTENDED ARRAY MODE 
          RJM    FCN
          RJM    SBF         DETERMINE LINE LIMIT FOR PAGE
  
 LPI      SUBR               ENTRY/EXIT 
          RJM    FCN         ISSUE FUNCTION 
          LDN    14          CLEAR EXTENDED ARRAY MODE
          RJM    FCN
          LDN    24          SELECT ABNORMAL *EOP* INTERRUPT
          RJM    FCN
          LDN    16          OUTPUT IMAGE ARRAY 
          RJM    IFN
          LDD    T5          WORD COUNT 
          OAM    BFMS,CH
 LPIA     EQU    *-1
          NJN    LPI3        IF INCOMPLETE DATA TRANSFER
          FJM    *,CH 
          DCN    CH+40
          RJM    GST         GET 6681 AND EQUIPMENT STATUS
          NJN    LPI4        IF ERROR 
          RJM    GMS         GET MAINTENANCE STATUS 
          ZJN    LPI5        IF NO ERROR
  
*         ENTERED HERE FROM *FCP*.
  
 LPI1     LDD    T2          SET MAINTENANCE STATUS 
          STD    FC 
          LDN    EPFC        *PFC ERROR*
 LPI2     LJM    ERR         PROCESS ERROR
  
 LPI3     STD    CS          STORE NUMBER OF UNTRANSFERED BYTES 
          LDN    EITM        *INCOMPLETE TRANSFER*
          UJN    LPI2        PROCESS ERROR
  
 LPI4     LDN    ERJM        REJECT/TRANSMISSION PARITY ERROR 
          UJN    LPI2        PROCESS ERROR
 PCP      SPACE  4,10 
**        PCP - PROCESS CHANNEL PARITY. 
* 
*         ENTRY  (A) = RECOVERY FLAG. 
*                (T1) = FUNCTION CODE.
* 
*         EXIT   TO *ERR2* IF UNRECOVERED ERROR.
* 
*         USES   CM - CM+4. 
* 
*         CALLS  CEC, PDF.
  
  
 PCP      SUBR               ENTRY/EXIT 
          SHN    14 
          LMM    EQSB+CMCP   FORM RETRY COUNT + RECOVERY FLAG 
          SHN    6
          STD    CM+2 
          LDN    ECLE        SET *I* DISPLAY MESSAGE CODE 
          STD    CM 
          LDN    ECRE        SET DAYFILE MESSAGE CODE 
          STD    CM+1 
          LDM    ERRB        SET PP NUMBER
          STD    CM+3 
          LDD    T1          SET FUNCTION CODE
          STD    CM+4 
          NFA    BF,R        STORE SECOND BUFFER POINT WORD 
          ADN    1
          CWD    CM 
          LDD    CM+2 
          LPN    1
          NJN    PCP1        IF UNRECOVERED ERROR 
          STM    EQSB+CMCP   SET NUMBER OF TRIES TO ZERO
          LDC    PCPX        SET RETURN ADDRESS 
          STM    PDFA 
          LJM    PDF1        ISSUE ERROR MESSAGE
  
 PCP1     LJM    ERR2        PROCESS UNRECOVERED ERROR
 RAD      SPACE  4,10 
**        RAD - RELEASE AND DISCONNECT. 
* 
*         ENTRY  (ES+1) = CHANNEL (RESERVED). 
* 
*         EXIT   CHANNEL RELEASED.
* 
*         CALLS  FCN. 
* 
*         MACROS DCHAN. 
  
  
 RAD      SUBR               ENTRY/EXIT 
          LDN    0           CLEAR AND DISCONNECT 
          RJM    FCN
          LDD    ES+1 
          DCHAN 
          UJN    RADX        RETURN 
 RST      SPACE  4,15 
**        RST - READ STATUS.
* 
*         ENTRY  (A) = 12 IF REQUESTING CONVERTER STATUS. 
*                    = 13 IF REQUESTING EQUIPMENT STATUS. 
* 
*         EXIT   (CS) = CONVERTER STATUS IF REQUESTED.
*                (ST) = EQUIPMENT STATUS IF REQUESTED.
* 
*         USES   CM, T4.
* 
*         CALLS  IFN, PCP.
  
  
 RST2     AOM    EQSB+CMCP   ADVANCE RETRY COUNT
          SBN    CHPR 
          MJN    RST1        IF NOT AT RETRY LIMIT
          LDN    1
 RST3     RJM    PCP         PROCESS PARITY ERROR 
  
 RST      SUBR               ENTRY/EXIT 
          STD    CM 
          SBN    12          SET STATUS INDEX 
          STD    T4 
 RST1     LDD    CM          ISSUE CONVERTER FUNCTION 
          RJM    IFN
          IAN    CH+40       INPUT STATUS 
          DCN    CH+40
          ERRNZ  CS+1-ST     CODE DEPENDS ON VALUE
          STM    CS,T4
          SFM    RST2,CH     IF CHANNEL PARITY ERROR
          LDM    EQSB+CMCP
          ZJN    RSTX        IF NO PREVIOUS ERROR 
          LDN    0
          UJN    RST3        PROCESS RECOVERED PARITY ERROR 
 SBF      SPACE  4,10 
**        SBF - SEARCH PFC ARRAY FOR BOTTOM OF FORM.
* 
*         ENTRY  (T5) = LENGTH OF PFC ARRAY.
*                (LPIA) = FWA OF ARRAY. 
* 
*         EXIT   (A) = NUMBER OF LINES TO BOTTOM OF FORM. 
*                    = 0 IF FORMAT CHANNEL 12 UNDEFINED.
* 
*         USES   T1, T2, T4.
  
  
 SBF2     LDD    T4          (A) = LINE COUNT TO BOTTOM OF FORM 
  
 SBF      SUBR               ENTRY/EXIT 
          LDM    LPIA 
          STD    T1          SET FWA OF ARRAY 
          ADD    T5 
          STD    T2          SET END OF ARRAY 
          LDN    1
          STD    T4 
 SBF1     LDI    T1          CHECK UPPER CHARACTER
          SHN    -6 
          LMN    12D
          ZJN    SBF2        IF BOTTOM OF FORM (FORMAT CHANNEL 12)
          AOD    T4 
          LDI    T1          CHECK LOWER CHARACTER
          LPN    77 
          LMN    12D
          ZJN    SBF2        IF BOTTOM OF FORM
          AOD    T4 
          AOD    T1          ADVANCE ARRAY ADDRESS
          LMD    T2 
          NJN    SBF1        IF NOT END OF ARRAY
*         LDN    0
          UJN    SBFX        RETURN 
 WNB      SPACE  4,10 
**        WNB - WAIT NOT BUSY.
* 
*         USES   T6.
* 
*         CALLS  ERR, GST.
  
 WNB      SUBR               ENTRY/EXIT 
          LDN    14 
          STM    WNBA        SET COUNTER
 WNB1     LDD    TH 
          STD    T6 
 WNB2     RJM    GST         GET EQUIPMENT STATUS 
          LDD    ST          CHECK STATUS 
          LPN    3
          LMN    1
          ZJN    WNBX        IF NOT BUSY AND READY
          DELAY 
          SOD    T6          INCREMENT COUNTER
          NJN    WNB2        LOOP 
          SOM    WNBA 
          NJN    WNB1        LOOP 
          LDD    ST          CHECK FOR READY DROP 
          LPN    1
          LMN    1
          ZJN    WNB3        IF NOT READY DROP
          SHN    13-0 
          RAM    ERRC 
          LDN    ENRD 
          STM    ERRA 
          LDN    ECBM 
 WNB3     LMN    ECBM        *CONTROLLER HUNG BUSY* 
          LJM    ERR         PROCESS ERROR
  
 WNBA     CON    14          CAUSE MINIMUM DELAY OF 750 MS
 TCHS     SPACE  4,10 
**        TCHS - CHANNEL TABLE. 
*         TABLE CONTAINS THE ADDRESSES OF ALL INSTRUCTIONS WHICH
*         REFERENCE THE EQUIPMENT CHANNEL.
  
  
 TCHS     CHTB
  
  
          USE LITERALS
  
 OPFC     EQU    *+5         LOAD ADDRESS FOR *3BF* 
 PFCO     SPACE  4,10 
**        PFCO - PFC IMAGE ARRAY OVERLAY TABLE.  EACH ENTRY 
*         CONSIST OF TWO WORDS.  THE FIRST IS THE SPACING 
*         CODE(SC PARAMETER) CHARACTER AND THE SECOND WORD
*         IS THE OVERLAY NAME CONTAINNING THE SPECIFIED 
*         PFC IMAGE ARRAY.
* 
*         FOR PRINTERS WHICH PRINT 8 LINES PER INCH  ON SHORT PAPER,
*         100B IS ADDED TO THE SPACING CODE SPECIFIED IN THE FET, 
*         ALLOWING THE CORRECT PFC TO BE LOADED WHILE SPECIFYING THE
*         SAME SPACING CODE FOR EITHER SIZE PAPER.  THUS, IF SC IS THE
*         SPACING CODE FOR LONG PAPER, SC+100B IS THE SPACING CODE FOR
*         SHORT PAPER.
  
 PFCO     TABL   0,BA 
*         TABL   1,BA        (EQUIVALENT TO DEFAULT)
          TABL   2,BB 
          TABL   100,BC 
*         TABL   101,BC      (EQUIVALENT TO DEFAULT)
          TABL   102,BD 
 PFCOL    EQU    *-PFCO      END OF OVERLAY TABLE.
          ERRPL  *-BFMS 
          TTL    QAP/3BB/5BA PFC IMAGE ARRAY TABLE. 
          TITLE  DEFAULT 580 PFC IMAGE ARRAY. 
          QUAL   5BA
          IDENT  5BA,PFCX    580 PFC IMAGE ARRAY
*COMMENT  QAP - 580 PFC IMAGE ARRAY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 PFC      SPACE  4,10 
          ORG    BFMS-7 
 PFC      SUBR               ENTRY/EXIT 
          LDC    TPF6L       SET LENGTH OF 6 LPI ARRAY
          STD    T7 
          ADN    TPF8L-TPF6L (A) = LENGTH OF 8 LPI ARRAY
          UJN    PFCX        EXIT 
 TPFC     SPACE  4,10 
*         8 LINES PER INCH ARRAY. 
  
 TPFC     BSS    0
 TPF8     DPFC   1,6,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   12D,0,0,0
          DPFC   1,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   12D,0,0,9D 
          DPFC   17,0 
 TPF8L    EQU    *-TPF8 
  
*         6 LINES PER INCH ARRAY. 
  
 TPF6     DPFC   1,6,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,12D
          DPFC   0,0,1,0
          DPFC   0,2,0,0
          DPFC   3,0,0,4
          DPFC   0,0,5,0
          DPFC   0,2,0,0
          DPFC   3,0,0,4
          DPFC   0,0,5,0
          DPFC   0,2,0,0
          DPFC   3,0,0,4
          DPFC   0,0,5,0
          DPFC   0,2,0,0
          DPFC   3,0,0,4
          DPFC   0,0,5,0
          DPFC   0,2,0,0
          DPFC   3,0,0,4
          DPFC   0,0,5,0
          DPFC   0,12D,0,9D 
          DPFC   17,0 
 TPF6L    EQU    *-TPF6 
  
          ERRNZ  TPFC-BFMS
          TTL    QAP/3BB/5BB  PFC IMAGE ARRAY TABLE.
          TITLE  ALTERNATE 580 PFC IMAGE ARRAY. 
          QUAL   5BB
          IDENT  5BB,PFCX    ALTERNATE 580 PFC IMAGE ARRAY
*COMMENT  QAP - ALTERNATE 580 PFC IMAGE ARRAY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 PFC      SPACE  4,10 
          ORG    BFMS-7 
 PFC      SUBR               ENTRY/EXIT 
          LDC    TPF6L       SET LENGTH OF 6 LPI ARRAY
          STD    T7 
          ADN    TPF8L-TPF6L (A) = LENGTH OF 8 LPI ARRAY
          UJN    PFCX        EXIT 
 TPFC     SPACE  4,10 
*         8 LINES PER INCH ARRAY. 
  
 TPFC     BSS    0
 TPF8     DPFC   1,6,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   7,0,0,0
          DPFC   8D,0,0,0 
          DPFC   10D,0,0,0
          DPFC   11D,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   7,0,0,0
          DPFC   8D,0,0,0 
          DPFC   10D,0,0,0
          DPFC   11D,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   12D,0,0,0
          DPFC   1,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   7,0,0,0
          DPFC   8D,0,0,0 
          DPFC   10D,0,0,0
          DPFC   11D,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   7,0,0,0
          DPFC   8D,0,0,0 
          DPFC   10D,0,0,0
          DPFC   11D,0,0,0
          DPFC   2,0,0,0
          DPFC   3,0,0,0
          DPFC   4,0,0,0
          DPFC   5,0,0,0
          DPFC   12D,0,0,9D 
          DPFC   17,0 
 TPF8L    EQU    *-TPF8 
  
*         6 LINES PER INCH ARRAY. 
  
 TPF6     DPFC   1,6,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,7
          DPFC   0,0,8D,0 
          DPFC   0,10D,0,0
          DPFC   11D,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,7
          DPFC   0,0,8D,0 
          DPFC   0,10D,0,0
          DPFC   11D,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,12D
          DPFC   0,0,1,0
          DPFC   0,2,0,0
          DPFC   3,0,0,4
          DPFC   0,0,5,0
          DPFC   0,7,0,0
          DPFC   8D,0,0,10D 
          DPFC   0,0,11D,0
          DPFC   0,2,0,0
          DPFC   3,0,0,4
          DPFC   0,0,5,0
          DPFC   0,7,0,0
          DPFC   8D,0,0,10D 
          DPFC   0,0,11D,0
          DPFC   0,2,0,0
          DPFC   3,0,0,4
          DPFC   0,0,5,0
          DPFC   0,12D,0,9D 
          DPFC   17,0 
 TPF6L    EQU    *-TPF6 
  
          ERRNZ  TPFC-BFMS
          TTL    QAP/3BB/5BC PFC IMAGE ARRAY TABLE. 
          TITLE  DEFAULT 580 PFC IMAGE ARRAY FOR SHORT PAPER. 
          QUAL   5BC
          IDENT  5BC,PFCX    580 PFC IMAGE ARRAY FOR SHORT PAPER
*COMMENT QAP - 580 PFC IMAGE ARRAY FOR SHORT PAPER. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 PFC      SPACE  4,10 
          ORG    BFMS-7 
 PFC      SUBR               ENTRY/EXIT 
          LDC    TPF6L       SET LENGTH OF 6 LPI ARRAY
          STD    T7 
          ADN    TPF8L-TPF6L (A) = LENGTH OF 8 LPI ARRAY
          UJN    PFCX        EXIT 
 TPFC     SPACE  4,10 
*         8 LINES PER INCH ARRAY. 
  
 TPFC     BSS    0
 TPF8     DPFC   1,6,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,2
          DPFC   0,12D,0,0
          DPFC   1,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,0
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,2
          DPFC   0,12D,0,9D 
          DPFC   17,0 
 TPF8L    EQU    *-TPF8 
  
*         6 LINES PER INCH ARRAY. 
  
 TPF6     DPFC   1,6,2,0
          DPFC   3,0,4,0
          DPFC   0,5,0,2
          DPFC   0,3,0,4
          DPFC   0,0,5,0
          DPFC   2,0,3,0
          DPFC   4,0,0,5
          DPFC   0,2,0,3
          DPFC   0,4,0,0
          DPFC   5,0,2,0
          DPFC   3,0,4,0
          DPFC   0,5,0,2
          DPFC   12D,0,0,1
          DPFC   0,2,0,3
          DPFC   0,4,0,0
          DPFC   5,0,2,0
          DPFC   3,0,4,0
          DPFC   0,5,0,2
          DPFC   0,3,0,4
          DPFC   0,0,5,0
          DPFC   2,0,3,0
          DPFC   4,0,0,5
          DPFC   0,2,0,3
          DPFC   0,4,0,0
          DPFC   5,0,2,12D
          DPFC   0,9D,17,0
 TPF6L    EQU    *-TPF6 
  
          ERRNZ  TPFC-BFMS
          TTL    QAP/3BB/5BD  PFC IMAGE ARRAY TABLE.
          TITLE  ALTERNATE 580 PFC IMAGE ARRAY FOR SHORT PAPER. 
          QUAL   5BD
          IDENT  5BD,PFCX    ALTERNATE 580 PFC IMAGE FOR SHORT PAPER
*COMMENT  QAP - ALTERNATE 580 PFC IMAGE, SHORT PAPER
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 PFC      SPACE  4,10 
          ORG    BFMS-7 
 PFC      SUBR               ENTRY/EXIT 
          LDC    TPF6L       SET LENGTH OF 6 LPI ARRAY
          STD    T7 
          ADN    TPF8L-TPF6L (A) = LENGTH OF 8 LPI ARRAY
          UJN    PFCX        EXIT 
 TPFC     SPACE  4,10 
*         8 LINES PER INCH ARRAY. 
  
 TPFC     BSS    0
 TPF8     DPFC   1,6,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,7
          DPFC   0,0,8D,0 
          DPFC   0,10D,0,0
          DPFC   11D,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,7
          DPFC   0,0,8D,0 
          DPFC   0,10D,0,0
          DPFC   11D,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,7
          DPFC   0,12D,0,0
          DPFC   1,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,7
          DPFC   0,0,8D,0 
          DPFC   0,10D,0,0
          DPFC   11D,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,7
          DPFC   0,0,8D,0 
          DPFC   0,10D,0,0
          DPFC   11D,0,0,2
          DPFC   0,0,3,0
          DPFC   0,4,0,0
          DPFC   5,0,0,7
          DPFC   0,12D,0,9D 
          DPFC   17,0 
 TPF8L    EQU    *-TPF8 
  
*         6 LINES PER INCH ARRAY. 
  
 TPF6     DPFC   1,6,2,0
          DPFC   3,0,4,0
          DPFC   0,5,0,7
          DPFC   0,8D,0,10D 
          DPFC   0,0,11D,0
          DPFC   2,0,3,0
          DPFC   4,0,0,5
          DPFC   0,7,0,8D 
          DPFC   0,10D,0,0
          DPFC   11D,0,2,0
          DPFC   3,0,4,0
          DPFC   0,5,0,7
          DPFC   12D,0,0,1
          DPFC   0,2,0,3
          DPFC   0,4,0,0
          DPFC   5,0,7,0
          DPFC   8D,0,10D,0 
          DPFC   0,11D,0,2
          DPFC   0,3,0,4
          DPFC   0,0,5,0
          DPFC   7,0,8D,0 
          DPFC   10D,0,0,11D
          DPFC   0,2,0,3
          DPFC   0,4,0,0
          DPFC   5,0,7,12D
          DPFC   0,9D,17,0
 TPF6L    EQU    *-TPF6 
  
          ERRNZ  TPFC-BFMS
          TTL    QAP/3BC - GENERATE LACE CARD.
          TITLE 
          QUAL   PHD
          IDENT  3BC,PHDX    GENERATE LACE CARD 
*COMMENT  QAP - GENERATE LACE CARD. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
***       *PHD* GENERATES A LACE CARD TO PROVIDE A READABLE FORM OF 
*         IDENTIFICATION AS THE FIRST CARD OF  A PUNCH DECK.  THE 
*         NAME ON THE LACE CARD WILL NORMALLY BE THE USER INDEX HASH
*         FOLLOWED BY THE JSN.  IN THE CASE OF AN *SYOT* FILE OR A FILE 
*         OWNED BY USER INDEX 0 OR 377777B, THE NAME WILL BE THE UJN. 
          SPACE  4
**        ENTRY CONDITIONS. 
* 
* 
*         (BS - BS+4) = FILE NAME FROM FET. 
*         (FT - LM+1) = FET BUFFER POINTERS.
          SPACE  4
**        EXIT CONDITIONS.
* 
* 
*         20B WORDS OF BINARY PUNCH DATA RETURNED TO THE CM BUFFER
*         STARTING AT *OUT*.
          TITLE  MAIN ROUTINE.
 PHD      SPACE  4
**        PHD - MAIN ROUTINE. 
  
  
          ORG    OVL
  
 PHD      SUBR               ENTRY/EXIT 
  
*         SET DATA FOR CARD IMAGE.
  
          LDD    BS+4        CHECK REQUEST
          LMC    PLEF 
          NJN    PHD1        IF NOT USER LIMIT EXCEEDED 
          LDC    1030 
          STD    BS+4 
          LJM    PHD2        GENERATE PUNCH DATA
  
*         GENERATE LACE CARD FROM USER INDEX HASH AND JSN.
  
 PHD1     SFA    QFT,FO      GENERATE USER INDEX HASH 
          ADK    JSNQ 
          CRD    CN 
          ADN    ENTQ-JSNQ   GET DISK ADDRESS OF FILE 
          CRD    T5 
          ADN    SCLQ-ENTQ   GET ORIGIN TYPE OF FILE
          CRD    CM 
          LDD    CM 
          LPN    77 
          LMK    SYOT 
          NJN    PHD1.1      IF NOT *SYOT* FILE 
          AOM    PHDB        USE UJN FOR LACE CARD NAME 
 PHD1.1   LDD    CN+2        SET USER INDEX FOR HASH GENERATION 
          LPN    77 
          STD    T1 
          SHN    14 
          LMD    CN+3 
          STD    T2 
          ZJN    PHD1.2      IF FILE OWNED BY USER INDEX ZERO 
          LMC    377777 
          NJN    PHD1.3      IF FILE IS NOT OWNED BY USER INDEX 377777B 
 PHD1.2   AOM    PHDB        USE UJN FOR LACE CARD NAME 
 PHD1.3   LDD    CN          SET JSN IN LACE CARD IMAGE 
          STM    PHDA+2 
          LDD    CN+1 
          STM    PHDA+3 
          RJM    GBN         GENERATE BANNER NAME 
          LDD    T1          SET USER INDEX HASH IN LACE CARD IMAGE 
          STM    PHDA 
          LDD    T2 
          STM    PHDA+1 
  
*         GENERATE LACE CARD FROM UJN (*SYOT* FILE OR FILE OWNED BY 
*         USER INDEX 0 OR 377777B). 
  
 PHDB     LDN    0
*         LDN    (NONZERO)   (FILE *SYOT* OR OWNED BY UI 0 OR 377777B)
          ZJN    PHD2        IF UJN NOT TO BE USED AS LACE CARD NAME
          SETMS  IO 
          LDN    0           DO NOT VERIFY FILE NAME
          RJM    RSS
          NJN    PHD2        IF ERROR IN SYSTEM SECTOR
          ENDMS 
          LDD    MA          SET UJN AS LACE CARD NAME
          CWM    JNSS,ON
          SBN    1
          CRM    PHDA,ON
          LDM    PHDA+3      ZERO FILL LACE CARD NAME 
          SCN    77 
          STM    PHDA+3 
  
*         GENERATE PUNCH DATA.
  
 PHD2     LDC    BUFA        SET BUFFER ADDRESS 
          STD    T7 
          LDC    PHDA        SET BYTE ADDRESS FOR PUNCH DATA
          STD    T5 
          LDN    0           CLEAR CHARACTER INDEX
          STD    T6 
 PHD3     LDI    T5          SHIFT BYTE 
          SHN    6
          STI    T5 
          SHN    -14         LETTER INDEX = 9D * CHARACTER
          STD    T1 
          SHN    3
          ADD    T1 
          STD    T1 
          LDN    0           CLEAR BYTE COUNT 
          STD    T2 
          LDD    T1          CHECK LETTER INDEX 
          ADC    -TLTRL 
          MJN    PHD4        IF IN TABLE
          LDN    0           CLEAR INDEX
          STD    T1 
 PHD4     LDM    TLTR,T1     STORE LETTER BYTE
          STI    T7 
          AOD    T7          ADVANCE BUFFER 
          AOD    T1          ADVANCE LETTER INDEX 
          AOD    T2          ADVANCE BYTE COUNT 
          LMN    11 
          NJN    PHD4        IF NOT END OF LETTER 
          LDC    4001        INSERT SEPARATOR BETWEEN LETTERS 
          STI    T7 
          AOD    T7 
          AOD    T6          ADVANCE CHARACTER COUNT
          LMN    10 
          ZJN    PHD6        IF LACE CARD COMPLETE
          LMN    10 
          LPN    1
          NJN    PHD5        IF SECOND CHARACTER IN BYTE NOT PROCESSED
          AOD    T5          ADVANCE BYTE 
 PHD5     LJM    PHD3        LOOP 
  
*         RETURN PUNCH DATA TO CM BUFFER. 
  
 PHD6     RJM    CIB         CHECK INPUT BUFFER 
          ZJN    PHD9        IF BUFFER FULL 
          PJN    PHD7        IF NO ERROR
          ABORT  ERBA        * QAP - BUFFER ARGUMENT ERROR.*
  
 PHD7     STD    T1          SET WORD COUNT 
          SBN    20 
          MJN    PHD8        IF LESS THAN 20B WORDS 
          LDN    20          SET NUMBER OF WORDS TO WRITE 
          STD    T1 
 PHD8     LDC    BUF
          RJM    WBB         WRITE BINARY BUFFER
          LDN    ZERL        UPDATE IN
          CRD    CM 
          LDD    IN 
          STD    CM+3 
          LDD    IN+1 
          STD    CM+4 
          LDA    IR+3        STORE *IN* 
          ADN    2
          CWD    CM 
 PHD9     LJM    PHDX        RETURN 
  
 PHDA     DATA   C* LIMIT * 
 TLTR     SPACE  4
**        TLTR - TABLE OF LETTERS.
*         EACH ENTRY IS 9D BYTES LONG.
  
  
 TLTR     BSS    0
  
          CON    4001,4001,4001,4001,4001  (INCORRECT CHARACTERS) 
          CON    4001,4001,4001,4001
          CON    4175,4375,4641,5441,5041  *A*
          CON    5441,4641,4375,4175
          CON    5775,5775,5105,5105,5105  *B*
          CON    5105,5105,5775,4671
          CON    4771,5775,5005,5005,5005  *C*
          CON    5005,5005,5415,4411
          CON    5775,5775,5005,5005,5005  *D*
          CON    5005,5005,5775,4771
          CON    5775,5775,5105,5105,5105  *E*
          CON    5105,5105,5105,5105
          CON    5775,5775,5101,5101,5101  *F*
          CON    5101,5101,5101,5101
          CON    4771,5775,5005,5005,5005  *G*
          CON    5025,5025,5435,4435
          CON    5775,5775,4101,4101,4101  *H*
          CON    4101,4101,5775,5775
          CON    5005,5005,5005,5775,5775  *I*
          CON    5775,5005,5005,5005
          CON    5011,5015,5005,5005,5775  *J*
          CON    5771,5001,5001,5001
          CON    5775,5775,4041,4141,4121  *K*
          CON    4231,4615,5405,5001
          CON    5775,5775,4005,4005,4005  *L*
          CON    4005,4005,4005,4005
          CON    5775,5775,4401,4201,4101  *M*
          CON    4201,4401,5775,5775
          CON    5775,5775,4201,4101,4041  *N*
          CON    4021,4011,5775,5775
          CON    4771,5775,5015,5025,5045  *O*
          CON    5105,5205,5775,4771
          CON    5775,5775,5101,5101,5101  *P*
          CON    5101,5101,5701,4601
          CON    4771,5775,5005,5025,5035  *Q*
          CON    5015,5005,5775,4771
          CON    5775,5775,5141,5161,5121  *R*
          CON    5111,5111,5705,4605
          CON    4411,5415,5605,5305,5145  *S*
          CON    5065,5035,5415,4401
          CON    5401,5001,5001,5775,5775  *T*
          CON    5775,5001,5001,5401
          CON    5771,5775,4005,4005,4005  *U*
          CON    4005,4005,5775,5771
          CON    5741,5761,4031,4011,4005  *V*
          CON    4011,4031,5761,5741
          CON    5775,5775,4015,4021,4041  *W*
          CON    4021,4015,5775,5775
          CON    5015,5435,4661,4341,4101  *X*
          CON    4341,4661,5435,5015
          CON    5001,5401,4601,4375,4175  *Y*
          CON    4375,4601,5401,5001
          CON    5405,5455,5075,5065,5145  *Z*
          CON    5345,5645,5415,5015
          CON    5775,5775,5005,5005,5005  *0*
          CON    5005,5005,5775,5775
          CON    4405,4405,5005,5005,5775  *1*
          CON    5775,4005,4005,4005
          CON    5415,5435,5065,5145,5105  *2*
          CON    5205,5605,5405,4005
          CON    5105,5105,5105,5105,5105  *3*
          CON    5105,5105,5775,5775
          CON    5741,5741,4041,4041,4041  *4*
          CON    5775,5775,4041,4041
          CON    5705,5705,5105,5105,5105  *5*
          CON    5105,5105,5175,5071
          CON    5771,5775,4045,4045,4045  *6*
          CON    4045,4045,4075,4031
          CON    5001,5005,5015,5031,5061  *7*
          CON    5141,5301,5601,5401
          CON    4671,5775,5105,5105,5105  *8*
          CON    5105,5105,5775,4671
          CON    4601,5701,5101,5101,5101  *9*
          CON    5101,5101,5775,4775
  
 TLTRL    EQU    *-TLTR 
          SPACE  4,10 
*         COMMON DECKS. 
  
  
*CALL     COMPGBN 
*CALL     COMPRSS 
 BUF      SPACE  4
**        BUF - ASSEMBLY BUFFER.
  
  
 BUF      CON    7777 
          CON    4001 
 BUFA     BSS    0
  
 BUFL     EQU    8D*10D      8 LETTERS AT 10D BYTES/LETTER
          ERRNG  EPFW-BUFA-BUFL  BUFFER OVERFLOWS INTO *EPFW* 
          EJECT 
          TTL    QAP/3BD - PROCESS OPERATOR REQUEST.
          QUAL   POR
          IDENT  3BD,PORX    PROCESS OPERATOR REQUEST 
*COMMENT  QAP - PROCESS OPERATOR REQUEST. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
***              *POR* PROCESSES SPECIAL OPERATOR REQUESTS THAT ARE 
*         CUMBERSOME FOR 1CD TO PERFORM.
          SPACE  4
**        ENTRY CONDITIONS. 
* 
* 
*                (EQ) = EST ORDINAL OF PRINTER. 
*         (FP - FP+4) = WORD 5 OF FET.
*         (BS - BS+4) = FIRST WORD OF FET.
*         (FT - FT+1) = *FIRST* POINTER.
*         (IN - IN+1) = *IN* POINTER. 
*         (OT - OT+1) = *OUT* POINTER.
*         (LM - LM+1) = *LIMIT* POINTER.
          SPACE  4
**        EXIT CONDITIONS.
* 
* 
*         FET AND *CIO* REQUEST SET UP TO REPOSITION PRINT FILE.
          TITLE  MAIN PROGRAM.
**        POR - MAIN ROUTINE. 
  
  
          ORG    OVL
  
 POR      SUBR               ENTRY/EXIT 
          NFA    BF,R        READ BUFFER POINT WORD 
          CRD    ES 
          ADN    1           READ REPEAT COUNT
          CRD    CM 
          LDD    ES+4        SET REQUEST PARAMETER
          SHN    -6 
          NJN    POR1        IF PARAMETER GIVEN 
          LDN    1           SET DEFAULT COUNT
 POR1     STD    T6 
          STD    T4 
          LDD    ES+4        EXTRACT REQUEST CODE 
          LPN    77 
          STD    T5 
          LDD    CM+4 
          SHN    6
          LMN    CPHP        SET DRIVER CONTINUE RESPONSE 
          STD    ES+4 
          LDD    BS+3        CLEAR LEVEL NUMBER 
          SCN    77 
          STD    BS+3 
          LDM    TOPF,T5     PROCESS REQUEST
          STD    T1 
          LJM    0,T1 
 TOPF     SPACE  4
**        TOPF - TABLE OF OPERATOR REQUESTS PROCESSORS. 
*         INDEXED BY REQUEST CODE. (DEFINED IN COMSBIO) 
*         ONE WORD ENTRY IN FORMAT -
* 
*T        12/  ADDR 
*         ADDR = ADDRESS OF REQUEST PROCESSOR.
  
  
 TOPF     INDEX 
          INDEX  BKPO,BKP    BACKSPACE PRUS 
          INDEX  BKRO,BKR    BACKSPACE RECORDS
          INDEX  BKFO,BKF    BACKSPACE FILES
          INDEX  SKPO,SKP    SKIP PRUS
          INDEX  SKRO,SKR    SKIP RECORDS 
          INDEX  SKFO,SKF    SKIP FILES 
          INDEX  LNLP,LNL    LOCATE NEXT LINE 
          INDEX  LCBP,LCB    LOAD CENTRAL BUFFER
          INDEX  FPRE        TABLE TERMINATOR 
          TITLE  REQUEST PROCESSORS.
 BKF      SPACE  4
**        BKF - BACKSPACE FILES.
  
  
 BKF      BSS    0
          LDN    74          SET LEVEL 17 
          RAD    BS+3 
          UJN    BKR         PROCESS SKIP 
 BKP      SPACE  4
**        BKP - BACKSPACE PRUS. 
  
  
 BKP      BSS    0
          RJM    COB         CHECK OUTPUT BUFFER
          SHN    -6 
          RAD    T4 
          LDN    LNLP-CPHP   SET NEXT FUNCTION
          RAD    ES+4 
          LDN    44 
          UJN    BKR1        PROCESS *BKSPRU* 
 BKR      SPACE  4
**        BKR - BACKSPACE RECORDS.
  
  
 BKR      BSS    0
          LDC    640         SET *SKIPB* REQUEST
 BKR1     LJM    SKR1 
 SKF      SPACE  4
**        SKF - SKIP FILES. 
  
  
 SKF      BSS    0
          LDN    74          SET LEVEL 17 
          RAD    BS+3 
          LJM    SKR         PROCESS SKIP 
 SKP      SPACE  4
**        SKP - SKIP PRUS.
  
  
 SKP      BSS    0
          LDN    LNLP-CPHP   SET NEXT FUNCTION
          RAD    ES+4 
          RJM    COB         CHECK OUTPUT BUFFER
          STD    T3 
          ADN    77 
          SHN    -6          CONVERT TO SECTOR COUNT
          SBD    T6 
          MJN    SKP2        IF SKIP OUT OF BUFFER
          SHN    6
          SBD    T3          REMOVE WORD COUNT
          LMC    -0 
          ADD    OT+1 
          STD    CM+4        FORM *OUT* POINTER 
          SHN    -14
          ADD    OT 
          STD    CM+3 
          SBD    LM          CHECK FOR WRAP AROUND
          SHN    14 
          ADD    CM+4 
          SBD    LM+1 
          MJN    SKP1        IF NO WRAP AROUND
          ADD    FT+1 
          STD    CM+4 
          SHN    -14         RESET *OUT* POINTER
          ADD    FT 
          STD    CM+3 
 SKP1     LDC    BCAX 
          UJN    SKP4        SET FINAL TRANSFER AND BUFFER STATUS 
  
 SKP2     LMC    -0          SET SKIP COUNT 
          STD    T4 
          RJM    ECB         EMPTY BUFFER 
          LDD    LM 
          SBD    FT 
          SHN    14          FIND BUFFER SIZE 
          ADD    LM+1 
          SBD    FT+1 
          SHN    -6          BUFFER SIZE IN PRUS
          SBD    T4 
          PJN    SKP3        IF SKIP LESS THAN BUFFER 
          RAD    T4          SKIP ONLY TO FULL BUFFER 
 SKP3     LDD    T4 
          SHN    6
          RAD    CM+4        SET *OUT* TO PROPER NUMBER OF SECTORS
          SHN    -14
          RAD    CM+3 
          LDN    LCBP-LNLP   SET NEXT FUNCTION
          RAD    ES+4 
          LDC    60S12+SKR3 
 SKP4     STM    PDFA        SET FINAL TRANSFER 
          SHN    -14         SET BUFFER STATUS
          SHN    3
          STD    BS+4 
          LDA    IR+3        STORE BUFFER STATUS
          CWD    BS 
          ADN    3           STORE *OUT* POINTER
          CWD    CM 
          UJN    SKR2 
 SKR      SPACE  4
**        SKR - SKIP RECORDS. 
  
  
 SKR      BSS    0
          LDC    240         SET *SKIPR* REQUEST
 SKR1     STD    BS+4 
          RJM    ECB         EMPTY BUFFER 
          LDC    SKR3 
          STM    PDFA        SET EXIT FOR CIO CALL
          LDD    T4 
          SHN    6           SET SKIP COUNT IN CIO CALL 
          RAD    IR+3 
          SHN    -14
          STD    IR+2 
          LDA    IR+3,M      STORE CIO FUNCTION CODE
          CWD    BS 
 SKR2     NFA    BF,R        SEND DRIVER CONTINUE 
          CWD    ES 
          SFA    EST,EQ      RESTORE EST ENTRY
          ADK    EQDE 
          CRD    ES 
          LDD    T6 
          STD    CM+2 
          LDD    T5 
          LJM    PDF2        EXIT TO MESSAGE PROCESSOR WITH REQUEST 
  
 SKR3     LJM    CIO         CALL *CIO* 
 LCB      SPACE  4,10 
**        LCB - LOAD CENTRAL BUFFER.
  
  
 LCB      BSS    0
          RJM    ECB         EMPTY BUFFER 
 LCB1     LDN    LNLP-CPHP   SET NEXT FUNCTION
          RAD    ES+4 
          LDC    600         SET *CIO* FUNCTION TO *READEI* 
          STD    BS+4 
          LDA    IR+3        STORE BUFFER STATUS
          CWD    BS 
          NFA    BF,R        STORE DRIVER FUNCTION
          CWD    ES 
          UJN    SKR3        CALL *CIO* 
 LNL      SPACE  4,10 
**        LNL - LOCATE NEXT LINE. 
  
  
 LNL      BSS    0
          LDN    35          SET LENGTH OF LINE + 1 WORD
          STD    T4 
          RJM    COB         CHECK OUTPUT BUFFER
          SBD    T4 
          MJN    LCB1        IF NOT 1 LINE AND 1 WORD 
          LDN    1           SET WORD COUNT FOR READ
          STD    T3 
 LNL1     LDN    CM          READ WORD FROM CENTRAL BUFFER
          RJM    RBB
          LDD    CM+4 
          ZJN    LNL2        IF END OF LINE FOUND 
          SOD    T4 
          NJN    LNL1        IF NOT MAXIMUM LINE LENGTH 
 LNL2     LDN    ZERL 
          CRD    CM 
          LDD    OT          SETUP *OUT* POINTER
          STD    CM+3 
          LDD    OT+1 
          STD    CM+4 
          LDC    600         SET *CIO* FUNCTION TO *READEI* 
          STD    BS+4 
          LDA    IR+3        STORE *OUT* POINTER
          CWD    BS          STORE BUFFER STATUS
          ADN    3
          CWD    CM 
          NFA    BF,R        SEND DRIVER CONTINUE 
          CWD    ES 
          LJM    BCAX        EXIT 
          TTL    QAP/3BE - CHANNEL ERROR CLEANUP. 
          TITLE 
          QUAL   CEC
          IDENT  3BE,CECX    CHANNEL ERROR CLEANUP
*COMMENT  QAP - CHANNEL ERROR CLEANUP.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 CEC      SPACE  4
***              *CEC* CLEANS UP AFTER REPEATED CHANNEL ERRORS. 
*         OUTPUT FILES ARE REQUEUED.  ANY TRACKS ASSIGNED TO INPUT
*         FILES ARE DROPPED.  THE FAULTY EQUIPMENT IS TURNED OFF. 
*         ERROR LOG MESSAGES ARE ISSUED.
*         *CEC* ALSO REQUEUES FILES FOR RERUN REQUESTS. 
 CEC      SPACE  4,10 
**        ENTRY CONDITIONS. 
* 
* 
*         (BS+4) = *CECF* IF CHANNEL ERROR. 
*                = *RQFF* IF RERUN REQUEST. 
*                = *CECF* + 4000B IF PRINTER READY DROP.
* 
*         (BF) = BUFFER POINT ADDRESS.
*         (EQ) = EST ORDINAL. 
*         (FA) = FNT ADDRESS. 
*         (FP - FP+4) = FILE PARAMETERS.
 CEC      SPACE  4,10 
**        EXIT CONDITIONS.
* 
* 
*         IF CHANNEL ERROR -
*                OUTPUT FILES REQUEUED. 
*                INPUT FILE TRACKS DROPPED. 
*                EQUIPMENT TURNED OFF.
*         IF RERUN REQUEST -
*                OUTPUT FILE REQUEUED.
          TITLE  MAIN ROUTINE.
**        CEC - MAIN ROUTINE. 
  
  
          ORG    OVL
  
 CEC      SUBR               ENTRY/EXIT 
          LDD    BS+4        CHECK FOR RERUN REQUEST
          LMC    CECF 
          NJN    CEC0        IF NOT CONTROLLER HUNG BUSY
  
*         TURN EQUIPMENT OFF. 
  
          LDD    EQ 
          STD    CM+1 
          LDN    OFES        SET OFF STATUS 
          STD    CM+2 
          MONITOR SEQM       SET EQUIPMENT PARAMETER
  
*         SEND ERROR LOG MESSAGES.
  
 CEC0     LDD    BS+4        CHECK FOR PRINTER READY DROP 
          LPC    4000 
          RAD    BS+4 
          SHN    0-14 
          ZJN    CEC1        IF NOT PRINTER READY DROP
          LDN    CEC6-CEC2
 CEC1     ADC    CEC2        SET RETURN ADDRESS 
          STM    PDFA 
          LJM    PDF1        ISSUE ERROR LOG MESSAGE
  
 CEC2     LDD    BS+4        CHECK FOR RERUN REQUEST
          LMC    CECF 
          ZJN    CEC3        IF CHANNEL ERROR 
          LJM    CEC6        RERUN REQUEST
  
 CEC3     LDD    CP          STORE CONTROL POINT MESSAGE
          ADN    MS2W 
          CWM    CECA,TR
          NFA    BF,R        READ SECOND BUFFER POINT WORD
          ADN    1
          CRD    CM 
          LDN    EOHE        *OFF - CHECK ERRLOG* 
          STD    CM 
          NFA    BF,R        STORE MESSAGE CODE 
          ADN    1
          CWD    CM 
          LDN    0           CLEAR RETRY FIELD
          STD    CM+2 
          LDN    EEOM-ERRF   ISSUE ERROR LOG AND BML MESSAGES 
          RJM    IBE
          LDN    ZERL        SELECT *EATM* AND ENTER EVENT OPTION 
          CRD    CM 
          LDN    ELAE        ERROR LOG ALERT
          STD    CM+4 
          MONITOR  EATM 
          LDD    FA 
          ZJN    CEC5        IF NO FNT
          NFA    FA,R 
          CRD    CM 
          LDD    CM+4        CHECK FOR INPUT FILE TYPE
          SHN    -6 
          LMN    LOFT 
          NJN    CEC6        IF NOT INPUT FILE
  
*         DROP INPUT FILE.
  
 CEC5     LDN    60          *UNLOAD* FILE
          STD    BS+4 
          LDA    IR+3        WRITE FET+0
          CWD    BS 
          LDN    0           CLEAR UNUSED BYTE
          STD    IR+2 
          LJM    CIO         CALL *CIO* 
  
*         REQUEUE OUTPUT FILE.
  
 CEC6     NFA    FA,R        READ FILE NAME 
          CRM    DSPB,ON
          LDC    DSPB+4      CLEAR *DSP* PARAMETER BLOCK
          STD    T1 
 CEC7     LDN    0
          STI    T1 
          AOD    T1 
          LMC    DSPB+DSPBL*5 
          NJN    CEC7        IF NOT END OF PARAMETER BLOCK
          LDK    FRRC/10000+FREP/10000  SET REP. COUNT, ERROR RETURN
          STM    DSPB+1*5+3 
          LDK    FRPR+FRCS   SET PRIORITY AND CENTRAL SITE FLAGS
          STM    DSPB+1*5+4 
          LDN    1           SET PRIORITY FLAG IN PRIORITY FIELD
          STM    DSPB+3*5+3 
          NFA    BF,R        FETCH REPEAT COUNT 
          CRD    CM 
          LDD    CM+4        SET REPEAT COUNT 
          SHN    -6 
          STM    DSPB+4*5+3 
          LDD    BS+4        CHECK FOR RERUN REQUEST
          LMC    CECF 
          ZJN    CEC8        IF CHANNEL ERROR 
          LDD    CM+2        SET OPERATOR SELECTED PRIORITY 
          UJN    CEC9        SET SELECTED PRIORITY
  
 CEC8     LCN    0
 CEC9     STM    DSPB+3*5+4 
          LDD    FA          SET FNT ADDRESS
          STM    DSPB+4*5+4 
          LDN    DSPBL       WRITE *DSP* PARAMETER BLOCK
          STD    T1 
          ADN    QAPO-1 
          STD    T2 
          RJM    VCA         VALIDATE CENTRAL ADDRESS 
          LDA    IR+3 
          ADN    QAPO 
          CWM    DSPB,T1
          LDN    QAPO        SET *DSP* PARAMETER BLOCK ADDRESS
          RAD    IR+4 
          SHN    -14
          RAD    IR+3 
          LDN    0           CLEAR UNUSED BYTE
          STD    IR+2 
          EXECUTE DSP,* 
          LJM    CPR         LOAD PP ROUTINE
  
 CECA     DATA   C+$REQUEST *I* DISPLAY.+ 
          SPACE  4,10 
          OVERFLOW  OVL 
 DSPB     SPACE  4,10 
**        DSPB - *DSP* PARAMETER BLOCK BUFFER.
  
  
 DSPB     EQU    *           *DSP* PARAMETER BLOCK BUFFER FWA 
          ERRNG  7777-DSPB-DSPBL*5-1  CHECK FOR OVERFLOW
          TTL    QAP/3BF - RELOAD 580 PFC MEMORY. 
          TITLE 
          QUAL   PFC
          IDENT  3BF,PFCX    RELOAD 580 PFC MEMORY
*COMMENT  QAP - RELOAD 580 PFC MEMORY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 PFC      SPACE  4,10 
***              *PFC* LOADS A USER SUPPLIED IMAGE TO 580 PFC MEMORY. 
          SPACE  4,10 
**        ENTRY CONDITIONS. 
* 
*         (BF) = BUFFER POINT ADDRESS.
*         (EQ) = EST ORDINAL. 
*         (BS+4) = REQUEST. 
*         (IR+3 - IR+4) = FET ADDRESS.
*         (OT - OT+1) = OUT POINTER.
*         (ES - ES+4) = EST ENTRY.
*         (FP - FP+4) = FILE PARAMETER WORD (FET+5).
*         (F6 - F6+4) = FILE PARAMETER WORD (FET+6).
          SPACE  4,10 
**        EXIT CONDITIONS.
* 
*         TO     *TPF* IF USER NOT VALIDATED FOR *CBIO* PRIVILEGES. 
*                *BCAX* IF USER PFC IMAGE SUCCESSFULLY LOADED.
*                *TPF1* IF ERROR IN USER PFC IMAGE. 
          TITLE  MAIN ROUTINE.
**        PFC - MAIN ROUTINE. 
  
  
          ORG    /LPM/OPFC
  
 PFC      SUBR               ENTRY/EXIT 
          LDD    F6+2        CHECK USER VALIDATION
          LPN    1
          NJN    PFC1        IF USER VALIDATED FOR SPECIAL PRIVILEGES 
          LDC    PFCA        CHANGE MESSAGE 
          STM    TPFA 
          LJM    TPF         TERMINATE PRINT FILE 
  
 PFC1     LDN    2           NUMBER OF USER IMAGES TO BE PROCESSED
          STD    NI 
          LDC    210         READ UP 136D BYTES TO EOL
          STM    RCBA 
          LDD    ES          CHECK FOR PFC PRINTER
          SHN    21-7 
          MJN    PFC2        IF PFC PRINTER 
          LJM    SKL         SKIP LINES 
  
*         READ USER PFC ARRAY.
  
 PFC2     LDC    BUF         READ CODED BUFFER
          STD    BA 
          RJM    RCB
          RJM    CAD         CONVERT ASCII TO DISPLAY 
          LDC    BFMS        SET ADDRESS FOR ASSEMBLY 
          STD    T1 
          STD    LA 
          LDN    0
          STI    T1 
          AOD    BA          ASSEMBLE CHARACTER STRING
          RJM    ACS
          LDM    -1,BA       CHECK FOR CONTINUATION LINE
          LPN    77 
          STD    T7          SAVE 6/8 LPI DESIGNATOR
          LMN    1RC
          NJN    PFC3        IF NO CONTINUATION LINE
          LDD    T1          SAVE END OF ASSEMBLY 
          STD    T5 
          SOD    BA          READ SECOND LINE 
          RJM    RCB
          RJM    CAD         CONVERT ASCII TO DISPLAY 
          LDD    T5          RESTORE ASSEMBLY ADDRESS 
          STD    T1 
          AOD    BA          APPEND SECOND LINE 
          RJM    ACS
 PFC3     LDD    T7          CHECK FOR 6/8 LPI
          LMN    1R6
          ZJN    PFC4        IF 6 LPI 
          LDN    17-16
 PFC4     ADN    16          SET FUNCTION CODE FOR 6 LPI
          STD    T7 
          LDI    T1 
          ZJN    PFC5        IF END OF ARRAY ON BYTE BOUNDARY 
          AOD    T1 
 PFC5     LDD    T1          SET LENGTH OF ARRAY
          SBD    LA 
          STD    T5 
          SBM    PFCB-16,T7 
          MJN    PFC7        IF ARRAY NOT TOO LONG
 PFC6     LJM    ERR         PROCESS ERROR
  
*         VALIDATE USER PFC ARRAY.
  
 PFC7     SOD    T1 
          LDI    T1          CHECK LAST CHARACTER 
          LPN    77 
          LMN    1R 
          NJN    PFC8        IF NO BLANK PADDING
          LCN    1R          CLEAR BLANK CHARACTER
          RAI    T1 
 PFC8     LDI    T1          CHECK LAST BYTE
          LPN    77 
          NJN    PFC9        IF TWO CHARACTERS
          LDI    T1          CHECK FOR END OF ARRAY 
          SHN    -6 
 PFC9     LMN    1RO
          NJN    PFC6        IF NOT 17B 
          LDI    LA          CHECK START OF IMAGE 
          SHN    -6 
          LMN    1RA
          NJN    PFC6        IF NOT TOP OF FORM 
          RJM    CPI         CHECK PFC IMAGE
          LDD    T2          NUMBER OF OCCURENCES OF TOP OF FORM
          SBN    2
          NJN    PFC10       IF NOT 2 PAGE IMAGE
          LDD    FG          CHECK PAPER SIZE 
          LPN    10 
          SHN    1-3
          ADD    T7 
          STD    T3 
          LDM    PFCB-16,T3  CHECK LENGTH OF ARRAY
          SBN    1
          STD    T3 
          LMD    T5 
          NJN    PFC10       IF NOT SAME LENGTH AS SYSTEM ARRAY 
          SOD    T3          CHECK LOCATION OF SECOND PAGE TOP OF FORM
          SHN    -1          DIVIDE BY 2
          RAD    LA 
          LDI    LA 
          SHN    -6 
          LMN    1RA
          ZJN    PFC11       IF SAME AS STANDARD PFC IMAGE
 PFC10    LDD    ES          SET USER FORMS CONTROL INDICATOR 
          LPC    7677 
          LMD    HN 
          STD    ES 
          SFA    EST,EQ      STORE EST ENTRY
          ADK    EQDE 
          CWD    ES 
 PFC11    RJM    /LPM/CON    CONNECT EQUIPMENT
          RJM    /LPM/WNB    WAIT NOT BUSY
          LDD    T7          LOAD PFC MEMORY
          RJM    /LPM/LPI 
          RJM    /LPM/RAD    RELEASE AND DISCONNECT 
          AOD    FP+3        ADVANCE COUNT OF *V* LINES 
          RJM    UFP         UPDATE FILE PARAMETERS 
          SOD    NI 
          NJN    PFC13       IF TWO *V* LINES NOT PROCESSED 
 PFC12    LJM    BCAX        EXIT 
  
 PFC13    LDA    OT          CHECK NEXT LINE
          CRD    CM 
          LDD    F6+2 
          LPN    4
          NJN    PFC17       IF 8/12 ASCII FILE 
          LDD    CM 
          SHN    -6 
          LMN    1RV
          NJN    PFC12       IF NOT ANOTHER *V* LINE
          LDD    CM          CHECK FOR V(6,8 OR C)
          LPN    77 
          LMN    1R6
          NJN    PFC15       IF NOT 6 LPI 
 PFC14    LJM    PFC2        LOOP FOR NEXT *V* LINE 
  
 PFC15    LMN    1R8&1R6
          ZJN    PFC14       IF 8 LPI 
          LMN    1RC&1R8
          ZJN    PFC14       IF 8 LPI ACROSS TWO LINES
 PFC16    LJM    SKL         SKIP LINE
  
 PFC17    LDD    CM 
          LMC    126
          NJN    PFC12       IF NOT ASCII *V* 
          LDD    CM+1 
          SBN    66          ASCII *6*
          ZJN    PFC14       IF 6 LPI 
          SBN    70-66       ASCII *8* - ASCII *6*
          ZJN    PFC14       IF 8 LPI 
          SBN    103-70      ASCII *C* - ASCII *8*
          ZJN    PFC14       IF 8 LPI ACROSS TWO LINES
          UJN    PFC16       SKIP LINE
  
 PFCA     DATA   C* - USER ACCESS NOT VALID.* 
          BSSZ   PFCA+3*5-* 
  
 PFCB     CON    /5BA/TPF6L+1,/5BA/TPF8L+1,/5BC/TPF6L+1,/5BC/TPF8L+1
 CAD      SPACE  4,15 
**        CAD - CONVERT ASCII TO DISPLAY. 
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                T8AD = FWA OF *COMT8AD.* 
* 
*         EXIT   CONVERSION IS TERMINATED BY A ZERO BYTE. 
* 
*         USES   T1, T2.
* 
*         CALLS  T8AD.
  
  
 CAD10    STI    T3          STORE EOL BYTE 
  
 CAD      SUBR               ENTRY/EXIT 
          LDD    F6+2 
          LPN    4
          ZJN    CADX        IF NOT 8/12 ASCII FILE 
          LDD    BA 
          STD    T2          SET PP BUFFER ADDRESS
          STD    T3 
          LDI    T2 
          ZJN    CADX        IF EOL 
 CAD1     LDI    T2 
 CAD2     ZJN    CAD10       IF END OF LINE 
          SBN    40 
          MJN    CAD3        IF CHAR .LT. 40
          STD    T1 
          ADC    -140+40
          MJN    CAD5        IF 40 .LT. CHAR .LE. 137 
          ZJN    CAD3        IF CHAR .EQ. 140 
          SBN    173-140
          PJN    CAD3        IF CHAR .GE. 173 
          LDD    T1 
          SBN    40 
          UJN    CAD4        CONVERT CHARACTER
  
 CAD3     LDN    12          CONVERT TO INCORRECT CHARACTER 
 CAD4     STD    T1 
 CAD5     LDM    T8AD,T1     CONVERT TO DISPLAY CODE
          SHN    6           STORE UPPER CHARACTER
          STI    T3 
          AOD    T2          INCREMENT OLD BYTE ADDRESS 
          LDI    T2 
          NJN    CAD6        IF NOT EOL 
          AOD    T3 
          LDN    0
          UJN    CAD2        STORE EOL BYTE 
  
 CAD6     SBN    40 
          MJN    CAD7        IF CHAR .LT. 40
          STD    T1 
          ADC    -140+40
          MJN    CAD9        IF 40 .LT. CHAR .LE. 137 
          ZJN    CAD7        IF CHAR .EQ. 140 
          SBN    173-140
          PJN    CAD7        IF CHAR .GE. 173 
          LDD    T1 
          SBN    40 
          UJN    CAD8        CONVERT CHARACTER
  
 CAD7     LDN    12          CONVERT TO INCORRECT CHARACTER 
 CAD8     STD    T1 
 CAD9     LDM    T8AD,T1     CONVERT TO DISPLAY CODE
          RAI    T3          STORE LOWER CHARACTER
          AOD    T2          INCREMENT OLD BYTE ADDRESS 
          AOD    T3          INCREMENT NEW BYTE ADDRESS 
          LJM    CAD1        LOOP TO END OF LINE
          TITLE  SUBROUTINES. 
 CPI      SPACE  4,10 
**        CPI - CHECK PFC IMAGE.
* 
*         ENTRY  (T1) = END OF PFC IMAGE. 
*                (LA) = START OF PFC IMAGE. 
* 
*         EXIT   (T2) = NUMBER OF OCCURENCES OF TOP OF FORM.
*                IF ERRORS ARE DETECTED EXIT IS MADE TO *ERR*.
* 
*         CALLS  ERR. 
  
  
 CPI1     LDI    T1          CHECK LOWER CHARACTER
          LPN    77 
          SBN    1RA
          NJN    CPI2        IF NOT  *A*
          AOD    T2          ADVANCE CHANNEL 1 COUNT
          UJN    CPI3        CHECK UPPER CHARACTER
  
 CPI2     SBN    1RO-1RA     CHECK RANGE OF CHARACTER 
          MJN    CPI3        IF VALID CHANNEL 
          SBN    1R -1RO     CHECK FOR BLANK
          NJN    ERR         IF INCORRECT CHARACTER 
          LCN    1R          REPLACE BLANK WITH *00*
          RAI    T1 
 CPI3     LDI    T1          CHECK UPPER CHARACTER
          SHN    -6 
          SBN    1RA
          NJN    CPI4        IF NOT *A* 
          AOD    T2          ADVANCE CHANNEL 1 COUNT
          UJN    CPI5        CHECK NEXT BYTE
  
 CPI4     SBN    1RO-1RA     CHECK RANGE OF CHARACTER 
          MJN    CPI5        IF VALID CHANNEL 
          SBN    1R -1RO     CHECK FOR BLANK
          NJN    ERR         IF INCORRECT CHARACTER 
          LCN    1R          REPLACE BLANK WITH *00*
          SHN    6
          RAI    T1 
 CPI5     SOD    T1          CHECK IF ALL CHARACTERS VERIFIED 
          SBD    LA 
          PJN    CPI1        IF MORE CHARACTERS TO CHECK
  
 CPI      SUBR               ENTRY/EXIT 
          LDN    0           CLEAR TOP OF FORMS COUNTER 
          STD    T2 
          LDI    T1          CHECK END OF ARRAY 
          LPN    77 
          NJN    CPI3        IF LOWER CHARACTER PRESENT 
          UJN    CPI5        SKIP END OF ARRAY CHECK
 ERR      SPACE  4,10 
**        ERR - ERROR ROUTINE.
  
  
 ERR      LDA    IR+3        FETCH *OUT* POINTER
          ADN    3
          CRD    CM 
          LDA    CM+3        READ START OF *V* LINE 
          CRD    T1 
          LDD    F6+2 
          LPN    4
          NJN    ERR1        IF 8/12 ASCII FILE 
          LDD    T1          REPLACE *V* CHARACTER WITH *-* 
          LPN    77 
          LMC    2L-- 
          UJN    ERR2        STORE START OF LINE IN ERROR 
  
 ERR1     LDN    55          REPLACE ASCII *V* WITH ASCII *-* 
 ERR2     STD    T1 
          LDA    CM+3        STORE START OF LINE IN ERROR 
          CWD    T1 
          LDD    OT          SET *IN* TO END OF LINE IN ERROR 
          STD    CM+3 
          LDD    OT+1 
          STD    CM+4 
          LJM    TPF1        TERMINATE PRINT FILE 
 SKL      SPACE  4,10 
**        SKL - SKIP LINES. 
* 
*         CALLS  CAD, RCB, UFP. 
  
  
 SKL      LDC    BUF         READ CODED BUFFER
          STD    BA 
          RJM    RCB
          RJM    CAD         CONVERT ASCII TO DISPLAY CODE
          LDI    BA 
          LPN    77 
          LMN    1RC
          NJN    SKL1        IF NOT CONTINUATION LINE 
          LDD    BA          READ SECOND LINE 
          RJM    RCB
 SKL1     SOD    NI          DECREMENT IMAGE COUNT
          ZJN    SKL4        IF LIMIT REACHED 
          LDA    OT 
          CRD    CM 
          LDD    F6+2 
          LPN    4
          ZJN    SKL2        IF NOT 8/12 ASCII FILE 
          LDD    CM 
          LMC    126         ASCII *V*
          UJN    SKL3        CHECK FOR ANOTHER *V* LINE 
  
 SKL2     LDD    CM 
          SHN    -6 
          LMN    1RV
 SKL3     NJN    SKL4        IF NOT ANOTHER *V* LINE
          LJM    SKL         LOOP FOR ANOTHER *V* LINE
  
 SKL4     RJM    UFP         UPDATE FILE POINTERS 
          LJM    PFC12       EXIT 
 UFP      SPACE  4,10 
**        UFP - UPDATE FILE POINTERS. 
* 
*         EXIT   FET POINTERS UPDATED.
  
  
 UFP      SUBR               ENTRY/EXIT 
          LDN    ZERL 
          CRD    CM 
          LDD    OT          SET *OUT* POINTER
          STD    CM+3 
          LDD    OT+1 
          STD    CM+4 
          LDA    IR+3        STORE *OUT* POINTER
          ADN    3
          CWD    CM 
          ADN    5-3         WRITE FILE PARAMETER WORD
          CWD    FP 
          UJN    UFPX        RETURN 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPRCB 
*CALL     COMT8AD 
  
 BUF      EQU    *           WORKING BUFFER 
          ERRPL  BUF+214-BFMS  LINE BUFFER OVERFLOWS ASSEMBLY BUFFER
          TTL    QAP/3BG - GENERATE BANNER PAGE.
          TITLE 
          QUAL   GBP
          IDENT  3BG,GBPX    GENERATE BANNER PAGE 
*COMMENT  QAP - GENERATE BANNER PAGE. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       GBP - GENERATE BANNER PAGE DATA.
* 
*         C. A. LACEY.       76/10/15.
*         R. A. JAPS         77/03/10.
*         D. R. HILGREN.     79/01/15.
*         P. D. HAAS.        83/03/07.
          SPACE  4,10 
***              *3BG* GENERATES THE BANNER PAGE FOR A JOB WHICH IS 
*         BEING PRINTED.  THE BANNER CONSISTS OF SYSTEM INFORMATION 
*         AND THE JOB SEQUENCE NUMBER (JSN) IN FORMATTED CHARACTERS.
* 
*                *3BG* HAS THE CAPABILITY TO RETURN A PORTION OF THE
*         BANNER PAGE TO THE CM BUFFER.  THIS WILL ALLOW A PROGRAM
*         TO GENERATE A BANNER PAGE WITH A SERIES OF *QAP* CALLS. 
          SPACE  4,10 
***       ENTRY CONDITIONS. 
* 
* 
*         (FO) = QFT ORDINAL. 
*         (CI) = CONTROL INFORMATION. 
*                1/S, 11/ WCNT
*                S = 1, IF SYSTEM SECTOR INFORMATION NOT NEEDED.
*                WCNT = NUMBER OF CM WORDS ALREADY RETURNED.
*         (WC) = 8/12 ASCII PRINT FILE FLAG IF BATCHIO CALL.
*         (ES - ES+4) = PRINTER EST ENTRY (*BATCHIO* CALL ONLY).
*         (ES) = PAGE SIZE.  (NON-*BATCHIO* CALL).
*         (FT - FT+1) = FIRST POINTER.
*         (IN - IN+1) = IN POINTER. 
*         (OT - OT+1) = OUT POINTER.
*         (LM - LM+1) = LIMIT POINTER.
          SPACE  4,10 
***       EXIT CONDITIONS.
* 
* 
*         (CI) = UPDATED CONTROL INFORMATION. 
*         (T1) = 1030 IF ALL BANNER PAGE DATA WRITTEN TO CM BUFFER. 
*         (T1) = 20 IF MORE BANNER PAGE DATA TO BE RETURNED.
*         BANNER PAGE RETURNED TO CM BUFFER.
*         *IN* POINTER UPDATED IN FET.
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMSMLS 
 MACROS   SPACE  4,10 
**        LINE - GENERATE 60 BITS OF DISPLAY CODE WITH EOL. 
* 
*         LINE   CHARS
* 
*         ENTRY  *CHARS* = 1 - 8 CHARACTER STRING TO FILL 60 BITS.
  
  
 LINE     MACRO  C
 .1       MICRO  1,, C       COUNT CHARACTERS IN EXPRESSION 
 .1       MICCNT .1 
 .1       DECMIC .1 
          VFD    48/".1"L_C,12/0
 LINE     ENDM
 SCLASS   SPACE  4,15 
**        SCLASS - DEFINE SERVICE CLASS TABLE.
* 
*         SCLASS NM,MN,DF,ST,TX 
* 
*         ENTRY  *NM* = SERVICE CLASS NAME. 
*                *MN* = TWO CHARACTER MNEMONIC. 
*                *DF* = DAYFILE MESSAGE CHARACTER.
*                *ST* = SHORT TEXT FOR *QFTLIST*. 
*                *TX* = TEXT OF SERVICE CLASS NAME FOR BANNER PAGE. 
* 
*         NOTE - THE CALL TO *COMSSCD* MUST FOLLOW THE DEFINITION OF
*                THIS MACRO.
  
  
          PURGMAC  SCLASS 
  
 SCLASS   MACRO  NM,MN,DF,ST,TX 
 .SCL     RMT 
          INDEX  NM,(=Z*TX_.*)
 .SCL     RMT 
 SCLASS   ENDM
  
  
 SCL$     EQU    0           ONLY PROCESS CLASSES WITH JCB-S
*CALL     COMSSCD 
          SPACE  4,10 
****      DIRECT CELL USAGE.
  
  
 CI       EQU    FP          CONTROL INFORMATION
 BG       EQU    FP+1        BANNER GENERATION FLAGS
 SS       EQU    EQ          SYSTEM SECTOR INFORMATION STATUS 
 WC       EQU    FP+2        WORD COUNT 
 BC       EQU    FP+3        NUMBER OF WORDS LEFT IN CM BUFFER
 LC       EQU    FC          LINE COUNT 
****
          TITLE  MAIN ROUTINE.
 GBP      SPACE  4,10 
**        GBP - MAIN ROUTINE. 
  
  
          ORG    OVL
  
 GBP      SUBR               ENTRY/EXIT 
          RJM    PRS         PRESET OVERLAY 
          RJM    RID         READ JOB IDENTIFICATION
          LDC    BUFP        LWA OF BUFFER
          STD    T7 
          LDN    LCN1        SET NUMBER OF LINES IN HEADER
          RJM    WAB
          NJN    GBP1        IF WRITE NOT COMPLETE
          LDC    4000        SET SYSTEM SECTOR INFORMATION NOT NEEDED 
 GBPA     EQU    *-1
*         LDC    0           (*SYOT* FILE OR FILE OWNED BY UI 377777) 
          STM    GBPE 
  
**        FORMAT JOB NAME.
  
 GBP1     LDC    BUF         SET BUFFER 
          STD    T7 
          LDN    0           CLEAR LINE COUNT 
          STD    T6 
 GBP2     LDN    0           CLEAR SPACE COUNT
          STD    T2 
 GBP3     LDC    2R          SPACE OUT LINE 
          STI    T7 
          AOD    T7          ADVANCE BUFFER 
          AOD    T2          ADVANCE SPACE COUNT
          LMN    3
          NJN    GBP3        IF NOT FINISHED SPACING
          RJM    STL         STORE LINE 
          AOD    T6          ADVANCE LINE COUNT 
          LMN    LCN2 
          NJN    GBP2        LOOP FOR 16 LINES
          LDN    LCN2        WRITE CENTRAL BUFFER 
          RJM    WAB
          NJN    GBP5        IF WRITE NOT COMPLETE
 GBP4     LDC    4000 
          STM    GBPE 
 GBP5     RJM    APS         ADVANCE TO PAGE SEPARATION 
  
*         DESELECT AUTO PAGE EJECT AND (TRY TO) SELECT 8 LPI. 
  
          LDC    BUF
          STD    T7 
          LDC    BUFV        TRANSFER TO OUTPUT BUFFER
 GBPB     EQU    *-1
*         LDC    BUFW        (ELECTRONIC VERTICAL FORMAT UNIT)
*         LDC    BUFY        (NON-IMPACT PRINTER) 
          STD    T1 
          LJM    GBP6        GENERATE PAGE SEPARATION 
 GBPC     EQU    *-1
*         LJM    GBP7        (ELECTRONIC VERTICAL FORMAT UNIT)
*         LJM    GBP9        (NON-IMPACT PRINTER) 
  
 GBP6     LDI    T1 
          STI    T7 
          AOD    T7 
          AOD    T1 
          LMC    BUFW 
          NJN    GBP6        IF TRANSFER NOT COMPLETE 
  
**        BANNER PAGE SEPARATION. 
  
 GBP7     LDI    T1 
          STI    T7 
          AOD    T7 
          AOD    T1 
          LDI    T1 
          STI    T7 
          AOD    T7 
          LDN    57D
          STD    T2 
 GBP8     LDM    BUFX-BUFW-1,T1  STORE SEPARATOR CHARACTERS 
          STI    T7 
          AOD    T7 
          SOD    T2 
          NJN    GBP8        IF LINE NOT COMPLETE 
          STI    T7 
          AOD    T7 
          AOD    T1 
          LMC    BUFX 
          NJN    GBP7        IF NOT END OF DATA 
          LDN    BUFY-BUFX
 GBPF     EQU    *-1
*         LDN    BUFU-BUFX   (ELECTRONIC VERTICAL FORMAT UNIT)
          RAD    T1 
 GBP9     LMC    BUFZ 
 GBPG     EQU    *-1
*         LMC    BUFU        (NOT LAST BANNER PAGE) 
          ZJN    GBP9.1      IF TRANSFER COMPLETE 
          LDI    T1 
          STI    T7 
          AOD    T7 
          AOD    T1 
          UJN    GBP9        CONTINUE TRANSFER
  
 GBP9.1   LDN    LCN3        WRITE BANNER PAGE SEPARATION 
 GBPD     EQU    *-1
*         LDN    LCN3-LCN4   (NON-IMPACT PRINTER) 
          RJM    WAB
  
*         SET EXIT CONDITIONS AND UPDATE *IN* POINTER.
  
          ZJN    GBP10       IF END OF BANNER PAGE ENCOUNTERED
          LDC    20&1030
 GBP10    LMC    1030 
          STD    T1 
          LDD    WC          SET CONTROL INFORMATION
          ADC    0
*         ADC    4000        (SYSTEM SECTOR INFO NO LONGER NEEDED)
 GBPE     EQU    *-1
          STD    CI 
          LDN    ZERL        UDPATE IN
          CRD    CM 
          LDD    IN 
          STD    CM+3 
          LDD    IN+1 
          STD    CM+4 
          LDA    IR+3        STORE IN POINTER 
          ADN    2
          CWD    CM 
          LJM    GBPX        RETURN 
          TITLE  SUBROUTINES. 
 APS      SPACE  4,10 
**        APS - ADVANCE TO PAGE SEPARATION. 
* 
*         ENTRY  (APSB) = NUMBER OF BLANK LINES TO WRITE. 
* 
*         EXIT   BLANK LINES WRITTEN (IF NOT *BATCHIO* CALL). 
* 
*         USES   T7.
* 
*         CALLS  WAB. 
  
  
 APS      SUBR               ENTRY/EXIT 
 APSA     UJN    APSX        IF *BATCHIO* OR SKIP TO END OF FORM WORKS
*         PSN                IF NON-*BATCHIO* CALL NEEDING LINES SKIP 
          LDN    ZERL 
          CRM    BUF,ON      BLANK LINE TO ASSEMBLY BUFFER
          LDC    2R0         DOUBLE SPACE 
          STM    BUF
 APS1     LDC    0
 APSB     EQU    *-1
          ZJN    APSX        IF NO MORE TO WRITE
          SBN    2           DOUBLE SPACED LINE 
          PJN    APS2        IF ROOM FOR DOUBLE SPACED LINE 
          LDC    2R          SET SINGLE SPACED LINE 
          STM    BUF
          LDN    0           END OF LINES 
 APS2     STM    APSB        DECREMENT LINE COUNT 
          LDC    BUF+5       LWA+1 OF BUFFER
          STD    T7 
          LDN    1
          RJM    WAB         WRITE BLOCK
          UJN    APS1        ADVANCE AGAIN
 STL      SPACE  4,10 
**        STL - STORE LINE. 
* 
*         ENTRY  (T7) = BUFFER ADDRESS. 
*                (CM - CM+4) = BANNER NAME
* 
*         EXIT   (T7) ADVANCED. 
* 
*         USES   T1 - T5. 
  
  
 STL      SUBR               ENTRY/EXIT 
          LDN    0           CLEAR CHARACTER INDEX
          STD    T5 
 STL1     LDD    T5          SET BYTE ADDRESS 
          SHN    -1 
          ADN    CM 
          STD    T2 
          LDI    T2          SET UPPER CHARACTER
          SHN    -6 
          STD    T1 
          LDD    T5 
          LPN    1
          ZJN    STL2        IF UPPER CHARACTER 
          LDI    T2          SET LOWER CHARACTER
          LPN    77 
          STD    T1 
 STL2     LDD    T1          CHECK CHARACTER
          SBN    1R+
          MJN    STL3        IF LETTER LEGAL
          LDN    0           CLEAR LETTER 
          STD    T1 
 STL3     LDD    T1          LETTER INDEX = CHARACTER * 20 + LINE 
          SHN    4
          ADD    T6 
          STD    T2 
          LDM    TBAN,T2     SET LETTER BYTE
          STD    T2 
          LDN    0           CLEAR BIT COUNT
          STD    T3 
 STL4     LDN    1R          SET UPPER = SPACE
          SHN    6
          STI    T7 
          LDD    T2          SHIFT BYTE 
          SHN    1
          STD    T2 
          SHN    5
          PJN    STL5        IF NO LETTER 
          LDD    T1          SET LETTER 
          SHN    6
          STI    T7 
 STL5     LDN    1R          SET LOWER = SPACE
          RAI    T7 
          LDD    T2          SHIFT BYTE 
          SHN    1
          STD    T2 
          SHN    5
          PJN    STL6        IF SPACE 
          LDI    T7          SET LETTER 
          SCN    77 
          ADD    T1 
          STI    T7 
 STL6     AOD    T7          ADVANCE BUFFER 
          AOD    T3          ADVANCE BIT COUNT
          LMN    6
          NJN    STL4        LOOP FOR 12 BITS 
          LDC    2R          STORE 2 SPACES 
          STI    T7 
          AOD    T7 
          AOD    T5          ADVANCE CHARACTER COUNT
          LMN    10 
          ZJN    STL7        IF 8 CHARACTERS STORED 
          LJM    STL1        LOOP 
  
 STL7     STI    T7          TERMINATE LINE (LAST BYTE OF CM WORD)
          AOD    T7 
          LJM    STLX        RETURN 
 WAB      SPACE  4,20 
**        WAB - WRITE ASCII BUFFER. 
* 
*         ENTRY  (A) = NUMBER OF LINES TO WRITE.
*                (BUF) = ASSEMBLY BUFFER FOR BANNER PAGE. 
*                (LBUF) = ASSEMBLY BUFFER FOR 8/12 ASCII LINE.
*                (BC) = NUMBER OF WORDS LEFT IN BUFFER. 
*                (WC) = CURRENT CM WORD COUNT.
*                (CI) = NUMBER OF CM WORDS TO SKIP. 
*                (T7) = LWA+1 OF PP BUFFER. 
* 
*         EXIT   (A) = 0 IF END OF PP BUFFER ENCOUNTERED. 
*                (BC) = NUMBER OF WORDS LEFT IN BUFFER. 
*                (WC) = CURRENT WORD COUNT. 
* 
*         USES   LC, T1 - T7. 
* 
*         CALLS  DV5, WDB.
  
  
 WAB8     RJM    WDB         WRITE DATA BUFFER
  
 WAB      SUBR               ENTRY/EXIT 
 WABA     UJN    WAB8        WRITE DATA BUFFER
*         PSN                (8/12 ASCII PRINT FILE)
          STD    LC          SAVE LINE COUNT
          LDC    BUF
          STD    T2 
          SBN    1
          STD    T1 
          LDC    LBUF        DEFINE ASSEMBLY BUFFER ADDRESS 
          STD    T5 
 WAB1     LDN    5           LOCATE EOL 
          RAD    T1 
          LDI    T1 
          NJN    WAB1        IF NOT EOL 
          AOD    T1          SET START OF NEXT LINE 
          STD    T4 
 WAB2     SOD    T1          FIND LAST BYTE OF DATA 
          SBD    T2 
          PJN    WAB3        IF NOT EMPTY LINE
          AOD    T1 
          LDC    2R 
          STI    T1 
 WAB3     LDI    T1 
          ZJN    WAB2        IF STILL EOL BYTE
          LPN    77 
          NJN    WAB4        IF LAST CHARACTER NOT PART OF EOL
          LDN    1R 
          RAI    T1 
 WAB4     AOD    T1 
          LDD    T5          SET ASSEMBLY BUFFER ADDRESS
          STD    T3 
 WAB5     LDI    T2          UNPACK DATA BYTE 
          SHN    14 
          STD    T6 
          SHN    -14
          STD    T7 
          LDM    TDA8,T6     CONVERT UPPER CHARACTER
          STI    T3 
          AOD    T3          ADVANCE ASSEMBLY BUFFER ADDRESS
          LDM    TDA8,T7     CONVERT LOWER CHARACTER
          STI    T3 
          AOD    T3          ADVANCE ASSEMBLY BUFFER ADDRESS
          AOD    T2 
          LMD    T1 
          NJN    WAB5        IF EOL NOT REACHED 
          LDD    T3          SET END OF ASCII LINE
          STM    WABB 
          ADN    1
          SBD    T5          DETERMINE CM WORD COUNT OF LINE
          RJM    DV5
          STD    T7          SET LWA OF BUFFER FOR *WDB*
          SHN    2
          ADD    T5 
          RAD    T7 
          LDN    ZERL        ENSURE EOL ON CM WORD BOUNDARY 
          CRM    *,ON 
 WABB     EQU    *-1
          RJM    WDB         WRITE DATA BUFFER
          ZJN    WAB7        IF ENTIRE LINE WRITTEN 
 WAB6     LJM    WABX        RETURN 
  
 WAB7     SOD    LC          DECREMENT LINE COUNT 
          ZJN    WAB6        IF REQUEST SATISFIED 
          LDD    T4          RESET POINTERS TO START OF NEXT LINE 
          STD    T2 
          SBN    1
          STD    T1 
          LJM    WAB1        PROCESS NEXT LINE
 WDB      SPACE  4,20 
**        WDB - WRITE BUFFER DATA.
* 
*         ENTRY  (BC) = NUMBER OF WORDS LEFT IN BUFFER. 
*                (WC) = CURRENT CM WORD COUNT.
*                (CI) = NUMBER OF WORDS TO SKIP.
*                (T7) = LWA+1 OF PP BUFFER. 
* 
*         EXIT   (A) = 0 IF END OF PP BUFFER. 
*                (BC) = NUMBER OF WORDS LEFT IN BUFFER. 
*                (WC) = CURRENT CM WORD COUNT.
* 
*         USES   T1, T2, T6, T7.
* 
*         CALLS  WBB. 
  
  
 WDB4     AOD    WC 
          LDN    5           ADVANCE BUFFER ADDRESS 
          RAD    T2 
          SBD    T7 
          MJN    WDB1        IF NOT END OF PP BUFFER
 WDB5     LDD    T7 
  
 WDB      SUBR               ENTRY/EXIT 
          LDD    BC 
          ZJN    WDB5        IF CM BUFFER FULL
          LDC    BUF
 WDBA     EQU    *-1
*         LDC    LBUF        (8/12 ASCII PRINT FILE)
          STD    T2 
 WDB1     LDD    WC 
          SBD    CI 
          MJN    WDB4        IF WORD TO BE SKIPPED
          LDN    0
          STD    T1 
          LDD    T2          SAVE FWA OF DATA TO BE WRITTEN 
          STD    T6 
 WDB2     LDD    BC 
          ZJN    WDB3        IF CM BUFFER FULL
          SOD    BC          DECREMENT WORDS REMAINING IN BUFFER
          AOD    WC          ADVANCE WORD COUNT 
          AOD    T1          ADVANCE NUMBER OF WORDS TO WRITE 
          LDN    5           ADVANCE TO NEXT WORD 
          RAD    T2 
          SBD    T7 
          MJN    WDB2        IF NOT END OF BUFFER 
          LDN    0           SET END OF BUFFER ENCOUNTERED
          STD    T7 
 WDB3     LDD    T6          WRITE BINARY BUFFER
          RJM    WBB
          UJN    WDB5        RETURN 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
 RND$     EQU    1           SELECT ROUNDING FOR *DV5*
*CALL     COMPDV5 
 TLTR     SPACE  4,10 
**        TBAN - TABLE OF BANNER LETTERS. 
* 
*         EACH LETTER IS DESCRIBED BY 16 DATA BYTES.
*         EACH BIT CORRESPONDS TO A PRINT COLUMN. (THERE ARE 12 
*         COLUMNS/LETTER).  IF THE BIT IS SET, STORE THE LETTER.
  
  
  
*CALL     COMTBAN 
 TDA8     SPACE  4,10 
**        TDA8 - CONVERSION TABLE.
  
  
 TDA8     BSS    0
*CALL     COMTDA8 
          SPACE  4,10 
**        BUF - ASSEMBLY BUFFER.
  
  
 BUFV     LINE   Q           DESELECT AUTO PAGE EJECT 
          LINE   T           SELECT 8 LINES PER INCH
  
 BUFW     DATA   4H2  M      SKIP TO BOTTOM OF FORM BEFORE PRINT
          DATA   4H   W 
          DATA   4H   M 
          DATA   4H   W 
          DATA   4H   M 
 BUFX     DATA   2HWM 
          CON    0
          DATA   2HMW 
          CON    0
          DATA   2HWM 
          CON    0
          DATA   2HMW 
          CON    0
          DATA   2HWM 
  
 BUFY     LINE   S           DESELECT 8 LINES PER INCH
 BUFU     LINE   2           SKIP TO BOTTOM OF FORM 
          LINE   R           SELECT AUTO EJECT
 BUFZ     BSS    0
 LCN3     EQU    12          LINE COUNT FOR PAGE SEPARATION 
 .LC      SET    BUFZ-BUFY
 LCN4     EQU    .LC/5       LINE COUNT FOR POSITIONING 2ND PAGE
  
 BUF      BSS    0
          LINE   Q           DESELECT AUTO EJECT
 BUFQ     LINE   3           SKIP TO FORMAT CHANNEL 6 
 BUFS     LINE   R           RESELECT AUTO PAGE EJECT 
 BUFT     LINE   0
          LINE   0
 BUFA     DATA   20H0 
          DATA   20HOPERATING SYSTEM =
 BUFB     DATA   10H
 BUFC     DATA   10H
          DATA   10H"DATE"
          DATA   10H PRINTED =
 BUFD     DATA   10H
 BUFE     DATA   10H
          LINE
          DATA   20H0 
          DATA   16HUJN          =
 BUFG     DATA   10H
          DATA   14H  FAMILY    = 
 BUFH     DATA   10H
          DATA   20H    JOB ORIGIN    = 
 BUFI     DATA   20H
          LINE
          DATA   20H
          DATA   16HCREATING JSN =
 BUFJ     DATA   10H
          DATA   14H  USER NAME = 
 BUFK     DATA   10H
          DATA   20H    SERVICE CLASS = 
 BUFM     DATA   30H
          LINE
          DATA   70H
 BUFN     DATA   20H    ACCESS LEVEL  = 
 BUFO     DATA   20H
          LINE
          LINE   0
          LINE   0
 BUFP     BSS    0
 LCN1     EQU    13          LINE COUNT FOR HEADER INFORMATION
  
 BUFL     EQU    120D/2*16D  CHARACTERS PER LINE * LINES
  
 LBUF     EQU    BUF+BUFL    ASSEMBLY BUFFER FOR 8/12 ASCII LINE
 LBUFL    EQU    LBUF+120D+5 LWA OF ASSEMBLY BUFFER 
  
          ERRPL  LBUFL-10000  BUFFER WRAPS PP MEMORY
 SLC      SPACE  4,10 
**        ACTUAL PRINT LINE COUNTS FOR PORTIONS OF BANNER PAGE. 
* 
*         THEIR PURPOSE IS TO DEFINE THE SIZE OF THE DIFFERENT
*         SEGMENTS OF THE BANNER PAGE ACTUALLY PRINTED ON ONE PAGE. 
*         IF LAYOUT CHANGES THESE CONSTANTS MAY NEED ADJUSTMENT.
  
  
 HDLC     EQU    LCN1-2+6    HEADER LINE COUNT
 LCN2     EQU    20          BLOCK LETTER LINE COUNT
 BLLC     EQU    LCN2 
 PSLC     EQU    0           PAGE SEPARATOR NOT COUNTED FOR NOW 
 MPBL     EQU    HDLC+BLLC+PSLC  MINIMUM PAGE SIZE FOR BLOCK LETTERS
          TITLE  SUBROUTINES THAT MAY BE OVERLAID.
 BFF      SPACE  4,10 
**        BFF - BLANK FILL FIELD. 
* 
*         BLANK FILL FROM SPECIFIED POINT TO START OF DATA. 
* 
*         ENTRY  (A) = BEGINNING OF BUFFER. 
*                (T1) = BUFFER ADDRESS TO START BLANK FILL. 
* 
*         USES   T1.
  
  
 BFF2     LPN    77          CHECK LOWER CHARACTER
          NJN    BFFX        IF NOT ZERO CHARACTER
          LDN    1R 
          RAI    T1 
  
 BFF      SUBR               ENTRY/EXIT 
          STM    BFFA 
 BFF1     SOD    T1          DECREMENT ADDRESS
          LMC    ** 
 BFFA     EQU    *-1
          ZJN    BFFX        IF BEGINNING OF BUFFER 
          LDI    T1 
          NJN    BFF2        IF NOT ZERO WORD 
          LDC    2R 
          STI    T1 
          UJN    BFF1        LOOP 
 RID      SPACE  4,20 
**        RID - READ IDENTIFICATION DATA. 
* 
*         ENTRY  (FO) = QFT ORDINAL.
*                (SS) = SYSTEM SECTOR INFORMATION STATUS. 
*                (T3) = SERVICE CLASS / ORIGIN TYPE.
*                (T5) = EST ORDINAL OF PRINT FILE RESIDENCE.
*                (T6) = FIRST TRACK OF FILE.
*                (T7) = 0.
* 
*         EXIT   (BUFG) = *UJN* ASSOCIATED WITH PRINT FILE. 
*                (BUFK) = USER NAME OF JOB THAT CREATED OUTPUT. 
*                (CM - CM+4) = BANNER NAME. 
* 
*         USES   T1, T2, CM - CM+4. 
* 
*         CALLS  BFF, GBN, RDS. 
* 
*         MACROS ENDMS, SETMS, SFA. 
  
  
 RID      SUBR               ENTRY/EXIT 
          LDD    SS 
          SHN    21-13
          MJN    RID1        IF SYSTEM SECTOR READ NOT NEEDED 
          SETMS  IO 
          LDC    BFMS        READ SYSTEM SECTOR 
          RJM    RDS
 RID1     MJP    RID4        IF SYSTEM SECTOR NOT READ
          ENDMS 
          LDN    3
          STD    T1 
 RID3     LDM    ACSS,T1     MOVE CREATION USER NAME
          STM    BUFK,T1
          LDM    JNSS,T1     MOVE USER JOB NAME 
          STM    BUFG,T1
          LDM    FMSS,T1     MOVE FAMILY NAME 
          STM    BUFH,T1
          SOD    T1 
          PJN    RID3        IF MORE TO MOVE
          LDM    BUFG+4 
          SCN    77 
          ADN    1R          ADD BLANK
          STM    BUFG+4 
          LDM    BUFK+3      CLEAR TRAILING INFORMATION IN FIELD
          SCN    77 
          STM    BUFK+3 
          LDM    BUFH+3 
          SCN    77 
          STM    BUFH+3 
          LDM    CJSS        SET CREATING *JSN* 
          STM    BUFJ 
          LDM    CJSS+1 
          STM    BUFJ+1 
 RID4     LDC    BUFK+4      BLANK FILL USER NAME 
          STD    T1 
          SBN    5
          RJM    BFF
          LDC    BUFG+4      BLANK FILL USER JOB NAME 
          STD    T1 
          SBN    5
          RJM    BFF
          LDC    BUFH+4      BLANK FILL FAMILY NAME 
          STD    T1 
          SBN    5
          RJM    BFF
          SFA    QFT,FO 
          ADK    JSNQ 
          CRD    CM 
          LDD    T3 
          LPN    77 
          LMK    SYOT 
          ZJN    RID6        IF *SYOT* ORIGIN 
          LDD    CM+2        SET USER INDEX 
          LPN    77 
          STD    T1 
          SHN    14 
          LMD    CM+3 
          STD    T2 
          ZJN    RID6        IF OWNER UI IS ZERO
          LMC    377777 
          ZJN    RID6        IF OWNER UI IS 377777
          LDD    CM          SET CREATION *JSN* 
          STD    CM+2 
          LDD    CM+1 
          STD    CM+3 
          RJM    GBN         GENERATE BANNER NAME 
          LDD    T1 
          STD    CM 
          LDD    T2 
          STD    CM+1 
 RID5     LJM    RIDX        RETURN 
  
 RID6     LDD    MA          SET USER JOB NAME
          CWM    JNSS,ON
          SBN    1
          CRD    CM 
          LDN    0
          STM    GBPA 
          STD    CM+4 
          LDD    CM+3 
          SCN    77 
          STD    CM+3 
          UJN    RID5        RETURN 
          SPACE  4,10 
**        COMMON DECKS THAT MAY BE OVERLAID.
  
  
*CALL     COMPGBN 
          SPACE  4,10 
          ERRNG  BFMS-*      SYSTEM SECTOR OVERLAYS CODE
 PRS      SPACE  4,20 
**        PRS - PRESET OVERLAY. 
* 
*         ENTRY  (BF) = 0 IF NOT *BATCHIO* CALL.
* 
*         EXIT   (T3) = SERVICE CLASS / ORIGIN TYPE.
*                (T5) = EST ORDINAL OF PRINT FILE RESIDENCE.
*                (T6) = FIRST TRACK OF FILE.
*                (T7) = 0.
*                (WC) = 0.
*                (SS) = (CI). 
*                (BC) = NUMBER OF FREE WORDS IN CM BUFFER.
* 
*                IF NOT *BATCHIO* CALL, 
*                *BUFQ* CHANNEL 6 SKIP (*3*) CHANGED TO PAGE EJECT. 
* 
*                IF END OF FORM SKIP NOT AVAILABLE, 
*                (APSB) = LINES TO SKIP TO REACH END OF FORM. 
*                *BUFW* END OF FORM SKIP (*2*) CHANGED TO SINGLE SPACE. 
* 
*         USES   T4, CM - CM+4. 
* 
*         CALLS  BFF, CIB, MCS. 
* 
*         MACROS SFA. 
  
  
 PRS      SUBR               ENTRY/EXIT 
          LDD    BF 
          NJN    PRS1        IF *BATCHIO* 
          RJM    PNB         PRESET NON-*BATCHIO* BANNER PAGE 
          UJN    PRS4        GO CLEAR CURRENT WORD COUNT
  
 PRS1     LDN    IPPL        SET DEFAULT PRINT DENSITY
          CRD    CM 
          LDD    CM+2 
          SHN    -4 
          LPN    17 
          LMN    PDSD 
          ZJN    PRS1.1      IF SIX LINES PER INCH
          LDM    PRSA        SET EIGHT LINES PER INCH 
          STM    BUFY 
 PRS1.1   LDD    WC 
          ZJN    PRS2        IF NOT 8/12 ASCII PRINT FILE 
          LDN    PSNI 
          STM    WABA 
          LDC    LBUF 
          STM    WDBA 
 PRS2     LDD    ES          CHECK EQUIPMENT TYPE 
          SHN    21-7 
          PJN    PRS4        IF NOT PFC PRINTER 
          LDN    1R -1R0     ADJUST PAGE REGISTRATION 
 PRS3     SHN    6
          RAM    BUFA 
 PRS4     LDN    0           CLEAR CURRENT WORD COUNT 
          STD    WC 
          LDD    CI          SET CONTROL INFORMATION
          STD    SS 
          LPC    3777 
          STD    CI 
          RJM    CIB         CHECK INPUT BUFFER 
          STD    BC          SAVE NUMBER OF WORDS IN BUFFER 
          LDN    TIML        GET SYSTEM TIME AND DATE 
          CRM    BUFE,ON
          ADK    DTEL-TIML-1
          CRM    BUFD,ON
          ADK    SVNL-DTEL-1 READ VERSION NAME
          CRM    BUFB,ON
          CRM    BUFC,ON
          LDC    BUFC+5      SET BUFFER POINTER 
          STD    T1 
          LDC    BUFB        BEGINNING OF BUFFER
          RJM    BFF         BLANK FILL FIELD 
          SFA    QFT,FO 
          ADN    INSQ        GET PARAMETERS FROM QFT ENTRY
          CRD    CM 
          ADN    SCLQ-INSQ
          CRD    T3 
          SBN    SCLQ-ENTQ
          CRD    T5 
          LDD    T3          SET JOB ORIGIN NAME IN HEADER
          LPN    77 
          STD    T1 
          SBN    MXOT 
          MJN    PRS5        IF VALID ORIGIN TYPE 
          LDN    SYOT        DEFAULT TO SYSTEM
          STD    T1 
 PRS5     LDM    TOTN,T1     SET ADDRESS
          STD    T1 
          LDC    BUFI        MOVE NAME TO BUFFER
          RJM    MCS
          LDD    T3          SET SERVICE CLASS NAME IN HEADER 
          SHN    -6 
          STD    T1 
          SBN    MXJC 
          MJN    PRS6        IF VALID SERVICE CLASS 
          LDN    SYSC        DEFAULT TO SYSTEM
          STD    T1 
 PRS6     LDM    TSCN,T1     SET ADDRESS
          STD    T1 
          LDC    BUFM        MOVE NAME TO BUFFER
          RJM    MCS
          LDD    CM+3        SET ACCESS LEVEL NAME IN HEADER
          SHN    -3 
          LPN    7
          STD    T1 
          SHN    2           SET ADDRESS OF NAME
          ADC    TALN 
          RAD    T1 
          LDN    SSML        CHECK SECURITY MODE
          CRD    CM 
          LDD    CM 
          LPN    7
          NJN    PRS8        IF SECURE SYSTEM 
          LDC    BUFN 
          STD    T1 
          ADN    BUFO-BUFN
          STD    T2 
 PRS7     LDC    2R          CLEAR REFERENCE TO ACCESS LEVEL
          STI    T1 
          AOD    T1 
          LMD    T2 
          NJN    PRS7        IF NOT END OF BUFFER 
*         LDN    0
          UJN    PRS9        CLEAR SECTOR NUMBER
  
 PRS8     LDC    BUFO        MOVE NAME TO BUFFER
          RJM    MCS
          LDN    0           CLEAR SECTOR NUMBER
 PRS9     STD    T7 
          LDD    ET 
          LMK    NPDT 
          NJN    PRS10       IF NOT NON-IMPACT PRINTER
          LDK    BUFY-BUFV
          RAM    GBPB 
          LDK    GBP9-GBP6   MODIFY MAIN ROUTINE TO SKIP SEPARATION 
          RAM    GBPC 
          LCN    LCN3-LCN4
          RAM    GBPD 
 PRS10    LJM    PRSX        RETURN 
  
 PRSA     LINE   T
 PNB      SPACE 4,15
**        PNB - PRESET NON-*BATCHIO* BANNER PAGE. 
* 
*         ENTRY  (ES) = 0, IF SKIP TO BOTTOM OF FORM IS SUPPORTED.
*                     = PAGE SIZE, IF NO SKIP TO BOTTOM OF FORM.
*                (BG) = ELECTRONIC VERTICAL FORMAT UNIT, NOT FIRST
*                       BANNER AND NOT LAST BANNER FLAGS. 
* 
*         EXIT   BANNER PAGE ALTERATIONS COMPLETE FOR NON-*BATCHIO* 
*                PRINTERS WHICH DO NOT HANDLE BOTTOM OF FORM, OR HAVE 
*                ELECTRONIC VERTICAL FORMAT UNITS.  ALTERATIONS ARE 
*                ALSO MADE WHEN REQUIRED FOR FORMAT CONTROL DIFFERENCES 
*                BETWEEN PAGES OF MULTIPLE BANNER PAGE SETS.
  
  
 PNB      SUBR               ENTRY/EXIT 
          LDC    3R 1        STORE PAGE EJECT INSTEAD OF FORMAT 6 
          STM    BUFQ 
          SHN    6           CLEAR SECOND SKIP TO BOTTOM OF FORM
          STM    BUFU 
          LDD    ES          GET PAGE SIZE
          ZJN    PNB1        IF NO PAGE ALTERATIONS NECESSARY 
          SBN    MPBL        SUBTRACT NUMBER OF LINES TO BE USED
          STM    APSB        SET LINES REMAINING BEFORE SEPARATOR 
          LDK    PSNI        ENSURE LINES ARE SKIPPED 
          STM    APSA 
          LDC    2R          CLEAR SKIP TO BOTTOM OF FORM CODE
          STM    BUFW 
 PNB1     LDD    BG 
          SHN    21-12
          PJN    PNB2        IF NOT ELECTRONIC VERTICAL FORMAT UNIT 
          LDK    BUFW-BUFV   DISABLE AUTO EJECT DESELECT, 8 LPI SELECT
          RAM    GBPB 
          LDK    GBP7-GBP6
          RAM    GBPC 
          LDK    BUFU-BUFY   DISABLE 8 LPI DESELECT 
          RAM    GBPF 
          LDC    2R 
          STM    BUFQ        ELIMINATE FIRST TOP OF FORM
          STM    BUFS        ELIMINATE AUTO PAGE EJECT RESELECTION
          STM    BUFT        ADJUST FOR EXTRA LINE
 PNB2     LDD    BG 
          SHN    21-11
          PJN    PNB3        IF FIRST BANNER PAGE 
          LDC    2R          DROP AUTO EJECT DESELECT, ADJUST SPACING 
          STM    BUF
          STM    BUFQ 
          STM    BUFA 
 PNB3     LDD    BG 
          SHN    21-10
          PJN    PNB4        IF LAST BANNER PAGE
          LDK    BUFU-BUFZ   DISABLE BOTTOM OF FORM SKIP AFTER BANNER 
          RAM    GBPG 
 PNB4     UJP    PNBX        RETURN 
 MCS      SPACE  4,10 
**        MCS - MOVE CHARACTER STRING TO BUFFER.
* 
*         ENTRY  (A) = BUFFER ADDRESS.
*                (T1) = ADDRESS OF CHARACTER STRING.
* 
*         USES   T1, T2.
  
  
 MCS1     AOD    T1          ADVANCE ADDRESSES
          AOD    T2 
 MCS2     LDI    T1 
          ZJN    MCSX        IF END OF STRING 
          STI    T2 
          LPN    77 
          NJN    MCS1        IF NOT END OF STRING 
          LDN    1R 
          RAI    T2          BLANK FILL 
  
 MCS      SUBR               ENTRY/EXIT 
          STD    T2 
          UJN    MCS2        MOVE CHARACTER STRING
 TALN     SPACE  4,10 
**        TALN - TABLE OF ACCESS LEVEL NAMES. 
  
  
 TALN     BSS    0
          DATA   8H"ALM0" 
          CON    0
          DATA   8H"ALM1" 
          CON    0
          DATA   8H"ALM2" 
          CON    0
          DATA   8H"ALM3" 
          CON    0
          DATA   8H"ALM4" 
          CON    0
          DATA   8H"ALM5" 
          CON    0
          DATA   8H"ALM6" 
          CON    0
          DATA   8H"ALM7" 
          CON    0
 TOTN     SPACE  4,10 
**        TOTN - TABLE OF ORIGIN TYPE NAMES.
  
  
 TOTN     INDEX 
          INDEX  SYOT,(=Z*SYSTEM.*) 
          INDEX  BCOT,(=Z*BATCH.*)
          INDEX  RBOT,(=Z*REMOTE.*) 
          INDEX  IAOT,(=Z*INTERACTIVE.*)
  
          INDEX  MXOT 
 TSCN     SPACE  4,10 
**        TSCN - TABLE OF SERVICE CLASS NAMES.
  
  
 TSCN     INDEX 
          LIST   D
 .SCL     HERE
          LIST   *
  
          INDEX  MXJC 
          SPACE  4,10 
          USE    LITERALS 
          OVERFLOW  OVL 
          SPACE  4
          TTL    QAP - QUEUE AUXILLARY PROCESSOR. 
          END 
