home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 6 File / 06-File.zip / gdiff.zip / gdiff.for < prev    next >
Text File  |  1999-11-22  |  57KB  |  1,928 lines
  1. c program to compute a gdiff difference between two files
  2. c 
  3. c
  4. c  Error returns
  5. c 1- failed to specify input file
  6. c 2- problem computing md4 (oldfile)
  7. c 3- problem computing md4 (newfile)
  8. c 4 - bad -blocksize option 
  9. c 5 - verification requires an output file
  10. c 31 - could not open old file
  11. c 32 - problem rewinding old file
  12. c 33 - old file is empty
  13. c 34 - unable to read entire oldfile into memory
  14. c 35 - unable to allocate memory while creating synopsis
  15. c 36 - verification failure
  16. c 37 - unable to open temporary file
  17. c 41 - problem allocating memory to create diff file
  18. c 42 - problem opening newfile
  19. c 43 - internal write problem
  20. c 46 - error writing to ouptut file
  21. c 47 - problem allocating memory to read newfile 
  22. c 48 - problem reading newfile (possibly eof)
  23. c 49 - unable to open output file
  24. c 51 - unable to open "difference file" 
  25. c 52 - not a gdiff formatted difference file
  26. c 53 - unable to read from difference file
  27. c 54 - unimplemented "large move" gdiff command encountered
  28. c 55 - error in ungdiff procedure 
  29. c 56 - illegal gdiff code
  30.  
  31.         include 'fsublib.fi'
  32.  
  33.         character *140 oldfile,newfile,opt1,out_file
  34.         CHARACTER *80 MK_TEMPFILENAME,TMPNAME,version
  35.         character *32 comp_md4,amd4,bmd4,newmd4,newmd4b
  36.  
  37.         integer synsize,oldsize
  38.  
  39.         integer numargs,istat,do_gdiff,do_ungdiff
  40.         integer blocksize,nblocks
  41.         integer do_synopsis 
  42.         character *(*) synopsis         !allocated later
  43.         logical qgotold,q_domd4,qgotnew,q_ungdiff,qgotout,quiet,qverify
  44.         integer i36
  45.         common /cm36/i36,quiet
  46.  
  47.  
  48.  
  49. c ------ being user changeable parameters
  50.  
  51. c blocksize used in synopsis creation (0=program chooses         
  52. c note that blocksize can be overridded by a -blocksize=nnnn argument
  53.         blocksize=0      
  54.  
  55.         i36=6                   ! std output unit number
  56.  
  57.         quiet=.false.
  58.  
  59.         version='GDIFF ver. 1.01'
  60.  
  61. c ------- end of user changeable parameters
  62.  
  63. c read arguments from command line 
  64.  
  65.         numargs=iargc()
  66.          q_ungdiff=qgotold=q_domd4=qgotnew=qgotout=qverify=.false.
  67.         
  68.         oldfile=' '
  69.         newfile=' '
  70.         out_file=' '
  71.  
  72.         do jj=1, numargs-1
  73.             mm=igetarg(jj,opt1)
  74.             if (opt1(1:1).eq.'-') then
  75.                 call captaliz(opt1)
  76.                 if (opt1(1:4).eq.'-MD4') then
  77.                    q_domd4=.true.
  78.                 endif
  79.                 if (opt1(1:4).eq.'-V') then
  80.                    qverify=.true.
  81.                 endif
  82.                 if (opt1(1:8).eq.'-VERSION') then 
  83.                     print *,version
  84.                     call fexit(0)
  85.                     stop
  86.                 endif
  87.                 if (opt1(1:4).eq.'-U') then
  88.                    q_ungdiff=.true.
  89.                 endif
  90.  
  91.                 if (opt1(1:4).eq.'-Q') then
  92.                    quiet=.true.
  93.                 endif
  94.  
  95.                 if (opt1(1:3).eq.'-B=') then
  96.                     read(opt1(4:lentrim(opt1)),*,iostat=ierr)
  97.      1                  blocksize
  98.                     if (ierr.ne.0) then
  99.                         print *,'ERROR Bad blocksize option:',
  100.      1                  opt1(1:lentrim(opt1))
  101.                         call fexit(4)
  102.                         stop
  103.                     endif
  104.                 endif
  105.                 cycle                   ! get next argument
  106.             endif
  107.             if (.not.qgotold) then           !not an option, must be afilename 
  108.                   oldfile=opt1
  109.                   qgotold=.true.
  110.             elseif (.not.qgotnew) then
  111.                  newfile=opt1
  112.                  qgotnew=.true.
  113.             else                   !the output (difference) file
  114.                  out_file=opt1
  115.                  i36=36
  116.             endif
  117.         enddo
  118.  
  119.         if (oldfile.eq. ' ' .or. oldfile.eq.'?')
  120.      1           then 
  121.             print *,'GDiff -- compute a difference between two files'
  122.             print *,' '
  123.             print *,'Syntax:'
  124.             print *,'  x:>GDiff oldfile newfile [out_file]',
  125.      1                  ' [-options]'
  126.             print *,' '
  127.             print *,'Notes: '
  128.             print *,'    * If out_file is not specified, output ',
  129.      1                    'is written to stdout  '
  130.             print *,'    * Options: '
  131.             print *,'       -MD4   -- just compute an MD4 of oldfile ',
  132.      1            ' (and newfile)'
  133.             print *,'       -u     -- undiff (newfile should be',
  134.      1              ' a Gdiff difference file)'
  135.             print *,'       -b=nnn -- use a blocksize of nnn',
  136.      1           '  (0<nnn<2000, 0=program chooses). '
  137.             print *,'       -q     -- quiet (suppress status ',
  138.      1              ' messages)'
  139.             print *,'       -v     -- verify '
  140.             print *,'       -version -- display version info '
  141.  
  142.             print *, '    * GDiff will work on any kind of file',
  143.      1              ' (text or binary)'
  144.             print *,'    * GDiff uses the RSYNC algorithim to compute',
  145.      1              ' differences'
  146.             print *,'    * Specification of the GDIFF format can be',
  147.      1              ' found at: '
  148.             print *,
  149.      1       '         http://www.w3.org/TR/NOTE-gdiff-19970901.html '
  150.             print *,' '
  151.             print *,'Examples: '
  152.             print *,'   x:>GDIFF bigdoc.old bigdoc.new bigdoc.dif -v '
  153.             print *,'   x:>GDIFF -u bigdoc.old bigdoc.dif > bigdoc.nu2'
  154.  
  155.            call fexit(0)
  156.             stop
  157.         endif
  158.  
  159.         if (newfile.eq.' '.and.(.not.q_domd4)) then
  160.            print *,'ERROR you must specify a newfile, ',
  161.      1                  'or a difference file'            
  162.           call fexit(1)
  163.           stop
  164.         endif
  165.               
  166.         if (qverify.and.(.not.q_Ungdiff).and.i36.eq.6) then
  167.              print *,'ERROR to verify, you must specify an output file'
  168.              call fexit(5)
  169.              stop
  170.         endif
  171.  
  172. c just do an md4? 
  173.         if (q_domd4) then
  174.            amd4=comp_md4(oldfile,1)
  175.            if (amd4(1:5).eq.'ERROR') then
  176.                call fexit(2)
  177.                stop 'error'
  178.            endif
  179.            if (newfile.ne.' ') then 
  180.              bmd4=comp_md4(newfile,1)
  181.              if (bmd4(1:5).eq.'ERROR') then
  182.                  call fexit(3)
  183.                  stop 'error'
  184.              endif
  185.            endif
  186.            write(6,*)amd4,' ',bmd4
  187.            call fexit(0)
  188.            stop
  189.         endif
  190.  
  191.  
  192. c compute the GDIFF file, or the undiff file.
  193.  
  194. c in either case, open the oldfile
  195.  
  196. c open the "old" file
  197.         open(unit=41,file=oldfile,access='sequential',status='old',
  198.      1   form='unformatted',recordtype='fixed',iostat=ierr,
  199.      1   action='read')
  200.      
  201.         if (ierr.ne.0) then 
  202.            print *,'ERROR no such file: ',oldfile
  203.            call fexit(31)
  204.            stop
  205.         endif
  206.         rewind(unit=41,iostat=ierr) 
  207.         if (ierr.ne.0) then
  208.            print *,'ERROR unable to read: ',oldfile
  209.            call fexit(32)
  210.            stop
  211.         endif
  212.         oldsize=filesize(41)
  213.         if (oldsize.eq.0) then
  214.             print *,'ERROR empty ',oldfile
  215.             call fexit(33)
  216.             stop
  217.         endif
  218.  
  219. c possibly adjust blocksize 
  220.         if (blocksize.le.0.and. (.not.q_ungdiff)) then 
  221.            if (oldsize.lt.10000) then
  222.                  blocksize=50
  223.            elseif (oldsize.lt.25000) then
  224.                 blocksize=100
  225.            elseif (oldsize.lt.100000) then
  226.                 blocksize=250
  227.            elseif (oldsize.lt.2500000) then
  228.                 blocksize=500
  229.            else
  230.                 blocksize=1000
  231.            endif
  232.            if (.not.quiet.and.i36.ne.6) then
  233.                print *,'Using blocksize of ',blocksize                 
  234.            endif
  235.         endif
  236.  
  237. c Undifference?
  238.       if (q_ungdiff) then
  239.          istat=do_ungdiff(41,newfile,out_file,0)  
  240.          close(unit=41,iostat=ierr)
  241.          if (istat.ne.0) then         !some kind of error
  242.             call fexit(istat)           !write it as output status
  243.             WRITE(6,81)ISTAT
  244.  81         FORMAT('ERROR: ',I5)
  245.             call fexit(istat)
  246.             stop                        ! and give up
  247.         endif
  248.         call fexit(0)
  249.         stop
  250.       endif
  251.   
  252.  
  253. c --- IF here : compute a gdiff difference file
  254. c first, compute a rync synopsis
  255. c so let's allocate space for the synopsis
  256.  
  257.         nblocks=(float(oldsize)/float(blocksize))+0.99999
  258.         synsize=nblocks*20
  259.         allocate (synopsis*synsize,stat=ierr)
  260.         if (ierr.ne.0) then
  261.            call fexit(35)
  262.            stop
  263.         endif
  264.  
  265. c if here, file is open and ready to read
  266. C        print *,' pre dosyn ',nblocks,blocksize
  267.         istat=do_synopsis(41,oldsize,synopsis,blocksize,nblocks)
  268. C        print *,' post dosyn '
  269.         if (istat.ne.0) then       !some kind of error
  270.             call fexit(istat)           !write it as output status
  271.             stop                        ! and give up
  272.         endif
  273.  
  274.  
  275. c then use rsync to compute a gdiff formatted diference file
  276. c (write it to stdout)
  277.  
  278.         istat=do_gdiff(newfile,synopsis,out_file,blocksize,nblocks)
  279.         deallocate(synopsis,stat=ierr)
  280.  
  281.         if (istat.ne.0) then         !some kind of error
  282.             call fexit(istat)           !write it as output status
  283.             WRITE(6,181)ISTAT
  284.  181        FORMAT('ERROR: ',I5)
  285.             stop                        ! and give up
  286.         endif
  287.         
  288. c verify ?
  289.         if ((.not.qverify).or.(i36.eq.6)) then
  290.           close(unit=41,iostat=ierr)
  291.           call fexit(0)
  292.           stop
  293.         endif
  294.  
  295. c md4 of "newfile"
  296.         newmd4=comp_md4(newfile,1)
  297.  
  298. c md4 of "reconstruction"
  299.         TMPNAME=MK_TEMPFILENAME()
  300.         ii=do_ungdiff(41,out_file,TMPNAME,1)
  301.         if (ii.ne.0) then
  302.            call fexit(36)
  303.            stop
  304.         endif        
  305.         newmd4b=comp_md4(TMPNAME,1)
  306.         close(unit=41,iostat=ierr)
  307.  
  308.         if (newmd4.ne.newmd4b) then
  309.            print *,'ERROR verification failed! '
  310.            print *,'  (md4 hashes are: ',newmd4,newmd4b,')'
  311.            call fexit(36)
  312.            OPEN(UNIT=61,FILE=TMPNAME,IOSTAT=IERR)  !DELETE TEMPFILE
  313.            CLOSE(UNIT=61,STATUS='DELETE',IOSTAT=IERR)
  314.            STOP
  315.         ELSE
  316.            IF (.NOT.QUIET) THEN
  317.                 PRINT *,'Reconstructed file passes verification test'
  318.            ENDIF
  319.         endif
  320.         
  321.  
  322.         OPEN(UNIT=61,FILE=TMPNAME,IOSTAT=IERR)  !DELETE TEMPFILE
  323.         CLOSE(UNIT=61,STATUS='DELETE',IOSTAT=IERR)
  324.         call fexit(0)           !SUCCESS 
  325.  
  326.         end
  327.  
  328. C---------
  329. C CREATE A TEMPORARY FILE NAME
  330.         CHARACTER *(*) FUNCTION MK_TEMPFILENAME()
  331.         CHARACTER *80 ANAME,TMPDIR
  332.         CHARACTER *13 ANAME0
  333.         INCLUDE 'FSUBLIB.FI'
  334.         logical qexist
  335.         integer *2 ihr,imin,isec,ihsec
  336.         INTEGER MM,NN
  337.  
  338.         II=FGETENV('TEMP',TMPDIR)
  339.         IF (II.EQ.0) THEN
  340.             PRINT *,'ERROR no TEMP directory (can not verify)'
  341.             call fexit(37)
  342.             STOP
  343.         endif
  344.         if (tmpdir(lentrim(tmpdir):lentrim(tmpdir)).eq.'\') then
  345.            tmpdir=tmpdir(1:lentrim(tmpdir)-1)
  346.         endif
  347.         call gettim(ihr,imin,isec,ihsec)
  348.         do mm=11,99
  349.            nn=10000+imin*360+isec*60+ihsec
  350.            write(aname0,55)nn,mm
  351.  55        format('\GDF',I5,'.T',I2)
  352.            aname=tmpdir(1:lentrim(tmpdir))//aname0
  353.            inquire(file=aname,exist=qexist)
  354.            if (.NOT.qexist) EXIT
  355.         enddo
  356.         if (qexist) then
  357.             PRINT *,'ERROR could not find unused temp name ',
  358.      1          ' (can not verify)'
  359.             call fexit(37)
  360.             STOP
  361.         endif
  362.         
  363.         mk_tempfilename=aname
  364.         return
  365.         end
  366.                 
  367.  
  368.         
  369.  
  370. c=--------------------------------------
  371. c compute an rsync synopsis
  372.  
  373.         integer function do_synopsis(iunit,oldsize,synopsis,
  374.      1                         blocksize,nblocks)
  375.         
  376.         character *(*) synopsis,ablock
  377.         character *32 md1,comp_md4
  378.         character *20 ablock20
  379.         character *8 rs1,rsync32
  380.         integer oldsize,i1
  381.         integer blocksize,nblocks,inext,iunit
  382.         integer mm,jj,ith1
  383.  
  384.         allocate (ablock*blocksize,stat=ierr)
  385.         if (ierr.ne.0) then
  386.              do_synopsis=35
  387.             return
  388.         endif
  389.  
  390. c 20 character entries per block: 4 for rsync32, 16 for md4        
  391.         inext=1
  392.         do ii=1,nblocks
  393.             iget=min(blocksize,1+oldsize-inext)
  394.             read(iunit)ablock(1:iget)
  395.             inext=inext+blocksize
  396.             ith1=0
  397.             rs1=rsync32(ablock(1:iget))
  398.             do mm=1,7,2
  399.                read(rs1(mm:MM+1),99)jj
  400.                ith1=ith1+1
  401.                ablock20(ith1:ith1)=char(jj)
  402.             enddo
  403.  99         format(z2)
  404.  
  405.             md1=comp_md4(ablock(1:iget),0)
  406.             do mm=1,31,2
  407.                read(md1(mm:MM+1),99)jj
  408.                ith1=ith1+1
  409.                ablock20(ith1:ith1)=char(jj)
  410.             enddo
  411.             i1=(ii-1)*20
  412.             synopsis(i1+1:i1+20)=ablock20
  413.         enddo
  414.  
  415. c note: synopsis is returned as an argument
  416.  
  417.         do_synopsis=0           !no error
  418.         deallocate(ablock,stat=ierr)
  419.         return
  420.         end
  421.  
  422.  
  423.  
  424.  
  425. c------------------
  426. c compute a 32 bit rolling checksum 
  427.         character *(*) function rsync32(astring)
  428.  
  429.         character *(*) astring
  430.         character *8 chksum8
  431.         integer chksum,i2,isum,isumb,ilen
  432.  
  433.         ilen=len(astring)
  434.         isumb=isum=0
  435.  
  436.         do i1=1,ilen
  437.           i2=ichar(astring(i1:i1))
  438.           isum=isum+i2
  439.           isumb=((ilen-i1+1)*i2) + isumb
  440.         enddo 
  441.         isum=mod(isum,65536)
  442.         if (isum.lt.0)isum=isum+65536
  443.  
  444.         isumb=mod(isumb,65536)
  445.         if (isumb.lt.0)isumb=isumb+65536
  446.  
  447.         chksum=isum +  (65536*isumb)
  448.  
  449.         write(chksum8,883,iostat=ierr)chksum
  450.  
  451.  883    format(z8)
  452.         rsync32=chksum8
  453.         return
  454.  
  455.         END
  456.  
  457.  
  458. c=--------------------------------------
  459. c compute md4 of a file. Call it asL
  460. c           aa=comp_md4(contents,mode)
  461. c  where aa is character *32
  462. c  contents: filename, or string
  463. c  filemode: if 1, contents is read from filename.
  464. c            otherwise, contents contains the contents
  465.  
  466.     character *(*) function comp_MD4(contents,filemode)
  467.  
  468.         character *32 a32
  469.         character *(*)contents
  470.  
  471.         integer addme,lenorig,lenorig8,filemode
  472.  
  473.         integer *1 pads(64)
  474.         data pads/'80'x,63*'00'x/
  475.  
  476.         integer *1 i1a(4)               !use this for working with 
  477.         integer  i4a
  478.         equivalence (i4a,i1a)
  479.  
  480.         integer mess16(16),x(0:15)                 !16 word chunk to digest
  481.         integer *1 mess64(64)
  482.         equivalence(mess16,mess64,x)
  483.  
  484.         integer lenbits(2)              !# bits in message
  485.         integer *1 lenbits_1(8)
  486.         equivalence(lenbits,lenbits_1)
  487.        
  488.         character *32 ans
  489.         integer leftover,addbytes,dessize
  490.         integer a,b,c,d,aa,bb,cc,dd,il,icc,k,i16,i1,len2,len3,j
  491.  
  492.         integer s11,s12,s13,s14,s21,s22,s23,s24,s31,s32,s33,s34
  493.         integer inbuffer,endbuffer
  494.  
  495.         character *1 a1lc(6)
  496.         data a1lc/'a','b','c','d','e','f'/
  497.  
  498.         character *2048 buffer2048
  499.  
  500.         character *1 achar64(64)
  501.         integer ikk,ngrab
  502.  
  503.         include 'fsublib.fi'
  504.  
  505. c read the inputfile?
  506.         if (filemode.eq.1) then
  507.           open(unit=43,file=contents,access='sequential',status='old',
  508.      1     form='unformatted',recordtype='fixed',iostat=ierr,
  509.      1     action='read')
  510.      
  511.           if (ierr.ne.0) then 
  512.               write(a32,77)ierr
  513.  77           format('ERROR opening file: ',i6)
  514.               comp_md4=a32
  515.               return
  516.           endif
  517.           rewind(unit=43,iostat=ierr)
  518.           if (ierr.ne.0) then
  519.              comp_md4='ERROR could not rewind file'
  520.              return
  521.           endif
  522.           dessize=filesize(43)
  523.           if (dessize.eq.0) then
  524.              comp_md4='ERROR empty file'
  525.              return
  526.           endif
  527.  
  528.         else                            !use contents as is
  529.           dessize=len(contents)
  530.         endif        
  531.  
  532. c nb: md4 of '' is d41d8cd98f00b204e9800998ecf8427e
  533.     
  534.         lenorig=dessize
  535.         lenorig8=8*lenorig
  536.         lenbits(1)=lenorig8
  537.         
  538.         leftover=mod(lenorig8,512)
  539. c pad message to multiple of 512 bits. 
  540. c Last 2 words are 64 bit # bits in message
  541.         if (leftover.eq.448) addme=512
  542.         if (leftover.lt.448) addme=448-leftover
  543.         if (leftover.gt.448) addme=960-leftover
  544.         addBYTES=addme/8
  545.  
  546. c  starting values of registers   
  547.        a ='67452301'x 
  548.        b ='efcdab89'x 
  549.        c ='98badcfe'x 
  550.        d ='10325476'x 
  551.  
  552.        len2=lenorig+ADDBYTES
  553.        len3=len2+8              ! FINAL LENGTH IN BYTES, must be multiple of 64
  554.  
  555.        
  556. c load buffer
  557.        
  558.        if (filemode.eq.1.and.lenorig.gt.2048) then
  559.            read(43,iostat=ierr)buffer2048
  560.            inbuffer=1
  561.            endbuffer=2048
  562.        else
  563.             endbuffer=0
  564.        endif        
  565.  
  566. c  loop through entire message -- 16 words at a time   
  567.        do i1 = 0,((len3/64)-1)
  568.           i16=i1*64
  569.  
  570. c if file mode, load up achar64 buffer (possibly from 2k buffer) 
  571.           if (filemode.eq.1) then               ! read from file
  572.            if (i16+64.le.endbuffer) then  !use the buffer (perhaps refill it)
  573.               do ii1=inbuffer,inbuffer+63
  574.                   achar64(1+ii1-inbuffer)=buffer2048(ii1:ii1)
  575.               enddo
  576.               inbuffer=inbuffer+64
  577.               if (inbuffer.gt.1985.and.(endbuffer+2048.lt.lenorig))
  578.      1                   then
  579.                 read(43,iostat=ierr)buffer2048
  580.                 endbuffer=endbuffer+2048
  581.                 inbuffer=1
  582.               endif
  583.            else                  ! near the end of the file
  584.              if (i16.lt.lenorig) then
  585.                 ngrab=min(64,lenorig-i16)
  586.                 read(43)(achar64(ikk),ikk=1,ngrab) 
  587.              endif               !direct read of achar64
  588.             endif               ! read from buffer
  589.            endif              ! read from file
  590.  
  591.  
  592.           do j=1,64            ! start computing stuff for this 64byte 
  593.  
  594.              k=i16+j    !add this byte 
  595. C add byte from message, padding, or length 
  596.              if (k.le.lenorig) then
  597.                  if (filemode.eq.1) then
  598.                      mess64(j)=ichar(achar64(j))
  599.                   else
  600.                      mess64(j)=ichar(contents(k:k))
  601.                   endif
  602.              else
  603.                 if (k.le.len2) then
  604.                  mess64(j)=pads(k-lenorig)
  605.                 else
  606.                   mess64(j)=lenbits_1(k-len2)
  607.                 ENDIF
  608.              ENDIF
  609.           ENDDO                 !64 BYTES OF BLOCK
  610.  
  611. c  transform this block of 16 chars to 4 values. Save prior values first */
  612.         aa=a
  613.         bb=b
  614.         cc=c
  615.         dd=d
  616.  
  617.  
  618. c do 4 rounds, 16 operations per round (rounds differ in bit'ing functions 
  619.  
  620.         S11=3
  621.         S12=7 
  622.         S13=11
  623.         S14=19
  624.  
  625.           call round1_4(a, b, c, d, x( 0), S11)  ! /* 1 */
  626.           call round1_4(d, a, b, c, x( 1), S12) ! /* 2 */
  627.           call round1_4(c, d, a, b, x( 2), S13) !  /* 3 */
  628.           call round1_4(b, c, d, a, x( 3), S14) !  /* 4 */
  629.           call round1_4(a, b, c, d, x( 4), S11) !  /* 5 */
  630.           call round1_4(d, a, b, c, x( 5), S12) !  /* 6 */
  631.           call round1_4(c, d, a, b, x( 6), S13) !  /* 7 */
  632.           call round1_4(b, c, d, a, x( 7), S14) !  /* 8 */
  633.           call round1_4(a, b, c, d, x( 8), S11) !  /* 9 */
  634.           call round1_4(d, a, b, c, x( 9), S12) !  /* 10 */
  635.           call round1_4(c, d, a, b, x(10), S13) !  /* 11 */
  636.           call round1_4(b, c, d, a, x(11), S14) !  /* 12 */
  637.           call round1_4(a, b, c, d, x(12), S11) !  /* 13 */
  638.           call round1_4(d, a, b, c, x(13), S12) !  /* 14 */
  639.           call round1_4(c, d, a, b, x(14), S13) !  /* 15 */
  640.           call round1_4(b, c, d, a, x(15), S14) !  /* 16 */
  641.  
  642.  
  643.  
  644. c /* Round 2 */
  645.         S21=3
  646.         S22=5
  647.         S23=9 
  648.         S24=13
  649.  
  650.           call round2_4(a, b, c, d, x( 0), S21) !  /* 17 */
  651.           call round2_4(d, a, b, c, x( 4), S22) !  /* 18 */
  652.           call round2_4(c, d, a, b, x( 8), S23) !  /* 19 */
  653.           call round2_4(b, c, d, a, x(12), S24) !  /* 20 */
  654.           call round2_4(a, b, c, d, x( 1), S21) !  /* 21 */
  655.           call round2_4(d, a, b, c, x( 5), S22) !  /* 22 */
  656.           call round2_4(c, d, a, b, x( 9), S23) !  /* 23 */
  657.           call round2_4(b, c, d, a, x(13), S24) !  /* 24 */
  658.           call round2_4(a, b, c, d, x( 2), S21) !  /* 25 */
  659.           call round2_4(d, a, b, c, x( 6), S22) !  /* 26 */
  660.           call round2_4(c, d, a, b, x(10), S23) !  /* 27 */
  661.           call round2_4(b, c, d, a, x(14), S24) !  /* 28 */
  662.           call round2_4(a, b, c, d, x( 3), S21) !  /* 29 */
  663.           call round2_4(d, a, b, c, x( 7), S22) !  /* 30 */
  664.           call round2_4(c, d, a, b, x(11), S23) !  /* 31 */
  665.           call round2_4(b, c, d, a, x(15), S24)!  /* 32 */
  666.  
  667. c  /* Round 3 */
  668.         S31= 3
  669.         S32= 9 
  670.         S33= 11
  671.         S34= 15
  672.  
  673.           call round3_4(a, b, c, d, x( 0), S31) !  /* 33 */
  674.           call round3_4(d, a, b, c, x( 8), S32) !  /* 34 */
  675.           call round3_4(c, d, a, b, x( 4), S33) !  /* 35 */
  676.           call round3_4(b, c, d, a, x(12), S34) !  /* 36 */
  677.           call round3_4(a, b, c, d, x( 2), S31) !  /* 37 */
  678.           call round3_4(d, a, b, c, x(10), S32) !  /* 38 */
  679.           call round3_4(c, d, a, b, x( 6), S33) !  /* 39 */
  680.           call round3_4(b, c, d, a, x(14), S34) !  /* 40 */
  681.           call round3_4(a, b, c, d, x( 1), S31) !  /* 41 */
  682.           call round3_4(d, a, b, c, x( 9), S32) !  /* 42 */
  683.           call round3_4(c, d, a, b, x( 5), S33) !  /* 43 */
  684.           call round3_4(b, c, d, a, x(13), S34) !  /* 44 */
  685.           call round3_4(a, b, c, d, x( 3), S31) !  /* 45 */
  686.           call round3_4(d, a, b, c, x(11), S32) !  /* 46 */
  687.           call round3_4(c, d, a, b, x( 7), S33) !  /* 47 */
  688.           call round3_4(b, c, d, a, x(15), S34) !  /* 48 */
  689.  
  690.  
  691.         A=AA+A
  692.         B=BB+B
  693.         C=CC+C
  694.         D=D+DD
  695.  
  696.  
  697.       enddo
  698.  
  699.       i4a=a
  700.       write(ans(1:8),'(4(z2))')i1a
  701.    
  702.       i4a=b
  703.       write(ans(9:16),'(4(z2))')i1a
  704.  
  705.       i4a=c
  706.       write(ans(17:24),'(4(z2))')i1a
  707.  
  708.       i4a=d
  709.       write(ans(25:32),'(4(z2))')i1a
  710.  
  711. c convert to lower case
  712.        do il=1, 32
  713.           icc=index('ABCDEF',ANS(IL:il))
  714.           if (icc.gt.0) ans(il:il)=a1lc(icc)
  715.        enddo
  716.         
  717.       close(unit=43,iostat=ierr)
  718.       comp_md4=ans
  719.       return
  720.       end
  721.  
  722.  
  723. C  /* md4 round 1 to 4 functins */
  724.  
  725.         SUBROUTINE round1_4(a1,b1,c1,d1,kk,shift)
  726.         INTEGER A1,B1,C1,D1,Kk,SHIFT,T1,T2,f_4
  727.         
  728.         t1=a1+f_4(b1,c1,d1)+ kk 
  729.  
  730.         t2=ISHC(t1,shift)
  731.         A1=T2
  732.         return 
  733.         END
  734.  
  735.  
  736.         SUBROUTINE round2_4(a1,b1,c1,d1,kk,shift)
  737.         INTEGER A1,B1,C1,D1,Kk,SHIFT,T1,T2,g_4,aconst
  738.  
  739.         aconst='5a827999'x
  740.  
  741.         t1=a1+G_4(b1,c1,d1)+ kk + aconst
  742.         t2=ISHC(t1,shift)
  743.         A1=T2
  744.         return 
  745.         END
  746.  
  747.         SUBROUTINE round3_4(a1,b1,c1,d1,kk,shift)
  748.         INTEGER A1,B1,C1,D1,Kk,SHIFT,aconst,T1,T2,h_4
  749.  
  750.         aconst='6ed9eba1'x
  751.  
  752.         t1=a1+H_4(b1,c1,d1)+ kk + aconst
  753.         t2=ISHC(t1,shift)
  754.         A1=T2
  755.         return 
  756.         END
  757.  
  758.  
  759.  
  760.  
  761. c*********** Basic functions */
  762. c* F_4(x, y, z) == (((x) & (y)) | ((~x) & (z))) */
  763.         INTEGER FUNCTION f_4(X,Y,Z)
  764.         INTEGER X,Y,Z,T1,NOTX,t2
  765.         t1=Iand(x,y)
  766.         notx=NOT(x)
  767.         t2=Iand(notx,z)
  768.         t2=Ior(t1,t2)
  769.         f_4=t2
  770.         RETURN
  771.         END
  772.  
  773. c* G_4(x, y, z) == (((x) & (z)) | ((x) & (y)) | ((y) & (z)) ) */
  774.         INTEGER FUNCTION G_4(X,Y,Z)
  775.         INTEGER X,Y,Z,T1,T2,t3,t4
  776.  
  777.         T1=Iand(x,y)
  778.         t2=Iand(x,z)
  779.         t3=iand(y,z)
  780.         t4=Ior(t1,t2)
  781.         g_4=ior(t3,t4)
  782.         RETURN
  783.         END
  784.  
  785. c* H_4(x, y, z) == ((x) ^ (y) ^ (z)) */
  786.         INTEGER FUNCTION H_4(X,Y,Z)
  787.         INTEGER X,Y,Z,T1
  788.  
  789.         t1=IEor(x,y)
  790.         H_4=IEor(t1,z)
  791.         RETURN
  792.         END
  793.  
  794.  
  795.  
  796. c------------------------------
  797. c capitalize a string
  798.  
  799.         subroutine captaliz(sent)
  800.  
  801.         character *(*)sent
  802.         character *1 char
  803.  
  804.         do 100 ij=1,len(sent)
  805.             let=ichar(sent(ij:IJ))
  806.             if (let.ge.97.and.let.le.122) sent(ij:ij)=char(let-32)
  807.  100    continue
  808.         return
  809.         end
  810.  
  811.  
  812. c-----------------------
  813. c using synopsis, and the rsync algorithim, compute a difference and
  814. c output it as a gdiff file (to stdout)
  815.  
  816.         integer function do_gdiff(newfile,synopsis,out_file,
  817.      1                    blocksize,nblocks)
  818.  
  819.         include 'fsublib.fi'
  820.  
  821.     character *(*) synopsis,newfile,ablock,out_file
  822.  
  823.         character *4 ctmp4
  824.         character  *8 ctmp8
  825.         character *32 ctmp32,comp_md4
  826.         character *16 ctmp16
  827.  
  828.         character *20 aline20
  829.         integer mm,ierr,ierrout,ioerror,iserror
  830.         integer ierr1,ierr2,ierr3,ierr4
  831.  
  832.         integer i36
  833.         logical quiet
  834.         common /cm36/i36,quiet
  835.  
  836.         integer hasht(0:65535)
  837.  
  838.         character *10 t1     
  839.         character *5 t2      
  840.         character *1 ac1,ac1a
  841.                 
  842.         integer rsyncs16(:)
  843.         integer rsyncs(:)
  844.         integer index_rsyncs16(:)
  845.         character *16 md4s(:)
  846.  
  847.         integer nblocks,blocksize,ll
  848.         integer matchblock,read_new
  849.         integer ib1,ib2,ialpha,ibeta,chksum
  850.         integer rsync_increment_s
  851.         integer ihasht,i1,blklen,ifoo,gdiff_write,write_6
  852.  
  853.         logical qfirst_32
  854.  
  855.         character *1 wastype
  856.         integer was0,was1,newsize,def_blksiz
  857.         common /ccache/wastype,was0,was1,newsize,def_blksiz
  858.  
  859.  
  860. c the newfile buffer
  861.         character *96384 buffer
  862.         integer bufstart,bufend
  863.         common /ccache2/buffer,bufstart,bufend
  864.  
  865. c do some initializations
  866.         def_blksiz=blocksize            ! default blocksize, used by gdiff_write
  867.         qfirst_32=.false.
  868.         wastype=' '
  869.         do mm=0,65535
  870.            hasht(mm)=0
  871.         enddo
  872.  
  873. c create some storage space
  874.         allocate(rsyncs(1:nblocks),stat=ierr1)
  875.         allocate(index_rsyncs16(1:nblocks),stat=ierr2)
  876.         allocate(md4s(1:nblocks),stat=ierr3)
  877.         allocate(rsyncs16(1:nblocks),stat=ierr4)
  878.         if (ierr1+ierr2+ierr3+ierr4.ne.0) then
  879.           do_gdiff=41
  880.           return
  881.         endif
  882.  
  883. C        print *,' post allocate '
  884.  
  885. c read in nblocks from synopsis (rsync32~md4 pairs)
  886.         do mm=1,nblocks
  887.             i1=1+((mm-1)*20)
  888.             aline20=synopsis(i1:i1+19)
  889.             write(ctmp8,68,err=2024)aline20(1:4)
  890.             read(ctmp8,68,err=2024)rsyncs(mm)
  891.             md4s(mm)=aline20(5:20)
  892.             write(ctmp4,66,err=2024)aline20(1:2)
  893.  66         format(z4)
  894.  68         format(z8)
  895.             read(ctmp4,66,err=2024)rsyncs16(mm)
  896.         enddo
  897.  
  898. C        print *,' done reading synops8s '
  899. c sort each record (sort by leftmost 16 bit hash, as stored in rsyncs16) 
  900.         call quik_indexsort(rsyncs16,index_rsyncs16,nblocks)
  901. C        print *,' post quik '
  902. c  now make the 65k hash table 
  903.         call make_hashtable(nblocks,index_rsyncs16,rsyncs16,hasht)
  904. C        print *,' post hash '
  905. c now open the new version as unit 21  (will set newsize global)
  906.         ifoo=read_new(0,0,newfile)
  907.         if (ifoo.le.0) then     !problem
  908.              do_gdiff=42  
  909.              return
  910.         endif
  911.  
  912. c open output file and  write gdidff header
  913. c open output file
  914.        if (i36.ne.6) then
  915.          open(unit=i36,file=out_file,recordtype='FIXED',
  916.      1                access='sequential',
  917.      1               form='unformatted',iostat=ierr,action='WRITE')
  918.           if (ierr.ne.0) then
  919.               print *,'ERROR Unable to open output file:  ',out_file
  920.               do_gdiff=49
  921.               return
  922.           endif
  923.        endif
  924.  
  925.        t1='d1ffd1ff04'      
  926.        read(t1,13)t2        
  927. 13     format(z10)          
  928.        
  929.        ioerror=write_6(t2)
  930.        if (ioerror.ne.0) then
  931.             do_gdiff=46
  932.             return
  933.        endif
  934.  
  935. c set up stuff to prance through
  936.         ib1=1
  937.         ib2=ib1+blocksize
  938.  
  939.         allocate(ablock*blocksize,stat=ierr)
  940.         if (ierr.ne.0) then
  941.             do_gdiff=47
  942.             return
  943.         endif
  944.  
  945. c read first block (blocksize bytes) of data 
  946.         blklen=read_new(1,ib2-1,ablock)
  947.         if (BLKLEN.lt.0) then
  948.           PRINT *,'ERROR at first block read'
  949.             do_gdiff=48
  950.             return
  951.         endif
  952.  
  953. c compute the rsync for the first block..
  954.         call rsync32_compute(ablock,chksum,ialpha,ibeta)
  955.  
  956. C        print *,' rsync done '
  957.  
  958. c now start the waltz
  959. c from ith char, look for matching block
  960. c if not found, write the character
  961. c if found, write the character
  962. c note that writeit will "cache" results
  963.  
  964.         do while (ib1.le.newsize)  ! stop when all chars examined
  965.            matchblock=0
  966. c check the check16 against the hashtable, etc.
  967.           ihasht=hasht(ibeta)
  968.           if (ihasht.Ne.0) then
  969.               DO LL=IHASHT,NBLOCKS
  970.                  mm=index_rsyncs16(LL)
  971.                  IF (RSYNCS16(MM).NE.IBETA) EXIT  !NO MATCH
  972.                  IF (RSYNCS(MM).NE.CHKSUM) CYCLE  !TRY NEXT 32BIT HASH
  973.  
  974.                  blklen=read_new(ib1,ib2-1,ablock)        !now get actual block
  975.                  if (BLKLEN.lt.0) then            !to compute md4
  976.                    print *,'ERROR at block read pre md4 '
  977.                    do_gdiff=48
  978.                    return
  979.                  endif
  980.  
  981.                  ctmp32=comp_md4(ablock(1:blklen),0)
  982.                  read(ctmp32,133,err=2024)ctmp16      !try the 128 bit hash
  983.  133             format(z32)
  984.                  if (qfirst_32) then     ! just look at  first 32 bits?
  985.                      if (ctmp16(1:4).ne.md4s(mm)(1:4)) cycle
  986.                  else 
  987.                      if (ctmp16.ne.md4s(mm)) cycle    !look at 128 bits  
  988.                  endif
  989.                  matchblock=mm
  990.                  exit
  991.               enddo
  992.           endif                 !hash table match
  993.  
  994. c no match? record this character, and roll the rsync ...
  995.           if (matchblock.eq.0) then            !not a matching block 
  996.                iserror=gdiff_write('C',ib1,0)
  997.                if (iserror.ne.0) then
  998.                    rsync_gdiff=46
  999.                    return
  1000.                endif
  1001.             
  1002. c COMPUTE ROLLING CHECKSUM (also save alpha,beta
  1003.             if (ib2.le.newsize) then            !increment 32bit checksum
  1004.                 ifoo=read_new(ib2,ib2,ac1)
  1005.                 if (ifoo.lt.0) then
  1006.                    print *,
  1007.      1      'ERROR reading last char (',ib2,') for rolling checksum'
  1008.                     do_gdif=48
  1009.                     return
  1010.                 endif
  1011.                 ifoo=read_new(ib1,ib1,ac1a)
  1012.                 if (ifoo.lt.0) then
  1013.                    print *,
  1014.      1      'ERROR reading first char (',ib1,') for rolling checksum'
  1015.                     do_gdif=48
  1016.                     return
  1017.                 endif
  1018.  
  1019.                  chksum=rsync_increment_s(ac1a,ac1,ialpha,   !compute rolling checksum
  1020.      1                                   ibeta,blocksize)
  1021.  
  1022.                ib1=ib1+1                   ! begin next block here 
  1023.                ib2=ib2+1
  1024.             else
  1025.                 if (ib1.ge.newsize) exit  !all done
  1026.                 ib1=ib1+1                   ! begin next block here
  1027.                 blklen=read_new(ib1,newsize,ablock)  !too messy to compute increment,
  1028.                 if (blklen.lt.0) then
  1029.                   do_gdiff=48
  1030.                   print *,'ERROR reading near end of file block '
  1031.                   return
  1032.                 endif
  1033.                 call rsync32_compute(ablock(1:blklen),chksum,     !so just compute using 
  1034.      1                               ialpha,ibeta)              !all characters
  1035.                 ib2=newsize+1
  1036.             endif
  1037.             cycle                       !get next block
  1038.          endif                          !  not a match
  1039.  
  1040. c if here, got a rsync16, 32, and md4 match. So write some results
  1041.  
  1042.          iserror=gdiff_write('B',matchblock,blklen)
  1043.          if (iserror.ne.0) then
  1044.               rsync_gdiff=49
  1045.               return
  1046.          endif
  1047.  
  1048.          if (ib2.gt.newsize) exit  ! done
  1049.          ib1=ib1+blocksize     ! skip past this block, and start searching again 
  1050.          ib2=ib1+blocksize      
  1051.          blklen=read_new(ib1,ib2-1,ablock)
  1052.          if (blklen.lt.0) then
  1053.                 print *,'ERROR reading skip to next block '
  1054.                 do_gdiff=48
  1055.                 return
  1056.         endif
  1057.          call rsync32_compute(ablock(1:blklen),chksum,ialpha,ibeta)
  1058.  
  1059.        enddo            !scan over all characters 
  1060.  
  1061. c add any "unmatched characters 
  1062.         iserror=gdiff_write('F',0,0)
  1063.         if (iserror.ne.0) then
  1064.             rsync_gdiff=46
  1065.             return
  1066.         endif
  1067.  
  1068.         call write_int(0,1)   ! close gdiff file
  1069.  
  1070.         close (unit=21,iostat=ierrout)  !close new file
  1071.         close (unit=36,iostat=ierrout)  ! close output file
  1072.  
  1073.         if (.not.quiet.and.i36.ne.6) then
  1074.           open(unit=i36,file=out_file,iostat=ierr,
  1075.      1         action='read',form='unformatted')
  1076.           if (ierr.ne.0) return
  1077.           iout=filesize(36)
  1078.           if (lentrim(out_File).lt.40) then
  1079.               write(6,51)iout,out_file(1:lentrim(out_file))
  1080.  51           format('OK ',i9,' bytes written to difference file ',a)
  1081.            else
  1082.               write(6,53)iout,out_file(1:lentrim(out_file))
  1083.  53           format('OK ',i9,' bytes written to difference file: '/a)
  1084.            endif
  1085.            close(unit=i36,iostat=ierr)
  1086.        endif
  1087.  
  1088.         deallocate(rsyncs,stat=ierr )
  1089.         deallocate(md4s,stat=ierr )
  1090.         deallocate(rsyncs16,stat=ierr )
  1091.         deallocate(index_rsyncs16,stat=ierr )
  1092.         deallocate(ablock,stat=ierr)
  1093.  
  1094.         do_gdiff=0
  1095.         return
  1096.  
  1097.  
  1098. c ------ status and errors
  1099.  2024   continue
  1100.         do_gdiff=43
  1101.         return
  1102.  
  1103.  
  1104.       end       
  1105.  
  1106. c-------------------------------------------
  1107. c write to an output device (on unit i36)
  1108.         integer function write_6(ac)
  1109.         character *(*)ac
  1110.  
  1111.         integer i36
  1112.         logical quiet
  1113.         common /cm36/i36,quiet
  1114.  
  1115.         if (i36.ne.6) then
  1116.             write(i36,iostat=ierr)ac
  1117.             write_6=ierr
  1118.             return
  1119.         else
  1120.         ill=len(ac)
  1121.            do mm=1,ill
  1122.              write(i36,55,iostat=ierr)ac(mm:mm)
  1123.              if (ierr.ne.0) then
  1124.                 write_6=ierr
  1125.                 return
  1126.              endif          
  1127.            enddo
  1128.            write_6=0
  1129.            return
  1130.          endif
  1131.  55     format(a1,$)
  1132.  
  1133.         end
  1134.         
  1135.  
  1136. c-------------------------------------------
  1137. c function to read from unit 21, into astring.
  1138. c start and end bytes of read are given, as well
  1139. c as file size (if end of read>filesize, read 
  1140. c until filesize).
  1141. c Returns astring in argument,
  1142. c function value is  length of astring (usually
  1143. c 1+end-start, but possibly 1+file_size-start read from 
  1144.  
  1145.         integer function read_new(istart,iend0,astring)
  1146.  
  1147.         include 'fsublib.fi'
  1148.  
  1149.         integer istart,iend,iend0
  1150.         character *(*) astring
  1151.  
  1152.         integer ido,ierr
  1153.         character *1 wastype
  1154.         integer was0,was1,newsize,def_blksiz
  1155.         common /ccache/wastype,was0,was1,newsize,def_blksiz
  1156.  
  1157. c the newfile buffer
  1158.         character *96384 buffer
  1159.         integer bufstart,bufend
  1160.         common /ccache2/buffer,bufstart,bufend
  1161.   
  1162.       
  1163. c initialize?
  1164.         if (istart+iend0.eq.0) then      
  1165.             open(unit=21,file=astring,
  1166.      1          access='SEQUENTIAL',
  1167.      1        status='old',form='unformatted',
  1168.      1        recordtype='fixed',iostat=ierr,action='read')
  1169.            if (ierr.ne.0) then 
  1170.                 print *,'ERROR unable to open ',
  1171.      1                  astring(1:lentrim(astring))
  1172.                 read_new=-1
  1173.                 return
  1174.            else
  1175.               newsize=filesize(21)   
  1176.               read_new=newsize
  1177.            endif
  1178.  
  1179. c  prime the buffer
  1180.  
  1181.            bufstart=1
  1182.            BUFEND=MIN(NEWSIZE,96384)
  1183.            read(21,iostat=ierr)buffer(1:BUFEND)
  1184.            if (ierr.ne.0) then          !error reading
  1185.                 read_new=-1
  1186.            endif
  1187.            return                       ! end of initialization
  1188.         endif
  1189.  
  1190.         iend=min(iend0,newsize)         !correct upper limit
  1191.         ido=1+iend-istart               ! characters to be returned
  1192.        
  1193. c check for bad range
  1194.         if (iend.lt.istart.or.istart.gt.newsize) then ! check for error
  1195.           PRINT *,'ERROR out of range ',ISTART,IEND,NEWSIZE
  1196.           read_new=-1
  1197.           return
  1198.         endif
  1199.  
  1200.  
  1201. c within buffer? don't do anything 
  1202.         if (istart.ge.bufstart.and.iend.le.bufend) then 
  1203.            continue
  1204.  
  1205. c otherwise, reload buffer
  1206. c  if (iend.lt.bufstart .or. istart.gt.bufend) then    !get fancy later 
  1207.  
  1208.         else
  1209.           II=SEEKUNIT(21,ISTART-1,0)
  1210.           IF (II.LT.0) THEN
  1211.               PRINT *,'ERROR BAD SEEKUNIT ',ISTART,II
  1212.               READ_NEW=-1
  1213.               RETURN
  1214.            ENDIF
  1215.            NRD=1+MIN(NEWSIZE,ISTART+96383)-ISTART
  1216.            read(21,iostat=ierr)buffer(1:NRD)
  1217.           IF (IERR.NE.0) THEN
  1218.               PRINT *,'ERROR BAD READ ',IERR,ISTART,NRD
  1219.               READ_NEW=-1
  1220.               RETURN
  1221.            ENDIF
  1222.  
  1223.            BUFSTART=ISTART
  1224.            BUFEND=BUFSTART+NRD-1
  1225.         ENDIF
  1226.  
  1227. c now we are ready to send back the info
  1228.        ioff1=1+istart-bufstart
  1229.        ioff2=ioff1+ido-1
  1230.        astring(1:ido)=buffer(ioff1:ioff2)
  1231.        read_new=ido
  1232.        return
  1233.        end
  1234.  
  1235.  
  1236. c-------------------------------------------
  1237. c write to stout using gdiff format
  1238. c if B (block found) call, then need to use "blksiz" (current
  1239. c blocksize) to find end (use def_blksize for beginning 
  1240.  
  1241.         integer function gdiff_write(atype,iat,blksiz)
  1242.  
  1243.         character *(*)atype
  1244.         integer iat,iserror ,blksiz
  1245.         integer ndo,ns1,blklen,read_new
  1246.         integer jas1,jassize
  1247.         character *1 wastype
  1248.  
  1249.         CHARACTER *4096 C4096
  1250.  
  1251.  
  1252.         integer was0,was1,newsize,def_blksiz,write_6
  1253.         common /ccache/wastype,was0,was1,newsize,def_blksiz
  1254.         COMMON /CSUM/KSUM
  1255.         DATA KSUM/0/
  1256.  
  1257.         iserror=0
  1258.  
  1259.         if (wastype.eq.' ') then          ! first call  
  1260.           if (atype.eq.'C') then
  1261.               was0=was1=iat
  1262.           else
  1263.               was0=((iat-1)*def_blksiz)+1
  1264.               was1=was0+blksiz-1
  1265.           endif
  1266.           wastype=atype
  1267.  
  1268.           gdiff_write=0
  1269.           return
  1270.         endif
  1271.  
  1272. c case 1: C,B
  1273.         if (atype.ne.'C'.and.wastype.eq.'C') then  ! flush chars, start new block 
  1274.           ndo=1+was1-was0    
  1275.           if (ndo.lt.247) then
  1276.              call write_int(ndo,1)
  1277.           else
  1278.              if (ndo.lt.65536) then      ! 2 bytes
  1279.                 call write_int(247,1)
  1280.                 call write_int(ndo,2)
  1281.              else
  1282.                 call write_int(248,1)
  1283.                 call write_int(ndo,4)
  1284.              endif
  1285.           endif
  1286.           do jj=was0,was1,4096
  1287.              blklen=read_new(JJ,MIN(JJ+4095,WAS1),C4096)
  1288.              if (blklen.GE.1) then
  1289.                 iserror=write_6(c4096(1:blklen))
  1290.              else
  1291.                  print *,'ERROR with ',Jj
  1292.              endif
  1293.              if (iserror.ne.0.or.blklen.lt.0) then
  1294.                 print *,'ERROR writing character run ',blklen,iserror
  1295.                   gdiff_write=-1
  1296.                   return
  1297.              endif
  1298.           enddo
  1299.           wastype=atype         !not strictly needed if "F"
  1300.           was0=((iat-1)*def_blksiz)+1
  1301.           was1=was0+blksiz-1
  1302.           gdiff_write=0
  1303.           return
  1304.       endif
  1305.  
  1306. c case 2: C,C
  1307.       if (atype.eq.'C'.and.wastype.eq.'C') then        !augment a characters run
  1308.              was1=iat
  1309.              gdiff_write=0
  1310.              return
  1311.       endif
  1312.         
  1313. c case 3: B,B
  1314.       if (atype.eq.'B'.and.wastype.eq.'B') then    !augment a block run, or flush 
  1315.          ns1=(iat-1)*def_blksiz
  1316.          if (ns1.eq.was1) then               !augment
  1317.              was1=was1+blksiz
  1318.              gdiff_write=0
  1319.              return
  1320.          endif
  1321.  
  1322.          jas1=was0       ! record a copy range
  1323.          jassize=1+was1-was0
  1324.          
  1325.          if (jas1.lt.65536) then
  1326.             if (jassize.lt.256) then 
  1327.                 call write_int(249,1)
  1328.                 call write_int(jas1,2)
  1329.                 call write_int(jassize,1)
  1330.             elseif (jassize.lt.65536) then
  1331.                 call write_int(250,1)
  1332.                 call write_int(jas1,2)
  1333.                 call write_int(jassize,2)
  1334.             else
  1335.                 call write_int(251,1)
  1336.                 call write_int(jas1,2)
  1337.                 call write_int(jassize,4)
  1338.             endif
  1339.          else                           !position > 65535
  1340.             if (jassize.lt.256) then 
  1341.                 call write_int(252,1)
  1342.                 call write_int(jas1,4)
  1343.                 call write_int(jassize,1)
  1344.             elseif (jassize.lt.65536) then
  1345.                 call write_int(253,1)
  1346.                 call write_int(jas1,4)
  1347.                 call write_int(jassize,2)
  1348.             else
  1349.                 call write_int(254,1)
  1350.                 call write_int(jas1,4)
  1351.                 call write_int(jassize,4)
  1352.             endif
  1353.          endif
  1354.  
  1355.          was0=ns1+1
  1356.          was1=was0+blksiz-1
  1357.  
  1358.          gdiff_write=0
  1359.          return
  1360.        endif
  1361.  
  1362. c case 4: B,C
  1363.       if (atype.ne.'B'.and.wastype.eq.'B') then    !flush a block run, start char run
  1364.  
  1365.          jas1=was0       ! record a copy range
  1366.          jassize=1+was1-was0
  1367.  
  1368.          if (jas1.lt.65536) then
  1369.             if (jassize.lt.256) then 
  1370.                 call write_int(249,1)
  1371.                 call write_int(jas1,2)
  1372.                 call write_int(jassize,1)
  1373.             elseif (jassize.lt.65536) then
  1374.                 call write_int(250,1)
  1375.                 call write_int(jas1,2)
  1376.                 call write_int(jassize,2)
  1377.             else
  1378.                 call write_int(251,1)
  1379.                 call write_int(jas1,2)
  1380.                 call write_int(jassize,4)
  1381.             endif
  1382.          else                           !position > 65536
  1383.             if (jassize.lt.256) then 
  1384.                 call write_int(252,1)
  1385.                 call write_int(jas1,4)
  1386.                 call write_int(jassize,1)
  1387.             elseif (jassize.lt.65536) then
  1388.                 call write_int(253,1)
  1389.                 call write_int(jas1,4)
  1390.                 call write_int(jassize,2)
  1391.             else
  1392.                 call write_int(254,1)
  1393.                 call write_int(jas1,4)
  1394.                 call write_int(jassize,4)
  1395.             endif
  1396.          endif
  1397.  
  1398.          was0=was1=iat
  1399.          wastype=atype          !not strictly needed if "F"
  1400.          gdiff_write=0
  1401.          return
  1402.  
  1403.         endif
  1404.  
  1405.  
  1406.  
  1407.          
  1408.         end
  1409.         
  1410. cc--------------
  1411. c write a 1, 2 or 4 byte integer to unit
  1412.         subroutine write_int(ival,nbytes)
  1413.         integer ival,iserror,nbytes
  1414.         character *1 c1
  1415.         character *2 c2
  1416.         character *4 c4
  1417.         character *8 c8
  1418.         integer write_6
  1419.  
  1420.  111       format(z4)
  1421.  1111       format(z8)
  1422.         if (nbytes.eq.1) then
  1423.              c1=char(ival)
  1424.              iserror=write_6(c1)
  1425.              if (iserror.gt.0) goto 10
  1426.              return
  1427.        endif
  1428.      
  1429.        if (nbytes.eq.2) then
  1430.             write(c4,111)ival
  1431.             read(c4,111)c2
  1432.             iserror=write_6(c2)
  1433.             if (iserror.gt.0) goto 10
  1434.  
  1435.            return
  1436.         endif
  1437.  
  1438. c otherwise use 4bytes (assume value < 2billion 
  1439.         write(c8,1111)ival
  1440.         read(c8,1111)c4
  1441.         iserror=write_6(c4)
  1442.         if (iserror.gt.0) goto 10
  1443.  
  1444.         return
  1445.  
  1446.  10     print *,'ERROR writing integer: ',ival
  1447.         stop
  1448.  
  1449.         end      
  1450.  
  1451.         subroutine make_hashtable(nblocks,index_rsyncs16, 
  1452.      1                     rsyncs16,hasht)
  1453.         integer rsyncs16(1)
  1454.         integer index_rsyncs16(1)
  1455.         integer  hasht(0:65535)
  1456.         integer ink,mm,ll,nblocks
  1457.  
  1458.         do mm=1,nblocks
  1459.            ink=index_rsyncs16(mm)
  1460.            ll=rsyncs16(ink)
  1461.            if (hasht(ll).eq.0) then
  1462.                  hasht(ll)=mm
  1463.            endif
  1464.         enddo
  1465.         return
  1466.         end
  1467.  
  1468.  
  1469. c---------------
  1470.         subroutine rsync32_compute(astring,chksum,ialpha,ibeta)
  1471.         integer chksum,ialpha,ibeta
  1472.         character *(*)astring
  1473.         integer isum,i2,i1,ilen
  1474.  
  1475.         ilen=len(astring)
  1476.  
  1477. c compute alpha
  1478.         isum=0
  1479.         do i1=1,ilen
  1480.           i2=ichar(astring(i1:i1))
  1481.           isum=isum+i2
  1482.         enddo 
  1483.         isum=mod(isum,65536)
  1484.         if (isum.lt.0)isum=isum+65536
  1485.         ialpha=isum
  1486.  
  1487.  
  1488. c compute beta     
  1489.         isum=0
  1490.         do i1=1,ilen
  1491.           i2=ichar(astring(i1:i1))
  1492.           isum=((ilen-i1+1)*i2) + isum
  1493.         enddo 
  1494.         isum=mod(isum,65536)
  1495.         if (isum.lt.0)isum=isum+65536
  1496.         ibeta=isum
  1497.  
  1498.         chksum=ialpha +  (65536*ibeta)
  1499.  
  1500.         return
  1501.         end
  1502.  
  1503.  
  1504. c----------------
  1505. c COMPUTE ROLLING CHECKSUM */
  1506.         integer function rsync_increment_s(oldchar,newchar,ialpha,
  1507.      1                          ibeta,ib)
  1508.         character *1 oldchar,newchar
  1509.         integer ialpha,ibeta,ioldchar,inewchar,ib
  1510.         IOLDCHAR=ichar(oldchar)
  1511.         INEWCHAR=ichar(newchar)
  1512.         ialpha=ialpha- Ioldchar + Inewchar
  1513.          ialpha=mod(ialpha,65536)
  1514.          if (ialpha.lt.0) ialpha=65536+ialpha
  1515.          ibeta=ibeta-(ib*ioldchar)+ialpha
  1516.          ibeta=mod(ibeta,65536)
  1517.         if (ibeta.lt.0) ibeta=65536+ibeta
  1518.         rsync_increment_s=ialpha+(ibeta*65536)
  1519.         return
  1520.         end
  1521.  
  1522. c==============================================================
  1523. c  sort to an index.  Index is integer, array to sort is integer
  1524. c Based on QUIKSORT
  1525.  
  1526.         SUBROUTINE quik_iNDEXSORT(X,xindex,nx)
  1527.  
  1528.         integer  x(1),pivotv
  1529.         integer    xindex(1),nx
  1530.         integer stack(5000)
  1531.         integer segbeg,segend,segsize,ep,bp,mid
  1532.         integer lenend,lenbeg,newpivot,nspt,ij
  1533.  
  1534.         logical QPopSort_rsync
  1535.  
  1536.         nspt=0
  1537.  
  1538. c initialize stack
  1539.         do 2 ij=1,5000
  1540.            stack(ij)=0
  1541.   2     continue
  1542.  
  1543.         do 3 ij=1,nx
  1544.            xindex(ij)=ij
  1545.  3      continue
  1546.         
  1547.         segbeg=1
  1548.         segend=nx
  1549.  
  1550. c  first "sort"
  1551.         call indqsort3_rsync(segbeg,mid,segend,pivotv,x,xindex)
  1552.         if (nx.le.3) goto 2000
  1553.  
  1554.  100    continue
  1555.         bp=segbeg
  1556.         ep=segend
  1557. C        print *,bp,MID,EP,':',
  1558. C     1       X(XINDEX(BP)),X(XINDEX(MID)),X(XINDEX(EP))
  1559.  
  1560.  200    continue
  1561.         if (x(xindex(bp)).le.pivotv .and.bp.lt.segend) then
  1562.           bp=bp+1
  1563. C         print *,'bp ',bp,SEGEND,X(XINDEX(BP))
  1564.  
  1565.           goto 200
  1566.         endif
  1567.  
  1568.  300    continue
  1569.         if (x(xindex(ep)).ge.pivotv.and.Ep.gt.segbeg) then
  1570.             ep=ep-1
  1571. C            PRINT *,' EP ',EP,SEGBEG,X(XINDEX(EP))
  1572.             goto 300
  1573.         endif
  1574.  
  1575.         if (ep.gt.bp) then
  1576.            call intswap_rsync(xindex(bp),xindex(ep))
  1577.            bp=bp+1
  1578.            ep=ep-1
  1579. C           PRINT *,' BP EP ',BP,EP
  1580.            goto 200
  1581.         endif
  1582.  
  1583.  
  1584.         if (bp.gt.mid) then
  1585.           if (ep.gt.mid) then
  1586.               call intswap_rsync(xindex(ep),xindex(mid))
  1587.               newpivot=ep
  1588.           else
  1589.               newpivot=mid
  1590.           endif
  1591.         else
  1592.            call intswap_rsync(xindex(bp),xindex(mid))
  1593.            newpivot=bp
  1594.         endif
  1595.  
  1596.         lenend=segend-newpivot
  1597.         lenbeg=newpivot-segbeg
  1598.  
  1599.         if (lenend.gt.lenbeg) then
  1600.            call pushsort_rsync(newpivot+1,segend,stack,nspt)
  1601.            segend=newpivot-1
  1602.            segsize=lenbeg
  1603.         else
  1604.            call pushsort_rsync(segbeg,newpivot-1,stack,nspt)
  1605.            segbeg=newpivot+1
  1606.            segsize=lenend
  1607.         endif
  1608.  
  1609.         call indqsort3_rsync(segbeg,mid,segend,pivotv,x,xindex)
  1610.  
  1611.         if (segsize.gt.3) goto 100
  1612.  
  1613.  1000   continue
  1614.         if (.not.QPopSort_rsync(segbeg,segend,stack,nspt)) then
  1615.             goto 2000
  1616.         else
  1617.            segsize=segend-segbeg+1
  1618.            call indqsort3_rsync(segbeg,mid,segend,pivotv,x,xindex)
  1619.            if (segsize.le.3) then
  1620.              goto 1000
  1621.            else
  1622.              goto 100
  1623.            endif
  1624.         endif
  1625.  
  1626.  2000   continue
  1627. C        print *,' endo quitk'
  1628.          return
  1629.         end
  1630.  
  1631.  
  1632.  
  1633.  
  1634.  
  1635. c--------
  1636.         subroutine indqsort3_rsync(segbeg,mid,segend,pivotv,x,xindex)
  1637.  
  1638.         integer x(1),pivotv
  1639.         integer segbeg,mid,segend
  1640.         integer xindex(1)
  1641.  
  1642.         mid=(segbeg+segend)/2
  1643.         if (segbeg+1.eq.segend) then
  1644.             if (x(xindex(segbeg)).gt.x(xindex(segend))) then
  1645.                call intswap_rsync(xindex(segbeg),xindex(segend))
  1646.             endif
  1647.             return
  1648.         endif
  1649.  
  1650.         if (x(xindex(segbeg)).gt.x(xindex(mid))) then
  1651.             if (x(xindex(segbeg)).gt.x(xindex(segend))) then
  1652.               call intswap_rsync(xindex(segbeg),xindex(segend))
  1653.               if (x(xindex(segbeg)).gt.x(xindex(mid))) then
  1654.                 call intswap_rsync(xindex(segbeg),xindex(mid))
  1655.               endif
  1656.             else
  1657.               call intswap_rsync(xindex(segbeg),xindex(mid))
  1658.             endif
  1659.         else
  1660.             if (x(xindex(mid)).gt.x(xindex(segend))) then
  1661.                call intswap_rsync(xindex(mid),xindex(segend))
  1662.                if (x(xindex(segbeg)).gt.x(xindex(mid))) then
  1663.                  call intswap_rsync(xindex(segbeg),xindex(mid))
  1664.                endif
  1665.             else
  1666.                continue
  1667.             endif
  1668.         endif
  1669.  
  1670.         pivotv=x(xindex(mid))
  1671.         return
  1672.         end
  1673.  
  1674.  
  1675.         subroutine intswap_rsync(ix,iy)
  1676.         integer it,ix,iy
  1677.         it=ix
  1678.         ix=iy
  1679.         iy=it
  1680.         return
  1681.         end
  1682.  
  1683.  
  1684.         subroutine pushsort_rsync(sb,se,stack,stackct)
  1685.         integer se,sb,stack(1),stackct
  1686.  
  1687.  
  1688.         if (stackct+2.gt.5000) then
  1689. c           print *,'ERROR in QUIKSORT: ARRAY TOO LONG '
  1690.            stop 0
  1691.         endif
  1692.  
  1693.         stackct=stackct+1
  1694.         stack(stackct)=sb
  1695.  
  1696.         stackct=stackct+1
  1697.         stack(stackct)=se
  1698.  
  1699.         return
  1700.         end
  1701.  
  1702.  
  1703.         logical function QPopSort_rsync(sb,se,stack,stkpoint)
  1704.         integer sb,se,stack(1),stkpoint
  1705.  
  1706.         if (stkpoint-1.le.0)then
  1707.            qpopsort_rsync=.false.
  1708.            return
  1709.         endif
  1710.  
  1711.         se=stack(stkpoint)
  1712.         stkpoint=stkpoint-1
  1713.         sb=stack(stkpoint)
  1714.         stkpoint=stkpoint-1
  1715.         qpopsort_rsync =.true.
  1716.         return
  1717.         end
  1718.  
  1719.  
  1720.  
  1721. c-----------------------
  1722. c using difference file, and old file, recreate "new file" (ungdiff)
  1723.  
  1724.         integer function do_ungdiff(iunit,dif_file,out_file,iquiet)
  1725.         character *(*) dif_file,out_file
  1726.         integer iunit,iquiet
  1727.         character *1 c1
  1728.         character *1000 c1000
  1729.         character *4 c4,c4a
  1730.         character *2 c2,c2a
  1731.         character *8 c8
  1732.         integer i4,iget,nget,c_to_int,write_6,iserror,ierr
  1733.  
  1734.         include 'fsublib.fi'
  1735.  
  1736.         integer i36
  1737.         logical quiet
  1738.         common /cm36/i36,quiet
  1739.  
  1740. c iunit points to the "old file"
  1741. c now open the "dif_file"
  1742.         open(unit=42,file=dif_file,access='sequential',status='old',
  1743.      1   form='unformatted',recordtype='fixed',iostat=ierr,
  1744.      1   action='read')
  1745.         if (ierr.ne.0) then
  1746.              do_ungdiff=51
  1747.              return
  1748.          endif
  1749.  
  1750. c is this a real difference file
  1751.         read(42,iostat=ierr)c1000(1:4),c1
  1752.  
  1753. c note: dif_file will be gone through sequentially. 41 (oldfile)
  1754. c will be jumped around in
  1755.  
  1756.        c8='d1ffd1ff'      
  1757.        read(c8,13)c4        
  1758.  13    format(z8)          
  1759.  
  1760.         if (c4.ne.c1000(1:4)) then
  1761.            do_ungdiff=52
  1762.            print *,'ERROR not a gdiff formatted difference file'
  1763.            return
  1764.         endif
  1765.  
  1766.  
  1767. c open output file?
  1768.        if (i36.ne.6) then
  1769.          open(unit=i36,file=out_file,recordtype='FIXED',
  1770.      1                access='sequential',
  1771.      1               form='unformatted',iostat=ierr,action='WRITE')
  1772.           if (ierr.ne.0) then
  1773.               print *,'ERROR Unable to open output file:  ',out_file
  1774.               do_gdiff=49
  1775.               return
  1776.           endif
  1777.        endif
  1778.  
  1779. c read codes from difference file, and write info accordingly
  1780.        do while (1.eq.1)               !do forever
  1781.         
  1782.         read(42,err=1010)c1
  1783.  
  1784.         itype=ichar(c1)   
  1785.  
  1786.         if (itype.eq.0) then
  1787.              exit                       !eof marker
  1788.  
  1789.         elseif (itype.eq.255) then
  1790.             do_ungdiff=54
  1791.             print *, 'ERROR gdiff copy operation too large'
  1792.             return
  1793.  
  1794.         elseif (itype.gt.0 .and. itype.lt.247) then ! 1 to 246 chars to write
  1795.             read(42,err=1010)c1000(1:itype)             !(from out_file)
  1796.             iserror=write_6(c1000(1:itype))
  1797.             if (iserror.ne.0) goto 1010
  1798.  
  1799.         elseif (itype.eq.247.or.itype.eq.248) then     ! get >255 bytes
  1800.            if (itype.eq.247) then                       ! from out_file
  1801.               read(42,err=1010)c2
  1802.               i4=c_to_int(c2)
  1803.            else
  1804.               read(42,err=1010)c4
  1805.               i4=c_to_int(c4)
  1806.            endif
  1807.  
  1808.            do jj=1,i4,1000
  1809.               nget=min(1000,1+i4-jj)
  1810.               read(42,err=1010)c1000(1:nget)
  1811.               iserror=write_6(c1000(1:nget))
  1812.               if (iserror.ne.0) goto 1010
  1813.  
  1814.            enddo
  1815.         
  1816.         else            !copy bytes from oldfile
  1817.  
  1818.           if (itype.eq.249) then
  1819.              read(42,err=1010)c2,c1
  1820.              istart=c_to_int(c2)
  1821.              iget=ichar(c1)
  1822.           elseif (itype.eq.250) then
  1823.              read(42,err=1010)c2,c2a
  1824.              istart=c_to_int(c2)
  1825.              iget=c_to_int(c2a)
  1826.  
  1827.           elseif (itype.eq.251) then
  1828.              read(42,err=1010)c2,c4
  1829.              istart=c_to_int(c2)
  1830.              iget=c_to_int(c4)
  1831.  
  1832.           elseif (itype.eq.252) then
  1833.              read(42,err=1010)c4,c1
  1834.              istart=c_to_int(c4)
  1835.              iget=ichar(c1)
  1836.           elseif (itype.eq.253) then
  1837.              read(42,err=1010)c4,c2
  1838.              istart=c_to_int(c4)
  1839.              iget=c_to_int(c2)
  1840.           elseif (itype.eq.254) then
  1841.              read(42,err=1010)c4,c4a
  1842.              istart=c_to_int(c4)
  1843.              iget=c_to_int(c4a)
  1844.           else
  1845.             do_ungdiff=56
  1846.             return
  1847.           endif                         !copy byte codes
  1848.  
  1849.           II=SEEKUNIT(iunit,istART-1,0)
  1850.           IF (II.LT.0)  goto 1010
  1851.          
  1852.           do mm=1,iget,1000
  1853.               nget=min(1000,1+iget-mm)
  1854.               read(iunit,err=1010)c1000(1:nget)
  1855.               iserror=write_6(c1000(1:nget))
  1856.               if (iserror.ne.0) goto 1010
  1857.  
  1858.           enddo
  1859.  
  1860.         endif             ! bytes code
  1861.        enddo               !scanning diff file 
  1862.  
  1863.        close(unit=iunit,iostat=ierr)            !oldfile
  1864.        close(unit=42,iostat=ierr)               !diff
  1865.        close(unit=36,iostat=ierr)               !output 
  1866.        do_ungdiff=0
  1867.  
  1868.         if (.not.quiet.and.i36.ne.6.and.iquiet.ne.1) then
  1869.           open(unit=i36,file=out_file,iostat=ierr,
  1870.      1         action='read',form='unformatted')
  1871.           if (ierr.ne.0) return
  1872.           iout=filesize(36)
  1873.           if (lentrim(out_File).lt.40) then
  1874.               write(6,51)iout,out_file(1:lentrim(out_file))
  1875.  51           format('OK ',i9,' bytes written to  ',a)
  1876.            else
  1877.               write(6,53)iout,out_file(1:lentrim(out_file))
  1878.  53           format('OK ',i9,' bytes written to  '/a)
  1879.            endif
  1880.            close(unit=i36,iostat=ierr)
  1881.         endif
  1882.  
  1883.  
  1884.  
  1885.        return
  1886.  
  1887.  
  1888.  1010   do_ungdiff=55   !unspecified io error
  1889.         return
  1890.  
  1891.         end
  1892.                 
  1893.  
  1894. c-------------------
  1895. c character to integer
  1896.         integer function c_to_int(cc)
  1897.         character *(*)cc
  1898.         INTEGER JJ
  1899.         CHARACTER *4 C4
  1900.         CHARaCTER *8 C8
  1901.  
  1902.  
  1903.         if (len(cc).eq.1) then
  1904.             c_to_int=ichar(cc)        
  1905.             return
  1906.         endif
  1907.  
  1908.         if (len(cc).eq.2) then
  1909.            write(c4,99)cc
  1910.  99        format(z4)
  1911.            read(c4,99)jj
  1912.            c_to_int=jj
  1913.            return
  1914.         endif
  1915.  
  1916.         if (len(cc).eq.4) then
  1917.            write(c8,199)cc
  1918.  199       format(z8)
  1919.            read(c8,199)jj
  1920.            c_to_int=jj
  1921.            return
  1922.         endif
  1923.  
  1924.         print *,'ERROR Overflow in c_to_int '
  1925.         stop
  1926.         end
  1927.  
  1928.