COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE CHAT
C00004 00003	INBUFH OUTBFH TTYBFH GOTINT NSVBLK NSVMSG NSVRPL RFCBLK HOST SMRBLK RMRBLK INPBLK CRLF BEEPC
C00006 00004	CHAT GETHST GOTHST NSVTRY
C00009 00005	CHAT1 CHAT2
C00011 00006	LOOP TTILUP
C00013 00007	TTIDUN TTIDN1 TTIDN2 NTICHR FLUSH CLOSED
C00017 ENDMK
C⊗;
TITLE CHAT
SUBTTL Definitions

; Mark Crispin, SU-AI, November '81

; Prototype Ethernet user TELNET.  Somebody ought to write the real thing

; AC definitions

A=1
B=2

; System bit definitions

INTTTY==020000,,		; TTY input
INTCLK==000200,,		; clock interrupts
INTIMS==000020,,		; closed interrupt
INTINP==000010,,		; input interrupt
IODTER==100000			; Time out
IOBKTL==040000			; Mark seen
IODEND==020000			; End seen
BSACT== 000020			; activate on BS
SPCBRK==000100,,		; special activation mode
DISLIN==400000,,		; III
DMLIN== 040000,,		; DM
DDDLIN==020000,,		; DD
INTBTS==INTTTY\INTCLK\INTINP\INTIMS

; Macro to build an Ethernet host address
DEFINE HST NET,ADR
 <NET←8.>+ADR TERMIN
;INBUFH OUTBFH TTYBFH GOTINT NSVBLK NSVMSG NSVRPL RFCBLK HOST SMRBLK RMRBLK INPBLK CRLF BEEPC

SUBTTL Data area

INBUFH:	BLOCK 3			; input buffer
OUTBFH:	BLOCK 3			; output buffer
TTYBFH:	BLOCK 3			; TTY buffer header
GOTINT:	BLOCK 1			; -1 → got an interrupt

NSVMSG:	BLOCK 140.		; name server message
NSVRPL:	BLOCK 140.		; name server reply

RFCBLK:	0			; connect to remote host
	0			; status word
RFCLSK:	0			; socket number (1 for TELNET)
	-1			; wait flag
	8			; byte size
RFCFSK:	1			; foreign socket number
HOST:	0			; host

;For name request
MSCBLK:	1			;Opcode = LISTEN (we will broadcast)
MSCSTS:	0			;Status
	-1			;Local socket (GENSYM)
	0			;Wait for connection
	8			;Bytesize (checked, but not used by PUP)
	4			;Foreign socket
	-1			;Host number

SMRBLK:	25			; send Mark
	0			; status word
	6			; Timing Mark Reply

RMRBLK:	26			; read last Mark
	0			; status word
	0			; Mark type returned here

INPBLK:	10			; skip if input available
	0			; status word

CRLF:	ASCIZ/
/

BEEPC:	-1			; assume beeping for default
;CHAT GETHST GOTHST NSVTRY

SUBTTL Start of program

CHAT:	CAI
	RESET			; flush all I/O
	INIT 15			; get a datagram channel on PUP:
	 SIXBIT/PUP/
	 0
	 JRST [	OUTSTR [ASCIZ/Device PUP not available/]
		EXIT]
; All this is pretty crude, but it works...
	MTAPE MSCBLK
	MOVE MSCBLK+1		; check for MTAPE error
	STATO 467600
	TRNE 77
	 JRST [	OUTSTR [ASCIZ/Pup links busy/]
		EXIT]
	hrroi a,[030000,,1]		; set the no-pk bit to hide input buffer
	ttyset a,
	OUTSTR [ASCIZ/Host = /]
	DMOVE A,[441000,,NSVMSG+5 ; data area
		 22.]		; overhead bytes
GETHST:	INCHWL			; get a character
	ANDI 177		; debuckyify
	CAIN ↑M			; ignore CR
	 JRST GETHST
	CAIE 175		; ALT?
	 CAIN ↑J
	  JRST GOTHST
	IDPB A			; save character
	AOJA B,GETHST		; count it and continue

GOTHST:	DPB B,[242000,,NSVMSG] ; set data size
	MOVEI 220		; Name lookup request
	DPB [041000,,NSVMSG]
	OUTSTR [ASCIZ/ Trying... /]
	MOVEI A,15.		; try up to 15 times before giving up
NSVTRY:	OUT [-140,,NSVMSG-1?0]	; send name server message
	 CAIA
	  JRST [OUTSTR [ASCIZ/Can't send to name server/]
		EXIT]
	MTAPE INPBLK		; is there any input present?
	 JRST [	MOVEI 1		; wait a second and try again
		SLEEP
		MTAPE INPBLK	; got it this time?
		 CAIA
		  JRST .+1
		SOJG A,NSVTRY	; no, try again
		OUTSTR [ASCIZ/Timed out waiting for name server reply/]
		EXIT]
	IN [-140,,NSVRPL-1?0]		; get name server reply
	 CAIA
	  JRST 4,CHAT		; can't happen
	CLOSE			; close connection to name server
	RELEASE
	LDB [041000,,NSVRPL]	; get type
	CAIE 221		; Name server reply?
	 JRST [	OUTSTR [ASCIZ/Host name not found/]
		EXIT]
	LDB [242000,,NSVRPL+5]
	MOVEM HOST
;	JRST CHAT1
;CHAT1 CHAT2

CHAT1:	HRROI [003000,,]
	TTYSET				; get line characteristics
	CAMN [-1]
	 EXIT				; how can I work if detached?
	TLNE (DISLIN\DMLIN\DDDLIN)	; display?
	 JRST CHAT2
	HRROI [001000,,(SPCBRK)]
	TTYSET
CHAT2:	SETACT [[	777777,,777777; activate on everything
			777777,,777777; just set it up for when we need it
			777777,,777777
			777777,,600000\BSACT]]
	INIT
	 SIXBIT/PUP/
	 OUTBFH,,INBUFH
	 JRST [	OUTSTR [ASCIZ/Device PUP not available.  Try again later./]
		EXIT]
	INIT 1,
	 SIXBIT/TTY/
	 TTYBFH,,
	 JRST 4,CHAT
	MOVEI 8.		; change byte size in buffer header
	DPB [300600,,INBUFH+1]
	DPB [300600,,OUTBFH+1]
	INBUF
	OUTBUF
	OUTBUF 1,
	SETOM RFCLSK		; make sure we get a wild socket number
	MOVEI 1
	MOVEM RFCFSK
	MTAPE RFCBLK
	MOVE RFCBLK+1		; check for MTAPE error
	STATO 467600
	TRNE 77
	 JRST [	OUTSTR [ASCIZ/Host dead/]
		EXIT]
	OUTSTR [ASCIZ/Open
/]
	PTJOBX [0 ? 3]
	LOCK
	SETZM GOTINT
	MOVEI [	SETOM GOTINT	; got an interrupt
		DISMIS]		; set up interrupt server
	MOVEM JOBAPR
	CLKINT 30.*60.		; keep alive counter
	MOVSI (INTBTS)
	INTENB			; enable interrupts
;	JRST LOOP
;LOOP TTILUP

LOOP:	INTMSK [0]		; mask off interrupts
	SKIPN GOTINT		; got an interrupt?
	 IMSTW [INTBTS]		; wait for an interrupt to happen
	SETZM GOTINT
TTILUP:	INCHSL			; get a byte from the TTY
	 JRST TTIDUN		; nothing, try input from the network
	CAIN ↑M			; if a CR,
	 INCHRW A		; flush the LF right after it
	CAIN 175		; ALT
	 MOVEI 33
	CAIN 176		; }
	 MOVEI 175
	CAIN 32			; ~
	 MOVEI 176
	CAIE 600\"L		; CONTROL-META-L is character mode
	 CAIN 600\"l
	  JRST [HRROI [001000,,(SPCBRK)]
		TTYSET
		JRST TTILUP]
	CAIE 400\"L		; META-L is line mode
	 CAIN 400\"l
	  JRST [HRROI [002000,,(SPCBRK)]
		TTYSET
		JRST TTILUP]
	CAIE 600\"Q		; CONTROL-META-Q exits
	 CAIN 600\"q
	  JRST FLUSH
	CAIE 400\"Q		; so does META-Q
	 CAIN 400\"q
	  JRST FLUSH
	CAIE 600\"G		; CONTROL-META-G
	 CAIN 600\"g
	  JRST [SETZM BEEPC	; disable beeping
		JRST TTILUP]
	CAIE 400\"G		; META-G
	 CAIN 400\"g
	  JRST [SETOM BEEPC	; enable beeping
		JRST TTILUP]
	ANDI 377		; turn off META bit
	TRZE 200		; CONTROL set?
	 ANDI 37
	SOSG OUTBFH+2		; space in buffer?
	 OUT
	  CAIA
	   JRST TTIDUN
	IDPB OUTBFH+1
	JRST TTILUP
;TTIDUN TTIDN1 TTIDN2 NTICHR FLUSH CLOSED


TTIDUN:	MOVE A,OUTBFH+2
	ANDI A,3
	MOVE A,[0
		1
		3
		7](A)
	SKIPLE OUTBFH		; set fill bits only if buffers are setup properly
	DPB A,[	000420,,OUTBFH+1]
;		POINT 4,@OUTBFH+1,35	; Sigh... This can't be in a literal???
	OUTPUT			; flush the output side of things
TTIDN1:	SOSLE INBUFH+2		; data available?
	 JRST NTICHR
	HRRZ A,INBUFH
	HRRZ A,(A)
	SKIPGE (A)		; anything in further buffers?
	 JRST TTIDN2
	MTAPE INPBLK		; no - new packet available?
	 JRST [	OUTPUT 1,
		STATZ IODEND
		 JRST CLOSED
		JRST LOOP]
TTIDN2:	IN			; yes - get it
	 JRST TTIDN3
	GETSTS A
	TRZE A,IODEND\IODTER	; End seen?
	 JRST CLOSED
	TRZN A,IOBKTL		; Mark seen?
	 JRST 4,.-1
	SETSTS (A)		; yes, clear error status
	MTAPE RMRBLK
	 TRN
	MOVE RMRBLK+2		; get Mark type
;;	CAIN 1			; Data Mark?
;;	 AOS NTOINP
	CAIE 5			; Timing Mark?
	 JRST TTIDN1		; something random
	MTAPE SMRBLK		; yes, send Timing Mark Reply
	 JRST CLOSED
	JRST TTIDN1

TTIDN3:	MOVE A,INBUFH		; get buffer header
	ADD A,1(A)		; find last word in buffer
	MOVE A,1(A)		; get that word
	ANDI A,7		; look at low order bits (faster than LDB)
	TRNE A,4
	  SKIPA A,[4]		; 7 means 4-1 unused bytes
	TRNE A,2		; 3 means 3-1 unused bytes
	  SUBI A,1
	MOVN A,A
	ADDM A,INBUFH+2		; update count to account for fill bytes
NTICHR:	ILDB INBUFH+1
	SETO A,
	SKIPE BEEPC		; skip if not beeping π today
	 CAIE ↑G		; skip if need to beep
	  CAIA
	   BEEP A,
	CAIN 176		; ~
	 MOVEI 32
	CAIN 175		; }
	 MOVEI 176
	CAIN 33			; ALT
	 MOVEI 175
	SOSG TTYBFH+2		; output character to TTY
	 OUTPUT 1,
	IDPB TTYBFH+1
	JRST TTIDN1

FLUSH:	RELEASE			; flush connection
CLOSED:	OUTPUT 1,		; flush TTY buffer
	OUTSTR [ASCIZ/
Connection closed
/]
	move a,[-2,,[	010000,,0	; disable αcr
			030000,,0]]	; re-enable pk of input buffer
	ttyset a,			; execute 2 functions above
	EXIT

END CHAT