Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0141/chksum.for
There are 2 other files named chksum.for in the archive. Click here to see a list.
C     RENBR(CHKSUM/CHECKSUM LISTER AND VERIFIER)
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
      DIMENSION KODE(100),IBFR(80),JBFR(72),KLMSUM(72)
     1,KLMTAB(72),LTREND(3),IDIGIT(10),KOMMON(45)
      EQUIVALENCE(KODE(1),KOMMON(1))
      DATA KMPR,KOPY,LEAD,NULL,IDSK,ILPT,INITAL/
     10,2,2,1,1,20,45/
      DATA KOMMON/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,
     11HJ,1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,
     21HV,1HW,1HX,1HY,1HZ,1H0,1H1,1H2,1H3,1H4,1H5,1H6,
     31H7,1H8,1H9,1H+,1H-,1H*,1H/,1H=,1H(,1H),1H.,1H,/
      DATA LTREND/1HE,1HN,1HD/
      DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,
     11H9/
      DATA ISTAR,KOMENT,ISPACE,ITAB/1H*,1HC,1H ,1H	/
C
C     GENERAL INPUT AND OUTPUT FORMATS
    1 FORMAT(80A1)
    2 FORMAT(72A1,1I5)
    3 FORMAT(6X,72A1)
    4 FORMAT(7X,72A1)
    5 FORMAT(1I5,1X,72A1)
    6 FORMAT(1X,I5,73A1)
    7 FORMAT(1X,6HVALID ,72A1)
    8 FORMAT(1X,6HERROR ,72A1)
    9 FORMAT(1X,6HSYMBL ,72A1)
   10 FORMAT(1X,6HCHKSM ,72A1)
   11 FORMAT(1X,5H*****,73A1)
   12 FORMAT(5H*****,1X,72A1)
   13 FORMAT(72A1,5H*****)
   14 FORMAT(1X/1X/1X)
   15 FORMAT(7X,1HC,1I6,24H ROUTINES CONTAIN ERRORS)
C
C     PREPARE FOR FIRST ROUTINE
      KIND=-1
      KNTERR=0
      IF(KMPR.LT.0)GO TO 18
      IF(KMPR.EQ.0)GO TO 17
      IF(KMPR.EQ.1)GO TO 16
      KMPBGN=2
      KMPEND=6
      LINBGN=8
      LINEND=79
      INPUT=79
      GO TO 19
   16 KMPBGN=1
      KMPEND=5
      LINBGN=7
      LINEND=78
      INPUT=78
      GO TO 19
   17 LINBGN=1
      LINEND=72
      INPUT=72
      GO TO 19
   18 LINBGN=1
      LINEND=72
      KMPBGN=73
      KMPEND=77
      INPUT=77
C
C     PREPARE FOR NEXT ROUTINE TO BE LISTED
   19 KNOWN=INITAL
      MOST=0
      LINKNT=0
      LONG=0
      LINCHK=0
      KLMCHK=0
      DO 20 KLMN=1,72
      KLMSUM(KLMN)=0
   20 KLMTAB(KLMN)=ISPACE
C
C     READ NEXT LINE AND FIND RIGHT PRINTING CHARACTER
   21 READ(IDSK,1,END=46)(IBFR(I),I=1,INPUT)
      MORE=LINEND+1
   22 MORE=MORE-1
      IF(MORE.LT.LINBGN)GO TO 21
      IF(IBFR(MORE).EQ.ISPACE)GO TO 22
      LESS=MORE+1
   23 LESS=LESS-1
      IF(LESS.LT.LINBGN)GO TO 21
      IF(IBFR(LESS).EQ.ISPACE)GO TO 23
      IF(IBFR(LESS).EQ.ITAB)GO TO 23
      IF(IBFR(LINBGN).NE.KOMENT)GO TO 38
      IF(LESS.EQ.LINBGN)GO TO 33
      IF(KIND.LT.0)KIND=1
      IF(IBFR(LINBGN+1).EQ.ISPACE)GO TO 34
      IF(IBFR(LINBGN+1).EQ.ITAB)GO TO 34
C
C     TEST IF CHECKSUMMED COMMENT IS CORRECT
      KLMN=LINBGN
      IVALUE=LINCHK
      DO 26 J=1,2
      JVALUE=0
      DO 25 I=1,6
      KLMN=KLMN+1
      IF(KLMN.GT.LESS)GO TO 30
      DO 24 K=1,10
      IF(IBFR(KLMN).NE.IDIGIT(K))GO TO 24
      JVALUE=(10*JVALUE)+K-1
      GO TO 25
   24 CONTINUE
      GO TO 30
   25 CONTINUE
      IF(IVALUE.NE.JVALUE)GO TO 30
   26 IVALUE=KLMCHK
      ITEST=KLMN+KNOWN-INITAL
      IF(ITEST.GT.LINEND)ITEST=LINEND
      IF(LESS.NE.ITEST)GO TO 28
      I=INITAL
   27 I=I+1
      IF(I.GT.KNOWN)GO TO 32
      KLMN=KLMN+1
      IF(IBFR(KLMN).EQ.KODE(I))GO TO 27
   28 IF(LEAD.LE.0)GO TO 29
      IF(KIND.GT.LEAD)GO TO 21
   29 LAST=2
      GO TO 36
   30 IF(LEAD.LE.0)GO TO 31
      IF(KIND.GT.LEAD)GO TO 21
   31 LAST=3
      GO TO 36
   32 LAST=0
      GO TO 37
C
C     COMMENT HAVING SPACE OR TAB IN COLUMN 2
   33 IF(NULL.GT.0)GO TO 21
      IF(KIND.LT.0)KIND=1
   34 IF(LEAD.LE.0)GO TO 35
      IF(KIND.GT.LEAD)GO TO 21
   35 LAST=-1
   36 IF(KIND.GT.0)KIND=KIND+1
C
C     OUTPUT COMMENT LINE
   37 IF(KOPY.GT.1)WRITE(ILPT,4)(IBFR(I),I=LINBGN,
     1LESS)
      IF(KOPY.EQ.1)WRITE(ILPT,3)(IBFR(I),I=LINBGN,
     1LESS)
      IF(KOPY.LE.0)WRITE(ILPT,1)(IBFR(I),I=LINBGN,
     1LESS)
      GO TO 21
C
C     CHECK FOR COLUMN CHECKSUMS IN INPUT FILE
   38 IF(KIND.GE.0)GO TO 41
      DO 40 KLMN=LINBGN,LESS
      LETTER=IBFR(KLMN)
      IF(LETTER.EQ.ISPACE)GO TO 40
      IF(LETTER.EQ.ISTAR)GO TO 40
      DO 39 I=1,10
      IF(LETTER.EQ.IDIGIT(I))GO TO 40
   39 CONTINUE
      GO TO 41
   40 CONTINUE
      GO TO 21
C
C     TEST FOR END STATEMENT
   41 KLMN=LINBGN+5
      IF(IBFR(KLMN).EQ.ISPACE)GO TO 42
      IF(IBFR(KLMN).EQ.ITAB)GO TO 42
      IF(IBFR(KLMN).EQ.IDIGIT(1))GO TO 42
      IF(KIND.GE.0)GO TO 54
      GO TO 44
   42 LTRTST=0
   43 KLMN=KLMN+1
      IF(KLMN.GT.LESS)GO TO 44
      IF(IBFR(KLMN).EQ.ISPACE)GO TO 43
      IF(IBFR(KLMN).EQ.ITAB)GO TO 43
      LTRTST=LTRTST+1
      IF(IBFR(KLMN).NE.LTREND(LTRTST))GO TO 44
      IF(LTRTST.LT.3)GO TO 43
      IF(KLMN.EQ.LESS)GO TO 45
   44 IF(KIND.GE.0)GO TO 53
      KIND=1
      GO TO 54
C
C     CONSTRUCT CHECKSUMMED COMMENT IF NONE OR WRONG
   45 KIND=-1
   46 IF(LINKNT.EQ.0)GO TO 78
      IF(LAST.EQ.0)GO TO 52
      JBFR(1)=KOMENT
      KLMN=1
      IVALUE=LINCHK
      DO 49 J=1,2
      JVALUE=0
      DO 47 I=1,6
      LFTOVR=IVALUE/10
      JVALUE=(10*JVALUE)+IVALUE-(10*LFTOVR)
   47 IVALUE=LFTOVR
      DO 48 I=1,6
      LFTOVR=JVALUE/10
      JDIGIT=JVALUE-(10*LFTOVR)+1
      JVALUE=LFTOVR
      KLMN=KLMN+1
   48 JBFR(KLMN)=IDIGIT(JDIGIT)
   49 IVALUE=KLMCHK
      I=INITAL
   50 I=I+1
      IF(I.GT.KNOWN)GO TO 51
      IF(KLMN.GE.72)GO TO 51
      KLMN=KLMN+1
      JBFR(KLMN)=KODE(I)
      GO TO 50
   51 IF(KOPY.GT.1)WRITE(ILPT,4)(JBFR(I),I=1,KLMN)
      IF(KOPY.EQ.1)WRITE(ILPT,3)(JBFR(I),I=1,KLMN)
      IF(KOPY.LE.0)WRITE(ILPT,1)(JBFR(I),I=1,KLMN)
   52 IF(KIND.EQ.-1)GO TO 55
      GO TO 70
C
C     IDENTIFY CHARACTERS AND CONSTRUCT CHECK SUMS
   53 KIND=0
   54 LAST=-1
   55 LINKNT=LINKNT+1
      LINTAB=ISPACE
      LINSUM=0
      KLMKNT=0
      DO 62 KLMN=LINBGN,MORE
      KLMKNT=KLMKNT+1
      LETTER=IBFR(KLMN)
      IF(LETTER.EQ.ISPACE)GO TO 62
      IF(LETTER.EQ.ITAB)GO TO 61
      NEWLTR=0
   56 NEWLTR=NEWLTR+1
      IF(NEWLTR.GT.KNOWN)GO TO 57
      IF(KODE(NEWLTR).NE.LETTER)GO TO 56
      GO TO 58
   57 KNOWN=KNOWN+1
      KODE(KNOWN)=LETTER
   58 LINSUM=LINSUM+(KLMKNT*NEWLTR)
      IF(KIND.LT.0)GO TO 62
      KLMSUM(KLMKNT)=KLMSUM(KLMKNT)+(LINKNT*NEWLTR)
      KLMCHK=KLMCHK+(LINKNT*NEWLTR)
   59 IF(KLMSUM(KLMKNT).LT.100000)GO TO 60
      KLMSUM(KLMKNT)=KLMSUM(KLMKNT)-100000
      GO TO 59
   60 IF(KLMCHK.LT.1000000)GO TO 62
      KLMCHK=KLMCHK-1000000
      GO TO 60
   61 IF(KOPY.GT.1)IBFR(KLMN)=ISPACE
      KLMTAB(KLMKNT)=ISTAR
      IF(LONG.LT.KLMKNT)LONG=KLMKNT
      LINTAB=ISTAR
   62 CONTINUE
      IF(MOST.LT.KLMKNT)MOST=KLMKNT
      LINCHK=LINCHK+LINSUM
   63 IF(LINCHK.LT.1000000)GO TO 64
      LINCHK=LINCHK-1000000
      GO TO 63
   64 IF(LINSUM.LT.100000)GO TO 65
      LINSUM=LINSUM-100000
      GO TO 64
C
C     DETERMINE IF CHECKSUM ON LINE IS CORRECT
   65 IF(KMPR.EQ.0)GO TO 68
      IVALUE=0
      DO 67 KLMN=KMPBGN,KMPEND
      DO 66 I=1,10
      IF(IBFR(KLMN).NE.IDIGIT(I))GO TO 66
      IVALUE=(10*IVALUE)+I-1
      GO TO 67
   66 CONTINUE
   67 CONTINUE
      IF(IVALUE.EQ.LINSUM)GO TO 68
      IF(IVALUE.EQ.0)GO TO 68
      IF(KOPY.GT.1)WRITE(ILPT,11)LINTAB,(IBFR(I),
     1I=LINBGN,MORE)
      IF(KOPY.EQ.1)WRITE(ILPT,12)(IBFR(I),I=LINBGN,
     1MORE)
      IF(KOPY.LE.0)WRITE(ILPT,13)(IBFR(I),I=LINBGN,
     1LINEND)
      GO TO 69
C
C     OUTPUT THIS LINE OF FORTRAN TEXT
   68 IF(KOPY.GT.1)WRITE(ILPT,6)LINSUM,LINTAB,
     1(IBFR(I),I=LINBGN,MORE)
      IF(KOPY.EQ.1)WRITE(ILPT,5)LINSUM,(IBFR(I),
     1I=LINBGN,MORE)
      IF(KOPY.EQ.0)WRITE(ILPT,1)(IBFR(I),I=LINBGN,
     1MORE)
      IF(KOPY.LT.0)WRITE(ILPT,2)(IBFR(I),I=LINBGN,
     1LINEND),LINSUM
   69 IF(KIND.GE.0)GO TO 21
C
C     CONSTRUCT CHECKSUM TOTALS BELOW COLUMNS
   70 IF(LAST.GT.0)KNTERR=KNTERR+1
      IF(KOPY.LE.1)GO TO 77
      IF(LONG.GT.0)WRITE(ILPT,4)(KLMTAB(I),I=1,LONG)
      IF(LONG.EQ.0)WRITE(ILPT,4)
      DO 72 KLMN=1,MOST
      IVALUE=KLMSUM(KLMN)
      JVALUE=1
   71 LFTOVR=IVALUE/10
      JVALUE=(10*(JVALUE-LFTOVR))+IVALUE
      IVALUE=LFTOVR
      IF(IVALUE.GT.0)GO TO 71
   72 KLMSUM(KLMN)=JVALUE
   73 LONG=0
      DO 75 KLMN=1,MOST
      JDIGIT=KLMSUM(KLMN)
      IF(JDIGIT.GT.1)GO TO 74
      KLMTAB(KLMN)=ISPACE
      GO TO 75
   74 LFTOVR=JDIGIT/10
      JDIGIT=JDIGIT-(10*LFTOVR)+1
      KLMSUM(KLMN)=LFTOVR
      KLMTAB(KLMN)=IDIGIT(JDIGIT)
      LONG=KLMN
   75 CONTINUE
      IF(LONG.LE.0)GO TO 76
      IF(LAST.LT.0)WRITE(ILPT,4)(KLMTAB(I),I=1,LONG)
      IF(LAST.EQ.0)WRITE(ILPT,7)(KLMTAB(I),I=1,LONG)
      IF(LAST.EQ.1)WRITE(ILPT,8)(KLMTAB(I),I=1,LONG)
      IF(LAST.EQ.2)WRITE(ILPT,9)(KLMTAB(I),I=1,LONG)
      IF(LAST.EQ.3)WRITE(ILPT,10)(KLMTAB(I),I=1,LONG)
      IF(LAST.LE.1)LAST=-1
      IF(LAST.GT.0)LAST=1
      GO TO 73
   76 WRITE(ILPT,14)
   77 IF(KIND.EQ.-1)GO TO 19
   78 IF(KNTERR.LE.0)GO TO 79
      IF(KOPY.GT.1)WRITE(ILPT,15),KNTERR
   79 ENDFILE ILPT
      STOP
C398993428599
      END