C UETCMP.FOR 9/19/77 MAIN0001
CTHIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED MAIN0002
C OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. MAIN0003
C MAIN0004
CCOPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. MAIN0005
C MAIN0006
C WHEN LOADED, IT ASKS FOR A COMMAND, 'SEND' OR 'RECEIVE' OR MAIN0007
C 'COMPARE'. MAIN0008
C MAIN0009
C AFTER THE COMMAND, ON THE NEXT LINE, IT TAKES ONE OR MORE MAIN0010
C INTEGER PARAMETERS, AS EXPLAINED HERE: MAIN0011
C MAIN0012
C COMMAND PARAMETER(S) MAIN0013
C ======= ============ MAIN0014
C MAIN0015
C SEND AN INTEGER (N) MAIN0016
C (READS COMM.TXT AND WRITES IT TO MAIN0017
C DEVICE N) MAIN0018
C MAIN0019
C RECEIVE TWO INTEGERS (N,M) MAIN0020
C (READS DEVICE N, LOGS THE DATA ONTO MAIN0021
C DEVICE M) MAIN0022
C MAIN0023
C COMPARE COMPARES CONTENTS OF DEVICE N AND M. MAIN0024
C PRINTS ERROR MESSAGES INTO COMM.ERR MAIN0025
C MAIN0026
C******RESTRICTION -- TRAILING BLANKS ARE DELETED FROM ALL LINES***** MAIN0027
C MAIN0028
C EXIT EXITS MAIN0029
C MAIN0030
C MAIN0031
IMPLICIT INTEGER (A-Z) MAIN0032
C IN1WRD AND IN2WRD ARE FILE NAMES FOR COMPARED FILES MAIN0033
DOUBLE PRECISION IN1WRD,IN2WRD MAIN0034
DIMENSION SEND(4),RECEIV(7),COMPAR(7),WORK1(132) MAIN0035
DIMENSION WORK2(132),WORK3(132),EXIT(4) MAIN0036
C MAIN0037
DATA (SEND(I),I=1,4)/'S','E','N','D'/ MAIN0038
DATA (RECEIV(I),I=1,7)/'R','E','C','E','I','V','E'/ MAIN0039
DATA (COMPAR(I),I=1,7)/'C','O','M','P','A','R','E'/ MAIN0040
DATA (EXIT(I),I=1,4)/'E','X','I','T'/ MAIN0041
C MAIN0042
C READ COMMAND AND IDENTIFY IT MAIN0043
10 WRITE(5,310) MAIN0044
READ(5,290,END=120) (WORK1(I),I=1,15) MAIN0045
CALL SEARCH(SEND,4,WORK1,1,4,KSTART,KLAST,KFOUND) MAIN0046
IF (KFOUND .EQ. 1) GOTO 20 MAIN0047
CALL SEARCH(RECEIV,7,WORK1,1,7,KSTART,KLAST,KFOUND) MAIN0048
IF (KFOUND .EQ. 1) GOTO 80 MAIN0049
CALL SEARCH(COMPAR,7,WORK1,1,7,KSTART,KLAST,KFOUND) MAIN0050
IF (KFOUND .EQ. 1) GOTO 160 MAIN0051
CALL SEARCH(EXIT,4,WORK1,1,4,KSTART,KLAST,KFOUND) MAIN0052
IF (KFOUND .EQ. 1) STOP MAIN0053
C MAIN0054
C IF NONE OF THESE, GIVE AN ERROR MAIN0055
WRITE (5,300) MAIN0056
GOTO 10 MAIN0057
C MAIN0058
C THE COMMAND WAS 'SEND'. NOW PROMPT FOR AND ACCEPT MAIN0059
C AN INTEGER TO BE TAKEN AS THE DEVICE NUMBER TO MAIN0060
C SEND TO. MAIN0061
20 WRITE(5,320) MAIN0062
READ(5,330,ERR=70) N MAIN0063
OPEN (UNIT=20,DEVICE='DSK',ACCESS='SEQIN',MODE='ASCII', MAIN0064
1 FILE='COMM.TXT') MAIN0065
OPEN (UNIT=N,DEVICE='DSK',ACCESS='SEQOUT',MODE='ASCII') MAIN0066
30 READ(20,340,END=60) (WORK1(I),I=1,132) MAIN0067
C LOCATE THE LAST NONBLANK READ IN. WRITE OUT THE ARRAY MAIN0068
C FROM THE BEGINNING TO THAT POINT (MINUS ONE POSITION) MAIN0069
K=132 MAIN0070
DO 40 I=1,132 MAIN0071
IF (WORK1(K) .NE. ' ') GOTO 50 MAIN0072
K=K-1 MAIN0073
40 CONTINUE MAIN0074
50 WRITE(N,340) (WORK1(I1),I1=1,K) MAIN0075
GOTO 30 MAIN0076
C MAIN0077
60 CLOSE (UNIT=N,DEVICE='DSK',ACCESS='SEQOUT',MODE='ASCII') MAIN0078
GOTO 10 MAIN0079
C USER TYPED IN SOMETHING OTHER THAN A 2 DIGIT INTEGER MAIN0080
70 READ(5,330) MAIN0081
GOTO 20 MAIN0082
C COMMAND WAS 'RECEIVE' (FROM DEVICE N, LOGGING DATA RECEIVED MAIN0083
C ON DEVICE M) MAIN0084
C MAIN0085
C FIRST PROMPT FOR N AND M. MAIN0086
C MAIN0087
80 WRITE (5,350) MAIN0088
READ (5,330,ERR=150) N MAIN0089
WRITE (5,360) MAIN0090
READ (5,330,ERR=150) M MAIN0091
OPEN (UNIT=N,DEVICE='DSK',ACCESS='SEQIN',MODE='ASCII') MAIN0092
OPEN (UNIT=M,DEVICE='DSK',ACCESS='SEQOUT',MODE='ASCII') MAIN0093
90 READ(N,340,END=140) (WORK1(I),I=1,132) MAIN0094
C LOCATE THE LAST NONBLANK READ IN. WRITE OUT THE ARRAY MAIN0095
C FROM THE BEGINNING TO THAT POINT (MINUS ONE POSITION) MAIN0096
K=132 MAIN0097
DO 100 I=1,132 MAIN0098
IF (WORK1(K) .NE. ' ') GOTO 110 MAIN0099
K=K-1 MAIN0100
100 CONTINUE MAIN0101
110 WRITE(M,340) (WORK1(I1),I1=1,K) MAIN0102
GOTO 90 MAIN0103
120 WRITE(5,130) MAIN0104
130 FORMAT(' ?UNEXPECTED EOF IN COMMAND FILE') MAIN0105
STOP MAIN0106
C MAIN0107
C END OF INPUT FILE ENCOUNTERED MAIN0108
140 CLOSE (UNIT=M,DEVICE='DSK',ACCESS='SEQOUT',MODE='ASCII') MAIN0109
GOTO 10 MAIN0110
C MAIN0111
C ERROR IN INPUT OF INTEGER MAIN0112
C SKIP THIS TTY RECORD AND GO BACK AND PROMPT AGAIN MAIN0113
150 WRITE (5,370) MAIN0114
READ (5,330) MAIN0115
GOTO 80 MAIN0116
C MAIN0117
C COMPARE FILES N AND M. SEND DISCREPANCIES TO FILE P. MAIN0118
160 NOMTCH = .FALSE. MAIN0119
N=30 MAIN0120
M=31 MAIN0121
P=5 MAIN0122
WRITE (5,480) MAIN0123
READ (5,470) IN1WRD MAIN0124
WRITE (5,490) MAIN0125
READ (5,470) IN2WRD MAIN0126
OPEN (UNIT=N,DEVICE='DSK',ACCESS='SEQIN',MODE='ASCII',FILE=IN1WRD)MAIN0127
OPEN (UNIT=M,DEVICE='DSK',ACCESS='SEQIN',MODE='ASCII',FILE=IN2WRD)MAIN0128
WRITE (P,450) MAIN0129
COUNT=1 MAIN0130
C MAIN0131
C READ RECORD FROM FILE N AND LOCATE LAST NON-BLANK MAIN0132
170 READ(N,340,END=240) (WORK1(I),I=1,132) MAIN0133
C MAIN0134
C LOCATE THE LAST NONBLANK READ IN. MAIN0135
K=132 MAIN0136
DO 180 I=1,132 MAIN0137
IF (WORK1(K) .NE. ' ') GOTO 190 MAIN0138
K=K-1 MAIN0139
180 CONTINUE MAIN0140
190 CONTINUE MAIN0141
C MAIN0142
C MAIN0143
C READ RECORD FROM FILE M AND LOCATE LAST NON-BLANK MAIN0144
200 READ(M,340,END=260) (WORK2(I),I=1,132) MAIN0145
C LOCATE THE LAST NONBLANK READ IN. MAIN0146
K1=132 MAIN0147
DO 210 I=1,132 MAIN0148
IF (WORK2(K1) .NE. ' ') GOTO 220 MAIN0149
K1=K1-1 MAIN0150
210 CONTINUE MAIN0151
220 CONTINUE MAIN0152
C MAIN0153
C NOW SEE IF THE LINES ARE EQUAL. (UPDATE LINE COUNT). MAIN0154
COUNT=COUNT+1 MAIN0155
IF (K .NE. K1) GOTO 230 MAIN0156
CALL SEARCH(WORK1,K,WORK2,1,K,KSTART,KLAST,KFOUND) MAIN0157
IF (KFOUND .NE. 1) GOTO 230 MAIN0158
GOTO 170 MAIN0159
C MAIN0160
C DATA DOES NOT MATCH UP. SEND MESSAGE TO ERROR FILE P MAIN0161
C MAIN0162
230 WRITE (P,430) N,COUNT,M,COUNT,WORK1,WORK2 MAIN0163
NOMTCH = .TRUE. MAIN0164
GOTO 170 MAIN0165
C MAIN0166
C FILE N HAS ENDED. DO A READ ON FILE M TO SEE IF MAIN0167
C IT ALSO ENDS. OTHERWISE FILES DON'T MATCH MAIN0168
240 READ (M,340,END=250) (WORK2(I),I=1,132) MAIN0169
C MAIN0170
C FALL-THROUGH MEANS FILE M IS LONGER MAIN0171
WRITE (P,440) COUNT,M,N,(WORK2(I),I=1,132) MAIN0172
NOMTCH = .TRUE. MAIN0173
GOTO 280 MAIN0174
C MAIN0175
C FILE ENDED, AS EXPECTED -- NO ERROR TO REPORT. MAIN0176
250 GOTO 280 MAIN0177
C MAIN0178
C FILE M ENDED BEFORE FILE N -- ERROR MAIN0179
260 WRITE (P,440) COUNT,N,M,(WORK1(I),I=1,132) MAIN0180
NOMTCH = .TRUE. MAIN0181
GOTO 280 MAIN0182
C MAIN0183
C INTEGER INPUT MISTYPED MAIN0184
270 WRITE (5,370) MAIN0185
READ(5,390) MAIN0186
GOTO 160 MAIN0187
C MAIN0188
C MAIN0189
280 IF (NOMTCH) WRITE (5,410) MAIN0190
IF (.NOT. NOMTCH) WRITE (5,400) MAIN0191
WRITE (P,460) MAIN0192
CLOSE (UNIT=P,DEVICE='DSK',MODE='ASCII') MAIN0193
GOTO 10 MAIN0194
C MAIN0195
290 FORMAT (15A1) MAIN0196
300 FORMAT (1H ,'%ILLEGAL COMMAND. COMMANDS ARE:',/, MAIN0197
1 1H ,'SEND RECEIVE COMPARE EXIT') MAIN0198
310 FORMAT (1H 'COMM>',$) MAIN0199
320 FORMAT (1H ,' DEVICE NUMBER TO SEND TO (21-63): ',$) MAIN0200
330 FORMAT (I2) MAIN0201
340 FORMAT (132A1) MAIN0202
350 FORMAT (1H ,' DEVICE NUMBER TO RECEIVE FROM: ',$) MAIN0203
360 FORMAT (1H ,' DEVICE NUMBER TO LOG DATA RECEIVED (21-63): ',$) MAIN0204
370 FORMAT (1H '?INPUT TYPED INCORRECTLY. SHOULD BE A TWO DIGIT MAIN0205
1 INTEGER.') MAIN0206
380 FORMAT(1H ,' DEVICE NUMBER OF FIRST FILE (21-63): ',$) MAIN0207
390 FORMAT (1H ,' DEVICE NUMBER OF SECOND FILE (21-63): ',$) MAIN0208
400 FORMAT (1H ,'FILES COMPARED -- EQUAL') MAIN0209
410 FORMAT (1H ,'?FILES COMPARED -- NOT EQUAL') MAIN0210
420 FORMAT (1H ,' DEVICE NUMBER OF ERROR LOG (21-63): '$) MAIN0211
430 FORMAT (' ++++ 1ST LINE FROM FILE: ',I2,', RECORD # ',I4, MAIN0212
1'; 2ND LINE FROM FILE: ',I2,', RECORD # ',I4,T91, MAIN0213
2'++++',/, MAIN0214
3 1H ,132A1,/,1H ,132A1) MAIN0215
440 FORMAT (' ++++ AFTER ',I4,' LINES,',T65,'++++',/, MAIN0216
1' ++++ FILE:',I2,' IS LONGER THAN',T65,'++++', MAIN0217
2/,' ++++ FILE:',I2,'. WHAT FOLLOWS IS THE MAIN0218
3',T65,'++++ MAIN0219
4',/,' ++++ FIRST EXTRA LINE:',T65,'++++', MAIN0220
5/,1H MAIN0221
6,132A1) MAIN0222
450 FORMAT(/,' MESSAGE FROM PROGRAM UETCMP.FOR',T65) MAIN0223
460 FORMAT(' END UETCMP.FOR MESSAGE',T65,/) MAIN0224
470 FORMAT(A10) MAIN0225
480 FORMAT(' FILE NAME FOR CREATED FILE : '$) MAIN0226
490 FORMAT(' FILE NAME OF ORIGINAL FILE : '$) MAIN0227
END MAIN0228
C MOVE MOVE0001
C MOVE0002
C MOVE0003
C SUBROUTINE MOVES WORDS FROM FROM ONE ARRAY INTO ANOTHER. MOVE0004
C MAXIMUM MOVE OF 72 WORDS. MOVE0005
C MOVE0006
C CALL MOVE(SOURCE,DEST,NCHAR) MOVE0007
C MOVE0008
SUBROUTINE MOVE(SOURCE,DEST,NCHAR) MOVE0009
C MOVE0010
INTEGER SOURCE(NCHAR),DEST(NCHAR),NCHAR MOVE0011
DO 10 I=1,NCHAR,1 MOVE0012
DEST(I)=SOURCE(I) MOVE0013
10 CONTINUE MOVE0014
RETURN MOVE0015
END MOVE0016
C SEARCH SRCH0001
C SRCH0002
C A SUBPROGRAM WHICH SEARCHES A STRING FOR A SUBSTRING. SRCH0003
C CALLED AS FOLLOWS: SRCH0004
C SRCH0005
C CALL SEARCH (SUBSTR,LSUBST,AREA,ISTART,ILAST SRCH0006
C ,KSTART,KLAST,KFOUND) SRCH0007
C SRCH0008
C INPUTS: SRCH0009
C SRCH0010
C SUBSTR AN ARRAY OF WORDS, WITH CHARACTERS SRCH0011
C LEFT JUSTIFIED ONE PER WORD, CONTAINING SRCH0012
C THE SUBSTRING TO SEARCH FOR SRCH0013
C SRCH0014
C LSUBST SIZE OF SUBSTR IN WORDS ( AND THEREFORE SRCH0015
C CHARACTERS) SRCH0016
C SRCH0017
C AREA AN ARRAY OF SIMILAR FORMAT TO SUBSTR, SRCH0018
C CONTAINING THE STRING TO BE SEARCHED SRCH0019
C SRCH0020
C ISTART POINTER INTO AREA -- FIRST CHARACTER TO SRCH0021
C SEARCH SRCH0022
C SRCH0023
C ILAST POINTER INTO AREA -- LAST CHARACTER TO SRCH0024
C SEARCH SRCH0025
C SRCH0026
C SRCH0027
C OUTPUTS: SRCH0028
C SRCH0029
C KSTART POINTER INTO AREA -- START OF FOUND STRING SRCH0030
C SRCH0031
C KLAST POINTER INTO AREA -- LAST CHARACTER OF SRCH0032
C FOUND STRING SRCH0033
C SRCH0034
C KFOUND =1 SEARCH WAS SUCCESSFUL SRCH0035
C =0 SEARCH WAS UNSUCCESSFUL SRCH0036
C SRCH0037
SUBROUTINE SEARCH (SUBSTR,LSUBST,AREA,ISTART,ILAST SRCH0038
1,KSTART,KLAST,KFOUND) SRCH0039
C SRCH0040
INTEGER AREA(132),SUBSTR(132),LSUBST,ISTART,ILAST,KSTART SRCH0041
INTEGER KLAST,KFOUND SRCH0042
C SRCH0043
LFOUND=0 SRCH0044
KFOUND=0 SRCH0045
DO 10 I=ISTART,ILAST,1 SRCH0046
C COMPARE THE FIRST CHARACTER IN THE SUBSTRING WITH SRCH0047
C THE CURRENT CHARACTER IN AREA. SRCH0048
C IF SUCCESSFUL THIS IS A POSSIBLE PLACE TO SRCH0049
C COMPARE FOR ENTIRE MATCH, SO CALL COMPAR. SRCH0050
IX=I SRCH0051
IF (SUBSTR(1).EQ.AREA(I)) SRCH0052
1 SRCH0053
2 SRCH0054
3 SRCH0055
4 SRCH0056
5 CALL COMSRCH0057
6PAR(SUBSTR,LSUBST,AREA, IX,ILAST,KLAST, SRCH0058
7 LFOUND) SRCH0059
IF (LFOUND.EQ.1) GOTO 20 SRCH0060
C IF NOT SUCCESSFUL, THE DO LOOP CYCLES AROUND TO DO SRCH0061
C A COMAPRISON OF THE FIRST CHAR. IN SUBSTR SRCH0062
C WITH ANOTHER IN "AREA". SRCH0063
10 CONTINUE SRCH0064
C IF LOOP FALLS THROUGH THE SEARCH WAS UNSUCCESSFUL. SRCH0065
RETURN SRCH0066
C SET UP A SUCCESSFUL RETURN SRCH0067
20 KSTART=I SRCH0068
KFOUND=LFOUND SRCH0069
RETURN SRCH0070
END SRCH0071
C CMPR0001
C COMPAR CMPR0002
C CMPR0003
C A SUBPROGRAM WHICH COMPARES TWO STRINGS AND RETURNS CMPR0004
C SUCCESS IF THEY AR EQUAL. CALLLED AS FOLLOWS: CMPR0005
C CMPR0006
C CALL COMPAR (SUBSTR,LSUBST,AREA,I,ILAST,KLAST,LFOUND) CMPR0007
C CMPR0008
C PARAMETERS ARE AS DEFINED FOR SEARCH (ABOVE), PLUS: CMPR0009
C CMPR0010
C I POINTER INTO AREA -- FIRST CHARACTER CMPR0011
C TO SEARCH CMPR0012
C CMPR0013
C LFOUND =1 COMPARISON WAS SUCCESSFUL CMPR0014
C =0 COMPARISON WAS UNSUCCESSFUL CMPR0015
C CMPR0016
C INPUTS: SUBSTR,LSUBST,AREA,I CMPR0017
C OUTPUTS: KLAST, LFOUND CMPR0018
SUBROUTINE COMPAR (SUBSTR,LSUBST,AREA,I,ILAST, CMPR0019
1KLAST,LFOUND) CMPR0020
INTEGER AREA(132),SUBSTR(132),LSUBST,ILAST,KSTART CMPR0021
INTEGER KLAST,LFOUND CMPR0022
J1=1 CMPR0023
10 DO 20 J=I,ILAST,1 CMPR0024
IF (SUBSTR(J1).NE.AREA(J)) GO TO 30 CMPR0025
J1=J1+1 CMPR0026
IF (J1.GT.LSUBST) GO TO 40 CMPR0027
20 CONTINUE CMPR0028
C IF LOOP FALLS THROUGH, ALL CHARACTERS IN AREA MATCHED CMPR0029
C THOSE IN SUBSTR, BUT AREA RAN OUT FIRST, SO IT'S CMPR0030
C NO MATCH. CMPR0031
30 RETURN CMPR0032
C SUCCESSFUL MATCH. PREPARE FOR RETURN CMPR0033
40 KLAST=J CMPR0034
LFOUND=1 CMPR0035
RETURN CMPR0036
END CMPR0037