TST 
          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 
