FTN4,L
      PROGRAM JVRFY(3,60), JVRFY FROM SSK 24999-16163 REV 1902
C 
C     THIS PROGRAM IS DESIGNED TO COMPARE THE CONTENTS OF 
C     A MAG TAPE FILE AGAINST THE CONTENTS OF A DISK TRACK. 
C     THE MAG TAPE FORMAT SHOULD BE:
C                   N CONSECUTIVE RECORDS EACH 6145 WORDS LONG
C                   WHERE WORD #1 IS THE TRACK #. 
C                   TERMINATION WILL OCCUR UPON READING EOF.
C     THE MAG TAPE MUST BE POSITIONED TO THE FIRST RECORD BEFORE
C     SCHEDULING THIS PROGRAM.
C 
C     FORM OF CALL: 
C                   RUN,JVRFY,LUCRT,LUDISK,LUMT 
C                          - OR - 
C                   CALL EXEC(ICODE,JVRFY,LUCRT,LUDISK,LUMT)
C                   [CALL RMPAR(IPBUF)] 
C 
C     WHERE:
C                   LUCRT - OPTIONAL IN THE SCHEDULING CALLS (9/23) 
C                   IF GIVEN, MESSAGES WILL BE DIRECTED TO THE
C                   SPECIFIED LU # - ELSE - 
C                   NO MESSAGES WILL BE OUTPUT. 
C                   LUDISK - LU # OF THE DISK SUBCHANNEL
C                   TO BE VERIFIED. 
C                   LUMT - LU # OF THE MAG TAPE.
C                   ICODE - 9,10,23 OR 24 
C                   WHEN EITHER 9 OR 23 ARE USED, 
C                   THE FOLLOWING INFO CAN BE RETRIEVED 
C                   BY THE FATHER UPON RETURN (USING RMPAR).
C     IPBUF(1) = 0 - COMPARE GOOD.
C     IPBUF(2) = # OF MAG TAPE RECORDS TESTED.
C 
C     IPBUF(1) = -2 - NO DISK LU GIVEN. 
C 
C     IPBUF(1) = -3 - NO MAG TAPE LU GIVEN
C 
C     IPBUF(1) = -4 - MAG TAPE STATUS ERROR 
C     IPBUF(2) = MAG TAPE RECORD NUMBER 
C     IPBUF(3) = EQT #5 STATUS INFO 
C 
C     IPBUF(1) = -5 - MAG TAPE RECORD LENGTH ERROR
C     IPBUF(2) = MAG TAPE RECORD NUMBER 
C     IPBUF(3) = LENGTH OF MAG TAPE RECORD. 
C 
C     IPBUF(1) = -6 - DISK READ ERROR.
C     IPBUF(2) = MAG TAPE RECORD NUMBER 
C     IPBUF(3) = EQT #5 STATUS INFO.
C 
C     IPBUF(1) = -1 MAG TAPE COMPARE ERROR
C     IPBUF(2) = MAG TAPE RECORD NUMBER 
C     IPBUF(3) = TRACK #
C     IPBUF(4) = SECTR #
C     IPBUF(5) = WORD OFFSET
C 
C MCC 6/10/77 
      DIMENSION IBUFF(6273),IPBUF(5),LENB(6),ISCTRS(6),IREG(2)
      EQUIVALENCE (REG,IREG),(LUDISK,IPBUF(2)),(LUMT,IPBUF(3))
      DATA LENB/128,256,512,1024,2048,2176/ 
      DATA ISCTRS/0,2,6,14,30,62/ 
C 
C     GET THE PARAMETERS
C 
      CALL RMPAR(IPBUF) 
      IF (IPBUF(1).EQ.0)  GOTO 2001 
      LUCRT=IPBUF(1)
      WRITE(LUCRT,1090) 
1090  FORMAT(/"24999-16163 1902 SOFTWARE SERVICE KIT SYSTEM 1000"/) 
      IF(LUDISK .EQ. 0)GO TO 200
      IF(LUMT .EQ. 0) GO TO 300 
C 
      ICOUNT = 0
C 
C     GET A MAG TAPE RECORD AND TEST FOR EOF
C 
10    IF(IFBRK(IDMY) .LT. 0) GO TO 100
      REG=EXEC(1,LUMT,IBUFF(128),6146)
C 
C     FINISHED IF EOF FOUND 
C 
      IF(IAND(IREG,200B) .NE. 0) GO TO 100
C 
C     ANY OTHER STATUS EXCEPT NO WRITE RING IS AN ABORT CONDITION.
C 
      IF(IAND(IREG,373B) .NE. 0) GO TO 400
C 
C     RECORD LENGTH MUST BE 6145
C 
      IF(IREG(2) .NE. 6145) GO TO 500 
C 
C     TRACK # IS IN FIRST WORD. 
C 
      ITRK = IBUFF(128) 
       ICOUNT = ICOUNT + 1
C 
C     NOW GET AND TEST THE CONTENTS OF ONE TRACK (6 READS)
C 
      DO 50 I=1,6 
      LENGTH = LENB(I)
      INDEX = LENGTH + 1
C 
C     INDEX IS 4097 ON LAST TIME THROUGH. 
C 
      IF(I .EQ. 6) INDEX = 4097 
C 
      REG = EXEC(1,LUDISK,IBUFF,LENGTH,ITRK,ISCTRS(I))
C 
      IF(IAND(IREG,55B) .NE. 0) GO TO 600 
C 
      CALL CMPWD(IBUFF,IBUFF(INDEX),LENGTH,IERR)
      IF(IERR .NE. 0) GO TO 700 
C 
50    CONTINUE
      GO TO 10
C 
C     GOOD COMPLETION 
C 
100   IPBUF(1) = 0
      GO TO 1000
C 
C     NO DISK LU GIVEN
C 
200   IPBUF(1) = -2 
      GO TO 1000
C 
C     NO MAG TAPE LU GIVEN
C 
300   IPBUF(1) = -3 
      GO TO 1000
C 
C     MAG TAPE STATUS ERROR.
C 
400   IPBUF(1) = -4 
      GO TO 1000
C 
C     MAG TAPE RECORD LENGTH ERROR. 
C 
500   IPBUF(1) = -5 
      IPBUF(3) = IREG(2)
      GO TO 1000
C 
C     DISK READ ERROR.
C 
600   IPBUF(1) = -6 
      IPBUF(3) = IREG(2)
      GO TO 1000
C 
C     COMPARE ERROR.
C 
700   IPBUF(1) = -1 
      IPBUF(3) = ITRK 
      IPBUF(4) = ISCTRS(I) + IERR/64
      IPBUF(5) = MOD(IERR,64) 
C 
C     FINISHED. 
C 
C     WRITE A MESG IF LUCRT IS GIVEN
C 
1000  IPBUF(2) = ICOUNT 
      IF(LUCRT .EQ. 0) GO TO 2000 
C 
      IGO = IPBUF(1) + 7
      GO TO (1010,1020,1030,1040,1050,1060,1070),IGO
C 
1010  WRITE(LUCRT,1011)IPBUF(3),IPBUF(2)
1011  FORMAT(" /JVRFY: DISK READ ERROR - STATUS ",K6," RECORD #",I4)
      GO TO 2000
C 
1020  WRITE(LUCRT,1021)IPBUF(3),IPBUF(2)
1021  FORMAT(" /JVRFY: MT RECORD LENGTH ERROR - LENGTH ", 
     +       I5," RECORD #",I4) 
      GO TO 2000
C 
1030  WRITE(LUCRT,1031)IPBUF(3),IPBUF(2)
1031  FORMAT(" /JVRFY: MT STATUS ERROR - STATUS ",K6," RECORD #",I4)
      GO TO 2000
C 
1040  WRITE(LUCRT,1041) 
1041  FORMAT(" /JVRFY: NO MAG TAPE LU# GIVEN")
      GO TO 2000
C 
1050  WRITE(LUCRT,1051) 
1051  FORMAT(" /JVRFY: NO DISK LU# GIVEN")
      GO TO 2000
C 
1060  WRITE(LUCRT,1061)(IPBUF(J),J=2,5) 
1061  FORMAT(" /JVRFY: COMPARE ERROR RECORD #",I4/, 
     +       " /JVRFY: TRACK #",I4," SECTOR #",I4," OFFSET",I4) 
      GO TO 2000
C 
1070  WRITE(LUCRT,1071)IPBUF(2) 
1071  FORMAT(" /JVRFY: COMPARE GOOD. ",I4," RECORDS") 
C 
2000  CALL PRTN(IPBUF)
2001  CONTINUE
      END 
      END$
ASMB,R,L,C,Z
      IFN 
      HED WORD COMPARE FOR 2100 & EARLIER CPU 
      NAM CMPWD,7 WORD COMPARE FOR 2100 & EARLIER CPU 6/10/77 
      XIF 
      IFZ 
      HED WORD COMPARE FOR 21MX & LATER CPU 
      NAM CMPWD,7 WORD COMPARE FOR 21MX & LATER CPU 6/10/77 
      XIF 
      ENT CMPWD 
      EXT .ENTR 
      SKP 
*     THIS PROGRAM WILL COMPARE THE CONTENTS OF TWO BUFFERS 
*      AND RETURN:
*                   IERR = 0  -  GOOD COMPARE 
*                   IERR = +N -  ERROR DETECTED.
*     WHERE N = BUFFER INDEX OF FAILED COMPARISON.
* 
*     THIS PROGRAM WILL RETURN AFTER ENCOUNTERING THE FIRST 
*     COMPARE FAILURE.
* 
*     THIS PROGRAM IS FORTRAN CALLABLE AS FOLLOWS:
*     CALL CMPWD(BUF1,BUF2,LENGTH,IERR) 
*            - OR - 
*     REG = CMPWD(BUF1,BUF2,LENGTH,IERR)
*     WHERE IERR IS RETURNED IN THE 'A' REGISTER. 
* 
*     CONDITIONAL ASSEMBLY REQUIRED FOR COMPUTER TYPE:
*                   N FOR 2100 OR EARLIER MODELS
*                   Z FOR 21MX OR LATER MODELS
* 
*     MCC 6/10/77 
* 
      SKP 
BUFF1 NOP 
BUFF2 NOP 
LENTH NOP 
IERR  NOP 
CMPWD NOP 
      SPC 1 
      JSB .ENTR 
      DEF BUFF1 
      SPC 1 
      IFN 
      LDA LENTH,I    GET THE BUFFER LENGTH
      CMA,INA       COMPLEMENT AND SAVE IT
      STA COUNT 
      SPC 1 
LOOP  LDA BUFF1,I   GET FIRST WORD
      XOR BUFF2,I   XOR WITH SECOND 
      SZA           OK IF ZERO RESULTS. 
      JMP ERROR     NO - ERROR. 
      SPC 1 
      ISZ COUNT     YES - FINISHED IF COUNT = 0 
      JMP INCR
      SPC 1 
      JMP OUT         FINISHED
      SPC 1 
INCR  ISZ BUFF1     INCREMENT BOTH BUFFER ADDRESSES 
      ISZ BUFF2 
      JMP LOOP      GO TEST THE NEXT TWO. 
      SPC 1 
ERROR ISZ COUNT     SET UP THE
      LDA LENTH,I   ERROR COUNT 
      ADA COUNT     FOR RETURN
      JMP BAD       THEN RETURN 
      SKP 
      XIF 
      IFZ 
      LDA BUFF1     GET THE TWO ADDRESSES IN 'A' & 'B'
      LDB BUFF2 
      CMW LENTH,I   GO TEST THESE ARRAYS
      JMP OUT       GOOD RETURN HERE. 
      SPC 1 
      NOP           ERROR RETURN HERE 
      LDB BUFF1     GET THE START ADDRESS 
      CMB,INB       AND SUBTRACT FROM 
      ADA B         PRESENT ADDRESS FOUND IN 'B'
      INA 
      JMP BAD       RETURN THE ERROR INDEX
      XIF 
      SKP 
OUT   CLA           GOOD RETURN HERE. 
      SPC 1 
BAD   STA IERR,I
      JMP CMPWD,I 
      SKP 
COUNT NOP 
A     EQU 0 
B     EQU 1 
      END 
      END$
      END$
      