MST 
          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 
