Retro1.org codex

1SS

[00002] 1SS - M860 SECONDARY STORAGE DRIVER.
[00009] M860 SECONDARY STORAGE DRIVER.
[00115] ASSEMBLY CONSTANTS.
[00191] LOCAL MACROS.
[00196] ERROR - PROCESS ERROR.
[00211] FETA - LOAD ABSOLUTE FET ADDRESS.
[00230] LDCA - LOAD CENTRAL ADDRESS.
[00247] MAIN ROUTINE.
[00248] SSD - MAIN ROUTINE.
[00318] ERR - PROCESS ERROR.
[00355] FUNCTION PROCESSORS.
[00357] PDF - PROCESS DATA FET.
[00404] TFCN - TABLE OF LEGAL FUNCTIONS AND PROCESSORS.
[00415] RDA - READ DATA IN STRIPE FORMAT.
[00595] RMS - READ MESSAGE AND ASSOCIATED DATA.
[00810] RUM - REWIND UNLOAD MESSAGES
[00847] CHN - CONVERT HEX NUMBER
[00878] RUN - REWIND UNLOAD UNIT.
[00935] WDA - WRITE DATA IN STRIPE FORMAT.
[01127] WMS - WRITE MESSAGE AND ASSOCIATED DATA.
[01286] SUBROUTINES.
[01287] I/O SUBROUTINES.
[01289] CKM - CHECK FOR MESSAGE.
[01315] CMD - CONNECT TO MESSAGE DEVICE.
[01355] CMG - CHECK FOR MESSAGES.
[01394] CON - CONNECT UNIT.
[01433] CSM - CHECK SPECIAL MESSAGE.
[01482] DST - DIAGNOSTIC STATUS.
[01532] FCN - FUNCTION M860 MSS INTERFACE.
[01599] FIN - FLUSH INPUT.
[01622] MCL - MASTER CLEAR FSC.
[01650] MDF - MESSAGE TYPE TO DAYFILE.
[01740] CTH - CONVERT TO HEX DISPLAY CODE.
[01760] RCL - RECALL CPU.
[01811] REL - RELEASE CHANNEL.
[01841] RES - RESERVE CHANNEL.
[01867] STS - RETURN INTERFACE STATUS.
[01936] WUM - WAIT UNIT MOUNTED
[01973] BDL - BUSY DELAY.
[01992] CBS - CHECK BUSY STATUS.
[02023] GENERAL SUBROUTINES.
[02025] CFL - CHECK FIELD LENGTH.
[02068] CFS - CHECK FULL STRIPE.
[02142] CIB - CHECK INPUT BUFFER.
[02184] COB - CHECK OUTPUT BUFFER.
[02224] DV3 - DIVIDE BY 3.
[02255] GMT - GET MESSAGE TYPE.
[02275] IBP - INITIALIZE AND CHECK BUFFER PARAMETERS.
[02339] RMB - READ MESSAGE BUFFER.
[02394] SCB - SET COMPLETE BIT.
[02432] UCO - UPDATE CENTRAL OUT.
[02455] WBB - WRITE BINARY BUFFER.
[02519] WMB - WRITE MESSAGE BUFFER.
[02579] PRESET.
[02711] TCHS - CHANNEL TABLE.
[02730] 2SS - ERROR MESSAGE OVERLAY.
[02780] EMS - ERROR MESSAGE PROCESSOR
[02926] ERRT - TABLE OF ERROR RETURN CODES.
Source Code

          IDENT  1SS,SSD 
          TITLE  1SS - M860 SECONDARY STORAGE DRIVER.
          PERIPH
          BASE   M
          SST
*COMMENT M860 SECONDARY STORAGE DRIVER.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4
***       1SS - M860 SECONDARY STORAGE DRIVER.
*         W. J. STURGIS      82/02/18.
          SPACE  4,10
***       1SS PROCESSES REQUESTS FROM SSEXEC TO READ AND WRITE
*         DATA AND MESSAGES.  MULTIPLE FUNCTIONS CAN BE PROCESSED
*         BY 1SS.
          SPACE  4,10
***       CALL
*
*T IR     18/ *1SS* ,6/ ,12/ CHB CHA ,6/ FC ,18/ ADDR
*
*T ADDR   18/ MSG. OUT FET ,18/ RECALL ADDR. ,12/ EQ ,11/ CN ,1/S
*T,ADDR+1 42/ ,18/DATA FET ADDR
*
*         WHERE
*         ADDR = PARAMETER ADDRESS.
*         FC = FUNCTION CODE.
*                1 = ENABLE TDAM BUFFER.
*                2 = MESSAGE BUFFER(S) TO PROCESS.
*                3 = MESSAGE AND DATA BUFFERS TO PROCESS.
*                4 = SET CHANNELS IN EST ENTRY.
*         EQ = EST ORDINAL.
*         CHB CHA = NEW CHANNELS TO BE SET IN EST FOR EQ.
*         MSG. OUT FET = FET USED TO SEND MESSAGES TO THE M860.
*         (MSG. OUT FET - 1) POINTER TO MESSAGE INPUT FET.
*         RECALL = CPU DRIVER RECALL WORD
*         DATA FET = FET FOR DATA I/O.
*         CN = CONTROLLER ORDINAL IN UDT.
*         S = 1, PPU ACTIVE (SET BY SSEXEC), CLEARED BY 1SS WHEN
*         DROPPING OUT.
          SPACE  4,10
***       MESSAGE FET
*
*T MFET   42/   ,8/ ERRC ,9/ ,1/C
*T,       42/ ,18/ FIRST
*T,       42/ ,18/ IN
*T,       42/ ,18/ OUT
*T,       12/ CH ,6/ ,18/ ABUF ,6/ ,18/ LIMIT
*T,       60/ EBUF
*
*         WHERE.
*         ERRC = ERROR RETURN CODE.
*         C = COMPLETE FLAG.
*         FIRST = FIRST POINTER.
*         IN = IN POINTER.
*         OUT = OUT POINTER.
*         CH = CHANNEL TO USE.
*         LIMIT = LIMIT POINTER.
*         ABUF = AUX BUFFER FOR LONG ASSOCIATED DATA BLOCKS.
*         EBUF = HARDWARE ERROR STATUS BUFFER.(5 WORDS)
          SPACE  4,10
***       DATA FET.
*
*T DFET   42/ ,8/ ERRC ,1/E,8/ FUNC ,1/C
*T,       42/ ,18/ FIRST
*T,       42/ ,18/ IN
*T,       42/ ,18/ OUT
*T,       12/ UNIT,29/ ,1/T ,18/ LIMIT
*T,       60/ EBUF
*T,       60/ HBUF
*
*         WHERE.
*         ERRC = ERROR RETURN CODE.
*         E = EOI STATUS(READ).
*         FUNC = FUNCTION CODE.
*                READ, WRITE, REWIND/UNLOAD.
*         C = COMPLETE STATUS.
*         FIRST = FIRST POINTER.
*         IN = IN POINTER.
*         OUT = OUT POINTER.
*         UNIT = UNIT NUMBER.
*         T = TERMINATE STREAMING FLAG.
*         LIMIT = LIMIT POINTER.
*         EBUF = HARDWARE ERROR STATUS BUFFER(5 WORDS).
*         HBUF = STRIPE HEADER BUFFER(20 WORDS).
          SPACE  4,10
***       STRIPE FORMAT.
*
*         EACH M860 STRIPE IS CAPABLE OF HOLDING
*         6530 8 BIT BYTES OF DATA.
*         1SS WRITES A 150 BYTE HEADER, 483 - 6279 BYTES OF DATA
*         AND EITHER A TAPEMARK (EOI) OR A 90 BYTE TRAILER.
*         DATA CONSISTS OF FROM 1 TO 13 DISK SECTORS WITH PARTIAL
*         NOS CONTROL WORDS.  THE FIRST CONTROL WORD HAS ONLY
*         THE PP WORD COUNT OF ACTUAL DATA AND THE SECOND CONTROL
*         WORD ONLY HAS THE LEVEL NUMBER.  THE REST OF THE CONTROL
*         WORDS ARE RECONSTRUCTED BY 1SS BEFORE WRITING THE
*         DATA TO THE CM BUFFER.
          SPACE  4,10
***       JOB DAYFILE MESSAGES.
*
*         *1SS ABT.*    FIELD LENGTH ERROR.
*         *1SS INVALID FUNCTION.*  INPUT REG. FUNCTION INVALID.
*
*
*         IF SENSE SWITCH 1 IS ON, TRACE AND TIMING MESSAGES
*         ARE ISSUED TO THE CONTROL POINT DAYFILE.
          SPACE  4,10
*         COMMON DECKS.
 
 
          LIST   X
*CALL     COMBCDD
          LIST   -X
*CALL     COMPMAC
*CALL     COMPCHI
          TITLE  ASSEMBLY CONSTANTS.
*         DIRECT CELLS.
 
 
          LOC    16
 CL       BSS    1           FUNCTION TIMEOUT CLOCK
 EO       BSS    1           END OF OPERATION TIMEOUT CLOCK
 CN       BSS    5           CM WORD BUFFER
 BC       BSS    1           BYTE COUNT
 EC       BSS    1           ERROR CODE
 FE       BSS    2           FET ADDRESS
 IC       BSS    1           IDLE COUNTER
 MW       BSS    1           MESSAGE WAITING FLAG
 RC       BSS    1           RECALL COUNT
 ST       BSS    1           GENERAL STATUS
 WC       BSS    1           WORD COUNT
 ES       BSS    1           EST ORDINAL OF CONTROL UNIT
 EQ       BSS    1           EQUIPMENT NUMBER OF CONTROL UNIT
 PC       BSS    1           PRU COUNT WITHIN A DATA STRIPE
 UN       BSS    1           UNIT NUMBER FOR DATA I/O
 SC       BSS    1           STRIPE COUNTER
 DR       BSS    2           CPU DRIVER RECALL ADDRESS
          LOC    *O
          LOC    60
 FT       BSS    2           FIRST POINTER
 IN       BSS    2           IN POINTER
 OT       BSS    2           OUT POINTER
 LM       BSS    2           LIMIT POINTER
          LOC    *O
          SPACE  4,10
*         EQUATES.
 
 
 CH       EQU    0           DEFAULT CHANNEL NUMBER
 DSTL     EQU    24          DETAIL (FSC) STATUS LENGTH
 BRTL     EQU    77          BUSY RETRY LIMIT
 EOPL     EQU    480D        END OF OP. TIME LIMIT
 FTOL     EQU    360D        FUNCTION TIMEOUT LIMIT
 GSTL     EQU    3           GENERAL STATUS LENGTH
 IPLM     EQU    400D        IDLE PASS LIMIT BEFORE DROP PP
 MSBC     EQU    43D         LENGTH OF MESSAGE IN PP BYTES
 MSWC     EQU    9D          LENGTH OF MESSAGE IN CM WORDS
 MXAD     EQU    3601        MAX ASSOCIATED DATA BYTE COUNT + 1
 MXWC     EQU    256D        CM WORD COUNT OF MAX ASSOC DATA
 PRUL     EQU    66D         LENGTH OF PRU WITH CONTROL WORDS
          SPACE  4,20
*         HARDWARE FUNCTION CODES.
 
 
 RELF     EQU    1           RELEASE UNIT
 CMRF     EQU    2           CONNECT FOR MESSAGE READ
 CMWF     EQU    3           CONNECT FOR MESSAGE WRITE
 REWF     EQU    10          REWIND
 STPF     EQU    11          STOP TAPE MOTION
 GSTF     EQU    12          GENERAL STATUS
 RISF     EQU    14          INTERRUPT STATUS
 CONF     EQU    20          CONNECT TO VIRTUAL TAPE UNIT
 REDF     EQU    40          READ DATA
 MRDF     EQU    43          MESSAGE READ
 WRTF     EQU    50          WRITE DATA
 WTMF     EQU    51          WRITE TAPE MARK
 MWRF     EQU    53          MESSAGE WRITE
 RUNF     EQU    110         REWIND/UNLOAD
 CDEF     EQU    120         CHECK FOR DEVICE END
 WUMF     EQU    140         WAIT UNIT MOUNTED
 SWRF     EQU    250         SHORT WRITE
 FSTF     EQU    312         FSC STATUS
 MCLF     EQU    414         MASTER CLEAR
 DSTF     EQU    704         DIAGNOSTIC STATUS
          SPACE  4,10
*         NOS 2 COMPATIBILITY.
 
 
          IF     -DEF,HNGM,1
 HNGM     EQU    MXFM        HANG PPU MONITOR FUNCTION
          SPACE  4,10
          TITLE  LOCAL MACROS.
          SPACE  4,10
**        LOCAL MACROS.
 
          SPACE  4,10
**        ERROR - PROCESS ERROR.
*
*         ERROR  EC
*
*         EC     ERROR CODE.
 
 
          PURGMAC ERROR
 
 ERROR    MACRO  E
          MACREF ERROR
          LDN    E
          RJM    ERR
          ENDM
 FETA     SPACE  4,10
**        FETA - LOAD ABSOLUTE FET ADDRESS.
*
*         FETA   A
*
*         A = OFFSET INTO FET.
 
 
          PURGMAC FETA
 
 FETA     MACRO  A
          MACREF FETA
          LDD    FE
          SHN    14
          ADD    FE+1
          IFC    NE,$A$$,1
          ADN    A
          RJM    CFL
          ENDM
 LDCA     SPACE  4,10
**        LDCA - LOAD CENTRAL ADDRESS.
*
*         LDCA   A
*
*         (A, A+1) = RELATIVE ADDRESS.
 
 
          PURGMAC LDCA
 
 LDCA     MACRO  A
          MACREF LDCA
          LDD    A
          LPN    77
          SHN    14
          ADD    A+1
          RJM    CFL         CHECK ADDRESS
          ENDM
          TITLE  MAIN ROUTINE.
**        SSD - MAIN ROUTINE.
 
 
          ORG    PPFW
 SSD      RJM    PRS         PRESET
 
*         PROCESS CYBER MESSAGES.
 
 SSD1     LDC    0           MESSAGE OUTPUT FET ADDRESS
 SSDA     EQU    *-1
          STD    FE+1
          SHN    -14
          STD    FE
          RJM    WMS         WRITE ANY MESSAGES TO M862
 
*         PROCESS M860 MESSAGES.
 
 SSD2     LDC    0           MESSAGE INPUT FET ADDRESS
 SSDB     EQU    *-1
          STD    FE+1
          SHN    -14
          STD    FE
          RJM    CKM         CHECK FOR MESSAGE
 
*         PROCESS DATA I/O.
 
          LDCA   IR+3
          ADN    1
          CRD    CM          READ DATA FET ADDRESS
          LDD    CM+3
          STD    FE
          SHN    14
          ADD    CM+4
          ZJN    SSD4        IF NO DATA FET
          STD    FE+1
          RJM    CFL         CHECK FIELD LENGTH
          RJM    PDF         PROCESS DATA FET
 
*         CHECK FOR ACTIVITY.
 
 SSD4     LDD    MW
          ZJN    SSD6        IF NO ACTIVITY
          LDC    IPLM
          STD    IC          INITIALIZE IDLE PASS LIMIT
 SSD5     LJM    SSD1        LOOK FOR WORK TO DO
 
 SSD6     SOD    IC
          ZJN    SSD7        IF IDLE PASS LIMIT
          PAUSE
          LDD    CM+1
          NJN    DPP         IF ERROR FLAG
          DELAY
          UJN    SSD5        LOOK FOR WORK
 
 SSD7     LDN    ZERL
          CRD    CM
          AOD    CM+4
          LDCA   DR
          CWD    CM          ACTIVATE CPU DRIVER
 
 DPP      LDCA   IR+3
          CRD    CM          READ AVTIVITY WORD
          LDD    CM+4
          SCN    1           CLEAR PPU ACTIVE
          STD    CM+4
          LDCA   IR+3
          CWD    CM
 DPP1     MONITOR DPPM
          LJM    PPR         EXIT TO PPR
 ERR      SPACE  4,10
**        ERR - PROCESS ERROR.
*
*         ENTRY  (A) = ERROR CODE.
*
*         EXIT   TO *DPP*.
*
*         CALLS  MCL, SCB.
*
*         USES   EC.
 
 
 ERR      CON    0           CALLERS ADDRESS FOR DEBUG
          STD    EC
          SBN    RCHWET
          MJN    ERR4        IF NOT HARDWARE ERROR TYPE
          SBN    RCMCLR-RCHWET
          MJN    ERR3        IF NO MASTERCLEAR REQUIRED
          RJM    MCL         MASTER CLEAR FSC
 ERR3     LDN    ERRL
          STD    CM
          FETA   ERRW
          CWM    GSTS,CM     WRITE STATUS TO FET
 ERR4     RJM    REL         RELEASE CHANNEL
 TRCA     LDN    0
          NJN    ERR5        IF TRACE MODE
          LDD    EC
          SBN    RCHWET
          MJN    ERR6        IF NOT HARDWARE ERROR
 ERR5     EXECUTE  2SS       LOG ERROR
 ERR6     LDN    0           ERROR STATUS ONLY
          RJM    SCB         SET FET COMPLETE
          LDN    ZERL
          CRD    CM
          AOD    CM+4
          LDCA   DR
          CWD    CM          RECALL CPU DRIVER
          LJM    DPP         DROP PP
          TITLE  FUNCTION PROCESSORS.
 PDF      SPACE  4,10
**        PDF - PROCESS DATA FET.
*
*         ENTRY  (FE - FE+1) = FET ADDRESS.
*
*         EXIT   DATA FET REQUEST PROCESSED.
*
*         CALLS  IBP, RDA, RUL, WDA.
*
*         USES   T1, CM - CM+4, CN - CN+4, ES, EQ, CH, PC, UN.
 
 
 PDF      SUBR               ENTRY     EXIT
          FETA
          CRD    CM          READ REQUEST WORD
          ADN    4
          CRD    CN          READ LIMIT WORD
          LDD    CM+4
          SHN    21-0
          MJN    PDFX        IF NO FUNCTION
          SHN    22-21
          LPC    777
          STD    CM+4
          LDC    TFCN        TABLE OF LEGAL FUNCTIONS
          STD    T1
 PDF1     LDI    T1
          NJN    PDF2        IF NOT END OF TABLE
          ERROR  RCILLF      ILLEGAL FUNCTION
 
 PDF2     LMD    CM+4
          ZJN    PDF3        IF FUNCTION FOUND
          LDN    2
          RAD    T1          ADVANCE TABLE ENTRY
          UJN    PDF1        CHECK NEXT ENTRY
 
 PDF3     LDM    1,T1        PROCESSOR ADDRESS
          STM    PDFA
          LDD    CN
          STD    UN          SET UNIT NUMBER
          SBN    17+1
          MJN    PDF4        IF LEGAL UNIT NUMBER
          ERROR  RCILLU      ILLEGAL UNIT NUMBER
 
 PDF4     RJM    IBP         INITIALIZE BUFFER POINTERS
          RJM    **          PROCESS FUNCTION
 PDFA     EQU    *-1
          LJM    PDFX        RETURN
 TFCN     SPACE  4,10
**        TFCN - TABLE OF LEGAL FUNCTIONS AND PROCESSORS.
*
*T,TFCN   12/ FUNCTION CODE ,12/PROC. ADDRESS
 
 
 TFCN     BSS    0           TABLE OF LEGAL FUNCTION REQUESTS
          CON    FCRUN,RUN   REWIND/UNLOAD
          CON    FCCWR,RDA   CONTROL WORD READ DATA
          CON    FCCWW,WDA   CONTROL WORD WRITE DATA
          CON    0           END OF TABLE
 RDA      SPACE  4,10
**        RDA - READ DATA IN STRIPE FORMAT.
*
*         ENTRY  FET INITIALIZED.
*
*         EXIT   EOI SET IN FET, ERROR OTHERWISE.
*
*         CALLS  CIB, CON, DV5, FCN, REL, SCB, ST, WBB.
*
*         USES   T0, T1, CM - CM+4, AC, BC, PC, RC, WC.
 
 
 RDA      SUBR               ENTRY/EXIT
 TRCB     LDN    0
          ZJN    RDA0        IF NOT TRACE MODE
          LDC    =C*RDA.*+CPON
          RJM    DFM
 RDA0     LDN    0
          STD    SC          CLEAR STRIPE COUNTER
          STD    PC          CLEAR PRU COUNT
          STM    PBUF        INITIALIZE FIRST CONTROL WORD
          STM    PBUF+2
          STM    PBUF+3
          LDD    HN
          STM    PBUF+1
          LDN    ZERL        INITIALIZE SECOND CONTROL WORD
          CRM    PBUF+PRUL*5-5,ON
          RJM    CON         CONNECT UNIT
 RDA1     RJM    CIB         CHECK INPUT BUFFER
          ADC    -PRUL*PRUPST
          PJN    RDA1.1      IF ROOM FOR FULL STRIPE
          LDN    0           NO READ IN PROGRESS
          RJM    RCL         RECALL CPU AND PAUSE
          UJN    RDA1        CHECK AGAIN
 
 RDA1.1   LDN    REDF
          RJM    FCN         READ FUNCTION
          ACN    CH
          LDC    HDRL*5
          STD    BC
          IAM    HBUF,CH     INPUT HEADER
          NJN    RDA2        IF NOT FULL BLOCK
          LDN    HDRL
          STD    T1
          FETA   HDRW
          CWM    HBUF,T1     WRITE HEADER TO CM
          LDN    BRTL
          STM    CBSA        INITIALIZE RETRY COUNT
          LJM    RDA7        READ DATA
 
 RDA2     STD    WC          SAVE REMAINDER
          DCN    CH+40
          LDN    GSTF
          RJM    STS         WAIT END OF OPERATION
          SHN    21-13
          PJN    RDA4        IF NO ALERT
          LDM    STEC
          LPC    -2000B
          NJN    RDA3        IF EC .NE. 0 OR PARITY ERROR
          LDM    FSTS+4
          SHN    21-1
          PJN    RDA3        IF NOT TAPE BOTTOM RIGHT
          ERROR  RCENDV
 
 RDA3     RJM    CBS         CHECK BUSY STATUS
          NJN    RDA3.1      IF NOT TO RETRY
          LJM    RDA1        RETRY READ
 
 RDA3.1   ERROR  RCSTER      STATUS ERROR
 
 RDA4     LDD    BC
          LMD    WC
          NJN    RDA5        IF NOT EMPTY BLOCK
          LDD    ST
          SHN    21-4
          MJN    RDA6        IF EOI
          LDN    REDF
          RJM    FCN         READ FUNCTION
          ACN    CH
          LDN    1
          IAM    CM,CH
          DCN    CH+40
          LDN    GSTF
          RJM    STS         WAIT END OF OPERATION
          SHN    21-4
          MJN    RDA6        IF EOI
 RDA5     ERROR  RCCHIN      CHANNEL HANG ERROR
 
 RDA6     LDD    TH
          RJM    SCB         SET COMPLETE WITH EOI
          LJM    RDAX        RETURN
 
 RDA7     BSS    0
 RDA8     LDN    0
          STD    RC          CLEAR RECALL COUNT
          LDC    500+2
          STD    BC
          IAM    PBUF+4,CH
          ZJN    RDA9        IF FULL PRU
          LJM    RDA2        CHECK FOR EOI
 
 RDA9     LDM    PBUF+4
          ADC    -501
          MJN    RDA11       IF BYTE COUNT OK
 RDA10    ERROR  RCCWER      CONTROL WORD ERROR
 
 RDA11    ADC    501
          RJM    DV5
          ADN    2           ADD CONTROL WORDS
          STD    WC
          SBN    2
          STD    T0
          SHN    2           *4
          ADD    T0          *5
          LMM    PBUF+4
          NJN    RDA10       IF NOT EXACT MULTIPLE OF 5
          RJM    WBB         WRITE PRU
          AOD    PC
          SBN    PRUPST
          ZJN    RDA12       IF FULL STRIPE
          ADN    PRUPST/2
          NJN    RDA11.1     IF NOT 1/2 STRIPE READ
          LDN    DRCM
          STD    CM
          LDD    OA
          CWD    CM          RECALL CPU DRIVER
 RDA11.1  LJM    RDA7        READ NEXT PRU
 
 RDA12    STD    PC          CLEAR PRU COUNT
          LDN    TLRL*5
          STD    BC
          IAM    TBUF,CH
          ZJN    RDA13       IF FULL TRAILER
          LJM    RDA2        CHECK FOR EOI
 
 RDA13    DCN    CH+40
          LDN    GSTF
          RJM    STS         WAIT END OF OP
          SHN    21-13
          PJN    RDA14       IF NO ALERT
          ERROR  RCSTER      STATUS ERROR
 
 RDA14    LDM    TBUF
          SHN    21-13
          MJN    RDA15       IF TRAILER
          ERROR  RCHDER
 
 RDA15    SHN    13-12
          PJN    RDA16       IF NOT END OF VOLUME
          ERROR  RCENDV      END OF VOLUME RETURN
 
 RDA16    SHN    12+1
          LPC    3777        CLEAR TRAILER FLAG
          STM    TBUF
          LDN    TLRL
          STD    T1
          FETA   HDRW
          CWM    TBUF,T1
          LDN    DRCM
          STD    CM
          LDD    OA
          CWD    CM          RECALL CPU
          AOD    SC
          SBN    STRPAU
          NJN    RDA17       IF NOT FULL AU
          STD    SC
          AOD    RC
*         LDN    1           FLAG READ
          RJM    RCL         PAUSE AND CHECK ERROR FLAG
 RDA17    FETA   4
          CRD    CM          READ LIMIT WORD
          LDD    CM+3
          SHN    -6
          ZJN    RDA18       IF TERMINATE FLAG NOT SET
          ERROR  RCTERF      TERMINATE FLAG RETURN
 
 RDA18    LDD    SC
          NJN    RDA19       IF NOT END OF AU
          RJM    CMG         CHECK FOR MESSAGES
 RDA19    LJM    RDA1        CONTINUE READ
 RMS      SPACE  4,10
**        RMS - READ MESSAGE AND ASSOCIATED DATA.
*
*         ENTRY  MESSAGE WAITING INTERRUPT FROM M862.
*                CHANNEL RESERVED.
*
*         EXIT   (A) .NE. 0, IF NO BUFFER SPACE FOR MESSAGE.
*                (A) .EQ. 0, IF MESSAGE READ.
*
*         CALLS  CIB, DV3, DV5, FCN, IBP, REL, STS, WMB.
*
*         USES   BC, CM - CM+4, FE, FE+1, WC, T1, T2, T4, T5, T6, T7.
 
 
 RMS0     RJM    REL         RELEASE CHANNEL
          LDN    ZERL
          CRD    CM
          LDD    IN
          STD    CM+3
          LDD    IN+1
          STD    CM+4
          FETA   2
          CWD    CM          UPDATE IN POINTER IN FET
          LDN    ZERL
          CRD    CM
          AOD    CM+4
          LDCA   DR
          CWD    CM          RECALL CPU DRIVER
          MONITOR DRCM
*         LDN    0           SET MESSAGE READ
 
 RMS      SUBR               ENTRY/EXIT
          RJM    IBP         INITIALIZE BUFFER PARAMETERS
          RJM    CIB         CHECK INPUT BUFFER
          ADC    -MSWC-MXWC
          PJN    RMS1        IF ROOM IN BUFFER
          RJM    REL         RELEASE CHANNEL
          LDN    ZERL
          CRD    CM
          AOD    CM+4
          LDCA   DR
          CWD    CM          RECALL CPU DRIVER
          MONITOR DRCM       RECALL CPU
          LDN    1           SET MESSAGE WAITING FOR BUFFER
          UJN    RMSX        RETURN
 
 RMS1     LDN    CMRF
          RJM    CMD         CONNECT TO MESSAGE READ DEVICE
          LDN    MRDF
          RJM    FCN         ISSUE MESSAGE READ FUNCTION
          LDN    MSBC
          ACN    CH
 RMS2     IJM    RMS3,CH     IF ERROR
          EJM    RMS2,CH     IF DATA NOT AVAILABLE
 RMS3     IAM    BUFR,CH     READ MESSAGE
          DCN    CH+40
          STD    BC          SAVE REMAINDER
          LMN    MSBC
          NJN    RMS3.1      IF NOT EMPTY MESSAGE
          LJM    RMS0        EXIT
 
 RMS3.1   LDN    GSTF
          RJM    STS         WAIT END OF OPERATION
          SHN    21-13
          PJN    RMS4        IF NO ERROR
          ERROR  RCSTER      STATUS ERROR
 
 RMS4     LDD    BC
          ZJN    RMS5        IF FULL BLOCK
          ERROR  RCCHIN      CHANNEL HANG
 
 RMS5     LDN    MSWC
          STD    WC
          RJM    WMB         WRITE MESSAGE TO BUFFER
 TRCC     LDN    0
          ZJN    RMS5.5      IF NOT TRACE MODE
          LDC    2RIN
          RJM    MDF         MESSAGE TO DAYFILE
          RJM    GMT         GET MESSAGE TYPE
          LMC    0#81
          NJN    RMS5.5      IF NOT REWIND UNLOAD MSG
          RJM    RUM         REWIND UNLOAD MESSAGES
 RMS5.5   LDM    BUFR+2
          SHN    -4
          STD    T2
          LDM    BUFR+1
          LPC    377
          SHN    10
          RAD    T2
          NJN    RMS7        IF ASSOCIATED DATA BLOCK PRESENT
 RMS6     LJM    RMS0        UPDATE FET
 
 RMS7     ADC    -MXAD
          PJN    RMS8        IF ASSOC DATA GOES TO AUX BUFFER
          LDN    0
          STD    T1
          STD    T4          CLEAR FULL BLOCK COUNT
          STD    T6          CLEAR AUX BUFFER ADDRESS
          STD    T7
          LJM    RMS10
 
 RMS8     ADC    MXAD
          SHN    -14
          STD    T1
          FETA   4
          CRD    CM          READ LIMIT WORD
          LDD    CM+1
          LPN    77
          STD    T6          SET AUX BUFFER
          SHN    14
          ADD    CM+2
          STD    T7
          NJN    RMS9        IF AUX BUFFER PRESENT
 RMS8.1   LDN    REDF
          RJM    FCN         ISSUE READ FUNCTION
          ACN    CH
          IAN    CH
          RJM    FIN         FLUSH INPUT
          RJM    GMT         GET MESSAGE TYPE
          LMN    0#04
          NJN    RMS8.2      IF NOT READ CART. LABEL
          LJM    RMS0        PUT MESSAGE IN BUFFER
 
 RMS8.2   ERROR  RCDLER      DATA LENGTH ERROR
 
 RMS9     RJM    CFL         CHECK ADDRESS
          RJM    GMT         GET MESSAGE TYPE
          LMN    0#11
          NJN    RMS8.1      IF NOT READ WITH ERROR MESSAGE
*         LDN    0
          STD    T4          CLEAR FULL BLOCK COUNT
 RMS10    LDD    T1
          SHN    14
          ADD    T2
          ADC    -500*3/2
          MJN    RMS11       IF NO MORE FULL BLOCKS
          STD    T2
          SHN    -14
          STD    T1
          AOD    T4          INCREMENT FULL BLOCK COUNT
          UJN    RMS10       CHECK FOR MORE FULL BLOCKS
 
 RMS11    LDD    T2
          STD    BC
          ZJN    RMS12       IF NO PARTIAL BLOCK
          SHN    1           *2
          RJM    DV3         DIVIDE BY 3
          STD    BC          SET PP BYTE COUNT
          RJM    DV5         DIVIDE BY 5 = CM WORD COUNT
          STD    T5
 RMS12    LDN    CMRF
          RJM    CMD         RESERVE MESSAGE EVICE
          LDN    REDF
          RJM    FCN         FUNCTION FOR READ
          ACN    CH
          LDD    T4
          NJN    RMS13       IF MORE FULL BLOCKS
          LJM    RMS19       PROCESS SHORT BLOCK
 
 RMS13    LDC    500
          IAM    BUFR,CH     READ FULL BLOCK
          ZJN    RMS16       IF FULL BLOCK
 RMS14    DCN    CH+40
          LDN    GSTF
          RJM    STS         WAIT END OF OP
          SHN    21-13
          PJN    RMS15       IF NO ERROR
          ERROR  RCSTER      STATUS ERROR
 
 RMS15    ERROR  RCCHIN      CHANNEL HANG
 
 RMS16    LDD    T6
          ADD    T7
          NJN    RMS17       IF AUX BUFFER PRESENT
          LDD    HN
          STD    WC
          RJM    WMB         WRITE BLOCK TO CM
          UJN    RMS18       CHECK FOR NEXT BLOCK
 
 RMS17    LDCA   T6
          CWM    BUFR,HN     WRITE DATA TO AUX BUFFER
          LDD    HN
          RAD    T7
          SHN    -14
          RAD    T6
 RMS18    SOD    T4
          ZJN    RMS19       IF NO MORE FULL BLOCKS
          LJM    RMS13       GET NEXT BLOCK
 
 RMS19    LDD    BC
          ZJN    RMS20       IF NO PARIIAL BLOCK
          IAM    BUFR,CH
          ZJN    RMS20       IF ALL DATA READ
          LJM    RMS14       CHECK STATUS
 
 RMS20    DCN    CH+40
          LDN    GSTF
          RJM    STS         WAIT END OF OPERATION
          SHN    21-13
          PJN    RMS21       IF NOT ALERT
          ERROR  RCSTER      STATUS ERROR RETURN
 
 RMS21    LDD    BC
          ZJN    RMS23       IF NO PARTIAL BLOCK
          LDD    T6
          ADD    T7
          NJN    RMS22       IF AUX BUFFER PRESENT
          LDD    T5
          STD    WC
          RJM    WMB         WRITE DATA TO BUFFER
          UJN    RMS23       UPDATE FET
 
 RMS22    LDCA   T6
          CWM    BUFR,T5     WRITE DATA TO AUX BUFFER
 RMS23    LJM    RMS0        UPDATE FET
 RUM      SPACE  4,10
**        RUM - REWIND UNLOAD MESSAGES
*
*         ENTRY  (BUFR) CONTAINS REWIND UNLOAD MESSAGE
*
*         EXIT   PHYSICAL AND LOGICAL STRIPES TO DAYFILE
*
*         CALLS  CHN, DFM.
*
*         USES   T0.
 
 
 RUM      SUBR               ENTRY/EXIT
          LDM    BUFR+35
          SHN    -8D
          STD    T0
          LDM    BUFR+34
          SHN    4
          LMD    T0
          RJM    CHN         CONVERT PHYSICAL STRIPE
          LDC    2R P
          STM    RUMA
          LDC    RUMA+CPON
          RJM    DFM         ISSUE MESSAGE
          LDM    BUFR+36
          LPN    0#F
          SHN    14
          LMM    BUFR+37
          RJM    CHN         CONVEWT LOGICAL STRIPE
          LDC    2R L
          STM    RUMA
          LDC    RUMA+CPON
          RJM    DFM         ISSUE MSSAGE
          LJM    RUMX        RETURN
 
 
 RUMA     DIS    ,* XS = 1234.*
 CHN      SPACE  4,10
**        CHN - CONVERT HEX NUMBER
*
*         ENTRY  (A) = 16 BIT NUMBER
*
*         EXIT   (RUMA+3, RUMA+4) = DISPLAY CODE HEX NUMBER
*
*         CALLS  CTH.
*
*         USES   T1.
 
 
 CHN      SUBR               ENTRY/EXIT
          STD    T1
          SHN    -14
          RJM    CTH         CONVERT 1ST DIGIT
          SHN    6
          STM    RUMA+3
          LDD    T1
          SHN    -8D
          RJM    CTH         CONVERT 2ND DIGIT
          RAM    RUMA+3
          LDD    T1
          SHN    -4
          RJM    CTH         CONVERT 3RD DIGIT
          SHN    6
          STM    RUMA+4
          LDD    T1
          RJM    CTH         CONVERT 4TH DIGIT
          RAM    RUMA+4
          UJN    CHNX        RETURN
 RUN      SPACE  4,10
**        RUN - REWIND UNLOAD UNIT.
*
*         ENTRY  (UN) = UNIT NUMBER.
*
*         EXIT REWIND UNLOAD ISSUED.
*
*         CALLS  FCN, RES, SCB.
*
*         USES   CM - CM+4.
 
 
 RUN      SUBR               ENTRY/EXIT
 TRCD     LDN    0
          ZJN    RUN0.0      IF NOT TRACE MODE
          LDC    =C*RUN.*+CPON
          RJM    DFM
 RUN0.0   RJM    RES         RESERVE CHANNEL
          LDN    CONF
          ADD    UN
          RJM    FCN         CONNECT UNIT
          LDN    GSTF
          RJM    STS         GET STATUS
          SHN    21-11
          MJN    RUN0        IF UNIT NOT CONNECTED
          LDC    RUNF
          RJM    FCN         ISSUE REWIND UNLOAD
          LDN    GSTF
          RJM    STS         GET STATUS
          SHN    21-13
          PJN    RUN1        IF NOT ALERT
 RUN0     ERROR  RCSTER      STATUS ERROR
 
 RUN1     LDN    0
          RJM    SCB         SET FET COMPLETE
 TRCE     LDN    0
          ZJN    RUN2        IF NOT TRACE MODE
          LDC    RTCL
          CRD    CM          READ MILLISECOND CLOCK
          LDN    0
          STD    CM          CLEAR SECOND COUNT
          STD    CM+1
          STD    CM+2        ONLY USE 24 BITS
          LDD    MA
          CWD    CM
          LDN    1
          STD    CM+1        ONLY 1 VALUE TO BE CONVERTED
          MONITOR RDCM       CONVERT TO F10.3
          LDD    MA
          CRM    RUNB,ON
          LDC    RUNA+CPON
          RJM    DFM         ISSUE DAYFILE MESSAGE
 RUN2     LJM    RUNX
 
 
 RUNA     DATA   12HRUNL
 RUNB     BSS    6           MILLISECOND CLOCK
 WDA      SPACE  4,10
**        WDA - WRITE DATA IN STRIPE FORMAT.
*
*         ENTRY  (UN) = UNIT NUMBER.
*
*         EXIT   AT EOI, ERROR OTHERWISE.
*
*         CALLS  CFS, DV5, FCN, RBB, REL, SCB, STS.
*
*         USES   T7, CM - CM+4, AC, PC, RC, WC.
 
 
 WDA      SUBR               ENTRY/EXIT
 TRCF     LDN    0
          ZJN    WDA0.0      IF NOT TRACE MODE
          LDC    =C*WDA.*+CPON
          RJM    DFM
 WDA0.0   LDN    0
          STD    SC          CLEAR STRIPE COUNT
          STD    PC          CLEAR PRU COUNT
          LDN    HDRL
          STD    T1
          LDN    TLRL
          STD    T2
          FETA   HDRW
          CRM    HBUF,T1     READ HEADER
          SBN    HDRL
          CRM    TBUF,T2     READ TRAILER
          LDC    4000
          RAM    TBUF        SET TRAILER FLAG
          RJM    CON         CONNECT UNIT
 WDA0     RJM    CFS         CHECK FOR FULL STRIPE
          LDN    WRTF
          RJM    FCN         WRITE FUNCTION
          ACN    CH
          LDC    HDRL*5
          OAM    HBUF,CH     OUTPUT HEADER
          NJN    WDA1        IF NOT ALL DATA OUTPUT
          LJM    WDA4        CONTINUE WRITE
 
 WDA1     DCN    CH+40
          LDN    GSTF
          RJM    STS
          SHN    21-13
          MJN    WDA2        IF ALERT
          ERROR  RCCHOT      CHANNEL HANG RETURN
 
 WDA2     LDM    FSTS+4
          SHN    21-1
          PJN    WDA3        IF NOT TAPE BOTTOM RIGHT
          LDM    STEC
          NJN    WDA3        IF EC .NE. 0 OR PARITY ERROR
          ERROR  RCTBRT      TAPE BOTTOM RIGHT ERROR
 
 WDA3     RJM    CBS         CHECK BUSY STATUS
          NJN    WDA3.1      IF NOT TO RETRY
          FETA   3
          CRD    CM          RESET OUT POINTER
          LDD    CM+3
          STD    OT
          LDD    CM+4
          STD    OT+1
          LJM    WDA0        RETRY WRITE
 
 WDA3.1   ERROR  RCSTER      STATUS ERROR
 
 WDA4     BSS    0
 WDA5     LDN    BRTL
          STM    CBSA        RESET RETRY COUNT
          LDCA   OT
          CRD    CM          READ CONTROL WORD
          LDD    CM
          SHN    21-12
          PJN    WDA9        IF NOT EOI
 WDA6     DCN    CH+40
          LDN    GSTF
          RJM    STS         GET GENERAL STATUS
          SHN    21-13
          PJN    WDA8        IF NO ALERT
 WDA7     LJM    WDA2        CHECK END OF TAPE
 
 WDA8     LDN    WTMF
          RJM    FCN         WRITE TAPE MARK
          LDN    1
          STD    WC
          RJM    RMB         READ MEMORY BUFFER
          RJM    UCO         UPDATE CENTRAL OUT
          LDN    GSTF
          RJM    STS         GET STATUS
          SHN    21-13
          MJN    WDA7        IF ALERT SET
          LDN    0
          RJM    SCB         SET FET COMPLETE
          LJM    WDAX        RETURN
 
 WDA9     LDD    CM+4
          ADC    -501
          MJN    WDA10       IF BYTE COUNT OK
          ERROR  RCCWER      CONTROL WORD ERROR
 
 WDA10    LDD    CM+4
          RJM    DV5
          ADN    2           ADD CONTROL WORDS
          STD    WC
          RJM    RMB         READ MEMORY BUFFER
          LDC    500+2
          OAM    PBUF+4,CH
          ZJN    WDA11       IF FULL BLOCK
          LJM    WDA1        CHECK FOR HANG
 
 WDA11    RJM    UCO         UPDATE CENTRAL OUT
          AOD    PC          ADVANCE PRU COUNT
          SBN    PRUPST
          ZJN    WDA12       IF FULL STRIPE
          ADN    PRUPST/2
          NJN    WDA11.1     IF NOT TIME TO RECALL CPU
          LDN    DRCM
          STD    CM
          LDD    OA
          CWD    CM
 WDA11.1  LJM    WDA4        GET NEXT PRU
 
 WDA12    STD    PC          RESET PRU COUNT
          STD    RC          RESET RECALL COUNT
 WDA13    RJM    COB         CHECK OUTPUT BUFFER
          NJN    WDA14       IF DATA
*         LDN    0           FLAG WRITE
          RJM    RCL         RECALL CPU
          UJN    WDA13       TRY AGAIN
 
 WDA14    LDCA   OT
          CRD    CM
          LDD    CM
          SHN    21-12
          PJN    WDA15       IF NOT EOI
          LJM    WDA6        CHECK FOR ERROR AND WRITE TAPE MARK
 
 WDA15    LDN    TLRL*5
          OAM    TBUF,CH
          ZJN    WDA16       IF FULL BLOCK
          LJM    WDA1        CHECK FOR HANG
 
 WDA16    DCN    CH+40
          LDN    GSTF
          RJM    STS         GET STATUS
          SHN    21-13
          PJN    WDA18       IF NO ERROR
          LJM    WDA2        CHECK FOR TAPE BOTTOM RIGHT
 
 WDA18    SHN    13-3
          PJN    WDA20       IF NOT EOT
          LDM    TBUF
          SHN    21-12
          PJN    WDA19       IF NOT ALREADY SET EOV TRAILER
          ERROR  RCENDV      END OF VOLUME
 
 WDA19    SHN    12+1        REPOSITION
          ADC    2000
          STM    TBUF        SET END OF VOLUME FLAG
 WDA20    AOM    HBUF+4      INCREMENT STRIPE IN FILE
          STM    TBUF+4
          SHN    -14
          RAM    HBUF+3
          STM    TBUF+3
          AOM    HBUF+1*5+4  INCREMENT STRIPE IN VOLUME
          STM    TBUF+1*5+4
          LDN    2
          STD    T1
          FETA   HDRW
          CWM    HBUF,T1
          LDN    DRCM
          STD    CM
          LDD    OA
          CWD    CM          RECALL CPU
          AOD    SC
          SBN    STRPAU
          NJN    WDA21       IF NOT FULL AU
          STD    SC
          AOD    RC
          LDN    0           FLAG WRITE
          RJM    RCL         PAUSE AND CHECK ERROR FLAG
 WDA21    FETA   4
          CRD    CM          READ LIMIT WORD
          LDD    CM+3
          SHN    -6
          ZJN    WDA22       IF TERMINATE FLAG NOT SET
          ERROR  RCTERF      TERMINATE FLAG RETURN
 
 WDA22    LDD    SC
          NJN    WDA23       IF NOT END OF AU
          RJM    CMG         CHECK FOR MESSAGES
 WDA23    LJM    WDA0        CONTINUE WRITE
 WMS      SPACE  4,10
**        WMS - WRITE MESSAGE AND ASSOCIATED DATA.
*
*         ENTRY  (FE - FE+1) = MESSAGE OUTPUT FET.
*
*         EXIT   ALL MESSAGES OUTPUT TO M860.
*
*         CALLS  COB, DV3, DV5, FCN, IBP, RMB, REL, RES, SCB, STS.
*                CMD, CSM, GMT.
*
*         USES   T4, CM - CM+4, BC, WC.
 
 
 WMS      SUBR               ENTRY/EXIT
          LDN    1
          STM    WMSA        CLEAR RESTART CONTROL UNIT FLAG
          RJM    IBP         INITIALIZE BUFFER PARAMETERS
          RJM    COB         CHECK OUTPUT BUFFER
          ZJN    WMSX        IF NO MESSAGES
          FETA               CHECK FOR ERROR CODE SET
          CRD    CM
          LDD    CM+4
          SHN    21-0
          MJN    WMSX        IF COMPLETE
          LDD    CM+4
          SHN    -12
          SHN    6
          LMD    CM+3
          NJN    WMSX        IF ERROR CODE SET
          RJM    RES         RESERVE CHANNEL
 WMS0     RJM    COB         CHECK OUTPUT BUFFER
          NJN    WMS1        IF MESSAGE(S) IN BUFFER
          MONITOR DRCM       RECALL CPU
          LDC    **          RESTART CONTROL UNIT FLAG
 WMSA     EQU    *-1
          NJN    WMS0.1      IF CONTROL UNIT NOT RESTARTED
          LDN    RISF
          RJM    STS         IGNORE ANY OUTSTANDING INTERRUPTS
 WMS0.1   RJM    REL         RELEASE CHANNEL
          LJM    WMSX        RETURN
 
 WMS1     SBN    MSWC
          PJN    WMS2        IF ENOUGH DATA
          ERROR  RCDLER      DATA LENGTH ERROR
 
 WMS2     LDN    MSWC
          STD    WC
          RJM    RMB         READ MESSAGE
 TRCG     LDN    0
          ZJN    WMS2.1      IF NOT TRACE MODE
          LDC    2ROT
          RJM    MDF         MESSAGE TYPE TO DAYFILE
 WMS2.1   LDN    CMWF
          RJM    CMD         CONNECT TO MESSAGE WRITE DEVICE
          LDC    BRTL
          STM    WMSB        RETRY LIMIT
 WMS2.2   LDN    MWRF
          RJM    FCN         ISSUE MESSAGE WRITE FUNCTION
          LDN    MSBC
          ACN    CH
          OAM    BUFR,CH     OUTPUT MESSAGE
          FJM    *,CH        WAIT FOR LAST BYTE
          DCN    CH+40
          STD    BC
          LDN    GSTF
          RJM    STS         WAIT END OF OPERATION
          SHN    21-13
          PJN    WMS3        IF NO ERROR
          SHN    13-1
          PJN    WMS2.3      IF NOT BUSY
          SOM    WMSB
          MJN    WMS2.3      IF RETRY LIMIT
          RJM    REL         RELEASE CHANNEL
          RJM    BDL         BUSY DELAY
          RJM    RES         RESERVE CHANNEL
          LJM    WMS2.2      RETRY
 
 WMS2.3   ERROR  RCSTER      STATUS ERROR
 
 WMS3     LDD    BC
          ZJN    WMS4        IF FULL BLOCK
          ERROR  RCCHOT      CHANNEL HANG
 
 WMS4     RJM    GMT         GET MESSAGE TYPE
          LMN    0#1C
          STM    WMSA        SET/CLEAR RESTART FLAG
          LMN    0#1C
          RJM    CSM         CHECK SPECIAL MESSAGE
          LDM    BUFR+2
          SHN    -4
          STD    BC          ASSOCIATED DATA BYTE COUNT
          LDM    BUFR+1
          LPC    377
          SHN    10
          RAD    BC
          NJN    WMS6        IF ASSOCIATED DATA
 WMS5     RJM    UCO         UPDATE CENTRAL OUT
          LJM    WMS0        CHECK FOR MORE MESSAGES
 
 WMS6     ADC    -MXAD
          MJN    WMS7        IF BLOCK NOT TOO BIG
          ZJN    WMS7        IF BLOCK NOT TOO BIG
          ERROR  RCDLER      DATA LENGTH ERROR
 
 WMS7     ADC    MXAD
          SHN    1           *2
          STD    T4
          RJM    DV3         /3 = PP BYTE COUNT
          STD    BC
          RJM    DV5         GET CM WORD COUNT
          STD    WC
          RJM    COB         CHECK OUTPUT FET
          SBD    WC
          PJN    WMS8        IF DATA IN BUFFER
          ERROR  RCDLER      DATA LENGTH ERROR
 
 WMS8     RJM    RMB         READ DATA TO PP
          LDC    BRTL
          STM    WMSB        RETRY LIMIT
 WMS8.1   LDD    BC
          SHN    1           *2
          ADD    BC          *3
          SBD    T4          REMAINDER FROM DIVISION BY 3
          LPN    2           REMAINDER OF 2 = WRITE SHORT
          SHN    6
          ERRNZ  SWRF-WRTF-200
          ADN    WRTF
          RJM    FCN         ISSUE WRITE FUNCTION
          LDD    BC
          STD    WC          SAVE FOR RETRY
          ACN    CH
          OAM    BUFR,CH     SEND ASSOC. DATA
          FJM    *,CH        WAIT FOR LAST BYTE
          DCN    CH+40
          STD    BC
          LDN    GSTF
          RJM    STS         WAIT END OF OPERATION
          SHN    21-13
          PJN    WMS9        IF NO ERROR
          SHN    13-1
          PJN    WMS8.2      IF NOT BUSY
          SOM    WMSB
          MJN    WMS8.2      IF RETRY LIMIT
          RJM    REL         RELEASE CHANNEL
          RJM    BDL         BUSY DELAY
          RJM    RES         RESERVE CHANNEL
          LDD    WC
          STD    BC          RESTORE BYTE COUNT
          LJM    WMS8.1      RETRY
 
 WMS8.2   ERROR  RCSTER      STATUS ERROR
 
 WMS9     LDD    BC
          ZJN    WMS10       IF FULL BLOCK
          ERROR  RCCHOT      CHANNEL HANG
 
 WMS10    LJM    WMS5        UPDATE FET
 
 
 WMSB     CON    BRTL        RETRY LIMIT
          TITLE  SUBROUTINES.
          TITLE  I/O SUBROUTINES.
 CKM      SPACE  4,10
**        CKM - CHECK FOR MESSAGE.
*
*         ENTRY  (MW) .NE. 0, IF MESSAGE ALREADY WAITING.
*
*         EXIT   (MW) = 0, IF NO MESSAGE WAITING FOR BUFFER.
*
*         CALLS  RES, RMS, STS.
*
*         USES   MW.
 
 
 CKM      SUBR               ENTRY/EXIT
          RJM    RES         RESERVE CHANNEL
          LDD    MW
          NJN    CKM1        IF MESSAGE WAITING
          LDN    RISF
          RJM    STS         REQUEST INTERRUPT STATUS
          SHN    21-10
          MJN    CKM1        IF MESSAGE READY
          RJM    REL         RELEASE CHANNEL
          UJN    CKMX        RETURN
 
 CKM1     RJM    RMS         READ MESSAGE
          STD    MW          SAVE BUFFER STATUS
          UJN    CKMX        RETURN
 CMD      SPACE  4,10
**        CMD - CONNECT TO MESSAGE DEVICE.
*
*         ENTRY  (A) = CONNECT FUNCTION CODE.
*                CHANNEL RESERVED.
*
*         EXIT   MESSAGE DEVICE CONNECTED.
*
*         CALLS  FCN, STS.
*
*         USES   NONE.
 
 
 CMD      SUBR               ENTRY/EXIT
          STM    CMDA        SAVE FUNCTION CODE
          LDC    BRTL
          STM    CMDB        RETRY LIMIT
 CMD0     LDC    **
 CMDA     EQU    *-1
          RJM    FCN         ISSUE CONNECT FUNCTION
          LDN    GSTF
          RJM    STS         GET STATUS
          SHN    21-13
          PJN    CMDX        IF NOT ALERT
          SOM    CMDB
          MJN    CMD0.0      IF RETRY LIMIT
          RJM    REL         RELEASE CHANNEL
          RJM    BDL         BUSY DELAY
          RJM    RES         RESERVE CHANNEL
          UJN    CMD0        RETRY
 
 CMD0.0   LDM    STEC        ERROR CODE
          LMC    170
          NJN    CMD1        IF CHANNEL INTERFACE ONLINE
          ERROR  RCCIFO      CHANNEL INTERFACE OFF LINE
 
 CMD1     ERROR  RCIMPL
 
 
 CMDB     CON    BRTL        RETRY COUNTER
 CMG      SPACE  4,10
**        CMG - CHECK FOR MESSAGES.
*
*         ENTRY  CHANNEL RESERVED.
*
*         EXIT   NORMAL, IF NO MESSAGES TO SEND/RECEIVE.
*                TO *SSD1* IF MESSAGES TO PROCESS.
*
*         CALLS  REL, STS.
*
*         USES   CM - CM+4, CN - CN+4, MW.
 
 
 CMG      SUBR               ENTRY/EXIT
          LDN    RISF
          RJM    STS         GET MESSAGE STATUS
          SHN    21-10
          PJN    CMG2        IF NO M860 MESSAGE
          AOD    MW          FLAG MESSAGE READY
 CMG1     RJM    REL         RELEASE CHANNEL
          LJM    SSD1        PROCESS MESSAGES
 
 CMG2     LDM    SSDA-1      CHECK MESSAGE FROM EXEC.
          LPN    77
          SHN    6
          ADD    RA
          SHN    6
          ADM    SSDA
          ADN    2           IN POINTER
          CRD    CM
          ADN    1
          CRD    CN          OUT POINTER
          LDD    CM+3
          LMD    CN+3
          NJN    CMG1        IF IN .NE. OUT
          LDD    CM+4
          LMD    CN+4
          NJN    CMG1        IF IN .NE. OUT
          LJM    CMGX        RETURN
 CON      SPACE  4,10
**        CON - CONNECT UNIT.
*
*         ENTRY  (UN) = UNIT NUMBER.
*
*         EXIT   CHANNEL RESERVED, UNIT CONNECTED AND NOT BUSY.
*
*         CALLS  FCN, RES, STS.
*
*         USES   NONE.
 
 
 CON      SUBR               ENTRY/EXIT
          RJM    WUM         WAIT UNIT MOUNTED
          LDC    BRTL
          STM    CONA        INITIALIZE BUSY RETRY LIMIT
 CON1     RJM    RES         RESERVE CHANNEL
          LDN    CONF
          ADD    UN
          RJM    FCN         CONNECT UNIT
          LDN    GSTF
          RJM    STS         GET STATUS
          SHN    21-13
          PJN    CONX        IF NO ALERT
          LDM    STEC        GET ERROR CODE
          LMN    2
          ZJN    CON2        IF BUSY CODE
          LMC    2&165
          NJN    CON3        IF NOT SENSE ERROR
 CON2     RJM    REL         RELEASE CHANNEL
          SOM    CONA
          ZJN    CON3        IF RETRY LIMIT
          RJM    BDL         BUSY DELAY
          UJN    CON1        TRY AGAIN
 
 CON3     ERROR  RCSTER      STATUS ERROR
 
 
 CONA     CON    BRTL        BUSY RETRY LIMIT
 CSM      SPACE  4,10
**        CSM - CHECK SPECIAL MESSAGE.
*
*         ENTRY  (A) = MESSAGE CODE.
*
*         EXIT   SPECIAL MESSAGES PROCESSED.
*
*         CALLS  FCN, STS.
*
*         USES   CM - CM+4.
 
 
 CSM      SUBR               ENTRY/EXIT
          LMN    0#06
          NJN    CSM1        IF NOT MOUNT VOLUME
          LDM    BUFR+5      GET UNIT NUMBER
          SHN    -10
          ADC    WUMF        PRIME FSC FOR READY INTERRUPT
          RJM    FCN         ISSUE FUNCTION
          UJN    CSMX        RETURN
 
 CSM1     LMC    0#06&0#81
          NJN    CSMX        IF NOT RESPONSE TO REWIND/UNLOAD MSG
          LDC    RTCL
          CRD    CM          READ REALTIME CLOCK
          LDD    CM+1        SECONDS
          ADC    EOPL        END OF OP. LIMIT
          STM    CMSA
 CSM2     LDM    BUFR+5      GET UNIT NUMBER
          SHN    -10
          ADC    CDEF        CHECK FOR INTERRUPT
          RJM    STS         GET STATUS
          SHN    21-13
          MJN    CSM4        IF ALERT
 CSM3     LJM    CSMX        RETURN
 CSM4     LDM    STEC        ERROR CODE
          LMN    2
          NJN    CSM3        IF NOT BUSY(EXPECT ALERT/EC=131)
          RJM    REL         PAUSE CHECK ERROR FLG
          LDC    RTCL
          CRD    CM          READ REALTIME CLOCK
          LDD    CM+1        SECONDS
          LMC    **
 CMSA     EQU    *-1
          ZJN    CSM5        IF TIMEOUT
          RJM    RES         RESERVE CHANNEL
          UJN    CSM2        CHECK AGAIN
 
 CSM5     ERROR  RCNEOP      NO END OF OPERATION
 DST      SPACE  4,10
**        DST - DIAGNOSTIC STATUS.
*
*         ENTRY  CHANNEL RESERVED.
*
*         EXIT   TO CALLER IF NO ERROR.
*                TO ERR IF ERROR
*
*         CALLS  NONE.
*
*         USES   T0.
 
 
 DST      SUBR               ENTRY/EXIT
          DCN    CH+40       INSURE INACTIVE CHANNEL
          FNC    DSTF,CH     ISSUE DIAGNOSTIC STATUS FUNCTION
          LCN    0
 DST1     IJM    DST2,CH     IF FUNCTION ACCEPTED
          SBN    1
          NJN    DST1        IF NOT TIMEOUT
          ERROR  RCFCTO      FUNCTION TIMEOUT
 
 DST2     ACN    CH
          LCN    0
 DST3     FJM    DST5,CH     IF STATUS READY
          SBN    1
          NJN    DST3        IF NOT TIMEOUT
 DST4     ERROR  RCCHMF      CHANNEL MALFUNCTION
 
 DST5     LCN    0
          IAN    CH+40
          DCN    CH+40
          MJN    DST4        IF NO DATA READ
          STM    DSTS        PUT IN STATUS BUFFER
          LPC    3003
          LMN    2
          ZJN    DSTX        IF NO ERROR
          SHN    21-12
          PJN    DST6        IF NOT CHANNEL PARITY ERROR
          ERROR  RCCHPE
 
 DST6     SHN    12-11
          PJN    DST7        IF NOT FSC MEMORY PARITY ERROR
          ERROR  RCFSPE
 
 DST7     SHN    11-0
          MJN    DST8        IF PROCESSOR RUNNING
          ERROR  RCFSNR
 
 DST8     ERROR  RCFSAB      FSC ABNORMAL
 FCN      SPACE  4,10
**        FCN - FUNCTION M860 MSS INTERFACE.
*
*         ENTRY  (A) = FUNCTION CODE TO BE ISSUED.
*
*         EXIT   FUNCTION ISSUED, TO ERR IF ERROR.
*
*         CALLS  DST.
*
*         USES   CL, CN - CN+4.
 
 
 FCN      SUBR               ENTRY/EXIT
          STM    FSTS+16D    SAVE FUNCTION IN DETAIL STATUS BLOCK
          ADD    EQ          SET EQUIPMENT NUMBER
          FAN    CH          ISSUE FUNCTION
          LDC    RTCL        SET TIMEOUT CLOCK
          CRD    CN
          LDD    CN+1        SECOND COUNT
          ADC    FTOL        FUNCTION TIMEOUT LIMIT
          STD    CL
          LDN    1
 FCN1     IJM    FCNX,CH     IF ACCEPTED
          ADN    1
          NJN    FCN1        IF NOT TIMEOUT
          PAUSE
          LDD    CM+1
          ZJN    FCN1.0      IF NO ERROR FLAG
          RJM    REL         RELEASE CHANNEL
          LJM    DPP         DROP PP
 
 FCN1.0   LDC    RTCL        READ CLOCK
          CRD    CN
          LDD    CL
          LMD    CN+1
          NJN    FCN1        IF NOT TIMEOUT
          DCN    CH+40
          LDN    GSTF
          FAN    CH          TRY TO GET GENERAL STATUS
 FCN2     IJM    FCN3,CH     IF ACCEPTED
          ADN    1
          PJN    FCN2        IF NOT TIMEOUT
          UJN    FCN8        TIMEOUT
 
 FCN3     ACN    CH
          LDN    1
 FCN4     FJM    FCN5,CH     IF STATUS READY
          ADN    1
          PJN    FCN4        IF NOT TIMEOUT
          UJN    FCN8        TIMEOUT
 
 FCN5     LDN    GSTL
          IAM    GSTS,CH     READ GENERAL STATUS
          NJN    FCN8        IF NOT ALL STATUS READ
          DCN    CH+40
          FNC    FSTF,CH     DETAIL STATUS
 FCN6     IJM    FCN7,CH     IF ACCEPTED
          ADN    1
          PJN    FCN6        IF NOT TIMEOUT
          UJN    FCN8        TIMEOUT
 
 FCN7     ACN    CH
          LDN    DSTL
          IAM    FSTS,CH     READ DETAIL STATUS
 FCN8     DCN    CH+40
          RJM    DST         GET DIAGNOSTIC STATUS
          ERROR  RCFCTO      FUNCTION TIMEOUT
 FIN      SPACE  4,10
**        FIN - FLUSH INPUT.
*
*         ENTRY  CHANNEL ACTIVE.
*
*         EXIT   INPUT OPERATION COMPLETE.
*
*         CALLS  NONE.
*
*         USES   NONE.
 
 
 FIN      SUBR               ENTRY/EXIT
 FIN1     IJM    FINX,CH     IF COMPLETE
          LCN    0
 FIN2     FJM    FIN3,CH     IF INPUT READY
          SBN    1
          NJN    FIN2        IF NOT TIMEOUT
          DCN    CH+40
          UJN    FINX        RETURN
 
 FIN3     IAN    CH+40
          UJN    FIN1        GET NEXT BYTE
 MCL      SPACE  4,15
**        MCL - MASTER CLEAR FSC.
*
*         ENTRY  CHANNEL RESERVED.
*
*         EXIT   FSC MASTERCLEARED.
*
*         CALLS  NONE.
*
*         USES   T0.
 
 
 MCL      SUBR               ENTRY/EXIT
          DCN    CH+40       INSURE CHANNEL INACTIVE
          FNC    MCLF,CH     MASTERCLEAR
          LDN    12
          STD    T0
 MCL1     SOD    T0
          MJN    MCL3        IF TIMEOUT
 MCL2     ADN    1
          PJN    MCL2        DELAY
          AJM    MCL1,CH     IF NOT PROCESSED
          ACN    CH
          OAN    CH
          OAN    CH
          DELAY
 MCL3     DCN    CH+40
          UJN    MCLX        RETURN
 MDF      SPACE  4,10
**        MDF - MESSAGE TYPE TO DAYFILE.
*
*         ENTRY  (BUFR+2,3) = MESSAGE TYPE, SUBTYPE.
*                (A) = *IN* OR *OT*.
*
*         EXIT   MESSAGE TO LOCAL DAYFILE.
*
*         USES   CM.
*
*         CALLS  CTH, DFM.
 
 
 MDF      SUBR               ENTRY/EXIT
          STM    MDFC
          CHTE   *
          LDN    0
          STD    T0
          SHN    3
          LMD    T0
          SCN    70
          ADC    2R00
          STM    MDFAA+1
          LDM    BUFR+2      FIRST DIGIT OF TYPE
          RJM    CTH         CONVERT TO HEX DISPLAY CODE
          SHN    6
          STM    MDFA+2      STORE IN MESSAGE
          LDM    BUFR+3      REST OF TYPE, SUBTYPE
          STD    CM
          SHN    -10
          RJM    CTH         CONVERT TO HEX DISPLAY CODE
          RAM    MDFA+2
          LDD    CM
          SHN    -4
          RJM    CTH         CONVERT TO HEX DISPLAY CODE
          SHN    6
          STM    MDFA+4
          LDD    CM
          RJM    CTH         CONVERT TO HEX DISPLAY CODE
          RAM    MDFA+4
          LDC    RTCL
          CRD    CM          READ MILLISECOND CLOCK
          LDN    0
          STD    CM          CLEAR SECOND COUNT
          STD    CM+1
          STD    CM+2        ONLY USE 24 BITS
          LDD    MA
          CWD    CM
          LDN    1
          STD    CM+1        ONLY 1 VALUE TO BE CONVERTED
          MONITOR RDCM       CONVERT TO F10.3
          LDD    MA
          CRM    MDFB,ON     READ TO MESSAGE
          LDM    BUFR+35D    GET MESSAGE RETURN CODE
          STD    T2
          LDM    BUFR+34D
          LPN    0#F
          STD    T1
          RJM    CTH         CONVERT TO HEX
          SHN    6
          STM    MDFD
          LDD    T2
          SHN    -8D
          RJM    CTH         CONVERT TO HEX
          RAM    MDFD
          LDD    T2
          SHN    -4
          RJM    CTH         CONVERT TO HEX
          SHN    6
          STM    MDFD+1
          LDD    T2
          RJM    CTH         CONVERT TO HEX
          RAM    MDFD+1
          LDD    T1
          ADD    T2
          NJN    MDF1        IF RETURN CODE PRESENT
          STM    MDFD        SET END OF LINE
 MDF1     LDC    MDFAA+CPON
          RJM    DFM         ISSUE MESSAGE TO LOCAL DAYFILE
          LJM    MDFX        RETURN
 
 
 MDFAA    DATA   4H CXX      CHANNEL NUMBER
 MDFA     DATA   12H MS XX, YY.
 MDFB     BSS    5           MILLISECOND CLOCK F10.3
          DATA   2H
 MDFC     CON    0           *IN* OR *OT*
          CON    2H
 MDFD     BSS    2           RETURN CODE
          CON    0           END OF LINE
 CTH      SPACE  4,10
**        CTH - CONVERT TO HEX DISPLAY CODE.
*
*         ENTRY  (A) = NUMBER TO BE CONVERTED.
*
*         EXIT   (A) = HEX DISPLAY CODE OF LOWER 4 BITS.
*
*         USES   NONE.
*
*         CALLS  NONE.
 
 
 CTH1     ADN    1           A THRU F
 
 CTH      SUBR               ENTRY/EXIT
          LPN    17
          SBN    12
          PJN    CTH1        IF A THRU F
          ADN    1R0+12      0 THRU 9
          UJN    CTHX        RETURN
 RCL      SPACE  4,10
**        RCL - RECALL CPU.
*
*         ENTRY  (RC) = 0, RECALL CPU.
*                (A) = 0, IF NOT READ ACTIVE
*
*         EXIT   IF NO ERROR.
*                TO *ERR*, IF TERMINATE FLAG SET.
*                TO *DPP*, IF ERROR FLAG SET.
*
*         CALLS  FIN.
*
*         USES   RC, CM - CM+4.
 
 
 RCL      SUBR               ENTRY/EXIT
          STM    RCLA        SAVE READ STATUS
 RCL0     LDD    OA
          CRD    CM
          LDD    CM
          NJN    RCL0        IF OUTPUT REGISTER NOT CLEAR
          LDD    RC
          NJN    RCL1        IF NOT TO RECALL CPU
          MONITOR DRCM
 RCL1     AOD    RC
          SBD    HN
          NJN    RCL2        IF NOT TIME TO RECALL CPU
          STD    RC
 RCL2     PAUSE
          LDD    CM+1
          ZJN    RCL3        IF NO ERROR FLAG
          LDC    **          READ/WRITE FLAG
 RCLA     EQU    *-1
          ZJN    RCL2.1      IF NOT READ
          RJM    FIN         FLUSH INPUT
 RCL2.1   DCN    CH+40
          RJM    REL         RELEASE CHANNEL
          LJM    DPP         DROP PP
 
 RCL3     FETA   4
          CRD    CM          READ LIMIT WORD
          LDD    CM+3
          SHN    -6
          NJN    RCL4        IF TERMINATE STREAMING FLAG
          LJM    RCLX        RETURN
 
 RCL4     LDM    RCLA
          ZJN    RCL5        IF NOT READ OPERATION
          RJM    FIN         FLUSH INPUT
 RCL5     DCN    CH+40
          ERROR  RCTERF      TERMINATE FLAG SET
 REL      SPACE  4,10
**        REL - RELEASE CHANNEL.
*
*         ENTRY  NONE.
*
*         EXIT   CHANNEL RELEASED.
*                TO *DPP* IF ERROR FLAG SET.
*
*         CALLS  NONE.
*
*         USES   CM - CM+4.
 
 
 REL      SUBR               ENTRY/EXIT
 REL0     LDD    OA
          CRD    CM
          LDD    CM
          NJN    REL0        IF OUTPUT REGISTER NOT CLEAR
          LDC    0
 RELA     EQU    *-1
          ZJN    REL1        IF CHANNEL NOT RESERVED
          CHTE   *
          LDN    CH
          DCHAN
*         LDN    0
          STM    RELA        FLAG CHANNEL NOT RESERVED
 REL1     PAUSE
          LDD    CM+1
          ZJN    RELX        IF NO ERROR FLAG
          LJM    DPP         DROP PP
 RES      SPACE  4,10
**        RES - RESERVE CHANNEL.
*
*         ENTRY  (CH) = CHANNEL(S).
*
*         EXIT   CHANNEL RESERVED.
*
*         CALLS  NONE.
*
*         USES   T1, CM - CM+4.
 
 
 RES      SUBR               ENTRY/EXIT
          CHTE   *
 RES0     LDN    CH
          STD    CM+1
          MONITOR CCHM
          LDD    CM+2
          NJN    RES1        IF CHANNEL RESERVED
          PAUSE
          LDD    CM+1
          ZJN    RES0        IF NO ERROR
          LJM    DPP         EXIT
 
 RES1     AOM    RELA        FLAG CHANNEL RESERVED
          UJN    RESX        RETURN
 STS      SPACE  4,10
**        STS - RETURN INTERFACE STATUS.
*
*         ENTRY  (A) = STATUS FUNCTION.
*
*         EXIT   (A) = (ST) INTERFACE STATUS.
*
*         CALLS  FCN, DST.
*
*         USES   CM - CM+4, ST, EO.
 
 
 STS      SUBR               ENTRY/EXIT
          STM    STSA        SAVE STATUS FUNCTION
          LDC    RTCL
          CRD    CM          READ CLOCK
          LDD    CM+1        SECONDS
          ADC    EOPL        END OF OP. LIMIT
          STD    EO
 STS0     LDC    **          STATUS FUNCTION
 STSA     EQU    *-1
          RJM    FCN         ISSUE STATUS FUNCTION
          ACN    CH
          LDN    77          WAIT EOP DELAY
 STS1     FJM    STS2,CH     IF STATUS READY
          SBN    1
          PJN    STS1        IF NOT TIMEOUT
          DCN    CH+40
          PAUSE
          LDD    CM+1
          ZJN    STS1.1      IF NO ERROR
          RJM    REL         RELEASE CHANNEL
          LJM    DPP         DROP PP
 
 STS1.1   LDC    RTCL
          CRD    CM          READ CLOCK
          LDD    EO
          LMD    CM+1
          NJN    STS0        IF NOT TIMEOUT
          RJM    DST         GET DIAGNOSTIC STATUS
          ERROR  RCNEOP      NO END OF OPERATION
 
 STS2     LDN    GSTL        GENERAL STATUS LENGTH
          IAM    GSTS,CH
          DCN    CH+40
          LDM    GSTS
          STD    ST
          SHN    21-13
          PJN    STS3        IF NOT ALERT
          LDM    STSA
          LMN    GSTF
          NJN    STS3        IF NOT GENERAL STATUS
          LDC    FSTF
          RJM    FCN         FSC STATUS FUNCTION
          ACN    CH
          LDN    DSTL        DETAIL STATUS (FSC) LENGTH
          IAM    FSTS,CH     READ FSC STATUS
          DCN    CH+40
          RJM    DST         GET DIAGNOSTIC STATUS
 STS3     LDD    ST
          LJM    STSX        RETURN
 
 
 GSTS     BSS    2           GENERAL STATUS
 STEC     BSS    1           ERROR CODE
 FSTS     BSS    24          FSC STATUS
          CHTE   *
 CHAN     CON    CH          CHANNEL USED
 DSTS     BSS    1           DIAGNOSTIC STATUS
 WUM      SPACE  4,10
**        WUM - WAIT UNIT MOUNTED
*
*         ENTRY  (UN) = UNIT NUMBER
*
*         EXIT   UNIT MOUNTED INTERRUPT SENSED
*
*         CALLS  STS, RES, REL.
*
*         USES   CM - CM+4.
 
 
 WUM1     RJM    REL         RELEASE CHANNEL
 
 WUM      SUBR               ENTRY/EXIT
          LDC    RTCL
          CRD    CM          READ SECOND CLOCK
          LDD    CM+1
          ADC    EOPL        END OF OP. LIMIT
          STM    WUMA
 WUM2     RJM    RES         RESERVE CHANNEL
          LDD    UN          UNIT NUMBER
          ADC    CDEF        CHECK DEVICE END
          RJM    STS
          SHN    21-13
          PJN    WUM1        IF NO ALERT
          LDM    STEC
          LMN    2
          NJN    WUM1        IF NOT BUSY
 WUM3     RJM    REL         RELEASE CHANNEL
          LDC    RTCL
          CRD    CM
          LDD    CM+1        SECONDS
          LMC    **
 WUMA     EQU    *-1
          NJN    WUM2        IF NOT TIMEOUT
          ERROR  RCNEOP      NO END OF OPERATION
 BDL      SPACE  4,20
**        BDL - BUSY DELAY.
*
*         ENTRY  BUSY STATUS FROM M860.
*
*         EXIT   DELAY TO ALLOW M860 INTERRUPT.
*
*         CALLS  NONE
*
*         USES   T0.
 
 
 BDL      SUBR               ENTRY/EXIT
          LDC    10D*100D    100 MSEC. DELAY
          STD    T0
 BDL1     DELAY
          SOD    T0
          NJN    BDL1        IF NOT TIME
          UJN    BDLX
 CBS      SPACE  4,10
**        CBS - CHECK BUSY STATUS.
*
*         ENTRY  (PC) = PRU COUNT.
*                (STEC) = STATUS ERROR CODE.
*
*         EXIT   (A) = 0, IF TO RETRY OPERATION.
*
*         CALLS  REL, RES.
*
*         USES   NONE.
 
 
 CBS      SUBR               ENTRY/EXIT
          LDD    PC
          NJN    CBSX        IF NOT HEADER
          LDM    STEC
          LMN    2
          NJN    CBSX        IF NOT BUSY ERROR
          SOM    CBSA
          NJN    CBS1        IF NOT RETRY LIMIT
          LDN    1           FLAG NO RETRY
          UJN    CBSX        RETURN
 
 CBS1     RJM    REL         RELEASE CHANNEL
          RJM    BDL         BUSY DELAY
          RJM    RES         RESERVE CHANNEL
          LDN    0           FLAG RETRY
          UJN    CBSX        RETURN
 
 
 CBSA     CON    BRTL        RETRY COUNTER
          TITLE  GENERAL SUBROUTINES.
 CFL      SPACE  4,15
**        CFL - CHECK FIELD LENGTH.
*
*         ENTRY  (A) = RELATIVE ADDRESS TO BE ACCESSED.
*                (RA) = CURRENT REFERENCE ADDRESS.
*                (FL) = CURRENT FIELD LENGTH.
*
*         EXIT   (A) = RELATIVE + REFERENCE ADDRESS.
*
*         CALLS  DFM.
*
*         USES   NONE
 
 
 
 CFL3     SHN    15          REPOSITION TO VALUE/100
          ADD    FL          RESTORE VALUE
          ADD    RA          ADD RA
          SHN    6           REPOSITION VALUE
 
 CFL      SUBR               ENTRY/EXIT
          SBN    2
          MJN    CFL1        IF ADDRESS TOO SMALL
          ADN    2
          SHN    21
          MJN    CFL2        IF VALUE ODD
          SHN    15          POSITION TO VALUE/100B
          SBD    FL
          SHN    5
          MJN    CFL3        IF VALUE IN RANGE
 CFL1     LDC    CFLA
          RJM    DFM         OUTPUT MESSAGE
          RJM    REL         RELEASE CHANNEL
          MONITOR HNGM       HANG PPU
          LJM    DPP1        DROP PP
 
 CFL2     SHN    15          POSITION TO VALUE/100B
          SBD    FL
          SHN    5
          MJN    CFL1        IF VALUE TO BIG (OR NEGATIVE)
          UJN    CFL3        SET RA
 
 CFLA     DATA   C*1SS ABT.*
 CFS      SPACE  4,10
**        CFS - CHECK FULL STRIPE.
*
*         ENTRY  BUFFER POINTERS INITIALIZED.
*
*         EXIT   FULL STRIPE + 1 PRU OR EOI IN BUFFER.
*
*         CALLS  COB, DV5, RCL.
*
*         USES   T3, CM - CM+4, PC, WC.
 
 
 CFS1     LDC    **          RESTORE ORIGINAL OUT POINTER
 CFSA     EQU    *-1
          STD    OT+1
          SHN    -14
          STD    OT
          LDN    0
          STD    PC          RESET PRU COUNT
 
 CFS      SUBR               ENTRY/EXIT
          LDD    OT+1        SAVE OUT POINTER
          STM    CFSA
          LDM    CFSA-1
          SCN    77
          ADD    OT
          STM    CFSA-1
          LDN    0
          STD    PC          INITIALIZE PRU COUNT
          STD    RC          INITIALIZE RECALL COUNT
 CFS2     RJM    COB         CHECK OUTPUT BUFFER
          NJN    CFS3        IF DATA IN BUFFER
*         LDN    0           NOT READ
          RJM    RCL         RECALL CPU
          UJN    CFS2        CHECK AGAIN
 
 CFS3     LDCA   OT
          CRD    CM          READ FIRST CONTROL WORD
          LDD    CM
          SHN    21-12
          MJN    CFS4        IF EOI
          AOD    PC          ADVANCE PRU COUNT
          SBN    PRUPST+1
          MJN    CFS5        IF NOT FULL STRIPE + 1 PRU
 CFS4     LJM    CFS1        RESTORE OUT AND RETURN
 
 CFS5     LDD    CM+4        PRU BYTE COUNT
          RJM    DV5         CM WORD COUNT
          ADN    2           CONTROL WORDS
          STD    WC
          LDD    LM
          SBD    OT
          SHN    14
          ADD    LM+1
          SBD    OT+1        WORD COUNT TO LIMIT
          STD    T3
          SBD    WC
          MJN    CFS6        IF WRAPAROUND
          ZJN    CFS6        IF WC = ROOM TO LIMIT
          LDD    WC
          RAD    OT+1        ADVANCE OUT
          SHN    -14
          RAD    OT
          LJM    CFS2        CHECK FOR NEXT PRU
 
 CFS6     LDD    FT          SET OUT=FIRST+WC-REMAINDER TO LIMIT
          SHN    14
          ADD    FT+1
          ADD    WC
          SBD    T3
          STD    OT+1
          SHN    -14
          STD    OT
          LJM    CFS2        CHECK FOR NEXT PRU
 CIB      SPACE  4
**        CIB - CHECK INPUT BUFFER.
*
*         ENTRY  (FE - FE+1) = FET ADDRESS.
*                (FT - FT+1) = FIRST ADDRESS OF CM BUFFER.
*                (IN - IN+1) = NEXT INPUT ADDRESS.
*                (OT - OT+1) = NEXT OUTPUT ADDRESS.
*                (LM - LM+1) = LIMIT ADDRESS OF CM BUFFER.
*
*         EXIT   (A) = WORD COUNT OF BUFFER.
*                RESETS (OT - OT+1).
*
*         CALLS  CFL.
*
*         USES   CM - CM+4.
 
 
 CIB      SUBR               ENTRY/EXIT
          FETA   3
          CRD    CM
          LDD    CM+3        SET OUT
          LPN    77
          STD    OT
          SHN    14
          LMD    CM+4
          STD    OT+1
          RJM    CFL         CHECK ADDRESS
          LDD    OT          LENGTH = OUT - IN
          SBD    IN
          SHN    14
          ADD    OT+1
          SBD    IN+1
          ZJN    CIB1        IF IN = OUT
          PJN    CIB2        IF OUT .GT. IN
 CIB1     SHN    6           LENGTH = (LIMIT - IN) + OUT - FIRST)
          ADD    LM
          SBD    FT
          SHN    14
          ADD    LM+1
          SBD    FT+1
 CIB2     SBN    1           LENGTH - 1
          UJN    CIBX        RETURN
 COB      SPACE  4,10
**        COB - CHECK OUTPUT BUFFER.
*
*         ENTRY  (FE - FE+1) = ADDRESS OF FET.
*                (FT - FT+1) = FIRST ADDRESS OF CM BUFFER.
*                (IN - IN+1) = NEXT INPUT ADDRESS.
*                (OT - OT+1) = NEXT OUTPUT ADDRESS.
*                (LM - LM+1) = LIMIT ADDRESS OF CM BUFFER.
*
*         EXIT   (A) = WORD COUNT OF BUFFER.
*                RESETS (IN - IN+1).
*
*         CALLS  CFL.
*
*         USES   CM - CM+4.
 
 
 COB      SUBR               ENTRY/EXIT
          FETA   2           READ IN
          CRD    CM
          LDD    CM+3        SET IN
          LPN    77
          STD    IN
          SHN    14
          LMD    CM+4
          STD    IN+1
          RJM    CFL         CHECK ADDRESS
          LDD    IN          LENGTH = IN - OUT
          SBD    OT
          SHN    14
          ADD    IN+1
          SBD    OT+1
          PJN    COBX        RETURN IF IN .GE. OUT
          SHN    6           LENGTH = (LIMIT - OUT) + (IN - FIRST)
          ADD    LM
          SBD    FT
          SHN    14
          ADD    LM+1
          SBD    FT+1
          UJN    COBX        RETURN
 DV3      SPACE  4,10
**        DV3 - DIVIDE BY 3.
*
*         DV3 USES THE APPROXIMATION N/3 = (85*N + 22*N/64) / 256.
*         ROUNDING UP IS DONE.
*
*         ENTRY  (A) = NUMBER.
*
*         EXIT   (A) = NUMBER / 3.
*
*         CALLS  NONE.
*
*         USES   T0, T2.
 
 
 DV3      SUBR               ENTRY/EXIT
          ADN    2           ROUND UP
          STD    T2          SAVE N
          SHN    2           N*4
          ADD    T2          N*5
          SHN    1           N*10
          ADD    T2          N*11
          SHN    1+14        N*22/64
          STD    T0
          SHN    6           N*22
          SBD    T2          N*21
          SHN    2           N*84
          ADD    T2          N*85
          ADD    T0          N*85 + N*22/64
          SHN    -10         (N*85 + N*22/64) / 256
          LJM    DV3X        RETURN
 GMT      SPACE  4,10
**        GMT - GET MESSAGE TYPE.
*
*         ENTRY  64 BYTE MESSAGE STARTING AT BUFR.
*         ENTRY  (BUFR) = START OF 64 BYTE M860 MESSAGE.
*
*         EXIT   (A) = MESSAGE TYPE(BYTE 4 OF MESSAGE).
*
*         CALLS  NONE.
*
*         USES   NONE.
 
 
 GMT      SUBR               ENTRY/EXIT
          LDM    BUFR+2      UPPER 4 BITS OF TYPE
          LPN    0#F
          SHN    14
          LMM    BUFR+3
          SHN    -8D         POSITION MESSAGE TYPE
          UJN    GMTX        RETURN
 IBP      SPACE  4,10
**        IBP - INITIALIZE AND CHECK BUFFER PARAMETERS.
*
*         ENTRY  (FE - FE+1) = FET ADDRESS.
*
*         EXIT   FT, IN, OT, AND LM INITIALIZED.
*
*         CALLS  CFL.
*
*         USES   T1 - T5, CM - CM+4.
 
 
 IBP      SUBR               ENTRY/EXIT
          FETA   1
          CRD    CM          READ FIRST
          ADN    1
          CRD    T1          READ IN
          ADN    2
          CRD    LM-3        READ LIMIT
          SBN    1
          CRD    OT-3        READ OUT
          LDD    CM+3
          LPN    77
          STD    FT
          LDD    CM+4
          STD    FT+1
          LDD    LM
          LPN    77
          STD    LM
          SHN    14
          ADD    LM+1
          SBN    1           ALLOW LIMIT = FL
          RJM    CFL         CHECK ADDRESS
          LDD    OT          CHECK OUT
          SBD    LM
          SHN    14
          ADD    OT+1
          SBD    LM+1
          PJN    IBP1        IF OUT GE LIMIT
          LDD    OT
          SBD    FT
          SHN    14
          ADD    OT+1
          SBD    FT+1
          MJN    IBP1        IF OUT LT FIRST
          LDD    T1+4
          STD    IN+1
          LDD    T1+3
          LPN    77
          STD    IN
          SBD    LM          CHECK IN
          SHN    14
          ADD    IN+1
          SBD    LM+1
          PJN    IBP1        IF IN GE LIMIT
          LDD    IN
          SBD    FT
          SHN    14
          ADD    IN+1
          SBD    FT+1
          PJN    IBP2        IF IN GE FIRST
 IBP1     ERROR  RCBARG      BUFFER ARGUMENT ERROR
 
 IBP2     LJM    IBPX        RETURN
 RMB      SPACE  4,10
**        RMB - READ MESSAGE BUFFER.
*
*         ENTRY  (WC) = CM WORD COUNT.
*
*         EXIT   OUT POINTER UPDATED IN (OT - OT+1).
*
*         CALLS  NONE.
*
*         USES   T3, OT - OT+1, WC.
 
 
 RMB      SUBR               ENTRY/EXIT
          LDC    BUFR
          STM    RMBA        PP BUFFER ADDRESS
          LDD    LM
          SBD    OT
          SHN    14
          ADD    LM+1
          SBD    OT+1
          STD    T3          WORD COUNT TO LIMIT
          SBD    WC
          MJN    RMB4        IF WRAPAROUND
 RMB2     LDCA   OT
          CRM    **,WC
 RMBA     EQU    *-1
          LDD    WC
          RAD    OT+1
          SHN    -14
          RAD    OT          UPDATE OUT
          LMD    LM
          NJN    RMB3        IF OUT NE LIMIT
          LDD    OT+1
          LMD    LM+1
          NJN    RMB3        IF OUT NE LIMIT
          LDD    FT
          STD    OT          SET OUT = FIRST
          LDD    FT+1
          STD    OT+1
 RMB3     LJM    RMBX        RETURN
 
 RMB4     LDCA   OT
          CRM    BUFR,T3
          LDD    FT          SET OUT = FIRST
          STD    OT
          LDD    FT+1
          STD    OT+1
          LDD    T3
          SHN    2
          ADD    T3          PP WORD COUNT
          RAM    RMBA        UPDATE PP BUFFER ADDRESS
          LDD    WC
          SBD    T3
          STD    WC          SET NEW WORD COUNT
          LJM    RMB2        READ REMAINING DATA
 SCB      SPACE  4,10
**        SCB - SET COMPLETE BIT.
*
*         ENTRY  (A) = ENDING STATUS.
*                (EC) = ERROR CODE.
*
*         EXIT   FET UPDATED.
*                (EC) = 0.
*
*         CALLS  REL.
*
*         USES   CM - CM+4, CN.
 
 
 SCB      SUBR               ENTRY/EXIT
          STD    CN          SAVE STATUS
          RJM    REL         RELEASE CHANNEL
          FETA
          CRD    CM          READ FET STATUS WORD
          LDD    CM+3        CLEAR ANY EXISTING STATUS
          SCN    77
          STD    CM+3
          LDD    CM+4
          LPC    776
          STD    CM+4
          LDD    EC
          SHN    12          POSITION ERROR CODE
          LMD    CN          SET STATUS
          LMD    CM+4        RESTORE FUNCTION CODE
          LMN    1           INSURE COMPLETE STATUS
          STD    CM+4
          SHN    -14
          RAD    CM+3        SET ERROR CODE
          FETA
          CWD    CM          UPDATE FET
          LDN    0
          STD    EC          CLEAR ERROR CODE
          LJM    SCBX        RETURN
 UCO      SPACE  4,10
**        UCO - UPDATE CENTRAL OUT.
*
*         ENTRY  (FE) = FET ADDRESS.
*                (OT - OT+1) = OUT POINTER.
*
*         EXIT   OUT UPDATED IN FET.
*
*         CALLS  NONE.
*
*         USES   CM - CM+4.
 
 
 UCO      SUBR               ENTRY/EXIT
          LDN    ZERL
          CRD    CM
          LDD    OT
          STD    CM+3
          LDD    OT+1
          STD    CM+4
          FETA   3
          CWD    CM          UPDATE OUT
          UJN    UCOX        RETURN
 WBB      SPACE  4,10
**        WBB - WRITE BINARY BUFFER.
*
*         ENTRY  (WC) = CM WORD COUNT.
*
*         EXIT   IN POINTER UPDATER IN FET.
*
*         CALLS  NONE.
*
*         USES   T3, CM - CM+4, WC.
 
 
 WBB1     LDN    ZERL        UPDATE IN POINTER IN FET
          CRD    CM
          LDD    IN
          STD    CM+3
          LDD    IN+1
          STD    CM+4
          FETA   2
          CWD    CM
 
 WBB      SUBR               ENTRY/EXIT
          LDC    PBUF
          STM    WBBA        PPU BUFFER ADDRESS
          LDD    LM
          SBD    IN
          SHN    14
          ADD    LM+1
          SBD    IN+1
          STD    T3          WORD COUNT TO LIMIT
          SBD    WC
          MJN    WBB4        IF WRAPAROUND
 WBB2     LDCA   IN
          CWM    **,WC       WRITE DATA TO BUFFER
 WBBA     EQU    *-1
          LDD    WC
          RAD    IN+1
          SHN    -14
          RAD    IN
          LMD    LM
          NJN    WBB3        IF IN NE LIMIT
          LDD    IN+1
          LMD    LM+1
          NJN    WBB3        IF IN NE LIMIT
          LDD    FT          SET IN = FIRST
          STD    IN
          LDD    FT+1
          STD    IN+1
 WBB3     LJM    WBB1        UPDATE CENTRAL IN
 
 WBB4     LDCA   IN
          CWM    PBUF,T3
          LDD    FT          SET IN = FIRST
          STD    IN
          LDD    FT+1
          STD    IN+1
          LDD    T3          UPDATE PP BUFFER ADDRESS
          SHN    2
          ADD    T3
          RAM    WBBA
          LDD    WC
          SBD    T3
          STD    WC          SET REMAINING WORD COUNT
          LJM    WBB2        READ REMAINING DATA
 WMB      SPACE  4,10
**        WMB - WRITE MESSAGE BUFFER.
*
*         ENTRY  (WC) = CM WORD COUNT.
*
*         EXIT   IN POINTER UPDATED IN PP.
*
*         CALLS  NONE.
*
*         USES   T3, IN - IN+1, WC.
 
 
 WMB      SUBR               ENTRY/EXIT
          LDC    BUFR
          STM    WMBA        PPU BUFFER ADDRESS
          LDD    LM
          SBD    IN
          SHN    14
          ADD    LM+1
          SBD    IN+1
          STD    T3          WORD COUNT TO LIMIT
          SBD    WC
          MJN    WMB4        IF WRAPAROUND
 WMB2     LDCA   IN
          CWM    **,WC       WRITE DATA TO BUFFER
 WMBA     EQU    *-1
          LDD    WC
          RAD    IN+1
          SHN    -14
          RAD    IN
          LMD    LM
          NJN    WMB3        IF IN NE LIMIT
          LDD    IN+1
          LMD    LM+1
          NJN    WMB3        IF IN NE LIMIT
          LDD    FT          SET IN = FIRST
          STD    IN
          LDD    FT+1
          STD    IN+1
 WMB3     LJM    WMBX        UPDATE CENTRAL IN
 
 WMB4     LDCA   IN
          CWM    BUFR,T3
          LDD    FT          SET IN = FIRST
          STD    IN
          LDD    FT+1
          STD    IN+1
          LDD    T3          UPDATE PP BUFFER ADDRESS
          SHN    2
          ADD    T3
          RAM    WMBA
          LDD    WC
          SBD    T3
          STD    WC          SET REMAINING WORD COUNT
          LJM    WMB2        READ REMAINING DATA
          SPACE  4,10
*         COMMON DECKS.
 
 
 RND$     EQU    1           ROUND UP
*CALL     COMPDV5
          TITLE  PRESET.
          USE    PRESET
 OVLA     EQU    *+5         OVERLAY LOAD ADDRESS
 BUFR     EQU    *           MESSAGE BUFFER
 PBUF     EQU    BUFR        PRU BUFFER
 HBUF     EQU    PBUF+PRUL*5     STRIPE HEADER BUFFER
 TBUF     EQU    HBUF+HDRL*5     STRIPE TRAILER BUFFER
 LBUF     EQU    TBUF+TLRL*5 LENGTH OF ALL BUFFERS
          ERRNG  7776-LBUF   BUFFER OVERFLOW
          ERRNG  7777-BUFR-PRUL        MESSAGE BUFFER OVERFLOW
 PRS      SPACE  4,10
*         PRS - PRESET.
 
 
 PRS      SUBR               ENTRY/EXIT
          LDN    0
          STD    EC          CLEAR ERROR CODE
          STD    MW          CLEAR MESSAGE WAITING FLAGS
          LDC    IPLM
          STD    IC          SET IDLE PASS LIMIT
          LDD    IR+3
          LPN    77
          SHN    14
          ADD    IR+4
          RJM    CFL
          CRD    CN          READ PARAMETER WORD
          LDD    CN+3
          STD    ES          EST ORDINAL FOR CONTROL UNIT
          SFA    EST,ES      GET EST ENTRY ADDRESS
          CRD    CM          READ EST ENTRY
          LDD    CM+4
          LPC    7000
          STD    EQ          EQUIPMENT NUMBER
          LDD    IR+3
          SHN    -6          FUNCTION CODE
          STD    T1
          ZJN    PRS0        IF NO FUNCTION
          SBN    TREQL
          MJN    PRS2        IF VALID FUNCTION
 PRS0     LDC    =C*1SS - INVALID FUNCTION.*
          RJM    DFM
 PRS1     LJM    DPP         DROP
 
 PRS2     LDM    TREQ,T1
          STD    T1
          LJM    0,T1        INITIALIZE FOR FUNCTION
 
*         SCH - SET CHANNELS IN EST
 
 SCH      LDD    ES
          STD    CM+1        EQUIPMENT NUMBER
          LDD    IR+2
          STD    CM+3        CHANNELS
          LDN    2           SET CHANNELS SUBFUNCTION
          STD    CM+2
          MONITOR SEQM       SET CHANNELS
          UJN    PRS1        DROP PP
 
*         ETD - ENABLE TDAM REQUEST BUFFER
 
 ETD      NFA    ICAN
          CRD    CM
          LDD    CM
          LPC    3777
          ADC    4000        ENABLE PP *TDAM* WRITE
          STD    CM
          NFA    ICAN        UPDATE INTER-CONTROL POINT CONTROLS
          CWD    CM
          UJN    PRS1        DROP
 
*         MSG - INITIALIZE FOR MESSAGE I/O
 
 MSG      LDD    CN+1
          SCN    77
          SHN    6
          LMD    CN
          SHN    6
          STM    SSDA        INITIALIZE MESSAGE OUTPUT ADDRESS
          SHN    -14
          RAM    SSDA-1
          LPN    77
          SHN    14
          LMM    SSDA
          ADN    4           LIMIT WORD
          RJM    CFL         CHECK ADDRESS
          CRD    T7          READ LIMIT WORD
          SBN    4+1
          CRD    CM          READ POINTER TO MESSAGE OUTPUT FET
          LDC    TCHS        CHANNEL INSTRUCTION LIST
          STD    T1
 PRS3     LDI    T1
          ZJN    PRS4        IF END OF LIST
          STD    T2
          LDI    T2
          SCN    37
          ADD    T7          SET CHANNEL
          STI    T2
          AOD    T1          ADVANCE LIST
          UJN    PRS3        SET NEXT ENTRY
 
 PRS4     LDD    CM+3
          LPN    77
          RAM    SSDB-1      INITIALIZE MESSAGE INPUT FET ADDRESS
          LPN    77
          SHN    14
          LMD    CM+4
          STM    SSDB
          RJM    CFL         CHECK ADDRESS
          LDD    CN+1        SET DRIVER RECALL ADDRESS
          LPN    77
          STD    DR
          SHN    14
          ADD    CN+2
          STD    DR+1
          RJM    CFL         CHECK FIELDLENGTH
          LDD    CP
          ADN    SNSW
          CRD    CM          READ SENSE SWITCH WORD
          LDD    CM+4
          SHN    21-6
          MJN    PRS5        IF TRACE MODE REQUESTED
          LJM    PRSX        RETURN
 
 PRS5     AOM    TRCA
          AOM    TRCB
          AOM    TRCC
          AOM    TRCD
          AOM    TRCE
          AOM    TRCF
          AOM    TRCG
          LJM    PRSX        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
*         TREQ - TABLE OF LEGAL FUNCTION PRESET ROUTINES.
 
 
 TREQ     BSS    0
          LOC    0
          CON    0           NULL FUNCTION
 IRTDAM   CON    ETD         ENABLE TDAM BUFFER
 IRPMSG   CON    MSG         MESSAGE I/O
 IRMDAT   CON    MSG         MESSAGE AND DATA I/O
 IRCHAN   CON    SCH         SET CHANNELS IN EST
          LOC    *O
 TREQL    EQU    *-TREQ
          TITLE  2SS - ERROR MESSAGE OVERLAY.
          IDENT  2SS,EMSX
*COMMENT  1SS - ERROR MESSAGE OVERLAY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
***       2SS - ERROR MESSAGE OVERLAY.
*
*         2SS IS CALLED BY 1SS TO ISSUE ERROR MESSAGES
*         TO THE MSAS SUBSYSTEM LOCAL DAYFILE WHEN AN
*         ERROR IS DETECTED.
*
*         ENTRY
*
*         (ERR) = PP ADDRESS WHERE ERROR DETECTED.
*         (GSTS) = START OF HAEDWARE STATUS BUFFER(25 WORDS).
*
*         EXIT
*         MESSAGES ISSUED.
*
*
*         MESSAGE FOR ALL ERRORS.
*
*         ERR = XX, ADR YYYY.
*
*         XX     ERROR CODE (SEE COMBCDD).
*         YYYY   PP ADDRESS WHERE ERROR DETECTED.
*
*         HARDWARE ERROR MESSAGES.
*
*         SS,CXX,GSSSSSSSSSSSS.
*         SS,CXX,FYYYYYYYYYYYYYYYYYYYY.
*         SS,CXX,DZZZZ. MESSAGE.
*
*         WHERE.
*         XX = CHANNEL.
*         SS...S = GENERAL STATUS.
*         YY...Y = FSC STATUS.
*         ZZZZ = DIAGNOSTIC STATUS.
*         MESSAGE = ONE OF THE FOLLOWING.
*         STATUS ERROR. = ALERT STATUS AND NONE OF THE FOLLOWING.
*         INPUT HANG. = CHANNEL HUNG ON INPUT OPERATION.
*         OUTPUT HANG. = CHANNEL HUNG ON OUTPUT OPERATION.
*         FUNCTION TIMEOUT. = NO RESPONSE TO FUNCTION IN 2 SECONDS.
*         NO EOP. = NO ENDING STATUS FROM M860 IN 6 SECONDS.
*         CHAN. MALF. = NO RESPONSE TO DIAGNOSTIC STATUS FUNCTION.
*         CHAN. PE. = FSC DETECTED CHANNEL A CHANNEL PARITY ERROR.
*         FSC MEM. PE. = FSC HAD A MEMORY PARITY ERROR.
*         FSC NOT RUNNING. = FSC PROCESSOR WAS NOT RUNNING.
*         FSC ABNORMAL. = FSC ABNORMAL STATUS.
          EJECT
 EMS      SPACE  0
**        EMS - ERROR MESSAGE PROCESSOR
*
*         ENTRY  (EC) = ERROR CODE.
*                (GSTS) = STATUS BUFFER.
*
*         EXIT   MESSAGES ISSUED.
*
*         USES   T1, T2, CN, IN, OT, LM.
*
*         CALLS  C2D.
 
 
          ORG    OVLA
 EMS      SUBR               ENTRY/EXIT
          LDD    CP
          ADN    SNSW
          CRD    CM          READ SENSE SWITCH WORD
          LDD    CM+4
          SHN    21-6
          MJN    EMS00       IF TRACE MODE
          LDD    EC
          SBN    RCHWET
          MJN    EMSX        IF NOT HARDWARE ERROR
          LJM    EMS0        MUST BE HARDWARE ERROR
 
 EMS00    LDM    ERRT-1,EC
          STD    T1          GET ERROR TYPE MESSAGE
          LDI    T1
          STM    EMSE
          LDM    1,T1
          STM    EMSE+1
          LDM    2,T1
          STM    EMSE+2
          LDM    ERR         GET ADDRESS WHERE DETECTED
          SBN    3
          SHN    -6
          RJM    C2D         UPPER DIGITS
          STM    EMSE+6
          LDM    ERR
          SBN    3
          RJM    C2D         LOWRE DIGITS
          STM    EMSE+7
          LDC    EMSE+CPON
          RJM    DFM         ISSUE MESSAGE
          LDD    EC
          SBN    RCHWET
          PJN    EMS0        IF HARDWARE ERROR
          LJM    EMSX        RETURN
 
 EMS0     LDM    CHAN        GET CHANNEL USED
          RJM    C2D         CONVERT TO DISPLAY
          STM    EMSA+2      STORE IN MESSAGES
          STM    EMSB+2
          STM    EMSC+2
          LDC    GSTS        GENERAL STATUS BUFFER
          STD    IN
          LDC    EMSA+4
          STD    OT
 EMS1     LDI    IN
          SHN    -6
          RJM    C2D         CONVERT UPPER 2 DIGITS
          STI    OT
          AOD    OT
          LDI    IN
          RJM    C2D         CONVERT LOWER 2 DIGITS
          STI    OT
          AOD    OT
          AOD    IN
          LMC    FSTS
          NJN    EMS1        IF NOT AT FSC STATUS
          LDC    EMSA+CPON
          RJM    DFM         ISSUE MESSAGE TO CONTROL POINT DAYFILE
          LDN    4           SET UP FOR 4 MESSAGES OF 5 BUTES EACH
          STD    CN
 EMS2     LDD    IN
          ADN    5
          STD    LM
          LDC    EMSB+4
          STD    OT
 EMS3     LDI    IN
          SHN    -6
          RJM    C2D         CONVERT LOWER 2 DIGITS
          STI    OT
          AOD    OT
          LDI    IN
          RJM    C2D         CONVERT LOWER 2 DIGITS
          STI    OT
          AOD    OT
          AOD    IN
          LMD    LM
          NJN    EMS3        IF NOT 5 BYTES MOVED
          LDC    EMSB+CPON
          RJM    DFM         ISSUE MESSAGE TO CONTROL POINT DAYFILE
          SOD    CN
          NJN    EMS2        IF NOT 4 MESSAGES
          LDM    DSTS        GET DIAGNOSTIC STATUS
          SHN    -6
          RJM    C2D         CONVERT UPPER 2 DIGITS
          STM    EMSC+4
          LDM    DSTS
          RJM    C2D         CONVERT LOWER 2 DIGITS
          STM    EMSC+5
          LDC    EMSD        MOVE MESSAGE
          STD    OT
          LDD    EC          ERROR CODE TO SSEXEC
          SBN    RCHWET      REMOVE HARDWARE ERROR BIAS
          STD    T1
          LDM    EMST,T1     ADDRESS OF SPECIFIC MESSAGE
          STD    IN
 EMS4     LDI    IN
          STI    OT          MOVE MESSAGE
          ZJN    EMS5        IF END OF MESSAGE
          AOD    IN
          AOD    OT
          UJN    EMS4        FINISH MOVE
 
 EMS5     LDC    EMSC+CPON
          RJM    DFM         ISSUE MESSAGE TO CONTROL POINT DAYFILE
          LJM    EMSX        RETURN
 
 
 EMSA     DIS    ,*SS,CXX,GSSSSSSSSSSSS.*
 EMSB     DIS    ,*SS,CXX,FXXXXXXXXXXXXXXXXXXXX.*
 EMSC     DATA   14HSS,CXX,DZZZZ,
 EMSD     BSS    30          SPECIFIC ERROR MESSAGE
 EMSE     DIS    ,*RCXXXX, ADR YYYY.*
          SPACE  4,10
*         EMST - TABLE OF SPECIFIC ERROR MESSAGES.
 
 
 EMST     BSS    0
          CON    =C*STATUS ERROR.*
          CON    =C*INPUT HANG.*
          CON    =C*OUTPUT HANG.*
          CON    =C*FUNCTION TIMEOUT.*
          CON    =C*NO EOP.*
          CON    =C*CHAN. MALF.*
          CON    =C*CHAN. PE.*
          CON    =C*CCC MEM. PE.*
          CON    =C*CCC NOT RUNNING.*
          CON    =C*CCC ABNORMAL.*
          CON    =C*DIAGNOSTIC FAILURE.*
          CON    0           CPU ONLY ERROR CODE
          CON    =C*OPERATOR IMPL REQUIRED.*
          CON    =C*CHANNEL INTERFACE OFF LINE.*
 ERRT     SPACE  4,10
**        ERRT - TABLE OF ERROR RETURN CODES.
 
 
 ERRT     BSS    0
          CON    =6HRCILLF   ILLEGAL FUNCTION
          CON    =6HRCDLER   DATA LENGTH ERROR
          CON    =6HRCCWER   CONTROL WORD ERROR
          CON    =6HRCBARG   BUFFER ARGUMENT ERROR
          CON    =6HRCHDER   HEADER/TRAILER ERROR
          CON    =6HRCENDV   END OF VOLUME
          CON    =6HRCILLU   ILLEGAL UNIT NUMBER
          CON    =6HRCBFTO   BUFFER TIMEOUT ERROR
          CON    =6HRCTBRT   TAPE BOTTOM RIGHT
          CON    =6HRCTERF   TERMINATE FLAG DETECTED
          CON    =6HNO ERR
          CON    =6HNO ERR
          CON    =6HNO ERR
          CON    =6HNO ERR
          CON    =6HNO ERR
          CON    =6HRCSTER   STATUS ERROR
          CON    =6HRCCHIN   CHANNEL HUNG ON INPUT
          CON    =6HRCCHOT   CHANNEL HUNG ON OUTPUT
          CON    =6HRCFCTO   FUNCTION TIMEOUT
          CON    =6HRCNEOP   NO END OF OPERATION
          CON    =6HRCCHMF   CHANNEL MALFUNCTION
          CON    =6HRCCHPE   CHANNEL PARITY ERROR
          CON    =6HRCFSPE   FSC MEMORY PARITY ERR
          CON    =6HRCFSNR   FSC NOT RUNNING
          CON    =6HRCFSAB   FSC ABNORMAL
          CON    =6HRCFSDF   FSC DIAGNOSTIC FAILURE
          CON    =6HRCXSUM   XSUM ERROR (CM DRIVER)
          CON    =6HRCIMPL   OPERATOR IMPL REQUIRED
          CON    =6HRCCIFO   M860 CHANNEL OFFLINE
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMPC2D
          SPACE  4,10
          END
Retro1.org codex

Table of Contents

1SS

Table Of Contents

Source Code
