home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol149 / fromxmod.for < prev    next >
Encoding:
Text File  |  1984-04-29  |  2.5 KB  |  117 lines
  1.     program fromxmod
  2. c  convert file of XMODEM 128 byte records with embedded <CR><LF>
  3. c  marking end-of-line and CTRL-Z marking end-of-file
  4. c  to carriage-control=LIST (normal VAX editable file)
  5.  
  6.     character*254 line,input,output
  7.     character*1 CR,LF,recchar
  8.     integer blank
  9.     logical eof
  10.     data eof/.false./
  11.  
  12.     CR=char(13)
  13.     LF=char(10)
  14.     call lib$get_foreign(line,'$_From  To: ',)
  15.  
  16.     blank=index(line,' ')
  17.     input=line( 1:blank )
  18.     output=line( blank:)
  19.  
  20.     open(6,file=input,status='OLD')
  21.     open(7,file=output,status='NEW',carriagecontrol='LIST')
  22.  
  23. c  getchar (read new record if no input characters left)
  24. c  if EOF on input, write line and exit
  25. c  if CR then
  26. c    if getchar LF then write line
  27. c    else put back char and putchar CR into line (error if too long)
  28. c    endif
  29. c  else putchar (write error message if line too long)
  30. c  endif
  31. c  loop
  32.  
  33.   100    call getchar(recchar,eof)
  34.     if(eof) goto 200
  35.     if(recchar.eq.CR) then
  36. c    PRINT *,' CR'
  37.         call getchar(recchar,eof)
  38.         if(eof.or.recchar.ne.LF) then
  39.             call putback
  40.             
  41.             len=len+1
  42.             if(len.gt.255) print *,' Out line too long.'
  43. c    print*,' too long line=',line
  44.             line(len:len)=recchar
  45.         else
  46. c  was LF
  47. c    PRINT *,' LEN=',LEN
  48. c    print*,' after LF, line=',line(1:len)
  49.             write(7,2000) line(1:len)
  50.             len=0
  51.         endif
  52.     else
  53. c  not CR, was "ordinary" character
  54.         len=len+1
  55.         if(len.gt.255) then
  56.             print *,' Out line too long.'
  57. c            PRINT *,' LINE=',LINE(1:len)
  58.         endif
  59.         line(len:len)=recchar
  60.     endif
  61.  
  62.     go to 100
  63.  
  64. c  flush last line and exit
  65.   200    continue
  66.     if(len.ne.0) then
  67.         write(7,2000) line(1:len)
  68.  2000        format(a)
  69.     endif
  70.     close(6)
  71.     close(7)
  72.     call exit
  73.  
  74.       end
  75. c------------------------------------------
  76.     subroutine getchar(c,eof)
  77.     character*1 c
  78.     logical eof
  79. c  point to next character in record (read record if necessary)
  80.     character*128 record
  81.     character*1 CTRLZ
  82.     integer point
  83.     logical firsttime
  84.     common /reccom/point,firsttime
  85.     common /rec2com/record
  86.     data point/0/
  87.     data firsttime/.true./
  88.  
  89.     CTRLZ=char(26)
  90.     point=point+1
  91.     if(point.gt.128.or.firsttime) then
  92.         firsttime=.false.
  93.   100        read(6,1000,end=200) record
  94.  1000        format(a)
  95. c        PRINT *,RECORD
  96.         point=1
  97.     endif
  98. c  strip parity in case CP/M file had it
  99.     c=char(iand(ichar(record(point:point)),127))
  100.     if(c.eq.CTRLZ) eof=.true.
  101.     return
  102.  
  103.   200    eof=.true.
  104.     return
  105.     end
  106. c----------------------------------------------
  107.     subroutine putback
  108. c  point to previous input character so this character will be getchar result
  109. c  even works if 1st char of record
  110.     integer point
  111.     logical eof
  112.     common /reccom/point
  113.  
  114.     point=point-1
  115.     return
  116.     end
  117.