Retro1.org codex

          IDENT  TST,FET 
          ABS
          SST    FL
          ENTRY  TST
          ENTRY  MFL=
          ENTRY  SSJ=
          SYSCOM B1
*COMMENT  TST - TAPE STORAGE TEST.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  TST - TAPE STORAGE TEST.
          SPACE  4
***       TST - TAPE STORAGE TEST.
*         P. C. SMITH.       91/11/08.
          SPACE  4
***       TST IS A CENTRAL PROCESSOR DRIVEN TAPE STORAGE TEST.  IT
*         PERFORMS SEQUENTIAL WRITES AND READS ON A SELECTED TAPE
*         DEVICE, AND REPORTS THE PERFORMANCE ACHIEVED.
*
*         OPERATING INSTRUCTIONS.
*         WHEN CALLED, TST ASSUMES THAT THE FILE *TAPE1* HAS BEEN
*         PREASSIGNED.
*
*         SEQUENTIAL WRITE.
*         RANDOM DATA IS WRITTEN SEQUENTIALLY ON THE FILE IN THIS
*         FORMAT -           1 WORD CONTAINING THE SECTOR 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.
*
*         THERE IS A FORTY SECOND PAUSE FOLLOWING THE WRITE SECTION OF
*         THE TEST TO ALLOW THE REWIND TO COMPLETE 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.
*
*         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.  SECTOR NUMBERS
*                     ARE GENERATED AND CHECKED.
*                 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.
*                     SECTOR NUMBERS ARE GENERATED AND CHECKED.
*
*         N      NUMBER OF 100B-WORD SECTORS (CAN BE EQUATED).
*                 N=0 GIVES ARGUMENT ERROR MESSAGE AND PROGRAM ABORT.
*                 N=XXXX WILL ENABLE THE TEST TO BE RUN ON XXXX SECTORS.
*                     (BE CAREFUL THAT TRACK LIMIT IS NOT EXCEEDED)
*                 N   GIVES DEFAULT VALUE (SEE TABLE TEQP).
*
*         NW     NO WRITE PERFORMED AT BEGINING OF TEST.
*
*         BS     BLOCK SIZE (MUST BE MULTIPLE OF 1000B).
*
*         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 TST 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.*.
*
 TST      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.
*
*         *TST TRANSFER RATE = XXXXXX.XXX KC.* = THE TAPE TRANSFER
*                            RATE FOR THE PREVIOUS SECTION WAS
*                            XXXXXX.XXX KILO-CHARACTERS 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 TST.
*
*         *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.
*
*         * TST ERROR - GO / DROP.* = *TST* HAS DETECTED AN
*                            IRRECOVERABLE READ ERROR.
*
*         * END TAPE STORAGE TEST.* = END OF TEST.
          SPACE  4
**        COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
          SPACE  4
****      ASSEMBLY CONSTANTS.
 
 
 TBUFL    EQU    4001B
****
          TITLE  DATA.
 FET      SPACE  4
*         FILE FET.
 
 
          ORG    110B
 FET      BSS    0
 T        BSS    0
 TAPE1    FILEB  TBUF,TBUFL,EPR,(FET=8)
 
*         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
 ND       CON    0           NULL DATA FLAG
 NT       CON    1           NO DATA TRANSFER FLAG
 BS       CON    1000B       BLOCK SIZE (PRU SIZE)
 
*         SPECIAL ENTRY POINTS.
 
 SSJ=     EQU    0
          TITLE  MAIN PROGRAM.
 TST      SPACE  4
**        TST - MAIN PROGRAM.
 
 
 TST      SB1    1           (B1) = 1
          SB7    B0
          SX6    A0
          SA6    FL
          RJ     PRS         PRESET
 TST1     SA1    NW
          NZ     X1,TST2     IF NO WRITE
          RJ     WSQ         WRITE SEQUENTIAL
          RJ     WRC         WAIT REWIND COMPLETE
 TST2     SA1    TS
          ZR     X1,TST3     IF ALL SECTIONS SELECTED
          SB5    X1-1
          ZR     B5,TST4     IF ONLY WRITE SELECTED
 TST3     RJ     RSQ         READ SEQUENTIAL
 TST4     SA1    B0
          LX1    59-8
          PL     X1,TST5     IF REPEAT TEST NOT SET
          RJ     WRC         WAIT REWIND COMPLETE
          EQ     TST1        CONTINUE
 
 TST5     MESSAGE (=C* END TAPE STORAGE TEST.*)
          ENDRUN
          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 T,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     SA1    TP          GENERATE SECTOR TO WRITE
          BX7    X5
          BX6    X1
          SA7    SBUF
          SA6    SBUF+1
          RJ     GDB         GENERATE DATA BUFFER
          SA7    TP
          SX2    T           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 T,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 T,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   T
 RSQ3     SX2    T           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    RSQA        SAVE RANDOM ADDRESS
          IX0    X0-X2       DECREMENT SECTOR COUNTER
          RJ     CKS         CHECK SECTOR
          SA5    RSQA
          ZR     X4,RSQ3     IF NO ERROR DETECTED
          SA1    T+1         RESTART READ ON ERROR
          SX2    B1
          IX7    X5+X2       SET RANDOM ADDRESS TO NEXT SECTOR
          SX6    X1
          SA6    A1+B1
          SA7    T+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
 
 RSQA     CON    0           TEMPORARY
          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*$TST 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).
 
          SX6    B5
          IX6    X6-X3       (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    X3
          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     SX6    B5
          IX6    X6-X3       (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    X3
          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 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, T+2, T+3, X0, T+6 WHEN RETURNING FROM ERROR.
*
*         CALLS  ABT, DCH, ERR.
 
 
 CKS      SUBR               ENTRY/EXIT
          SA3    T+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     BX6    X4-X5
          NZ     X6,CKS3     IF POSITION ERROR
          SX6    X4+B1       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    T+2
          SA7    T+3
          LX6    X2
          BX0    X1
          SA6    T+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
 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
          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*TST TRANSFER RATE = XXXXXX.XXX KC.*
 CTRB     CON    0           SECTORS TRANSFERRED
 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    PBUF+1
          SB7    B0+
          RJ     GDB         REGENERATE DATA
 DCH1     SB6    77B
 DCH2     SA1    PBUF+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  (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
          SA7    A6+B1
          RECALL T
          NZ     X4,ERR1     IF REGISTERS ALREADY SAVED
          SA2    T+2
          SA3    T+3
          LX6    X5
          BX7    X2
          SA2    T+6
          SA6    ERRA
          LX6    X3
          SA7    A6+B1
          BX7    X0
          SA6    A7+B1
          LX6    X2
          SA7    A6+B1
          SA6    A6+2
 ERR1     MESSAGE  ERRB,,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
 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    T+1
          SX7    X1-10B
          SX6    X2
          SA7    T+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
 WRC      SPACE  4,10
**        WRC - WAIT REWIND COMPLETE.
*
*         USES   X - 1, 2, 3.
*                A - 1.
*                B - NONE.
*
*         MACROS MESSAGE, RECALL, RTIME.
 
 
 WRC      SUBR
          MESSAGE  (=C* WAIT REWIND COMPLETE.*),1,R
          RTIME  WRCA        FETCH TIME
          REWIND T
          SA1    WRCA
          MX3    -36
          BX2    -X3*X1      SAVE START TIME
 WRC1     RECALL             DELAY
          RTIME  WRCA        CHECK TIME
          SA1    WRCA
          BX1    -X3*X1
          IX1    X1-X2       TIME SINCE FIRST CALL
          SX1    X1-40000
          NG     X1,WRC1     IF 40 SECONDS NOT ELAPSED
          EQ     WRCX        RETURN
 
 WRCA     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
 
 PBUF     EQU    BUFS+1      TEST BUFFER FOR PATTERN REGENERATION
 SBUF     EQU    PBUF+100B
 TBUF     EQU    SBUF+100B
 MFL=     EQU    TBUF+TBUFL+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
          MODE   1
          STATUS T,P
          SA1    T+6
          RJ     WOD         CONVERT EST ORDINAL
          SA1    T+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    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    T+5
          SA6    A6+B1
 
*         IDENTIFY ASSIGNED EQUIPMENT.
 
          SA2    TEQP
          SA1    T+B1
          MX0    -24
          MX4    11
          LX4    -1
          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    -X0*X3
          IX6    X6-X7
          SA6    NS
          MX7    12          SET SECTOR MASK
          NX6    X6,B2
          AX7    X7,B2
          SA7    A6+B1
 
*         RETRIEVE ARGUMENTS.
 
          SA1    ACTR        ARGUMENT COUNT
          SB7    B0          FORCE OCTAL CONVERSION OF ARGUMENTS
          SB4    X1
          SA4    ARGR        FIRST ARGUMENT
          SB5    TARG        ARGUMENT TABLE
          RJ     ARG         PROCESS ARGUMENTS
          NZ     X1,PRS7     IF ARGUMENT ERROR
          SA5    NS          NUMBER OF SECTORS
          MX2    12
          BX3    X2*X5
          ZR     X3,PRS3     IF ARGUMENT OMITTED
          RJ     DXB         CONVERT OCTAL ARGUMENT
          NZ     X4,PRS7     IF ERROR IN CONVERSION
          SX1    B1
          IX6    X6-X1
          ZR     X6,PRS7     IF ARGUMENT ERROR
          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
 
*         PATTERN SELECTION.
 
          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,PRS5     IF P=4
          SX7    X5-6
          NZ     X7,PRS5     IF NOT P=6
          SA7    ND          SET NO DATA FLAG
          SA7    NT          SET NO DATA TRANSFER FLAG
 
*         TEST SELECTION.
 
 PRS5     SA5    TS
          RJ     DXB
          NZ     X4,PRS7     IF ARGUMENT ERROR
          SX3    X6-6
          PL     X3,PRS7     IF ARGUMENT ERROR
          SA6    TS
 
*         BLOCK SIZE SELECTION.
 
          SA5    BS          SPECIFIED BLOCK SIZE
          MX2    12
          BX3    X2*X5
          ZR     X3,PRS6     IF ARGUMENT OMITTED
          RJ     DXB         CONVERT OCTAL ARGUMENT
          NZ     X4,PRS7     IF ERROR IN CONVERSION
          BX5    X6
          AX5    9
          LX5    9
          IX7    X6-X5
          NZ     X7,PRS7     IF NOT MULTIPLE OF 1000B
 PRS6     BX6    X5          SET MLRS FIELD IN FET
          SA6    T+6
          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.*
 
 
 TARG     BSS    0           TST ARGUMENT TABLE
 T        ARG    DZRO,TS,400B
 P        ARG    TP,TP,400B
 N        ARG    DZRO,NS,400B
 NW       ARG    -ONE,NW
 BS       ARG    BS,BS
          ARG
 
 
 DZRO     DATA   1L0         DISPLAY CODE ZERO
 ONE      DATA   1           CONSTANT 1
 
 
 TEQP     BSS    0           TABLE OF EQUIPMENTS
          VFD    12/2RMT,24/,24/100000B
          VFD    12/2RNT,24/,24/100000B
          VFD    12/2RCT,24/,24/100000B
          VFD    12/2RAT,24/,24/100000B
          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
 
          SPACE  4
          END