Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50476/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