C
C	VAXSUB - VAX/VMS subroutines to be used with SNDRCV program.
C
	SUBROUTINE SETUP
C
C	Do special setup stuff.
C
	INCLUDE 'SNDRCV.INC'
	INCLUDE 'VAXDEF.FOR'

	CHARACTER*50 TERMINAL

	IOSTAT = SS$_NORMAL
	DSW = SYS$TRNLOG('SYS$INPUT',I,TERMINAL,,,)
	CALL CHKSTA('TRNLOG',DSW,IOSTAT)
	DSW = SYS$ASSIGN(TERMINAL(5:I),CHANNEL,,)
	CALL CHKSTA('ASSIGN',DSW,IOSTAT)
	RETURN
	END
	SUBROUTINE READIT(IBUFF,NBYTES)
C
C	Reads an input line from the host.
C
	INCLUDE 'SNDRCV.INC/NOLIST'
	INCLUDE 'VAXDEF.FOR/NOLIST'

	LOGICAL*1 IBUFF(1)
 
	IBUFF(1) = 0			! Clear the first byte.
	ASSIGN 100 TO RETRY		! Loop for retrys.
	ASSIGN 500 TO ERROR		! For various errors.
100	DSW = SYS$QIOW(,%VAL(CHANNEL),
	1	%VAL(IO$_TTYREADALL + IO$M_NOECHO + IO$M_TIMED),
	1	RIOSB,,,IBUFF,%VAL(BUFSIZ),
	1	%VAL(TIMOUT),TTBL,,)
	IOSTAT = RIOSB(1)		! Copy I/O status.
	NBYTES = RIOSB(2)		! Copy the byte count.
	IF (NBYTES .LT. 2 .AND. IBUFF(1) .EQ. CAN)
	1	CALL ABORT		! Abort transmission.
	IF	(IOSTAT .EQ. SS$_TIMEOUT) THEN ! Timeout ?
		TMOERR = TMOERR + 1	! Yes, count it,
		GO TO ERROR		!  and continue.
	ELSEIF	(IOSTAT .EQ. SS$_PARITY) THEN ! Parity error ?
		VERERR = VERERR + 1	! Count # of parity errors,
		GO TO ERROR		!  and continue.
	ENDIF	
230	CALL CHKSTA('READIT',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 'VAXDEF.FOR/NOLIST'

	LOGICAL*1 IBUFF(1), CODE(1)
	LOGICAL WAIT

	ASSIGN 100 TO RETRY		! Retry on transmission error.
100	CALL FLUSH			! Flush the typeahead buffer.
	DSW = SYS$QIOW(,%VAL(CHANNEL),
	1	%VAL(IO$_WRITELBLK + IO$M_NOFORMAT + IO$M_CANTRLO),
	1	XIOSB,,,IBUFF,%VAL(NBYTES),,%VAL(43),,)
	IOSTAT = XIOSB(1)		! Copy the I/O status.
	CALL CHKSTA('WRITIT',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.
C
	INCLUDE 'SNDRCV.INC/NOLIST'
	INCLUDE 'VAXDEF.FOR/NOLIST'

	DSW = SYS$QIOW(,%VAL(CHANNEL),
	1	%VAL(IO$_READLBLK + IO$M_NOECHO + IO$M_PURGE),
	2	XIOSB,,,TBUFF,%VAL(0),,,,)
	IOSTAT = XIOSB(1)		! Copy the I/O status.
	CALL CHKSTA('FLUSH',DSW,IOSTAT)	! Check the status.
	RETURN
	END
	SUBROUTINE OPERR
C
C	This subroutine returns the error text to the host.
C
C	CALL ERRSNS(num,rmssts,rmsstv,iunit,)
C
C	Where:	num = fortran error code,
C		rmssts = RMS completion status code.
C		rmsstv = RMS status code.
C		iunit = logical unit number.
C
	INCLUDE 'SNDRCV.INC/NOLIST'
	CHARACTER*80 MESSAGE
C
C	Set flags for GETMSG for:
C		- Include text of message
C		- Include message identifier
C		- Include severity indicator
C		- Include facility name
C
	FLAGS = "17
	CALL ERRSNS(FERR,RMSSTS,RMSSTV,LUN,)
	CALL SYS$GETMSG(%VAL(RMSSTS),MSGLEN,MESSAGE,%VAL(FLAGS),)
	WRITE (TOLUN,100) NAK, MESSAGE
100	FORMAT ('+', A1, <MSGLEN>A)
	RETURN
	END
	SUBROUTINE CHKSTA(NAME,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 'VAXDEF.FOR/NOLIST'
	CHARACTER*(*) NAME

	IF (DSW .EQ. SS$_NORMAL .AND. 
	1	IOSTAT .EQ. SS$_NORMAL) RETURN	! Return if success code,
	WRITE (TOLUN,100) CAN, NAME, DSW, IOSTAT!  else cancel transmission.
100	FORMAT ('+',A1,'ERROR detected in ', A, ' DSW =', Z4,
	1	', IOSTAT =', Z4)
	IF (FILOPN) CLOSE (UNIT=IOLUN)		! Close file if open,
	CALL EXIT				!  and exit.
	END