Retro1.org codex

          IDENT  MST,FET 
          ABS
          SST    FL
          ENTRY  MST
          ENTRY  MFL=
          ENTRY  SSJ=
          SYSCOM B1
*COMMENT  MST - MASS STORAGE TEST.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  MST - MASS STORAGE TEST.
          SPACE  4
***       MST - MASS STORAGE TEST.
*         G. R. MANSFIELD.  70/12/06.
*         MODIFIED BY W. E. GOEBEL.  74/01/21.
          SPACE  4
***       MST IS A CENTRAL PROCESSOR DRIVEN MASS STORAGE TEST.  IT
*         PERFORMS SEQUENTIAL WRITES, READS AND POSITIONS ALONG WITH
*         RANDOM READS AND WRITES ON A SELECTED MASS STORAGE DEVICE.
*
*         OPERATING INSTRUCTIONS.
*         WHEN CALLED, MST WILL REQUEST ASSIGNMENT OF THE FILE *DISK1*.
*
*         SEQUENTIAL WRITE.
*         RANDOM DATA IS WRITTEN SEQUENTIALLY ON THE FILE IN THIS
*         FORMAT -           1 WORD CONTAINING JSN, MFID AND PRU NUMBER
*                            1 WORD CONTAINING RANDOM DATA SEED
*                            61 WORDS OF RANDOM DATA
*                            1 WORD CHECKSUM OF ABOVE DATA
*
*         SEQUENTIAL READ.
*         FILE IS REWOUND AND DATA IS READ BACK CHECKING SECTOR NUMBER
*         AND CHECKSUM OF RANDOM DATA.
*
*         SEQUENTIAL POSITIONING.
*         FILE IS POSITIONED ALTERNATELY TO SUCCESSIVE SECTORS
*         FROM BEGINING TO END.
*
*         RANDOM READ.
*         RANDOM SECTOR NUMBERS ARE PICKED AND THE SECTORS READ.
*         THE SECTOR NUMBER IS CHECKED AND THE DATA CHECKSUM VERIFIED.
*
*         RANDOM WRITE.
*         RANDOM SECTOR NUMBERS ARE PICKED AND THE SECTORS ARE WRITTEN.
*         A SEQUENTIAL READ IS PERFORMED TO VERIFY THE WRITTEN DATA.
*
*         FOR BUFFERED DISKS THERE IS A THREE SECOND PAUSE FOLLOWING
*         EACH SECTION TO ALLOW I/O ACTIVITY TO COMPLETE ON THE
*         DISK BEFORE CONTINUING TO THE NEXT SECTION.
          SPACE  4
***       ARGUMENT PARAMETERS.
*
*         T      TEST SECTION (CAN BE EQUATED).
*                 T=0 OR T OR OMISSION OF THIS PARAMETER WILL RUN ALL
*                     SECTIONS.
*                 T=1 WRITE SEQUENTIAL.
*                 T=2 READ SEQUENTIAL.
*                 T=3 POSITION SEQUENTIAL.
*                 T=4 RANDOM READ.
*                 T=5 RANDOM WRITE.
*
*         P      TEST PATTERN (CAN BE EQUATED).
*                 P=0 ALL ZEROS PATTERN.
*                 P=1 ALL ONES PATTERN.
*                 P=2 25252525252525252525B PATTERN.
*                 P=3 52525252525252525252B PATTERN.
*                 P=4 DO NOT GENERATE OR CHECK DATA.  THE SECTOR
*                     NUMBER, JSN AND MFID IS GENERATED AND CHECKED
*                     FOR EACH SECTOR.
*                 P=5 OR P OR OMISSION OF THIS PARAMETER WILL ENABLE
*                     RANDOM PATTERN.
*                 P=6 DO NOT GENERATE OR CHECK DATA.  DO NOT COPY DATA
*                     BETWEEN THE CIO BUFFER AND THE WORKING BUFFER.
*                     THE SECTOR NUMBER, JSN AND MFID IS GENERATED AND
*                     CHECKED FOR EACH SECTOR.
*
*         N      NUMBER OF SECTORS (CAN BE EQUATED).
*                 N=0 GIVES ARGUMENT ERROR MESSAGE AND PROGRAM ABORT.
*                 N=XXXXXXX WILL RUN THE TEST ON XXXXXXX SECTORS.
*                   IF TOO LARGE A VALUE OF XXXXXXX IS SPECIFIED,
*                   A TRACK LIMIT WILL RESULT.
*                 N=* WILL TEST ALL AVAILABLE SECTORS.
*                   IF SPECIFIED ON A DEVICE WITH OTHER ACTIVITY,
*                   A TRACK LIMIT MAY RESULT.
*
*         NW     NO WRITE PERFORMED AT BEGINING OF TEST.
*
*         TL     TRANSFER LENGTH IN SECTORS FOR RANDOM I/O.
*                DEFAULT IS 10B SECTORS.
*
*         NV     IF SPECIFIED, DO NOT PERFORM SEQUENTIAL READ AFTER
*                RANDOM WRITE.
*
*         RO     IF SPECIFIED, SIMULATE ROLLIN/ROLLOUT I/O ON BUFFERED
*                DEVICES.
*
*         IO     IF SPECIFIED, GIVES THE NUMBER OF I/O-S TO BE
*                PERFORMED ON THE DEVICE.  IF *IO* IS NOT SPECIFIED,
*                THE VALUE FOR NUMBER OF I/O-S IS COMPUTED FROM THE
*                TRANSFER LENGTH.
*
*         NOTE:
*                SENSE SWITCH 2 - IF SET WILL ABORT ON ERRORS.
*                SENSE SWITCH 3 - IF SET WILL CONTINUE AT END OF TEST.
*                SENSE SWITCH 4 - IF SET WILL REPEAT CURRENT SECTION.
*
*                ISSUING A CALL OF MST FROM THE CONSOLE WILL
*                SELECT ALL SECTIONS, RANDOM PATTERN, DEFAULT SECTOR
*                VALUE, PAUSE ON ERROR AND STOP AT END OF TEST.
*                TO CONTINUE ON ERRORS TYPE *GO.*.
*
 MST      SPACE  4
***       DAYFILE MESSAGES.
*
*         * ARGUMENT ERROR.* = ONE OF PARAMETERS IS IN ERROR.
*
*         * ILLEGAL EQUIPMENT.* = THE EQUIPMENT WHICH WAS ASSIGNED IN
*                            RESPONSE TO THE DISPLAY REQUEST IS NOT
*                            RECOGNIZED AS BEING A DEVICE UPON WHICH
*                            THE TEST MAY BE RUN.
*
*         * SEQUENTIAL WRITE.* = THIS TEST SECTION IS BEING EXECUTED.
*
*         * SEQUENTIAL READ.* = THIS TEST SECTION IS BEING EXECUTED.
*
*         * SEQUENTIAL POSITIONING.* = THIS SECTION IS BEING EXECUTED.
*
*         * RANDOM READ.* =  THIS TEST SECTION IS BEING EXECUTED.
*
*         * RANDOM WRITE.* = THIS TEST SECTION IS BEING EXECUTED.
*
*         *MST TRANSFER RATE = XXXXXX.XXX KC.* = THE DISK TRANSFER
*                            RATE FOR THE PREVIOUS SECTION WAS
*                            XXXXXX.XXX KILO-CHARACTERS PER SECOND.
*
*         *  NUMBER OF I/O-S = XXXXXXXXXX.* = THE NUMBER OF IO PAIRS
*                            SPECIFIED WITH THE *IO* PARAMETER OR
*                            COMPUTED FROM THE *NL* PARAMETER.
*
*         *    IO PER SECONDS = XXXXXX.XXX.* = NUMBER OF IO-S PERFORMED
*                            PER SECOND.
*
*         *      FILE SIZE = XXXXXXXXXX SECTORS.* = SIZE OF THE DATA
*                            FILE IN SECTORS.*
*
*         * ILLEGAL EOF DETECTED.* = AN EOF WAS DETECTED BEFORE THE
*                            LAST SECTOR ON THE FILE.
*
*         * NO EOF DETECTED ON LAST READ.* = NO EOF ON THE LAST SECTOR.
*
*         * JOB ABORTED.* = ABNORMAL TERMINATION OF MST.
*
*         *EQXXX,DATA ERROR AT -PHYSICAL POSITION-.*
*         *EQXXX,RXXXXXXX,TYYYY,SZZZZ.*
*                            DATA ERRORS HAVE BEEN DETECTED ON A
*                            SECTOR WHICH WAS READ.
*
*         *EQXXX,POS. ERROR AT -PHYSICAL POSITION-.*
*         *EQXXX,RXXXXXXX,TYYYY,SZZZZ.*
*                            THE SECTOR WHICH WAS READ WAS NOT
*                            THE CORRECT SECTOR.  THE POSITION GIVEN
*                            IS THE POSITION OF THE SECTOR READ.
*
*         *EQXXX,DEV.-TYPE ERR--PHYSICAL POSITION-.*
*         *EQXXX,RXXXXXXX,TYYYY,SZZZZ.*
*                            CIO HAS DETECTED ONE OF THE FOLLOWING
*                            ERRORS WHICH APPEAR IN THE -TYPE ERR-
*                            POSITION.
*                    -TYPE ERR- = PARITY ER.  -- PARITY ERROR
*                                 ADDR. ERR.  -- ADDRESS ERROR
*                                 STATUS ER.  -- DEVICE STATUS ERROR
*                                 81 FNC REJ  -- 6681 FUNCTION REJECT
*                                 RESERVED    -- DEVICE RESERVED
*                                 NOT READY   -- DEVICE NOT READY
*
*         *EQXXX,EXP. POSITION -PHYSICAL POSITION-.*
*         *EQXXX,RXXXXXXX,TYYYY,SZZZZ.*
*                            WHEN A POSITION OR DEVICE ADDRESS ERROR
*                            OCCURES THE EXPECTED POSITION IS GIVEN
*                            BY THIS MESSAGE.
*
*         *EQXXX,DATA EXP  WWW,EEEEEEEEEEEEEEEEEEEE*
*         *EQXXX,DATA READ WWW,RRRRRRRRRRRRRRRRRRRR*
*         *EQXXX,DATA DIFF WWW,DDDDDDDDDDDDDDDDDDDD*
*         *DATA OK.*  (OPTIONAL - SEE BELOW)
*                            WHEN A DATA ERROR OR DEVICE PARITY ERROR IS
*                            DETECTED THE DATA ON THE SECTOR IS CHECKED
*                            AND THE ERRORS REPORTED.  IF NO ERRORS ARE
*                            FOUND THE MESSAGE *DATA OK.* IS ISSUED.
*                                 WWW IS THE WORD NUMBER IN THE SECTOR.
*                                 EE-----E IS THE EXPECTED DATA.
*                                 RR-----R IS THE DATA READ.
*                                 DD-----D IS THE DIFFERNCE.
*
*         * MST ERROR - GO / DROP.* = *MST* HAS DETECTED AN
*                            IRRECOVERABLE READ ERROR.
*
*         * END MASS STORAGE TEST.* = END OF TEST.
          SPACE  4
**        COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSCIO
*CALL     COMSMSP
          SPACE  4
****      ASSEMBLY CONSTANTS.
 
 
 DBUFL    EQU    4001B
****
          TITLE  DATA.
 FET      SPACE  4
*         FILE FET.
 
 
          ORG    110B
 FET      BSS    0
 D        BSS    0
 DISK1    RFILEB DBUF,DBUFL,(FET=8),(DTY=2RMS)
 
*         DATA STORAGE.
 
 
 FL       CON    0           ORIGINAL FIELD LENGTH
 NS       CON    10000B      NUMBER OF SECTORS
 SM       CON    7777B       SECTOR MASK
 NW       CON    0           NO SEQUENTIAL WRITE AT BEGINNING OF TEST
 TS       CON    0L0         TEST SECTION TO BE EXECUTED
 TP       CON    0L5         DEFAULT TEST PATTERN
 ST       CON    0           START TIME
 ET       CON    0           ENDING TIME
 BD       CON    0           BUFFERED DEVICE FLAG
 ND       CON    0           NULL DATA FLAG
 NT       CON    1           NO DATA TRANSFER FLAG
 TL       CON    0L10B       TRANSFER LENGTH
 NV       CON    0           NO VERIFICATION AFTER RANDOM WRITE FLAG
 RO       CON    0           ROLLOUT SIMULATION FLAG
 IO       CON    0           NUMBER OF I/O-S
 JN       CON    0           24/JSN, 12/MAINFRAME ID, 24/0
 EMTS     VFD    1/1,59/0    EXTENDED MEMORY TRACK SHIFT
 
*         SPECIAL ENTRY POINTS.
 
 SSJ=     EQU    0
          TITLE  MAIN PROGRAM.
 MST      SPACE  4
**        MST - MAIN PROGRAM.
 
 
 MST      SB1    1           (B1) = 1
          SB7    B0
          SX6    A0
          SA6    FL
          RJ     PRS         PRESET
 MST1     SA1    NW
          NZ     X1,MST2     IF NO WRITE
          RJ     WSQ         WRITE SEQUENTIAL
          RJ     WIC         WAIT I/O COMPLETE
 MST2     SA1    TS
          ZR     X1,MST3     IF ALL SECTIONS SELECTED
          SB5    X1-1
          ZR     B5,MST7
          SB2    3
          GT     B5,B2,MST6
          EQ     B5,B2,MST5
          GT     B5,B1,MST4
 MST3     RJ     RSQ         READ SEQUENTIAL
          RJ     WIC         WAIT I/O COMPLETE
          SA1    TS
          NZ     X1,MST7
 MST4     RJ     POS         POSITION SEQUENTIAL
          RJ     WIC         WAIT I/O COMPLETE
          SA1    TS
          NZ     X1,MST7
 MST5     RJ     RRD         READ RANDOM
          RJ     WIC         WAIT I/O COMPLETE
          SA1    TS
          NZ     X1,MST7
 MST6     RJ     WRD         WRITE RANDOM
          RJ     WIC         WAIT I/O COMPLETE
          SA1    NV
          NZ     X1,MST7     IF NO VERIFICATION REQUIRED
          RJ     RSQ         READ SEQUENTIAL
 MST7     SA1    B0
          LX1    59-8
          PL     X1,MST8     IF REPEAT TEST NOT SET
          RJ     WIC         WAIT I/O COMPLETE
          EQ     MST1        CONTINUE
 
 MST8     MESSAGE (=C* END MASS STORAGE TEST.*)
          ENDRUN
 
 MSTA     CON    0           TEMPORARY USED BY RSQ AND RRD
          TITLE  TEST SECTIONS.
 WSQ      SPACE  4,15
**        WSQ - WRITE SEQUENTIAL.
*
*         USES   X - 0, 1, 2, 4, 5, 6, 7.
*                A - 1, 5, 6, 7.
*
*         CALLS  AIP, CKS, CTR, GDB, MEM, MES.
*
*         MACROS REWIND, RTIME, WRITEF, WRITEW.
 
 
 WSQ      SUBR               ENTRY/EXIT
          SX6    1           SET SECTORS TO CHECK
          SA6    CKSI
          SA1    FL
          RJ     MEM         REQUEST MEMORY
 WSQ1     REWIND D,R
          SX1    =C* SEQUENTIAL WRITE.*
          RJ     MES         SEND MESSAGE
          SA5    NS          NUMBER OF SECTORS TO WRITE
          BX0    X5
          BX6    X5          SAVE SECTOR COUNT
          SA6    CTRB
          SX5    B1
          RTIME  ST
 WSQ2     SA2    JN          JSN AND MFID
          SA1    TP          GENERATE SECTOR TO WRITE
          BX7    X2+X5
          BX6    X1
          SA7    SBUF
          SA6    SBUF+1
          RJ     GDB         GENERATE DATA BUFFER
          SA7    TP
          SX2    D           SET FET ADDRESS
          SA1    NT
          ZR     X1,WQS3     IF NO DATA TRANSFER
          WRITEW X2,SBUF,100B
          EQ     WQS4        CHECK FOR CIO ERROR
 
 WQS3     RJ     AIP         ADVANCE *IN* POINTER
 WQS4     SX4    B0
          RJ     CKS         CHECK FOR CIO ERROR
          SX6    B1+
          IX5    X5+X6       ADVANCE SECTOR COUNTER
          IX0    X0-X6
          NZ     X0,WSQ2     IF MORE SECTORS TO WRITE
          WRITEF D,R
          RJ     CTR         COMPUTE TRANSFER RATE
          SA1    B0
          LX1    59-9
          NG     X1,WSQ1     IF REPEAT SECTION SET
          EQ     WSQX        RETURN
 RSQ      SPACE  4,15
**        RSQ - READ SEQUENTIAL.
*
*         USES   X - 0, 1, 2, 4, 5, 6, 7.
*                A - 1, 5, 6, 7.
*
*         CALLS  ABT, AOP, CKS, CTR, MEM, MES.
*
*         MACROS MESSAGE, READ, READW, REWIND, RTIME.
 
 
 RSQ      SUBR               ENTRY/EXIT
          SX6    1           SET SECTORS TO CHECK
          SA6    CKSI
          SA1    FL
          RJ     MEM         REQUEST MEMORY
 RSQ1     REWIND D,R
          SX1    =C* SEQUENTIAL READ.*
          RJ     MES         SEND MESSAGE
          SA5    NS          NUMBER OF SECTORS
          BX0    X5
          BX6    X5          SAVE SECTOR COUNT
          SA6    CTRB
          SX5    B0
          RTIME  ST
 RSQ2     READ   D
 RSQ3     SX2    D           SET FET ADDRESS
          SA1    NT
          ZR     X1,RSQ3.1   IF NO DATA TRANSFER
          READW  X2,SBUF,100B
          EQ     RSQ3.2      CHECK FOR EOR/EOF
 
 RSQ3.1   RJ     AOP         ADVANCE *OUT* POINTER
 RSQ3.2   ZR     X1,RSQ3.3   IF NO EOR/EOF DETECTED
          SX1    X1+3        CHECK FOR *CIO* ERROR
          NZ     X1,RSQ5     IF NO *CIO* ERROR
 RSQ3.3   ZR     X0,RSQ4     IF EOF EXPECTED
          SX2    B1
          IX4    X5+X2       ADVANCE EXPECTED SECTOR
          SA5    SBUF
          BX6    X4
          SA6    MSTA        SAVE RANDOM ADDRESS
          IX0    X0-X2       DECREMENT SECTOR COUNTER
          RJ     CKS         CHECK SECTOR
          SA5    MSTA
          ZR     X4,RSQ3     IF NO ERROR DETECTED
          SA1    D+1         RESTART READ ON ERROR
          SX2    B1
          IX7    X5+X2       SET RANDOM ADDRESS TO NEXT SECTOR
          SX6    X1
          SA6    A1+B1
          SA7    D+6
          SA6    A6+B1
          EQ     RSQ2
 
 RSQ4     MESSAGE (=C* NO EOF ON LAST READ.*)
          EQ     RSQ6
 
 RSQ5     ZR     X0,RSQ7     IF EOF EXPECTED
          MESSAGE  (=C* ILLEGAL EOF DETECTED.*)
 RSQ6     RJ     ABT         CHECK FOR ABORT ON ERRORS
 RSQ7     RJ     CTR         COMPUTE TRANSFER RATE
          SA1    B0
          LX1    59-9
          NG     X1,RSQ1     IF REPEAT SECTION
          EQ     RSQX        RETURN
 POS      SPACE  4,15
**        POS - SEQUENTIAL POSITIONING.
*
*         ENTRY  NONE.
*
*         EXIT   NONE.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 2.
*
*         CALLS  CKS, CTR, MES, MTR.
*
*         MACROS READW, REWIND, RPHRLS, RTIME.
 
 
 POS7     RJ     CTR         COMPUTE TRANSFER RATE
          SA1    B0
          LX1    59-9
          NG     X1,POS1     IF REPEAT SECTION SET
 
 POS      SUBR               ENTRY/EXIT
          REWIND D,R
          SX1    MFL=-200000B
          RJ     MEM         REQUEST MEMORY
 POS1     SX1    =C* SEQUENTIAL POSITIONING.*
          RJ     MES         SEND MESSAGE
          BX6    X6-X6       CLEAR SECTOR COUNT
          SA6    CTRB
          RTIME  ST
          SA1    NS
          SX7    B1
          BX0    X0-X0
          LX6    X1
          EQ     POS3
 
 POS2     SX0    X0-40B
          NZ     X0,POS7     IF LAST READ ENCOUNTERED - RETURN
          SA2    A4-B1
          SA1    A2-B1
          BX7    X2
          LX6    X1
 POS3     SA3    POSA
          SA7    TRRD-1
 POS4     IX6    X6-X3       GENERATE LIST OF SECTORS
          IX7    X7+X3
          NG     X6,POS5     IF END OF SECTORS TO READ
          SA6    A7+1
          SA7    A7+2
          SB2    A6-TRRD-36B
          NZ     B2,POS4     IF LIST NOT FULL
 POS5     MX7    0           SET END OF LIST FLAG
          SB2    B1+B1
          SX2    D
          SX6    DBUF        IN = OUT = FIRST
          SA7    A7+B1
          SA6    X2+B2
          SX7    TRRD
          SA6    A6+B1
          SA7    A6+B2       SET LIST ADDRESS
          RPHRLS X2
 POS6     READW  D,SBUF,100B GET SECTOR TO CHECK
          SA4    TRRD+X0
          SA5    SBUF
          ZR     X4,POS2     IF END OF LIST
          RJ     CKS         CHECK SECTOR
          SX0    X0+B1
          SA1    CTRB        COUNT SECTORS
          SX2    B1
          IX6    X1+X2
          SA6    A1
          EQ     POS6        NEXT SECTOR
 
 POSA     CON    0           INCREMENT (SET BY PRESET)
 RRD      SPACE  4,15
**        RRD - RANDOM READ.
*
*         ENTRY  NONE.
*
*         EXIT   NONE.
*
*         USES   X - 0, 1, 4, 5, 6, 7.
*                A - 1, 4, 5, 6, 7.
*                B - NONE.
*
*         CALLS  CIO, CKS, CTR, MES, RNO.
*
*         MACROS READ, RTIME.
 
 
 RRD      SUBR               ENTRY/EXIT
          SA1    TL          REQUEST MEMORY
          BX6    X1
          LX1    6
          SA6    CKSI        SET SECTORS TO READ
          SX1    X1+DBUF+11B
          BX6    X1
          SA6    D+4
          RJ     MEM
 RRD1     SX1    =C* RANDOM READ.*
          RJ     MES         ISSUE MESSAGE
          SA1    TL
          SA5    IO          GET NUMBER OF I/O-S
          BX0    -X5
          SA5    NS          SET NUMBER OF SECTORS TRANSFERED
          AX5    7
          IX6    X1*X5
          SA6    CTRB
          RTIME  ST
 RRD2     SX7    B1          SET RANDOM ADDRESS IN FET
          LX7    29-0
          RJ     RNO         GET RANDOM NUMBER
          SA6    RRDA
          BX7    X6+X7
          SA7    D+6
          SX6    DBUF        SET IN = OUT = FIRST
          SA6    D+2
          SA6    A6+B1
          READ   D,R
          SA5    DBUF        SET ACTUAL RANDOM ADDRESS
          SA4    RRDA        SET EXPECTED RANDOM ADDRESS
          RJ     CKS         CHECK DATA
          SX0    X0+B1       INCREMENT I/O COUNT
          NG     X0,RRD2     IF MORE I/O-S REQUIRED
          RJ     CTR         COMPUTE TRANSFER RATE
          RJ     CIO         COMPUTE I/O RATE
          SA1    B0
          LX1    59-9
          NG     X1,RRD1     IF NOT DONE
          EQ     RRDX        RETURN
 
 RRDA     CON    0           EXPECTED RANDOM ADDRESS
 WRD      SPACE  4,15
**        WRD - RANDOM WRITE.
*
*         ENTRY  NONE.
*
*         EXIT   NONE.
*
*         USES   X - 0, 1, 5, 6, 7.
*                A - 1, 5, 6, 7.
*                B - 4, 5.
*
*         CALLS  CIO, CTR, GDB, MEM, MES, RNO.
*
*         MACROS RTIME, WRITE.
 
 
 WRD      SUBR               ENTRY/EXIT
          SA1    D+1         CLEAR EPR BIT
          SX6    B1
          LX6    44
          BX6    -X6*X1
          SA6    A1
          SA1    TL
          BX6    X1
          SA6    CKSI        SET SECTORS TO CHECK
          LX1    6
          SX1    X1+DBUF+11B
          RJ     MEM
 WRD1     SX1    =C* RANDOM WRITE.*
          RJ     MES         SEND MESSAGE
          SA5    NS
          SA1    TL          REQUEST MEMORY
          AX5    7
          BX0    -X5
          IX6    X1*X5
          SA6    CTRB
          RTIME  ST
 WRD1.1   SA1    TL
          SB4    B0
          SB5    X1
          SX7    B1
          LX7    29
          RJ     RNO         GET RANDOM NUMBER
          SA2    JN          JSN AND MFID
          BX7    X6+X7       SET RANDOM BIT
          SA7    D+6
          BX6    X2+X6       ADD JSN AND MFID TO SECTOR NUMBER
 WRD2     SA6    B4+DBUF
          SA1    TP
          BX6    X1
          SA6    B4+DBUF+1   STORE RANDOM ADDRESS IN FET
          RJ     GDB         GENERATE DATA BUFFER
          SA7    TP
          SA1    B4+DBUF
          SX6    1
          IX6    X1+X6
          SB5    B5-B1
          SB4    B4+100B
          NE     B5,WRD2     IF MORE SECTORS TO GENERATE
          SA1    TL
          LX1    6
          SX6    DBUF
          IX7    X6+X1
          SA6    D+3         OUT = FIRST
          SA7    D+2         IN = FIRST + 64
          WRITE  D,R
          SX6    B1
          IX0    X0+X6       COUNT SECTOR
          NG     X0,WRD1.1   IF MORE SECTORS TO TRANSFER
          RJ     CTR         COMPUTE TRANSFER RATE
          RJ     CIO         COMPUTE I/O RATE
          SA1    B0
          LX1    59-9
          NG     X1,WRD1     IF REPEAT SECTION SET
          SA1    D+1         SET EPR BIT
          SX6    B1
          LX6    44
          BX6    X6+X1
          SA6    A1
          EQ     WRDX        RETURN
          TITLE  SUBROUTINES.
 ABT      SPACE  4,15
**        ABT - ABORT JOB.
*
*         ABORTS JOB IF PAUSE ON ERROR NOT SELECTED.
*
*         EXIT   (X4) = 1.
*
*         USES   X - 1, 4, 7.
*                A - 1, 7.
*                B - NONE.
*
*         MACROS ABORT, MESSAGE, RECALL.
 
 
 ABT      SUBR               ENTRY/EXIT
          SA1    B0
          LX1    59-7
          NG     X1,ABT2     IF ABORT ON ERROR
          SX7    B1+         SET PAUSE BIT
          LX1    7-59
          LX7    12
          BX7    X7+X1
          SA7    A1
          MESSAGE  ABTA,2,R  ISSUE MESSAGE TO SECOND LINE
 ABT1     RECALL
          SA1    B0
          LX1    59-12
          NG     X1,ABT1     IF PAUSE BIT SET
          SX4    B1
          EQ     ABTX        RETURN
 
 ABT2     MESSAGE  (=C* JOB ABORTED.*)
 ABT3     ABORT              ABORT JOB
 
 ABTA     DATA   C*$MST ERROR - GO / DROP.*
 AIP      SPACE  4,20
**        AIP - ADVANCE *IN* POINTER.
*
*         ADVANCE THE *IN* POINTER BY 100B (AS IF A *WRITEW* OF 100B
*         WORDS HAD BEEN PERFORMED), BUT DO NOT TRANSFER THE DATA.
*         COPY ONLY THE FIRST WORD OF THE BLOCK FROM BUFFER *SBUF*
*         TO THE CIO BUFFER.
*
*         ENTRY  (X2) = ADDRESS OF FET FOR FILE.
*
*         EXIT   VIA *WTX=*.
*                (X2) = ADDRESS OF FET FOR FILE.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6.
*                B - 2, 3, 4, 5, 6, 7.
*
*         CALLS  DCB=, WTX=.
 
 
 +        EQ     AIP1        (REENTRY ADDRESS FROM *DCB=*)
 
 AIP      SUBR               ENTRY/EXIT
          SA4    *-1         SET REENTRY/RETURN ADDRESS
          SA1    X2+4        (B5) = LIMIT
          SA3    X2+B1       (X3) = FIRST
          SB5    X1
 
*         REENTER HERE FROM *DCB=*.
 
 AIP1     SA2    X2          (B2) = FET STATUS
          SA1    A3+2        (B4) = OUT
          SB2    X2
          SA2    A3+B1       (X2) = IN
          SB4    X1
          SB3    X2+B1       (B3) = IN+1
          LE     B3,B4,AIP3  IF IN .LT. OUT
 
*         CALCULATE SPACE LEFT IN BUFFER (IN .GE. OUT).
 
          SB7    X3
          SX6    B5-B7       (LIMIT-FIRST)
          SX7    B3-B4       (IN+1-OUT)
          IX6    X6-X7       AVAILABLE SPACE IN BUFFER
          SX7    X6-100B
          NG     X7,DCB=     IF NOT ENOUGH SPACE
 
*         UPDATE BUFFER POINTER (IN .GE. OUT).
 
          SB6    X2+100B     NEW VALUE OF IN
          LT     B6,B5,AIP2  IF NO BUFFER WRAPAROUND
          SB7    B5-B7       (LIMIT-FIRST)
          SB6    B6-B7       NEW VALUE OF IN
 AIP2     SA1    SBUF        COPY FIRST WORD OF BLOCK TO (IN)
          BX6    X1
          SA6    X2
          SX2    B6          SET NEW VALUE OF IN
          EQ     WTX=        EXIT
 
*         CALCULATE SPACE LEFT IN BUFFER (IN .LT. OUT).
 
 AIP3     SX6    B4-B3       AVAILABLE SPACE IN BUFFER
          SX7    X6-100B
          NG     X7,DCB=     IF NOT ENOUGH SPACE IN BUFFER
 
*         UPDATE BUFFER POINTER (IN .LT. OUT).
 
          SB6    X2+100B     NEW VALUE OF IN
          EQ     AIP2        EXIT
 AOP      SPACE  4,20
***       AOP - ADVANCE *OUT* POINTER.
*
*         ADVANCE THE *OUT* POINTER BY 100B (AS IF A *READW* OF 100B
*         WORDS HAD BEEN PERFORMED), BUT DO NOT TRANSFER THE DATA.
*         COPY ONLY THE FIRST WORD OF THE BLOCK FROM THE CIO BUFFER
*         TO BUFFER *SBUF*.
*
*         ENTRY  (X2) = ADDRESS OF FET FOR FILE.
*
*         EXIT   VIA *RDX=*.
*                (X1) = 0 FOR TRANSFER COMPLETE.
*                (X1) = -1 IF EOF DETECTED ON FILE.
*                (X1) = -2 IF EOI DETECTED ON FILE.
*                (X2) = ADDRESS OF FET FOR FILE.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 7.
*                B - 3, 4, 5, 6, 7.
*
*         CALLS  LCB=, RDX=.
 
 
 +        EQ     AOP1        (REENTRY ADDRESS FOR *LCB=*)
 
 AOP      SUBR               ENTRY/EXIT
          SA4    *-1         SET REENTRY/RETURN ADDRESS
          SA1    X2+4        (B5) = LIMIT
          SA3    X2+B1       (X3) = FIRST
          SB5    X1
 
*         REENTER HERE FROM *LCB=*.
 
 AOP1     SA1    A3+B1       (B3) = IN
          SA2    A1+B1       (B4) = OUT
          SB3    X1
          SB4    X2
          LT     B3,B4,AOP3  IF IN .LT. OUT
 
*         CALCULATE DATA AVAILABLE IN BUFFER (IN .GE. OUT).
 
          SX6    B3-B4       AVAILABLE DATA IN BUFFER
          SX7    X6-100B
          NG     X7,LCB=     IF NOT ENOUGH DATA IN BUFFER
 
*         UPDATE BUFFER POINTER (IN .GE. OUT).
 
          SB6    B4+100B     NEW VALUE OF OUT
 AOP2     SA1    B4          COPY FIRST WORD OF BLOCK FROM (OUT)
          BX7    X1
          SA7    SBUF
          SB4    B6          SET NEW VALUE OF OUT
          EQ     RDX=        EXIT
 
*         CALCULATE DATA AVAILABLE IN BUFFER (IN .LT. OUT)
 
 AOP3     SB7    X3
          SX6    B5-B7       (LIMIT-FIRST)
          SX7    B4-B3       (OUT-IN)
          IX6    X6-X7       AVAILABLE DATA IN BUFFER
          SX7    X6-100B
          NG     X7,LCB=     IF NOT ENOUGH DATA IN BUFFER
 
*         UPDATE BUFFER POINTER (IN .LT. OUT).
 
          SB6    B4+100B     NEW VALUE OF OUT
          LT     B6,B5,AOP2  IF NO BUFFER WRAPAROUND
          SB7    B5-B7       (LIMIT-FIRST)
          SB6    B6-B7       NEW VALUE OF OUT
          EQ     AOP2        EXIT
 CKS      SPACE  4,20
**        CKS - CHECK SECTOR.
*
*         ENTRY  (X5) = SECTOR NUMBER, JSN AND MFID READ.
*                (X4) = SECTOR NUMBER EXPECTED.
*                (A5) = ADDRESS OF SECTOR TO BE CHECKED.
*                ND .NE. 0 IF DATA IS TO BE CHECKED.
*
*         EXIT   (X4) = 0 IF NO ERROR DETECTED.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 2.
*
*         RESTORES  X5, D+2, D+3, X0, D+6 WHEN RETURNING FROM ERROR.
*
*         CALLS  ABT, DCH, ERR.
 
 
 CKS      SUBR               ENTRY/EXIT
          SA3    D+6         CHECK FOR CIO ERROR
          MX2    -3
          BX2    -X2*X3
          NZ     X2,CKS2     IF CIO ERROR
          ZR     X4,CKSX     IF CHECKING ON WRITE - RETURN
 CKS0     SA2    JN          GET JSN AND MFID
          BX2    X2+X4       MERGE WITH SECTOR NUMBER
          BX6    X2-X5
          NZ     X6,CKS3     IF POSITION ERROR
          SX6    B1
          IX6    X4+X6       INCREMENT RANDOM ADDRESS FOR NEXT SECTOR
          SA6    CKSJ
          SA4    ND
          ZR     X4,CKSX     IF DATA NOT TO BE CHECKED
          SX4    B0
          SB2    76B
          SA2    A5+77B      LOAD CHECKSUM
 CKS1     SA1    A5+B2       VALIDATE CHECKSUM
          IX2    X2-X1
          SB2    B2-1
          GT     B2,B1,CKS1  IF MORE DATA
          NZ     X2,CKS1.1   IF CHECKSUM ERROR
          SA3    CKSI        CHECK SECTOR COUNT
          SX6    X3-1
          ZR     X6,CKSX     IF END OF TRANSFER
          SA6    A3+
          SA5    A5+100B     SET ACTUAL RANDOM ADDRESS
          SA4    CKSJ        SET EXPECTED RANDOM ADDRESS
          EQ     CKS0        NEXT SECTOR
 
 CKS1.1   SA1    CKSA        DATA ERROR PROCESSING
          SA2    CKSE
          RJ     ERR         DATA ERROR MESSAGE
          RJ     DCH         DATA CHECK
          EQ     CKS6
 
 CKS2     SA1    CKSB        CIO ERROR PROCESSING
          SX6    X2-2
          SA2    X2+TCIO-1
          SA6    CKSG
          LX7    X4
          SX4    B0
          SA7    CKSH
          RJ     ERR         CIO ERROR MESSAGE
          SA1    CKSG
          NG     X1,CKS5     IF PARITY ERROR
          ZR     X1,CKS4     IF ADDRESS ERROR
          EQ     CKS6
 
 CKS3     SA1    CKSC        POSITION ERROR PROCESSING
          SA2    CKSE
          BX6    X4
          SX4    B0
          SA6    CKSH
          RJ     ERR         POSITION ERROR MESSAGE
 CKS4     SA4    CKSH        SECTOR EXPECTED
          SA1    CKSD
          SA2    CKSF
          BX5    X4
          SX4    B1
          ZR     X5,CKS6     IF ADDRESS ERROR ON SEQUENTIAL WRITE
          RJ     ERR         EXPECTED ERROR MESSAGE
 CKS5     RJ     DCH         DATA CHECK
 CKS6     RJ     ABT         CHECK FOR ABORT ON ERRORS
 CKS7     SA5    ERRA        RESTORE REGISTERS
          SA2    A5+B1
          SA3    A2+B1
          SA1    A3+B1
          BX6    X2
          LX7    X3
          SA2    A1+B1
          SA6    D+2
          SA7    D+3
          LX6    X2
          BX0    X1
          SA6    D+6
          EQ     CKSX        RETURN
 
 
 CKSA     DATA   10HEQXXX,DATA
 CKSB     DATA   10HEQXXX,DEV.
 CKSC     DATA   10HEQXXX,POS.
 CKSD     DATA   10HEQXXX,EXP.
 CKSE     CON    10H ERROR AT
 CKSF     CON    10H POSITION
 CKSG     CON    0           TEMPORARY
 CKSH     CON    0           TEMPORARY
 CKSI     CON    0           NUMBER OF SECTORS REMAINING TO CHECK
 CKSJ     CON    0           EXPECTED RANDOM ADDRESS OF NEXT SECTOR
 
 TCIO     CON    10LPARITY ER.      PARITY ERROR
          CON    10LADDR. ERR.      ADDRESS ERROR
          CON    10LSTATUS ER.      DEVICE STATUS ERROR
          CON    10L81 FNC REJ      6681 FUNCTION REJECT
          CON    10LRESERVED        DEVICE RESERVED
          CON    10LNOT READY       DEVICE NOT READY
 CIO      SPACE 4,10
**        CIO - COMPUTE I/O RATE.
*
*         USES   X - 1, 2, 5, 6.
*                A - 1, 2, 5, 6.
*                B - NONE.
*
*         CALLS  CDD, CFD, MES.
 
 
 CIO      SUBR               ENTRY/EXIT
          SA1    CIOA        GET ELAPSED TIME
          SA5    NS          SET NUMBER OF I/O-S
          AX5    7
          SA2    CIOD
          IX5    X2*X5
          IX1    X5/X1
          RJ     CFD         CONVERT TO FLOATING POINT
          SA6    CIOB+2
          SA1    IO
          RJ     CDD         CONVERT TO DISPLAY
          SA6    CIOC+2
          SX1    CIOB
          RJ     MES         SEND I/O-S PER SECOND MESSAGE
          SX1    CIOC
          RJ     MES
          EQ     CIOX        RETURN
 
 CIOA     CON    0           ELAPSED TIME
 CIOB     DATA   C*    IO PER SECOND = XXXXXX.XXX.*
 CIOC     DATA   C*  NUMBER OF I/O-S = XXXXXXXXXX.*
 CIOD     CON    1000D*1000D
 CTR      SPACE  4,15
**        CTR - COMPUTE TRANSFER RATE.
*
*         ENTRY  (CTRB) = NUMBER OF SECTORS TRANSFERRED.
*                (ST) = START TIME.
*
*         EXIT   TRANSFER RATE MESSAGE ISSUED TO DAYFILE.
*
*         USES   X - 0, 1, 2, 3, 6.
*                A - 1, 2, 6.
*                B - NONE.
*
*         CALLS  CFD, MES.
*
*         MACROS RTIME.
 
 
 CTR      SUBR               ENTRY/EXIT
          RTIME  ET          GET ENDING TIME
          SA1    ST          COMPUTE ELAPSED TIME
          SA2    ET
          MX0    -36
          BX1    -X0*X1
          BX2    -X0*X2
          IX2    X2-X1
          BX6    X2
          SA6    CIOA
          SA1    CTRB
          SX3    640*1000/64
          LX3    6
          IX3    X1*X3       CHAR
          IX1    X3/X2
          RJ     CFD         CONVERT TO DISPLAY CODE
          SA6    CTRA+2
          SX1    CTRA        SEND TRANSFER RATE MESSAGE
          RJ     MES
          EQ     CTRX        RETURN
 
 CTRA     DATA   C*MST TRANSFER RATE = XXXXXX.XXX KC.*
 CTRB     CON    0           SECTORS TRANSFERRED
 CVA      SPACE  4,15
**        CVA - CONVERT ADDRESS.
*
*         THIS SUBROUTINE PERFORMS THE CONVERSION OF LOGICAL
*         TO PHYSICAL DISK ADDRESS.  IT IS OVERLAYED BY THE
*         THE CONVERSION ROUTINE FOR THE SPECIFIED EQUIPMENT.
*
*         ENTRY  (B6) = MESSAGE ADDRESS.
*
*         EXIT   NONE.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*                B - NONE.
*
*         CALLS  WOD.
 
*         WILL NEED WORK HERE FOR MULTI-PARTITION DEVICES.
 
 
 CVA      PS                 ENTRY/EXIT
          SA2    D+6         PLACE TRACK AND SECTOR
          MX0    -12
          AX2    12
          BX6    -X0*X2
          AX2    12
          BX7    -X0*X2
          LX7    15*3
          LX6    9*3
          BX1    X7+X6
          RJ     WOD
          SA1    CVAA
          SA2    A1+B1
          IX6    X1+X6
          IX7    X2+X7
          SA6    B6
          SA7    B6+B1
          EQ     CVA         RETURN
 
 CVAA     CON    10HT0000 S000-10H0000000000
          CON    10H0.        -10H0000000000
          BSS    10
 CVAE     BSS    0
 DCH      SPACE  4,15
**        DCH - DATA CHECK.
*
*         ENTRY  (SBUF - SBUF+77B) = SECTOR TO BE CHECKED.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 2, 5, 6, 7.
*
*         CALLS  COD, GDB, WOD.
*
*         MACROS MESSAGE.
 
 
 DCH4     NZ     B7,DCHX     IF ERRORS FOUND RETURN
          MESSAGE  (=C*DATA OK.*)
 
 DCH      SUBR               ENTRY/EXIT
          SA1    ND
          ZR     X1,DCHX     IF NO DATA GENERATED
          SA1    SBUF+1
          SB5    B1
          BX6    X1
          SA6    TBUF+1
          SB7    B0+
          RJ     GDB         REGENERATE DATA
 DCH1     SB6    77B
 DCH2     SA1    TBUF+B5
          SA2    SBUF+B5
          SB5    B5+B1
          BX7    X2-X1
          GT     B5,B6,DCH4  IF END OF CHECK
          ZR     X7,DCH2     IF DATA MATCHES
          LX6    X2
          SB7    B1          ERROR FLAG
          SA6    DCHA
          SA7    A6+B1
          BX0    X1
          SX1    B5
          SB6    B0
          RJ     COD         CONVERT WORD NUMBER
          LX6    6
          SX1    B1
          IX6    X6+X1
          BX1    X0
          SA6    DCHD
 DCH3     RJ     WOD         CONVERT DATA
          SA1    TMES+B6     MESSAGE TYPE
          SA2    DCHD
          SA6    DCHE
          MX0    -24
          SA7    A6+B1
          BX2    -X0*X2      MERGE MESSAGE TYPE
          BX1    X0*X1
          BX6    X2+X1
          SA6    A2
          MESSAGE  DCHC,,R
          SA1    DCHA+B6
          SB2    B6-B1
          SB6    B6+B1
          NE     B2,B1,DCH3  IF MORE MESSAGES FOR THIS ERROR
          EQ     DCH1
 
 DCHA     CON    0           TEMPORARY
 DCHB     CON    0           TEMPORARY
 DCHC     DATA   10HEQXXX,DATA
 DCHD     CON    10H .... 000,
 DCHE     CON    0,0,0
 
 TMES     CON    6L EXP      TABLE OF MESSAGES
          CON    6L READ
          CON    6L DIFF
 ERR      SPACE  4,15
**        ERR - SEND ERROR MESSAGE.
*
*         ENTRY  (X5) = SECTOR NUMBER, JSN AND MFID READ.
*                (X4) = 0 IF REGISTERS MUST BE SAVED.
*                (X2) = SECOND WORD OF MESSAGE.
*                (X1) = FIRST WORD OF MESSAGE.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 6
*
*         CALLS  CVA, WOD.
*
*         MACROS MESSAGE, RECALL, RPHR, STATUS.
 
 
 ERR      SUBR               ENTRY/EXIT
          BX6    X1
          LX7    X2
          SA6    ERRB
          MX6    -24
          BX6    -X6*X5
          SA7    A6+B1
          SA6    ERRH
          RECALL D
          NZ     X4,ERR1     IF REGISTERS ALREADY SAVED
          SA2    D+2
          SA3    D+3
          LX6    X5
          BX7    X2
          SA2    D+6
          SA6    ERRA
          LX6    X3
          SA7    A6+B1
          BX7    X0
          SA6    A7+B1
          LX6    X2
          SA7    A6+B1
          SA6    A6+2
 ERR1     SA2    ERRH        POSITION TO ERROR
          SA1    D+1
          BX6    X2
          SX7    X1
          SA6    D+6
          SX6    X1+B1
          SA7    A1+B1
          SA6    A7+B1
          RPHR   D,R
          STATUS X2,P
          SA1    ERRH        MERGE RANDOM ADDRESS TRACK AND SECTOR
          SA2    D+6
          MX0    30
          LX2    18
          BX1    -X0*X1
          BX2    X0*X2
          BX1    X1+X2
          RJ     WOD         CONVERT RANDOM ADDRESS TRACK AND SECTOR
          SA1    ERRE
          MX0    -18
          SA2    A1+B1
          BX1    X0*X1
          LX7    -24
          MX4    24
          BX3    -X0*X7
          BX2    -X4*X2
          BX4    X4*X7
          BX7    X1+X3       MERGE RANDOM ADDRESS IN MESSAGE
          SA3    A2+B1
          BX2    X4+X2
          SA7    A1
          MX4    -24
          BX7    -X4*X6
          AX6    24
          BX2    X4*X2       CLEAR TRACK
          BX6    -X4*X6
          LX4    24
          BX3    X4*X3       CLEAR SECTOR
          BX6    X6+X2       MERGE TRACK IN MESSAGE
          LX7    24
          SA6    A2
          BX7    X7+X3       MERGE SECTOR IN MESSAGE
          SA7    A3
          SB6    ERRD
          RJ     CVA         CONVERT ADDRESS
          MESSAGE  ERRB,,R
          MESSAGE  ERRE,,R
          EQ     ERRX        RETURN
 
 ERRA     BSS    5
 ERRB     DATA   10HEQXXX,ZZZZ
 ERRC     CON    10H ERROR AT
 ERRD     CON    0,0
          CON    0           END OF LINE FOR FIRST MESSAGE
 ERRE     DATA   10HEQXXX,R000
 ERRF     CON    10H0000,T0000
 ERRG     CON    7L,S0000.
 ERRH     CON    0           RANDOM ADDRESS TEMPORARY
 GDB      SPACE  4,15
**        GDB - GENERATE DATA BUFFER.
*
*         ENTRY (X6) = RANDOM NUMBER WHICH WILL GENERATE BUFFER.
*               (A6) = ADDRESS OF RANDOM NUMBER IN BUFFER.
*
*         EXIT  (X6) = CHECKSUM OF BUFFER.
*               (X7) = LAST DATA WORD STORED IN BUFFER.
*               (B2) = (B3) = NUMBER OF DATA WORDS GENERATED.
*               (A6) = ADDRESS OF LAST WORD IN BUFFER.
*
*         USES   X - 2, 6, 7.
*                A - 2, 6, 7.
*                B - 2, 3.
 
 
 GDB      SUBR               ENTRY/EXIT
          SA2    ND
          ZR     X2,GDBX     IF NO DATA GENERATION
          SB3    75B
          SB2    B0+
 GDBA     BX7    X6
          SA7    A6
 
*         THIS INSTRUCTION IS MODIFIED BY PRESET
*         EQ     GDB2        IF NON-RANDOM PATTERN
 
          SX6    B0+         IF RANDOM PATTERN - CLEAR CHECKSUM
 
 GDB1     PX2    X7
          DX7    X2*X2
          IX7    X7+X2
          SB2    B2+B1
          LX2    15
          IX7    X7+X2
          LX2    19
          IX7    X2+X7
          SA7    A7+B1
          IX6    X6+X7       ADVANCE CHECKSUM
          NE     B2,B3,GDB1  IF MORE DATA TO GENERATE
          SA6    A7+B1       CHECKSUM IN LAST LOCATION OF BUFFER
          EQ     GDBX
 
 GDB2     SB2    B2+B1
          SA7    A7+B1
          NE     B2,B3,GDB2  IF BUFFER NOT FULL
          SA6    A7+B1
          EQ     GDBX
 MEM      SPACE  4,15
**        MEM - REQUEST MEMORY.
*
*         ENTRY  (X1) = REQUESTED MEMORY.
*
*         EXIT   (IN) = (OUT) = (FIRST).
*                (LIMIT) = REQUESTED FIELD LENGTH.
*
*         USES   X - 2, 6, 7.
*                A - 2, 6, 7.
*                B - NONE.
*
*         MACROS MEMORY.
 
 
 MEM      SUBR               ENTRY/EXIT
          SA2    D+1
          SX7    X1-10B
          SX6    X2
          SA7    D+4         LIMIT
          SA6    A7-B1       OUT
          SA6    A6-B1       IN
          MEMORY ,,R,X1      REQUEST MEMORY
          EQ     MEMX        RETURN
 MES      SPACE  4,15
**        MES - SEND MESSAGE.
*
*         ENTRY  (X1) = MESSAGE ADDRESS.
*
*         EXIT   MESSAGE SENT TO CONTROL POINT AND JOB DAYFILE.
*
*         USES   X - 0.
*                A - NONE.
*                B - NONE.
*
*         MACROS MESSAGE.
 
 
 MES      SUBR               ENTRY/EXIT
          SX0    X1+
          MESSAGE X1,1,R
          MESSAGE X0,3,R
          EQ     MESX        RETURN
 RNO      SPACE  4
**        RNO - GENERATE RANDOM SECTOR NUMBER.
*
*         ENTRY  NONE.
*
*         EXIT   (X6) = RANDOM SECTOR NUMBER IN FILE.
*
*         USES   X - 1, 3, 5, 6.
*                A - 1, 3, 5, 6.
*                B - NONE.
 
 
 RNO      SUBR               ENTRY/EXIT
 RNO1     SA1    RNOA        LAST NUMBER
          SA3    SM          SECTOR MASK
          SA5    NS          NUMBER OF SECTORS
          PX1    X1
          DX6    X1*X1
          IX6    X1+X6
          LX1    15
          IX6    X1+X6
          LX1    19
          IX6    X1+X6
          SA6    A1          SAVE NEW NUMBER
          SA1    TL
          IX5    X5-X1
          BX6    -X3*X6
          SA1    RO          CHECK ROLLOUT SIMULATION REQUEST
          ZR     X1,RNO2     IF NO ROLLOUT SIMULATION
          IX6    X1+X6       ROUND SECTOR ADDRESS UP TO MULTIPLE OF 32
          AX6    5
          LX6    5
 RNO2     BSS    0
          IX3    X5-X6
          ZR     X6,RNO1     IF SECTOR NUMBER = 0
          NG     X3,RNO1     IF SECTOR NOT IN FILE
          EQ     RNOX        RETURN
 
 RNOA     DATA   13576420735162531625B
 WIC      SPACE  4,10
**        WIC - WAIT I/O COMPLETE.
*
*         ENTRY  (BD) = 2 IF DEVICE IS BUFFERED.
*
*         USES   X - 1, 2, 3.
*                A - 1.
*                B - NONE.
*
*         MACROS MESSAGE, RECALL, RTIME.
 
 
 WIC      SUBR
          SA1    BD
          LX1    59-1
          PL     X1,WICX     IF DEVICE NOT BUFFERED
          MESSAGE  (=C* WAIT I/O COMPLETE.*),1,R
          RTIME  WICA        FETCH TIME
          SA1    WICA
          MX3    -36
          BX2    -X3*X1      SAVE START TIME
 WIC1     RECALL             DELAY
          RTIME  WICA        CHECK TIME
          SA1    WICA
          BX1    -X3*X1
          IX1    X1-X2       TIME SINCE FIRST CALL
          SX1    X1-3000
          NG     X1,WIC1     IF 3 SECONDS NOT ELAPSED
          EQ     WICX        RETURN
 
 WICA     BSS    1
          SPACE  4
**        COMMON DECKS.
 
 
 ERP1$    EQU    1           ENABLE I/O ERROR PROCESSING
*CALL     COMCCDD
*CALL     COMCCOD
*CALL     COMCCIO
*CALL     COMCCFD
*CALL     COMCLFM
*CALL     COMCRDW
*CALL     COMCSYS
*CALL     COMCWOD
*CALL     COMCWTW
 BUFFERS  SPACE  4
          TITLE  BUFFERS.
          USE    //
          SEG
 BUFS     BSS    0
 
 TRRD     EQU    BUFS+1      TABLE OF SECTORS FOR RANDOM READ WITH LIST
 TBUF     EQU    TRRD+41     TEST BUFFER FOR PATTERN REGENERATION
 SBUF     EQU    TBUF+100B
 DBUF     EQU    SBUF+100B
 MFL=     EQU    DBUF+DBUFL+10B+200000B
 
 
          TITLE  PRESET.
          ORG    BUFS
 
 
**        THE FOLLOWING CODE IS OVERLAYED BY BUFFERS.
 
 
*         COMMON DECKS
 
*CALL     COMCARG
*CALL     COMCCPM
*CALL     COMCDXB
*CALL     COMCMVE
 PRS      SPACE  4
**        PRS - PRESET PROGRAM.
*
*         ENTRY  (B7) = 1 IF ADDRESS CONVERSION PRESET.
 
 
 PRS      SUBR               ENTRY/EXIT
          SYSTEM RSB,R,PRSF  SET EXTENDED MEMORY TRACK SHIFT
          SA1    EMTS
          MX0    -2
          LX1    0-29
          BX6    -X0*X1
          SA6    A1
          EQ     B7,B1,PRS5  IF ADDRESS CONVERSION PRESET
          MODE   1
          GETJN  JN          GET JSN
          MACHID PRSH        GET MAINFRAME ID
          SA1    PRSH        MERGE JSN AND MFID
          SA2    JN
          LX1    24
          BX6    X1+X2
          SA6    A2+
          REQUEST D
          STATUS X2,P
          SA1    D+6
          BX6    X1
          AX6    48
          SA6    PRSG        SAVE EST ORDINAL
          RJ     WOD         CONVERT EST ORDINAL
          SA1    D+1
          AX6    6           POSITION EST ORDINAL
          MX0    12
          BX1    X0*X1
          MX0    18
          LX0    -12
          BX6    X0*X6
          BX6    X6+X1       MERGE EST ORDINAL AND TYPE
          MX0    -30
          SA1    DCHC        SET EQUIPMENT IN MESSAGES
          BX1    -X0*X1
          BX7    X6+X1
          SA7    DCHC
          SA1    ERRE
          BX1    -X0*X1
          BX7    X6+X1
          SA7    ERRE
          SA1    CKSA-1
          SB2    B0+
          SB3    4
 PRS1     SA1    A1+B1
          BX1    -X0*X1
          SB2    B2+1
          BX7    X6+X1
          SA7    A1
          LT     B2,B3,PRS1  IF MORE MESSAGES
          MX6    0
          SA6    D+5
          SA6    A6+B1
 
*         IDENTIFY ASSIGNED EQUIPMENT.
 
          SA2    TEQP
          SA1    D+B1
          MX0    -24
          MX5    1           SET EP BIT IN FET
          MX4    12
          LX5    44-59
          SX7    B1
 PRS2     ZR     X2,PRS8     IF END OF TABLE
          BX3    X2-X1
          BX6    X4*X3
          LX3    X2
          SA2    A2+B1
          NZ     X6,PRS2     IF NO EQUIPMENT MATCH
          BX6    X1+X5
          SA6    A1          SET EPR BIT IN FET
          BX6    -X0*X3
          IX6    X6-X7
          SA6    NS
          MX7    12          SET SECTOR MASK
          NX6    X6,B2
          AX7    X7,B2
          AX3    24
          SA7    A6+B1
          MX0    -6
          BX6    -X0*X3
          SA6    BD          SET BUFFERED DEVICE FLAG
          AX3    6
          SX2    X3
          ZR     X2,PRS8     IF ILLEGAL EQUIPMENT
          MOVE   CVAE-CVA,X2,CVA
 
*         RETRIEVE ARGUMENTS.
 
          SA1    ACTR        ARGUMENT COUNT
          SB7    B0
          SB4    X1
          SA4    ARGR        FIRST ARGUMENT
          SB5    TARG        ARGUMENT TABLE
          RJ     ARG         PROCESS ARGUMENTS
          NZ     X1,PRS7     IF ARGUMENT ERROR
 
*         PROCESS *N* PARAMETER (NUMBER OF SECTORS).
 
          SA5    NS          NUMBER OF SECTORS
          MX2    14B
          BX3    X2*X5
          ZR     X3,PRS3     IF ARGUMENT OMITTED
          SA3    =0L*
          BX3    X3-X5
          AX3    18
          NZ     X3,PRS2.1   IF NOT /*/
          RJ     CNS         CALCULATE NUMBER OF SECTORS
          EQ     PRS2.2      SET NUMBER OF SECTORS
 
 PRS2.1   RJ     DXB         CONVERT ARGUMENT
          SX1    B1
          IX6    X6-X1
          ZR     X6,PRS7     IF ARGUMENT ERROR
 PRS2.2   SA6    NS
          MX7    12          SET SECTOR MASK
          NX6    X6,B2
          AX7    X7,B2
          SA7    SM
 PRS3     SA1    NS          SET SECTOR SIZE
          RJ     CDD         CONVERT TO DISPLAY
          SA6    PRSE+2
          SX1    PRSE
          RJ     MES         SEND FILE SIZE MESSAGE
 
*         PROCESS *IO* PARAMETER (NUMBER OF I/O-S).
 
          SA5    IO          SET NUMBER OF I/O-S
          ZR     X5,PRS3.1   IF NUMBER OF I/O-S NOT SPECIFIED
          RJ     DXB
          NZ     X4,PRS7     IF ERROR IN CONVERSION
          EQ     PRS3.2      SAVE NUMBER OF I/O-S
 
 PRS3.1   SA5    NS          BASE NUMBER OF I/O-S ON NUMBER OF SECTORS
          AX5    7
          BX6    X5
 PRS3.2   SA6    IO
 
*         PROCESS *TL* PARAMETER (TRANSFER LENGTH).
 
          SA5    TL          SET TRANSFER LENGTH
          RJ     DXB
          NZ     X4,PRS7     IF ERROR IN CONVERSION
          ZR     X6,PRS7     IF INVALID TRANSFER LENGTH
          SA6    A5
          SA5    NS
          IX6    X5-X6
          NG     X6,PRS7     IF TRANSFER SIZE GREATER THAN FILE SIZE
 
*         PROCESS *P* PARAMETER (SELECT TEST PATTERN).
 
 PRS3.3   SA5    TP
          RJ     DXB
          NZ     X4,PRS7     IF ARGUMENT ERROR
          SB5    X6-TPATL+1
          BX5    X6
          GT     B5,B0,PRS7  IF ARGUMENT ERROR
          SA1    X6+TPAT
          SA2    PRSA
          BX6    X1
          LX7    X2
          SB5    X5-5
          ZR     B5,PRS4     IF P=5 (RANDOM PATTERN)
          SA7    GDBA        SETS AN INSTRUCTION IN GDB
 PRS4     SA6    TP
          SX7    X5-4
          SA7    ND          SET NO DATA FLAG
          ZR     X7,PRS4.1   IF P=4
          SX7    X5-6
          NZ     X7,PRS4.1   IF NOT P=6
          SA7    ND          SET NO DATA FLAG
          SA7    NT          SET NO DATA TRANSFER FLAG
 PRS4.1   SA1    NS          SET INCREMENT FOR POSITION TEST
          SX2    B1+
          AX1    6
          IX7    X1+X2
          SA7    POSA
 
*         PROCESS *T* PARAMETER (SELECT TEST SECTION).
 
          SA5    TS
          RJ     DXB
          NZ     X4,PRS7     IF ARGUMENT ERROR
          SX3    X6-6
          PL     X3,PRS7     IF ARGUMENT ERROR
          SA6    TS
          EQ     PRSX        RETURN
 
*         PRESET FOR ADDRESS CONVERSION.
 
 PRS5     SA1    ACTR
          SA4    ARGR
          SB5    TART
          SB4    X1+
          RJ     ARG         PROCESS ARGUMENTS
          NZ     X1,PRS7     IF ARGUMENT ERROR
          SA1    PRSB
          SA5    PRSC        ADDRESS
          SA2    TEQP-1
 PRS6     SA2    A2+B1
          ZR     X2,PRS8     IF EQUIPMENT NOT FOUND
          BX3    X2-X1
          AX3    48
          NZ     X3,PRS6     IF NO MATCH
          BX6    X2
          LX2    30
          SA6    A1
          SB6    X2
          SB7    B0
          RJ     DXB
          NZ     X4,PRS7     IF ARGUMENT ERROR
          SA6    PRSC
          SA5    PRSD
          RJ     DXB         CONVERT SECTOR
          NZ     X4,PRS7     IF ARGUMENT ERROR
          MX0    -12
          BX5    X0*X6
          SA1    PRSC
          NZ     X5,PRS7     IF TRACK ERROR
          BX5    X0*X1
          LX1    12
          NZ     X5,PRS7     IF SECTOR ERROR
          BX6    X6+X1
          LX6    12
          SA6    D+6
          SB4    CVA
          EQ     B4,B5,PRSX  IF TRACK AND SECTOR ADDRESS
          MOVE   CVAE-CVA,B6,B4
          EQ     PRSX        RETURN
 
 PRS7     MESSAGE  (=C* ARGUMENT ERROR.*)
          EQ     ABT3        ABORT
 
 PRS8     MESSAGE  (=C* ILLEGAL EQUIPMENT.*)
          EQ     ABT3        ABORT
 
 PRSA     BX7    X6
          SA7    A6
          EQ     GDB2
 
 PRSB     CON    0           DEVICE TYPE - NO DEFAULT
 PRSC     DATA   0L0         TRACK
 PRSD     CON    0           SECTOR
 PRSE     DATA   C*        FILE SIZE = XXXXXXXXXX SECTORS.*
 PRSF     VFD    24/1,18/MEFL,18/EMTS
 PRSG     DATA   0           EST ORDINAL
 PRSH     CON    0           MAINFRAME ID
          TITLE  PRESET SUBROUTINES.
 CNS      SPACE  4,20
**        CNS - CALCULATE NUMBER OF SECTORS.
*
*         READS THE MST FOR THE SPECIFIED DEVICE AND COMPUTES
*         NS = (AVAILABLE TRACKS)*(SECTOR LIMIT) - 5.  THIS SIZE
*         ALLOWS FOR BOI, EOR, EOF, EOI, AND AN EXTRA SECTOR.
*         FOR *LDAM* DEVICES, DO NOT TEST THE LAST *RWPC* SECTORS,
*         TO AVOID A TRACK LIMIT CAUSED BY LOGIC IN *1MS*.
*
*         ENTRY  (PRSG) = EST ORDINAL.
*
*         EXIT   (X6) = NUMBER OF SECTORS.
*
*         USES   X -  1, 2, 3, 4, 6.
*                A -  1, 2.
*
*         CALLS  RSB=.
 
 
 CNS      SUBR
          SX1    CNSA        READ EST POINTER
          SX2    ESTP
          SX3    B1
          SX4    B0
          RJ     RSB=        READ POINTER
 
*         READ EST ENTRY FOR DEVICE.
 
          SA1    PRSG
          SA2    CNSA
          SX3    ESTE
          AX2    36
          MX4    -24
          IX1    X1*X3
          BX2    -X4*X2      FWA EST
          SX3    EQDE
          IX2    X1+X2       EST ADDRESS FOR SPECIFIED DEVICE
          IX2    X2+X3
          SX1    CNSB        READ *EQDE* WORD OF EST ENTRY
          SX3    B1
          SX4    B0
          RJ     RSB=        READ EST
 
*         READ MST FOR SPECIFIED DEVICE.
 
          SA1    CNSB
          MX2    -12         GET MST ADDRESS
          BX2    -X2*X1
          LX2    3
          SX1    CNSC
          SX4    B0
          SX3    MSTL
          RJ     RSB=        READ MST
 
*         CALCULATE NUMBER OF AVAILABLE SECTORS.
 
          SA1    CNSC+TDGL
          SA2    CNSC+MDGL
          MX3    -12
          BX1    -X3*X1      NUMBER OF AVAILABLE TRACKS
          BX2    -X3*X2      SECTOR LIMIT
          SX1    X1+B1       ADD TRACK ALREADY ALLOCATED TO FILE
          IX1    X1*X2
          SX4    5
          IX6    X1-X4       SET TOTAL SECTOR COUNT
          SA1    CNSB
          LX1    59-55
          PL     X1,CNSX     IF NOT *LDAM* DEVICE
          SX1    RWPC        DO NOT TEST THE LAST *RWPC* SECTORS
          IX6    X6-X1
          EQ     CNSX        RETURN
 
 
 CNSA     VFD    1/1,23/0,18/0,18/0
 CNSB     VFD    1/1,23/0,18/0,18/0
 CNSC     VFD    1/1,23/0,18/0,18/0
          BSS    MSTL-1
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMCRSB
          TITLE  PRESET DATA.
 
 TARG     BSS    0           MST ARGUMENT TABLE
 T        ARG    DZRO,TS,400B
 P        ARG    TP,TP,400B
 N        ARG    DZRO,NS,400B
 NW       ARG    -ONE,NW
 TL       ARG    TL,TL,400B
 NV       ARG    -ONE,NV
 RO       ARG    -T32,RO
 IO       ARG    IO,IO,400B
          ARG
 
 TART     BSS    0           ARGUMENT TABLE FOR ADDRESS CONVERSION
 EQ       ARG    TEQP+1,PRSB,400B
 T        ARG    DZRO,PRSC,400B
 S        ARG    DZRO,PRSD,400B
          ARG
 
 
 DZRO     DATA   1L0         DISPLAY CODE ZERO
 ONE      DATA   1           CONSTANT 1
 T32      DATA   32          CONSTANT 32
          SPACE  4
 CDV      EQU    CVA         819 SINGLE DENSITY
 CDW      EQU    CVA         819 DOUBLE DENSITY
 CDB      EQU    CVA         PFMD - DEMA ACCESS
 CDC      EQU    CVA         895
 CDF      EQU    CVA         887 (4KB SECTOR)
 CDH      EQU    CVA         887 (16KB SECTOR)
 CDN      EQU    CVA         9853
 CEA      EQU    CVA         5832 (1X SSD)
 CEB      EQU    CVA         5832 (2X SSD)
 CEC      EQU    CVA         5833 (1X SABRE)
 CED      EQU    CVA         5833 (1XP SABRE)
 CEE      EQU    CVA         5833 (2X SABRE)
 CEF      EQU    CVA         5833 (2XP SABRE)
 CEG      EQU    CVA         5838 (1X ELITE)
 CEH      EQU    CVA         5838 (1XP ELITE)
 CEI      EQU    CVA         5838 (2X ELITE)
 CEJ      EQU    CVA         5838 (2XP ELITE)
 CEK      EQU    CVA         5838 (3XP ELITE)
 CEL      EQU    CVA         5838 (4X ELITE)
 CEM      EQU    CVA         5833 (3XP SABRE)
 CEN      EQU    CVA         5833 (4X SABRE)
 CEO      EQU    CVA         47444 (1X 3.5IN)
 CEP      EQU    CVA         47444 (1XP 3.5IN)
 CES      EQU    CVA         47444 (2X 3.5IN)
 CEU      EQU    CVA         47444 (2XP 3.5IN)
 CEV      EQU    CVA         47444 (3XP 3.5IN)
 CEW      EQU    CVA         47444 (4X 3.5IN)
          SPACE  4
**        TBLM - GENERATE TABLE VIA *TBL* MACRO.
 
 
          PURGMAC TBLM
 TBLM     MACRO  EQ
          IFC    NE,*"DRN_EQ"*DI*
          IFC    NE,*"DRN_EQ"*DJ*
          VFD    12/2R_EQ,18/C_EQ,6/BF_EQ
          ELSE   1
          VFD    12/2R_EQ,18/CVA,6/BF_EQ
          IFNE   NT_EQ,0
          VFD    24/NT_EQ*SL_EQ/2
          ELSE   1
          VFD    24/3400B
          ENDM
 
 
 TEQP     BSS    0           TABLE OF EQUIPMENTS
          LIST   G
          TBL    "MSEQ"
          LIST   -G
          CON    0           END OF TABLE
 
 TPAT     BSS    0           TABLE OF PATTERNS.
          DATA   0
          DATA   -0
          DATA   25252525252525252525B
          DATA   52525252525252525252B
          DATA   0
          DATA   13576420735162531625B
          DATA   0
 TPATL    EQU    *-TPAT
 
 PRS      SPACE  4
          TITLE  ADDRESS CONVERSION ROUTINES.
 CDE      SPACE  4
**        CDE - CONVERT *DE* ADDRESS.
 
 
 CDE      BSS    0
 CDP      SPACE  4,10
**        CDP - CONVERT *DP* ADDRESS.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 6, 7.
*                B - NONE.
*
*         CALLS  WOD.
 
 
 CDP      BSS    0
          LOC    CVA
 CVA      PS                 ENTRY/EXIT
          SA1    EMTS        GET EM TRACK SHIFT
          SB2    X1+10
          SB3    X1+4
          MX6    -12
          SA1    D+6         READ POSITION
          AX1    12          EXTRACT SECTOR
          BX7    -X6*X1
          SX4    3777B
          LX7    6           SECTOR * 101B
          BX6    -X6*X1
          IX3    X7+X6
          AX1    12          EXTRACT TRACK
          BX2    X4*X1       TRACK * 101 * SECTOR LIMIT
          LX2    B2
          BX7    X4*X1
          LX7    B3
          IX2    X7+X2
          IX1    X2+X3
          LX1    12*3        POSITION DATA
          RJ     WOD         CONVERT DATA
          SA1    CDEA
          SA2    A1+B1
          IX6    X1+X6
          IX7    X2+X7
          SA6    B6
          SA7    B6+B1
          EQ     CVA         RETURN
 
 CDEA     CON    10HA0000000. -10H0000000000
          CON    10H          -10H0000000000
 
          ERRNG  CVAE-*
          LOC    *O
          SPACE  4
          END