program xmodem50 c 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 3/13/83 touched up command line parsing to trim blanks properly. c and use proper command locations (rloc,rcloc,sloc). 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' character*80 line, file byte sector(130), c, notc, checksumbyte, ck integer blocknumber, sloc, rloc, stat, inotc, ic integer notnotc, secbytes integer nakwait, testblock, testprev logical ttyinlim, charintime, getack, acked, firstsoh logical logdel common /logfile/logdel 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 ver 5.0 on VAX [CRC capable]' 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 get command line call lib$get_foreign(line,'$_command: ',) c trim blanks do i=80,1,-1 len=i if(line(i:i).NE.' ') goto 25 enddo c no command on line goto 40 25 continue c send sloc=index(line(1:len),'S ') if(sloc.NE.0) then file=line(sloc+2:) len=len-2 goto 50 endif c receive with checksum rloc=index(line(1:len),'R ') if(rloc.NE.0) then file=line(rloc+2:) len=len-2 crc=.false. secbytes=129 goto 600 endif c receive with CRC rcloc=index(line(1:len),'RC ') if(rcloc.NE.0) then file=line(rcloc+3:) len=len-3 crc=.true. secbytes=130 goto 600 endif c else bad command 40 print *,' Invalid command.' print *,' usage: xmodem ' call exit c send file 50 open(6,name=file(1:len),iostat=stat,status='OLD',READONLY) 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 mode' else print *,' Checksum mode' endif print *,file(1:len),' open, ready to send. Run your receiver.' errorcount=0 blocknumber=1 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). do i=1,128 call ttyout(sector(i),1) enddo 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 function 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 function getack attempts to get ACK up to errlim times call getack(acked) if( .NOT.acked ) goto 500 c print *,' Sending complete.' call exit c receive file 600 continue 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.' print *,' ' call passall(CHAN,.TRUE.) 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 write(8,*) ' CRC, high,low=' write(8,3000) high,low 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 c2100 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. close(8,status='DELETE') call exit 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 newbyte ! 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' INCLUDE '($SSDEF)' 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' INCLUDE '($SSDEF)' ! defines error status returns 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) INCLUDE '($TTDEF)' 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 acklim=15 ! seconds to wait for ACK (xmodem.asm uses 10?) ! but Stern's Northstar takes longer ! to write 128 sectors c print*,' inside getack' c empty typeahead in case garbage c charintime=ttyinlim(sector,130,0) c allow time for disk file write at other end. Typically 128 sectors. c Sometimes only 1 track. charintime=ttyinlim(c,1,acklim) 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