1IO 
          IDENT  1IO,BCM
          PERIPH
          BASE   MIXED
          SST 
*COMMENT  1IO - BATCHIO MANAGER.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  1IO - BATCHIO MANAGER. 
          SPACE  4,10 
*****     1IO - *BATCHIO* MANAGER.
*         G. R. MANSFIELD.   70/07/20.
*         P. D. HAAS.        74/04/19.
*         R. M. YASUHARA.    75/01/17.
*         D. R. HILGREN.     79/04/06.  RESEQUENCED.
          SPACE  4,15 
***              1IO PERFORMS SCHEDULING OF ALL PROCESSES OPERATING AT
*         THE *BATCHIO* CONTROL POINT.  THIS INCLUDES - 
*         (1)  SEARCHING FOR THE HIGHEST PRIORITY *OUTPUT* AND *PUNCH*
*         FILES.
*         (2)  CHECKING FOR A *READY* STATUS ON ANY CARD READERS. 
*         (3)  MANAGING BUFFER STORAGE FOR THE ABOVE. 
*         (4)  POSTING ERROR CONDITION MESSAGES FOR THE ABOVE.
* 
*         1IO WITH THE OVERLAY 3ID INITIALIZES THE *BATCHIO*
*         CONTROL POINT TO AN FL=200, AND SETS THE AVAILABLE EQUIPMENT
*         LIST FROM WHICH THE OPERATIONS ARE SCHEDULED. 
*         ALSO SET IN THE CONTROL POINT ARE THE CONVERSION MODE TABLES
*         WHICH 1CD WILL USE WHEN DRIVING THE VARIOUS EQUIPMENTS. 
          SPACE  4,10 
***       CALL. 
* 
* 
*T        18/  *1IO*,1/P,5/  CP,5/,1/F,6/ RS,12/  BN,12/  AB
* 
*         P      PRESET PERFORMED.
*         CP     CONTROL POINT NUMBER.
*         F      FILE PREVIOUSLY REQUESTED FLAG.
*         RS     RELEASE STORAGE REPEAT COUNT.
*         BN     BUFFER POINT NUMBER CURRENTLY UNDER CONSIDERATION. 
*         AB     ACTIVE BUFFER COUNT. 
          SPACE  4,10 
***       DAYFILE AND ERRLOG MESSAGES.
* 
* 
*         *EQXXX CCC/NIP CONTROLWARE LOADED.* = 
*                INFORMATIVE MESSAGE INDICATING THAT CCC/NIP
*                CONTROLWARE WAS LOADED SUCCESSFULLY. 
* 
*         *EQXXX CCC/NIP CONTROLWARE LOAD ERROR.* = ERROR WAS 
*                ENCOUNTERED IN THE CCC/NIP CONTROLWARE WHEN ATTEMPTING 
*                TO LOAD THE CCC. 
* 
*         *EQXXX CCC/NIP CONTROLWARE NOT FOUND.* =
*                CCC/NIP CONTROLWARE WAS NOT FOUND ON THE SYSTEM FILE.
* 
*         *EQXXX CCC/NIP STATUS ERROR.* = A STATUS OF 5XXX WAS
*                RETURNED FROM THE CCC. 
* 
*         *EQXXX CHANNEL PARITY ERROR.* = 
*                A PARITY ERROR WAS DETECTED ON A CONVERTER 
*                OR EQUIPMENT.
* 
*         *EQXXX CONTROLLER HUNG BUSY.* = 
*                THE CONTROLLER DOES NOT DROP BUSY STATUS.
* 
*         *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 TRANSMISSION PARITY ERROR.* =
*                A TRANSMISSION PARITY ERROR WAS DETECTED.
* 
*         *EQXXX TURNED OFF BY SYSTEM.* = 
*                FAULTY EQUIPMENT WAS TURNED OFF BY THE SYSTEM. 
* 
*         * NO EQUIPMENT AVAILABLE.* =
*                *BIO* DETERMINED THAT THERE IS NO EQUIPMENT IN 
*                THE SYSTEM THAT IT CAN DRIVE.
* 
*         * RECOVERY COMPLETE.* = 
*                INFORMATIVE MESSAGE. 
* 
*         WHERE-
*         EQ = EQUIPMENT MNEMONIC.
*         XXX = EST ORDINAL.
          SPACE  4,10 
***       OPERATOR *I* DISPLAY STATUS MESSAGES. 
* 
*         *NOT READY.* = DEVICE IS NOT READY. 
* 
*         *OFF.* = DEVICE IS *OFF* IN THE EST.
* 
*         *DOWN.* = DEVICE IS *DOWN* IN THE EST.
* 
*         *OFF - CHECK ERRLOG.* = DEVICE HAS BEEN TURNED OFF DUE TO A 
*         HARDWARE PROBLEM.  CHECK THE ERRLOG FOR THE DETAILS.
* 
*         *INTERVENTION NEEDED.* = DEVICE NEEDS OPERATOR INTERVENTION.
* 
*         *CH UNAVAILABLE.* = CHANNEL COULD NOT BE RESERVED.
          SPACE  4,10 
***       ERROR PROCESSING. 
* 
* 
*         CHANNEL ERROR PROCESSING. 
* 
*         THE FOLLOWING CHANNEL ERRORS ARE DETECTED - 
*                CONNECT REJECT.
*                FUNCTION REJECT. 
*                TRANSMISSION PARITY ERRORS.
*                INCOMPLETE DATA TRANSFER.
*                6681 FUNCTION TIMEOUT. 
*                EQUIPMENT FUNCTION TIMEOUT.
*                CCC/NIP STATUS ERROR.
*         WHEN ANY OF THESE CHANNEL ERRORS ARE DETECTED, THE
*         FOLLOWING ACTION IS TAKEN - 
*                OUTPUT FILES ARE REQUEUED. 
*                TRACKS FOR INPUT FILES ARE DROPPED.
*                THE FAULTY EQUIPMENT IS TURNED OFF AND DROPPED.
*                ERROR LOG MESSAGES ARE ISSUED. 
* 
*         BAD SYSTEM SECTOR ERROR PROCESSING. 
* 
*         IF AN ERROR IS ENCOUNTERED WHILE READING THE SYSTEM 
*         SECTORS, THE FILE IS RELEASED FROM THE *BATCHIO* CP 
*         WITH THE FOLLOWING CONDITIONS - 
*                THE NAME OF THE FILE IS CHANGED TO -**BAD O-.
*                THE FILE TYPE IS CHANGED TO COMMON.
*                WRITE LOCKOUT IS SELECTED FOR THE FILE.
          SPACE  4,10 
**        ROUTINES USED.
* 
* 
*         3IA - 1IO SUBROUTINES.
*         3IB - 1IO LOAD IMAGE MEMORY.
*         3IC - 1IO ERROR ROUTINES. 
*         3ID - 1IO PRESET ROUTINES.
*         3IF - 1IO LOAD CCC/NIP CONTROLWARE. 
          SPACE  4,10 
**        PROGRAMS CALLED.
* 
* 
*         CIO - COMBINED INPUT/OUTPUT.
*         QAC - QUEUE ACCESS. 
*         QAP - QUEUE AUXILIARY PROCESSOR.
*         1CD - *BATCHIO* DRIVER. 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPMAC 
*CALL     COMSACC 
*CALL     COMPCHI 
          LIST   X
*CALL     COMSBIO 
          LIST   *
*CALL     COMSCPS 
*CALL     COMSDFS 
*CALL     COMSDSP 
*CALL     COMSEVT 
*CALL     COMSJCE 
*CALL     COMSJIO 
*CALL     COMSPIM 
*CALL     COMSQAC 
*CALL     COMSSSD 
          SPACE  4,10 
****      DIRECT LOCATION ASSIGNMENTS.
  
  
 RI       EQU    16 - 17     RANDOM INDEX (2 LOCATIONS) 
 ES       EQU    20 - 24     EST ENTRY
 EC       EQU    25          EQUIPMENT TYPE CODE
 FC       EQU    26          FUNCTION CODE
 EI       EQU    27          EQUIPMENT INDEX
 CN       EQU    30 - 34     CM WORD BUFFER (5 LOCATIONS) 
 CS       EQU    35          CONVERTER STATUS 
 ST       EQU    36          EQUIPMENT STATUS 
 ET       EQU    37          EQUIPMENT DEFINITION 
 FN       EQU    40 - 44     FILE NAME (5 LOCATIONS)
 AB       EQU    FN - FN+4   PROGRAM NAME (5 LOCATIONS) 
 EQ       EQU    45          EST ORDINAL / DEVICE TYPE
 BA       EQU    46 - 47     BUFFER ADDRESS (2 LOCATIONS) 
 FA       EQU    57          FNT ADDRESS
 FS       EQU    60 - 64     FST INFORMATION (5 LOCATIONS)
 RT       EQU    65          ERROR RETRY COUNT + RECOVERY FLAG
 MC       EQU    66          ERROR MESSAGE CODE 
 RC       EQU    67          CHANNEL ERROR RETRY COUNT
          SPACE  4,10 
*         ASSEMBLY CONSTANT.
  
  
 CH       EQU    12          CHANNEL NUMBER 
 BFL      EQU    BUFR+77     BUFFER LENGTH, ROUNDED UP
 MSR$     EQU    0           DEFINE ERROR PROCESSOR FOR *COMPRNS* 
 SAF$     EQU    1           DEFINE ENTRY CONDITION FOR *COMPSAF* 
****
 DBMLT    SPACE  4,10 
**        DBMLT - DEFINE BML MESSAGE TABLE. 
* 
*         DBMLT  MSGCD,PROC,SYMPC,NBYTES. 
* 
*         ENTRY  MSGCD = MESSAGE CODE.
*                PROC = ADDRESS OF BML MESSAGE PROCESSOR. 
*                SYMPC = SYMPTOM CODE FOR BML MESSAGE.
*                NBYTES = NUMBER OF BYTES IN BML MESSAGE. 
  
  
 DBMLT    MACRO  MSGCD,PROC,SYMPC,NBYTES
 DTPR     RMT 
          INDEX  MSGCD-BAME,PROC
          RMT 
 DTSY     RMT 
          INDEX  MSGCD-BAME,SYMPC 
          RMT 
 DTNB     RMT 
          INDEX  MSGCD-BAME,NBYTES
          RMT 
          ENDM
 DEFOIES  SPACE  4,10 
**        DEFOIES - DEFINE LOAD ADDRESS OF ERROR ROUTINES.
* 
*         DEFOIES  ADDR 
* 
*         ENTRY  *ADDR* = LOAD ADDRESS.  IF NOT SPECIFIED, USE
*                         CURRENT ADDRESS + 5.
* 
*         EXIT   *OIES* = NEW OVERLAY LOAD ADDRESS VALUE. 
  
  
          PURGMAC  DEFOIES
  
 DEFOIES  MACRO  ADDR 
          MACREF DEFOIES
          NOREF  .1 
          QUAL
 .1       SET    ADDR *+5 
          IF     -DEF,OIES
 OIES     SET    .1 
          ELSE
 OIES     MAX    OIES,.1
          ENDIF 
          QUAL   *
 DEFOIES  ENDM
          SPACE  4,10 
*         DEFINE QUAL BLOCK ORDER.
  
  
          QUAL   3IA
          QUAL   3IB
          QUAL   3IC
          QUAL   3ID
          QUAL   3IF
          QUAL   5IA
          QUAL   5IC
          QUAL   5ID
          QUAL   5IE
          QUAL   5IG
          QUAL   5IH
          QUAL
          TITLE  MAIN PROGRAM.
 BCM      SPACE  4,10 
**        BCM - MAIN PROGRAM. 
  
  
          ORG    PPFW 
  
 BCM      LDD    IR+1        CHECK PRESET FLAG
          SHN    14 
          MJN    BCM1        IF NOT FIRST ENTRY 
          EXECUTE  3ID       PRESET BATCHIO 
 BCM1     LDN    0           CLEAR FST ADDRESS
          STD    RT 
          STD    FA 
          STD    BA          CLEAR BUFFER ADDRESS 
          STD    BA+1 
          LDD    IR+4        CLEAR RECOVERY FLAG
          LPN    77 
          STD    IR+4 
          LDD    CP          CHECK IDLEDOWN STATUS
          ADN    SNSW 
          CRD    CM 
          LDD    CM+3 
          SHN    21-3 
          PJN    BCM3        IF IDLEDOWN NOT REQUESTED
 BCM2     LDD    IR+4 
          NJN    BCM4        IF BUFFERS ASSIGNED
          LJM    DPP         DROP PP
  
 BCM3     LDD    RA          CHECK FOR PENDING REQUEST
          SHN    6
          ADN    DRQR 
          CRD    CM 
          LDD    CM 
          ZJN    BCM5        IF NO PENDING REQUEST
 BCM4     LJM    BCM11       TERMINATE PROCESSING 
  
 BCM5     LDN    TAEQL/5
          STD    T1 
          LDD    RA          READ EQUIPMENT TABLE 
          SHN    6
          ADK    TEQR 
          CRM    TAEQ,T1
          LDD    IR+2        CHECK FILE REQUESTED FLAG
          SHN    21-6 
          MJN    BCM7        IF FILE PREVIOUSLY REQUESTED 
  
*         ENTER FILE REQUEST. 
  
          RJM    REQ         REQUEST EQUIPMENT
          ZJN    BCM4        IF NO EQUIPMENT AVAILABLE
          RJM    CPB         CLEAR *QAC* PARAMETER BLOCK
          LDD    EQ          SET EQUIPMENT TYPE 
          LPN    7
          STD    T1 
          LDM    BCMA,T1
          STD    T1 
          LJM    0,T1        PROCESS EQUIPMENT
  
*         RELEASE FILE BACK TO QUEUE. 
  
 BCM6     EXECUTE  3IC
          LJM    /3IC/CAS    RELEASE FILE BACK TO QUEUE 
  
*         FILE PREVIOUSLY REQUESTED.
  
 BCM7     RJM    CFF         CHECK FOR FILE 
          MJN    BCM8        IF FILE FOUND
          ZJN    BCM11       IF REQUEST NOT COMPLETE
          LDD    FL          CLEAR ANY PENDING FL REQUEST 
          RJM    RSI
          AOM    RCLA        SET NO RECALL REQUESTED FLAG 
          UJN    BCM10       RELEASE EQUIPMENT
  
*         PREPARE COMMUNICATION AREA FOR *1CD*. 
  
 BCM8     LDD    EQ          CHECK FOR PRINTER
          LPN    7
          SBK    LPDT 
          NJN    BCM9        IF NOT PRINTER 
          EXECUTE  3IB       LOAD IMAGE MEMORY
          NJN    BCM6        IF MEMORY NOT LOADED 
 BCM9     EXECUTE  3IA       ASSIGN JOB 
          RJM    /3IA/ABF    ASSIGN BUFFER
          LJM    /3IA/ADR    ASSIGN DRIVER
  
*         RELEASE EQUIPMENT AND TERMINATE PROCESSING. 
  
 BCM10    RJM    RLE         RELEASE EQUIPMENT
 BCM11    RJM    MSG         PROCESS MESSAGES 
          RJM    CPR         CHECK PENDING REQUEST
          RJM    CSR         CHECK STORAGE RELEASE
*         UJN    RCL         RECALL *1IO* 
 RCL      SPACE  4,10 
**        RCL - RECALL *1IO*. 
  
  
 RCL      PAUSE              CHECK ERROR FLAG 
          LDD    CM+1 
          NJN    ERR         IF ERROR FLAG SET
 RCLA     LDN    0           RECALL REQUESTED 
*         LDN    1           (NO RECALL REQUESTED)
          ZJN    RCL1        IF RECALL REQUESTED
          SOM    RCLA 
          LJM    BCM         CHECK NEXT EQUIPMENT 
  
 RCL1     LDN    ZERL 
          CRD    CM 
 RCL2     LDD    MA          ENTER PP RECALL REQUEST
          CWD    IR 
          MONITOR  RECM 
 RCL3     LJM    PPR         EXIT TO PP RESIDENT
 DPP      SPACE  4,10 
**        DPP - DROP PP.
  
  
 DPP      MONITOR  DPPM      DROP PP
          LJM    PPR         EXIT TO PP RESIDENT
 ERR      SPACE  4,10 
**        ERR - PROCESS ERROR.
* 
*         ENTRY  (A) = ERROR FLAG.
  
  
 ERR      LMN    IDET 
          ZJN    DPP         IF IDLEDOWN
          EXECUTE  3IC
          RJM    /3IC/PEF    PROCESS ERROR FLAG 
          UJN    DPP         DROP PP
  
  
 BCMA     INDEX 
          INDEX  LPDT,LPP 
          INDEX  CPDT,CPP 
          INDEX  CRDT,CRP 
          INDEX  NPDT,LPP 
          INDEX  MXDT 
 LPP      SPACE  4,10 
**        LPP - LINE PRINTER PROCESSOR. 
  
  
 LPP      LDN    1S2         FILE TYPE = PRINT
          LJM    SFF         SEARCH FOR FILE
 CPP      SPACE  4,10 
**        CPP - CARD PUNCH PROCESSOR. 
  
  
 CPP      LDN    1S3         FILE TYPE = PUNCH
          LJM    SFF         SEARCH FOR FILE
 CRP      SPACE  4,10 
**        CRP - CARD READER PROCESSOR.
  
  
 CRP      LDD    ST          CHECK STATUS 
          LPN    40 
          ZJN    CRP1        IF *INPUT TRAY NOT EMPTY*
          LJM    BCM10       RELEASE EQUIPMENT
  
 CRP1     LDC    2R          SET DUMMY NAME *  * FOR INPUT FILE 
          STM    QACB 
          LDN    BCOT        SET BATCH ORIGIN TYPE
          STM    QACB+5*5+4 
          LJM    BCM9        ASSIGN JOB 
          TITLE  SUBROUTINES. 
 CAD      SPACE  4,10 
**        CAD - CLEAR AND DISCONNECT EQUIPMENT. 
* 
*         ENTRY  (ES+1) = CHANNEL (RESERVED). 
*                (EQ) = 9/EST ORDINAL, 3/DEVICE TYPE. 
* 
*         EXIT   (A) = 0. 
*                CHANNEL RELEASED.
* 
*         CALLS  FCN. 
* 
*         MACROS DCHAN. 
  
  
 CAD      SUBR               ENTRY/EXIT 
          LDD    EQ          CHECK EQUIPMENT
          LPN    7
          SBK    NPDT 
          ZJN    CAD1        IF NON-IMPACT PRINTER
          LDN    0           CLEAR AND DISCONNECT 
          RJM    FCN
 CAD1     LDD    ES+1        RELEASE CHANNEL
          DCHAN 
*         LDN    0
          UJN    CADX        RETURN 
 CCT      SPACE  4,15 
**        CCT - CONNECT TO EQUIPMENT. 
* 
*         ENTRY  (ES - ES+4) = EST ENTRY. 
* 
*         EXIT   (A) = GENERAL STATUS.
* 
*         ERROR  TO *FCN2* IF FUNCTION TIMEOUT. 
*                TO *FCN3* IF ERROR.
* 
*         CALLS  CFN, CGS.
  
  
 CCT4     DCN    CH+40
          RJM    CGS         GET GENERAL STATUS 
          NJN    CCT3        IF ERROR 
          LDD    ST          CHECK STATUS 
          SHN    -11
          LMN    5
          ZJN    CCT2        IF STATUS ERROR
          LDD    ST 
  
 CCT      SUBR               ENTRY/EXIT 
          LDN    0           ISSUE SELECT UNIT FUNCTION 
          RJM    CFN
          NJN    CCT3        IF ERROR 
          LDD    ES+4        SET DEVICE 
          SHN    -11
          ACN    CH 
          OAN    CH+40
 CCT1     ADD    ON 
          EJM    CCT4,CH     IF FUNCTION ACCEPTED 
          NJN    CCT1        IF NOT TIMED OUT 
          LJM    FCN2        PROCESS FUNCTION TIMEOUT 
  
 CCT2     LDN    ECSE        *EQXXX CCC/NIP STATUS ERROR.*
 CCT3     LJM    FCN3        PROCESS ERROR
 CEQ      SPACE  4,15 
**        CEQ - CHECK EQUIPMENT AVAILABLE.
* 
*         ENTRY  (A) = EST ORDINAL. 
* 
*         EXIT   (A) = 0 IF EQUIPMENT AVAILABLE AND RESERVED. 
*                (T5) = EST ORDINAL.
*                (ES - ES+4) = EST ENTRY. 
* 
*         USES   CM - CM+4, FS - FS+4.
* 
*         CALLS  IOM. 
* 
*         MACROS MONITOR, SFA.
  
  
 CEQ2     LDD    FS+4 
          NJN    CEQX        IF EQUIPMENT ASSIGNED
          LDD    ES 
          ERRNZ  REQS        CODE ASSUMES *REQS* = 0
          LPN    2
          NJN    CEQ1        IF EQUIPMENT OFF 
          STD    CM+2 
          MONITOR  REQM      RESERVE EQUIPMENT
          LDD    CM+1 
          ZJN    CEQ3        IF NOT ASSIGNED
          LCN    1
 CEQ3     ADN    1           RETURN ASSIGNED ELSEWHERE STATUS 
  
 CEQ      SUBR               ENTRY/EXIT 
          STD    T5 
          STD    CM+1 
          SFA    EST         FETCH EST ENTRY
          ADK    EQDE 
          CRD    ES 
          ADK    EQAE-EQDE   READ EQUIPMENT ASSIGNMENT WORD 
          CRD    FS 
          LDD    ES 
          LPN    3           CHECK DEVICE STATE 
          LMN    3
          NJN    CEQ2        IF EQUIPMENT NOT DOWN
          LDN    EDWN&EOFF&2
 CEQ1     LMN    EOFF&2 
          RJM    IOM         ISSUE OPERATOR MESSAGE 
          LDN    1           SET NOT AVAILABLE
          UJN    CEQX        RETURN 
 CFF      SPACE  4,20 
**        CFF - CHECK FOR FILE. 
* 
*         ENTRY  (IR+2) = FILE REQUESTED FLAG SET (BIT 6).
*                (IR+3) = BUFFER POINT NUMBER.
* 
*         EXIT   (A) .GT. 0 IF FILE NOT FOUND OR ERRORS.
*                (A) = 0 IF *QAC* REQUEST NOT COMPLETE. 
*                (A) .LT. 0 IF FILE FOUND.
*                AVAILABLE EQUIPMENT TABLE WRITTEN. 
*                (EQ) = EST ORDINAL / DEVICE TYPE.
*                (ES - ES+4) = EST ENTRY. 
*                (FA) = FNT ADDRESS.
*                (FS - FS+4) = FST ENTRY. 
*                (QACB - QACB+QACBL) = *QAC* PARAMETER BLOCK. 
* 
*         USES   EQ, T1.
* 
*         MACROS NFA, SFA.
  
  
 CFF      SUBR               ENTRY/EXIT 
          LDM    TAEQ+1,IR+3 SET EST ORDINAL / DEVICE TYPE
          STD    EQ 
          SHN    -3 
          SFA    EST
          ADK    EQDE 
          CRD    ES 
  
*         CHECK *QAC* PARAMETER BLOCK.
  
          LDN    QAPBL       READ *QAC* PARAMETER BLOCK 
          STD    T1 
          LDD    RA 
          SHN    6
          ADC    QAPB 
          CRM    QACB,T1
          LDM    QACB+0*5+4 
          LPN    1
          ZJN    CFFX        IF *QAC* REQUEST NOT COMPLETE
          LDD    IR+2        CLEAR FILE REQUESTED FLAG
          LMD    HN 
          STD    IR+2 
          LDM    QACB+0*5+3  CHECK ERROR CODE 
          SHN    6
          LMM    QACB+0*5+4 
          SHN    -12
          NJN    CFF1        IF ERROR 
          LDM    QACB+4*5    SET FNT OFFSET 
          STD    FA 
          NFA    FA,R        READ FST INFORMATION 
          ADN    FSTL 
          CRD    FS          READ FST ENTRY 
          LCN    0           INDICATE NO ERRORS 
 CFF1     LJM    CFFX        RETURN 
 CFN      SPACE  4,15 
**        CFN - OUTPUT FUNCTION TO EQUIPMENT. 
* 
*         ENTRY  (A) = FUNCTION CODE. 
* 
*         EXIT   (A) = 0 IF FUNCTION SUCCESSFUL.
*                (FC) = FUNCTION CODE IF NOT GENERAL STATUS FUNCTION. 
* 
*         ERROR  (A) = ERROR MESSAGE CODE.
* 
*         USES   T1.
  
  
 CFN2     LDN    0
  
 CFN      SUBR               ENTRY/EXIT 
          FAN    CH          ISSUE FUNCTION 
          STD    T1 
          LMN    12 
          ZJN    CFN1        IF GENERAL STATUS FUNCTION 
          LMN    12          SAVE FUNCTION CODE FOR ERROR MESSAGE 
          STD    FC 
 CFN1     ADD    ON 
          IJM    CFN2,CH     IF FUNCTION ACCEPTED 
          NJN    CFN1        IF NOT TIMED OUT 
          DCN    CH+40
          LDD    T1 
          STD    FC 
          LDN    EFTM        *EQXXX FUNCTION TIMEOUT.*
          UJN    CFNX        RETURN 
 CGS      SPACE  4,15 
**        CGS - GET GENERAL STATUS. 
* 
*         ENTRY  (EQ) = 9/EST ORDINAL, 3/DEVICE TYPE. 
*                (ES - ES+4) = EST ENTRY. 
* 
*         EXIT   (A) = 0 IF GENERAL STATUS OBTAINED.
*                (ST) = GENERAL STATUS. 
* 
*         CALLS  CFN, PCP.
  
  
 CGS2     LDD    RC 
          ZJN    CGSX        IF NO ERRORS 
          LDN    0           REPORT CHANNEL PARITY ERRORS 
 CGS3     RJM    PCP
          LDN    0
  
 CGS      SUBR               ENTRY/EXIT 
 CGS1     LDN    12          ISSUE GENERAL STATUS FUNCTION
          RJM    CFN
          NJN    CGSX        IF ERROR 
          ACN    CH 
          IAN    CH+40
          DCN    CH+40
          STD    ST 
          CFM    CGS2,CH     IF NO CHANNEL ERROR
          AOD    RC 
          SBK    CHPR 
          NJN    CGS1        IF RETRY COUNT NOT EXHAUSTED 
          LDN    1
          UJN    CGS3        PROCESS UNRECOVERED PARITY ERROR 
 CON      SPACE  4,20 
**        CON - CONNECT EQUIPMENT.
* 
*         ENTRY  6681 CONNECTED.
*                (ES - ES+4) = EST ENTRY. 
* 
*         EXIT   (A) = BITS 0 - 2 OF 6681 STATUS. 
*                (CS) = 6681 STATUS.
*                (ST) = EQUIPMENT STATUS. 
*                (FC) = CONNECT CODE. 
*                EQUIPMENT CONNECTED. 
*                IF THE CONNECT FUNCTION TIMES OUT, THEN EXIT IS MADE 
*                TO *RAF* VIA *FCN2*. 
* 
*         USES   FC.
* 
*         CALLS  GST, IFN.
  
  
 CON2     DCN    CH+40
          RJM    GST         GET STATUS OF 6681 AND EQUIPMENT 
  
 CON      SUBR               ENTRY/EXIT 
          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 
 CON1     EJM    CON2,CH     IF CONNECT RESPONSE RECEIVED 
          SBN    1
          NJN    CON1        IF NOT TIMED OUT 
          LJM    FCN2        FUNCTION TIMEOUT ERROR PROCESSOR 
 CPB      SPACE  4,10 
**        CPB - CLEAR *QAC* PARAMETER BLOCK.
* 
*         USES   T2.
  
  
 CPB      SUBR               ENTRY/EXIT 
          LDC    QACB 
          STD    T2 
 CPB1     LDN    0           CLEAR PARAMETER BLOCK
          STI    T2 
          AOD    T2          ADVANCE ADDRESS
          LMC    QACB+QACBL 
          NJN    CPB1        IF NOT END OF PARAMETER BLOCK
          LDC    QAPBL*100-500  SET PARAMETER BLOCK LENGTH
          STM    QACB+1*5+3 
          UJN    CPBX        RETURN 
 CPR      SPACE  4,10 
**        CPR - CHECK PENDING REQUEST.
* 
*         CHECKS IF REQUEST IS PENDING FOR A *1CD* THAT HAS DROPPED 
*         OUT.
* 
*         EXIT TO *3IA* IF PENDING REQUEST AND *1CD* NOT ACTIVE.
* 
*         USES   EC, CM - CM+4, CN - CN+4.
* 
*         CALLS  *3IA*. 
* 
*         MACROS EXECUTE. 
  
  
 CPR      SUBR               ENTRY/EXIT 
          LDD    RA 
          SHN    6
          ADN    DRQR 
          CRD    CN 
          LDD    CN 
          ZJN    CPRX        IF NO PENDING REQUEST
          LDD    RA          CHECK IF *1CD* ACTIVE
          SHN    6
          ADD    CN 
          CRD    CM 
          LDD    CM 
          NJN    CPRX        IF *1CD* ACTIVE
          LDD    CN+1        SET DEVICE TYPE
          LPN    7
          STD    EC 
          EXECUTE  3IA
          LJM    /3IA/ADR4   ASSIGN DRIVER
 CSR      SPACE  4,10 
**        CSR - CHECK FOR STORAGE RELEASE.
* 
*         ENTRY  (IR - IR+4) SET. 
* 
*         USES   IR+2, IR+4, BA - BA+1, CM - CM+4, CN - CN+4, T1 - T4.
* 
*         MACROS MONITOR, PAUSE.
  
  
 CSR      SUBR               ENTRY/EXIT 
          LDD    IR+4 
          LPN    77 
          ZJN    CSRX        IF NO BUFFER ASSIGNED
          AOD    IR+2        ADVANCE ENTRY COUNT
          LPN    77 
          LMN    5
          NJN    CSRX        IF NOT 5 ENTRIES 
          LDD    IR+2 
          SCN    77 
          STD    IR+2        CLEAR ENTRY COUNT
          LDN    0           CLEAR BUFFER COUNT 
          STD    T1 
          STD    T4          CLEAR LAST BUFFER NUMBER 
          STD    T2          SET BUFFER ADDRESS 
          STD    BA 
          LDC    BUFR 
          STD    T3 
          STD    BA+1 
 CSR1     LDD    T2          READ BUFFER STATUS 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    T3 
          CRD    CM 
          ADN    4           READ LIMIT 
          CRD    CN 
          LDD    CM 
          ZJN    CSR2        IF BUFFER FREE 
          LDD    CN+3        SET BUFFER LIMIT 
          STD    BA 
          LDD    CN+4 
          STD    BA+1 
          LDD    T1          SET CURRENT BUFFER COUNT 
          ADN    1
          STD    T4 
 CSR2     LDD    CN+3        SET NEXT BUFFER ADDRESS
          STD    T2 
          LDD    CN+4 
          STD    T3 
          AOD    T1          ADVANCE BUFFER COUNT 
          LMD    IR+4 
          NJN    CSR1        IF NOT END OF BUFFERS
          LDD    BA          CHECK LAST BUFFER
          SHN    14 
          ADD    BA+1 
          ADN    77 
          SHN    -6 
          STD    CM+1 
          STD    T1 
          LMD    FL 
          ZJN    CSR3        IF NO FL CHANGE
          LDN    0           SET CM REQUEST 
          STD    CM+2 
          MONITOR  RSTM      REQUEST STORAGE
          PAUSE 
          LDD    FL          CHECK STORAGE
          LMD    T1 
          NJN    CSR3        IF NOT RELEASED
          LDD    T4          SET NEW BUFFER COUNT 
          STD    IR+4 
 CSR3     LJM    CSRX        RETURN 
 C2D      SPACE  4,10 
**        C2D - CONVERT 2 DIGITS. 
* 
*         ENTRY  (A) = DIGITS RIGHT JUSTIFIED.
* 
*         EXIT   (A) = DIGITS CONVERTED WITH LEADING 0 SUPPRESSED.
* 
*         USES   T0.
  
  
 C2D      SUBR               ENTRY/EXIT 
          LPN    77          UNPACK DIGITS
          STD    T0 
          SHN    3
          LMD    T0 
          SCN    70 
          ADC    2R00        CONVERT
          STD    T0 
          SHN    -6 
          LMN    1R0         DELETE LEADING 0 
          NJN    C2D1        IF NO LEADING ZERO 
          LDN    1R -1R0
          SHN    6
          RAD    T0 
 C2D1     LDD    T0 
          UJN    C2DX        RETURN 
 FCN      SPACE  4,10 
**        FCN - ISSUE FUNCTION TO EQUIPMENT.
* 
*         ENTRY  (A) BITS    0 - 11 = FUNCTION CODE.
*                            12 - 17 = 0, ABORT IF ERROR DETECTED 
*                            IN 6681 STATUS.
*                            12 - 17 .NE. 0, EXIT IF EXTERNAL REJECT. 
* 
*         EXIT   (A) = BITS 0 - 2 OF 6681 STATUS. 
*                IF THE EXTERNAL REJECT EXIT IS REQUESTED 
*                AND THAT ERROR OCCURS, A NORMAL EXIT FROM
*                *FCN* TAKES PLACE. 
*                OTHERWISE, IF A FUNCTION REJECT OR 
*                TRANSMISSION PARITY ERROR IS DETECTED, OR
*                IF THE FUNCTION TIMES OUT, 
*                THEN EXIT IS MADE TO */3IC/CAS*. 
* 
*         USES   FC, MC, T6.
* 
*         CALLS  GST, *3IC*.
* 
*         MACROS DCHAN, EXECUTE.
  
  
 FCN4     RJM    GST         GET 6681 AND EQUIPMENT STATUS
          ZJN    FCNX        IF NO ERRORS 
          LMN    1
          ZJN    FCN6        IF EXTERNAL REJECT 
 FCN5     LDN    ERJM        REJECT/TRANSMISSION PARITY ERROR 
          UJN    FCN3        PROCESS ERROR
  
 FCN6     LDD    T6 
          ZJN    FCN5        IF EXTERNAL REJECT EXIT NOT REQUESTED
          LDD    CS          RETURN WITH CONVERTER STATUS 
          LPN    7
  
 FCN      SUBR               ENTRY/EXIT 
          STD    FC          SAVE FUNCTION CODE 
          SHN    -14
          STD    T6          RETURN CONTROLLER STATUS FLAG
          LDD    FC 
          FAN    CH          ISSUE FUNCTION 
          LCN    0           SET TIMEOUT LIMIT
 FCN1     IJM    FCN4,CH     IF FUNCTION ACCEPTED 
          SBN    1
          NJN    FCN1        IF NOT TIMED OUT 
  
*         *FCN2* IS A SECONDARY ENTRY POINT FOR *FCN*.
* 
*         PROCESS FUNCTION TIMEOUT. 
  
 FCN2     DCN    CH+40
          LDN    EFTM        *EQXXX FUNCTION TIMEOUT.*
  
*         *FCN3* IS A SECONDARY ENTRY POINT FOR *FCN*.
* 
*         ENTRY  (A) = MESSAGE CODE.
*                (ES+1) = CHANNEL (RESERVED). 
  
 FCN3     STD    MC          SAVE MESSAGE CODE
          LDD    ES+1        RELEASE CHANNEL
          DCHAN 
          EXECUTE  3IC
          RJM    /3IC/ERM    SEND ERROR MESSAGE 
          RJM    /3IC/OEQ    OFF EQUIPMENT
          LJM    /3IC/CAS    CLEAR ASSIGNMENT 
 GST      SPACE  4,10 
**        GST - GET STATUS OF 6681 AND EQUIPMENT. 
* 
*         EXIT   (A) = BITS O - 2 OF 6681 STATUS. 
*                (CS) = 6681 STATUS.
*                (ST) = EQUIPMENT STATUS. 
* 
*         CALLS  RST. 
  
  
 GST      SUBR               ENTRY/EXIT 
          LDN    13          SELECT 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   (FC) = FUNCTION CODE.
*                CHANNEL ACTIVE.
*                TO *FCN2* IF FUNCTION TIMEOUT. 
  
  
 IFN2     ACN    CH 
  
 IFN      SUBR               ENTRY/EXIT 
          SHN    6
          FAN    CH          ISSUE FUNCTION 
          STD    FC 
          LDN    6
 IFN1     IJM    IFN2,CH     IF FUNCTION ACCEPTED 
          SBN    1
          NJN    IFN1        IF NOT TIMED OUT 
          LJM    FCN2        FUNCTION TIMEOUT ERROR PROCESSOR 
 IOM      SPACE  4,10 
**        IOM - ISSUE OPERATOR MESSAGE. 
* 
*         ENTRY  (A) = MESSAGE CODE FOR *I* DISPLAY.
*                (IR+3) = BUFFER POINT NUMBER.
* 
*         USES   T1, CM - CM+4. 
* 
*         MACROS NFA. 
  
  
 IOM      SUBR               ENTRY/EXIT 
          STD    T1 
          NFA    BFCW+1      READ PREVIOUS MESSAGE
          ADD    IR+3 
          ADD    IR+3 
          CRD    CM 
          LDD    CM          CHECK IF SAME MESSAGE
          LMD    T1 
          ZJN    IOMX        IF SAME AS LAST MESSAGE
          LDD    T1 
          LMN    EOFF 
          NJN    IOM1        IF SETTING *OFF* MESSAGE 
          LDD    CM 
          LMN    EOHE 
          ZJN    IOMX        IF CURRENTLY OFF WITH ERROR
 IOM1     LDD    T1          SET NEW MESSAGE
          STD    CM 
          SBN    ENEC 
          MJN    IOM2        IF NOT ERROR CONDITION 
          LDD    CP          GET ATTENTION OF OPERATOR
          ADN    MS2W 
          CWM    IOMA,TR
 IOM2     NFA    BFCW+1      STORE NEW MESSAGE
          ADD    IR+3 
          ADD    IR+3 
          CWD    CM 
          UJP    IOMX        RETURN 
  
  
 IOMA     DATA   C+$REQUEST *I* DISPLAY.+ 
 MCI      SPACE  4,10 
**        MCI - MODIFY CHANNEL INSTRUCTIONS.
* 
*         ENTRY  (ES+1) = CHANNEL NUMBER. 
* 
*         EXIT   (A) .EQ. 0, CHANNEL RESERVED AND (RC) = 0. 
*                (A) .EQ. *ECUA*, CHANNEL UNAVAILABLE.
* 
*         USES   T1, T2.
* 
*         MACROS CHTL, RCHAN. 
  
  
 MCI1     RAI    T2 
          AOD    T1 
 MCI2     LDI    T1 
          STD    T2 
          LDD    ES+1 
          LPN    37 
          CHTL   *
          SBN    CH 
          NJN    MCI1        IF MORE INSTRUCTIONS TO MODIFY 
          STD    RC          CLEAR RETRY COUNT
  
 MCI      SUBR               ENTRY/EXIT 
          LDD    ES+1        GET CHANNEL BYTE 
          LPC    4037        REMOVE ALL BUT CHANNEL NUMBER
          RCHAN              TRY TO RESERVE CHANNEL 
          LDC    TCHS        LOAD FWA OF CHANNEL TABLE ADDRESSES
          STD    T1 
          LDM    CM+1 
          SHN    21-13
          PJN    MCI2        IF CHANNEL AVAILABLE 
          LDN    ECUA        *CHANNEL UNAVAILABLE*
          UJN    MCIX        EXIT WITH ERROR CODE 
 MSG      SPACE  4,10 
**        MSG - PROCESS CONTROL POINT MESSAGE.
* 
*         ENTRY  (IR+4) SET.
* 
*         USES   T1, CM - CM+4. 
* 
*         CALLS  C2D. 
  
  
 MSG      SUBR               ENTRY/EXIT 
          LDD    IR+4 
          LPN    77 
          NJN    MSG1        IF BUFFERS ASSIGNED
          LDD    CP          CONSOLE MESSAGE = *IDLE.*
          ADN    MS1W 
          CWM    =C*IDLE.*,ON 
          UJN    MSG2        CHECK FOR *MS2W* MESSAGE 
  
 MSG1     RJM    C2D         CONVERT BUFFER COUNT 
          STM    MSGA 
          LDD    CP          STORE CONTROL POINT MESSAGE
          ADN    MS1W 
          CWM    MSGA,TR
 MSG2     LDD    CP          CHECK FOR *MS2W* MESSAGE 
          ADN    MS2W 
          CRD    CM 
          LDD    CM 
          ZJN    MSGX        IF NO +CHECK *I* DISPLAY+ MESSAGE
          LDN    0           SET BUFFER POINT INDEX 
          STD    T1 
 MSG3     NFA    BFCW+1      READ SECOND BUFFER POINT WORD
          ADD    T1 
          ADD    T1 
          CRD    CM 
          LDD    CM          CHECK *I* DISPLAY MESSAGE CODE 
          SBN    ENEC 
          PJN    MSG4        IF ERROR CONDITION PRESENT 
          AOD    T1          ADVANCE BUFFER POINT INDEX 
          LMM    TAEQ 
          NJN    MSG3        IF MORE TO CHECK 
          STD    CM 
          LDD    CP          CLEAR OPERATOR ALERT 
          ADN    MS2W 
          CWD    CM 
 MSG4     LJM    MSGX        RETURN 
  
  
 MSGA     DATA   C*00 BUFFERS ACTIVE.*
 PCP      SPACE  4,10 
**        PCP - PROCESS CHANNEL PARITY. 
* 
*         ENTRY  (A) =  UNRECOVERED FLAG. 
*                (RC) = RETRY COUNT.
* 
*         EXIT   TO *FCN3* IF UNRECOVERED ERROR.
* 
*         USES   MC, RC, RT.
* 
*         CALLS  *3IC*. 
* 
*         MACROS EXECUTE. 
  
  
 PCP1     STD    RC          CLEAR RETRY COUNT
          EXECUTE  3IC
          RJM    /3IC/ERM    ISSUE ERROR MESSAGE
  
 PCP      SUBR
          STD    RT          STORE RECOVERED FLAG 
          LDN    ECRE        *EQXXX CHANNEL PARITY ERROR.*
          STD    MC 
          LDD    RC 
          SHN    6           APPEND RETRY COUNT TO RECOVERY FLAG
          RAD    RT 
          LPN    1
          ZJN    PCP1        IF RECOVERED ERROR 
          LDN    ECRE        *EQXXX CHANNEL PARITY ERROR.*
          LJM    FCN3        PROCESS UNRECOVERED ERROR
 REQ      SPACE  4,15 
**        REQ - REQUEST EQUIPMENT.
* 
*         EXIT   (A) = 0 IF NO EQUIPMENT AVAILABLE OR *DSP/QAC* CALL
*                        BLOCK BUSY.
*                (EQ) = EST ORDINAL / DEVICE TYPE.
*                (FA) = 0.
*                (ES - ES+4) = EST ENTRY. 
*                (IR+3) = EQUIPMENT INDEX.
* 
*         USES   EI.
* 
*         CALLS  CAD, CEQ, CCT, IOM, MCI, RLE, STS. 
* 
*         MACROS EXECUTE. 
  
  
 REQ      SUBR               ENTRY/EXIT 
          LDD    RA          CHECK *DSP/QAC* PARAMETER BLOCK BUSY 
          SHN    6
          ADK    QAPB 
          CRD    CM 
          LDD    CM+4        BUSY BIT 
          LPN    1
 REQ0     ZJN    REQX        IF CALL BLOCK BUSY 
          LDN    0           CLEAR EST ORDINAL
          STD    EQ 
          STD    FA          CLEAR FST ADDRESS
          LCN    0           SET COUNTER
          STD    EI 
          LDD    IR+3        GET EQUIPMENT INDEX
          SHN    0-13 
          ZJN    REQ1        IF ALL EQUIPMENT NOT CHECKED 
          LCN    0
          STD    IR+3 
 REQ1     AOD    IR+3        ADVANCE EQUIPMENT INDEX
          LMM    TAEQ 
          NJN    REQ2        IF NO MATCH
          STD    IR+3 
 REQ2     AOD    EI          ADVANCE COUNTER
          LMM    TAEQ 
          ZJN    REQ0        IF ALL EQUIPMENT CHECKED 
          LDM    TAEQ+1,IR+3
          STD    EQ 
          SHN    -3          CHECK EQUIPMENT AVAILABLE
          RJM    CEQ
          NJN    REQ1        IF EQUIPMENT ASSIGNED ELSEWHERE
          RJM    MCI         MODIFY CHANNEL INSTRUCTIONS
          ZJN    REQ2.1      IF CHANNEL AVAILABLE 
          RJM    IOM         ISSUE ERROR MESSAGE
          UJN    REQ1        CHECK NEXT EQUIPMENT 
  
 REQ2.1   LDD    EQ 
          LPN    7
          SBK    NPDT 
          NJN    REQ4        IF NOT NON-IMPACT PRINTER
          LDD    ES          CHECK IF CONTROLWARE LOAD NEEDED 
          SHN    21-4 
          PJN    REQ3        IF LOAD NOT NEEDED 
          EXECUTE  3IF       LOAD CONTROLWARE 
          NJN    REQ7        IF BUFFER SPACE UNAVAILABLE
 REQ3     RJM    CCT         CONNECT TO DEVICE
          ZJN    REQ8        IF DEVICE READY
          LMN    1
          ZJN    REQ5        IF NOT READY 
          LMN    4&1
          NJN    REQ7        IF INTERVENTION NOT REQUIRED 
          LDN    EIVR        *INTERVENTION REQUIRED.* 
          UJN    REQ6        SET ERROR MESSAGE
  
 REQ4     RJM    STS         CHECK STATUS 
          NJN    REQ8        IF EQUIPMENT READY 
 REQ5     LDN    ENRD        *NOT READY.* 
 REQ6     RJM    IOM         ISSUE OPERATOR MESSAGE 
 REQ7     RJM    CAD         CLEAR AND DISCONNECT 
          RJM    RLE         RELEASE EQUIPMENT
          LJM    REQ1        PROCESS NEXT EQUIPMENT 
  
 REQ8     RJM    CAD         CLEAR AND DISCONNECT 
          LDN    ECLE        CLEAR MESSAGE
          RJM    IOM         ISSUE OPERATOR MESSAGE 
          LDN    1           SET EQUIPMENT AVAILABLE
          LJM    REQX        RETURN 
 RLE      SPACE  4,10 
**        RLE - RELEASE EQUIPMENT.
* 
*         ENTRY  (EQ) = 9/EST ORDINAL, 3/DEVICE TYPE. 
* 
*         EXIT   (EQ) = 0.
* 
*         MACROS MONITOR. 
  
  
 RLE      SUBR               ENTRY/EXIT 
          LDD    EQ 
          SHN    -3 
          ZJN    RLEX        IF NOT ASSIGNED
          STD    CM+1 
          MONITOR  DEQM 
*         LDN    0
          STD    EQ 
          UJN    RLEX        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, RC, T4.
* 
*         CALLS  IFN, PCP.
  
  
 RST2     AOD    RC          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
          LDD    RC 
          ZJN    RSTX        IF NO PREVIOUS ERROR 
          LDN    0
          UJN    RST3        PROCESS RECOVERED PARITY ERROR 
 SFA      SPACE  4,10 
**        SFA - SET FET ADDRESS.
* 
*         ENTRY  (BA - BA+1) = RELATIVE FET ADDRESS.
* 
*         EXIT   (A) = ABSOLUTE FET ADDRESS.
  
  
 SFA      SUBR               ENTRY/EXIT 
          LDD    BA 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    BA+1 
          UJN    SFAX        RETURN 
 SFF      SPACE  4,15 
**        SFF - SEARCH FOR FILE.
* 
*         ENTRY  (A) = FILE TYPE. 
*                (EQ) = 9/EST ORDINAL,3/EQUIPMENT TYPE. 
*                (ES - ES+4) = EST ENTRY. 
* 
*         EXIT   *1IO* IS RECALLED AND *QAC* IS CALLED INTO THIS PP.
* 
*         USES   T1, T2, CM - CM+4. 
* 
*         CALLS  *QAC*. 
* 
*         MACROS EXECUTE, MONITOR, SFA. 
  
  
 SFF      STM    QACB+10*5   SET QUEUE TYPE 
          LMK    PHQQ 
          ZJN    SFF3        IF PUNCH QUEUE 
          LDK    ZESF+HESF+DSSF  SET EXT. CHAR. AND DISP. CODE
          STM    QACB+7*5+4 
          LDD    ES+4        SET EXTERNAL CHARACTERISTICS (PRINT TRAIN) 
          SHN    -6 
          LPN    7
          STD    T1 
          LMN    6
          NJN    SFF2        IF NOT 12-BIT ASCII TRAIN
          LDK    ECSF+DSSF   SET EXPLICIT EXT. CHAR. AND DISP. CODE 
          STM    QACB+7*5+4 
 SFF2     LDM    TPTE,T1     SET EXTERNAL CHARACTERISTICS 
          STM    QACB+10*5+3
 SFF3     LDK    FCSF+IDSF+DPSF  ADD SELECTION FLAGS
          RAM    QACB+7*5+4 
          LDK    LPSF+LVSF
          STM    QACB+7*5+3 
          LDD    ES+3        SET DISPOSITION CODE 
          STM    QACB+10*5+2
          LDD    ES+4        SET DEVICE ID CODE 
          LPN    77 
          STM    QACB+5*5+3 
          LDD    EQ          READ EST ENTRY 
          SHN    -3 
          SFA    EST
          ADK    EQAE 
          CRD    CM 
          LDD    CM+2        SET FORMS CODE 
          STM    QACB+10*5+1
          LDD    CM+3        SET EQUIPMENT ACCESS LEVEL LIMITS
          SHN    6
          STM    QACB+11*5+3
          LDN    GTFC*2      SET *GET* FUNCTION 
          STM    QACB+4 
  
*         RECALL *1IO* AND CALL *QAC* INTO THIS PP. 
  
          LDN    QAPBL       WRITE *QAC* PARAMETER BLOCK
          STD    T1 
          LDD    RA 
          SHN    6
          ADC    QAPB 
          CWM    QACB,T1
          LDD    HN          SET FILE REQUESTED FLAG IN *1IO* RECALL
          RAD    IR+2 
          EXECUTE  QAC,=
          LDD    MA          CALL *QAC* 
          CWM    SFFA,ON
          LDN    0           ENABLE QUEUING OF PP REQUEST 
          STD    CM+1 
          MONITOR  RPPM 
          LJM    RCL1        RECALL *1IO* 
  
 SFFA     VFD    18/3LQAC,24/0,18/QAPB
 STS      SPACE  4,20 
**        STS - CHECK EQUIPMENT STATUS. 
* 
*         ENTRY  (ES - ES+4) = EST ENTRY. 
* 
*         EXIT   (A) = 0, IF EQUIPMENT *NOT READY*. 
*                (A) = 1, IF EQUIPMENT CONNECTED AND *READY*. 
*                (CS) = 6681 STATUS.
*                (ST) = EQUIPMENT STATUS. 
*                TO *FCN3* IF ERROR.
* 
*         CALLS  CON, IFN.
  
  
 STS6     LDD    ST          CHECK EQUIPMENT STATUS 
          LPN    1
  
 STS      SUBR               ENTRY/EXIT 
          LDN    20          SELECT 6681
          RJM    IFN         ISSUE FUNCTION 
          DCN    CH+40
          RJM    CON         CONNECT EQUIPMENT
 STS3     ZJN    STS6        IF NO ERROR
          RJM    CON
          ZJN    STS6        IF PARITY ERROR CLEARED
 STS4     LDN    ERJM        REJECT/TRANSMISSION PARITY ERROR 
 STS5     LJM    FCN3        PROCESS ERROR
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPRSI 
          SPACE  4,10 
**        LITERALS BLOCK. 
  
  
          USE    OVERLAY
 TPTE     SPACE  4,10 
**        TPTE - TABLE OF PRINT TRAIN EXTERNAL CHARACTERISTIC VALUES. 
* 
*         INDEXED BY PRINT TRAIN NUMBER.
* 
*T,       3/EC , 9/ 0 
* 
*         EC = EXTERNAL CHARACTERISTIC VALUE. 
  
  
 TPTE     BSS    0
  
          CON    4000        595-1/596-1
          CON    4000        595-1/596-1
          CON    4000        NOT SUPPORTED
          CON    4000        NOT SUPPORTED
          CON    6000        595-6/596-6
          CON    5000        595-5/596-5
          CON    6000        595-6/596-6
          CON    0           595-6/596-6 USED AS 595-5/596-5
 TCHS     SPACE  4,10 
**        TCHS - CHANNEL TABLE. 
  
  
 TCHS     CHTB
 TAEQ     SPACE  4,10 
**        TAEQ - TABLE OF AVAILABLE EQUIPMENT.
  
  
 TAEQ     BSS    0
 TAEQL    EQU    CTIR*5-TEQR*5  TABLE LENGTH
          SPACE  4,10 
**        QACB - *QAC* PARAMETER BLOCK BUFFER.
  
  
 QACB     EQU    TAEQ+TAEQL  FWA OF BUFFER
 QACBL    EQU    QAPBL*5     *QAC* PARAMETER BLOCK BUFFER LENGTH
  
 ORGR     EQU    QACB+5*QFFL+5
  
          DEFOIES  ORGR      SET LOAD ADDRESS OF ERROR ROUTINES 
          SPACE  4,10 
          OVERFLOW  ,BFMS-TAEQL 
 RIO      TTL    1IO/3IA - 1IO SUBROUTINES. 
          TITLE 
          QUAL   3IA
          IDENT  3IA,RIOX 
*COMMENT  1IO - SUBROUTINES.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 RIO      SPACE  4,10 
**        RIO - RETURN CONTROL. 
  
  
          ORG    ORGR 
  
 RIO      SUBR               ENTRY/EXIT 
          UJN    RIOX        RETURN 
 ABF      SPACE  4,10 
**        ABF - ASSIGN BUFFER.
* 
*         ENTRY  (EQ) = EST ORDINAL / DEVICE TYPE.
*                (FA) = FST ADDRESS.
*                (FS - FS+4) = FST ENTRY. 
*                (QACB - QACB+QACBL) = *QAC* PARAMETER BLOCK. 
* 
*         USES   EC, FA, FS - FS+4. 
* 
*         CALLS  EBP, EFT, FFB. 
  
  
 ABF      SUBR               ENTRY/EXIT 
          LDD    EQ          SET DEVICE TYPE
          LPN    7
          STD    EC 
          SBK    CRDT 
          NJN    ABF1        IF NOT INPUT FILE
          STD    FA          CLEAR FST ADDRESS
          LDN    ZERL        CLEAR FST ENTRY
          CRD    FS 
 ABF1     RJM    FFB         FIND FREE BUFFER 
          RJM    EFT         ENTER FET INFORMATION
          RJM    EBP         ENTER BUFFER POINT INFORMATION 
          UJN    ABFX        RETURN 
 ADR      SPACE  4,15 
**        ADR - ASSIGN DRIVER.
* 
*         ENTRY  (IR+3) = BUFFER NUMBER.
*                (BA - BA+1) = BUFFER ADDRESS.
*                (EQ) = EST ORDINAL / DEVICE TYPE.
* 
*         EXIT   TO *RCL*.
* 
*         USES   EC, T2, CM - CM+4, CN - CN+4.
* 
*         CALLS  MSG, *3IC*.
* 
*         MACROS EXECUTE, MONITOR.
  
  
 ADR      LDN    D1AR        PREPARE REQUEST WORD 
          STD    CN 
          LDD    EQ 
          STD    CN+1 
          LPN    7
          STD    EC          SET DEVICE TYPE
          LDD    BA 
          STD    CN+3 
          LDD    BA+1 
          STD    CN+4 
          LDN    0           CLEAR EMPTY INDICATOR
          STD    T2 
 ADR1     LDD    RA          READ ASSIGNMENT WORD 
          SHN    6
          ADD    CN 
          CRD    CM 
          LDD    CM+1        CHECK PROCESSOR
          SCN    77 
          SHN    6
          ADD    CM 
          NJN    ADR2        IF ASSIGNED
          LDD    CN          SET FREE ADDRESS 
          STD    T2 
 ADR2     LMC    3RD1C
          NJN    ADR3        IF NOT DRIVER
          LDD    CM+3        CHECK ENTRY COUNT
          LMN    MEQD 
          ZJN    ADR3        IF DRIVER FULL 
          LDM    ADRB,EC     CHECK SUB-DRIVER TYPE
          LMD    CM+4 
          NJN    ADR3        IF NOT PROPER SUB-DRIVER 
          LDD    RA          STORE REQUEST
          SHN    6
          ADN    DRQR 
          CWD    CN 
          LJM    ADR5        CHECK JOB TYPE 
  
 ADR3     AOD    CN          ADVANCE SEARCH 
          LMN    DRQR 
          NJN    ADR1        IF NOT END OF PROCESSORS 
          LDD    T2 
          STD    CN 
          NJN    ADR4        IF ROOM FOR ANOTHER PROCESSOR
          EXECUTE  3IC
          LJM    /3IC/CAS    CLEAR ASSIGNMENT 
  
*         *ADR4* IS A SECONDARY ENTRY POINT FOR *ADR*.
* 
*         FORMAT *1CD* CALL AND TRY TO INITIATE *1CD* IN ANOTHER PP.
  
 ADR4     LDD    CN 
          STM    ADRA+2      SET PROCESSER NUMBER 
          LDM    ADRB,EC     SET SUB-DRIVER TYPE
          STM    ADRA+4 
          LDD    RA          STORE PROCESSOR WORD 
          SHN    6
          ADD    CN 
          CWM    ADRA,ON
          LDD    RA          SET REQUEST
          SHN    6
          ADN    DRQR 
          CWD    CN 
          LDD    IR+1        SET CONTROL POINT NUMBER 
          LPN    37 
          RAM    ADRA+1 
          RJM    MSG         PROCESS MESSAGES 
          EXECUTE  1CD,=
          LDD    MA          CALL *1CD* 
          CWM    ADRA,ON
          LDN    0           ENABLE QUEUING OF PP REQUEST 
          STD    CM+1 
          MONITOR  RPPM 
          LDD    CM+1 
          ZJN    ADR7        IF PP NOT ASSIGNED 
  
*         REQUEST NO *1IO* RECALL FOR OUTPUT JOBS.
  
 ADR5     LDD    FA 
          ZJN    ADR6        IF INPUT JOB 
          AOM    RCLA        SET NO RECALL REQUESTED FLAG 
 ADR6     LJM    RCL         RECALL *1IO* 
  
*         RECALL *1IO* AND CALL *1CD* INTO THIS PP. 
  
 ADR7     LDC    4000 
          STD    CM+1 
          LDD    IA          STORE INPUT REGISTER 
          CWM    ADRA,ON
          LJM    RCL2        ENTER *1IO* RECALL REQUEST 
  
 ADRA     VFD    60/0L1CD 
  
 ADRB     INDEX              SUB-DRIVER TYPES 
          INDEX  LPDT,0 
          INDEX  CPDT,0 
          INDEX  CRDT,0 
          INDEX  NPDT,1 
          INDEX  MXDT 
 EBP      SPACE  4,10 
**        EBP - ENTER BUFFER POINT INFORMATION. 
* 
*         ENTRY  (BA - BA+1) = BUFFER ADDRESS.
*                (EQ) = EST ORDINAL / DEVICE TYPE.
*                (IR+3) = BUFFER POINT NUMBER.
*                (FA) = FNT ADDRESS.
*                (T7) = REPEAT COUNT. 
*                (QACB) = FET.
* 
*         EXIT   BUFFER POINT UPDATED.
* 
*         USES   CM - CM+4. 
* 
*         CALLS  SFA. 
* 
*         MACROS NFA. 
  
  
 EBP      SUBR               ENTRY/EXIT 
          RJM    SFA         READ FILE NAME 
          CRD    CM 
          LDD    EQ          SET EST ORDINAL / DEVICE TYPE
          SHN    -3 
          STD    CM+3 
          LDD    T7          SET REPEAT COUNT 
          SHN    6
          STD    CM+4 
          NFA    QACB+5*5,R  STORE BUFFER POINT WORD
          CWD    CM 
          LDN    ZERL 
          CRD    CM 
          LDD    BA          SET FET ADDRESS
          STD    CM+3 
          LDD    BA+1 
          STD    CM+4 
          NFA    BFSP        STORE AUXILIARY BUFFER POINT WORD
          ADD    IR+3 
          CWD    CM 
          UJN    EBPX        RETURN 
 EFT      SPACE  4,10 
**        EFT - ENTER FET INFORMATION.
* 
*         ENTRY  (EC) = DEVICE TYPE.
*                (T3) = BUFFER SIZE / 100.
*                (IR+3) = BUFFER NUMBER.
*                (BA - BA+1) = BUFFER ADDRESS.
*                (ES - ES+4) = EST ENTRY. 
* 
*         EXIT   (T7) = REPEAT COUNT. 
* 
*         USES   EC, T1, T5, T6, RI - RI+1. 
* 
*         CALLS  CRA, SFA.
  
  
*         PROCESS PRINT FILE. 
  
 EFT1     SBN    6
          NJN    EFT2        IF NOT ASCII PRINT FILE
          LDM    QACB+10*5+3
          SHN    -6 
          LPN    7           ISOLATE IC 
          LMK    DCIC 
          ZJN    EFT2        IF 6-BIT DISPLAY CODE
          LMK    A6IC&DCIC
          ZJN    EFT1.1      IF 6/12 ASCII
          LDN    20&4        SET 8/12 ASCII 
 EFT1.1   LMN    20          SET ASCII FILE FLAG
          STM    QACB+5*FPW2+2
 EFT2     LDM    QACB+15*5+3 SET *BATCHIO* SUBSYSTEM PRIVILEDGES FLAG 
          STM    QACB+4*5+2 
          SHN    0-13 
          RAM    QACB+5*FPW2+2
          LDD    ES          CHECK PAPER SIZE 
          SHN    3-11 
          LPN    10          SHORT PAPER BIT
          RAM    QACB+5*FPW2+2
          LDM    QACB+14*5+2 SET DAYFILE RANDOM ADDRESS 
          SCN    77 
          SHN    6
          LMM    QACB+14*5+1
          SHN    6
          STD    RI+1 
          SCN    77 
          LMM    QACB+14*5
          SHN    6
          STD    RI 
          ADD    RI+1 
          ZJN    EFT4        IF NO DAYFILE
          LDD    FS          SET EQUIPMENT
          STD    T5 
          LDD    FS+1        SET FIRST TRACK
          STD    T6 
          RJM    CRA         CONVERT RANDOM ADDRESS 
          MJN    EFT4        IF ADDRESS NOT ON CHAIN
          LDD    T6          SET DAYFILE TRACK
          STM    QACB+5*5+1 
          LDD    T7          SET DAYFILE SECTOR 
  
*         PROCESS PUNCH FILE. 
  
 EFT3     STM    QACB+5*5+2 
 EFT4     LDN    0           CLEAR USER FORMS CONTROL INDICATOR 
          STM    QACB+5*5+3 
          LDM    QACB+14*5+3 SET USER LIMITS
          STM    QACB+5*FPW2+3
          LDM    QACB+14*5+4
          STM    QACB+5*FPW2+4
          LDM    QACB+5*16+1  MOVE FILE SIZE TO FET (LOWER 24 BITS) 
          SHN    14 
          SCN    77 
          ADM    QACB+5*16+2
          SHN    -6 
          STM    QACB+5*14+4  FILE SIZE 
          LDM    QACB+5*16+0
          SHN    14 
          SCN    77 
          ADM    QACB+5*16+1
          SHN    -6 
          STM    QACB+5*14+3  FILE SIZE 
          LDC    4000 
          STM    QACB+5*1+1  SET RANDOM BIT 
  
*         PROCESS INPUT FILE. 
  
 EFT5     LDC    BFCW        SET BUFFER POINT OFFSET
          SBD    IR+3 
          SBD    IR+3 
          STM    QACB+5*5 
          LDN    QFFL        SET FET LENGTH 
          STD    T1 
          ADD    BA+1        SET BUFFER POINTERS
          STM    QACB+5*1+4 
          STM    QACB+5*2+4 
          STM    QACB+5*3+4 
          SHN    -14
          ADD    BA 
          STM    QACB+5*3+3 
          STM    QACB+5*2+3 
          LMC    QFFL*100-500 
          STM    QACB+5*1+3 
          LDN    1           SET FET STATUS 
          STM    QACB+4 
          LDN    ZERL        CLEAR QUEUE ACCESS PARAMETER BLOCK 
          CRM    QACB+5*QAPO,ON 
          LDN    ZERL 
          CRM    QACB+5*FPSN,ON 
  
*         INITIALIZE DRIVER STATUS BLOCK. 
  
          LDM    QACB+5*15+4 SAVE REPEAT COUNT
          STD    T7 
          LDC    QACB+5*EDSO
          STD    T6 
 EFT6     LDN    0           CLEAR DRIVER STATUS BLOCK
          STI    T6 
          AOD    T6 
          LMC    QACB+5*QFFL
          NJN    EFT6        IF NOT END OF BLOCK
          LDD    EQ          SET EQUIPMENT ORDINAL / TYPE 
          STM    QACB+5*EDSO+CMEN 
          LDD    ES+4        SET CONNECT CODE / CHANNEL 
          LPC    7000 
          LMD    ES+1 
          SCN    37 
          LMD    ES+1 
          STM    QACB+5*EDSO+CMCE 
          LDD    T7          SET REPEAT COUNT 
          LPN    77 
          STM    QACB+5*EDSO+CMER 
          LDD    T3          SET BUFFER THRESHOLD 
          SHN    -2 
          ERRNG  BBFL-4      CODE DEPENDS ON VALUE
          SHN    6
          STM    QACB+5*EDSO+CMBT 
          RJM    SFA         STORE FET
          CWM    QACB,T1
  
 EFT      SUBR               ENTRY/EXIT 
          LDM    EFTA,EC     SET PROCESSOR ADDRESS
          STD    T1 
          LDM    QACB+10*5+3 EXTERNAL CHARACTERISTICS 
          SHN    -11
          LJM    0,T1        EXIT TO PROCESSOR
  
 EFTA     INDEX 
          INDEX  LPDT,EFT1
          INDEX  CPDT,EFT3
          INDEX  CRDT,EFT5
          INDEX  NPDT,EFT1
          INDEX  MXDT 
 FFB      SPACE  4,15 
**        FFB - FIND FREE BUFFER. 
* 
*         ENTRY  (EC) = DEVICE TYPE.
*                (IR+4) SET.
* 
*         EXIT   (T3) = BUFFER SIZE / 100.
*                (BA - BA+1) = BUFFER ADDRESS.
* 
*         USES   T2, CM - CM+4, CN - CN+4.
* 
*         CALLS  RSI, SFA, *3IC*. 
* 
*         MACROS EXECUTE. 
  
  
 FFB6     LDD    FL          CLEAR PENDING FL REQUEST 
          RJM    RSI
  
 FFB      SUBR               ENTRY/EXIT 
  
*         SEARCH ALLOCATED BUFFERS FOR A FREE BUFFER. 
  
          LDM    FFBA,EC     SET BUFFER SIZE
          STD    T3 
          LDN    0           CLEAR BUFFER COUNT 
          STD    T2 
          STD    BA          SET FIRST BUFFER ADDRESS 
          LDC    BUFR 
          STD    BA+1 
          LDM    QACB+10*5+3 CHECK FOR 12-BIT ASCII PRINT FILE
          SHN    -11
          SBN    6
          NJN    FFB1        IF NOT 12-BIT ASCII CODE PRINT FILE
          LDD    T3          DOUBLE BUFFER SIZE REQUIRED
          RAD    T3 
 FFB1     LDD    T2 
          LMD    IR+4 
          ZJN    FFB3        IF END OF BUFFERS
          RJM    SFA         READ FET+0 
          CRD    CM 
          ADN    4           READ LIMIT 
          CRD    CN 
          LDD    CM 
          NJN    FFB2        IF BUFFER BUSY 
          LDD    CN+3        CHECK BUFFER SIZE
          STM    QACB+4*5+3 
          SBD    BA 
          SHN    14 
          ADD    CN+4 
          STM    QACB+4*5+4 
          SBD    BA+1 
          SBK    QFFL+1 
          SHN    -6 
          SBD    T3 
          MJN    FFB2        IF FREE BUFFER NOT LARGE ENOUGH
          LJM    FFB6        CLEAR PENDING FL REQUESTS
  
 FFB2     LDD    CN+3        SET NEXT BUFFER ADDRESS
          STD    BA 
          LDD    CN+4 
          STD    BA+1 
          AOD    T2          ADVANCE BUFFER COUNT 
          UJN    FFB1        CHECK NEXT BUFFER
  
*         REQUEST ADDITIONAL STORAGE. 
  
 FFB3     LDD    BA          COMPUTE FL NEEDED
          SHN    6
          ADD    T3 
          SHN    6
          ADD    BA+1 
          ADC    QFFL+1+77
          SHN    -6 
          RJM    RSI
          ZJN    FFB5        IF STORAGE ASSIGNED
          MJN    FFB4        IF NOT AVAILABLE 
          LDD    CP          CONSOLE MESSAGE = *WAITING FOR STORAGE.* 
          ADN    MS1W 
          CWM    =C*WAITING FOR STORAGE.*,TR
          LDD    IR+2        SET SO STORAGE REQUEST WILL REMAIN 5 TIMES 
          SCN    77 
          STD    IR+2 
 FFB4     LDN    0           INDICATE NO BUFFER 
          STD    BA 
          STD    BA+1 
          SOD    IR+3        DECREMENT EQUIPMENT INDEX
          EXECUTE  3IC
          LJM    /3IC/CAS    RELEASE FILE AND EQUIPMENT 
  
 FFB5     AOD    IR+4        ADVANCE ASSIGNED BUFFER COUNT
          LDD    BA 
          SHN    6
          ADD    T3 
          SHN    6
          ADD    BA+1 
          ADK    QFFL+1 
          STM    QACB+4*5+4  SET VALUE FOR LIMIT
          SHN    -14
          STM    QACB+4*5+3 
          LJM    FFBX        RETURN 
  
 FFBA     INDEX              BUFFER SIZES / 100 
          INDEX  LPDT,BBFL*2
          INDEX  CPDT,BBFL
          INDEX  CRDT,BBFL*2
          INDEX  NPDT,BBFL*4
          INDEX  MXDT 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPCRA 
          SPACE  4,10 
          OVERFLOW  ORGR,BFMS 
          TTL    1IO/3IB - LOAD IMAGE MEMORY. 
          TITLE 
          QUAL   3IB
          IDENT  3IB,LDMX 
*COMMENT  1IO - LOAD PRINTER IMAGE MEMORY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 3IB      SPACE  4,10 
**               3IB IS CALLED TO IDENTIFY A LINE PRINTER AND 
*         LOAD IMAGE MEMORY.
* 
*         ENTRY  (EQ) = 9/EST ORDINAL,3/EQUIPMENT TYPE. 
* 
*         EXIT   (A) = 0, IF IMAGE CANNOT BE LOADED.
 SLUG     SPACE  4,15 
**        SLUG - DEFINE PRINT SLUG. 
* 
*         CALL -
*         SLUG   (A1A2A3...AI),N
* 
*         WHERE  AI ARE CODES APPEARING ON THE SLUG.
*                N IS THE NUMBER OF CODES TO DEFINE.  IF N IS 
*                ABSENT, THE SYMBOL *NCSL* DEFINES THE NUMBER OF
*                CODES/SLUG.
* 
*         N WORDS ARE ASSEMBLED WITH THE CONTENTS BEING THE 12-BIT
*         ASCII CODE EQUIVALENT OF THE SPECIFIED STRING, RIGHT- 
*         JUSTIFIED AND ZERO FILLED.
  
  
 SLUG     MACRO  A,N
          LOCAL  AA,BB,CC 
 CC       SET    N NCSL 
 AA       SET    1
          CODE   ASCII
          NOREF  NCSL 
          DUP    CC,3 
 BB       MICRO  AA,1, A
          CON    1R"BB"+40B 
 AA       SET    AA+1 
          CODE   *
          ENDM
 ESLUG    SPACE  4,10 
**        ESLUG - DEFINE EXTENDED TRAIN PRINT SLUG. 
* 
*         CALL -
*         ESLUG  (XI,XJ,...,XM),P1,...,PN 
* 
*         WHERE  XI - XM ARE THE HEXADECIMAL REPRESENTATIONS OF 
*                THE VALUES OF THE 12-BIT ASCII CODES ON THE
*                SLUG.
*                P1 - PN SPECIFY THE POSITIONS IN THE TRAIN 
*                CONTAINING THIS SLUG.
  
  
 ESLUG    MACRO  CHARS,P1,P2,P3,P4,P5,P6,P7,P8
          NOREF  NCHAR,NCSL,TIMC,.1 
 .1       SET    *
          ECHO   5,P=(P1,P2,P3,P4,P5,P6,P7,P8)
          IFC    NE,//P/
          ORG    TIMC-NCSL+NCSL*P 
          ECHO   2,Q=(CHARS)
          CON    Q
 NCHAR    SET    NCHAR+1
          ENDIF 
          ORG    .1 
 ESLUG    ENDM
          SPACE  4,10 
**        PIOVL - DEFINE PRINT IMAGE OVERLAYS.
* 
*         CALL -
*         PIOVL  (A1,A2,A3...AN)
* 
*         WHERE  (AN) ARE TWO CHARACTER OVERLAY NAMES.
*                THE LENGTH OF AN ARRAY IS 8. THERFORE
*                A MAXIMUM OF 8 NAMES CAN BE SPECIFIED. 
*                IF LESS THAN 8 NAMES ARE SPECIFIED, THE
*                FIRST NAME WILL BE USED TO FILL THE
*                REMAINING SLOTS. 
  
  
 PIOVL    MACRO  A
          LOCAL  AA,BB,CC,DD
 AA       SET    0
          IRP    A
 CC       MICRO  1,,*A* 
          CON    2R"CC" 
 AA       SET    AA+1 
 .B       IFEQ   AA,1 
 DD       MICRO  1,,*A* 
 .B       ENDIF 
          IRP 
 BB       SET    10-AA
 .B       IFGT   BB,0 
          DUP    BB,1 
          CON    2R"DD" 
 .B       ENDIF 
 PIOVL    ENDM
          TITLE  MAIN PROGRAM.
 LDM      SPACE  4,10 
**        MAIN PROGRAM. 
  
  
          ORG    ORGR 
  
 LDM      SUBR               ENTRY/EXIT 
          RJM    MCI         MODIFY CHANNEL INSTRUCTIONS
          RJM    LIM         LOAD IMAGE MEMORY
          NJN    LDM2        IF ERROR 
          LDD    ST          CHECK FOR PRINTER READY
          LPN    1
          LMN    1
          RAM    LDMA 
  
*         NORMAL EXIT - RELEASE EQUIPMENT.
  
          RJM    CAD         CLEAR AND DISCONNECT 
 LDMA     LDN    0
*         LDN    1           (PRINTER NOT LOADED) 
 LDM1     UJN    LDMX        EXIT 
  
*         ERROR EXIT - TURN EQUIPMENT OFF 
  
 LDM2     STD    MC          SAVE MESSAGE CODE
          LMN    ECUA 
          ZJN    LDM4        IF CHANNEL UNAVAILABLE 
          DCN    CH+40
          LDD    ES+1        RELEASE CHANNEL
          DCHAN 
          EXECUTE  3IC
          RJM    /3IC/ERM    SEND ERROR MESSAGE 
          RJM    /3IC/OEQ    OFF EQUIPMENT
 LDM3     LDN    1           SET ERROR FLAG 
          UJN    LDM1        EXIT 
  
 LDM4     LDN    ECUA        *CHANNEL UNAVAILABLE*
          RJM    IOM         ISSUE ERROR MESSAGE
          UJN    LDM3        EXIT WITH ERROR FLAG 
 LIM      SPACE  4,10 
**        LIM - LOAD IMAGE MEMORY.
* 
*         ENTRY  (ES - ES+4) = EST ENTRY. 
* 
*         EXIT   (A) .NE. 0 IF IMAGE MEMORY CANNOT BE LOADED. 
*                (ST) = EQUIPMENT STATUS. 
* 
*         USES   CS, T3.
* 
*         CALLS  CAD, CES, EXR, FCN, GST, IFN, *5IA*, *5IC*, *5ID*, 
*                *5IE*, *5IG*, *5IH*. 
* 
*         MACROS EXECUTE. 
  
 LIM      SUBR               ENTRY/EXIT 
          RJM    CES         CHECK EQUIPMENT STATUS 
          PJN    LIMX        IF PRINTER NOT READY OR ERROR
          LDD    ET 
          SHN    6           FIND OVERLAY NAME
          STD    T3 
          LDD    ES+4 
          SHN    -6          ADD TRAIN TYPE TO INDEX
          LPN    7
          SHN    3
          RAD    T3 
          LDM    QACB+15*5+3 GET PRINT IMAGE CODE 
          SHN    -6 
          LPN    17 
          NJN    LIM0        IF EXPLICIT PRINT IMAGE SPECIFIED
          LDN    PISD        USE SYSTEM DEFAULT PRINT IMAGE 
 LIM0     LPN    7
          RAD    T3 
          LDM    TIMO,T3     SET OVERLAY NAME 
          STM    LIMA 
          RJM    CAD         CLEAR AND DISCONNECT 
          LDC    1L5         LOAD IMAGE MEMORY OVERLAY
 LIMA     EQU    *-1
          EXECUTE  5IA,=
          EXECUTE  5IC,=
          EXECUTE  5ID,=
          EXECUTE  5IE,=
          EXECUTE  5IG,=
          EXECUTE  5IH,=
          RJM    EXR
          STM    LIMB        SAVE TABLE LENGTH
          RJM    CES         CHECK EQUIPMENT STATUS 
          PJN    LIM1        IF PRINTER NOT READY OR ERROR
          LDN    24          SELECT ABNORMAL *EOP* INTERRUPT
          RJM    FCN         ISSUE FUNCTION 
          LDN    13          SET EXTENDED ARRAY MODE
          RJM    FCN
          LDN    12          *FILL IMAGE MEMORY*
          RJM    FCN         ISSUE FUNCTION 
          LDN    16          OUTPUT IMAGE MEMORY
          RJM    IFN         ISSUE FUNCTION 
          LDC    *           OUTPUT IMAGE MEMORY
 LIMB     EQU    *-1
          OAM    TIMC,CH
          NJN    LIM2        IF INCOMPLETE DATA TRANSFER
          FJM    *,CH 
          DCN    CH+40
          RJM    GST         GET 6681 AND EQUIPMENT STATUS
          ZJN    LIM1        IF NO ERRORS 
          LDN    ERJM        REJECT/TRANSMISSION PARITY ERROR 
 LIM1     LJM    LIMX        RETURN 
  
 LIM2     STD    CS          STORE NUMBER OF UNTRANSFERED BYTES 
          LDN    EITM        *EQXXX INCOMPLETE DATA TRANSFER.*
          UJN    LIM1        RETURN 
 CES      SPACE  4,15 
**        CES - CHECK EQUIPMENT STATUS. 
* 
*         EXIT   (A) .LT. 0 IF NO ERROR.
*                (A) = 0, IF PRINTER NOT READY. 
*                (A) = ERROR CODE.
*                (ET) = 0 IF 512 PRINTER. 
*                     = 1 IF 580 PRINTER. 
* 
*         USES   ET, T3.
* 
*         CALLS  FCN, GST, STS, //MCI.
  
  
 CES2     LDN    50          ISSUE FUNCTION UNIQUE TO IMAGE MEMORY
          RJM    FCN
          LDC    1S12+66     ISSUE FUNCTION UNIQUE TO 580 
          RJM    FCN
          NJN    CES3        IF NOT 580 
          AOD    ET 
 CES3     LCN    0           INDICATE NO ERROR
  
 CES      SUBR               ENTRY/EXIT 
          RJM    //MCI       MODIFY CHANNEL INSTRUCTIONS
          NJN    CESX        IF CHANNEL UNAVAILABLE 
          RJM    STS         CHECK PRINTER STATUS 
          ZJN    CESX        IF NOT READY 
  
*         TIME OUT SINCE 512 CAN HANG BUSY WITH GARBAGE IN IMAGE
*         MEMORY. 
  
          LDN    0           SET TIMEOUT LIMIT
          STD    T3 
          STD    ET          PRESET EQUIPMENT TYPE = 512
 CES1     RJM    GST         GET STATUS OF 6681 AND EQUIPMENT 
          LDD    ST          CHECK EQUIPMENT STATUS 
          LPN    2
          ZJN    CES2        IF NOT BUSY
          SOD    T3 
          NJN    CES1        IF NOT TIMED OUT 
          LDN    ECBM        *EQXXX CONTROLLER HUNG BUSY.*
          UJN    CESX        BUSY ERROR 
 MCI      SPACE  4,10 
**        MCI - MODIFY CHANNEL INSTRUCTIONS.
* 
*         ENTRY  (ES+1) SET.
* 
*         EXIT   CHANNEL INSTRUCTIONS SET WITH PROPER CHANNEL.
* 
*         USES   T1, T2.
  
  
 MCI      SUBR               ENTRY/EXIT 
          LDC    TCHS 
          STD    T1 
          UJN    MCI2        UPDATE CHANNEL INSTRUCTIONS
  
 MCI1     RAI    T2 
          AOD    T1 
 MCI2     LDI    T1 
          STD    T2 
          LDD    ES+1 
          LPN    37 
          CHTL   *
          SBN    CH 
          NJN    MCI1        IF MORE CHANNEL INSTRUCTIONS TO MODIFY 
          UJN    MCIX        RETURN 
 TCHS     SPACE  4,10 
**        TCHS - CHANNEL TABLE. 
*         TABLE CONTAINS THE ADDRESSES OF ALL INSTRUCTIONS WHICH
*         REFERENCE THE EQUIPMENT CHANNEL.
  
  
 TCHS     CHTB
          SPACE  4,10 
  
 ELIM     EQU    *+10        DEFINE END OF LOAD IMAGE MEMORY ROUTINES 
 TIMC     EQU    ELIM+5 
          QUAL
 OIMT     SET    /3IB/ELIM   DEFINE ORIGIN OF IMAGE MEMORY TABLES 
          QUAL   *
  
          DEFOIES  OIMT      SET LOAD ADDRESS OF ERROR ROUTINES 
 TIMO     SPACE  4,15 
**        TIMO - TABLE OF IMAGE MEMORY OVERLAYS.
* 
*         EIGHT BY EIGHT WORD ENTRY.
* 
*         EACH SET OF EIGHT BY EIGHT WORDS DESCRIBES IMAGE OVERLAYS 
*         FOR A PARTICULAR EQUIPMENT TYPE.  EACH WORD CONTAINS AN 
*         OVERLAY NAME. 
* 
*         EACH ROW INDICATES A TRAIN TYPE - 
*                0, 1        CDC GRAPHIC 64-CHARACTER SET.
*                4, 5, 7     ASCII GRAPHIC 64-CHARACTER SET.
*                6           ASCII GRAPHIC 95-CHARACTER SET.
* 
*         THE POSITION WITHIN A ROW INDICATES THE PRINT IMAGE (PI)
*         ( 0 - 7 ) AND CORRESPONDING OVERLAY NAME FOR THAT TRAIN TYPE. 
*         IF LESS THAN 8 NAMES ARE SPECIFIED IN A ROW, THE FIRST (PI=0) 
*         NAME WILL BE USED TO FILL THE REMAINDER OF THE ROW. 
  
  
  
 TIMO     BSS    0
  
*         PI      0  1  2  3  4  5  6  7     TRAIN TYPE 
  
*         512.
  
          PIOVL  (IA,IA,IA,IA,IA,IA,IA,IA)   595-1
          PIOVL  (IA)                        595-1
          PIOVL  (IA)                        NOT SUPPORTED
          PIOVL  (IA)                        NOT SUPPORTED
          PIOVL  (ID)                        595-6
          PIOVL  (IC)                        595-4 OR 595-5 
          PIOVL  (ID)                        595-6
          PIOVL  (ID)                        595-6 USED AS 595-5
  
*         580.
  
          PIOVL  (IE)                        596-1
          PIOVL  (IE)                        596-1
          PIOVL  (IE)                        NOT SUPPORTED
          PIOVL  (IE)                        NOT SUPPORTED
          PIOVL  (IH)                        596-6
          PIOVL  (IG)                        596-4 OR 596-5 
          PIOVL  (IH)                        596-6
          PIOVL  (IH)                        596-6 USED AS 596-5
          TTL    1IO/3IB/5IA - IMAGE MEMORY TABLE.
          TITLE  3555/512 WITH 595-1 PRINT TRAIN. 
          QUAL   5IA
          IDENT  5IA,IMTX 
*COMMENT  1IO - 512/595-1 IMAGE MEMORY. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 5IA      SPACE  4,10 
 NCSL     EQU    4           DEFINE SLUG SIZE 
 IMT      SPACE  4,10 
          ORG    OIMT 
  
 IMT      SUBR               ENTRY/EXIT 
          LDC    TIMCL
          UJN    IMTX        RETURN WITH TABLE LENGTH 
 TIMC     SPACE  4,10 
*         GROUP  1. 
  
 TIMC     SLUG   (0123) 
          SLUG   (4567) 
          SLUG   (BZ,/) 
          SLUG   (89AC) 
          SLUG   ((GH)) 
          SLUG   (RIFL) 
          SLUG   (MNOP) 
          SLUG   ([),1
          CON    45          PERCENT
          SLUG   (^]),2 
          SLUG   (DUST) 
          SLUG   (VWXY) 
          SLUG   (+-.E) 
          SLUG   (JKQ*) 
  
*         GROUP  2. 
  
          SLUG   (0123) 
          SLUG   (4567) 
          SLUG   ($),1
          CON    137         CONCATENATION
          SLUG   ("=),2 
          SLUG   (89AC) 
          SLUG   (BZ,/) 
          SLUG   (RIFL) 
          SLUG   (MNOP) 
          SLUG   ((GH)) 
          SLUG   (DUST) 
          SLUG   ('?&!) 
          SLUG   (+-.E) 
          SLUG   (VWXY) 
  
*         GROUP  3. 
  
          SLUG   (0123) 
          SLUG   (4567) 
          SLUG   (JKQ*) 
          SLUG   (89AC) 
          SLUG   (@\<>) 
          SLUG   (RIFL) 
          SLUG   (MNOP) 
          SLUG   (BZ,/) 
          SLUG   (DUST) 
          SLUG   ((GH)) 
          SLUG   (+-.E) 
          CON    72          COLON
          SLUG   (;#=),3
  
*         GROUP  4. 
  
          SLUG   (0123) 
          SLUG   (4567) 
          SLUG   (VWXY) 
          SLUG   (89AC) 
          SLUG   (JKQ*) 
          SLUG   (RIFL) 
          SLUG   (MNOP) 
          SLUG   ([),1
          CON    45          PERCENT
          SLUG   (^]),2 
          SLUG   (DUST) 
          SLUG   (BZ,/) 
          SLUG   (+-.E) 
          SLUG   ((GH)) 
  
*         GROUP  5. 
  
          SLUG   (0123) 
          SLUG   (4567) 
          SLUG   ($),1
          CON    137         CONCATENATION
          SLUG   ("=),2 
          SLUG   (89AC) 
          SLUG   (VWXY) 
          SLUG   (RIFL) 
          SLUG   (MNOP) 
          SLUG   (JKQ*) 
          SLUG   (DUST) 
          SLUG   ('?&!) 
          SLUG   (+-.E) 
          SLUG   (BZ,/) 
  
*         GROUP  6. 
  
          SLUG   (0123) 
          SLUG   (4567) 
          SLUG   ((GH)) 
          SLUG   (89AC) 
          SLUG   (@\<>) 
          SLUG   (RIFL) 
          SLUG   (MNOP) 
          SLUG   (VWXY) 
          SLUG   (DUST) 
          SLUG   (JKQ*) 
          SLUG   (+-.E) 
          CON    72          COLON
          SLUG   (;#=),3
  
          ERRNZ  /3IB/TIMC-TIMC 
 TIMCL    EQU    *-TIMC 
          ERRNZ  TIMCL-288D 
  
          DEFOIES            SET LOAD ADDRESS OF ERROR ROUTINES 
          TTL    1IO/3IB/5IC - IMAGE MEMORY TABLE.
          TITLE  3555/512 WITH 595-4, 595-5 PRINT TRAINS. 
          QUAL   5IC
          IDENT  5IC,IMTX 
*COMMENT  1IO - 512/595-4,595-5 IMAGE MEMORY. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 5IC      SPACE  4,10 
 NCSL     EQU    4           DEFINE SLUG SIZE 
 IMT      SPACE  4,10 
          ORG    OIMT 
  
 IMT      SUBR               ENTRY/EXIT 
          LDC    TIMCL
          UJN    IMTX        RETURN WITH TABLE LENGTH 
 TIMC     SPACE  4,10 
*         GROUP  1. 
  
 TIMC     SLUG   (0123) 
          SLUG   (4567) 
          SLUG   (BZ,/) 
          SLUG   (89AC) 
          SLUG   ((GH)) 
          SLUG   (RIFL) 
          SLUG   (MNOP) 
          SLUG   ([),1
          CON    45          PERCENT
          SLUG   ("]),2 
          SLUG   (DUST) 
          SLUG   (VWXY) 
          SLUG   (+-.E) 
          SLUG   (JKQ*) 
  
*         GROUP  2. 
  
          SLUG   (0123) 
          SLUG   (4567) 
          SLUG   ($@'=) 
          SLUG   (89AC) 
          SLUG   (BZ,/) 
          SLUG   (RIFL) 
          SLUG   (MNOP) 
          SLUG   ((GH)) 
          SLUG   (DUST) 
          SLUG   (#\^!) 
          SLUG   (+-.E) 
          SLUG   (VWXY) 
  
*         GROUP  3. 
  
          SLUG   (0123) 
          SLUG   (4567) 
          SLUG   (JKQ*) 
          SLUG   (89AC) 
          SLUG   (&?<>) 
          SLUG   (RIFL) 
          SLUG   (MNOP) 
          SLUG   (BZ,/) 
          SLUG   (DUST) 
          SLUG   ((GH)) 
          SLUG   (+-.E) 
          CON    72          COLON
          SLUG   (;),1
          CON    137         UNDERLINE
          SLUG   (=),1
  
*         GROUP  4. 
  
          SLUG   (0123) 
          SLUG   (4567) 
          SLUG   (VWXY) 
          SLUG   (89AC) 
          SLUG   (JKQ*) 
          SLUG   (RIFL) 
          SLUG   (MNOP) 
          SLUG   ([),1
          CON    45          PERCENT
          SLUG   ("]),2 
          SLUG   (DUST) 
          SLUG   (BZ,/) 
          SLUG   (+-.E) 
          SLUG   ((GH)) 
  
*         GROUP  5. 
  
          SLUG   (0123) 
          SLUG   (4567) 
          SLUG   ($@'=) 
          SLUG   (89AC) 
          SLUG   (VWXY) 
          SLUG   (RIFL) 
          SLUG   (MNOP) 
          SLUG   (JKQ*) 
          SLUG   (DUST) 
          SLUG   (#\^!) 
          SLUG   (+-.E) 
          SLUG   (BZ,/) 
  
*         GROUP  6. 
  
          SLUG   (0123) 
          SLUG   (4567) 
          SLUG   ((GH)) 
          SLUG   (89AC) 
          SLUG   (&?<>) 
          SLUG   (RIFL) 
          SLUG   (MNOP) 
          SLUG   (VWXY) 
          SLUG   (DUST) 
          SLUG   (JKQ*) 
          SLUG   (+-.E) 
          CON    72          COLON
          SLUG   (;),1
          CON    137         UNDERLINE
          SLUG   (=),1
  
          ERRNZ  /3IB/TIMC-TIMC 
 TIMCL    EQU    *-TIMC 
          ERRNZ  TIMCL-288D 
  
          DEFOIES            SET LOAD ADDRESS OF ERROR ROUTINES 
          TTL    1IO/3IB/5ID - IMAGE MEMORY TABLE.
 5ID      TITLE  3555/512 WITH 595-6 PRINT TRAIN. 
          QUAL   5ID
          IDENT  5ID,IMTX 
*COMMENT  1IO - 512/595-6 IMAGE MEMORY. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 5ID      SPACE  4,10 
 NCSL     EQU    4           DEFINE SLUG SIZE 
 IMT      SPACE  4,10 
          ORG    OIMT 
  
 IMT      SUBR               ENTRY/EXIT 
          LDC    TIMCL
          UJN    IMTX        RETURN WITH TABLE LENGTH 
 TIMC     SPACE  4,10 
 TIMC     BSSZ   288D 
 NCHAR    SET    0
  
*         DEFINE SYMBOLS X0-X7F FOR CORRESPONDING HEX VALUES. 
  
          ECHO   3,P=(2,3,4,5,6,7)
          ECHO   2,Q=(0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F)
          NOREF  X_P_Q
 X_P_Q    EQU    0#_P_Q 
  
          BASE   D
  
          ESLUG  (X30,X31,X32,X33),01,25,49 0,1,2,3 
          ESLUG  (X34,X35,X36,X37),02,26,50 4,5,6,7 
          ESLUG  (X38,X39,X62,X63),03,27,51 8,9,B(LC),C(LC) 
          ESLUG  (X65,X73,X74,X61),04,28,52 E(LC),S(LC),T(LC),A(LC) 
          ESLUG  (X64,X66,X75,X76),05,29,53 D(LC),F(LC),U(LC),V(LC) 
          ESLUG  (X67,X68,X69,X6A),06,30,54 G(LC),H(LC),I(LC),J(LC) 
          ESLUG  (X6B,X6C,X6D,X6E),07,31,55 K(LC),L(LC),M(LC),N(LC) 
          ESLUG  (X6F,X70,X77,X72),08,32,56 O(LC),P(LC),W(LC),R(LC) 
          ESLUG  (X71,X78,X79,X7A),09,33,57 Q(LC),X(LC),Y(LC),Z(LC) 
          ESLUG  (X5C,X60,X51,X55),15,39,63 BACK/,ACCENT,Q(LC),U(LC)
          ESLUG  (X4A,X41,X4B,X45),16,40,64 J,A,K,E 
          ESLUG  (X42,X57,X47,X48),17,41,65 B,W,G,H 
          ESLUG  (X44,X43,X53,X54),18,42,66 D,C,S,T 
          ESLUG  (X50,X4E,X46,X4C),19,43,67 P,N,F,L 
          ESLUG  (X4D,X49,X4F,X52),20,44,68 M,I,O,R 
          ESLUG  (X56,X5A,X58,X59),21,45,69 V,Z,X,Y 
          ESLUG  (X3C,X3E,X5B,X5D),10,34,58 .LT.,.GT.,L.BRKT,R.BRKT 
          ESLUG  (X2E,X7C,X7B,X7D),11,35,59 .,V.BAR,L.BRACE,R.BRACE 
          ESLUG  (X21,X5E,X5F,X7E),12,36,60 EXCLAM,C.FLEX,UNDERSC,TILDE 
          ESLUG  (X25,X30,X23,X40),13,37,61 PERCENT,0,POUND,AT
          ESLUG  (X3A,X3B,X27,X3F),14,38,62 COLON,SEMICOLON,APOS,Q.MARK 
          ESLUG  (X28,X2F,X2A,X29),22,46,70 (,/,*,) 
          ESLUG  (X2B,X2D,X2E,X2C),23,47,71 +,-,.,, 
          ESLUG  (X24,X3D,X22,X26),24,48,72 $,=,D.QUOTE,AMPERSAND 
  
          BASE   *
          ERRNZ  /3IB/TIMC-TIMC 
 TIMCL    EQU    NCHAR
          ERRNZ  TIMCL-288D 
  
          DEFOIES            SET LOAD ADDRESS OF ERROR ROUTINES 
          TTL    1IO/3IB/5IE - IMAGE MEMORY TABLE.
          TITLE  580 WITH 596-1 PRINT TRAIN.
          QUAL   5IE
          IDENT  5IE,IMTX 
*COMMENT  1IO - 580/596-1 IMAGE MEMORY. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 5IE      SPACE  4,10 
 NCSL     EQU    8D          DEFINE SLUG SIZE 
 IMT      SPACE  4,10 
          ORG    OIMT 
  
 IMT      SUBR               ENTRY/EXIT 
          LDC    TIMCL
          UJN    IMTX        RETURN WITH TABLE LENGTH 
 TIMC     SPACE  4,10 
*         GROUP  1. 
  
 TIMC     SLUG   (17430265) 
          SLUG   (E-+.HG98) 
          SLUG   (FCBDRALI) 
          SLUG   (140$3Z2,) 
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
          SLUG   (;=()[]),6 
          CON    45          PERCENT
          CON    72          COLON
          SLUG   (17430265) 
  
*         GROUP  2. 
  
          SLUG   (E-+.HG98) 
          SLUG   (FCBDRALI) 
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
          SLUG   (&@\!),4 
          CON    137         CONCATENATION
          SLUG   ('?^),3
          SLUG   (#()><"Z,) 
          SLUG   (17430265) 
          SLUG   (E-+.HG98) 
  
*         GROUP  3. 
  
          SLUG   (FCBDRALI) 
          SLUG   (140$3Z2,) 
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
          SLUG   (;=()[]),6 
          CON    45          PERCENT
          CON    72          COLON
          SLUG   (17430265) 
          SLUG   (E-+.HG98) 
          SLUG   (FCBDRALI) 
  
*         GROUP  4. 
  
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
          SLUG   (&@\!),4 
          CON    137         CONCATENATION
          SLUG   ('?^),3
          SLUG   (#()><"Z,) 
          SLUG   (17430265) 
          SLUG   (E-+.HG98) 
          SLUG   (FCBDRALI) 
          SLUG   (140$3Z2,) 
  
*         GROUP  5. 
  
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
          SLUG   (;=()[]),6 
          CON    45          PERCENT
          CON    72          COLON
          SLUG   (17430265) 
          SLUG   (E-+.HG98) 
          SLUG   (FCBDRALI) 
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
  
*         GROUP  6. 
  
          SLUG   (&@\!),4 
          CON    137         CONCATENATION
          SLUG   ('?^),3
          SLUG   (#()><"Z,) 
          SLUG   (17430265) 
          SLUG   (E-+.HG98) 
          SLUG   (FCBDRALI) 
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
          SLUG   (;=()[]),6 
          CON    45          PERCENT
          CON    72          COLON
  
          ERRNZ  /3IB/TIMC-TIMC 
 TIMCL    EQU    *-TIMC 
          ERRNZ  TIMCL-384D 
  
          DEFOIES            SET LOAD ADDRESS OF ERROR ROUTINES 
          TTL    1IO/3IB/5IG - IMAGE MEMORY TABLE.
          TITLE  580 WITH 596-4, 596-5 PRINT TRAINS.
          QUAL   5IG
          IDENT  5IG,IMTX 
*COMMENT  1IO - 580/596-4,596-5 IMAGE MEMORY. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 5IG      SPACE  4,10 
 NCSL     EQU    8D          DEFINE SLUG SIZE 
 IMT      SPACE  4,10 
          ORG    OIMT 
  
 IMT      SUBR               ENTRY/EXIT 
          LDC    TIMCL
          UJN    IMTX        RETURN WITH TABLE LENGTH 
 TIMC     SPACE  4,10 
*         GROUP  1. 
  
 TIMC     SLUG   (17430265) 
          SLUG   (E-+.HG98) 
          SLUG   (FCBDRALI) 
          SLUG   (140$3Z2,) 
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
          SLUG   (;&()[]),6 
          CON    45          PERCENT
          CON    72          COLON
          SLUG   (17430265) 
  
*         GROUP  2. 
  
          SLUG   (E-+.HG98) 
          SLUG   (FCBDRALI) 
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
          SLUG   (!"^=@),5
          CON    137         UNDERLINE
          SLUG   (?\),2 
          SLUG   ('),1
          CON    51          CLOSE PARENTHESIS
          CON    50          OPEN PARENTHESIS 
          SLUG   (><#Z,),5
          SLUG   (17430265) 
          SLUG   (E-+.HG98) 
  
*         GROUP  3. 
  
          SLUG   (FCBDRALI) 
          SLUG   (140$3Z2,) 
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
          SLUG   (;&()[]),6 
          CON    45          PERCENT
          CON    72          COLON
          SLUG   (17430265) 
          SLUG   (E-+.HG98) 
          SLUG   (FCBDRALI) 
  
*         GROUP  4. 
  
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
          SLUG   (!"^=@),5
          CON    137         UNDERLINE
          SLUG   (?\),2 
          SLUG   ('),1
          CON    51          CLOSE PARENTHESIS
          CON    50          OPEN PARENTHESIS 
          SLUG   (><#Z,),5
          SLUG   (17430265) 
          SLUG   (E-+.HG98) 
          SLUG   (FCBDRALI) 
          SLUG   (140$3Z2,) 
  
*         GROUP  5. 
  
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
          SLUG   (;&()[]),6 
          CON    45          PERCENT
          CON    72          COLON
          SLUG   (17430265) 
          SLUG   (E-+.HG98) 
          SLUG   (FCBDRALI) 
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
  
*         GROUP  6. 
  
          SLUG   (!"^=@),5
          CON    137         UNDERLINE
          SLUG   (?\),2 
          SLUG   ('),1
          CON    51          CLOSE PARENTHESIS
          CON    50          OPEN PARENTHESIS 
          SLUG   (><#Z,),5
          SLUG   (17430265) 
          SLUG   (E-+.HG98) 
          SLUG   (FCBDRALI) 
          SLUG   (POQKMN*J) 
          SLUG   (/VTYWXUS) 
          SLUG   (;&()[]),6 
          CON    45          PERCENT
          CON    72          COLON
  
          ERRNZ  /3IB/TIMC-TIMC 
 TIMCL    EQU    *-TIMC 
          ERRNZ  TIMCL-384D 
  
          DEFOIES            SET LOAD ADDRESS OF ERROR ROUTINES 
          TTL    1IO/3IB/5IH - IMAGE MEMORY TABLE.
 5IH      TITLE  580 WITH 596-6 PRINT TRAIN.
          QUAL   5IH
          IDENT  5IH,IMTX 
*COMMENT  1IO - 580/596-6 IMAGE MEMORY. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 5IH      SPACE  4,10 
 NCSL     EQU    8D          DEFINE SLUG SIZE 
          SPACE  4,10 
          ORG    OIMT 
  
 IMT      SUBR               ENTRY/EXIT 
          LDC    TIMCL
          UJN    IMTX        RETURN WITH TABLE LENGTH 
 TIMC     SPACE  4,10 
 TIMC     BSSZ   384D 
 NCHAR    SET    0
  
*         DEFINE SYMBOLS X0-X7F FOR CORRESPONDING HEX VALUES. 
  
          ECHO   3,P=(2,3,4,5,6,7)
          ECHO   2,Q=(0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F)
          NOREF  X_P_Q
 X_P_Q    EQU    0#_P_Q 
  
          BASE   D
  
          ESLUG  (X31,X37,X34,X33,X30,X32,X36,X35),1,13,25,37 
          ESLUG  (X45,X2D,X2B,X2E,X48,X47,X39,X38),2,14,26,38 
          ESLUG  (X46,X43,X42,X44,X52,X41,X4C,X49),3,15,27,39 
          ESLUG  (X50,X4F,X51,X4B,X4D,X4E,X2A,X4A),4,16,28,40 
          ESLUG  (X2F,X56,X54,X59,X57,X58,X55,X53),5,17,29,41 
          ESLUG  (X27,X24,X23,X2C,X3E,X3D,X3C,X5A),6,18,30,42 
          ESLUG  (X21,X31,X3F,X40,X30,X5C,X22,X60),7,19,31,43 
          ESLUG  (X66,X61,X63,X65,X67,X62,X64,X68),8,20,32,44 
          ESLUG  (X6C,X6B,X6D,X6E,X70,X6F,X6A,X69),9,21,33,45 
          ESLUG  (X76,X77,X74,X78,X73,X75,X71,X72),10,22,34,46
          ESLUG  (X7E,X7C,X5F,X7D,X7B,X7A,X79,X5E),11,23,35,47
          ESLUG  (X3B,X26,X28,X29,X5B,X5D,X25,X3A),12,24,36,48
  
          BASE   *
  
          ERRNZ  /3IB/TIMC-TIMC 
 TIMCL    EQU    NCHAR
          ERRNZ  TIMCL-384D 
  
          DEFOIES            SET LOAD ADDRESS OF ERROR ROUTINES 
 RER      TTL    1IO/3IC - ERROR SUBROUTINES. 
          TITLE 
          QUAL   3IC
          IDENT  3IC,RERX 
*COMMENT  1IO - ERROR SUBROUTINES.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 3IC      SPACE  4,10 
**        RER - RETURN CONTROL. 
  
  
          ORG    OIES 
  
 RER      SUBR               ENTRY/EXIT 
          UJN    RERX        RETURN 
 CAS      SPACE  4,10 
**        CAS - CLEAR ASSIGNMENT. 
* 
*         ENTRY  (EQ) = EST ORDINAL / DEVICE TYPE.
*                (EQ) = 0, IF NO EQUIPMENT ASSIGNED.
*                (BA - BA+1) = BUFFER ADDRESS.
*                (BA - BA+1) = 0, IF NO BUFFER ASSIGNED.
*                (FA) = FNT ADDRESS.
*                (FA) = 0 IF NO FILE ASSIGNED.
*                (IR+1) SET.
*                (IR+3) SET.
* 
*         EXIT   EQUIPMENT RELEASED.
*                BUFFER RELEASED. 
*                IF FILE IS TO BE RELEASED, THEN *1IO* IS RECALLED, 
*                AND *CIO* IS CALLED INTO THIS PP.
*                OTHERWISE, EXIT IS MADE TO *RCL*.
* 
*         USES   T1, T2, CM - CM+4. 
* 
*         CALLS  RLE, SFA, *DSP*. 
* 
*         MACROS EXECUTE, MONITOR, NFA. 
  
  
 CAS      BSS    0           ENTRY
          LDN    ZERL        CLEAR BUFFER NAME
          CRD    CM 
          LDD    BA          CHECK FOR BUFFER ASSIGNMENT
          ADD    BA+1 
          ZJN    CAS1        IF NO BUFFER ASSIGNED
          RJM    SFA         CLEAR BUFFER 
          CWD    CM 
          LDD    EQ          RESET BUFFER POINT WORD
          SHN    -3 
          STD    CM+3 
          NFA    BFCW 
          ADD    IR+3 
          ADD    IR+3 
          CWD    CM 
 CAS1     RJM    RLE         RELEASE EQUIPMENT
          LDD    FA 
          NJN    CAS3        IF FILE ASSIGNED 
          LJM    RCL         RECALL *1IO* 
  
*         SET UP *DSP* CALL BLOCK.
  
 CAS3     NFA    FA,R        READ FILE NAME 
          CRM    DSPP,ON
          LDC    DSPP+2 
          STD    T1 
 CAS4     LDN    0           CLEAR *DSP* PARAMETER BLOCK
          STI    T1 
          AOD    T1 
          LMC    DSPPE
          NJN    CAS4        IF NOT END OF BLOCK
          LDK    FRPR+FRCS   SET PRIORITY / CENTRAL SITE FLAGS
          STM    DSPP+1*5+4 
          LCN    0           SET MAXIMUM PRIORITY 
          STM    DSPP+3*5+4 
          LDD    FA          SET FNT OFFSET 
          STM    DSPP+4*5+4 
          LDN    DSPBL       SET PARAMETER BLOCK LENGTH 
          STD    T1 
          LDD    RA          STORE *DSP* PARAMETER BLOCK
          SHN    6
          ADC    QAPB 
          CWM    DSPP,T1
  
*         RECALL *1IO* AND CALL *DSP*.
  
          EXECUTE  DSP,=
          LDD    MA          CALL *DSP* 
          CWM    CASA,ON
          LDN    0           ENABLE QUEUING OF PP REQUEST 
          STD    CM+1 
          MONITOR  RPPM 
          LJM    RCL1        RECALL *1IO* 
  
 CASA     VFD    18/0LDSP,24/0,18/QAPB
 ERM      SPACE  4,10 
**        ERM - PROCESS ERROR MESSAGE.
* 
*         ENTRY  (CS) = CONVERTER STATUS/BYTE COUNT.
*                (EQ) = 9/EST ORDINAL, 3/DEVICE TYPE. 
*                (FC) = FUNCTION CODE.
*                (MC) = MESSAGE CODE. 
*                (ST) = EQUIPMENT STATUS. 
*                (ES - ES+4) = EST ENTRY. 
* 
*         USES   RT, T5.
* 
*         CALLS  C2D, DFM, IBM. 
  
  
 ERM2     STD    RT 
  
 ERM      SUBR               ENTRY/EXIT 
          LDD    MC          CHECK MESSAGE CODE 
          SBN    BAME 
          MJN    ERMX        IF MESSAGE ISSUED ONLY BY *QAP*
          STD    T5 
          RJM    IBM         PROCESS BML MESSAGE
          LDD    RT          CHECK IF ERROR RETRIED 
          ZJN    ERM1        IF ERROR NOT RETRIED 
          LPN    1
          ZJN    ERM2        IF RECOVERED ERROR 
  
 ERM1     LDM    TDFP,T5     SET MESSAGE ADDRESS
          STD    T5 
          LDD    ES+3        SET EQUIPMENT TYPE 
          STI    T5 
          LDD    EQ          CONVERT UPPER TWO DIGITS OF EST ORDINAL
          SHN    -6 
          RJM    C2D
          STM    1,T5 
          LDD    EQ          CONVERT LOWER DIGIT OF EST ORDINAL 
          LPN    70 
          SHN    3
          ADC    2R0
          STM    2,T5 
          LDD    T5          SEND MESSAGE TO DAYFILE
          RJM    DFM
          LDC    ERLN        SEND MESSAGE TO ERROR LOG
          LMD    T5 
          RJM    DFM
          LJM    ERMX        RETURN 
 TDFP     SPACE  4,10 
**        TDFP - TABLE OF PROCESSORS AND MESSAGES.
* 
*         *TDFP* IS A PARTIAL TABLE OF MESSAGES CONTAINING ONLY 
*         THOSE MESSAGES ISSUED BY *1IO*. 
  
  
 TDFP     INDEX 
          INDEX  ERJM-BAME,(=C*EQXXX INTERNAL/EXTERNAL REJECT.*)
          INDEX  ETPE-BAME,(=C*EQXXX TRANSMISSION PARITY ERROR.*) 
          INDEX  EFTM-BAME,(=C*EQXXX FUNCTION TIMEOUT.*)
          INDEX  EITM-BAME,(=C*EQXXX INCOMPLETE DATA TRANSFER.*)
          INDEX  EEOM-BAME,(=C*EQXXX TURNED OFF BY SYSTEM.*)
          INDEX  ECBM-BAME,(=C*EQXXX CONTROLLER HUNG BUSY.*)
          INDEX  ECRE-BAME,(=C*EQXXX CHANNEL PARITY ERROR.*)
          INDEX  ECSE-BAME,(=C*EQXXX CCC/NIP STATUS ERROR.*)
          INDEX  ECLM-BAME,(=C*EQXXX CCC/NIP CONTROLWARE LOADED.*)
          INDEX  ECWE-BAME,(=C*EQXXX CCC/NIP CONTROLWARE LOAD ERROR.*)
          INDEX  ECNF-BAME,(=C*EQXXX CCC/NIP CONTROLWARE NOT FOUND.*) 
          INDEX  ELME-BAME
 IBM      SPACE  4,10 
**        IBM - ISSUE BML MESSAGE.
* 
*         ENTRY  (A) = INDEX INTO TABLES *TIPR*, *TISY*, AND *TINB*.
*                (CS) = CONVERTER STATUS/BYTE COUNT.
*                (EQ) = 9/EST ORDINAL, 3/DEVICE TYPE. 
*                (FC) = FUNCTION CODE.
*                (RT) = RETRY COUNT/UNRECOVERED FLAG. 
*                (ST) = EQUIPMENT STATUS. 
*                (T5) = ERROR LOG MESSAGE INDEX.
*                (ES - ES+4) = EST ENTRY. 
* 
*         USES   T1, T2, CM - CM+4. 
* 
*         CALLS  DFM, DMI.
* 
*         MACROS BLMSIDT, DBMLT.
  
  
 IBM      SUBR               ENTRY/EXIT 
          STD    T2 
          RJM    DMI         DETERMINE BML MESSAGE ID 
          ZJN    IBMX        IF EQUIPMENT NOT FOUND 
          STM    IBMA 
          LDK    PPCP 
          CRD    CM 
          LDD    IA          CALCULATE PP NUMBER
          SBD    CM+4 
          SHN    6-3
          LMD    ES+1        APPEND PP NUMBER 
          SCN    37 
          LMD    ES+1 
          STM    IBMA+2 
          LDK    MMFL 
          CRD    CM 
          LDD    CM          MACHINE ID 
          STM    IBMB+3 
          LDM    TISY,T2     SYMPTOM CODE 
          STM    IBMA+1 
          LDM    TIPR,T2     SET POSTPROCESSOR ADDRESS
          STD    T1 
          LJM    0,T1        COMPLETE MESSAGE PROCESSING
  
*         CCC/NIP STATUS. 
  
 IBM1     LDC    DM0401      SET MESSAGE ID 
          STM    IBMA 
          UJN    IBM3        COMPLETE BML MESSAGE 
  
*         FUNCTION REJECT, TRANSMISSION PARITY ERROR. 
  
 IBM2     LDD    CS 
          LPN    4
          ZJN    IBM3        IF REJECT MESSAGE
          AOD    T2 
          AOD    T5 
          LDM    TISY,T2     SYMPTOM CODE 
          STM    IBMA+1 
 IBM3     LDD    ST          EQUIPMENT STATUS 
          STM    IBMC+1 
*         UJN    IBM4        COMPLETE BML MESSAGE 
  
*         INCOMPLETE DATA TRANSFER. 
  
 IBM4     LDD    CS          CONVERTER STATUS/BYTE COUNT
          STM    IBMC 
*         UJN    IBM5        COMPLETE BML MESSAGE 
  
*         CHANNEL PARITY ERROR. 
  
 IBM5     LDD    RT          RETRY COUNT/UNRECOVERED FLAG 
 IBM6     STM    IBMB+1 
*         UJN    IBM7        COMPLETE BML MESSAGE 
  
*         FUNCTION TIMEOUT, CONTROLLER HUNG BUSY. 
  
 IBM7     LDD    FC 
          STM    IBMC+2 
  
*         EQUIPMENT TURNED OFF. 
  
 IBM8     LDD    ES+4        SET EQUIPMENT NUMBER 
          SHN    0-11 
          LPN    7
          SHN    6
          STM    IBMA+3 
          LDD    EQ          EST ORDINAL
          SHN    0-3
          STM    IBMB 
          LDN    ZERL        CLEAR CM REGISTER FOR DAYFILE CALL 
          CRD    CM 
          LDM    TINB,T2     SET BYTE COUNT FOR MESSAGE 
          STD    CM+1 
          LDC    IBMA+BMLN   SEND MESSAGE TO BML
          RJM    DFM
          LJM    IBMX        RETURN 
  
**        BML MESSAGE TABLE.
  
  
 IBMA     VFD    12/0,12/0,6/0,6/0,6/0,18/0   BML WORD 2
 IBMB     VFD    12/0,6/0,6/0,12/0,12/0,12/0  BML WORD 3
 IBMC     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  ERJM,IBM2,/COMSDFS/HS0025,3*5   FUNCTION REJECT
          DBMLT  ETPE,IBM2,/COMSDFS/HS0010,3*5   TRANSMISSION PARITY
          DBMLT  EFTM,IBM7,/COMSDFS/HS0050,3*5   FUNCTION TIMEOUT 
          DBMLT  EITM,IBM4,/COMSDFS/HS0005,3*5   INCOMPLETE TRANSFER
          DBMLT  EEOM,IBM8,/COMSDFS/HS0030,2*5   EQUIPMENT TURNED OFF 
          DBMLT  ECBM,IBM7,/COMSDFS/HS0044,3*5   CONTROLLER HUNG BUSY 
          DBMLT  ECRE,IBM5,/COMSDFS/HS0024,3*5   CHANNEL PARITY ERROR 
          DBMLT  ECSE,IBM1,HI0113,3*5            CCC/NIP STATUS ERROR 
          DBMLT  ECLM,IBM1,HI0111,3*5            CCC/NIP LOADED 
          DBMLT  ECWE,IBM1,HI0112,3*5            CCC/NIP LOAD ERROR 
          DBMLT  ECNF,IBMX,0,0  CCC/NIP CONTROLWARE NOT FOUND 
          SPACE  4,10 
          BLMSIDT 
 TIPR     SPACE  4,10 
**        TIPR - TABLE OF PROCESSING ROUTINES.
  
  
 TIPR     INDEX 
          DUP    ELME-BAME,1
          CON    IBMX 
          ORG    TIPR 
 DTPR     HERE
          INDEX  ELME-BAME
 TISY     SPACE  4,10 
**        TISY - TABLE OF SYMPTOM CODES.
  
  
 TISY     INDEX 
 DTSY     HERE
          INDEX  ELME-BAME
 TINB     SPACE  4,10 
**        TINB - TABLE OF NUMBER OF BML BYTES.
  
  
 TINB     INDEX 
 DTNB     HERE
          INDEX  ELME-BAME
 OEQ      SPACE  4,10 
**        OEQ - OFF EQUIPMENT.
* 
*         ENTRY  (EQ) = EST ORDINAL / DEVICE TYPE.
*                (IR+3) = BUFFER POINT NUMBER.
* 
*         USES   MC, CM - CM+4. 
* 
*         CALLS  ERM, IOM.
* 
*         MACROS MONITOR, NFA.
  
  
 OEQ      SUBR               ENTRY/EXIT 
          LDD    EQ 
          SHN    -3 
          STD    CM+1 
          LDN    OFES        SET OFF STATUS 
          STD    CM+2 
          MONITOR  SEQM      SET EQUIPMENT PARAMETER
          LDN    EEOM        *EQXXX TURNED OFF BY SYSTEM.*
          STD    MC 
          RJM    ERM         SEND ERROR MESSAGE 
          LDN    EOHE        *OFF - CHECK ERRLOG.*
          RJM    IOM         ISSUE OPERATOR MESSAGE 
          LDN    ZERL 
          CRD    CM 
          LDN    ELAE        ERROR LOG ALERT
          STD    CM+4 
          MONITOR  EATM 
          UJN    OEQX        RETURN 
 PEF      SPACE  4,10 
**        PEF - PROCESS ERROR FLAG. 
* 
*         FILES IN PROCESS ARE RETURNED TO THE SYSTEM BY A *RERUN*. 
* 
*         USES   T1, CM - CM+4. 
* 
*         MACROS NFA. 
  
  
 PEF      SUBR               ENTRY/EXIT 
          LDN    ZERL 
          CRD    CM 
          LDD    RA 
          SHN    6
          ADN    DRQR 
          CWD    CM          CLEAR PENDING REQUEST
          LDN    MXEQ*2-2 
          STD    T1 
 PEF1     NFA    BFCW        ENTER *RERUN* FOR ALL EQUIPMENTS 
          ADD    T1 
          CRD    CM 
          LDN    RRNM        ENTER *RERUN* OPERATOR FLAG FOR *1CD*
          STD    CM+4 
          LCN    0           SET PRIORITY 
          STD    CM+2 
          NFA    BFCW        STORE BUFFER POINT WORD
          ADD    T1 
          CWD    CM 
          LCN    2           DECREMENT BUFFER POINT INDEX 
          RAD    T1 
          PJN    PEF1        IF NOT LAST BUFFER 
          UJN    PEFX        RETURN 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPC2D 
          SPACE  4,10 
**        LITERALS BLOCK. 
  
  
          USE    LITERALS 
 DSPP     SPACE  4,10 
**        DSPP - *DSP* PARAMETER BUFFER.
  
  
 DSPP     BSS    0
 DSPPE    EQU    DSPP+DSPBL*5 
          SPACE  4,10 
          OVERFLOW  OIES,7777+DSPP-DSPPE
 PRS      TTL    1IO/3ID - 1IO PRESET BATCHIO.
          TITLE 
          QUAL   3ID
          IDENT  3ID,PRSX 
*COMMENT  1IO - BATCHIO PRESET. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  PRESET BATCHIO.
 PRS      SPACE  4,10 
**        PRS - PRESET BATCHIO. 
  
  
          ORG    ORGR 
  
 PRS      SUBR               ENTRY/EXIT 
          LDD    IR+4        CHECK RECOVERY 
          LMN    DRET 
          NJN    PRS1        IF NOT DEADSTART RERUN 
          RJM    RIO         RECOVER *BATCHIO*
          LDC    4000        SET RECOVERY FLAG
          STD    IR+4 
 PRS1     LDN    0           CLEAR INPUT REGISTER FLAGS 
          STD    IR+2 
          STD    IR+3 
          LDN    ZERL        CLEAR CONSOLE MESSAGE
          CRD    CM 
          LDD    CP 
          ADN    MS1W 
          CWD    CM 
          LDN    CTIR-1      CLEAR (RA - RA+CTIR) 
          STD    CM+2 
          LDD    HN          SET SUBFUNCTION = RELATIVE ADDRESSES 
          STD    CM+1 
          AOD    CM+4 
          MONITOR  CSTM 
  
*         BUILD AVAILABLE EQUIPMENT TABLE.
  
          LDN    ESTP        READ EST POINTER 
          CRD    CM 
          LDN    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          STD    T1 
          LDN    0
          STD    T2          CLEAR TABLE INDEX
 PRS4     AOD    T1          ADVANCE EST ORDINAL
          LMD    CM+2 
          ZJP    PRS8        IF END OF EST
          SFA    EST,T1      READ EST ENTRY 
          ADK    EQDE 
          CRD    CN          READ EST ENTRY 
          LDD    CN+3 
          ZJN    PRS4        IF EQUIPMENT UNDEFINED 
          LCN    1
          STD    T3 
 PRS6     LDN    2           ADVANCE TABLE INDEX
          RAD    T3 
          LDM    TEQT,T3     COMPARE EQUIPMENT TYPE 
          ZJN    PRS4        IF END OF TABLE
          LMD    CN+3 
          NJN    PRS6        IF NO MATCH
          LDN    ZERL 
          CRD    CN 
          LDD    T2          CHECK BUFFER POINT AVAILABLE 
          SBN    MXEQ 
          PJN    PRS9        IF NONE LEFT 
          LDD    T1 
          STD    CN+3 
          SHN    3           SET EST ORDINAL AND TYPE IN TABLE
          LMM    TEQT+1,T3
          STM    TAEQ+1,T2
          NFA    BFCW        STORE BUFFER POINT WORD
          ADD    T2 
          ADD    T2 
          CWD    CN 
          AOD    T2          ADVANCE TABLE
          LJM    PRS4        LOOP 
  
 PRS8     LDD    T2          SET EQUIPMENT COUNT
          STM    TAEQ 
          NJN    PRS10       IF EQUIPMENT AVAILABLE 
          LDC    =C*NO EQUIPMENT AVAILABLE.*
          RJM    DFM
          LJM    DPP         DROP PP
  
 PRS9     LDD    T2          SET EQUIPMENT COUNT
          STM    TAEQ 
          LDC    =C* NOT ALL EQUIPMENT SERVICABLE.* 
          RJM    DFM
          LDM    TAEQ        RESTORE
          STD    T2 
 PRS10    AOD    T2          CLEAR REMAINDER OF TABLE 
          SBK    TAEQL
          PJN    PRS11       IF END OF TABLE
          LDN    0
          STM    TAEQ,T2
          UJN    PRS10       LOOP 
  
 PRS11    LDN    TAEQL/5     STORE AVAILABLE EQUIPMENT TABLE
          STD    T1 
          LDD    RA 
          SHN    6
          ADN    TEQR 
          CWM    TAEQ,T1
          LDN    40          SET PRESET COMPLETE FLAG 
          RAD    IR+1 
          LDN    IPRL        CHECK 64 CHARACTER SET 
          CRD    CN 
          LDD    CN+2 
          SHN    21-0 
          MJN    PRS12       IF 64 CHARACTER SET
          RJM    CCT         CHANGE CONVERSION TABLES 
 PRS12    LDC    CTBLL/5     STORE CONVERSION TABLES
          STD    T1 
          LDD    RA 
          SHN    6
          ADN    CTIR 
          CWM    CTBL,T1
          CWD    ON-4        SET *DSP/QAC* BUFFER NOT BUSY
          ERRNZ  CTIR+CTBLL/5-QAPB  CODE DEPENDS ON CONTIGUOUS BUFFERS
          LDD    CP          READ CONTROL STATEMENT POINTER 
          ADN    CSPW 
          CRD    CM 
          ADN    JCRW-CSPW   READ JOB CONTROL REGISTERS 
          CRD    CN 
          SBN    JCRW-EOJW   READ END OF JOB CONTROL
          CRD    FN 
          AOD    CN+1        SET (R3) = 1 
  
*         DISABLE OUTPUT FILE WHEN SUBSYSTEM IDLEDOWN.
  
          LDC    NOJT*100-QOJT*100
          RAD    FN 
          LDC    CSBN-1      SET NEXT CONTROL STATEMENT 
          STD    CM+3 
          SBN    2           SET LIMIT OF CONTROL STATEMENTS
          STD    CM+4 
          NFA    CSBN        STORE CONTROL STATEMENTS FOR RECOVERY
          CWM    PRSA,TR
          LDD    CP          UPDATE STATEMENT POINTERS
          ADN    CSPW 
          CWD    CM 
          ADN    JCRW-CSPW   STORE JOB CONTROL REGISTERS
          CWD    CN 
          SBN    JCRW-EOJW   STORE END OF JOB CONTROL 
          CWD    FN 
          LDN    ZERL 
          CRD    CM 
          LDN    BFL/100     SET INITIAL FL 
          STD    CM+1 
          MONITOR  RSTM 
          LDC    SSCF*10000+BISI  SET SUBSYSTEM ACCESSABILITY FLAG
          RJM    AST
          LJM    PRSX        RETURN 
  
 PRSA     VFD    60/0 
          VFD    60/0LBIO1. 
          VFD    60/0LEXIT. 
 CCT      SPACE  4,10 
**        CCT - CHANGE CONVERSION TABLES
* 
*         CCT CHANGES CONVERSION TABLES FROM 64 CHARACTER SET 
*         TRANSLATION TO 63 CHARACTER TRANSLATION.
*         THE COLON WILL BE CHANGED FROM 00 TO 63 DISPLAY CODE, 
*         THE PERCENT WILL BE DROPPED, AND 00 DISPLAY WILL BE 
*         TRANSLATED TO A BLANK.
  
  
 CCT      SUBR               ENTRY/EXIT 
  
*         COMT6DP.
  
          LDN    55          SPACE
          STM    CTBA+1+16
          LDN    63          COLON
          STM    CTBA+1+12
  
*         COMT9DP.
  
          LDN    55          SPACE
          STM    CTBB+1+34
          LDN    63          COLON
          STM    CTBB+1+12
  
*         COMTDA8.
  
          LDN    40          SPACE
          STM    CTBC+1+00
          LDN    72          COLON
          STM    CTBC+1+63
  
*         COMTDP6.
  
          LDN    0           BLANK     NO PUNCH 
          STM    CTBD+1+00
          LDC    0202        COLON     8-2
          STM    CTBD+1+63
  
*         COMTDP9.
  
          LDN    0           BLANK     NO PUNCH 
          STM    CTBE+1+00
          LDC    0202        COLON     8-2
          STM    CTBE+1+63
          LJM    CCTX        EXIT 
 CTBL     SPACE  4,10 
**        CTBL - CONVERSION TABLES. 
  
  
 CTBL     BSS    0
  
 CTBA     CON    C6XD 
*CALL     COMT6DP 
          BSS    CTBA+CTLN*5-*  PRESERVE WORD BOUNDARY
  
 CTBB     CON    C9XD 
*CALL     COMT9DP 
          BSS    CTBB+CTLN*5-*  PRESERVE WORD BOUNDARY
  
 CTBC     CON    CDX8 
*CALL     COMTDA8 
          BSS    CTBC+CTLN*5-*  PRESERVE WORD BOUNDARY
  
 CTBD     CON    CDXH 
*CALL     COMTDP6 
          BSS    CTBD+CTLN*5-*  PRESERVE WORD BOUNDARY
  
 CTBE     CON    CDXA 
*CALL     COMTDP9 
          BSS    CTBE+CTLN*5-*  PRESERVE WORD BOUNDARY
  
 CTBLL    EQU    *-CTBL 
  
          ERRNZ  CTBLL/5*5-CTBLL INSURE TABLE LENGTH IS MULTIPLE
*                                      OF CM WORDS
 TEQT     SPACE  4,10 
**        TEQT - TABLE OF EQUIPMENT TYPES.
*         ENTRY = 2 WORDS.
* 
*T TEQT   12/MNEMONIC, 12/DEVICE TYPE 
  
  
 TEQT     BSS    0
          VFD    12/2RCP,12/CPDT  415 
          VFD    12/2RCR,12/CRDT  405 
          VFD    12/2RLQ,12/LPDT  512 
          VFD    12/2RLR,12/LPDT  580-12
          VFD    12/2RLS,12/LPDT  580-16
          VFD    12/2RLT,12/LPDT  580-20
          VFD    12/2RLX,12/NPDT  5870
          VFD    12/2RLY,12/NPDT  5970
          DATA   0
          SPACE  4,10 
**        COMMON DECKS. 
  
  
 QUAL$    SET    1
 AST$     EQU    0           DEFINE *COMPAST* ACCESS TO *SSCT*
*CALL     COMPAST 
*CALL     COMPSAF 
          TITLE  RECOVER BATCHIO. 
 RIO      SPACE  4,10 
**        RIO - RECOVER *BATCHIO*.
* 
*         USES   T5, T7, BA - BA+1, CM - CM+4, CN - CN+4, FN - FN+4.
* 
*         CALLS  CAB, DEQ, DFM, RQF, SAF, SFA.
* 
*         MACROS NFA. 
  
  
 RIO4     RJM    DEQ         DROP EQUIPMENT 
          LDC    =C* RECOVERY COMPLETE.*
          RJM    DFM
  
 RIO      SUBR               ENTRY/EXIT 
          RJM    CAB         COUNT ACTIVE BUFFERS 
          ZJN    RIO4        IF SUBSYSTEM IDLE
          LDN    MXEQ        SET MAXIMUM EQUIPMENT COUNT
          STD    T5 
          LDN    0           SET FIRST FET ADDRESS
          STD    BA 
          LDC    BUFR 
          STD    BA+1 
 RIO1     RJM    SFA         READ FILE NAME 
          CRD    FN 
          ADN    4           READ LIMIT WORD
          CRD    CN 
          ADN    5-4         READ FILE PARAMETER WORD 
          CRD    T7 
          LDD    FN 
          ZJN    RIO2        IF BUFFER UNASSIGNED 
          LDD    CN          SEARCH FOR ASSIGNED FILE 
          RJM    SAF
          ZJN    RIO2        IF FILE NOT FOUND
          NFA    T7,R 
          CRD    CM 
          LCN    0           SET REQUEUING PRIORITY 
          STD    CM+2 
          NFA    T7,R        STORE BUFFER POINT WORD
          CWD    CM 
          RJM    RQF         REQUEUE FILE 
          ZJN    RIO3        IF ALL ACTIVE BUFFERS PROCESSED
 RIO2     LDD    CN+3        SET NEXT FET ADDRESS 
          STD    BA 
          LDD    CN+4 
          STD    BA+1 
          SOD    T5          DECREMENT EQUIPMENT COUNT
          NJN    RIO1        IF ALL EQUIPMENT NOT CHECKED 
 RIO3     LJM    RIO4        DROP EQUIPMENT 
          TITLE  RECOVERY SUBROUTINES.
 CAB      SPACE  4,10 
**        CAB - COUNT ACTIVE BUFFERS. 
* 
*         EXIT   (A) = (T6) = ACTIVE BUFFER COUNT.
* 
*         USES   T7, CM - CM+4. 
  
  
 CAB      SUBR               ENTRY/EXIT 
          LDN    D1AR        SET FIRST DRIVER ASSIGNMENT WORD 
          STD    T7 
          LDN    0           CLEAR BUFFER COUNT 
          STD    T6 
 CAB1     LDD    RA          READ DRIVER ASSIGNMENT WORD
          SHN    6
          ADD    T7 
          CRD    CM 
          LDD    CM+1        CHECK DRIVER ASSIGNED
          SCN    77 
          SHN    6
          LMD    CM 
          LMC    3RD1C
          NJN    CAB2        IF DRIVER NOT ASSIGNED 
          LDD    CM+3        ADVANCE ACTIVE BUFFER COUNT
          RAD    T6 
 CAB2     AOD    T7          ADVANCE ASSIGNMENT ADDRESS 
          LMN    DRQR 
          NJN    CAB1        IF NOT END OF DRIVER WORDS 
          LDD    T6 
          UJN    CABX        RETURN 
 DEQ      SPACE  4,10 
**        DEQ - DROP EQUIPMENT. 
* 
*         USES   T6, T7, CM - CM+4, CN - CN+4, FS - FS+4. 
* 
*         MACROS MONITOR, SFA.
  
  
 DEQ      SUBR               ENTRY/EXIT 
          LDN    ESTP        READ EST POINTER 
          CRD    FS 
          LDD    CP          FETCH EJT ORDINAL
          ADN    TFSW 
          CRD    T6 
          LDN    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          STD    T7 
 DEQ1     AOD    T7          ADVANCE EST ORDINAL
          STD    CM+1 
          LMD    FS+2 
          ZJN    DEQX        IF END OF EST
          SFA    EST,T7      READ EQUIPMENT ASSIGNMENT
          ADK    EQAE 
          CRD    CN 
          LDD    CN+4 
          LMD    T6 
          NJN    DEQ1        IF NOT ASSIGNED TO THIS JOB
          MONITOR  DEQM      RELEASE EQUIPMENT
          UJN    DEQ1        LOOP TO END OF EST 
 RQF      SPACE  4,15 
**        RQF - REQUEUE FILE. 
* 
*         ENTRY  (T6) = ACTIVE BUFFER COUNT.
*                (BA - BA+1) = FET ADDRESS. 
*                (FN - FN+4) = FILE NAME. 
* 
*         EXIT   (A) = (T6) = ACTIVE BUFFER COUNT DECREMENTED.
* 
*         USES   CM - CM+4. 
* 
*         CALLS  SFA, WNB.
* 
*         MACROS DELAY, MONITOR, PAUSE. 
  
  
 RQF2     RJM    WNB         WAIT NOT BUSY
          SOD    T6          DECREMENT ACTIVE BUFFER COUNT
  
 RQF      SUBR               ENTRY/EXIT 
          LDD    BA+1        SET FET ADDRESS IN *QAP* CALL
          STM    RQFA+4 
          LDD    BA 
          STM    RQFA+3 
          LDC    RQFF        SET *QAP* FUNCTION IN FET
          STD    FN+4 
          RJM    SFA         STORE FUNCTION IN FET
          CWD    FN 
          ADN    QAPO        SET *DSP* PARAMETER BLOCK BUSY 
          CWD    FN 
 RQF1     LDD    MA          STORE *QAP* CALL 
          CWM    RQFA,ON
          LDN    0           ALLOW QUEUING OF PP REQUEST
          STD    CM+1 
          MONITOR  RPPM 
          LDD    CM+1 
          NJN    RQF2        IF PP ASSIGNED / REQUEST QUEUED
          DELAY              WAIT AWHILE
          PAUSE              CHECK ERROR FLAG 
          LDD    CM+1 
          ZJN    RQF1        IF NO ERROR FLAG SET 
          MONITOR  ABTM      ABORT JOB
          LJM    PPR         EXIT TO PP RESIDENT
  
 RQFA     VFD    18/0LQAP,42/BUFR 
 WNB      SPACE  4,10 
**        WNB - WAIT NOT BUSY.
* 
*         USES   FN - FN+4. 
* 
*         CALLS  SFA. 
* 
*         MACROS DELAY, MONITOR, PAUSE. 
  
  
 WNB2     RJM    SFA         CHECK *DSP* PARAMETER BLOCK
          ADN    QAPO 
          CRD    FN 
          LDD    FN+4 
          LPN    1
          ZJN    WNB1        IF FILE BUSY 
  
 WNB      SUBR               ENTRY/EXIT 
 WNB1     DELAY              WAIT AWHILE
          PAUSE              CHECK ERROR FLAG 
          LDD    CM+1 
          ZJN    WNB2        IF NO ERROR FLAG SET 
          MONITOR  ABTM      ABORT JOB
          LJM    PPR         EXIT TO PP RESIDENT
          SPACE  4,10 
          OVERFLOW  ORGR,BFMS 
          TTL    1IO/3IF - LOAD CCC/NIP CONTROLWARE.
          TITLE 
          QUAL   3IF
          IDENT  3IF,LCCX 
*COMMENT  1IO - LOAD CCC/NIP CONTROLWARE. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 3IF      SPACE  4,15 
**        *3IF* LOADS 5870/5970 CONTROLWARE INTO A CYBER CHANNEL
*         COUPLER (CCC).
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMSMSP 
          SPACE  4,10 
**        CCC8700 FILE INFORMATION. 
  
  
 T52W     EQU    17          52 TABLE WORD
 LDTL     EQU    20          LOADER TABLES LENGTH 
          TITLE  MAIN ROUTINE.
 LCC      SPACE  4,20 
**        LCC - LOAD CCC CONTROLWARE. 
* 
*         ENTRY  (EQ) = 9/EST ORDINAL, 3/DEVICE TYPE. 
*                (ES - ES+4) = EST ENTRY. 
*                EQUIPMENT AND CHANNEL RESERVED.
* 
*         EXIT   (A) = 0 IF CONTROLWARE LOADED. 
* 
*         ERROR  TO *FCN3* IF LOAD ERROR. 
* 
*         USES   CN, MC.
* 
*         CALLS  CGS, COE, GCW, LCW, RSI, /3IC/ERM. 
* 
*         MACROS EXECUTE. 
  
  
          ORG    ORGR 
  
 LCC      SUBR               ENTRY/EXIT 
          LDD    FL          SAVE FIELD LENGTH
          STD    CN 
          RJM    GCW         GET CCC/NIP CONTROLWARE
          NJN    LCCX        IF STORAGE NOT AVAILABLE 
          RJM    LCW         LOAD CCC/NIP CONTROLWARE 
          LDD    CN          RESET FIELD LENGTH 
          RJM    RSI
          RJM    CGS         GET GENERAL STATUS 
          NJN    LCC2        IF ERROR 
          LDD    ST 
          NJN    LCC1        IF LOAD ERROR
          RJM    COE         CHECK OTHER EQUIPMENT
          LDN    ECLM        *EQXXX CCC/NIP CONTROLWARE LOADED.*
          STD    MC 
          EXECUTE  3IC
          RJM    /3IC/ERM    SEND ERROR MESSAGE 
          LDN    0           LOAD SUCCESSFUL
          UJN    LCCX        RETURN 
  
 LCC1     LDN    ECLE        *EQXXX CCC/NIP CONTROLWARE LOAD ERROR.*
 LCC2     LJM    FCN3        PROCESS ERROR
          SPACE  4,10 
          ERRNG  OIES-5-*    *3IC* OVERLAYS CODE
          TITLE  SUBROUTINES. 
 COE      SPACE  4,10 
**        COE - CHECK OTHER EQUIPMENT.
* 
*         ENTRY  (ES+1) = CURRENT CHANNEL BEING LOADED. 
* 
*         USES   T1, CN - CN+4. 
* 
*         CALLS  UES. 
* 
*         MACROS SFA. 
  
  
 COE      SUBR               ENTRY/EXIT 
          LDM    TAEQ        SET AVAILABLE EQUIPMENT COUNT
          STD    T1 
 COE1     LDM    TAEQ,T1     LOOK FOR NON-IMPACT PRINTER
          LPN    7
          SBK    NPDT 
          ZJN    COE3        IF NON-IMPACT PRINTER
 COE2     SOD    T1 
          NJN    COE1        IF MORE EQUIPMENT TO CHECK 
          UJN    COEX        RETURN 
  
 COE3     LDM    TAEQ,T1     READ EQUIPMENT EST ENTRY 
          SHN    -3 
          SFA    EST
          ADK    EQDE 
          CRD    CN 
          LDD    CN          CHECK CONTROLWARE LOAD REQUIRED
          SHN    21-4 
          PJN    COE2        IF NOT CONTROLWARE LOAD REQUIRED 
          LDD    ES+1 
          LMD    CN+1 
          LPN    37 
          NJN    COE2        IF NOT CURRENT CHANNEL 
          LDM    TAEQ,T1
          RJM    UES         UPDATE EQUIPMENT STATUS
          UJN    COE2        CHECK NEXT EQUIPMENT 
 GCB      SPACE  4,10 
**        GCB - GET CENTRAL MEMORY BUFFER.
* 
*         ENTRY  (A) = BUFFER SIZE NEEDED (CM WORDS). 
* 
*         EXIT   (A) = 0 IF BUFFER ASSIGNED.
* 
*         USES   CM - CM+4. 
* 
*         MACROS MONITOR. 
  
  
 GCB      SUBR               ENTRY/EXIT 
          ADC    77+LDTL
          SHN    -6 
          ADD    FL 
          STD    CM+1 
          LDN    0
          STD    CM+2 
          MONITOR  RSTM      REQUEST STORAGE INCREASE 
          LDD    CM+1 
          UJN    GCBX        RETURN 
 GCW      SPACE  4,15 
**        GCW - GET CCC/NIP CONTROLWARE.
* 
*         EXIT   (A) = 0 IF CONTROLWARE MOVED TO CM.
*                (CN+3 - CN+4) = LENGTH OF CONTROLWARE. 
* 
*         ERROR  TO *MSR1* IF CONTROLWARE NOT FOUND.
* 
*         USES   T5, T6, T7, AB - AB+4, CM - CM+4, FN - FN+4. 
* 
*         CALLS  GCB, CLD, RNS. 
* 
*         MACROS ENDMS, SETMS.
  
  
 GCW      SUBR               ENTRY/EXIT 
          LDD    MA          SET CONTROLWARE RECORD NAME
          CWM    CCCN,ON
          SBN    1
          CRD    AB 
          RJM    CLD         SEARCH CENTRAL LIBRARY DIRECTORY 
          NJN    GCW1        IF CONTROLWARE RECORD FOUND
          LDN    ECNF        *EQXXX CCC/NIP CONTROLWARE NOT FOUND.* 
          LJM    MSR1        PROCESS ERROR
  
 GCW1     CRD    FN          READ TRACK AND SECTOR
          LDN    FNTP        GET SYSTEM EQUIPMENT 
          CRD    CM 
          LDD    CM          READ SYSTEM FST
          SHN    14 
          ADD    CM+1 
          ADK    SYFO*FNTE+FSTG 
          CRD    T5 
          SETMS  READSYS
          LDD    FN+3        SET FILE POINTERS
          STD    T6          TRACK
          LDD    FN+4        SECTOR 
          STD    T7 
          LDN    0           SET FIRST SECTOR FLAG
          STD    FN+1 
 GCW2     LDC    BFMS        READ SECTOR
          RJM    RNS
          ZJN    GCW4        IF END OF FIRMWARE 
          STD    FN          SAVE WORD COUNT
          LDD    FN+1        CHECK IF FIRST SECTOR
          NJN    GCW3        IF NOT FIRST SECTOR
          ENDMS 
          LDM    BFMS+2+T52W*5+3  SET BUFFER SIZE REQUIRED
          STD    CN+3 
          SHN    14 
          ADM    BFMS+2+T52W*5+4
          STD    CN+4 
          RJM    GCB         GET CENTRAL MEMORY BUFFER
          NJN    GCW5        IF BUFFER NOT ASSIGNED 
 GCW3     LDD    RA          WRITE BUFFER TO CENTRAL MEMORY 
          ADD    CN 
          ADD    FN+1 
          SHN    6
          CWM    BFMS+2,FN
          AOD    FN+1 
          LDD    FN          CHECK FOR EOR
          SHN    -6 
          NJN    GCW2        IF NOT END OF FIRMWARE 
 GCW4     ENDMS 
*         LDN    0
 GCW5     LJM    GCWX        RETURN 
 LCW      SPACE  4,10 
**        LCW - LOAD CCC/NIP CONTROLWARE. 
* 
*         ENTRY  (CN) = FWA / 100B OF BUFFER. 
*                (CN+3 - CN+4) = CONTROLWARE LENGTH.
* 
*         ERROR  TO *MSR1* IF ERROR.
* 
*         USES   CS, FN, FN+1, CN+3 - CN+4. 
* 
*         CALLS  CFN, MCI.
  
  
 LCW3     STD    CN+4        SET REMAINING WORD COUNT 
          SHN    -6 
          NJN    LCW4        IF MORE THAN 100B WORDS
          LDD    CN+4 
          STD    FN 
 LCW4     SHN    -6 
          STD    CN+3 
 LCW5     LDD    RA          READ NEXT BUFFER 
          ADD    CN 
          ADD    FN+1 
          SHN    6
          ADN    LDTL 
          CRM    BFMS+2,FN
          LDD    FN          COMPUTE BYTE COUNT 
          SHN    2
          ADD    FN 
          OAM    BFMS+2,CH
          NJN    LCW1        IF INCOMPLETE TRANSFER 
          AOD    FN+1        ADVANCE BUFFER ADDRESS 
          LDD    CN+3 
          SHN    14 
          ADD    CN+4 
          SBD    FN 
          NJN    LCW3        IF MORE TO LOAD
          FJM    *,CH        IF TRANSFER NOT COMPLETE 
          DCN    CH+40
  
 LCW      SUBR               ENTRY/EXIT 
          RJM    MCI         MODIFY CHANNEL INSTRUCTIONS
          LDD    HN 
          STD    FN 
          LDC    414         ISSUE AUTOLOAD FUNCTION
          RJM    CFN
          STD    FN+1 
          NJN    LCW2        IF ERROR 
          ACN    CH 
          LJM    LCW5        OUTPUT CONTROLWARE TO CCC
  
 LCW1     STD    CS          SAVE BYTE COUNT
          LDN    EITM        *EQXXX INCOMPLETE DATA TRANSFER.*
 LCW2     LJM    MSR1        PROCESS ERROR
 MCI      SPACE  4,10 
**        MCI - MODIFY CHANNEL INSTRUCTIONS.
* 
*         ENTRY  (ES+1) = CHANNEL NUMBER. 
* 
*         USES   T1, T2.
  
  
 MCI1     RAI    T2 
          AOD    T1 
 MCI2     LDI    T1 
          STD    T2 
          LDD    ES+1 
          LPN    37 
          CHTL   *
          SBN    CH 
          NJN    MCI1        IF MORE INSTRUCTIONS TO MODIFY 
  
 MCI      SUBR               ENTRY/EXIT 
          LDC    TCHS        LOAD FWA OF CHANNEL TABLE ADDRESSES
          STD    T1 
          UJN    MCI2        UPDATE CHANNEL INSTRUCTIONS
 MSR      SPACE  4,15 
**        MSR - ERROR PROCESSOR FOR *COMPRNS*.
* 
*         ENTRY  (CN) = ORIGINAL FL.
* 
*         EXIT   TO *FCN3*. 
* 
*         USES   MC.
* 
*         CALLS  RSI. 
* 
*         MACROS ENDMS. 
  
  
 MSR      SUBR               ENTRY/EXIT 
          ENDMS 
          LDN    ECWE        *EQXXX CCC/NIP CONTROLWARE LOAD ERROR.*
 MSR1     STD    MC 
          LDD    CN          RESET FIELD LENGTH 
          RJM    RSI
          LDD    MC 
          LJM    FCN3        ISSUE ERROR
 UES      SPACE  4,10 
**        UES - UPDATE EQUIPMENT STATUS.
* 
*         ENTRY  (A) = 9/EST ORDINAL, 3/DEVICE TYPE.
* 
*         EXIT   CONTROLWARE LOAD REQUIRED BIT CLEARED IN EST.
* 
*         USES   CM - CM+4. 
* 
*         MACROS MONITOR. 
  
  
 UES      SUBR               ENTRY/EXIT 
          SHN    -3 
          STD    CM+1 
          LCN    20          SET MASK 
          STD    CM+3 
          LDN    0           SET VALUE
          STD    CM+4 
          LDN    SB0S        SET SUBFUNCTION
          STD    CM+2 
          MONITOR  SEQM      SET EQUIPMENT PARAMETER
          UJN    UESX        RETURN 
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMPCLD 
 QUAL$    EQU    0           FORCE UNQUALIFIED COMMON DECK
*CALL     COMPRNS 
          SPACE  4,10 
**        DATA LOCATIONS. 
  
  
 CCCN     VFD    42/0LCCC5870,18/0  CONTROLWARE RECORD NAME 
 TCHS     SPACE  4,10 
**        TCHS - CHANNEL TABLE. 
  
  
 TCHS     CHTB
          SPACE  4,10 
          OVERFLOW  ORGR,BFMS 
          TTL    1IO - BATCHIO MANAGER. 
          SPACE  4,10 
          END 
