*COMDECK,D895 
          TITLE  HIGH LEVEL 895 FULL TRACK PRODUCT OVERLAY FOR MALET. 
 589      SEGMENT POVLA 
          ORG    POVLA
          QUAL   D895 
*CALL,VERS
          COMMENT 895 PRODUCT OVERLAY FOR MALET "VERS"
          EJECT 
**        THE FOLLOWING COMMANDS  ARE  DESIGNED FOR THE  895 DISK SUB-
*         SUBSYSTEM  RUNNING IN FULL-TRACK MODE.  589  IS  THE PRODUCT
*         OVERLAY THAT EXECUTES THESE COMMANDS  AND  IS  DRIVEN BY THE
*         INSTRUCTION STACK OF THE MALET PP DRIVER.  REQUESTS ARE MADE
*         BY THE DRIVER BY STORING PARAMETERS INTO PP DIRECT CELLS AND
*         PERFORMING A  RETURN-JUMP TO AN OVERLAY SUBROUTINE. ONCE THE
*         REQUEST HAS BEEN COMPLETED, CONTROL IS RETURNED TO THE STACK
*         TO  EXECUTE  THE  NEXT  COMMAND.  THE  DEVICE TYPE FOR THESE
*         COMMANDS IS D895.  THE LANGUAGE NAME IS D895. 
* 
*         THE D895 FULL-TRACK PRODUCT OVERLAY SUPPORTS  A PROGRAMMABLE
*         INPUT BUFFER (IB) OF 505B PP WORDS, AN OUTPUT BUFFER (OB) OF
*         OF 505B PP WORDS AND A STATUS BUFFER (SB) OF  64B  PP WORDS.
*         THE STATUS BUFFER IS USED TO HOLD GENERAL AND  DETAIL STATUS
*         FROM THE SUBSYSTEM.  SUPPORTED CAPABILITIES ARE  AS FOLLOWS:  
* 
*            EXECUTE - INITIATE SUBSYSTEM DIAGNOSTIC TESTS. 
*            HALT    - TERMINATE INLINE DIAGNOSTIC EXECUTION. 
*            MONITOR - MONITOR INLINE DIAGNOSTIC EXECUTION. 
*            REL     - RELEASE DRIVE, CCC, STORAGE DIRECTOR AND I/O 
*                      CHANNEL. 
*            RES     - RESERVE I/O CHANNEL, CCC, STORAGE DIRECTOR AND 
*                      DRIVE. 
*            SENSE   - INPUT INLINE DIAGNOSTIC SENSE BYTES. 
*            STATUS  - INPUT GENERAL OR DETAIL STATUS TO SB.
* 
*         THIS PRODUCT OVERLAY DOES NOT USE THE WC OR BA  REGISTERS TO
*         CONTROL I/O OPERATIONS.  THESE REGISTERS ARE FREE FOR USE BY
*         THE MODULE PROGRAMMER.
* 
          EJECT 
**        THE FOLLOWING CHART DEFINES THE LAY-OUT OF THE STATUS BUFFER. 
* 
*                   --------------------   ---
*               0   /   GENERAL STATUS /      / 
*                   /------------------/      / 
*               1   /                  /      / 
*               .   /                  /      / 
*               .   /   DETAIL STATUS  /      / THIS IS THE NORMAL-LAST 
*               .   /                  /      / TAKEN STATUS FROM THE 
*               .   /                  /      / SUBSYSTEM 
*               .   /                  /      / 
*               .   /                  /      / 
*               .   /                  /      / 
*              24B  /                  /   ---
*                   /------------------/   ---
*              25B  /   GENERAL STATUS /      / 
*                   /------------------/      / 
*              26B  /                  /      / 
*               .   /                  /      / THIS IS THE FIRST TAKEN 
*               .   /   DETAIL STATUS  /      / STATUS WITHIN SEQUENCES 
*               .   /                  /      / THAT REQUIRED RECOVERY
*               .   /                  /      / TO BE PERFORMED.
*               .   /                  /      / (CONTINUE FUNCTIONS 
*               .   /                  /      / ISSUED) 
*               .   /                  /      / 
*              51B  /                  /   ---
*                   /------------------/   ---
*              52B  /  RETRY COUNT     /      / ERROR CORRECTION DATA 
*                   /------------------/   ---
*              56B  / 1ST BYTE         /      / DISK PACK SERIAL NUMBER 
*              57B  / 2ND BYTE         /      / (FROM ASSIGN DIRECTIVE) 
*                   /------------------/   ---
*              60B  / SEEK TIME        /      / MILLISECONDS TO DO LAST 
*                   /------------------/      / SEEK
*              61B  / CHANNEL          /   ---
*              62B  / EQUIPMENT        /      / 
*              63B  / UNIT             /      / EQUIPMENT UNDER TEST
*                   --------------------   ---
* 
*         ALL SUBROUTINES IN THIS PRODUCT OVERLAY USE  A  COMMON ERROR
*         EXIT  SEQUENCE WHEN  AN  ERROR  IS  DETECTED.  THIS SEQUENCE
*         STORES AN INTERNAL ERROR CODE INTO THE EC REGISTER, AN ERROR
*         MESSAGE INDEX INTO THE EM REGISTER  AND CURRENT  P  REGISTER
*         CONTENTS (LINE NUMBER) INTO THE  EA  REGISTER.   I-O CHANNEL
*         CLEAN-UP OCCURS  AND  A JUMP IS MADE TO THE STATEMENT NUMBER
*         SPECIFIED BY THE ABT ADDRESS IN THE COMMAND.
* 
          EJECT 
**        THE FOLLOWING TABLE DEFINES THE ERROR CODES AND MESSAGES THAT 
*         MAY BE GENERATED FOR EACH COMMAND.
* 
*                                     E H M R R S S 
*                                     X A O E E E T 
*                                     E L N L S N A 
*                                     C T I . . S T 
*                                     U . T . . E U 
*                                     T . O . . . S 
*                                     E . R . . . . 
*                                     - - - - - - - 
* 7110 CH NOT ASSIGNED                X X X . . X X 
*      ------------------------------ - - - - - - - 
* 7111 CH ACTIVE ON ENTRY             . . . . X . . 
*      ------------------------------ - - - - - - - 
* 7112 NO INACTIVE TO LAST FUNC       X X X X X X X 
*      ------------------------------ - - - - - - - 
* 7113 NO INACTIVE TO GENERAL STATUS  X . . . X X X 
*      ------------------------------ - - - - - - - 
* 7114 NO INACTIVE TO DETAIL STATUS   . . . . X . X 
*      ------------------------------ - - - - - - - 
* 7115 GENERAL STATUS NOT RETURNED    X . . . X X X 
*      ------------------------------ - - - - - - - 
* 7116 INCOMPLETE STATUS RETURNED     . . . . X . X 
*      ------------------------------ - - - - - - - 
* 7117 FUNC PARAMETERS NOT ACCEPTED   X . . . X . . 
*      ------------------------------ - - - - - - - 
* 7120 INCOMPLETE SENSE RETURNED      . . . . . X . 
*      ------------------------------ - - - - - - - 
* 7121 SD/DRIVE NOT CONNECTED         X X X . . X X 
*      ------------------------------ - - - - - - - 
* 7122 ACCESS LEVEL TOO LOW FOR REQ   X . . . . . . 
*      ------------------------------ - - - - - - - 
* 7123 RESERVE TIMEOUT                . . . . X . . 
*      ------------------------------ - - - - - - - 
* 7124 ABNORMAL GENERAL STATUS        X . . . X X . 
*      ------------------------------ - - - - - - - 
* 7125 CHANNEL FAILED TO GO EMPTY     X . . . . . . 
*      ------------------------------ - - - - - - - 
* 7126 DEVICE CODE/ STATUS MISMATCH   . . . . X . . 
*      ------------------------------ - - - - - - - 
* 7127 NO INACTIVE AFTER DATA XFER    X X X . . X X 
*      ------------------------------ - - - - - - - 
* 7130 CHANNEL PARITY ERROR ON INPUT  X X X . X X X 
*      ------------------------------ - - - - - - - 
* 7131 ILLEGAL ROUTINE SELECTION      X . . . . . . 
*      ------------------------------ - - - - - - - 
* 7132 UNIT HUNG BUSY                 X . . . . . . 
*      ------------------------------ - - - - - - - 
* 7133 DIAG SELECT ERROR              X . . . . . . 
*      ------------------------------ - - - - - - - 
* 7134 DIAG LOAD VERIFY ERROR         X . . . . . . 
*      ------------------------------ - - - - - - - 
* 7135 DIAG START ERROR               X . . . . . . 
*      ------------------------------ - - - - - - - 
* 7136 DIAG PARAMETER CHANGE ERROR    X . . . . . . 
*      ------------------------------ - - - - - - - 
* 7137 DIAG PARAMETERS NOT ACCEPTED   X . . . . . . 
*      ------------------------------ - - - - - - - 
          EJECT 
*         EQUATES FOR ERROR CODES - FIRST 7 ARE FOR BASIC DRIVER. 
  
 EC.FLE   EQU    1           ADDR OUT OF FL 
 EC.TL    EQU    2           I/O TIMEOUT ON CH RESERVE
 EC.SEE   EQU    3           SUBR ENTRY/EXIT ERROR
 EC.WC    EQU    4           BUFFER INDEX OR WC ERR 
 EC.RES   EQU    5           RESERVED FOR BASIC DRIVER
 EC.RES1  EQU    6           RESERVED FOR BASIC DRIVER
 EC.RES2  EQU    7           RESERVED FOR BASIC DRIVER
  
 EC.CNA   EQU    10B         CH NOT ASSIGNED
 EC.CAS   EQU    11B         CH ACTIVE ON ENTRY 
 EC.NIF   EQU    12B         NO INACTIVE TO LAST FUNC 
 EC.NIGS  EQU    13B         NO INACTIVE TO GENERAL STATUS
 EC.NIDS  EQU    14B         NO INACTIVE TO DETAIL  STATUS
 EC.GSNR  EQU    15B         GENERAL STATUS NOT RETURNED
 EC.ISR   EQU    16B         INCOMPLETE STATUS RETURNED 
 EC.FPNA  EQU    17B         FUNC PARAMETERS NOT ACCEPTED 
 EC.ISN   EQU    20B         INCOMPLETE SENSE RETURNED TO PP
 EC.SDNC  EQU    21B         SD/DRIVE NOT CONNECTED 
 EC.IAL   EQU    22B         ACCESS LEVEL TOO LOW FOR REQ 
 EC.NRES  EQU    23B         RESERVE TIMEOUT
 EC.AGS   EQU    24B         ABNORMAL GENERAL STATUS
 EC.CFE   EQU    25B         CHANNEL FAILED TO GO EMPTY 
 EC.DCSM  EQU    26B         DEVICE CODE/STATUS MISMATCH
 EC.NIDT  EQU    27B         NO INACTIVE AFTER DATA TRANSFER
 EC.CPE   EQU    30B         CHANNEL PARITY ERROR ON INPUT
 EC.ITS   EQU    31B         ILLEGAL ROUTINE SELECTION
 EC.UHB   EQU    32B         UNIT HUNG BUSY 
 EC.DSLE  EQU    33B         DIAG SELECT ERROR
 EC.DLVE  EQU    34B         DIAG LOAD VERIFY ERROR 
 EC.DSTE  EQU    35B         DIAG START ERROR 
 EC.DPCE  EQU    36B         DIAG PARAMETER CHANGE ERROR
 EC.DPNA  EQU    37B         DIAG PARAMETERS NOT ACCEPTED 
  
*         DIRECT CELL EQUATES 
  
 CL       EQU    63B         ADDRESS OF CURRENT (SECTOR) LENGTH  - V
 WC       EQU    64B         WORD COUNT FOR I/O 
 CC       EQU    65B         ADDRESS OF CURRENT CYLINDER         - W
 CT       EQU    66B         ADDRESS OF CURRENT TRACK            - X
 CS       EQU    67B         ADDRESS OF CURRENT SECTOR           - Y
  
 SEEKA    EQU    D.Z3        SEEK ADDRESS USES D.Z3 THRU D.Z7 
 PA       EQU    D.T0        PARAMETER ADDRESS
  
          EJECT 
*         EQUATES FOR EQUIPMENT FUNCTIONS.
  
 CONN     EQU    0           CONNECT
 OC       EQU    10B         OPERATION COMPLETE 
 GS       EQU    12B         GENERAL STATUS 
 EDS      EQU    23B         DETAIL STATUS
 RPC      EQU    60B         RUN PATH CONFIDENCE TEST 
 RDI      EQU    70B         RUN DI DIAGNOSTICS 
 SEL      EQU    71B         SELECT INLINE DIAG 
 VER      EQU    72B         VERIFY DIAG LOADED 
 SENS     EQU    73B         INPUT INLINE SENSE 
 CHNG     EQU    74B         CHANGE INLINE PARAMS 
 STRT     EQU    75B         START INLINE EXECUTION 
 MONTR    EQU    76B         MONITOR INLINE EXECUTION 
 HLT      EQU    77B         HALT INLINE EXECUTION
 CCCID    EQU    770B        CCC ID REQUEST FUNCTION
  
*         GENERAL STATUS BIT EQUATES. 
  
 BUSY     EQU    1           UNIT BUSY
 SDRES    EQU    3           STORAGE DIRECTOR RESERVED
 RIP      EQU    8D          RECOVERY IN PROGRESS 
 UNR      EQU    9D          UNRECOVERABLE ERROR
 ABN      EQU    11D         ABNORMAL TERMINATION 
  
*         DEVICE CODES SUPPORTED
  
 DC895    EQU    115B        895 DEVICE CODE
          SPACE   4,20
*         MISCELLANEOUS EQUATES.
  
 TIMBZ    EQU    72D         ITERATION TIME TO LOOP FOR 30 SEC
 TIMFJM   EQU    50000D/2     ITERATION TIME TO WAIT FOR FULL 50 MSEC 
 TIMREL   EQU    400000D/100D INTERVAL FOR CHANNEL RELEASE- 
 MAXITT   EQU    12D         ITERATION COUNT FOR ABOUT A 5 SEC.DELAY
 MAXCDD8  EQU    1565B       MAXIMUM CYLINDER ON 895
  
*IF -DEF,SECURE,1 
 ARD      EQU    2           READ ANYWHERE
*IF DEF,SECURE,1
 ARD      EQU    4           READ ANYWHERE
 ARW      EQU    4           READ ANYWHERE, WRITE ANYWHERE
 AL21     EQU    21B         ACCESS LEVEL FOR NO CHANNEL CLEANUP OR ERR 
 CH       EQU    37B         DEFAULT CHANNEL VALUE FOR I/O COMMANDS 
  
          EJECT 
**        ERROR MESSAGES - WRITTEN TO CM DURING INITIALIZATION. 
* 
*         MMSG MACRO. 
* 
*         MMSG  MACRO  NAME,ECODE,MSG,FABT
* 
*         NAME = 6/FABT,6/MESSAGE ORDINAL,6/ECODE.
* 
*         ECODE = ERROR CODE TO BE ASSIGNED (6 BITS). 
* 
*         MSG = ERROR MESSAGE (40 CHARACTERS).
* 
*         FABT = FORCE ABORT (UPPER 6 BITS OF NAME. 
* 
          PURGMAC MMSG
 MMSG     MACRO  NAME,ECODE,MSG,FABT
          IF     -DEF,MMSGORD,1 
 MMSGORD  SET    0                        INITIALIZE ORDINAL
          IFC    EQ,$FABT$$,2             TEST FOR NO FORCE ABORT 
 NAME     EQU    MMSGORD*100B+ECODE 
          ELSE   1
 NAME     EQU    FABT*10000B+MMSGORD*100B+ECODE 
 MMSGBGN  SET    *                        SAVE CURRENT ADDRESS
          IFC    EQ,$MSG$$,2              TEST NULL MESSAGE 
          DATA   1H                       INSURE DATA ITEM
          ELSE   1
          DATA   H$MSG$                   STORE MESSAGE 
          DATA   0                        SET END OF MESSAGE
          IFGT   *-MMSGBGN,BD.MSGML*5+1,1 TEST MESSAGE TOO LONG 
 P        ERR    MESSAGE TOO LONG 
 MMSGORD  SET    MMSGORD+1                BUMP ORDINAL
          IFGT   MMSGORD,BD.MSGMN,1       TEST TOO MANY MESSAGES
 P        ERR    TOO MANY MESSAGES
 MMSGL    SET    MMSGORD*BD.MSGML         SET CM WORD COUNT 
          ENDM
          EJECT 
 START    LJM    **          ENTRY POINT FOR OVERLAY INITIALIZATION 
          LJM    INIT 
  
          CON    IB          FWA OF INPUT BUFFER
          CON    OB          FWA OF OUTPUT BUFFER 
          CON    SB          FWA OF STATUS BUFFER 
          CON    LIB         LENGTH OF INPUT BUFFER 
          CON    LIB         LENGTH OF OUTPUT BUFFER
          CON    LSB         LENGTH OF STATUS BUFFER
  
          CON    BD.VERS     VERSION NUMBER OF THIS OVERLAY 
  
**        RFM    - RELEASE FROM MLD (FIXED LOCATION ENTRY POINT)
*                  RELEASE CALLED FROM MAINTENANCE LANGUAGE DRIVER
*                  RELEASE EQUIPMENT IF CONNECTED 
* 
*                  REL, ABT Z 
* 
*         ENTRY  - (A) = ABORT ADDRESS (777777B)
* 
*         EXIT   - RELEASE COMMAND HAS BEEN EXECUTED
* 
*         USES   - ERR3, ERR4 
* 
*         CALLS  - OPC, BD.DCH
* 
 XRFM     LJM    **          EXIT TO MLD
 RFM      EQU    *-1
          STM    ERR4        SAVE ABORT ADDRESS (777777B) 
          SHN    -12D 
          STM    ERR3 
          RJM    OPC         RELEASE THE EQUIPMENT IF CONNECTED 
          RJM    BD.DCH      DROP CHANNEL/TALK TO SYSTEM AND EXEC 
          UJN    XRFM        EXIT TO MLD
  
**        ENT    - DISTRIBUTE CONTROL TO REQUESTED COMMAND
* 
*         ENTRY  - ((ENT))    BITS 11 - 06 = INDEX TO TBLENT ENTRY
*                                            BIASED BY 20B
*                  ((ENT))    BITS 05 - 00 = LINE NO. UPPER 6 BITS
* 
*                  ((ENT)+1)  BIT  11      = LINE NO. LOWER BIT 
*                  ((ENT)+1)  BITS 10 - 00 = ABORT ADDRESS I
* 
*         EXIT   - COMMAND HAS BEEN EXECUTED
* 
*         USES   - D.Z1, D.Z2, D.Z3, ERR3, ERR4 
* 
*         CALLS  - NONE (LJM TO REQUESTED COMMAND)
* 
 XENT     LJM    **          EXIT TO CALLER OF COMMAND CODE (IN STACK)
 ENT      EQU    *-1
          LDM    ENT         ADDRESS OF COMMAND PARAMETERS IN STACK 
          STD    D.Z2        SAVE FOR INDIRECT LOAD OF PARAMETERS 
          LDI    D.Z2        LOAD COMMAND PARAMETER WORD 1 FROM STACK 
          SHN    12D         OBTAIN INDEX+20B TO CURRENT TBLENT ENTRY 
          STD    D.Z3        SAVE FOR LOAD OF ADDRESS OF COMMAND CODE 
          SHN    -12D        OBTAIN UPPER 6 BITS OF LINE NUMBER 
          STM    ERR3        SAVE IN ERROR PROCESSING AREA
          AOD    D.Z2        INCREMENT TO COMMAND STACK PARAMETER WORD 2
          LDI    D.Z2        LOAD COMMAND PARAMETER WORD 2 FROM STACK 
          STM    ERR4        RIGHT BIT OF LINE NO./ 11 BIT ABORT ADDRESS
          AOD    D.Z2        INCREMENT TO NEXT COMMAND IN STACK 
          STM    ENT         STORE ADDRESS IN EXIT TO STACK LONG JUMP 
          LDM    TBLENT-20B,D.Z3     LOAD FWA OF CODE TO EXECUTE COMMAND
          STD    D.Z1 
          LJM    0,D.Z1      GO EXECUTE COMMAND 
  
**        TABLE OF ENTRY POINTS FOR EXECUTING HIGH LEVEL COMMANDS 
* 
 TBLENT   CON    REL         RELEASE EQUIPMENT
          CON    RES         RESERVE CCC, SD AND DRIVE
          CON    EXECUTE     EXECUTE INLINE DIAGNOSTICS 
          CON    HLTMON      HALT OR MONITOR INLINE DIAG EXECUTION
          CON    SENSE       INPUT INLINE SENSE BUFFER
          CON    STATUS      GET GENERAL OR DETAIL STATUS 
          EJECT 
**        REL    - RELEASE EQUIPMENT IF CONNECTED.
* 
*                  REL, ABT Z 
* 
*         ENTRY  - NONE 
* 
*         EXIT   - DEVICE CONNECT HAS BEEN RELEASED IF ASSIGNED AND THE 
*                  CHANNEL IS RELEASED TO THE SYSTEM. 
* 
*         USES   - NONE.
* 
*         CALLS  - OPC- RELEASE EQUIPMENT IF CONNECTED. 
*                - BD.DCH- DROP CH/TALK TO SYSTEM AND EXEC. 
* 
  
**     1. DISCONNECT EQUIPMENT WITH AN OPERATION COMPLETE 
*         FUNCTION IF EITHER IS CONNECTED.
* 
*      2. DROP THE I/O CHANNEL TO THE OPERATING SYSTEM IF ASSIGNED. 
* 
 REL      RJM    OPC         RELEASE THE EQUIPMENT IF CONNECTED 
          RJM    BD.DCH      DROP CHANNEL/TALK TO SYSTEM AND EXEC 
          LJM    XENT        EXIT TO STACK
          EJECT 
**        RES    - RESERVE STORAGE DIRECTOR/DRIVE.
* 
*                  RES DRIVE, ABT Z 
*                  RES CCC, ABT Z 
* 
*         ENTRY  - (PA) = 0 IF RES CCC, 1 IF RES DRIVE
* 
*         EXIT   - I/O CHANNEL ASSIGNED AND CHANNEL ASSIGNED FLAGS
*                  SET IN ALL THE OTHER SUBROUTINES.
* 
*                  ERRCAS  - IF CHANNEL ACTIVE FROM SYSTEM
*                  ERRNRES - IF NOT RESERVED IN 5 MINUTES 
*                  ERDCSM  - IF DEVICE CODE DOES NOT MATCH STATUS 
* 
*         USES   - EC, EA, EM, D.T3, D.T4, RESA, DRCON
* 
*         CALLS  - RES1, OPC, STC, DST, FNA, BD.RCH 
  
**     1. DISCONNECT STORAGE DIRECTOR WITH AN OPERATION COMPLETE
*         FUNCTION IF CONNECTED.
* 
  
**     2. CLEAR ERROR EXIT REGISTERS. 
* 
 RESX     LJM    ** 
 RES      LDN    0
          STD    EC          CLEAR ERROR REGISTERS
          STD    EA 
          STD    EM 
          LDD    PA 
          STM    DROP1       STORE PA FOR DROP ROUTINE
          NJN    RES1        IF RES DRIVE 
          LJM    RES19       ELSE IF RES CCC
  
**     3. DROP/REQUEST I/O CHANNEL FROM THE SYSTEM. 
* 
 RES1     LDN    MAXITT      ITERATION COUNT FOR STATUS 
          STM    RESA        AND PAUSE LOOP 
 RES2     RJM    OPC         TO RELEASE THE SD IF SELECTED
          LDN    0
          STM    OPC1        SET SD NOT RESERVED
 RES3     SOM    RESA        DECREMENT THE ITERATION COUNT
          PJN    RES4        IF NOT TIMED OUT 
          LDC    ER.NRES     ELSE ERROR EXIT
          LJM    ERR
  
 RES4     RJM    BD.RCH      DROP/REQUEST CHANNEL AS REQUESTED
          RJM    IJM         WAIT CHANNEL ACTIVE
          AJM    RES20,CH    ERROR IF CHANNEL ACTIVE FROM SYSTEM
  
*      4. ISSUE CONNECT FUNCTION AND GET STATUS.
  
          RJM    CKCCC       CHECK CCC ID 
          LDC    TIMREL 
          STD    D.T3 
 RES5     LDC    **          UNIT NUMBER
 UN       EQU    *-1
          STD    D.T4        SAVE FOR FNO 
          STM    DROP2       SAVE UN FOR DROP ROUTINE 
          LDN    CONN        LOAD CONNECT FUNCTION
          RJM    FNO         PERFORM FUNCT AND OUTPUT CONTROL WORD
          RJM    STS
  
*       5. IF BIT 2**3 IS SET, REPEAT STEP 4 UNTIL 500 MSEC HAS 
*          ELAPSED.  IF A RESERVE IS NOT SUCCESSFUL WITHIN THIS 
*          TIME-FRAME, EXECUTE THE  *REL * SEQUENCE TO COMMUNICATE
*          WITH THE SYSTEM.  REPEAT THIS STEP UNTIL A RESERVE IS
*          SUCCESSFUL OR 5 MINUTES HAVE ELAPSED.  ABORT IF NO 
*          RESERVE IN 5 MINUTES.
  
          SHN    17D-3D 
          PJN    RES8        IF SD CONNECTED
 RES7     SOD    D.T3        DECREMENT LOOP COUNT 
          PJN    RES5        IF NOT TIMED OUT 
          LJM    RES2        ELSE START ANOTHER ITERATION 
  
*      6. VERIFY GEN STATUS IS 0000 OR 0002 AND THAT DETAIL 
*         STATUS INDICATES THAT THE UNIT ASSIGNED MATCHES THE 
*         DEVICE CODE ASSIGNED. 
  
 RES8     SHN    4
          ZJN    RES9        GENERAL STATUS EQUAL TO ZERO 
          SCN    2
          ZJN    RES7        IF NO ERROR STATUS 
          LJM    ERRAGS      GET DETAILED STATUS AND EXIT 
 RES9     RJM    DST         GET DETAILED STATUS
* 
*         SEE IF ASSIGNED DEVICE IS 895 
* 
          LDM    SB+20D      DS WORD WITH DEVICE CAPACITY 
          SHN    0-10D
          ZJN    RES15       IF 33800 DRIVE 
* 
 ERDCSM   LDC    ER.DCSM     ERROR DEVICE CODE/STATUS MISMATCH
 ERXIT    LJM    ERR
  
*       7. SET STORAGE DIR/DRIVE CONNECTED. 
  
 RES15    LDN    0
          STM    DRCON       SET DRIVE CONNECTED FLAG 
          LDN    2
          STM    OPC1 
          LDM    RESX+1 
          ZJN    RES18       EXIT NOT CALLED FROM SUBROUTINE
          LJM    RESX        RETURN TO SUBROUTINE 
  
 RES18    LJM    XENT        EXIT TO STACK
  
 RES19    RJM    BD.RCH      DROP/REQUEST CHANNEL AS REQUESTED
          RJM    IJM         WAIT CHANNEL INACTIVE
          NJN    RES21       IF CHANNEL INACTIVE
 RES20    LDC    ER.CAS      ERROR CHANNEL ACTIVE FROM SYSTEM 
          UJN    ERXIT       ERROR EXIT 
  
 RES21    RJM    CKCCC       CHECK CCC ID 
          UJN    RES18       RETURN TO STACK
* 
* 
*         CKCCC - ISSUE CCC ID REQUEST AND CHECK RESPONSE 
*                 CCC WILL RESPOND WITH CCC HEX (6314B) 
* 
 CKCCCX   LJM    **          ENTRY/EXIT 
 CKCCC    EQU    *-1
          LDC    CCCID       770B FUNCTION
          RJM    FNA         ISSUE CCC ID REQUEST 
          NJN    CKCC1       IF INACTIVE, CCC 
          DCN    CH          NOT CCC, DEACTIVATE CHANNEL
 CKERR    LJM    ERDCSM      ERROR EXIT 
 CKCC1    ACN    CH          ACTIVATE CHANNEL 
          IAN    CH          INPUT ONE WORD TO A
          LMC    6314B       CHECK CCC ID WORD (CCC(HEX)) 
          NJN    CKERR       IF NOT CCC, ERROR
          RJM    IJM         WAIT CHANNEL INACTIVE
          NJN    CKCC2       IF INACTIVE RECEIVED 
          LJM    ERRNIDT     ELSE ERROR EXIT
 CKCC2    SFM    ERCPE1,CH   CHECK FOR CH PARITY ERROR
          UJN    CKCCCX      RETURN TO CALLING ROUTINE
          EJECT 
 EXECUTE  TITLE  EXECUTE - INITIATE SUBSYSTEM DIAGNOSTICS 
**        EXECUTE - INITIATE SUBSYSTEM DIAGNOSTICS
* 
*                   EXECUTE PATH, ABT Z 
*                   EXECUTE DI, ABT Z 
*                   EXECUTE DIAG W, ABT Z 
*                   EXECUTE MAINT DIAG W, ABT Z 
* 
*         ENTRY   - (PA) = 0 IF EXECUTE PATH
*                          1 IF EXECUTE DI
*                          2 IF EXECUTE DIAG
*                          3 IF EXECUTE MAINT DIAG
* 
*                   (PA+1) = W
* 
*         EXIT    - REQUESTED DIAGNOSTIC EXECUTION STARTED
* 
*                   ERRCPE   - IF CHANNEL PARITY ERROR ON INPUT 
*                   ERRDLVE  - IF ERROR ON DIAGNOSTIC LOAD FUNCTION 
*                   ERRDPCE  - IF ERROR ON DIAG PARAMETER CHANGE FUNC.
*                   ERRDPNA  - IF CCC DETECTED ERROR IN NEW DIAG PARAMS 
*                   ERRDSTE  - IF ERROR ON DIAGNOSTIC START FUNCTION
*                   ERRFPNA  - IF FUNCTION PARAMETERS NOT ACCEPTED
*                   ERRISR   - IF INCOMPLETE STATUS RETURNED
*                   ERRITS   - IF ILLEGAL ROUTINE SELECTED
*                   ERRNIDT  - IF CHANNEL NOT INACTIVE AFTER DATA XFER
*                   ERRUHB   - IF UNIT HUNG BUSY ON DIAG SELECT 
* 
*         USES    - P1, PA, SB, OB, D.T2, D.T3, D.T5, D.T6, D.T7, 
*                   D.Z2, D.Z3, D.Z4
* 
*         CALLS   - ALCHK, DROP, EJM, FNC, IJM, SELECT, STS, TCA, TCC 
* 
**     1. IF KEYWORD PATH IS SPECIFIED, VERIFY SUBSYSTEM CONNECTED AND
*         GO TO STEP 5. 
* 
 EXECUTE  LDD    PA          LOAD CODE
          NJN    EXEC2       IF NOT EXEC PATH 
          RJM    TCC         TEST SUBSYSTEM CONNECTED 
          UJN    EXEC5
* 
*      2. VERIFY CHANNEL ASSIGNED 
* 
 EXEC2    RJM    TCA
* 
*      3. IF KEYWORDS DIAG OR MAINT DIAG, GO TO STEP 7. 
* 
          LDD    PA          GET CODE 
          SBN    2
          PJN    EXEC7
* 
*      4. ISSUE RUN DI DIAGNOSTICS FUNCTION.
* 
          LDN    RDI         RUN DI DIAG FUNCTION 
          UJN    EXEC6
* 
*      5. ISSUE PATH CONFIDENCE TEST FUNCTION, GO TO STEP 6.
* 
 EXEC5    LDN    RPC         RUN PATH CONFIDENCE TEST 
* 
*      6. EXIT ROUTINE. 
* 
 EXEC6    RJM    FNC         ISSUE FUNCTION AND WAIT INACTIVE 
          LJM    XENT        EXIT TO STACK
* 
*      7. VALIDATE TEST AND/OR ACCESS LEVEL FOR DIAG REQUEST
* 
 EXEC7    LDD    PA+1        GET DIAG NO. W 
          STD    D.Z2        STORE FOR OUTPUT 
          ADC    -6200B 
          MJN    ERRITS      IF LESS THAN C80 HEX, ILLEGAL
          SBN    9D 
          MJN    EXAL3       C80 - C88 NEEDS AL=3 
          SBN    7
 EXEC7A   MJN    ERRITS      C89 - C8F ILLEGAL
          ZJN    EXAL4       C90 NEEDS AL=4 
          SBN    1
 EXEC7B   ZJN    ERRITS      C91 ILLEGAL
          SBN    1
          NJN    EXEC7C      IF NOT C92 
* 
*         C92 - IF DEFAULT, NEEDS AL=3, ELSE NEEDS AL=4 
* 
          LDD    PA          GET PA CODE
          SBN    3
          NJN    EXAL3       IF NOT MAINT DIAG, AL=3
          LDM    P1          GET PARAMETER P1 
          SHN    17D-11D
          PJN    EXAL3       IF BIT 11, P1 NOT SET
          SHN    11D-17D
          LMN    4
          NJN    EXAL4       IF NOT DEFAULT PARAM, NEED AL=4
* 
* 
 EXAL3    LDN    3           LOAD ACCESS LEVEL REQUIRED 
          UJN    CKAL 
 EXAL4    LDN    4           LOAD ACCESS LEVEL REQUIRED 
 CKAL     STD    D.T3        STORE FOR ALCHK
          RJM    ALCHK       CHECK ACCESS LEVEL 
          UJN    EXEC8
* 
 ERRITS   LDC    ER.ITS      ILLEGAL ROUTINE SELECTED 
          LJM    ERR         ERROR EXIT 
* 
* 
 EXEC7C   SBN    1
          ZJN    EXAL4       IF C93, AL=4 
          SBN    13D
          MJN    ERRITS      IF C94 - C9F, ILLEGAL
          ZJN    EXAL3       IF CA0, AL=3 
          SBN    1
          ZJN    ERRITS      IF CA1, ILLEGAL
          SBN    1
          ZJN    EXAL3       IF CA2, AL=3 
          SBN    5
          MJN    ERRITS      IF CA3 - CA6, ILLEGAL
 EXEC7D   ZJN    EXAL3       IF CA7, AL=3 
          SBN    1
          ZJN    ERRITS      IF CA8, ILLEGAL
          SBN    3
          MJN    EXAL4       IF CA9 - CAA, AL=4 
          ZJN    ERRITS      IF CAB, ILLEGAL
          SBN    2
          MJN    EXAL4       IF CAC, AL=4 
          ZJN    EXEC7D      IF CAD, AL=3 
          UJN    ERRITS      IF GREATER THAN CAD, ILLEGAL 
* 
*      8. PREPARE OUTPUT WORDS FOR SELECT FUNCTION. 
* 
 EXEC8    LDM    P1          GET PARAMETER P1 
          SHN    17D-10D     CHECK FOR LOOPING REQUEST
          MJN    EXEC8A      IF LOOPING SELECTED
          LDC    444B        INHIBIT ROUTINE LINKING
          UJN    EXEC8B 
 EXEC8A   LDC    446B        LOOP ON ROUTINE
 EXEC8B   STD    D.Z3        STORE FOR OUTPUT 
          LDM    UN          GET UNIT NUMBER
          STD    D.Z4        STORE FOR OUTPUT 
* 
*      9. USE SELECT SUBROUTINE TO ISSUE SELECT FUNCTION
* 
          LDN    3           NO. OF TIMES TO TRY SELECT ROUTINE 
          STD    D.T2 
 EXEC9    RJM    SELECT      CALL SELECT ROUTINE
          ZJN    EXEC13      IF SELECT COMPLETED WITHOUT ERROR
          SOD    D.T2        IF SELECT NOT COMPLETE 
          ZJN    ERRUHB      IF SELECT TRIED THREE TIMES
          RJM    DROP        DROP PPU FOR 1 SEC 
          UJN    EXEC9       TRY AGAIN
 ERRUHB   LDC    ER.UHB      UNIT HUNG BUSY 
 EXEC9A   LJM    ERR         ERROR EXIT 
* 
*     10. IF SELECT COMPLETE, ISSUE VERIFY FUNCTION.
* 
 VCOUNT   DATA   0           RETRY COUNT FOR VERIFY/START 
* 
 EXEC13   LDN    20          RETRY COUNT FOR VERIFY 
          STM    VCOUNT      SET RETRY COUNT
 EXEC13A  LDN    VER         LOAD VERIFY FUNCTION (72B) 
          RJM    FNC         ISSUE FUNCTION AND WAIT INACTIVE 
* 
*     11. INPUT VERIFY STATUS, CHECK FOR ZERO.
* 
          ACN    CH+40B      ACTIVATE CHANNEL 
          LDN    1           NO. OF WORDS TO INPUT
          IAM    SB,CH       INPUT WORD TO SB 
          ZJN    EXEC15      IF ONE WORD RECEIVED 
          LJM    ERRISR      ERROR IF NO STATUS RECEIVED
 EXEC15   RJM    IJM         WAIT FOR CH INACTIVE 
          NJN    EXEC16      IF INACTIVE RECEIVED 
          LJM    ERRNIDT     IF NO INACTIVE RECEIVED
 EXEC16   SFM    ERCPE1,CH   CHECK FOR CH PARITY ERROR
          LDM    SB          GET STATUS WORD
          ZJN    EXEC17      IF LOAD COMPLETED OK 
          LPN    12B         CHECK BUSY BITS
          ZJN    ERDLVE      IF NOT BUSY, ERROR 
          SOM    VCOUNT      DECREMENT RETRY COUNTER
          ZJN    ERDLVE      IF COUNTED DOWN, ERROR 
          RJM    DLYSEC      DELAY ONE SECOND 
          UJN    EXEC13A     TRY AGAIN
 ERDLVE   LDC    ER.DLVE     LOAD VERIFY ERROR
          LJM    ERR         ERROR EXIT 
* 
*     12. IF KEYWORD DIAG SPECIFIED, GO TO STEP 17. 
* 
 EXEC17   LDD    PA          GET COMMAND CODE 
          LMN    3
          ZJN    EXEC18      IF KEYWORDS MAINT DIAG 
 EXEC17A  LJM    EXEC23      IF KEYWORD DIAG
 EXEC18   LDM    P1          LOAD PARAM P1
          SHN    17D-11D
          PJN    EXEC17A     IF BIT 11, P1 NOT SET
* 
*     13. LOAD DIAGNOSTIC PARAMETERS FOR CHANGE FUNCTION. 
* 
          LDC    P1          GET ADDRESS OF P1
          STD    D.T5 
          LDC    OB+400B     ADDRESS OF PARAM BUFFER
          STD    D.T6 
          LDN    9D          NO. OF PARAMETERS TO LOAD
          STD    D.T7 
* 
*         LOAD PARAMETERS 1H - 5H FROM P1 - P9
* 
 EXEC19   LDI    D.T5        GET MALET PARAMETER
          LPC    377B        MASK OFF LOWER 8 BITS
          STI    D.T6        STORE IN PARAM BUFFER
          AOD    D.T5        INCREMENT PARAM ADDRESS
          AOD    D.T6        INCREMENT BUFFER ADDRESS 
          SOD    D.T7        DECREMENT LOAD COUNTER 
          NJN    EXEC19      IF NOT ALL 9 PARAMS LOADED 
* 
*         ZERO PARAMETERS 5L - 8L 
* 
          LDN    7           NO. OF PARAMETERS TO ZERO
          STD    D.T7 
 EXEC19A  LDN    0
          STI    D.T6        ZERO BUFFER ENTRY
          AOD    D.T6        INCREMENT BUFFER ADDRESS 
          SOD    D.T7        DECREMENT COUNTER
          NJN    EXEC19A     IF NOT ALL LOCATIONS ZEROED
* 
*     14. ISSUE PARAM CHANGE FUNCTION 
* 
          LDN    CHNG        CHANGE INLINE PARAMETER FUNCTION 
          RJM    FNC         ISSUE FUNCTION AND WAIT INACTIVE 
* 
*     15. OUTPUT 16 WORDS - NEW PARAMETERS
* 
          ACN    CH+40B      ACTIVATE CHANNEL 
          LDN    16D         NO. OF WORDS TO OUTPUT 
          OAM    OB+400B,CH  OUTPUT 16D WORDS FROM OB(400)
          ZJN    EXEC19B     IF ALL WORDS OUTPUT
          LJM    ERRFPNA     IF PARAMETERS NOT ACCEPTED 
 EXEC19B  RJM    EJM         WAIT FOR CHANNEL EMPTY 
          DCN    CH+40B      DEACTIVATE CHANNEL 
* 
*     16. OBTAIN GENERAL STATUS AFTER CHANGE FUNCTION 
* 
          RJM    STS         GET GENERAL STATUS 
          ZJN    EXEC23      IF ZERO, CONTINUE
          LMC    5200B       CHECK IF CCC DETECTED PARAM ERROR
          ZJN    ERDPNA      IF CCC DETECTED ERROR
          LDC    ER.DPCE     IF OTHER ABNORMAL STATUS 
          UJN    EXEC20 
 ERDPNA   LDC    ER.DPNA     DIAG PARAMS NOT ACCEPTED 
 EXEC20   LJM    ERR         ERROR EXIT 
* 
*     17. ISSUE START INLINE ROUTINE FUNCTION 
* 
 EXEC23   LDN    10          RETRY COUNT FOR START
          STM    VCOUNT 
 EXEC23A  LDN    STRT        START ROUTINE FUNCTION 
          RJM    FNC         ISSUE FUNCTION AND WAIT INACTIVE 
* 
*     18. INPUT RESPONSE TO FUNCTION AND CHECK. 
* 
          ACN    CH+40B      ACTIVATE CHANNEL 
          LDN    1           NO. OF WORDS TO INPUT
          IAM    SB,CH       INPUT STATUS WORD
          ZJN    EXEC24      IF WORD RECEIVED 
          LJM    ERRISR      IF WORD NOT RECEIVED 
 EXEC24   RJM    IJM         WAIT FOR CHANNEL INACTIVE
          NJN    EXEC25      IF CH INACTIVE 
          LJM    ERRNIDT     IF NO INACTIVE RECEIVED
 EXEC25   SFM    ERCPE1,CH   CHECK FOR CH PARITY ERROR
          LDM    SB          GET STATUS WORD
          SBN    2           EXPECTED STATUS IS 2 
          NJN    EXEC26      IF STATUS WORD NOT 2 
          LJM    XENT        ELSE, EXIT TO STACK
 EXEC26   SOM    VCOUNT      DECREMENT RETRY COUNTER
          ZJN    ERDSTE      IF COUNTED DOWN, ERROR 
          RJM    DLYSEC      DELAY ONE SECOND 
          UJN    EXEC23A     TRY AGAIN
 ERDSTE   LDC    ER.DSTE     DIAGNOSTIC START ERROR 
          LJM    ERR         ERROR EXIT 
          EJECT 
 HLTMON   TITLE  HLTMON - HALT OR MONITOR DIAGNOSTIC EXECUTION
**        HLTMON - HALT OR MONITOR DIAGNOSTIC EXECUTION 
* 
*                  HALT DIAG, ABT Z 
*                  MONITOR DIAG, ABT Z
* 
*         ENTRY  - (PA) = 0 IF HALT DIAG
*                         1 IF MONITOR DIAG 
* 
*         EXIT   - FUNCTION HAS BEEN ISSUED 
*                  (SB) = STATUS WORD INPUT AFTER FUNCTION
* 
*                  ERRAGS    - IF ABNORMAL STATUS AFTER FUNCTION ISSUE
*                  ERRCPE    - IF CHANNEL PARITY ERROR ON INPUT 
*                  ERRISR    - IF INCOMPLETE STATUS RETURNED
*                  ERRNIDT   - IF CHANNEL NOT INACTIVE AFTER DATA XFER
* 
*         USES   - SB, PA 
* 
*         CALLS  - FNC, IJM, TCC
* 
  
**     1. VERIFY THAT CHANNEL IS ASSIGNED 
* 
 HLTMON   RJM    TCA         CALLER ENTRY POINT 
  
**     2. STORE 7777B IN SB AND ISSUE FUNCTION
* 
          LCN    0
          STM    SB          NEGATIVE ZERO TO SB
          LDD    PA          LOAD CODE
          NJN    HLTM1       IF MONITOR DIAG
          LDN    HLT         LOAD HALT FUNCTION 
          UJN    HLTM2
 HLTM1    LDN    MONTR       LOAD MONITOR FUNCTION
 HLTM2    RJM    FNC         ISSUE FUNCTION AND WAIT INACTIVE 
* 
*      3. INPUT ONE WORD TO SB. 
* 
          ACN    CH+40B      ACTIVATE CHANNEL 
          LDN    1
          IAM    SB,CH       INPUT ONE WORD TO SB 
          ZJN    HLTM3       IF STATUS RECEIVED 
          LJM    ERRISR      ERROR IF NO STATUS RECEIVED
 HLTM3    RJM    IJM         WAIT FOR INACTIVE
          NJN    HLTM4       IF INACTIVE RECEIVED 
          LJM    ERRNIDT     ERROR IF NO INACTIVE 
 HLTM4    SFM    ERCPE1,CH   CHECK FOR CH PARITY ERROR
* 
*      4. CHECK STATUS WORD FOR ABNORMAL TERMINATION
* 
          LDM    SB          GET STATUS WORD
          SHN    17D-ABN
          PJN    HLTM5       IF NOT ABNORMAL STATUS 
 ERRAGS   LDC    ER.AGS 
          UJN    SENS1A      ERROR EXIT 
 HLTM5    LJM    XENT        EXIT TO STACK
          EJECT 
 SENSE    TITLE  SENSE - INPUT DIAGNOSTIC SENSE BYTES 
**        SENSE - INPUT DIAGNOSTIC SENSE BYTES
* 
*                 SENSE INLINE, ABT Z 
* 
*         ENTRY  - NONE 
* 
*         EXIT   - INLINE SENSE BYTES TO IB(0) - IB(65B)
* 
*                  ERRAGS    - IF ABNORMAL STATUS AFTER FUNCTION ISSUE
*                  ERRCPE    - IF CHANNEL PARITY ERROR ON INPUT 
*                  ERRISN    - IF INCOMPLETE SENSE RETURNED TO PP 
*                  ERRNIDT   - IF CHANNEL NOT INACTIVE AFTER DATA XFER
* 
*         USES   - D.T1, IB 
* 
*         CALLS  - FNC, IJM, STS
* 
  
**     1. VERIFY THAT CHANNEL IS ASSIGNED 
* 
 SENSE    RJM    TCA         CALLER ENTRY POINT 
* 
*      2. STORE 7777B INTO ALL WORDS TO BE READ 
* 
          LDN    66B         NUMBER OF WORDS TO BE READ 
          STD    D.T1 
 SENS1    LCN    0
          STM    IB,D.T1     STORE 7777B IN IB
          SOD    D.T1        DECREMENT COUNT
          NJN    SENS1       DO ALL 66B WORDS 
* 
*      3. ISSUE INPUT INLINE SENSE FUNCTION 
* 
          LDN    SENS        LOAD INPUT SENSE FUNCTION
          RJM    FNC         ISSUE FUNCTION AND WAIT INACTIVE 
* 
*      4. INPUT 66B WORDS TO IB(0) - IB(65B)
* 
          ACN    CH+40B      ACTIVATE CHANNEL 
          LDN    66B         NUMBER OF WORDS
          IAM    IB,CH       INPUT SENSE WORDS TO IB
          ZJN    SENS2       IF ALL WORDS RECEIVED
 ERRISN   LDC    ER.ISN      INCOMPLETE SENSE RETURNED
 SENS1A   LJM    ERR         ERROR EXIT 
 SENS2    RJM    IJM         WAIT INACTIVE
          NJN    SENS3       IF INACTIVE RECEIVED 
          LJM    ERRNIDT     IF NO INACTIVE 
 SENS3    SFM    ERCPE1,CH   CHECK FOR CH PARITY ERROR
* 
*      5. TAKE GENERAL STATUS 
* 
          RJM    STS         GET GENERAL STATUS 
          ZJN    SENS4       IF STATUS OK 
          LJM    ERRAGS      IF ABNORMAL STATUS 
 SENS4    LJM    XENT        EXIT TO STACK
          EJECT 
 STATUS   TITLE  STATUS - GET GENERAL OR DETAIL STATUS. 
**        STATUS - GET GENERAL OR DETAIL STATUS.
* 
*                  STATUS GENERAL, ABT Z
*                  STATUS DETAIL, ABT Z 
* 
*          GENERAL - INPUT 1 WORD OF GENERAL STATUS TO  SB(0).
*          DETAIL  - INPUT 20D WORDS OF DETAIL STATUS TO SB(1)-SB(20D)
* 
*         ENTRY  - (PA) = CODE          0 = GENERAL 
*                                       1 = DETAIL
* 
*         EXIT   - (A)  = STATUS (IF GENERAL STATUS IS SELECTED)
*                  (SB), OR (SB 0-24) = STATUS OR DETAIL. 
* 
*                  ERRISR - ERROR EXIT IF INCOMPLETE STATUS RETURNED
* 
*         USES   - LF, P, D.T1, SB, WT
* 
*         CALLS  - ERA, TCA, STS, DST, FNC, FJM, IJM
* 
  
**     1. STORE 7777B INTO THE STATUS BUFFER FOR WORDS ABOUT TO BE RE 
* 
**     2. VERIFY THAT THE CHANNEL IS ASSIGNED.
* 
 STATUS   RJM    TCA         TEST CH ASSIGNED 
          STD    WT          CLEAR WT REGISTER
  
**     3. ISSUE THE SELECTED STATUS FUNCTION SPECIFIED BY THE KEYWORD 
*         GENERAL (0012), DETAIL (0023).
* 
*      4. INPUT THE REQUIRED NUMBER OF WORDS TO THE STATUS BUFFER 
*         (1, OR 24B).
* 
          LDD    PA          LOAD CODE
          NJN    STATUS3     IF DETAIL STATUS REQUEST 
          LDN    GS 
          STD    LF          SAVE LAST PRIMARY FUNCTION 
          RJM    STS         GET GENERAL STATUS 
          UJN    STATUS4
  
 STATUS3  LDN    EDS         SAVE LAST FUNCTION 
          STD    LF          SAVE LAST PRIMARY FUNCTION 
          RJM    DST         GET DETAIL STATUS
 STATUS4  LJM    XENT        EXIT TO STACK
  
          EJECT 
 ALCHK    TITLE  UTILITIES USED BY D895 PRODUCT OVERLAY.
**        ALCHK - CHECKS ACCESS LEVEL 
* 
*         ENTRY - (D.T3) = ACCESS LEVEL NEEDED
* 
*         EXIT - ER.IAL - IF ACCESS LEVEL NOT VALID 
*                CALLING ROUTINE IF NO ERROR
* 
 ALCHKX   LJM    ** 
 ALCHK    EQU    *-1
          LDD    AL          GET ACCESS LEVEL FROM ASSIGN 
          SBD    D.T3 
          PJN    ALCHKX      ACCESS LEVEL HIGH ENOUGH EXIT
 ERRIAL   LDC    ER.IAL      ERROR AL NOT VALID 
 ALCHK1   LJM    ERR         ERROR EXIT 
          SPACE  4,23 
**        DLYSEC - DELAYS ONE SECOND
* 
*         ENTRY  - NONE 
* 
*         EXIT   - RETURNS TO CALLING ROUTINE AFTER ONE SECOND
* 
*         USES   - D.Z0 
* 
*         CALLS  - NONE 
* 
 DLYX     LJM    **          ENTRY/EXIT 
 DLYSEC   EQU    *-1
* 
          LDN    8           REPS OF DELAY LOOP FOR 1 SEC.
          STD    D.Z0 
 DLY1     LCN    3           STARTING VALUE FOR DELAY LOOP
 DLY2     SBN    4           *** SBN 4 IF 1X SPEED PPU ***
*         SBN    2           *** SBN 2 IF 2X SPEED PPU ***
*         SBN    1           *** SBN 1 IF 4X SPEED PPU ***
          NJN    DLY2        IF NOT COUNTED DOWN
          SOD    D.Z0        DECREMENT LOOP COUNTER 
          NJN    DLY1        IF NOT 1 SEC.
          UJN    DLYX        EXIT WHEN FINISHED 
          EJECT 
**        DROP   - DROP PPU FOR ONE SECOND
* 
*         ENTRY  - NONE 
* 
*         EXIT   - RETURN TO CALLING ROUTINE AFTER 1 SEC DROP OF PPU
* 
*         USES   - PA 
* 
*         CALLS  - BD.REQ, RES
* 
 DROPX    LJM    **          ENTRY/EXIT 
 DROP     EQU    *-1
          LDM    ERR3        GET ABORT ADDRESS
          ADC    2000B       ADD LDC INSTRUCTION
          STM    DROP3       SAVE FOR RESERVE 
          LDM    ERR4 
          STM    DROP3+1     SAVE THE REST FOR RESERVE
* 
          LDN    1
          STM    BD.REQP+4   SET DROP TIME
          LDN    BD.DREQ
          RJM    BD.REQ      REQUEST A DROP FOR 1 SEC 
* 
*         CONTROL RETURNS AFTER 1 SECOND DROP OF THE PPU
* 
          LDC    ** 
 DROP1    EQU    *-1         LAST SELECTED RES SUBFUNCTION STORED HERE
          STD    PA          INDICATE RES OPTION TO USE 
          LDC    ** 
 DROP2    EQU    *-1         UNIT NUMBER STORED HERE
          STM    UN          SAVE UNIT NO. FOR CONNECT
 DROP3    LDC    **          LDC INSTRUCTION AND ABORT ADDRESS
          STM    ERR4        REPLACE ABORT ADDRESS
          SHN    -12
          STM    ERR3        STORE OTHER HALF 
          RJM    RESX+1      RESERVE CHANNEL AND UNIT 
          LDN    0
          STM    RESX+1      CLEAR RETURN ADDRESS 
          LJM    DROPX       RETURN TO CALLING ROUTINE
          EJECT 
**        DST    - OBTAIN DETAIL STATUS.
* 
*         ENTRY  - NONE 
* 
*         EXIT   - STATUS BUFFER CONTAINS THE CURRENT DETAIL STATUS.
*                  TO BE USED FOR ERROR CHECKING. 
* 
*                - (A) = (SB+13D) 
* 
*                  ERRCPE  - IF CHANNEL PARITY ERROR ON INPUT 
*                  ERRISR  - IF INCOMPLETE STATUS RETURNED
*                  ERRNIDS - IF NO INACTIVE TO DETAIL STATUS
* 
*         USES   - D.T1, SB(1-24) 
* 
*         CALLS  - FNA, FJM, IJM
* 
*         TIME   - MINIMUM 1X SPEED EXECUTION TIME IS 247+ MICROSEC.
* 
 DST0     LJM    **          ENTRY/EXIT 
 DST      EQU    *-1
  
**        1.  STORE 7777B INTO ALL WORDS
* 
          LDN    24B
          STD    D.T1 
 DST1     LCN    0
          STM    SB,D.T1
          SOD    D.T1 
          NJN    DST1        DO ALL WORDS 
  
**        2. ISSUE DETAIL EXTENDED STATUS FUNCTION. 
* 
          LDN    EDS
          RJM    FNA         ISSUE STATUS FUNCTION
          NJN    DST5        IF FUNCTION ACCEPTED 
          LDC    ER.NIDS     ERROR IF NO INACTIVE TO DETAIL STATUS
 DST3     UJN    DST7 
  
**        3. INPUT STATUS AND RETURN. 
* 
 DST5     ACN    CH+40B 
          LDN    24B
          IAM    SB+1,CH
          NJN    ERRISR      IF ALL WORDS NOT INPUT 
          RJM    IJM         VERIFY INACTIVE IS RECEIVED
          ZJN    ERRNIDT     IF NO INACTIVE RECEIVED
          SFM    ERCPE3,CH   CHECK FOR CH PARITY ERROR
          UJN    DST0        IF OK EXIT 
  
 ERRNIDT  LDC    ER.NIDT     ERROR NO INACTIVE AFTER DATA XFER
          UJN    EJM2 
  
 ERRISR   LDC    ER.ISR      ERROR INCOMPLETE STATUS RETURNED 
 DST7     UJN    EJM2 
          SPACE  4,22 
**        EJM     - WAIT FOR CHANNEL TO GO EMPTY
* 
*          ENTRY   - NONE.
* 
* 
*          EXIT    - ER.CFE - IF CHANNEL FAILED TO GO EMPTY.
* 
*          USES    - NONE.
* 
*          CALLS   - NONE.
  
  
 EJMX     LJM    **          SUBROUTINE ENTRY/EXIT
 EJM      EQU    *-1
 EJM1     EJM    EJMX,CH     JUMP IF CHANNEL EMPTY
          ADN    1           UPDATE LOOP COUNT
          PJN    EJM1        LOOP ON CHANNEL EMPTY TEST 
 ERRCFE   LDC    ER.CFE      ERROR CHANNEL FAILED TO GO EMPTY 
 EJM2     UJN    FNC1        ERROR EXIT 
          SPACE  4,21 
**        FJM    - WAIT FOR CHANNEL TO GO FULL. 
* 
*         ENTRY  - NONE 
* 
*         EXIT   - (A) NONZERO IF NOT TIMED OUT WAITING FULL
*                  (A) ZERO IF TIMED OUT
* 
*         USES   - D.T1 
* 
*         CALLS  - NONE 
* 
*         TIME   - MINIMUM 1X SPEED EXECUTION TIME IS 6 MICROSEC. 
* 
 FJMX     LJM    **          ENTRY/EXIT 
 FJM      EQU    *-1
          LDC    TIMFJM*2    ITERATION TIME 
 FJM1     FJM    FJMX,CH     IF FULL EXIT 
 FJM2     SBN    4           *** SBN 4 IF 1X SPEED PPU ***
*         SBN    2           *** SBN 2 IF 2X SPEED PPU ***
*         SBN    1           *** SBN 1 IF 4X SPEED PPU ***
          NJN    FJM1        IF TIME NOT COUNTED DOWN 
          UJN    FJMX        ELSE EXIT WITH A EQ. ZERO
          SPACE  4,21 
**        FNC    - ISSUE A FUNCTION ON A CHANNEL AND WAIT INACTIVE. 
* 
*         ENTRY  - (A) = FUNCTION TO ISSUE
* 
*         EXIT   - (A) = NONZERO IF FUNCTION ACCEPTED.
* 
*                  ERRNIF  - IF NO INACTIVE TO FUNCTION 
* 
*         USES   - LF 
* 
*         CALLS  - FNA
* 
*         TIME   - MINIMUM 1X SPEED EXECUTION TIME IS 22 MICROSEC.
* 
 FNCX     LJM    **          ENTRY/EXIT 
 FNC      EQU    *-1
          STD    LF          TO SAVE LAST MAJOR FUNCTION
          RJM    FNA         TO FUNCTION AND WAIT INACTIVE
          NJN    FNCX        IF INACTIVE EXIT 
 ERRNIF   LDC    ER.NIF      ERROR NO INACTIVE TO FUNCTION
 FNC1     LJM    ERR         ERROR EXIT 
          SPACE  4,17 
**        FNA    - ISSUE A FUNCTION AND WAIT INACTIVE.
* 
*         ENTRY  - (A) = FUNCTION TO ISSUE
* 
*         EXIT   - (A) = NONZERO IF FUNCTION ACCEPTED 
* 
*         USES   - NONE 
* 
*         CALLS  - IJM
* 
*         TIME   - MINIMUM 1X SPEED EXECUTION TIME IS 14 MICROSEC.
* 
 FNAX     LJM    **          ENTRY/EXIT 
 FNA      EQU    *-1
          FAN    CH+40B      FUNCTION FROM A
          RJM    IJM         WAIT FOR INACTIVE
          UJN    FNAX        EXIT 
          SPACE  4,29 
**        FNO    - ISSUE FUNCTION AND OUTPUT ONE WORD OF DATA.
* 
*         ENTRY  - (A)  = FUNCTION DESIRED
*                  D.T4 = DATA WORD TO OUTPUT 
* 
*         EXIT   - ERRFPNA - IF FUNCTION PARAMETER NOT ACCEPTED 
* 
*         USES   - NONE 
* 
*         CALLS  - FNC
* 
*         TIME   - MINIMUM 1X SPEED EXECUTION TIME IS 40 MICROSEC.
* 
 FNOX     LJM    **          ENTRY/EXIT 
 FNO      EQU    *-1
          RJM    FNC         TO SEND FUNCTION 
          ACN    CH+40B      ACTIVATE THE CHANNEL 
          LDN    1
          OAM    D.T4,CH
          ZJN    FNO2        IF PARAMETER WAS ACCEPTED
 ERRFPNA  LDC    ER.FPNA     ELSE ERROR EXIT
          LJM    ERR
  
 FNO2     EJM    FNO3,CH
          ADN    1
          PJN    FNO2        LOOP ON CHANNEL EMPTY TEST 
          LJM    ERRCFE      ERROR  EXIT IT CH DIDNT GO EMPTY 
  
 FNO3     DCN    CH+40B 
          UJN    FNOX        EXIT 
          SPACE  4,22 
**        IJM    - WAIT INACTIVE AND TIME OUT.
* 
*         ENTRY  - NONE 
* 
*         EXIT   - (A) = NONZERO IF FUNCTION ACCEPTED 
*                        ZERO IF FUNCTION NOT ACCEPTED
* 
*         USES   - NONE 
* 
*         CALLS  - NONE 
* 
*         TIME   - MINIMUM 1X SPEED EXECUTION TIME IS 6 MICROSEC. 
* 
 IJMX     LJM    **          ENTRY/EXIT 
 IJM      EQU    *-1
          LDN    12          RETRY COUNT FOR IJM 3 SECONDS
          STM    ICOUNT 
 IJM1A    LCN    3
 IJM1     IJM    IJMX,CH     IF INACTIVE EXIT 
 IJM2     SBN    4           *** SBN 4 IF 1X SPEED PPU ***
*         SBN    2           *** SBN 2 IF 2X SPEED PPU ***
*         SBN    1           *** SBN 1 IF 4X SPEED PPU ***
          NJN    IJM1        IF NOT COUNTED DOWN
          SOM    ICOUNT      DECREMENT RETRY COUNT
          ZJN    IJMX        IF COUNTED DOWN, EXIT W/(A) = ZERO 
          UJN    IJM1A       IF NOT, TRY AGAIN
* 
 ICOUNT   DATA   0           RETRY COUNT FOR IJM STORED HERE
          SPACE  4,49 
**        OPC    - RELEASE THE EQUIPMENT WITH AN OPERATION COMPLETE.
* 
*         ENTRY  - NONE 
* 
*         EXIT   - (A) = ZERO IF CCC NOT CONNECTED
*                      = NONZERO IF OPERATION COMPLETE ACCEPTED 
* 
*         USES   - NONE 
* 
*         CALLS  - FNC
* 
*         TIME   - MINIMUM 1X SPEED EXECUTION TIME IS 44 MICROSEC.
* 
 OPCX     LJM    **          ENTRY/EXIT 
 OPC      EQU    *-1
          LDM    BD.CHFG
          ZJN    OPCX        EXIT IF CHANNEL NOT RESERVED 
          LDM    SDCON
          NJN    OPCX        EXIT IF CCC NOT RESERVED 
          AOM    SDCON       CLEAR SD CONNECTED FLAG
          AOM    DRCON       CLEAR DRIVE CONNECT FLAG 
          LDC    ** 
 OPC1     EQU    *-1         SD/DRIVE RES BITS STORED 
          SBN    2
          NJN    OPCX        IF SD/DRIVE NOT RESERVED 
  
*         THE RELEASE REQUEST CAME FROM THE BASIC DRIVER, SO PROCESS
*         IT WITHOUT CHANGING ANY DATA OR CREATING AN ERROR EXIT. 
  
 OPC3     LDN    OC 
 OPC4     STD    D.T5 
          LDM    ERR3        UPPER BITS OF ABT ADDRESS
          SBN    77B
          NJN    OPC5        IF REQUEST IS FROM THE USER
          LDD    D.T5 
          RJM    FNA         EXECUTE OPERATION COMPLETE FUNCTION
          NJN    OPCX        EXIT IF NOT FUNCTION TIMEOUT 
          DCN    CH+40B      ELSE DO A DISCONNECT 
          UJN    OPCX        AND EXIT 
  
 OPC5     LDD    D.T5 
          RJM    FNC         TO FUNCTION OPERATION COMPLETE 
          UJN    OPCX        EXIT 
          SPACE  4,42 
**        SELECT - ISSUE SELECT FUNCTION AND WAIT FOR ZERO STATUS 
* 
*         ENTRY  - D.Z2, D.Z3, D.Z4 CONTAIN FUNCTION PARAMETERS 
* 
*         EXIT   - (A) = ZERO IF SELECT COMPLETED WITHOUT ERROR 
*                      = NON-ZERO IF SELECT NOT COMPLETE AFTER
*                        FOUR ISSUES OF FUNCTION
* 
*                   ERRDSLE - IF 5XXX STATUS RETURNED AFTER SELECT
*                             FUNCTION
* 
*         USES   - D.T3 
* 
*         CALLS  - DLYSEC, EJM, FNC, STS
* 
 SELX     LJM    **          ENTRY/EXIT 
 SELECT   EQU    *-1
          LDN    3           COUNTER FOR FUNCTION TRIES 
          STD    D.T3 
 SELA     LDN    SEL         GET SELECT FUNCTION (71B)
          RJM    FNC         ISSUE FUNCTION AND WAIT INACTIVE 
          ACN    CH+40B      ACTIVATE CHANNEL 
          LDN    3           NO. OF WORDS TO OUTPUT 
          OAM    D.Z2,CH     OUTPUT FUNCTION PARAMETERS 
          ZJN    SELB        IF FUNCTION PARAMETERS ACCEPTED
          LJM    ERRFPNA     IF PARAMS NOT ACCEPTED 
 SELB     RJM    EJM         WAIT FOR CHANNEL EMPTY 
          DCN    CH+40B      DEACTIVATE CHANNEL 
* 
          RJM    STS         GET GENERAL STATUS 
          ZJN    SELX        IF ZERO, EXIT
          LPN    12B         CHECK BUSY BITS
          NJN    SELC        IF SD/DP BUSY
 ERDSLE   LDC    ER.DSLE     ELSE ABNORMAL STATUS 
          UJN    STS0        ERROR EXIT 
* 
 SELC     SOD    D.T3        DECREMENT TRY COUNT
          MJN    SELX        IF TRIED FOUR TIMES
          RJM    DLYSEC      ELSE DELAY ONE SECOND
          UJN    SELA        TRY AGAIN
          EJECT 
**        STS    - REQUEST AND INPUT GENERAL STATUS.
* 
*         ENTRY  - NONE 
* 
*         EXIT   - (A) = STATUS 
* 
*                  ERRCPE  - IF CHANNEL PARITY ERROR ON INPUT 
*                  ERRGSNR - IF GENERAL STATUS NOT RETURNED 
*                  ERRNIGS - IF NO INACTIVE TO GENERAL STATUS 
* 
*         USES   - SB 
* 
*         CALLS  - FNA, FJM, IJM
* 
*         TIME   - MINIMUM 1X SPEED EXECUTION TIME IS 60 MICROSEC.
* 
 STSXX    LDM    SB          LOAD STATUS AND EXIT 
          LJM    **          ENTRY/EXIT 
 STS      EQU    *-1
          LCN    0
          STM    SB          NEGATIVE ZERO TO SB
          LDN    GS 
          RJM    FNA         ISSUE GENERAL STATUS FUNCTION
          NJN    STS1        IF FUNCTION ACCEPTED 
 ERRNIGS  LDC    ER.NIGS     ERROR IF NO INACTIVE TO GS FUNCTION
 STS0     UJN    STS3        ERROR EXIT 
  
 STS1     LDN    0
          STM    SDCON       SET STORAGE DIRECTOR CONNECTED 
          ACN    CH+40B 
          LDN    1
          IAM    SB,CH       INPUT GENERAL STATUS 
          NJN    STS2        IF NO STATUS PROVIDED
          RJM    IJM         WAIT FOR INACTIVE
          ZJN    STS1A       IF INACTIVE NOT RECEIVED 
          SFM    ERCPE2,CH   CHECK FOR CH PARITY ERROR
          UJN    STSXX       IF OK EXIT 
 STS1A    LJM    ERRNIDT     ERROR NO INACTIVE AFTER DATA XFER
 ERRGSNR  EQU    *
 STS2     LDC    ER.GSNR     ERROR IF NO FULL OR NO INACTIVE
  
 STS3     UJN    TCA1        JUMP TO ERR
  
          SPACE  4,18 
**        TCA    - TEST CHANNEL ASSIGNMENT. 
* 
*         ENTRY  - BD.CHFG =  1 IF CH NOT ASSIGNED
*                             0 IF CH ASSIGNED
* 
*         EXIT   - ABT ADDRESS STORED IN ERR3 AND ERR4
* 
*                  ERRCNA  - IF CHANNEL NOT ASSIGNED
* 
*         CALLS  - NONE.
* 
*         USES   - NONE 
* 
 TCAX     LJM    **          ENTRY/EXIT 
 TCA      EQU    *-1
          LDM    BD.CHFG
          NJN    TCAX        EXIT IF CHANNEL ASSIGNED 
          LDC    ER.CNA      ERROR IF CHANNEL NOT RESERVED
 TCA1     UJN    ERR
          SPACE  4,18 
**        TCC    - TEST STORAGE DIRECTOR CONNECTED. 
* 
*         ENTRY  - NONE 
* 
*         EXIT   - ABT ADDRESS STORED IN ERR3 AND ERR4
*                  WC SET TO WRRD 
* 
*         USES   - NONE.
* 
*         CALLS  - TCA
* 
 TCCX     LJM    **          ENTRY/EXIT 
 TCC      EQU    *-1
          RJM    TCA         TEST CCC CONNECTED 
          LDC    ** 
 SDCON    EQU    *-1         *** STORAGE DIRECTOR CONN FLAG STORED HERE 
          ZJN    TCCX        IF CONNECTED 
          UJN    ERRSDNC     ELSE ERROR EXIT
          SPACE  4,17 
**        TDR    - TEST DRIVE RESERVED. 
* 
*         ENTRY  - NONE 
* 
*         EXIT   - NONE 
* 
*         USES   - NONE 
* 
*         CALLS  - TCC
* 
 TDRX     LJM    **          ENTRY/EXIT 
 TDR      EQU    *-1
          RJM    TCC         CHECK SD CONNECTED 
          LDC    ** 
 DRCON    EQU    *-1         *** DRIVE CONNECTED FLAG STORED HERE.
          ZJN    TDRX        IF CONNECTED EXIT
 ERRSDNC  LDC    ER.SDNC     ELSE ERROR EXIT
          UJN    ERR         ERROR EXIT 
* 
* 
 ERCPE1   RJM    STS         TAKE GENERAL STATUS
 ERCPE2   RJM    DST         TAKE DETAILED STATUS 
 ERCPE3   LDC    ER.CPE      CHANNEL PARITY ERROR 
          EJECT 
**        ERR    - ERROR EXIT SUBROUTINE
* 
*         ENTRY  - (A) = MESSAGE ADDRESS INDEX
* 
*         EXIT   - (A) = ABORT ADDRESS FOR AN ABORT 
*                  (A) = LINE NUMBER FOR MODULE TERMINATE 
* 
*         USES   - D.Z1, D.Z2, EC, EM, EA 
* 
*         CALLS  - NONE 
* 
 ERR      STD    D.Z1        SAVE MESSAGE INDEX AND ERROR NUMBER
          SHN    -12
          STD    D.Z2        SAVE ABORT FLAG
          LDM    BD.CHFG
          ZJN    ERR2        IF CHANNEL IS NOT ASSIGNED 
          LDD    BD.AL
          SBN    AL21 
          ZJN    ERR2        IF ACCESS LEVEL INDICATES NO CHAN CLEANUP
          IJM    ERR2,0      CLEAN UP CHANNEL 
          DCN    40B
 ERR2     LDD    D.Z1 
          LPN    77B         MASK ERROR CODE
          ADC    7100B       ADD IN BIAS FOR D895 PRODUCT OVERLAY 
          STD    EC          STORE ERROR CODE 
          LDD    D.Z1 
          SHN    -6 
          ADC    100B        FLAG MESSAGE INDEX AS OVERLAY MESSAGE
          STD    EM          STORE MESSAGE INDEX
          LDD    P
          STD    EA          STORE LINE NUMBER WHERE ERROR OCCURRED 
          LDD    D.Z2 
          NJN    ERR5        IF ABORT FLAG SET
          LDC    ** 
 ERR3     EQU    *-1         FOR ABORT ADDRESS
          SHN    12 
          LMC    ** 
 ERR4     EQU    *-1         FOR ABORT ADDRESS
          LJM    BD.RNI      RNI AT THE REJECT ADDRESS
  
 ERR5     LJM    BD.ABT      TERMINATE MODULE 
  
 IB       EQU    6500B       INPUT BUFFER 
 LIB      EQU    505B        LENGTH OF INPUT AND OUTPUT BUFFERS 
 OB       EQU    IB+LIB      OUTPUT BUFFER
 SB       EQU    OB+LIB      STATUS BUFFER
 SBIE     EQU    SB+25B      STATUS THAT DETECTED THE ERROR 
 RETRY    EQU    SB+52B      RETRY COUNT
 SERNUM1  EQU    SB+56B      FIRST HALF OF PACK SERIAL NUMBER 
 SERNUM2  EQU    SB+57B      SECND HALF OF PACK SERIAL NUMBER 
 SEEKTIM  EQU    SB+60B      LAST SEEK TIME 
 RESA     EQU    SB+64B      ITERATION COUNT FOR RES COMMAND
 LSB      EQU    64B         LENGTH OF STATUS BUFFER
  
          ERRPL  *-IB-1      ERROR IF D895 PRODUCT OVERLAY OVERFLOW 
          EJECT 
 INIT     TITLE  INIT - INITIALIZATION. 
**        THE INITIALIZATION CODE THAT FOLLOWS IS OVERLAYED BY THE
*         PRODUCT OVERLAY BUFFERS ABOVE.
* 
*         TEST EQUIPMENT AND UNIT NUMBER
* 
 INIT     LDN    0
          STD    D.Z1        CLEAR COUNTER
*IF DEF,MVE 
          LDM    BD.IOU 
          NJN    INIT0       IF NOT I0
          LDC    INITB       (A)=ERROR ADDRESS FOR INVALID IOU
          STM    INIT6.1
          STM    INIT9.1
          LJM    INIT5.3     PROCESS ERROR MESSAGE
*ENDIF
 INIT0    LDN    0
          STM    SB,D.Z1     CLEAR STATUS BUFFER
          AOD    D.Z1 
          SBN    LSB
          NJN    INIT0       IF STATUS BUFFER NOT CLEARED 
          LDM    BD.SN
          STM    SERNUM1     SAVE USER SUPPLIED SERIAL NUMBER IN SB 
          LDM    BD.SN+1
          STM    SERNUM2
*IF DEF,MVE 
          LDM    BD.EQ
          LPN    40B
          ZJN    INIT0.1     IF UN IS LESS THAN 40B 
          LDC    INITC
          UJN    INIT0.2
 INIT0.1  LDM    BD.EQ
          SHN    -9 
          SBN    2
          MJN    INIT0.3     IF EQ IS LESS THAN 2 
          LDC    INITD
 INIT0.2  LJM    INIT11.1    EQ OR UN RANGE ERROR 
 INIT0.3  LDM    BD.EQ
          LPN    77B
          STM    SB+63B      UNIT TO STATUS BUFFER
          LDM    BD.EQ
          SHN    -4 
          LPN    40B         MASK FOR STORAGE DIRECTOR BIT
          RAM    SB+63B      ADD STORAGE DIRECTOR BIT TO ADDRESS
          STM    UN 
*ENDIF
*IF -DEF,MVE
          LDM    BD.EQ
          LPC    377B        8 BIT UNIT NUMBER
          STM    SB+63B      UNIT TO STATUS BUFFER
          STM    UN          SET UNIT NUMBER
*ENDIF
          LDN    0
          STM    SB+62B      EQUIPMENT NUMBER TO STATUS BUFFER
  
*         SET DELAY TIME BASED ON SPEED OF PPU
  
          LDC    TSPEED 
          STD    D.T0 
 INIT2    LDI    D.T0 
          ZJN    INIT3       IF END OF TABLE
          STD    D.T1 
          LDI    D.T1 
          SCN    77B
          ADM    BD.SPEED 
          STI    D.T1        SET ADN/SBN/VALUE
          AOD    D.T0 
          UJN    INIT2       COMPLETE ALL WORDS 
  
*         STORE I/O CHANNEL INTO COMMANDS 
  
 INIT3    LDM    BD.CHAN
          LPN    77B         REMOVE CHANNEL BIAS
          STM    SB+61B      I/O CHANNEL TO STATUS BUFFER 
*IF DEF,MVE 
          LDM    BD.IOU 
          LPN    40B         MASK CIO FLAG * A=40B IF CIO * 
          RAM    SB+61B      ADD CIO/NIO FLAG 
*ENDIF
          LPN    37B         MASK FOR CIO CHANNEL 
          STD    D.T2 
          LDC    TCHAN
          STD    D.T0        SET FWA OF TABLE CONTAINING ADDRESSES
 INIT4    LDI    D.T0 
          ZJN    INIT5       IF END OF TABLE
          STD    D.T1 
          LDI    D.T1 
          LPC    7740B
          ADD    D.T2 
          STI    D.T1 
          AOD    D.T0 
          UJN    INIT4       COMPLETE ALL WORDS 
  
*IF DEF,MVE 
 INIT5    STD    D.T1        CLEAR CELL 
          LDC    MMSGL. 
          STD    D.T0        LENGTH OF PO MSG AREA IN 60 BIT WORDS
 INIT5.1  SBN    3           NUMBER OF 60 BIT WORDS/MESSAGE 
          MJN    INIT5.2     IF NO MESSAGES 
          STD    D.T0        UPDATED LENGTH 
          AOD    D.T1        INCREMENT MESSAGE COUNT
          LDD    D.T0 
          NJN    INIT5.1     IF MORE MESSAGES 
 INIT5.2  LDD    D.T1 
          STM    BD.MSGS     MESSAGE COUNT
**
*         WRITE PP MESSAGES TO CM 
* 
 INIT5.3  LDN    0
          STD    D.Z1 
          STD    D.Z2 
          STD    D.Z3 
          STD    D.Z4 
 INIT6    LDM    PPMSGS,D.Z1 GET PP MESSAGE WORD
 INIT6.1  EQU    *-1         MODIFIED TO FWA OF INITIALIZATION ERROR
          ZJN    INIT8       IF END OF MESSAGE
 INIT7    STM    D.T4,D.Z2   STORE IN D.T4+ 
          AOD    D.Z1        BUMP PP MESSAGE POINTER
          UJN    INIT9
 INIT8    LDC    2R          MESSAGE END, STORE BLANKS
          STM    D.T4,D.Z2
 INIT9    AOD    D.Z2        BUMP D.T4+ POINTER 
          SBN    4
          NJN    INIT6       IF NOT 4 PP WORDS
          STD    D.Z2        CLEAR POINTER
          LDC    BD.MSGA     INDEX INTO CM COMM BUFFER TO PO MSG AREA 
          ADD    D.Z4        BIAS TO WORD WITHIN PO MSG AREA
          STM    BD.IDEX
          LDN    BD.CMB      POINTER TO FWA OF CM COMM BUFFER 
          RJM    BD.SETR
          CWDL   D.T4        WRITE MSG WORD TO CM 
          AOD    D.Z4        INCREMENT BIAS INTO PO MSG AREA
          AOD    D.Z3        BUMP CM WORD COUNTER 
          SBN    BD.MSGML+1  EACH MESSAGE OCCUPIES A 4 WORD CM BLOCK
          NJN    INIT6       IF NOT BD.MSGML CM WORDS 
          STD    D.Z3        CLEAR CM WORD COUNTER
          LDC    0
 INIT9.1  EQU    *-1         MODIFIED TO FWA OF INITIALIZATION ERROR
          ZJN    INIT9.2     IF NOT PO INITIALIZATION ERROR 
          LCN    0
          LJM    INIT12      PO INITIALIZATION ERROR (A) = NEG ZERO 
 INIT9.2  LDM    PPMSGS,D.Z1
          ZJN    INIT10      IF MESSAGE ENDED IN ZERO BYTE
          AOD    D.Z1        SKIP ZERO BYTE TERMINATOR
 INIT10   AOD    D.Z1        BUMP PP MESSAGE ADDRESS TO NEXT MESSAGE
          LDM    PPMSGS,D.Z1
          ZJN    INIT10.1    IF LAST MESSAGE
          LJM    INIT7       GET NEXT MESSAGE 
 INIT10.1 EQU    *
  
*ENDIF
  
*IF -DEF,MVE
*         WRITE PP MESSAGES TO CM 
  
 INIT5    LDM    BD.MSGA     GET PP MESSAGE AREA ADDRESS
          STD    D.T6        SAVE IT
          ADC    MMSGL.      ADD LENGTH 
          RJM    BD.TFL      SEE IF IN FL 
          LDN    P.ZERO      CLEAR CELLS, D.Z1=PP MESSAGE ADDRESS 
          CRD    D.Z1        D.Z2=D.T0-D.T4 POINTER, D.Z3=CM WD COUNTER 
 INIT6    LDM    PPMSGS,D.Z1 GET PP MESSAGE WORD
          ZJN    INIT8       IF END OF MESSAGE
 INIT7    STM    D.T0,D.Z2   STORE IN D.T0+ 
          AOD    D.Z1        BUMP PP MESSAGE POINTER
          UJN    INIT9
  
 INIT8    LDC    2R          MESSAGE END, STORE BLANKS
          STM    D.T0,D.Z2
 INIT9    AOD    D.Z2        BUMP D.T0+ POINTER 
          SBN    5
          NJN    INIT6       IF NOT 5 PP WORDS
          STD    D.Z2        CLEAR POINTER
          LDD    D.RA        PUT RA IN A REG
          SHN    6
          ADD    D.T6        ADD MESSAGE ADDRESS
          CWD    D.T0        WRITE ONE WORD FROM D.T0 
          AOD    D.T6        UPDATED ADDRESS
          AOD    D.Z3        BUMP CM WORD COUNTER 
          SBN    BD.MSGML 
          NJN    INIT6       IF NOT BD.MSGML CM WORDS 
          STD    D.Z3        CLEAR CM WORD COUNTER
          LDM    PPMSGS,D.Z1
          ZJN    INIT10      IF MESSAGE ENDED IN ZERO BYTE
          AOD    D.Z1        SKIP ZERO BYTE TERMINATOR
 INIT10   AOD    D.Z1        BUMP PP MESSAGE ADDRESS TO NEXT MESSAGE
          LDM    PPMSGS,D.Z1
          NJN    INIT7       IF NOT LAST MESSAGE
*ENDIF
*         *ENDIF
**
  
*         SET DIRECT CELLS
  
          STD    WT          CLEAR WORDS TRANSMITTED REGISTER 
          STD    BA          CLEAR BEGINNING ADDRESS REGISTER 
*IF -DEF,MVE
          LDC    100D        100 MSEC DELAY IN BD.RCH 
          STM    DLYDCH      MODIFY DELAY USED ON REL AND RES CHANNEL 
*ENDIF
  
*         VERIFY THAT THE ASSIGNED DEVICE CODE IS SUPPORTED 
  
          LDD    DC          DEVICE CODE CURRENTLY ASSIGNED 
          ADC    -DC895      TEST IF DEVICE CODE FOR 895 (115B) 
          ZJN    INIT12 
          LDC    INITA       (A) = POINTER TO ERROR MSG IF NO SUPPORT 
*IF DEF,MVE 
 INIT11.1 STM    INIT6.1
          STM    INIT9.1
          LJM    INIT5.3     PROCESS ERROR MESSAGE
*ENDIF
 INIT12   LJM    START       EXIT WITH (A) = ERROR/NO ERROR FLAG
  
 INITA    DIS    ,*DEVICE CODE NOT SUPPORTED* 
*IF DEF,MVE 
 INITB    DIS    ,*INVALID IOU TYPE*
 INITC    DIS    ,*UNIT NUMBER INVALID* 
 INITD    DIS    ,*EQUIPMENT NUMBER INVALID*
*ENDIF
  
*         TABLE OF PPU SPEED SWITCHES 
  
 TSPEED   CON    DLY2 
          CON    FJM2 
          CON    IJM2 
          DATA   0           END OF SPEED SWITCHES TABLE
  
          EJECT 
          TITLE  ERROR MESSAGES 
 PPMSGS   EQU    *           START OF PP MESSAGES 
****
          MMSG   ER.FLE,EC.FLE,(ADDR OUT OF FL),1 
          MMSG   ER.TL,EC.TL,(I/O TIME OUT ON CH RESERVE),1 
          MMSG   ER.SEE,EC.SEE,(SUBR ENTRY/EXIT ERR),1
          MMSG   ER.WC,EC.WC,(BUFFER INDEX OR WC ERR),1 
          MMSG   ER.RES,EC.RES,(R)
          MMSG   ER.RES1,EC.RES1,(R)
          MMSG   ER.RES2,EC.RES2,(R)
          MMSG   ER.CNA,EC.CNA,(CH NOT ASSIGNED)
          MMSG   ER.CAS,EC.CAS,(CH ACTIVE ON ENTRY) 
          MMSG   ER.NIF,EC.NIF,(NO INACTIVE TO LAST FUNC) 
          MMSG   ER.NIGS,EC.NIGS,(NO INACTIVE TO GENERAL STATUS)
          MMSG   ER.NIDS,EC.NIDS,(NO INACTIVE TO DETAIL STATUS) 
          MMSG   ER.GSNR,EC.GSNR,(GENERAL STATUS NOT RETURNED)
          MMSG   ER.ISR,EC.ISR,(INCOMPLETE STATUS RETURNED) 
          MMSG   ER.FPNA,EC.FPNA,(FUNC PARAMETERS NOT ACCEPTED) 
          MMSG   ER.ISN,EC.ISN,(INCOMPLETE SENSE RETURNED)
          MMSG   ER.SDNC,EC.SDNC,(SD/DRIVE NOT CONNECTED) 
          MMSG   ER.IAL,EC.IAL,(ACCESS LEVEL TOO LOW FOR REQ) 
          MMSG   ER.NRES,EC.NRES,(RESERVE TIMEOUT)
          MMSG   ER.AGS,EC.AGS,(ABNORMAL GENERAL STATUS)
          MMSG   ER.CFE,EC.CFE,(CH FAILED TO GO EMPTY)
          MMSG   ER.DCSM,EC.DCSM,(DEVICE CODE/STATUS MISMATCH)
          MMSG   ER.NIDT,EC.NIDT,(NO INACTIVE AFTER DATA XFER)
          MMSG   ER.CPE,EC.CPE,(CHANNEL PARITY ERROR ON INPUT)
          MMSG   ER.ITS,EC.ITS,(ILLEGAL ROUTINE SELECTION)
          MMSG   ER.UHB,EC.UHB,(UNIT HUNG BUSY) 
          MMSG   ER.DSLE,EC.DSLE,(DIAG SELECT ERROR)
          MMSG   ER.DLVE,EC.DLVE,(DIAG LOAD VERIFY ERROR) 
          MMSG   ER.DSTE,EC.DSTE,(DIAG START ERROR) 
          MMSG   ER.DPCE,EC.DPCE,(DIAG PARAMETER CHANGE ERROR)
          MMSG   ER.DPNA,EC.DPNA,(DIAG PARAMETERS NOT ACCEPTED) 
 MMSGL.   EQU    MMSGL
          DATA   0
****
 TCHAN    EQU    *           CREATE CHANNEL TABLE 
          LIST   D
          HERE
          LIST   *
          DATA   0           END OF CHANNEL TABLE 
*IF -DEF,MVE
          IFEQ   NOS,1
 .1       SET    POVLA
 .2       SET    10000B 
 .3       SET    *-.1+5+4+500B
 .4       SET    .2-.1+5-1
          ERRNG  .2-.1+5-.3/500B*500B-1  BYTES LEFT AFTER LAST SECTOR 
          ERRNG  .3/500B*500B-5-*+.1-5   BYTES LEFT IN LAST SECTOR
          ERRNG  .4/500B*500B-5-*+.1-5   BYTES CAN BE ADDED TO OVERLAY
          ENDIF 
*ENDIF
  
*IF DEF,MVE 
          ERRPL  *-7773B     ERROR IF P895D VERLAY OVERFLOW 
*ENDIF
*IF -DEF,MVE
          IFEQ   NOSBE,1,1
          ERRPL  *-7773B     ERROR IF D895 OVERLAY OVERFLOW 
*ENDIF
          QUAL   *
