               ­7È+ÍˆC:)=_Íg XMODEM  MSG                   XMODEM  DOC                   XMODEM  HLP                   XMODEM  FOR< ç                  XMODEM  COM#                  QIO     DCK(                  CTOV    FOR)                  VTOC    FOR@                 ÿbo=<áÊ.oÍtoÍÈKÃ.oá:vÍˆC!v¾ÚoÿG~w£oÍgx·ÈþÚ“o>Ox‘GÅ ÕÍ³GÿÁÃ†o                ¹oÃ†o     


                        XMODEM Version 5.1 on CENTACS VAX

             É aí verù pleaseä tï announcå thaô XMODEM¬  Versioî 5.1¬  ió 
        no÷  completelù operationaì oî thå CENTACÓ VAX®   XMODEÍ supportó 
        thå publiã domaiî MODEM² anä MODEM· communcationó protocols¬  anä 
        iô enableó anù microcomputeò whicè alsï supportó theså  protocoló 
        tï  transmiô anù sizå oæ texô oò binarù filå tï anä froí VAX/VMS®  
        Theså byte-orienteä datá linë leveì protocoló arå highlù reliablå 
        anä detecô oveò 99¥ oæ thå possiblå transmissioî errors¬ retrans-
        mittinç packetó aó requireä tï ensurå thaô thå fileó arå receiveä 
        properly®  XMODEÍ 5.± supportó transmissioî oæ fileó aô speedó uð 
        tï 960° baud.

             Thió ió á significanô tooì foò uså oî thå VAX®   Sincå therå 
        arå  severaì machineó oî thå Defenså Datá Networë (DDN1¬  oò  thå 
        olä  ARPÁ  Net© whicè implemenô theså protocoló aó  well¬  iô  ió 
        possiblå  tï transfeò anù filå froí thå DDÎ tï thå VAØ  anä  bacë 
        agaiî  thrõ á microcomputer®   Manù otheò organizations¬  sucè aó 
        Whitå Sandó Missilå Range¬  thå Ballistiã Researcè Lab¬  thå  Aiò 
        Forcå  Institutå  oæ Technology¬  anä Belì Labs¬  arå alsï  usinç 
        theså  protocols¬  anä  communicatioî witè theí ió openeä  uð  bù 
        XMODEM.

             Speciaì  provisionó  arå includeä iî XMODEÍ foò  VAX/VMÓ  tï 
        transfeò  (anä  convert© texô fileó tï anä froí  thå  VAX®   Thió 
        allowó thå uså oæ á microcomputeò oò conventionaì worä  processoò 
        tï  bå  useä tï generatå á documenô anä the use of thå VAØ  aó  á 
        repositorù anä distributioî systeí foò thaô document.

             Iî  testing¬  smalì (undeò 12¸ character© texô files¬  largå 
        (oveò  34Ë character© texô files¬  anä executablå  binarù  imageó 
        havå beeî transferreä tï anä froí thå VAØ withouô anù error.

             Manù  otheò  applicationó  caî bå founä  foò  thió  program®  
        Interesteä  personó  maù  obtaiî  commandó foò  usinç  XMODEÍ  bù 
        including the following command in their LOGIN.COM files:

                  @[conn.public]xmodem

        Foò   furtheò   documentation¬    [conn.publicÝ   alsï   containó 
        XMODEM.HLP¬  whicè  describeó thå uså oæ theså commandó  iî  somå 
        detail.

             Questionó  shoulä  bå addresseä tï må aô thå  followinç  ad-
        dresses®  Uså oæ thå telephonå tï contacô må ió noô recommended.

                  On CENTACS VAX:  CONN
                  On DDN:  RCONN@BRL or
                           DRSEL-TCS-SSD@OFFICE-7 or
                           CONN@MIT-MC
        Enjoy!
        Richard ConnŠThe following files are provided in this distribution of XMODEM 5.1
for VAX/VMS:

	XMODEM.FOR -- Source of XMODEM in FORTRAN-77
	XMODEM.COM -- COM (Indirect Command File) to Implement
			XMODEM commands of XMODEM, CTOV, VTOC, SEND, and RECV
	XMODEM.HLP -- VAX/VMS Help File
	XMODEM.MSG -- Message Announcing This Program
	XMODEM.DOC -- This Documentation File
	CTOV.FOR   -- Source of CTOV (CP/M to VAX/VMS Text File Converter)
	VTOC.FOR   -- Source of VTOC (VAX/VMS to CP/M Text File Converter)
	QIO.DCK    -- INCLUDE File Used by XMODEM.FOR

Thanks to Jim Belonis for the original creation of XMODEM.FOR from TMODEM.C.

	Rick Conn

2 CPM
	Utilities for 8080 etc. Microcomputers running the CP/M
operating system.  Note especially RCPMLIST.032 is a list of public
CP/M systems available over the phone.

XMODEM will allow MODEM7 compatable programs to transfer
binary or ASCII files to or from your CP/M system with CRC or checksums.

CTOV converts CP/M ASCII files as received to VAX editable form
                  (1 line per record, no CRLF at ends of records).
VTOC   converts normal VAX text files to CP/M format (128 character
                  records, CRLF at ends of lines) ready for transfer.
3 XMODEM
     Format:
            XMODEM  option  file

The current options are
	S	Send ANY File from the VAX
	ST	Send a VAX/VMS Text File
		  (file is internally converted to CP/M format)
	SC	Send ANY file from the VAX using CRCs
	R	Receive ANY File to the VAX
	RT	Receive a VAX/VMS Text File
		  (file is internally converted from CP/M format)
	RC	Receive ANY file to the VAX using CRCs

Assuming you have MODEM7 runnable on your system,
and a direct or modem connection to the VAX,
then to perform a transfer using MODEM7 or its successors
you would on your CP/M system:

A>modem7                     you run MODEM7 on your CP/M system
Command: T                   you tell it to emulate a VAX terminal
                             press return to get VAX prompt
Username:JIMMY               log in to VAX via MODEM7
Password:                    just as if you were on a direct terminal
          Welcome...

$ xmodem  s  ulib:[cpm]help.com   run XMODEM telling it to send the named
                                  file from the VAX
CTRL-E                            gets attention of your MODEM7 program
Command: r  help.com              tell MODEM7 to recieve the file on
                                  your CP/M system

To send a file to the VAX:
$ xmodem  r  spec34a.dat          tell XMODEM to receive file
CTRL-E                            get attention of MODEM7
Command: s  spec34a.dat           tell MODEM7 to send file to VAX
3 CTOV
Converts from CP/M file (continuous stream of bytes in 128 character
records with embedded CR LF) to VAX editable file (one line per
record carriagecontrol='LIST').
     Format:
             CTOV  infile  outfile

Example, assuming you have accessed the VAX via your CP/M system's
MODEM7 program:
$ XMODEM  R  thesis.cpm               tell XMODEM to receive the file
CTRL-E                                get MODEM7 attention
Command: S  thesis.cpm                tell MODEM7 to send the file.
$ CTOV      thesis.cpm thesis.doc     convert to VAX text form
3 VTOC
Converts from VAX text file (one line per record, no CR LF)
to CP/M form (one line per record, CR LF added at end of line)
ready for transfer to CP/M system using XMODEM.
     Format:
             VTOC  infile  outfile

Example, assuming you have accessed the VAX via your CP/M system's
MODEM7 program:
$ VTOC  thesis.doc thesis.cpm       convert to CP/M form
$ XMODEM  S  thesis.cpm               tell XMODEM to send the file
CTRL-E                                CTRL-E to get MODEM7 attention
Command: R  thesis.cpm                tell MODEM7 to receive the file.

3 SEND
The XMODEM.COM file creates the SEND command as a special
form of the more general-purpose XMODEM command.  SEND
is used to send a Text File from the VAX to the micro.
It is equivalent to XMODEM ST.
3 RECV
The XMODEM.COM file creates the RECV command as a special
form of the more general-purpose XMODEM command.  RECV
is used to receive a Text File on the VAX from the micro.
It is equivalent to XMODEM RT.
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  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'
	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.NE.0) 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.NE.0) 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.NE.0) 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.NE.0) 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.NE.0) 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.NE.0) 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).
	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  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

!
!	XMODEM.COM for VAX/VMS by Richard Conn
!	This command file defines the following commands --
!
!	XMODEM -- VAX/VMS File Transceiver
!	CTOV -- Convert CP/M Text File to VAX/VMS Format
!	VTOC -- Convert VAX/VMS Text File to CP/M Format
!	SEND -- Send VAX/VMS Text File via XMODEM
!	RECV -- Receive CP/M Text File via XMODEM
!
$ X*MODEM:==$sys$usersdisk:[conn.bin]xmodem
$ CTOV:==$sys$usersdisk:[conn.bin]ctov
$ VTOC:==$sys$usersdisk:[conn.bin]vtoc
$ SEND:==$sys$usersdisk:[conn.bin]xmodem ST 'P1'
$ RECV:==$sys$usersdisk:[conn.bin]xmodem RT 'P1'
C  QIO.DCK to be included in subroutines using SYS$QIOW

	INTEGER*2 CHAN,STATUS(4)
	COMMON /QIO/ CHAN,STATUS


	program ctov
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)
c  6/21/83 increased output line buffer to 300 characters.

	character*300 line
	character*254 input,output
	character*1 CR,LF,recchar
	integer blank
	logical eof
	data eof/.false./

	CR=char(13)
	LF=char(10)
	print *,'CTOV -- Convert CP/M Text Files to VAX/VMS'
	call lib$get_foreign(line,'  From  To: ',)

	blank=index(line,' ')
	input=line( 1:blank )
	output=line( blank:)

	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 getchar(recchar,eof)
	if(eof) goto 200
	if(recchar.eq.CR) then
c	PRINT *,' CR'
		call getchar(recchar,eof)
		if(eof.or.recchar.ne.LF) then
			call putback
			
			len=len+1
			if(len.gt.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.gt.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
	close(6)
	close(7)
	call exit

  	end
c------------------------------------------
	subroutine getchar(c,eof)
	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 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


	program toxmodem
c  convert VAX text file to
c  file of XMODEM 128 byte records with embedded <CR><LF>

	character*254 line,input,output
	character*1 CR,LF,c
	integer blank
	logical eof,eol
	data eof,eol/.false.,.false./

	CR=char(13)
	LF=char(10)
	print *,'VTOC -- Convert VAX/VMS Text Files to CP/M'
	call lib$get_foreign(line,'  From  To: ',)

	blank=index(line,' ')
	input=line( 1:blank )
	output=line( blank:)

	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 getchar(c,eof,eol)
	if(.not.eol) then
		call putchar(c,eof)
	else
c  end of line
		call putchar(CR,eof)
		call putchar(LF,eof)
		eol=.false.
	endif
	go to 100

  	end
c-------------------------------------------
	subroutine getchar(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 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)
	call exit
	end
