From:	CSBVAX::MRGATE!@KL.SRI.Com,@wiscvm.wisc.edu:UUCJEFF@ECNCDC.BITNET@SMTP 19-AUG-1987 18:29
To:	EVERHART
Subj:	c

Received: from wiscvm.wisc.edu by KL.SRI.COM with TCP; Wed 19 Aug 87 12:24:24-PDT
Received: from ECNCDC.BITNET by wiscvm.wisc.edu ; Wed, 19 Aug 87 14:24:46 CDT
Date:     Wed 19 Aug 1987 12:38 CDT
From:     <UUCJEFF%ECNCDC.BITNET@wiscvm.wisc.edu>
Subject:  c
To:       <info-vax@KL.SRI.COM>

c        MODEM7-type program to send and
c        receive files with checksums or CRC and automatic
c        re-transmission of bad blocks.
c        translated to VAX Fortran V3.0 from TMODEM.C by
c        and enhanced according to time-outs and CRC
C        in XMODEM50.ASM
c        J.James Belonis II
c        Physics Hall FM-15
c        University of Washington
c        Seattle, WA 98195
c
c  TMODEM.C written by Richard Conn, Eliot Moss, and Lauren
c   Weinstein
c
c  6/30/83  Modified, restructured, and VAX/VMS text file
c    conversion added by Richard Conn
c  1/17/83    touched up filename display and comments.
c  1/14/83    including timeouts and CTRL-X cancellation
c        and CRC capability
c
c  keeps a log file of error messages ( deletes it if no errors )
c  sets terminal driver to eightbit, passall
c  may need altypeahd if faster than 1200 baud works to 9600 baud at least.
c  needs PHY_IO privilege for passall ? apparently not on UWPhys VAX
c  nor on ACC VAX
c  many debugging statements left in as comments

c  declare variables
    include 'QIO.DCK/list'
    character*80 line, file, workf
    integer sloc, worklen

    logical filedel
    common /filest/filedel

    integer errorcount
    common /err/errorcount

    integer high,low
    common /crcval/high,low

    logical crc
    integer checksum
    common /checks/checksum,crc

    equivalence (checksum,checksumbyte)
    equivalence (ic,c)

c  define ascii characters
    parameter NUL=0        !ignore at SOH time
    parameter SOH=1        !start of header for sector
    parameter EOT=4        !end of transfer
    parameter ACK=6        !acknowlege sector
    parameter NAK=21    !not acknowlege sector
    parameter CAN=24    !cancel transfer
    parameter CRCCHAR='C'    !CRC indicating character

c  timeouts
    parameter respnaklim=10    !seconds to allow for response to NAK
    parameter naklim=10     !seconds to allow to receive first NAK
    parameter eotlim=10    !seconds to wait for EOT acknowlege

    parameter errlim=10    !max errors on a sector

c  define an exit routine to get control on all exits to turn off
c  passall and for debug cleanup
    external giveup
    call userex( giveup )

    print *,' XMODEM Version 5.1 on VAX VMS'
c  log file for debugging
    open(8,file='XMODEM.LOG',carriagecontrol='LIST',status='NEW')
c  assign terminal channel for QIO calls to send raw bytes.
    call sys$assign('TT',chan,,)

c  name work file
    workf='XMODEM.WRK '
    worklen=10    ! number of chars in file name
c  get command line
    call lib$get_foreign(line,'$_XMODEM Command: ',)
c  trim blanks
    do i=80,1,-1
        if(line(i:i).NE.' ') goto 25
        len=i
    enddo
  25    continue

c  set to NOT delete working file
    filedel=.false.

c  send
    sloc=index(line,'S ')
    if(sloc.EQ.1) then
        file=line(sloc+2:)
        len=len-2
        crc=.false.
        print *,' Sending File: ',file(1:len)
        call sendfile(file,len)
        call exit
    endif
c  send text
    sloc=index(line,'ST ')
    if(sloc.EQ.1) then
        file=line(sloc+3:)
        len=len-3
        crc=.false.
        print *,' Sending Text File: ',file(1:len)
        call vtoc(file,workf)
        filedel=.true.    !delete working file when done
        call sendfile(workf,worklen)
        call exit
    endif
c  send with CRC
    sloc=index(line,'SC ')
    if (sloc.EQ.1) then
        file=line(sloc+3:)
        len=len-3
        crc=.true.
        print *,' Sending File: ',file(1:len),' using CRCs'
        call sendfile(file,len)
        call exit
    endif
c  receive with checksum
    sloc=index(line,'R ')
    if(sloc.EQ.1) then
        file=line(sloc+2:)
        len=len-2
        crc=.false.
        print *,' Receiving File: ',file(1:len)
        call recvfile(file,len)
        call exit
    endif
c  receive text with checksum
    sloc=index(line,'RT ')
    if(sloc.EQ.1) then
        file=line(sloc+3:)
        len=len-3
        crc=.false.
        print *,' Receiving Text File: ',file(1:len)
        call recvfile(workf,worklen)
        filedel=.true.    !delete working file when done
        call ctov(workf,file)
        call exit
    endif
c  receive with CRC
    sloc=index(line,'RC ')
    if(sloc.EQ.1) then
        file=line(sloc+3:)
        len=len-3
        crc=.true.
        print *,' Receiving File: ',file(1:len),' using CRCs'
        call recvfile(file,len)
        call exit
    endif

c  else bad command
    print *,' Invalid XMODEM Command --'
    print *,' Usage: XMODEM  <S, ST, SC, R, RT, or RC>  <file> '
    print *,'   S = Send, R = Receive, C = Use CRCs'
    print *,'   T = Convert CP/M to VAX/VMS and VAX/VMS to CP/M Text Files'
    call exit
    end

c----------------------------------------------------------------
c  send file
    subroutine sendfile(file,len)

c  declare variables
    include 'QIO.DCK'
    character*80 file
    byte sector(130), c
    integer blocknumber, nakwait, stat, ic
    logical ttyinlim
    logical charintime, acked

    logical filedel
    common /filest/filedel

    integer errorcount
    common /err/errorcount

    integer high,low
    common /crcval/high,low

    logical crc
    integer checksum
    common /checks/checksum,crc

    equivalence (checksum,checksumbyte)
    equivalence (ic,c)

c  define ASCII characters
    parameter NUL=0
    parameter SOH=1
    parameter EOT=4
    parameter ACK=6
    parameter NAK=21
    parameter CAN=24
    parameter CRCCHAR='C'
c  timeouts
    parameter respnaklim=10
    parameter naklim=10
    parameter eotlim=10
    parameter errlim=10

    open(6,name=file(1:len),iostat=stat,status='OLD')
c     1        carriagecontrol='NONE',recordtype='FIXED',recl=128)

    if(stat) then
        print *,'Can''t open',file(1:len),' for send.'
        call exit
    endif
    if(crc) then
        print *,' CRC Transfer Mode'
    else
        print *,' Checksum Transfer Mode'
    endif
    print *,file(1:len),' Open -- Please Run Your Receiver --'
    print *
    errorcount=0
    blocknumber=1
    nakwait=0

c  await first NAK (or 'C') indicating receiver is ready
  200    charintime=ttyinlim(c,1,naklim)        ! return NUL if timeout
c    print *,' character=',c
    if( .NOT.charintime ) then
        nakwait=nakwait+1
c  give the turkey 80 seconds to figure out how to receive a file
        if(nakwait.EQ.80) call cancel
        goto 200
    elseif(c.EQ.NAK) then
        crc=.false.
    elseif(c.EQ.CRCCHAR) then
        crc=.true.
    elseif(c.EQ.CAN) then
        call cancel
    else
c  unrecognized character
        nakwait=nakwait+1
        if(nakwait.eq.80) call cancel
        goto 200
    endif
    
  300    continue
c  send new sector
    read(6,1000,end=500) (sector(i),i=1,128)
 1000    format(128a)
    errorcount=0
c    print *,' sector as read',sector
  400    continue
c  send sector
c    print *,' SOH '
    call ttyout(SOH,1)
    call ttyout(blocknumber,1)
    call ttyout( not(blocknumber),1 )
c    print *,' blocknumber=',blocknumber

    checksum=0
    call clrcrc
c  separate calls to slow down in case other end slow (can even introduce
c  delay between characters).
c    do i=1,128
c        call ttyout(sector(i),1)
c    enddo
    call ttyout(sector,128)

c  calc checksum or crc
    if(crc) then
c  put all bytes + two finishing zero bytes through updcrc
        sector(129)=0
        sector(130)=0
        call updcrc( sector,130 )
        call ttyout(high,1)
        call ttyout(low,1)
    else
        do i=1,128
            checksum=checksum+sector(i)
        enddo
c  this sends low order byte of checksum
        call ttyout(checksum,1)
c        print *,' checksum',checksum
    endif

c  sector sent, see if receiver acknowleges
c  getack attempts to get ACK
c  if not, repeat sector
c    print*, ' should wait for ACK 10 seconds'
    call getack(acked)
c    print*, ' getack returned=',acked
    if(.NOT.acked) goto 400

c  ACK received, send next sector
    blocknumber=blocknumber+1
    goto 300

c  end of file during read.  finish up sending.
  500    continue
    call ttyout(EOT,1)
c  getack attempts to get ACK up to errlim times
    call getack(acked)
    if( .NOT.acked ) goto 500

c    print *,' Sending complete.'
    if (filedel) then
        close(6,dispose='DELETE')
    else
        close(6)
    endif
    close(8,dispose='DELETE')
    return
    end

c----------------------------------------------------------------
c  receive file
    subroutine recvfile(file,len)

c  declare variables
    include 'QIO.DCK'
    character*80 file
    byte sector(130), c, notc, checksumbyte, ck
    integer blocknumber, inotc, notnotc, secbytes, stat
    integer testblock, testprev, ic
    logical ttyinlim
    logical charintime, firstsoh

    integer errorcount
    common /err/errorcount

    integer high,low
    common /crcval/high,low

    logical crc
    integer checksum
    common /checks/checksum,crc

    equivalence (checksum,checksumbyte)
    equivalence (ic,c)

c  define ASCII characters
    parameter NUL=0
    parameter SOH=1
    parameter EOT=4
    parameter ACK=6
    parameter NAK=21
    parameter CAN=24
    parameter CRCCHAR='C'
c  timeouts
    parameter respnaklim=10
    parameter naklim=10
    parameter eotlim=10
    parameter errlim=10

    open(7,name=file(1:len),recl=128,status='NEW',iostat=stat,
     1        carriagecontrol='NONE',recordtype='FIXED')
    if(stat) then
        print *,' Can''t open ',file(1:len),' for recieve.'
        call exit
    endif

    print *,' Please Send Your File --'
    print *
    call passall(CHAN,.TRUE.)

    secbytes=129
    if(crc) then
        secbytes=130
    endif

    firstsoh=.false.
    errorcount=0
    blocknumber=1

c  start the sender by letting ttyinlim time-out in getack routine
c  so it sends a NAK or C
    goto 999

  800    continue
c    write(8,*) ' ready for SOH'
c  must allow enough time for other's disk read (xmodem50.asm allows 10 sec)
    charintime=ttyinlim(c,1,respnaklim)
c  if no char for a while, try NAK or C again
    if( .NOT.charintime ) then
c        print*,' no response to NAK or C, trying again'
        write(8,*) ' no response to NAK or C, trying again'
        goto 999
    endif
c  else received a char so see what it is
    if(c.eq.NUL) goto 800    ! ignore nulls here for compatablity with old
                ! versions of modem7
    if(c.EQ.CAN) then
        print *,' Canceled.  Aborting.'
        write(8,*) ' Canceled.  Aborting.'
        call exit
    endif
c    write(8,*) ' EOT or SOH character=',c
    if(c.NE.EOT) then
        IF(c.NE.SOH) then
            write(8,*) ' Not SOH, was decimal ',c
            goto 999
        endif
        firstsoh=.true.

c  character was SOH to indicate start of header
c  get block number and complement
        call ttyin(c,1)
c        write(8,*) ' block=',c

        call ttyin(notc,1)
c        write(8,*) ' block complement=',notc
        inotc=notc    ! make integer for "not" function
        notnotc=iand( not(inotc),255 )    ! mask back to byte

c  c is low order byte of ic via equivalence statement
        if(ic.NE.notnotc) then
            write(8,*) ' block check bad.'
            goto 999
        endif
c  block number valid but not yet checked against expected

c  clear checksum and CRC
        checksum=0
        call clrcrc

c  receive the sector and checksum bytes in one call (for speed).
c  secbytes is 129 for checksum, 130 for CRC
        call ttyin(sector,secbytes)

        if(crc) then
c  put data AND CRC bytes through updcrc
            call updcrc(sector,secbytes)
c  if result non-zero, BAD.
            if(iand(high,255).NE.0
    1        .OR.iand(low,255).NE.0) then
c                write(8,*) ' CRC, high,low='
c                write(8,3000) high,low
c 3000                format(2z10)
                goto 999
            endif
        else
c  don't add received checksum byte to checksum
            do i=1,secbytes-1
                checksum=checksum+sector(i)
            enddo
            ck=sector(129)
c            write(8,2100) ck

c            write(8,2100) checksum
c            write(8,2100) checksumbyte
c 2100            format(' checksum=',z10)
            if( checksumbyte.NE.ck ) then
                write(8,*) ' bad checksum'
                goto 999
            endif
        endif

c  received OK so we can believe the block number, see which block it was
c  mask it to be one byte
        testblock=iand(blocknumber,255)
        testprev=iand( blocknumber-1 ,255)
        if( ic.EQ.testprev) then
            write(8,*) ' prev. block again, out of synch'
c  already have this block so don't write it, but ACK anyway to resynchronize
            goto 985
        elseif( ic.NE.testblock ) then
            write(8,*) ' block number bad.'
            goto 999
        endif
c  else was expected block

c  write before acknowlege so not have to listen while write.
        write(7,2000,err=900) (sector(i),i=1,128)
 2000        format(128a)
        goto 975
  900        write(8,*) ' Can''t write sector. Aborting.'
        print*, ' Can''t write sector. Aborting.'
        call exit

  975        continue
c  recieved sector ok, wrote it ok, so acknowlege it to request next.
        blocknumber=blocknumber+1
c  comes here if re-received the previous sector
  985        continue
        errorcount=0
c        write(8,*) ' ACKing, sector was ok.'
        call ttyout(ACK,1)
        goto 800

c  else error so eat garbage in case out of synch and try again
  999        continue
        call eat
        write(8,*) ' receive error NAK, block=',blocknumber
        if(crc.AND..NOT.firstsoh) then
c  keep sending 'C'  'til receive first SOH
            call ttyout(CRCCHAR,1)
        else
            call ttyout(NAK,1)
        endif
        errorcount=errorcount+1
  998        if(errorcount.GE.errlim) then
            print*,' Unable to receive block. Aborting.'
            write(8,*) ' Not receive block. Aborting.'
c  delete incompletely received file
            close(7,dispose='DELETE')
            call exit
        endif
c  retry
        goto 800
    endif

c  EOT received instead of SOH so file done.
c  should keep sending ACK 'til no more EOT's ?
    close(6)
    close(7)
    call ttyout(ACK,1)
    call ttyout(ACK,1)
    call ttyout(ACK,1)

c    write(8,*) ' Completed.'
c    print *,   ' Completed.'
c  transfer ok, so delete the error log file.
c    close(8,status='DELETE')
    close(8,dispose='DELETE')
    return
    end

c-------------------------------------------------------------
    subroutine ctov(input,output)
c  convert file of XMODEM 128 byte records with embedded <CR><LF>
c  marking end-of-line and CTRL-Z marking end-of-file
c  to carriage-control=LIST (normal VAX editable file)

    character*80 input,output
    character*300 line
    character*1 CR,LF,recchar
    integer blank
    logical eof, eol

    logical filedel
    common /filest/filedel

    data eof,eol/.false.,.false./

    CR=char(13)
    LF=char(10)

    open(6,file=input,status='OLD')
c  set maximum output record length to 300 (fortran default is 133)
    open(7,file=output,status='NEW',carriagecontrol='LIST',recl=300)

c  getchar (read new record if no input characters left)
c  if EOF on input, write line and exit
c  if CR then
c    if getchar LF then write line
c    else put back char and putchar CR into line (error if too long)
c    endif
c  else putchar (write error message if line too long)
c  endif
c  loop

  100    call getc(recchar,eof,eol)
    if(eof) goto 200
    if(recchar.eq.CR) then
c    PRINT *,' CR'
        call getc(recchar,eof)
        if(eof.or.recchar.ne.LF) then
            call putback
            
            len=len+1
            if(len.ge.301) print *,' Out line too long.'
c    print*,' too long line=',line
            line(len:len)=recchar
        else
c  was LF
c    PRINT *,' LEN=',LEN
c    print*,' after LF, line=',line(1:len)
            write(7,2000) line(1:len)
            len=0
        endif
    else
c  not CR, was "ordinary" character
        len=len+1
        if(len.ge.301) then
            print *,' Out line too long.'
c            PRINT *,' LINE=',LINE(1:len)
        endif
        line(len:len)=recchar
    endif

    go to 100

c  flush last line and exit
  200    continue
    if(len.ne.0) then
        write(7,2000) line(1:len)
 2000        format(a)
    endif
    if (filedel) then
        close(6,dispose='DELETE')
    else
        close(6)
    endif
    close(7)
    return
      end
c-------------------------------------------------------------
    subroutine vtoc(input,output)
c  convert VAX text file to
c  file of XMODEM 128 byte records with embedded <CR><LF>

    character*80 input,output
    character*1 CR,LF,c
    integer blank
    logical eof,eol
    data eof,eol/.false.,.false./

    CR=char(13)
    LF=char(10)

    open(6,file=input,status='OLD')
    open(7,file=output,status='NEW',carriagecontrol='LIST',
    1                  recl=128,recordtype='FIXED')

c  getchar (read new line if no input characters left)
c  putchar ( output record if full, close if EOF )
c  if EOL on input, putchar CR putchar LF (output record if full)
c  loop

  100    call getv(c,eof,eol)
    if(.not.eol) then
        call putchar(c,eof)
        if(eof) then
            return
        endif
    else
c  end of line
        call putchar(CR,eof)
        call putchar(LF,eof)
        eol=.false.
        if(eof) then
            return
        endif
    endif
    go to 100

      end
c------------------------------------------
    subroutine putchar(c,eof)
    character*1 c
    logical eof
c  put character into record (write record if necessary)
c  if eof, fills out rest of record with CTRL-Z's and exits
    character*1 CTRLZ
    character*128 record
    integer point
    common /reccom/point,record
    data point/0/

    if(eof) goto 200
    point=point+1
c  strip parity in case VAX file had it
    record(point:point)=char(iand(ichar(c),127))
c    print*,' record(point:point)=',record(point:point)
c    print*,' point=',point
   50    if(point.ge.128) then
c        print*,' record=',record
  100        write(7,1000) record
 1000        format(a)
        point=0
    endif
    return        

c  EOF fill record with 26's (CTRL-Z, CP/M end of file mark for ASCII)
c  output last record and exit
  200    continue
c    print*,' in putchar EOF section'
    CTRLZ=char(26)
    do i=point+1,128
        record(i:i)=CTRLZ
    enddo
c    print*,' record=',record
    write(7,1000) record
    close(6)
    close(7)
    return
    end
c------------------------------------------
    subroutine getc(c,eof)
c  get character from a CP/M text file
    character*1 c
    logical eof
c  point to next character in record (read record if necessary)
    character*128 record
    character*1 CTRLZ
    integer point
    logical firsttime
    common /reccom/point,record,firsttime
    data point/0/
    data firsttime/.true./

    CTRLZ=char(26)
    point=point+1
    if(point.gt.128.or.firsttime) then
        firsttime=.false.
  100        read(6,1000,end=200) record
 1000        format(a)
c        PRINT *,RECORD
        point=1
    endif
c  strip parity in case CP/M file had it
    c=char(iand(ichar(record(point:point)),127))
    if(c.eq.CTRLZ) eof=.true.
    return

  200    eof=.true.
    return
    end
c-------------------------------------------
    subroutine getv(inchar,eof,eol)
    character*1 inchar
    logical eof,eol
c  get character from input line (read line if necessary)
c  returns character and eol=.true. if no more char on line
c  returns eof if end of file (no character)
    character*255 line
    integer len, pos
    logical firsttime
    common/lincom/pos,len,line
    data pos/0/

    if(pos.eq.0) then
        read(6,1000,end=100)len,line(1:len)
 1000        format(q,a)
c        print*,' line=',line
    endif
    pos=pos+1
    if(pos.gt.len) then
        eol=.true.
        pos=0
        return
    endif
c    print*,' pos=',pos,' line(1:pos)=',line(1:pos)
c    print*,' line(pos:pos)=',line(pos:pos)
    inchar=line(pos:pos)
c    print*,' pos,char',pos,inchar
    return

c  EOF
  100    continue
    eof=.true.
    return
    end
c----------------------------------------------
    subroutine putback
c  point to previous input character so this character will be getchar result
c  even works if 1st char of record
    integer point
    logical eof
    common /reccom/point

    point=point-1
    return
    end

c-----------------------------------------------------------
    subroutine clrcrc
c  clears CRC
    integer high,low
    common /crcval/high,low

    high=0
    low=0
    return
    end
c-----------------------------------------------------------
    subroutine updcrc(bbyte,n)
    byte bbyte(*)
    integer n
c  updates the Cyclic Redundancy Code
c  uses x^16 + x^12 + x^5 + 1 as recommended by CCITT
c    and as used by CRCSUBS version 1.20 for 8080 microprocessor
c    and incorporated into the MODEM7 protocol of the CP/M user's group
c
c  during sending:
c  call clrcrc
c  call updcrc   for each byte
c  call fincrc   to finish (or just put 2 extra zero bytes through updcrc)
c  result to send is low byte of high and low in that order.
c
c  during reception:
c  call clrcrc
c  call updcrc   all bytes PLUS the two received CRC bytes must be passed
c       to this routine
c       then zero in high and low means good checksum
c
c  see Computer Networks, Andrew S. Tanenbaum, Prentiss-Hall, 1981
c
c  must declare integer to allow shifting
    integer byte
    integer high
    integer low
    common /crcval/high,low
    integer bit,bitl,bith

c    write(8,*) ' inside updcrc'
    do i=1,n
c        write(8,*) high,low,byte'
c        write(8,1000),high,low,bbyte
 1000        format(3z10)
        byte=bbyte(i)

        do j=1,8
c  get high bits of bytes so we don't lose them when shift
c  positive is left shift
            bit =ishft( iand(128,byte), -7)
            bitl=ishft( iand(128,low),  -7)
            bith=ishft( iand(128,high), -7)
c            write(8,*) 'bit,bitl,bith'
c            write(8,1000),bit,bitl,bith
c  get ready for next iteration
            newbyte=ishft(byte,1)
            byte=newbyte        ! introduced dummy variable newb
                        ! to avoid "access violation"
c            write(8,*) ' byte ready for next iteration'
c            write(8,1000),byte
c  shift those bits in
            low =ishft(low ,1)+bit
            high=ishft(high,1)+bitl
c            write(8,*),' high,low after shifting bits in'
c            write(8,1000),high,low

            if(bith.eq.1) then
                high=ieor(16,high)
                low=ieor(33,low)
c                write(8,*) ' high,low  after xor'
c                write(8,1000) high,low
            endif
        enddo
    enddo
    return
    end
c-----------------------------------------------------------
c    subroutine fincrc
c  finish CRC calculation for sending    result in high, low
c  merely runs updcrc with two  zero bytes
c    integer high,low
c    common /crcval/high,low
c
c    byte=0
c    call updcrc(byte)
c    call updcrc(byte)
c    return
c    end
c-----------------------------------------------------------
      SUBROUTINE TTYIN(LINE,N)
      BYTE LINE(*)
      INTEGER N
C              READ CHARACTERS FROM TERMINAL
C              MODIFIED BY BELONIS TO REMOVE PRIVILEGE
C              MAY HAVE PROBLEM WITH TYPE-AHEAD
c  should convert to time-out properly with loops in main ?
      INCLUDE 'QIO.DCK'
c      INCLUDE '($SSDEF)'
      parameter ss$_timeout='22c'x
      INTEGER I
      INTEGER SYS$QIOW
      INTEGER*4 terminators(2)

c      logical crc
c      integer checksum
c      common /checks/checksum,crc

      EXTERNAL IO$M_NOECHO,IO$_TTYREADALL,IO$M_TIMED
      DATA terminators/0,0/
C
    write(8,*) ' inside ttyin, N=',N
      I = SYS$QIOW(,           !EVENT FLAG
     -              %VAL(CHAN),         !CHANNEL
     -              %VAL(%LOC(IO$_TTYREADALL).OR.
     -                   %LOC(IO$M_NOECHO)),         !   .OR.%LOC(IO$M_TIMED)),
     -              STATUS,,,
     -              LINE,       !BUFFER
     -              %VAL(N),    !LENGTH
     -              ,        ! max time   beware other disk time
     -                !            and Quit or Retry time
     -              terminators,,)  !no terminators
c      if(crc) then
c         write(8,1000) (LINE(j),j=1,N)
c         write(8,*) ' status=',STATUS
c      else
c         write(8,2000) (line(j),j=1,N)
c         write(8,*) ' status=',status
c      endif
 1000 format(' ttyin=',6(20z3/),10z3)
 2000 format(' ttyin=',6(20z3/),9z3)
c      if(STATUS(1).EQ.SS$_TIMEOUT) THEN
c         write(8,*) ' 10 second timeout in ttyin'
c         print*,    ' 10 second timeout in ttyin'
c         call exit
c      endif

      IF (I) THEN
c        write(8,*) ' returning from ttyin'
         return
      endif
C
C              ERROR
      write(8,*) ' ttyin error.'
      CALL SYS$EXIT( %VAL(I) )
      END
c-----------------------------------------------------------
    subroutine eat
c  eats extra characters 'til 1 second pause   used to re-synch after error
    byte buffer(135)
    integer numchar
    logical i,ttyinlim
c
    parameter maxtime=1
c  in case mis-interpreted header, allow at least 1 block of garbage
    numchar=135

    i=ttyinlim(buffer,numchar,maxtime)
c    print*,' finished eating'
c    write(8,*) ' finished eating'
    return
    end
c-----------------------------------------------------------
      LOGICAL FUNCTION TTYINLIM(LINE,N,LIMIT)
      BYTE LINE(*)
      INTEGER N,LIMIT
C              READ CHARACTERS FROM TERMINAL
C              WITH TIME LIMIT, RETURN FALSE IF NO CHARACTERS
C              RECEIVED FOR LIMIT SECONDS
C              MODIFIED BY BELONIS TO REMOVE PRIVILEGE PROBLEM
C              MAY HAVE PROBLEM WITH TYPE-AHEAD
      INCLUDE 'QIO.DCK'
c      INCLUDE '($SSDEF)'    ! defines error status returns
      parameter ss$_timeout='22c'x
      INTEGER I
      INTEGER SYS$QIOW
      INTEGER*4 terminators(2)
      EXTERNAL IO$M_NOECHO,IO$_TTYREADALL,IO$M_TIMED
      DATA TERMINATORS/0,0/
C
c    write(8,*) ' inside ttyinlim'
      TTYINLIM=.TRUE.          ! DEFAULT no delay over LIMIT seconds
      I = SYS$QIOW(,           !EVENT FLAG
     -              %VAL(CHAN),         !CHANNEL
     -              %VAL(%LOC(IO$_TTYREADALL).OR.
     -                   %LOC(IO$M_NOECHO).OR.%LOC(IO$M_TIMED)),
     -              STATUS,,,
     -              LINE,       !BUFFER
     -              %VAL(N),   !LENGTH
     -              %VAL(LIMIT),    !time limit in seconds
     -              terminators,,)  !no terminators
c     print*,' ttyinlim=',(LINE(j),j=1,N), ' STATUS=',STATUS
c     write(8,*) ' ttyinlim=',(LINE(j),j=1,N), ' STATUS=',STATUS
      if(STATUS(1).EQ.SS$_TIMEOUT) THEN
         TTYINLIM=.FALSE.
         write(8,*) ' timeout'
         return
      ENDIF

      IF (I) THEN
c        write(8,*) ' returning from ttyinlim'
         return
      endif
C
C              ERROR
      write(8,*) ' ttyinlim error.'
      CALL SYS$EXIT( %VAL(I) )
      END
c-----------------------------------------------------------
      SUBROUTINE TTYOUT(LINE,N)
      BYTE LINE(*)
      INTEGER*2 N
C  output N characters without interpretation
      INCLUDE 'QIO.DCK'
      INTEGER I
      INTEGER SYS$QIOW
      EXTERNAL IO$M_NOFORMAT
      EXTERNAL IO$_WRITEVBLK
C
      IF ( N.LE.0 ) RETURN
C
c    print *, ' to be sent by ttyout ', line(1)
      I = SYS$QIOW(,
     -              %VAL(CHAN),
     -              %VAL(%LOC(IO$_WRITEVBLK).OR.
     -                   %LOC(IO$M_NOFORMAT)),
     -              STATUS,,,
     -              LINE,
     -              %VAL(N),,
     -              %VAL(0),, )         !NO CARRIAGE CONTROL
      if(I) then
         return
      endif
C
C              ERROR
      write(8,*) ' ttyout error.'
      CALL SYS$EXIT( %VAL(I) )
      END
c--------------------------------------------------
    subroutine giveup
c  this exit routine used especially in case exited via QIO problem
    include 'qio.dck'

c  note: if want log file message, must re-open since
c  system already closed all files before this exit handler got control
c    open(8,file='XMODEM.LOG',access='APPEND')
c    write(8,*) ' Exit handler.'

c  turn off passall
    call passall(CHAN,.FALSE.)
    return
    end
c-----------------------------------------------------
    SUBROUTINE PASSALL(CHAN,SWITCH)
C  sets PASSALL mode for terminal connected to chanel CHAN, ON if switch true
    IMPLICIT INTEGER (A-Z)
c    INCLUDE '($TTDEF)'
    parameter tt$m_passall=1
    parameter tt$m_eightbit='8000'x
    parameter io$_sensemode='27'x
    parameter io$_setmode='23'x
c    INCLUDE '($IODEF)'
    LOGICAL SWITCH
    COMMON/CHAR/CLASS,TYPE,WIDTH,CHARAC(3),LENGTH    !byte reversed LENGTH
    BYTE CLASS,TYPE,CHARAC,LENGTH
    INTEGER*2 WIDTH,SPEED
    EQUIVALENCE(CHARACTER,CHARAC)

c  sense current terminal driver mode
    ISTAT=SYS$QIOW(,%VAL(CHAN),%VAL(IO$_SENSEMODE),,,,
    1 CLASS,,,,,)
    IF (.NOT.ISTAT) CALL ERROR('TERMINAL SENSEMODE',ISTAT)

    IF(SWITCH) THEN
c  turn on 8 bit passall
        CHARACTER=CHARACTER.OR.TT$M_PASSALL.OR.
    1                TT$M_EIGHTBIT
    ELSE
c  turn off 8 bit passall
        CHARACTER=CHARACTER.AND..NOT.TT$M_PASSALL.AND.
    1                               .NOT.TT$M_EIGHTBIT
    ENDIF
    SPEED=0    !LEAVE SPEED UNCHANGED
    PAR=0    !LEAVE PARITY UNCHANGED

c  set terminal mode with desired passall
    ISTAT=SYS$QIOW(,%VAL(CHAN),%VAL(IO$_SETMODE),,,,
    1               CLASS,,%VAL(SPEED),,%VAL(PAR),)
    IF (.NOT.ISTAT) CALL ERROR('TERMINAL SETMODE',ISTAT)
    RETURN
    END
c---------------------------------------------------
    SUBROUTINE ERROR(STRING,MSGID)
c        Types error message
    IMPLICIT INTEGER(A-Z)
    CHARACTER*(*) STRING
    CHARACTER*80 MESSAGE

    TYPE *,' *** ERROR: ',STRING
    write(8,*) ' *** ERROR: ',STRING
    CALL SYS$GETMSG(%VAL(MSGID),MSGLEN,MESSAGE,%VAL(15),)
    TYPE *,MESSAGE(1:MSGLEN),CRLF
    write(8,*) MESSAGE(1:MSGLEN),CRLF
    RETURN
    END
c-----------------------------------------------------------
    subroutine cancel
    INCLUDE 'QIO.DCK'
c  called to cancel send (at least)
    logical charintime,ttyinlim
    byte c
    parameter CAN=24
    parameter SPACE=32

c  eat garbage
  100    charintime=ttyinlim(c,1,1)
    if(.NOT.charintime) goto 100
c  cancel other end
    call ttyout(CAN,1)

c  eat garbage in case it didn't understand ?
  200    charintime=ttyinlim(c,1,1)
    if(.NOT.charintime) goto 200
c  clear the CAN from far end's input  ???? why ? xmodem50.asm does it
    call ttyout(SPACE,1)

c    print*,' XMODEM program canceled'
    write(8,*)' XMODEM program canceled'
    call exit
    end
c------------------------------------------------------
    subroutine getack(acked)
c  returns .TRUE. if gets ACK
    logical charintime, ttyinlim, acked
    byte sector(130),c

    integer errorcount
    common /err/errorcount

    parameter ACK=6
    parameter errlim=10    ! max number of errors
    parameter eotlim=10    ! seconds to wait for eot

c    print*,' inside getack'
c  empty typeahead in case garbage
c    charintime=ttyinlim(sector,130,0)
c  allow time for file close at other end.
    charintime=ttyinlim(c,1,eotlim)
c    print*,' getack got',c
    if( .NOT.charintime .OR. c.NE.ACK ) then
c        print*, ' not ACK, decimal=',c
        write(8,*) ' not ACK, decimal=',c
        errorcount=errorcount+1
        if(errorcount.GE.errlim) then
            write(8,*) ' not acknowleged in 10 tries.'
            print*,' Can''t send sector. Aborting.'
            call exit
        endif
        acked=.FALSE.
    else
c  received ACK
        acked=.TRUE.
    endif
    return
    end

