home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / archives / honeywellgcosb.zip / hdps8.ftn < prev    next >
Text File  |  1988-08-16  |  4KB  |  123 lines
  1. cunpack - convert packed character format file to random binary
  2. c
  3. c  This routine converts Kermit-GCOS from the packed character
  4. c  format used on the Columbia distribution tape to an executable
  5. c  Honeywell H* file.
  6. c
  7. c  The packed format is:
  8. c    Columns   Contents
  9. c      1- 6      Zero origin word address of first word on line
  10. c      7-12      First data word as 6 characters
  11. c     13-18      Second data word
  12. c      ...        ...
  13. c     61-66      Tenth data word
  14. c        67      Checksum for this data line
  15. c        68      "|"
  16. c
  17. c  Data words are packed into six ASCII characters each, using only
  18. c  printable ASCII characters in the range 32 through 96, excluding
  19. c  64.
  20. c  These are formed by
  21. c  adding 32 to each 6-bit field from a 36-bit word, plus one if the
  22. c  six-bit value is 32 or greater.
  23. c  Thus, each 10 words generate a 15 word ASCII
  24. c  data record.  Data records consisting of only words which are all
  25. c  zero are discarded.
  26. c
  27. c  The checksum is the rightmost six bits of the integer value
  28. c  obtained by adding each of the 60 6-bit field used to generate
  29. c  the data string, plus 32 to make it a printing ASCII character,
  30. c  plus one if the original value is 32 or greater.
  31. c
  32. c  The final "|" is added to make the record length a multiple of
  33. c  four so record boundaries fall on word boundaries without padding,
  34. c  and to give a simple visual verification of the correct end of
  35. c  line.
  36. c
  37. c     hstar  - file code for random binary output file
  38.       integer hstar/01/
  39. c     infile - file code for packed text input file
  40.       integer infile/02/
  41. c     otbuff - buffer for binary output block
  42.       integer otbuff(320)
  43. c     text file input records are composed of:
  44. c     inword - integer offset of first data word on line
  45.       integer inword
  46. c     inbuff - 15 words of ASCII text - binary in packed format.
  47.       integer inbuff(15)
  48. c     chksum - checksum computed when text record was formed.
  49.       integer chksum
  50. c     inrec - count of input text records
  51.       integer inrec
  52. c     otrec - count of binary output blocks
  53.       integer otrec
  54. c
  55.       write(6,6010)
  56.  6010 format(' Begin packed character to random binary conversion.')
  57. c     define record length of random binary output file
  58.       call ransiz(hstar,320,1)
  59.       inrec = 0
  60.       otrec = 1
  61. c     clear output buffer
  62.       do 5 ix=1,320
  63.          otbuff(320) = 0
  64.     5 continue
  65. c
  66. c  process each input record until end of text file.
  67.    10 read(infile,1010,end=100) inword,inbuff,chksum
  68.  1010    format(i6,15a4,a1)
  69.          inrec = inrec+1
  70.    12    if (inword .lt. 320*otrec) goto 20
  71.             write(hstar'otrec) otbuff
  72.             otrec = otrec + 1
  73.             do 15 ix=1,320
  74.                otbuff(ix) = 0
  75.    15       continue
  76.          goto 12
  77.    20    call unpak2(inword,inbuff,chksum,otbuff(mod(inword,320)+1))
  78.       goto 10
  79. c
  80. c     flush final output buffer
  81.   100 write(hstar'otrec) otbuff
  82.       write(6,6090) inrec,otrec
  83.  6090 format(' Records read  =',i4/
  84.      &       ' Blocks written=',i4/
  85.       &      ' Conversion completed')
  86.       stop
  87.       end
  88.       subroutine unpak2(inword,inbuff,chksum,otbuff)
  89. c
  90. c  Convert 10 words in packed text format to binary data.
  91. c  Validate the checksum, and report any errors.
  92. c
  93.       integer inword
  94.       integer inbuff(15)
  95.       integer otbuff(10)
  96.       integer chksum
  97. c
  98. c     ASF to put 6-bits into binary output data word
  99.       raw(ix) = fld(6*mod(ix-1,6),6,otbuff((ix+5)/6))
  100. c     ASF to get 6-bit value out of 9-bit field on text record
  101.       packed(ix) = fld(9*mod(ix-1,4),9,inbuff((ix+3)/4)) - 32
  102. c
  103.       integer ix
  104. c     newsum - local computation of checksum from packed text
  105.       integer newsum
  106. c
  107.       newsum = 0
  108.       do 10 ix=1,60
  109.          ichar = packed(ix)
  110.          newsum = newsum + ichar
  111.          if (ichar .ge. 32) ichar = ichar - 1
  112.          raw(ix) = ichar
  113.    10 continue
  114.       newsum = fld(30,6,newsum)
  115.       if (newsum .ge. 32) newsum = newsum+1
  116.       newsum = newsum + 32
  117.       chksum = fld(0,9,chksum)
  118.       if (newsum .ne. chksum) write(6,6010) inword,newsum,chksum
  119.  6010 format(' Checksum error at word',i6/
  120.      &       ' Computed: ',o12,'   Actual: ',o12)
  121.       return
  122.       end
  123.