C	VAXNET.FOR
C
C	THIS PROGRAM IS A VIRTUAL TERMINAL HANDLER USED TO COMMUNICATE WITH
C	A PDP10, VAX, OR PDP11
C
C	RUN THIS PROGRAM WITH SUITABLE PRIVILEGES.
C	DIAL UP A PDP10, VAX, OR PDP11 USING THE DZ11 PORT NAMED IN REMDEV.
C	LOG ONTO THAT SYSTEM AT THE PROGRAM'S LOCAL TERMINAL TO USE THE
C	VIRTUAL TERMINAL CAPABILITY.
C	RUN THE APPROPRIATE VERSION OF SNDRCV ON THAT SYSTEM TO TRANSFER
C	FILES BACK AND FORTH.
C	SEE VAXNET.HLP FOR DETAILED INSTRUCTIONS AND INFORMATION.
C
C	J. THOMPSON  INTERMETRICS  MARCH 26, 1979
C	R. LIPSETT   INTERMETRICS  APRIL 23, 1979
C
C	MODIFICATION HISTORY
C
C	TECOINPUT COMMAND ADDED MAY 11, 1979 - J. THOMPSON  (REV 1.1)
C	MINOR EDITING CHANGES TO MAKE VAXNET  MAY 15, 1979 - J. THOMPSON (1.2)
C	WRTRD MODS AND NAMING OF REMDEV ADDED MAY 16, 1979 - J. THOMPSON (1.3)
C	CHANGES TO MAKE VIRTUAL TERMINAL PROCEDURE HANDLE ONE CHARACTER AT A
C	A TIME WHEN READING REMOTE PORT.  JULY 4, 1979  J. THOMPSON (REV 1.5)
C	SOME CHANGES TO IMPROVE LOCAL TERMINAL TREATMENT OF RECEIVED LINEFEEDS
C	AND TO SEND CONTROL CHARACTERS EASIER.  12 JULY, 1979  J. THOMPSON
C	(REV 1.53)
C	REMOTE PORT TERMINAL CHARACTERISTICS ARE NOW SET BY VAXNET AND THEN
C	RETURNED TO NORMAL AT VAXNET TERMINATION.
C	27 JULY, 1979  J. THOMPSON  (REV 1.54)

	INCLUDE 'COM.INC'
	EXTERNAL ACTRLCAST, WRITELT, WRITERT, RESET_WORLD
	EXTERNAL SYS$DCLEXH
	INTEGER SYS$DCLEXH
C
	CHARACTER*50 LOCDEV	! TO HOLD THE NAME OF THE PHYSICAL LOCAL DEV.
	CHARACTER*50 REMDEV	! TO HOLD THE NAME OF THE PHYSICAL REMOTE DEV.
C
	WRITE(6,*) 'INTERMETRICS VAX VIRTUAL TERMINAL HANDLER - VAXNET -
	1 (REV 1.54)'

C	SET UP AN EXIT HANDLER, AND SET THE PROCESS NAME.
	EXIT_BLOCK(2) = %LOC(RESET_WORLD)
	EXIT_BLOCK(3) = 1
	EXIT_BLOCK(4) = %LOC(STATUS)
	CALL SYS$DCLEXH(EXIT_BLOCK)
	IRCODE = SETPRN('VAXNET')
	IF (IRCODE .NE. %LOC(SS$_NORMAL)) IRCODE = SETPRN()

	CALL SYS$TRNLOG('SYS$INPUT',I,LOCDEV,,,)
C	NOTE IN THE FOLLOWING THAT I CONTAINS THE TRUE LENGTH, AND REMEMBER
C	THAT TRNLOG PUTS A STUPID 4-BYTE HEADER ON THE TRANSLATIONS OF
C	SYS$INPUT/OUTPUT SPECIFICALLY.
	JRCODE=SYS$ASSIGN(LOCDEV(5:I),LCHANIN,,)! LOCAL CHANNEL INPUT
	IF(JRCODE.NE.%LOC(SS$_NORMAL)) STOP 'LOCAL PORT (TT) NOT ASSIGNED'
	LCHANOUT = LCHANIN			! LOCAL CHANNEL OUTPUT

	WRITE(6,9901)
9901	FORMAT('  NAME OF VAXNET DZ11 OUTPUT PORT (e.g. _TTB7:)? '$)
	READ(5,9902) I,REMDEV(1:I)
9902	FORMAT(Q,A<I>)
	IRCODE=SYS$ASSIGN(REMDEV(1:I),RCHANIN,,)! REMOTE CHANNEL INPUT
	IF(IRCODE.NE.%LOC(SS$_NORMAL)) STOP 'REMOTE DZ11 PORT NOT ASSIGNED'
	RCHANOUT = RCHANIN			! REMOTE CHANNEL OUTPUT.
	CALL SETVAXNET  !SET REMOTE PORT TO VAXNET CHARACTERISTICS

C	SET PROCESS PRIORITY AND SWAP MODE
	CALL SYS$SETSWM(%VAL(1)) !NO SWAPPING
	PRIORITY=7
	CALL SYS$SETPRI(,,%VAL(PRIORITY),)

C	DISABLE CTRL C TRAPS
	KRCODE=SYS$QIOW(,%VAL(LCHANIN),
	1	%VAL(%LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST)),,,,,,,,,)
C
	XB = 0				! TRANSMITTER NOT BUSY
	CHANCTRLC = .FALSE.		! NO ^C SEEN YET.
	CALL SETCTRLC			! ENABLE CTRL C AST'S
C
	P = 1		!POINTER TO FIRST CHARACTER POSITION IN RBUFFER
	C = 0		!COUNT OF CHARACTERS IN RBUFFER
	CALL CLRTYPE	!CLEAR REMOTE PORT TYPEAHEAD BUFFER

	TYPE *,' '
	TYPE *,'SET TERMINAL CHARACTERISTICS.'
	TYPE *,'ALWAYS WAIT FOR PROMPTS.'
	TYPE *,'TYPE CTRL C FOLLOWED BY ANOTHER C TO STOP EXTRA BLANK LINES.'
	TYPE *,' '

C
C	LOOP
C
100	RB=1				!RECEIVER ENABLED - USE 1 SEC TIMEOUT
	IRCODE=SYS$QIO(,%VAL(RCHANIN),
	1	%VAL(%LOC(IO$_READLBLK)+%LOC(IO$M_TIMED)
	1	+%LOC(IO$M_NOECHO)+%LOC(IO$M_TRMNOECHO)),
	1	RIOSB,WRITELT,,RBUFFER(P),%VAL(1),%VAL(1),,,)
	IF(IRCODE.NE.%LOC(SS$_NORMAL)) CALL QIOERROR(1,IRCODE)

200	IF (CHANCTRLC) CALL GETCTRL	!GET AND SEND ANY CONTROL CHARACTERS
	IF(RB.EQ.0) GO TO 100		!SEE IF RECEIVER IS DONE (RB.EQ.0)
	IF(XB.EQ.0) GO TO 400		!SEE IF TRANSMITTER IS DONE (XB.EQ.0)
	CALL SYS$HIBER			!WAIT UNTIL SOMETHING HAPPENS
	GO TO 200

400	XB=1				!TRANSMITTER BUSY.
	JRCODE=SYS$QIO(,%VAL(LCHANIN),%VAL(%LOC(IO$_READLBLK)
	1	+%LOC(IO$M_TRMNOECHO)),
	1	XIOSB,WRITERT,,XBUFFER,%VAL(BUFSIZE),,,,)
	IF(JRCODE.NE.%LOC(SS$_NORMAL)) CALL QIOERROR(2,JRCODE)
	GO TO 200
	END
C	ACTRLCAST.FOR
C
C	CTRLC TRAP HANDLER
C
	SUBROUTINE ACTRLCAST
C
	INCLUDE 'COM.INC/NOLIST'
	EXTERNAL DUMMY
C
C	TURN OFF ALL READS OUTSTANDING
C
	CANL=1
	CANR=1
	RB=1
	XB=1
	CALL SYS$CANCEL(%VAL(LCHANIN))
	CALL SYS$CANCEL(%VAL(RCHANIN))

	IF (INCMD) THEN		! IF IN A GET COMMAND,
		INCMD = .FALSE.		! TURN OFF COMMAND FLAG AND RETURN.
					! THERE IS NO RACE HERE BECAUSE THE
					!  QIOW IN GET DOES NOT GEN AN AST.
	ELSE			! GET CONTROL CHARACTERS TO SEND
		CHANCTRLC = .TRUE.	! REMEMBER ^C SEEN.
		CALL SYS$DCLAST(DUMMY,,)
	ENDIF
	RETURN
	END
	SUBROUTINE COMMAND(NBYTES)
C
C	DISPATCHES TO COMMAND PROCESSING ROUTINES.
C
	INCLUDE 'COM.INC/NOLIST'
	INTEGER XBUF(64)
	EQUIVALENCE (XBUFFER(1), XBUF(1))
C
	IF     (XBUF(1) .EQ. 4HGETA) THEN	! NORMAL ASCII FILE (GETASCII)
		FLOW = IN
		MODE = ASCII
	ELSEIF (XBUF(1) .EQ. 4HGETL) THEN	! LISTING FILE (GETLISTING)
		FLOW = IN
		MODE = LISTING
	ELSEIF (XBUF(1) .EQ. 4HGETS) THEN	! SYSGEN FILE (GETSYSGEN)
		FLOW = IN
		MODE = SYSGEN
	ELSEIF (XBUF(1) .EQ. 4HTECO) THEN	! TECO INPUT (TECOINPUT)
		FLOW=OUT
		MODE=TECO
	ELSEIF (XBUF(1) .EQ. 4HSEND .AND. XBUFFER(5) .EQ. 1HA) THEN
		FLOW = OUT
		MODE = ASCII
C	ELSEIF (XBUF(1) .EQ. 4HSEND .AND. XBUFFER(5) .EQ. 1HS) THEN
C		FLOW = OUT
C		MODE = ASCII
	ELSEIF (XBUF(1) .EQ. 4HSTOP) THEN	! GO AWAY (STOP)
		STOP '*** NORMAL VAXNET TERMINATION ***'
	ELSE					! SOMETHING ELSE (ERROR)
		TYPE *, '*** UNKNOWN VAXNET COMMAND ***'
		RETURN
	ENDIF

	CALL GETSEND		! TRANSMIT THE FILE.
	RETURN
	END
C	GETCTRL.FOR
C
C	GET THE CONTROL CHARACTER(S) WE WANT TO SEND AND SEND THEM
C	IF THEY AREN'T CONTROL CHARACTERS DECODE AND DO THE COMMAND
C
	SUBROUTINE GETCTRL
C
	INCLUDE 'COM.INC/NOLIST'
C
C	GET CONTROL CHARACTERS TO SEND
50	JRCODE=SYS$QIOW(,%VAL(LCHANIN),%VAL(%LOC(IO$_READLBLK)
	1	+%LOC(IO$M_TRMNOECHO)),
	1	XIOSB,,,XBUFFER,%VAL(BUFSIZE),,,,)
	IF(JRCODE.NE.%LOC(SS$_NORMAL)) CALL QIOERROR(5,JRCODE)

	NBYTES=XIOSB(2)

	IF(NBYTES.EQ.0) THEN
		TYPE *,' TYPE AT LEAST ONE NON-CONTROL CHARACTER PLEASE!'
		GO TO 50
	ENDIF

	IF(NBYTES.GT.2) THEN
		CALL COMMAND(NBYTES)	! DECODE THE COMMAND AND DO IT.
	ELSE
		DO 100 I=1,NBYTES	! CONVERT TO CONTROL CHARACTERS.
100		XBUFFER(I)=XBUFFER(I) .AND. "37
		CALL CLRTYPE		!MUST CLEAN OUT TYPEAHEAD BUFFER
C		NOW WRITE THE CONTROL CHARACTER(S)
		IRCODE=SYS$QIOW(,%VAL(RCHANOUT),%VAL(%LOC(IO$_WRITEPBLK))
	1		,XIOSB,,,XBUFFER,%VAL(NBYTES),,,,)
		IF(IRCODE.NE.%LOC(SS$_NORMAL)) CALL QIOERROR(6,IRCODE)
		CALL WAITABIT('1')
		XBUFFER(1)=0
	ENDIF
	GO TO 200			! BRANCH AROUND THE ENTRY POINT.

	ENTRY REENABLE
C	REENABLE EVERYTHING
200	CALL SETCTRLC			! ENABLE CTRL C AST'S
	CHANCTRLC = .FALSE.		! TURN OFF GET
	CALL XDONE
	RETURN
	END
	SUBROUTINE QIOERROR(IN,ICODE)
	IMPLICIT INTEGER*4 (A-Z)
	WRITE(6,10) IN,ICODE
10	FORMAT(' LOCATION = ',I2,2X,'STATUS (HEX) = ',Z8)
	STOP '***QIO ERROR***'
	END
C	SETCTRLC.FOR
C
C	ENABLE CTRL C AST'S
C
	SUBROUTINE SETCTRLC
C
	INCLUDE 'COM.INC/NOLIST'
	EXTERNAL ACTRLCAST
C
C	ENABLE CTRL C AST'S 
	KRCODE=SYS$QIOW(,%VAL(LCHANIN),
	1	%VAL(%LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST)),,,,
	2	ACTRLCAST,,,,,)
	IF(KRCODE.NE.%LOC(SS$_NORMAL)) CALL QIOERROR(8,KRCODE)
	RETURN
	END
	SUBROUTINE WRITELT
C
C	AST ROUTINE TO WRITE TO LOCAL TERMINAL (TT)
C
	INCLUDE 'COM.INC/NOLIST'
	EXTERNAL DUMMY
C

	IF(CANR .NE. 0) THEN	! START OVER
		P = 1	!START OF BUFFER
		C = 0	!COUNT IN BUFFER
		RETURN
	ENDIF
C
	IF(RIOSB(2) .NE. 0) THEN	!CONTINUE FILLING RBUFFER
		C = P	!UPDATE COUNT
		P = P + 1  !NEXT POSITION
		IF(P.GT.BUFSIZE-1) THEN !THIS MAY HAPPEN WHEN USING ^S,^Q
		  TYPE *, '*** WRITELT - BUFFER OVERFLOW - DATA LOST'
		  GO TO 300
		ENDIF
		RB = 0	!CAN DO ANOTHER REMOTE READ NOW
		CALL SYS$DCLAST(DUMMY,,) !NEED AN AST TO WAKE UP HIBERNATE
		RETURN
	ENDIF
C
C	THERE IS EITHER A TERMINATOR OR A TIMEOUT	
C
	IF(RIOSB(1) .EQ. %LOC(SS$_TIMEOUT)) THEN	!TIMEOUT
		IF(C .EQ. 0) THEN
			P = 1	!RESET START OF BUFFER
			RB = 0	!CAN DO ANOTHER REMOTE READ NOW
			CALL SYS$DCLAST(DUMMY,,) !AST TO WAKE UP HIBERNATE
			RETURN
		ENDIF

	ELSE
		C = C + 1 !TERMINATOR HERE

	ENDIF

	CANL=1				! CANCEL ANY LOCAL READ
	CALL SYS$CANCEL(%VAL(LCHANIN))
	CALL SETCTRLC			! ENABLE CTRL C AST'S
C
	IRCODE=SYS$QIOW(,%VAL(LCHANOUT),%VAL(%LOC(IO$_WRITEPBLK)),
	1	RIOSB,,,RBUFFER,%VAL(C),,,,)
	IF(IRCODE.NE.%LOC(SS$_NORMAL)) CALL QIOERROR(3,IRCODE)
C
300	P = 1	!RESET START OF BUFFER
	C = 0	!RESET COUNT IN BUFFER
	RBUFFER(1)=0
	CALL XDONE
	RETURN
	END
	SUBROUTINE WRITERT
C
C	AST ROUTINE TO WRITE TO REMOTE TERMINAL (DZ11 PORT THAT IS
C	CONNECTED TO THE MODEM TO THE REMOTE CPU)
C
	INCLUDE 'COM.INC/NOLIST'
	EXTERNAL DUMMY
C
	IF ((XBUFFER(1) .EQ. 0) .OR. (CANL .NE. 0)) RETURN

	NBYTES=XIOSB(2) + 1		! USE APPROPRIATE TERMINATOR.

	CANR=1				! CANCEL REMOTE READ
	CALL SYS$CANCEL(%VAL(RCHANIN))
	CANL=1
	CALL SYS$CANCEL(%VAL(LCHANIN))	! CANCEL LOCAL READ
	CALL SETCTRLC			! ENABLE CTRL C AST'S

	IRCODE=SYS$QIOW(,%VAL(LCHANIN),	! PURGE LOCAL TYPEAHEAD BUFFER
	1   %VAL(%LOC(IO$_READLBLK)+%LOC(IO$M_PURGE)),
	1   RIOSB,,,RBUFFER,%VAL(0),,,,)

	IF(XBUFFER(NBYTES) .EQ. "03) GO TO 100 ! DON'T WRITE CTRL C's
	IF(XBUFFER(NBYTES) .EQ. "15) THEN
		CALL CLRTYPE		!PURGE REMOTE TYPEAHEAD BUFFER
C					!ECHO THE CR TO LOCAL TERMINAL
		JRCODE=SYS$QIOW(,%VAL(LCHANOUT),%VAL(%LOC(IO$_WRITEPBLK)),
	1	XIOSB,,,XBUFFER(NBYTES),%VAL(1),,,,)
	ENDIF
C					! AND WRITE TO REMOTE TERMINAL.
	JRCODE=SYS$QIOW(,%VAL(RCHANOUT),%VAL(%LOC(IO$_WRITEPBLK)),
	1	XIOSB,,,XBUFFER,%VAL(NBYTES),,,,)
	IF(JRCODE.NE.%LOC(SS$_NORMAL)) CALL QIOERROR(4,IRCODE)
100	XBUFFER(1) = 0			! INDICATE BUFFER EMPTY
	CALL XDONE			! WAKE UP EVERYBODY
	RETURN
	END
	SUBROUTINE XDONE
C
C	ROUTINE TO RENABLE TRANSMISSION.
C
	INCLUDE 'COM.INC/NOLIST'
	EXTERNAL DUMMY
C
	XB=0			! CAN DO ANOTHER LOCAL READ NOW
	RB=0			! CAN DO ANOTHER REMOTE READ NOW
	CANR=0			! ALWAYS CLEAR ANY REMOTE READ CANCEL FLAG
	CANL=0			! ALWAYS CLEAR ANY LOCAL READ CANCEL FLAG
	CALL SYS$DCLAST(DUMMY,,) !NEED AN AST TO WAKE UP HIBERNATE
	RETURN
	END
	SUBROUTINE DUMMY
C	DUMMY ROUTINE FOR SYS$DCLAST ROUTINE
	CALL SYS$WAKE(,)
	RETURN
	END
	SUBROUTINE RESET_WORLD
C
C	EXIT HANDLER.
C
	INCLUDE 'COM.INC/NOLIST'
C
	CALL SETNORMAL	!SET REMOTE PORT TO NORMAL TERMINAL CHARACTERISTICS.
	CALL SETPRN()		! SET THE PROCESS NAME TO THE USER NAME.
	CALL SYS$SETSWM(%VAL(0)) !REENABLE SWAPPING
	CALL SYS$SETPRI(,,%VAL(4),) !LOWER PRIORITY
	RETURN
	END

C	SETVAXNET.FOR
C
C	THIS SUBROUTINE GETS THE CURRENT CHARACTERISTICS OF THE CHANNEL
C	ASSIGNED TO THE REMOTE VAXNET PORT.  IT THEN CHANGES THE
C	CHARACTERISTICS SO THAT THE PORT WILL WORK PROPERLY FOR VAXNET.
C	ON PROPER VAXNET TERMINATION, THE ENTRY POINT SETNORMAL IS
C	USED TO MAKE THE PORT ACCESSIBLE TO NORMAL DIAL-UP.
C
C	J. THOMPSON  INTERMETRICS  27 JULY 1979
C
	SUBROUTINE SETVAXNET

	INCLUDE 'COM.INC/NOLIST'
	LOGICAL*1 B,BE(128),CLASS,TYPE,PAGELENGTH
	INTEGER*2 PAGEWIDTH
	INTEGER*4 TERM_CHAR
	CHARACTER*128 BUFF	!CHARACTERISTICS BUFFER

	COMMON/RTTCHAR/ B(128)

	EQUIVALENCE (BE(1),BUFF(1:1))
	EQUIVALENCE (CLASS,B(5)), (TYPE,B(6))
	EQUIVALENCE (PAGEWIDTH,B(7)), (TERM_CHAR,B(9))
	EQUIVALENCE (PAGELENGTH,B(12))
	EQUIVALENCE (W1,B(1)),(W2,B(5)),(W3,B(9))

	EXTERNAL IO$_SETCHAR,TT$M_LOWER,TT$M_MECHTAB,TT$M_NOECHO
	EXTERNAL TT$M_WRAP,TT$M_REMOTE,TT$M_PASSALL,TT$M_SCOPE

	IRCODE = SYS$GETCHN(%VAL(RCHANIN),L1,BUFF,,,)
	IF(IRCODE .NE. %LOC(SS$_NORMAL)) WRITE(6,11) IRCODE
	DO 100 I=1,L1
100	B(I)=BE(I)

11	FORMAT(' GETCHN ERROR - HEX VALUE IS ',Z10)

	TERM_CHAR = TERM_CHAR .OR. %LOC(TT$M_LOWER)
	TERM_CHAR = TERM_CHAR .OR. %LOC(TT$M_MECHTAB)
	TERM_CHAR = TERM_CHAR .OR. %LOC(TT$M_NOECHO)
	TERM_CHAR = TERM_CHAR .OR. %LOC(TT$M_REMOTE)
	TERM_CHAR = TERM_CHAR .OR. %LOC(TT$M_PASSALL)
	TERM_CHAR = TERM_CHAR .OR. %LOC(TT$M_SCOPE)

	NOWRAP = .NOT. %LOC(TT$M_WRAP)
	TERM_CHAR = TERM_CHAR .AND. NOWRAP

	PAGEWIDTH = 132

	IRCODE = SYS$QIOW(,%VAL(RCHANIN),%VAL(%LOC(IO$_SETCHAR)),,,,
	1 B(5),%VAL(8),,,,)

C	THE %VAL(8) IS THE LENGTH OF THE CHARACTERISTICS BUFFER WHICH
C	STARTS AT BYTE 5 OF ARRARY B.  THIS P2 PARAMETER IS NOT DOCUMENTED
C	UP THROUGH RELEASE 1.5 OF VMS.

	IF(IRCODE .NE. %LOC(SS$_NORMAL)) WRITE(6,12) IRCODE
12	FORMAT(' SETCHAR ERROR - HEX VALUE IS ',Z10)

	RETURN


C	RESET TERMINAL SO IT CAN BE USED AS A DIAL-UP.
C	(DON'T NEED TO RESET ALL CHARACTERISTICS)

	ENTRY SETNORMAL

	IRCODE = SYS$GETCHN(%VAL(RCHANIN),L1,BUFF,,,)
	IF(IRCODE .NE. %LOC(SS$_NORMAL)) WRITE(6,11) IRCODE
	DO 200 I = 1,L1
200	B(I) = BE(I)

	ECHO = .NOT. %LOC(TT$M_NOECHO)
	INTERACTIVE = .NOT. %LOC(TT$M_PASSALL)

	TERM_CHAR = TERM_CHAR .AND. ECHO
	TERM_CHAR = TERM_CHAR .AND. INTERACTIVE
	TERM_CHAR = TERM_CHAR .OR. %LOC(TT$M_WRAP)

	PAGEWIDTH = 80

	IRCODE = SYS$QIOW(,%VAL(RCHANIN),%VAL(%LOC(IO$_SETCHAR)),,,,
	1 B(5),%VAL(8),,,,)
	IF(IRCODE .NE. %LOC(SS$_NORMAL)) WRITE(6,12) IRCODE

	RETURN
	END