home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / ibm370 / ik0ver.for < prev    next >
Text File  |  2020-01-01  |  23KB  |  288 lines
  1. C|IK0VER    (C) 1988 BY J.F.CHANDLER                                    00001000
  2. C PERMISSION IS GRANTED TO COPY OR USE THIS PROGRAM, EXCEPT FOR         00002000
  3. C EXCEPT FOR EXPLICITLY COMMERCIAL PURPOSES.                            00003000
  4. C                                                                       00004000
  5. C ORIGINAL VERSION 1977 OCTOBER, CONDENSED 1988 OCTOBER.                00005000
  6. C                                                                       00006000
  7. C COMPARE TWO LINE-NUMBERED CARD-IMAGE FILES AND PUNCH UPDATE CARDS     00007000
  8. C WHICH WOULD CONVERT ONE DATA SET TO THE OTHER.  THE COMPARISON IS DONE00008000
  9. C LINE BY LINE.  EACH PAIR OF LINES IS TESTED IN COLUMNS 1-72.  THE     00009000
  10. C INPUT FILES ARE READ FROM UNITS 1 AND 2; OUTPUT TO UNIT 7.            00010000
  11. C                                                                       00011000
  12. C TO CHANGE FROM FORTRAN 66 TO FORTRAN 77, JUST CHANGE ALL REAL*8'S TO  00012000
  13. C CHARACTER*8'S AND LOGICAL*1'S TO CHARACTER*1'S, AND CHANGE THE DECODE 00013000
  14. C STEP IN VDUMP.  JUST REVERSE THE PROCESS FOR 77 TO 66.                00014000
  15. C                                                                       00015000
  16. C          INPUT TEXT BUFFER                                            00016000
  17.       COMMON/BUFFER/ CBF(10,2,300)                                      00017000
  18.       CHARACTER*8 CBF                                                   00018000
  19.       INTEGER*4 ISIZ/300/                                               00019000
  20. C                                                                       00020000
  21. C          POINTERS                                                     00021000
  22.       COMMON/PTRS/ SEQ(2),LN(2),IP(2),JP(2),IEF(2),IDMP,LOOK,IBFL       00022000
  23.       CHARACTER*8 SEQ                                                   00023000
  24. C    SEQ - SEQUENCE NUMBER OF LAST MATCH, 1ST NON-MATCH                 00024000
  25. C    LN  - LINE NUMBER OF LATEST CONFIRMED MATCH                        00025000
  26. C    IP  - CURRENT POINTER IN SEARCH FOR MATCH (MATCH WHEN FOUND)       00026000
  27. C    JP  - HIGHEST NUMBERED CARD CURRENTLY READ IN                      00027000
  28. C    IEF - END OF FILE INDICATOR (0 BEFORE, 1 AS SOON AS EOF REACHED)   00028000
  29. C    LOOK- SEARCH LEVEL FOR NEXT MATCH                                  00029000
  30. C    IBFL- INDEX OF LAST RECORD IN EACH BUFFER                          00030000
  31. C                                                                       00031000
  32.       INTEGER*4 LNJ(2),LNV(2),IPS(2)                                    00032000
  33.       EQUIVALENCE(LNJ(1),LNJ1),(LNJ(2),LNJ2),(LNV(1),LNV1),(LNV(2),LNV2)00033000
  34.       LOGICAL CMP                                                       00034000
  35. C           SYNCH EXCEPTIONS: COLS 1-16 OF RECORDS THAT SHOULDN'T BE    00035000
  36. C           USED IN DETERMINING A NEW MATCH (MIGHT NOT BE REAL).        00036000
  37.       CHARACTER*8 ZEROES,SYNCH(2,12)                                    00037000
  38.       DATA NSYNCH/12/, SYNCH/                                           00038000
  39.      1'        ','        ','C       ','        ','*       ','        ',00039000
  40.      2'        ',' SPACE  ','        ',' SPACE 1','        ',' SPACE ,',00040000
  41.      3'.*      ','        ','        ',' MACRO  ','        ',' MEND   ',00041000
  42.      4'        ',' MEXIT  ','/*      ','        ','//*     ','        '/00042000
  43.       DATA ZEROES/'00000000'/                                           00043000
  44. C                                                                       00044000
  45. C           INITIALIZE PTRS                                             00045000
  46.       DO 2 I=1,2                                                        00046000
  47.       LN(I)=0                                                           00047000
  48.       JP(I)=0                                                           00048000
  49.     2 IEF(I)=0                                                          00049000
  50.       IBFL=ISIZ                                                         00050000
  51.       IDMP=0                                                            00051000
  52.       SEQ(1)=ZEROES                                                     00052000
  53.       WRITE(7,6)                                                        00053000
  54.     6 FORMAT('./ * * * * * * START OF UPDATES - IK0VER * * * * * ')     00054000
  55. C                                                                       00055000
  56. C           RESET COMPARE POINTER IN CASE RECORDS WERE SKIPPED          00056000
  57.    10 DO 20 I=1,2                                                       00057000
  58.    20 LNJ(I)=MOD(LN(I),IBFL)+1                                          00058000
  59. C           START HERE WHEN EXPECTING A MATCH                           00059000
  60.    30 IF(LN(1).GE.JP(1)) CALL CRD(1)                                    00060000
  61.       IF(LN(2).GE.JP(2)) CALL CRD(2)                                    00061000
  62.    80 IF(LN(1).GE.JP(1).OR.LN(2).GE.JP(2)) GOTO 220                     00062000
  63. C           NOW WE HAVE TWO CARDS TO COMPARE                            00063000
  64.       IF(.NOT.CMP(CBF(1,1,LNJ1),CBF(1,2,LNJ2))) GOTO 100                00064000
  65. C           RECORDS MATCH, ADVANCE POINTERS AND CHECK NEXT              00065000
  66.       SEQ(1)=CBF(10,1,LNJ1)                                             00066000
  67.       DO 90 I=1,2                                                       00067000
  68.       LN(I)=LN(I)+1                                                     00068000
  69.       LNJ(I)=LNJ(I)+1                                                   00069000
  70.       IF(LNJ(I).GT.IBFL) LNJ(I)=1                                       00070000
  71.    90 CONTINUE                                                          00071000
  72.       GOTO 30                                                           00072000
  73. C           NON-MATCH, LOOK FOR NEXT MATCH                              00073000
  74.   100 LOOK=1                                                            00074000
  75.       SEQ(2)=CBF(10,1,LNJ1)                                             00075000
  76.       LN12=LN(1)+LN(2)                                                  00076000
  77.       LNT=LNJ1                                                          00077000
  78. C        LOOP ON 'LOOK' (NO. OF CARDS NEEDED IN BUFFER FOR COMPARISON)  00078000
  79.   110 LOOK=LOOK+1                                                       00079000
  80.       LNT=LNT+1                                                         00080000
  81.       IF(LNT.GT.IBFL) LNT=1                                             00081000
  82.       IF(LOOK.LE.IBFL) GOTO 130                                         00082000
  83.       IF(IEF(1).EQ.1.AND.IEF(2).EQ.1) GOTO 140                          00083000
  84. C           BUFFER OVERFLOW, SOME MATCHING MAY BE LOST                  00084000
  85.       WRITE(6,120) IBFL,LN                                              00085000
  86.   120 FORMAT('0***MORE THAN',I4,' NON-MATCHING CARDS BEGINNING AT LINE',00086000
  87.      1 I6,',',I5)                                                       00087000
  88.       IDMP=IDMP+1                                                       00088000
  89.       GOTO 1000                                                         00089000
  90. C           READ CARDS IF NECESSARY                                     00090000
  91.   130 IF(LN(1)+LOOK.GT.JP(1)) CALL CRD(1)                               00091000
  92.       IF(LN(2)+LOOK.GT.JP(2)) CALL CRD(2)                               00092000
  93. C           SEE IF BOTH FILES AT EOF                                    00093000
  94.   140 IF(JP(1)+JP(2)-LN12.LE.LOOK) GOTO 200                             00094000
  95. C           COMPARE AT LEVEL 'LOOK',  'IP(*)' AND 'LNU*' ARE EQUIVALENT 00095000
  96.       IP(1)=LN(1)+LOOK                                                  00096000
  97.       IP(2)=LN(2)+1                                                     00097000
  98.       LNU1=LNT                                                          00098000
  99.       LNU2=LNJ2                                                         00099000
  100.       DO 160 L=1,LOOK                                                   00100000
  101. C           SEE IF OFF THE END OF ONE                                   00101000
  102.       IF(IP(1).GT.JP(1)) GOTO 150                                       00102000
  103.       IF(CMP(CBF(1,1,LNU1),CBF(1,2,LNU2))) GOTO 170                     00103000
  104. C           STILL NO MATCH                                              00104000
  105.   150 IP(1)=IP(1)-1                                                     00105000
  106.       IP(2)=IP(2)+1                                                     00106000
  107. C           SEE IF OFF THE END OF TWO                                   00107000
  108.       IF(IP(2).GT.JP(2)) GOTO 110                                       00108000
  109.       LNU1=LNU1-1                                                       00109000
  110.       IF(LNU1.LT.1) LNU1=IBFL                                           00110000
  111.       LNU2=LNU2+1                                                       00111000
  112.       IF(LNU2.GT.IBFL) LNU2=1                                           00112000
  113.   160 CONTINUE                                                          00113000
  114.       GOTO 110                                                          00114000
  115. C           MATCH FOUND AT IP(1) --- IP(2), MAKE SURE IT'S SIGNIFICANT  00115000
  116.   170 LNV1=LNU1                                                         00116000
  117.       LNV2=LNU2                                                         00117000
  118.       IPS(1)=IP(1)                                                      00118000
  119.       IPS(2)=IP(2)                                                      00119000
  120.       LOOKS=LOOK                                                        00120000
  121.   173 DO 175 I=1,NSYNCH                                                 00121000
  122.       IF(SYNCH(1,I).EQ.CBF(1,1,LNV1).AND.SYNCH(2,I).EQ.CBF(2,1,LNV1))   00122000
  123.      1 GOTO 177                                                         00123000
  124.   175 CONTINUE                                                          00124000
  125.       GOTO 190                                                          00125000
  126.   177 DO 180 I=1,2                                                      00126000
  127.       IF(IPS(I).LT.JP(I)) GOTO 180                                      00127000
  128. C           NEED TO READ NEXT CARD                                      00128000
  129.       IF(LOOKS.GE.IBFL) GOTO 190                                        00129000
  130.       CALL CRD(I)                                                       00130000
  131. C           DON'T INSIST IF A FILE HAS REACHED END                      00131000
  132.       IF(IPS(I).GE.JP(I)) GOTO 190                                      00132000
  133.   180 CONTINUE                                                          00133000
  134. C           NOW TRY NEXT PAIR OF CARDS AFTER MATCH, KEEP LOOKING IF DIF.00134000
  135.       LOOKS=LOOKS+1                                                     00135000
  136.       DO 183 I=1,2                                                      00136000
  137.       IPS(I)=IPS(I)+1                                                   00137000
  138.       LNV(I)=LNV(I)+1                                                   00138000
  139.   183 IF(LNV(I).GT.IBFL) LNV(I)=1                                       00139000
  140.       IF(.NOT.CMP(CBF(1,1,LNV1),CBF(1,2,LNV2))) GOTO 150                00140000
  141.       GOTO 173                                                          00141000
  142. C           ACCEPT MATCH                                                00142000
  143.   190 CALL VDUMP                                                        00143000
  144.       GOTO 10                                                           00144000
  145. C           NO MATCH UP TO END OF BOTH FILES                            00145000
  146.   200 IP(1)=JP(1)+2                                                     00146000
  147.       IP(2)=JP(2)+2                                                     00147000
  148.       GOTO 250                                                          00148000
  149. C           ONE FILE EXHAUSTED                                          00149000
  150.   220 DO 230 I=1,2                                                      00150000
  151.       IF(LN(I).LT.JP(I)) GOTO 240                                       00151000
  152.   230 CONTINUE                                                          00152000
  153. C           BOTH EXHAUSTED.  ALL DONE                                   00153000
  154.       GOTO 1000                                                         00154000
  155. C           ALL EXCESS OF THE REMAINING FILE IS 'NON-MATCHING'          00155000
  156.   240 IP(3-I)=JP(3-I)+2                                                 00156000
  157.       IP(I)=99999999                                                    00157000
  158.   250 CALL VDUMP                                                        00158000
  159. C           PRINT SUMMARY                                               00159000
  160.  1000 IF(IDMP.GT.0) WRITE(6,1010)                                       00160000
  161.  1010 FORMAT(' * * * * DISCREPANCIES')                                  00161000
  162.       STOP                                                              00162000
  163.       END                                                               00163000
  164.       SUBROUTINE VDUMP                                                  00164000
  165. C        ALL LINES BETWEEN LN AND IP ARE TO BE PRINTED AS NON-MATCHING  00165000
  166. C        LN IS UPDATED TO INDICATE LAST MATCH                           00166000
  167. C          INPUT TEXT BUFFER                                            00167000
  168.       COMMON/BUFFER/ CBF(10,2,1)                                        00168000
  169.       CHARACTER*8 CBF                                                   00169000
  170. C          POINTERS                                                     00170000
  171.       COMMON/PTRS/ SEQ(2),LN(2),IP(2),JP(2),IEF(2),IDMP,LOOK,IBFL       00171000
  172.       CHARACTER*8 SEQ                                                   00172000
  173. C...       FORTRAN 77 ONLY...                                           00173000
  174.       CHARACTER*16 SEQX                                                 00174000
  175.       EQUIVALENCE (SEQ,SEQX)                                            00175000
  176. C............................                                           00176000
  177. C                                                                       00177000
  178.       CHARACTER*1 CMDS(3)/'I','D','R'/                                  00178000
  179.       CHARACTER*8 BLNK8/'        '/,SEQB                                00179000
  180. C                                                                       00180000
  181.       NCMD=0                                                            00181000
  182.       IF(IP(1).GT.LN(1)+1) NCMD=2                                       00182000
  183.       IF(IP(2).GT.LN(2)+1) NCMD=NCMD+1                                  00183000
  184.       IF(NCMD.EQ.0 .AND. JP(1).GE.IP(1).AND.JP(2).GE.IP(2)) GOTO 1300   00184000
  185. C           NO CHANGE CARDS FOR LAST GASP                               00185000
  186.       IF(LN(1).GE.JP(1).AND.LN(2).GE.JP(2)) RETURN                      00186000
  187.       IDMP=IDMP+1                                                       00187000
  188.       IF(NCMD.GT.1) SEQ(1)=SEQ(2)                                       00188000
  189.       SEQB=BLNK8                                                        00189000
  190.       LNP1=LN(1)+1                                                      00190000
  191.       IPM1=IP(1)-1                                                      00191000
  192.       IF(IEF(1).EQ.1.AND.IPM1.GT.JP(1)) IPM1=JP(1)                      00192000
  193.       IF(LNP1.GE.IPM1) GOTO 130                                         00193000
  194.       IF(IP(1).LT.99999999) GOTO 120                                    00194000
  195.   110 CALL CRD(1)                                                       00195000
  196.       IF(IEF(1).NE.1) GOTO 110                                          00196000
  197.       IPM1=JP(1)                                                        00197000
  198.   120 LNM=MOD(IPM1-1,IBFL)+1                                            00198000
  199.       SEQB=CBF(10,1,LNM)                                                00199000
  200.   130 LNM=MOD(IPM1,IBFL)+1                                              00200000
  201.       IF(IPM1.LT.JP(1)) SEQ(2)=CBF(10,1,LNM)                            00201000
  202. C----------- CHOOSE ONE ------------------                              00202000
  203. C...        WRITE/READ USING FORTRAN 66...                              00203000
  204. C     WRITE(3,1210) SEQ                                                 00204000
  205. C     REWIND 3                                                          00205000
  206. C     READ(3,135) ISEQ3,ISEQ4                                           00206000
  207. C     REWIND 3                                                          00207000
  208. C...        DECODE USING FORTRAN 77...                                  00208000
  209.       READ(SEQX,135) ISEQ3,ISEQ4                                        00209000
  210. C-----------------------------------------                              00210000
  211. C           FORMAT CAN BE CHANGED TO 2(3X,I5) FOR 'NOSEQ8'              00211000
  212.   135 FORMAT(2I8)                                                       00212000
  213.       NNEW=IP(2)-LN(2)                                                  00213000
  214.       IF(NCMD.EQ.3) NNEW=NNEW-1                                         00214000
  215.       INC=1000                                                          00215000
  216.       IF(IPM1.LT.JP(1)) INC=MAX0(1,(ISEQ4-ISEQ3)/NNEW)                  00216000
  217.       IMOD=1000                                                         00217000
  218.       IF(INC.LT.1000) IMOD=100                                          00218000
  219.       IF(INC.LT.100) IMOD=10                                            00219000
  220.       IF(INC.GT.10) INC=(INC/IMOD)*IMOD                                 00220000
  221.       IF(NCMD.EQ.1) ISEQ3=ISEQ3+INC                                     00221000
  222. C           CAN ADD T6,'   ',T15,'   ' TO FORMATS FOR 'NOSEQ8'          00222000
  223.       IF(NCMD.EQ.2) WRITE(7,140) CMDS(NCMD),SEQ(1),SEQB                 00223000
  224.   140 FORMAT('./ ',A1,1X,A8,1X,A8,T55,'*IK0VER* **TAG***')              00224000
  225.       IF(NCMD.NE.2) WRITE(7,150) CMDS(NCMD),SEQ(1),SEQB,ISEQ3,INC       00225000
  226.   150 FORMAT('./ ',A1,1X,A8,1X,A8,' $',2I9,T55,'*IK0VER* **TAG***')     00226000
  227. C                                                                       00227000
  228.       IF(LN(1).LT.IP(1)) LN(1)=IP(1)                                    00228000
  229.       LNM=MOD(LN(1)-1,IBFL)+1                                           00228300
  230.       IF(LN(1).LE.JP(1)) SEQ(1)=CBF(10,1,LNM)                           00228600
  231.       IF(LN(2).LT.IP(2)) LN(2)=LN(2)+1                                  00229000
  232. C           GET INDEX FOR FIRST CARD                                    00230000
  233.       LNM=MOD(LN(2)-1,IBFL)+1                                           00231000
  234.  1100 IF(LN(2).GE.IP(2)) RETURN                                         00232000
  235. C           SEE IF END OF FILE                                          00233000
  236.  1120 IF(LN(2).GT.JP(2)) RETURN                                         00234000
  237. C           WATCH FOR END OF BUFFER                                     00235000
  238.       IF(LNM.GT.IBFL) LNM=1                                             00236000
  239. C           PUNCH CHANGE CARDS                                          00237000
  240.       WRITE(7,1210) (CBF(J,2,LNM),J=1,9)                                00238000
  241.  1210 FORMAT(10A8)                                                      00239000
  242.  1220 LN(2)=LN(2)+1                                                     00240000
  243.       LNM=LNM+1                                                         00241000
  244.       IF(IP(2).LT.99999999) GOTO 1100                                   00242000
  245. C           INDEFINITE PRINT                                            00243000
  246.       CALL CRD(2)                                                       00244000
  247.       IF(IEF(2).EQ.1) IP(2)=JP(2)+2                                     00245000
  248.       GOTO 1100                                                         00246000
  249. C                                                                       00247000
  250.  1300 LN(1)=IP(1)                                                       00248000
  251.       LN(2)=IP(2)                                                       00249000
  252.       RETURN                                                            00250000
  253.       END                                                               00251000
  254.       SUBROUTINE CRD(I)                                                 00252000
  255. C        READ A CARD FROM FILE I IF NOT ALREADY AT EOF                  00253000
  256. C          CARD BUFFERS                                                 00254000
  257.       COMMON/BUFFER/ CBF(10,2,1)                                        00255000
  258.       CHARACTER*8 CBF                                                   00256000
  259. C          POINTERS                                                     00257000
  260.       COMMON/PTRS/ SEQ(2),LN(2),IP(2),JP(2),IEF(2),IDMP,LOOK,IBFL       00258000
  261.       CHARACTER*8 SEQ                                                   00259000
  262. C                                                                       00260000
  263.       INTEGER*4 ICP(2)                                                  00261000
  264. C                                                                       00262000
  265.       IF(IEF(I).EQ.1) RETURN                                            00263000
  266.       IF(JP(I).EQ.0) ICP(I)=IBFL                                        00264000
  267.       ICP(I)=ICP(I)+1                                                   00265000
  268.       IF(ICP(I).GT.IBFL) ICP(I)=1                                       00266000
  269.       LNM=ICP(I)                                                        00267000
  270.       READ(I,60,END=800) (CBF(J,I,LNM),J=1,10)                          00268000
  271.    60 FORMAT(10A8)                                                      00269000
  272.   100 JP(I)=JP(I)+1                                                     00270000
  273.       RETURN                                                            00271000
  274. C           REACHED END OF FILE                                         00272000
  275.   800 IEF(I)=1                                                          00273000
  276.       RETURN                                                            00274000
  277.       END                                                               00275000
  278.       LOGICAL FUNCTION CMP(BUFA,BUFB)                                   00276000
  279. C           RETURN 'TRUE' IF BUFA = BUFB                                00277000
  280.       CHARACTER*8 BUFA(9),BUFB(9)                                       00278000
  281. C                                                                       00279000
  282.       CMP=.FALSE.                                                       00280000
  283.       DO 100 I=1,9                                                      00281000
  284.   100 IF(BUFA(I).NE.BUFB(I)) RETURN                                     00282000
  285.       CMP=.TRUE.                                                        00283000
  286.       RETURN                                                            00284000
  287.       END                                                               00285000
  288.