C
C	RSXSUB - RSX-11M subroutines to be used with SNDRCV program.
C
	SUBROUTINE SETUP
C
C	Do special setup stuff.
C
	INCLUDE 'SNDRCV.INC'
	INCLUDE 'RSXDEF.FTN'

	CALL WTQIO(IOATT,TILUN,TIEFN,,XIOSB,,DSW) ! Attach the terminal.
	IOSTAT = XIOSB(1)		! Copy the I/O status.
	CALL CHKSTA(DSW,IOSTAT)		! Check the status.
C
C	Catch the following errors:
C	"No such file error     (29)" generated by OPEN 'OLD'.
C	"Open error		(30)" generated by OPEN 'NEW'.
C	"Error during write	(38)" generated by WRITE.
C	"Error during read	(39)" generated by READ.
C	"No such device		(42)" generated by OPEN.
C	"File name specification(43)" generated by OPEN.
C	"Input conversion error (64)" generated by DECODE.
C
C	CALL ERRSET(error,contin,count,type,log,maxlim)
C
	CALL ERRSET(29,.TRUE.,.FALSE.,.TRUE.,.FALSE.,)
	CALL ERRSET(30,.TRUE.,.FALSE.,.TRUE.,.FALSE.,)
	CALL ERRSET(38,.TRUE.,.FALSE.,.TRUE.,.FALSE.,)
	CALL ERRSET(39,.TRUE.,.FALSE.,.TRUE.,.FALSE.,)
	CALL ERRSET(42,.TRUE.,.FALSE.,.TRUE.,.FALSE.,)
	CALL ERRSET(43,,.FALSE.,,.FALSE.,)
	CALL ERRSET(64,.TRUE.,.FALSE.,.TRUE.,.FALSE.,)

	CALL ASSIGN(IOLUN,'SY:')	! Set default to SY0:.
	CALL CLOSE(IOLUN)		! Close so OPEN will work.
	RETURN
	END
	SUBROUTINE READIT(IBUFF,NBYTES)
C
C	Reads an input line from the host.
C
	INCLUDE 'SNDRCV.INC/NOLIST'
	INCLUDE 'RSXDEF.FTN/NOLIST'

	LOGICAL*1 IBUFF(1)
	INTEGER*2 IPR(6)
	DATA IPR(2) /256/		! Byte count for read.
	DATA IPR(3) /TIMOUT/		! Timeout count.
 
	FUNC = IORTT+TFRAL+TFRNE+TFTMO	! Set up read function.
	IBUFF(1) = 0			! Clear the first byte.
	CALL GETADR(IPR(1),IBUFF)	! Set buffer address.
	CALL GETADR(IPR(4),TTBL)	! Set terminator table addr.
	ASSIGN 100 TO RETRY		! Loop for retrys.
	ASSIGN 500 TO ERROR		! For various errors.
100	CALL WTQIO(FUNC,TILUN,TIEFN,,RIOSB,IPR,DSW)
	IOSTAT = RIOSB(1) .AND. "377 	! Copy the I/O status.
	NBYTES = IRIOSB(2)		! Copy the byte count.
	IF (NBYTES .LT. 2 .AND. IBUFF(1) .EQ. CAN)
	1	CALL ABORT		! Abort transmission.
	IF (IOSTAT .NE. ISTMO) GO TO 200 ! Timeout error ?
	TMOCNT = TMOCNT + 1		! Count # of timeouts,
	GO TO ERROR			!  and continue.
200	IF (IOSTAT .NE. IEBCC) GO TO 210 ! Framing error ?
	BCCERR = BCCERR + 1		! Yes, count it,
	GO TO ERROR			!  and continue.
210	IF (IOSTAT .NE. IEDAO) GO TO 220 ! Data overrun error ?
	DAOERR = DAOERR + 1		! Yes, count it,
	GO TO ERROR			!  and continue.
220	IF (IOSTAT .NE. IEVER) GO TO 230 ! Parity error ?
	VERERR = VERERR + 1		! Yes, count it,
	GO TO ERROR			!  and continue.
230	CALL CHKSTA(DSW,IOSTAT)		! Check status code.
	RETURN
C
C	Here for timeout and hardware errors.
C
500	IBUFF(1) = 0			! Force bad transmission
	NBYTES = 0			!  by clearing buffer & BC.
	CALL FLUSH			! Flush the typeahead buffer,
	RETURN				!  and finally return.
	END 
	SUBROUTINE WRITIT(IBUFF,NBYTES,WAIT)
C
C	This routine writes a buffer to the host.
C
	INCLUDE 'SNDRCV.INC/NOLIST'
	INCLUDE 'RSXDEF.FTN/NOLIST'

	LOGICAL*1 IBUFF(1), CODE(1)
	LOGICAL WAIT
	INTEGER*2 IPR(6)
	DATA IPR(3) /43/		! Decimal for '+'

	FUNC = IOWAL + TFCCO		! Set up write function.
	ASSIGN 100 TO RETRY		! Retry on transmission error.
100	CALL FLUSH			! Flush the typeahead buffer.
	CALL GETADR(IPR(1),IBUFF)	! Set the buffer address.
	IPR(2) = NBYTES			! Set the byte count.
	CALL WTQIO(FUNC,TOLUN,TOEFN,,XIOSB,IPR,DSW)
	IOSTAT = XIOSB(1)		! Copy the I/O status.
	CALL CHKSTA(DSW,IOSTAT)		! Check the status.
	IF (.NOT. WAIT) RETURN		! Don't wait for response.
C
C	Get response back from the host.
C 
	CALL GETRES(CODE(1))		! Get the response.
	IF (CODE(1) .EQ. NAK) GO TO RETRY ! Transmission error.
	RETURN
	END
	SUBROUTINE FLUSH
C
C	This subroutine flushs the typeahead buffer and clears
C	  the suspend state (CTRL/S) of the terminal.
C
	INCLUDE 'SNDRCV.INC/NOLIST'
	INCLUDE 'RSXDEF.FTN/NOLIST'

	LOGICAL*1 SFBUF(4)
	INTEGER*2 IPR(6)
	DATA IPR(2) /4/
	DATA SFBUF(1) /TCTBF/		! Clear typeahead buffer.
	DATA SFBUF(3) /TCCTS/		! Clear suspend state.
	DATA SFBUF(4) /0/		! Must be zero to clear.

	FUNC = SFSMC 			! Set up write function.
	CALL GETADR(IPR(1),SFBUF)	! Set the buffer address.
	CALL WTQIO(FUNC,TOLUN,TOEFN,,XIOSB,IPR,DSW)
	IOSTAT = XIOSB(1)		! Copy the I/O status.
	CALL CHKSTA(DSW,IOSTAT)		! Check the status.
	RETURN
	END
	SUBROUTINE OPERR
C
C	This subroutine returns the ERRSNS numbers to the host.
C
C	CALL ERRSNS(num,ioerr,ioerr1,iunit)
C
C	Where:	num = fortran error code,
C		ioerr = primary FCS error code (F.ERR),
C		ioerr1 = secondardy FCS error code (F.ERR+1),
C		iunit = logical unit number.
C
	INCLUDE 'SNDRCV.INC/NOLIST'

	CALL ERRSNS(FERR,FCS1,FCS2,LUN)
	WRITE (TOLUN,100) NAK, FERR, FCS1, FCS2, LUN
100	FORMAT('+', A1, 'FERR =', I6, ' FCS1 =', I6, ' FCS2 =', I6,
	1	' LUN =', I4)
	RETURN
	END
	SUBROUTINE CHKSTA(DSW,IOSTAT)
C
C	This subroutine checks the status of a QIO.
C
C	If success then simply return, else send the error code
C	to the host and cancel the transmission.
C
	INCLUDE 'SNDRCV.INC/NOLIST'
	INCLUDE 'RSXDEF.FTN/NOLIST'

	IF (DSW .EQ. ISSUC .AND. 
	1	IOSTAT .EQ. ISSUC) RETURN	! Return if success code,
	IOSTAT = IOSTAT .OR. "177400		! Sign extend high bits.
	WRITE (TOLUN,100) CAN, DSW, IOSTAT	!  else cancel transmission.
100	FORMAT ('+',A1,'ERROR detected in QIO, DSW =', I6,
	1	', IOSTAT =', I6)
	IF (FILOPN) CLOSE (UNIT=IOLUN)		! Close file if open,
	CALL EXIT				!  and exit.
	END