logicerror
timeout
timeoutount
cserrorcount
define (error=1)# error lun
define (sy=2)	# output file lun
define (rem=3)	# remote computer lun
define (null=0)	# "0	^@
define (soh=1)	# "1 	^A
define (stx=2)	# "2	^B
define (eot=4)	# "4 	^D
define (enq=5)	# "5 	^E
define (ack=6)	# "6 	^F
define (bel=7)	# "7	^G
define (bs=8)	# "10 	^H
define (lf=10)	# "12 	^J
define (cr=13)	# "15	^M
define (so=14)	# "16	^N
define (dle=16)	# "20	^P
define (dc4=20)	# "24	^T
define (syn=22)	# "26	^V
define (esc=27)	# "33 	^[
define (space=' ')
define (del=127)	# "177
define (oct040=32)	# "40
define (oct077=63)	# "77
define (oct100=64)	# "100
define (oct137=95)	# "137
define (oct200=128)	# "200
define (transmissionlength=516)	# maximum length of transmitted data sequences
define (responselength=10)	# length of transmitted response sequences
define (maxrecordsize=512)
define (translengthhigh=trhigh)
define (translengthlow=trlow)
define (recordlengthhigh=rechi)
define (recordlengthlow=reclow)
define (encodenumeric=enlen)
define (decodenumeric=delen)
define (ttwlbf=256)	# io.wlb, "400
define (ttrnef=528)	# io.rne, "1020

# RECEIV - main routine of receive task, Cadnet V 2.0
#
#	This program is the receiving section for CADNET. It can handle varible
#	record length files of the 'list' type, and fixed record length files. 
#
	program		receiv

	byte 		record (maxrecordsize), fname (29)
	logical*1	image
	integer*2	iarray (18), namlen, reclen

	byte		tsknam (6)
	common		/task/	tsknam

%	data		idot	/3r.../
	data		fname (29) /0/
	byte		respon (responselength)

# Attach the devices used by Cadnet
	call assign (sy, 'SY0:')		# output lun
	call assign (sy)			# close the unit
	call assign (error, 'TI:')		# error message lun
	call ttatt (0, rem, istat)		# attach to term
	if (istat != 0)				# attach error
		{
		write (error, 102) tsknam
		call exst (4)
		}

# Find our task name for error messages
	call gettsk (iarray, ids)		# get task name
	if (iarray (1) == idot) iarray (1) = 0	# delete leading '...'s
	if (iarray (2) == idot) iarray (2) = 0	# delete trailing '...'s
	call r50asc (6, iarray, tsknam)		# convert to ascii
	do i = 1, 6	# eliminate blanks
		if (tsknam (i) == ' ')
			tsknam (i) = 0

# Initialize the readln routine by calling writln once.
	respon (1) = null
	call writln (respon, 0)

# Process files being transmitted
repeat
	{
	# Open output file
	call rinit (fname, namlen, image, reclen)

	# Move the records of the file
	repeat
		{
		# read the record from the remote computer
		call retln (record, linlen, iretcd)
		if (iretcd == 1)		# check for end of file
			break

		#   write record to output file
		#type *, 'writing a record of length', linlen
		if (linlen == 0)
			write (sy, 100, err=9)
		else if (linlen > 0)
			write (sy, 100, err=9) (record (i), i = 1,linlen)
		}

	# End of file. close output file and loop for next file.
	call close (sy)

	# Write error section
	if (.false.)
		{
		9
		write (error, 101) tsknam, (fname (i), i = 1, namlen)
		respon (1) = soh
		call writln (respon, 1)
		call close (sy)		# close file
		}
	}

100	format (4(128a1))
101	format (x, 6a1, ' -- Unable to write to output file ', 28a1)
102	format (x, 6a1, ' -- Unable to attach to remote. Aborting task.')
103	format (' ', a1)
	end

# RINIT - initialize file handling for receive task, CADNET V 2.0.
#
# Calling Sequence:
#	call rinit (fname, namlen, image, reclen)
#
# Where:
#	fname  - byte array into which the filespec is placed
#	namlen - length of string fname
#	image  - flag: .true. if file is fixed length (image mode)
#	reclen - record length of target file (0 if variable length)
#
#	This subroutine handles the communication initialization sequence.
#	It determines the file name, its length, type of file, and record
#	length for fixed length files.
#
#	In the following notes, the string transmitted by XMT is listed
#	first, followed by the response string sent by RECEIV. All lengths 
#	(transmission, record, filename) are coded via subroutine encodenumeric
#
#	<ACK> [filename length] [record length] [file name] <CR>
#	[transmission length] <CR>
#
	subroutine rinit (fname, namlen, image, reclen)

	byte		fname (28)
	integer*2	namlen
	logical*1	image
	integer*2	reclen

	byte		tsknam (6)
	common		/task/ tsknam

	integer*2	seqlength
	common		/seq/ sequence
	byte		sequence (transmissionlength)

	byte		translengthhigh, translengthlow
	byte		respon (responselength)

	define (fnpos=6)

# Clear file name
	do i = 1, 28
		fname (i) = null

# Wait for a valid init sequence, then process it.
repeat
	{
	call readln (seqlength)

	# Reject if not a valid init sequence, go back and wait for another
	if ((seqlength < 5) \ (sequence (1) != ack))
		{
		respon (1) = stx
		call writln (respon, 1)
		next
		}
	
	# Decode init sequence for file name length, reject if invalid
	call decodenumeric (namlen, sequence (2), sequence (3))
	if (seqlength != namlen + 5)	# verify file name length
		{
		respon (1) = stx
		call writln (respon, 1)
		next
		}

	# Decode for record length. If zero output file will be varible length.
	call decodenumeric (reclen, sequence (4), sequence (5))
	image = reclen > 0
	#type 999, 'reclen, image, sequence', reclen, image
	#999 format (' ', a, i5, l3)
	#type *, sequence

	# Move file name to fname
	do j = 1, namlen
		fname (j) = sequence (j + fnpos - 1)


	# Compute and send response to remote computer
	call encodenumeric (seqlength, translengthhigh, translengthlow)
	respon (1) = translengthhigh
	respon (2) = translengthlow
	call writln (respon, 2)

	# Open output file
	if (image)	# fixed length
		{
		#type *, 'opening a file with reclen', reclen
		open (unit=sy, name=fname, type='new', err=9,
			recordtype='fixed', recordsize=reclen,
			access='sequential', form='formatted')
		}
	else 		# varible length 
		open (unit=sy, name=fname, type='new', err=9, 
			carriagecontrol='list')

	# Open error section
	if (.false.)
		{
		9
		write (error, 8) tsknam, (fname (i), i = 1, namlen)
		8 format (' ', 6a1, ' -- Unable to open output file ', 28a1)
		respon (1) = soh
		call writln (respon, 1)
		}

	return
	}

	end

# RETLN - retreive a logical record from the remote computer.
#	for receive task, Cadnet V 2.0.
#
# Calling Sequence:
#	call retln (record, linlen, iretcd)
#
# Where:
#	record - logical record received from the remote computer
#	linlen - length of logical record
#	iretcd - status code:	  0 => all ok
#				> 0 => end of file
#				< 0 => transmission error
#
# Notes:
#	Logical records are transmitted as one or more sequences. Each sequence
#	has up to 40 characters, which may be either normal characters or
#	special character subsequences.
#
#	There are several different formats for sequences transmitted from 
#	the remote computer. All of the following formats list the transmitted
#	sequence first, then the response string sent back to the remote.
#
#	In the following notes, the string transmitted by XMT is listed
#	first, followed by the response string sent by RECEIV. All lengths 
#	(transmission, record) are coded via subroutine decodenumeric.
#
#	The format of a sequence representing a logical record of length 0 is:
#		<STX> <CR>
#		[transmission length] [logical record length] <CR>
#
#	The format of a sequence not holding the end of the logical record is:
#		[data subsequences] <SO> <CR>
#		[transmission length] <CR>
#
#	The format of a sequence holding the end of the logical record is:
#		[data subsequences] <DLE> <CR>
#		[transmission length] [logical record length] <CR>
#
#	An end-of-file:
#		<EOT> <CR>
#		<EOT> <CR>
#
#	In each case, the CR is stripped off by RSX.
#

	subroutine retln (record, linlen, iretcd)

	byte		record (maxrecordsize)
	integer*2	linlen, iretcd

	integer*2	recptr
	integer*2	offset, seqlength
	logical*1	contin
	common		/seq/ sequence
	byte		sequence (transmissionlength)
	byte		translengthhigh, translengthlow
	byte		recordlengthhigh, recordlengthlow

	byte		tsknam (6)
	common 		/task/ tsknam

	byte		respon (responselength)

	recptr=1		# pointer in record
	iretcd=0		# clear status code
	linlen=0		# clear length of line
	offset=0		# used to compute control characters

# Process sequences received from the remote until a logical record has
#	been received.
repeat
	{
	call readln (seqlength)

	# Determine type of sequence.
	if (sequence (seqlength) == so)
		{	# sequence: doesn't contain end of logical record
		contin = .true.
		seqlength = seqlength - 1	# delete <SO> from sequence
		}
	else if (sequence (seqlength) == dle)
		{	# sequence: contains end of logical record
		contin = .false.
		seqlength = seqlength - 1	# delete <SO> from sequence
		}
	else if (sequence (1) == stx & seqlength == 1)
		{		# null logical record
		contin = .false.
		seqlength = seqlength - 1	# delete <STX> from sequence
		break
		}
	else if (sequence (1) == eot & seqlength == 1)
		{		# End of file: send response string, return
		iretcd = 1
		respon (1) = eot
		call writln (respon, 1)
		return
		}
	else
		{		# transmission error
		type *, 'seqlength, sequence', seqlength, (sequence (i), i = 1, seqlength)
		write (error, 101) tsknam, 2
		respon (1) = soh
		call writln (respon, 1)
		iretcd = 1
		return
		}

	# Move data from sequence to record, interpreting all subsequences.
	do j = 1, seqlength
		{
		if (sequence (j) < space)	# start of control subsequences
			{
			if (sequence (j) == enq)		# Control char
				offset = 1
			else if (sequence (j) == bel)	# Bit 7 set, bit 6 set
				offset = -1
			else if (sequence (j) == bs)	# Bit 7 set, bit 6 clr
				offset = -2
			else if (sequence (j) == dc4)	# <DEL>
				{
				offset = 0
				record (recptr) = del
				recptr = recptr + 1
				}
			else if (sequence (j) == syn)	# <DEL> with bit 7 set
				{
				offset = 0
				record (recptr) = del \ oct200
				recptr = recptr + 1
				}
			else 			# this is an error condition
				{
				write (error, 101) tsknam, 3
				respon (1) = soh
				call writln (respon, 1)
				iretcd = 1
				return
				}
			}
		else			# end of control subseq. or normal char
			{
			# Interpret transmitted characters.
			if (offset == 1)	# Control char
				record (recptr)= sequence (j) & oct077
			else if (offset == -1)	# Negative character, bit 6 set
				record (recptr)= sequence (j) \ oct200
			else if (offset == -2)	# Negative character, bit 6 clr
				record (recptr)= (sequence (j) & oct077) \ oct200
			else if (offset == 0)	# Normal character
				record (recptr)= sequence (j)
			offset = 0		# clear offset
			recptr = recptr + 1	# increment pointer
			}
		}

	# Transmit this value if sequence is not finished
	if (contin)
		{
		call encodenumeric (seqlength+1, translengthhigh, translengthlow)
		respon (1) = translengthhigh
		respon (2) = translengthlow
		call writln (respon, 2)
		}

	} until (! contin)

# Send end of logical record response
	call encodenumeric (seqlength+1, translengthhigh, translengthlow)
	linlen = recptr - 1	# compute length of record
	call encodenumeric (linlen, recordlengthhigh, recordlengthlow)
	respon (1) = translengthhigh
	respon (2) = translengthlow
	respon (3) = recordlengthhigh
	respon (4) = recordlengthlow
	call writln (respon, 4)

	return

101	format (' ', 6a1, ' - Transmit error', i3, '. Aborting communication.')

	end

# WRITLN - write a response to the remote computer.
#	for receive task, CADNET V 3.0
#
# Calling Sequence:
#	call writln (respon, rsplen)
#
# Where:
#	respon - string containing all the characters in the response 
#	rsplen - length of string respon, may be a constant.
#
# Notes:
#	Readln will fetch a sequence from the remote, the caller will process
#	the sequence, and send a response. It is important that no characters
#	slip through, so writln will now actually issue an asynchronous read
#	to the remote immediately after the write has completed. When readln is
#	called, it will wait for the read to complete, then return the sequence
#	as stored. All routines which access sequence do so through common seq.
#
	subroutine writln (respon, rsplen)

	byte		respon (responselength)
	integer*2	rsplen

	common		/seq/ sequence
	byte		sequence (transmissionlength)

	integer*2	outlen

	byte		tsknam (6)
	common		/task/	tsknam

	integer*2	istat, addr
	include		[100,3]ttcomm

	define 		(wrtefn=2)
	define		(redefn=3)
	integer*2	wrtpar (6), wrtios (2), wrtdsw

#	type *, 'writing: rsplen', rsplen
#	type 99, (respon (i), i = 1, rsplen)
#	99 format (20o4)

# Prepare for the qio calls.
	respon (rsplen + 1) = cr
	outlen = rsplen + 1
	call getadr (addr, respon)
	wrtpar (1) = addr
	wrtpar (2) = outlen
	wrtpar (3) = 0

	call getadr (addr, sequence)
	ttpar (1) = addr
	ttpar (2) = transmissionlength
	ttios (1) = 1

# Write the response 
	if (rsplen > 0)	
		call qio (ttwvbf, rem, wrtefn, , wrtios, wrtpar, wrtdsw)
	else
		wrtdsw = 1

# Issue the read
	call qio (ttrnef, rem, redefn, , ttios, ttpar, ttdsw)

# Check for directive error on the io's
	if (wrtdsw != 1 \ ttdsw != 1)	# directive error
		{
		write (error, 1) tsknam, wrtdsw, ttdsw
		write (rem, 3) soh
		call exst (4)
		}

1 format (' ', 6a1, ' - Directive error', 2i5, ' - writln. Aborting receive.')
3 format (x, a1)

	return
	end

# READLN - read a sequence from the remote computer.
#	For receive task, CADNET V 3.0
#
# Calling Sequence:
#	call readln (seqstart, seqlength)
#
# Where:
#	seqstart  - first character in sequence to be used.
#	seqlength - length of sequence.
#
# Notes:
#	The byte array sequence in common seq will contain all the characters 
#		in the sequence.
#	The sequence will have the following format:
#		[checksum] [sequence number] <sequence type> [sequence data] CR
#	Readln will verify the checksum and send a Data Error response if 
#		checksum incorrect.
#	Readln will send a Timeout response if any reads experience a timeout.
#	If the number of data errors or timeouts in a row exceeds errorlimit,
#		readln will force an abort.
#	If the sequence number is incorrect, readln will either request the
#		next sequence (if low by 1) or force an abort.
#

	subroutine readln (seqstart, seqlength)

	integer*2	seqlength

	include		seq.rat

	integer*2	istat, addr, iofcn
	include		[100,3]ttcomm

	byte		tsknam (6)
	common		/task/	tsknam

	seqno = seqno + 1
	timeoutcount = 0
	cserrorcount = 0

repeat
	{
	call waitfr (redefn, idsw)

#	type *, 'reading: (length)', ttios (2)
#	type 99, (sequence (i), i = 1, ttios (2))
#	99 format (20o4)


	if (idsw != 1)
		{		# directive error
		call abort (...)
		}

	if (ttbyt == 1)	# all ok
		{
		seqlength = ttios (2)
		seqstart = 1
		while (sequence (seqstart) == null)
			{	# strip off <NULL> from the start
			seqstart = seqstart + 1
			seqlength = seqlength - 1
			}
		call decodenumeric (transchecksum,
			sequence (seqstart), sequence (seqstart+1))
		checksum = 0
		do i = seqstart+2, seqstart+seqlength-1
			checksum = (checksum + sequence (i)) & 4095
		if (transchecksum != checksum)	# checksum error
			{
			cserrorcount = cserrorcount + 1
			if (cserrorcount > errorlimit)
				call abort (...)
			call error (cserror)
			next
			}
		call decodenumeric (transseqno,
			sequence (seqstart+2), sequence (seqstart+3))

		if (transseqno == seqno)
			return
		else if (transseqno == seqno - 1)
			{
			call writln (ack, 1)
			next
			}
		else	# sequence number wrong
			call abort (...)
		}
	else if (ttbyt == istmo)	# timeout
		{
		timeoutcount = timeoutcount + 1
		if (timeoutcount > errorlimit)
			call abort (...)
		call error (timeout)
		next
		}
	else 		# i/o error
		call abort (...)
	}

	end

# encodenumeric - encode a length (integer, 0 <= length <= 4095) into 2 ASCII
#	characters.
#
# Calling Sequence:
#	call encodenumeric (i, hibyte, lobyte)
#
# Where:
#	i      - value to be encoded
#	hibyte - high-order 2 octal digits of i, plus offset of octal 40.
#	lobyte - low-order 2 octal digits of i, plus offset of octal 40.
#

	subroutine encodenumeric (i, hibyte, lobyte)

	integer*2	i
	byte		hibyte, lobyte


# Check for input value out of range
	if ((i < 0) \ (i > 4095))
		call abort (logicerror)

# Encode value
	hibyte = (i / oct100) + oct040
	lobyte = (i & oct077) + oct040

	return
	end

# decodenumeric - decode a length (integer, 0 <= length <= 4095) from 2 ASCII
#	characters.
#
# Calling Sequence:
#	call decodenumeric (i, hibyte, lobyte)
#
# Where:
#	i      - output: value of the ASCII characters. -1 if error.
#	hibyte - high-order 2 octal digits of i, plus offset of octal 40.
#	lobyte - low-order 2 octal digits of i, plus offset of octal 40.
#

	subroutine decodenumeric (i, hibyte, lobyte)

	integer*2	i
	byte		hibyte, lobyte

	integer*2	j, k

# Check for illegal input values
	if     ((hibyte < oct040) \ (hibyte > oct137) \
		(lobyte < oct040) \ (lobyte > oct137)) 
		{
		i = -1
		return
		}

# Decode value
	j = hibyte - oct040
	k = lobyte - oct040
	i = j * oct100 + k

	return
	end

# ABORT - send abort response to XMT, and force task exit.
#
# Calling Sequence:
#	call abort (subcode)
#
# Where:
#	subcode - error subcode (abort or some internal error, usually)
#