(FILECREATED "10-Sep-80 21:41:28" {PARC-MAXC2}<MASINTER>TELNET.;1
        

     previous date: " 5-FEB-79 09:31:33" {PARC-MAXC2}<LISPUSERS>TELNET.;9)


(PRETTYCOMPRINT TELNETCOMS)

(RPAQQ TELNETCOMS
 [(DECLARE: FIRST (ADDVARS (NOSWAPFNS SETSHAREDPAGE)))
		   (FNS TELNET SETREMOTETERMINAL RESTORETERMSTATUS GETTERMSTATUS SETFORK MAPPAGEDOWN)
		   (P (MOVD? (QUOTE TELNET)
			     (QUOTE CHAT)))
		   (VARS TELNETEXITCHAR (LASTCONNECTION)
			 (LASTCHATEXITCHAR)
			 (SHAREDPAGE)
			 (CHATDEBUGFLG)
			 (RELAYFORK)
			 (TIMERFORK))
		   [P (PUTDQ? CHATSIGNAL (LAMBDA (X)
						 (SELECTQ X (T (PRIN1 "[nothing happening]" T))
							  (ERROR "unexpected signal" X]
		   (P (LOAD? (QUOTE <LISPUSERS>NET.COM)
			     LDFLG))
		   [DECLARE: EVAL@COMPILE DONTCOPY (RECORDS FLAGWORD TERMSTATUS)
			     DONTEVAL@LOAD
			     (P (LOADCOMP (QUOTE <LISPUSERS>NET]
		   (FNS SETSHAREDPAGE)
		   (BLOCKS (CHATBLOCK (ENTRIES TELNET SETFORK)
				      SETFORK MAPPAGEDOWN TELNET SETREMOTETERMINAL
				      (GLOBALVARS LASTCONNECTION CHATDEBUGFLG LASTCHATEXITCHAR 
						  TELNETEXITCHAR TIMERFORK RELAYFORK CONNECTIONARRAY 
						  SHAREDPAGE)
				      (NOLINKFNS . T))
			   (NIL SETSHAREDPAGE GETTERMSTATUS RESTORETERMSTATUS (LOCALVARS . T)
				(GLOBALVARS BYTELISPFLG SHAREDPAGE])
(DECLARE: FIRST 

(ADDTOVAR NOSWAPFNS
 SETSHAREDPAGE)
)
(DEFINEQ

(TELNET

  [LAMBDA (CONNECTION TYPE SKT BUTTONCHAR TIMEOUT)
                                   (* lmm "10-Sep-80 21:38")

                                   (* CONNECTION is either a litatom (host name, either NET or PUP-NETWORK) or an 

				   instance of the CONNECTION record)

    (RESETLST (PROG (VINJ VOUTJ TERMSTATUS CODE FLAGS NEW XIT (NAME CONNECTION)
			  SPECS TEM)
		    [OR CONNECTION TYPE (SETQ CONNECTION LASTCONNECTION)
			(ERROR (QUOTE (no connection]
		    [SETQ CONNECTION (COND
			[(SETQ SPECS (GETHASH CONNECTION CONNECTIONARRAY))
			  (OR (CHECKCONNECTION CONNECTION)
			      (SETQ NEW (MAKENEWCONNECTION (fetch
 NAME of
 TEM)
							   (fetch
 CNTYPE of
 CONNECTION)
							   (fetch
 SOCKET of
 TEM)
							   CONNECTION NIL]
			(T (MAKENEWCONNECTION NAME TYPE SKT NIL NIL]
                                   (* save terminal state as of now and remember to restore it)

		    [RESETSAVE NIL (LIST (FUNCTION RESTORETERMSTATUS)
					 (SETQ TERMSTATUS (GETTERMSTATUS
]
		    (SETQ XIT (OR BUTTONCHAR (SELECTQ (fetch
 CNTYPE of
 CONNECTION)
						      (SUBSYS 1000Q)
						      TELNETEXITCHAR)))
		    (SETQ LASTCONNECTION)
		RESTART
		    (OR (CHECKCONNECTION CONNECTION)
			(GO CLOSE))
		    (ASSEMBLE
 NIL
			      (MOVEI 1 , 100Q)
			      (JS RFMOD)
			      (TRO 2 , 170000Q)
                                   (* wakeup on everything)

			      (TLZ 2 , 37777Q)
                                   (* no page width)

			      (TRZ 2 , 6000Q)
                                   (* no echo)

			      (JS SFMOD)
			      (JS STPAR))
		    (SELECTQ (fetch
 TERMTYPE of
 TERMSTATUS)
			     (12Q 
                                   (* change DISPLAY to NVT)

				  (JS STTYP 100Q 7))
			     NIL)
                                   (* and set term type)

		    (SETREMOTETERMINAL
 CONNECTION (SELECTQ (fetch
 TERMTYPE of
 TERMSTATUS)
							   (12Q 
                                   (* if not currently a display, leave other terminal alone)

								12Q)
							   NIL)
				       (fetch
 PAGEWIDTH of
 TERMSTATUS)
				       (fetch
 PAGELENGTH of
 TERMSTATUS))
		    (ENABLEPROCESSCAPS)
		    (COND
		      ((NOT CHATDEBUGFLG)
			(JS STIW (COND ((EQ (fetch CNTYPE of CONNECTION)
					    (QUOTE SUBSYS))
					(* only turn off this fork's interrupts)
					400000Q)
				       (T (* turn off interrupts for whole job)
					  777773Q))
			    0)))
		    (COND
		      ([AND (NEQ CONNECTION LASTCONNECTION)
			    (OR NEW (AND (NOT BUTTONCHAR)
					 (NEQ (fetch
 CNTYPE of
 CONNECTION)
					      (QUOTE SUBSYS]
			(PRIN1 (COND
				 (NEW "[new ")
				 (T "["))
			       T)
			(PRIN1 (fetch
 CNTYPE of
 CONNECTION)
			       T)
			(SETQ SPECS (GETHASH CONNECTION CONNECTIONARRAY))
			[COND
			  ((fetch
 NAME of
 SPECS)
			    (PRIN1 " connection to " T)
			    (PRIN1 (fetch
 NAME of
 SPECS)
				   T)
			    (COND
			      ((fetch
 SOCKET of
 SPECS)
				(SPACES 1 T)
				(PRIN1 (fetch
 SOCKET of
 SPECS)
				       T]
			(COND
			  ((AND (NOT BUTTONCHAR)
				(ILESSP XIT 33Q))
			    (PRIN1 " - control-" T)
			    (PRIN1 (FCHARACTER (IPLUS 100Q XIT))
				   T)
			    (PRIN1 " to exit" T)))
			(PRIN1 "]" T)
			(TERPRI T)))
		    (JS AIC 400000Q 160200000Q)
                                   (* turn on interrupt channels)

		    (COND
		      ((OR (NEQ CONNECTION LASTCONNECTION)
			   (NEQ LASTCHATEXITCHAR XIT)
			   (NOT (CHECKFORK RELAYFORK T T)))
			           (* if the NEQ holds, this is either 1st time thru or we have run some other 

				   TELNET below this one)

			[SETQ VINJ (VAG (OPNJFN (fetch
 IN of
 CONNECTION]
			           (* might have changed JFNs)

			[SETQ VOUTJ (VAG (OPNJFN (fetch
 OUT of
 CONNECTION]
			(SETQ RELAYFORK (SETFORK
 RELAYFORK 1 (SELECTQ (fetch
 CNTYPE of
 CONNECTION)
								      ((NET NETCHARS)
									(IPLUS (BIT 0)
									       (LOC VOUTJ)))
								      (LOC VOUTJ))
						 (SELECTQ (fetch
 CNTYPE of
 CONNECTION)
							  ((NET NETUSER NETSERVER NETCHARS)
							    
                                   (* CRLF is eol)

							    (IPLUS (BIT 0)
								   XIT))
							  XIT)))
			(SETQ LASTCONNECTION CONNECTION)
			(SETQ LASTCHATEXITCHAR XIT)))
		    [COND
		      (TIMEOUT (SETQ TIMERFORK (SETFORK
 TIMERFORK 3 TIMEOUT RELAYFORK]
		    (SELECTQ (fetch
 CNTYPE of
 CONNECTION)
			     ((NET NETSERVER NETUSER)
			           (* enable INS and state change interrupt)

			       (JS MTOPR (LOC VINJ)
				   24Q
				   (XWD 150014Q 0)))
			     NIL)
		    (AND (fetch
 JOBFORK of
 CONNECTION)
			 (OR (CHECKFORK (fetch
 JOBFORK of
 CONNECTION)
					T T)
			     (GO CLOSE)))
		    (ASSEMBLE
 NIL
			      (PUSHN = 0)
			  ST  (MOVEI FX , 1)
                                   (* output to T)

			  NXTCHR
			      (CQ VINJ)
			      (CQ2 SHAREDPAGE)
			      (JSP 7 , 4 (2))
                                   (* call subroutine set up by SETSHAREDPAGE)

			      (JUMPE 2 , CHECKSTATUS)
                                   (* null byte; either real null byte or an end of file)

			  ST2 (CAILE 2 , 177Q)
			      (JRST SIGNAL)
                                   (* char codes after 177Q mean something special)

			  GOTCHAR
			      (MOVEI 1 , 0 (2))
			      (CAIN 1 , 7)
			      (JRST BELL)
			      (NREF (SKIPL 0))
                                   (* unless waiting for signal char)

			      (FASTCALL FOUT)
			      (JRST NXTCHR)
			  BELL(CQ (PRINTBELLS))
			      (MOVEI FX , 1)
			  BELLOOK
			      (CQ VINJ)
			      (CQ2 SHAREDPAGE)
			      (JSP 7 , 4 (2))
                                   (* get another char)

			      (CAIN 2 , 7)
                                   (* another bell?)

			      (JRST BELLOOK)
			      (JUMPN 2 , ST2)
			  CHECKSTATUS
			      (CQ VINJ)
			      (MOVEI 3 , 0)
			      (JS GDSTS)
			      (TLNE 2 , 10000Q)
			      (JRST EOF)
			      (TLZN 2 , 20000Q)
			      (JRST NULLBYTE)
			      (CQ (CHECKTIMING CONNECTION))
			      (JRST NXTCHR)
			  EOF (CQ NIL)
			      (JRST OUT)
			  NULLBYTE
			      (MOVEI 2 , 0)
			      (JRST GOTCHAR)
			  SIGNAL
			      (TLNN 2 , 20000Q)
                                   (* INS/INR recieved?)

			      (JRST NOTINS)
                                   (* no)

			      (CQ SHAREDPAGE)
                                   (* if INS, then ignore characters until some telnet control happens)

			      (HRLZI 2 , 20000Q)
			      (ANDCAM 2 , 0 (1))
                                   (* turn off INS bit)

			      (NREF (SOS 0))
			      (JRST NXTCHR)
			  NOTINS
			      (CAILE 2 , 277Q)
                                   (* 200-277 ARE RESERVED FOR "TELNET ESCAPE" CODES)

			      (JRST NTLNT)
			      (NREF (SETZM 0))

          (* should actually keep track of the count of the telnet controls, counting the ones which "cancel" an ins interrupt

	  (since it can possibly arrive before the INS))



			      (CAIE 2 , 200Q)
			      (JRST ST)
			      (MOVEI 1 , 101Q)
			      (JS CFOBF)
			      (JRST ST)
			  NTLNT
			      (MOVEI 1 , ASZ (2))
			      (TLNN 2 , 4000Q)
			      (JRST NOTTIMER)
			      (CV (OR TIMERFORK (SHOULDNT)))
			      (JS WFORK)
			      (JRST ZERO)
			  NOTTIMER
			      (TLNE 2 , 100000Q)
                                   (* not SIGNAL)

			      (TLNE 2 , 200000Q)
                                   (* or RELAY not halted)

			      (JRST OUT)
                                   (* wait for fork halt)

			      (CV RELAYFORK)
			      (JS WFORK)
			  ZERO(CQ 0)
			  OUT (POPNN 1)
			      (SETQ CODE))
		    (PROGN         (* pause connection)

			   (JS FFORK RELAYFORK)
			   (SELECTQ (fetch
 CNTYPE of
 CONNECTION)
				    (SUBSYS 
                                   (* if SUBSYS freeze lower fork (don't need to if FORK because controlling 

				   terminal is different))

					    (JS FFORK (fetch JOBFORK of CONNECTION)))
				    NIL)
			   (RESTORETERMSTATUS
 TERMSTATUS)
			   (SELECTQ (fetch
 CNTYPE of
 CONNECTION)
				    ((NET NETSERVER NETUSER)
				      
                                   (* turn off listening to INS/INR and state change interrupts)

				      (JS MTOPR (OPNJFN (fetch IN of CONNECTION))
					  24Q
					  (XWD 770077Q 0)))
				    NIL))
		    [COND
		      (CODE [COND
			      ((ZEROP CODE)
				(SETQ FLAGS (OPENR (LOC SHAREDPAGE)))
				(CLOSER (LOC SHAREDPAGE)
					0)
				(COND
				  ((fetch
 DATAERROR of
 FLAGS)
				    
                                   (* data error interrupt happened)

				    (PRIN1 "-- data error --
" T)
				    (GO CLOSE))
				  ((fetch
 SIGNAL of
 FLAGS)
				    
                                   (* relay fork noticed one of the signal characters -

				   unless in BUTTONCHAR, just return)

				    (OR BUTTONCHAR (GO RET)))
				  ((fetch
 TIMEOUT of
 FLAGS)
				    (SETQ CODE T))
				  [(fetch
 FORKHALT of
 FLAGS)
				    
                                   (* lower fork must have halted)

				    (COND
				      ((AND (fetch
 JOBFORK of
 CONNECTION)
					    (NOT (SMALLP (fetch
 JOBFORK of
 CONNECTION)))
					    (EQ (BITS 2 21Q (JS RFSTS (fetch JOBFORK of CONNECTION)
								NIL NIL 1))
						2))
					(PROGN 
                                   (* this isn't really right -

				   want to send a character thru the PTY to "clean it out" -

				   also need to take care of type-ahead)

					       (DISMISS 1750Q)
					       (while
 (READP (fetch
 IN of
 CONNECTION))
						  do
 (PRIN1 (READC (fetch
 IN of
 CONNECTION))
							    T)))
					(TAB 0 0 T)
					(GO RET))
				      (T (HELP RELAYFORK "unexpected fork halt"]
				  ((fetch
 STATECHANGE of
 FLAGS)
				    
                                   (* fall thru, just try to restart)

				    (GO RESTART))
				  (T (HELP FLAGS "unexpected flag word"]
			    (COND
			      ((CHATSIGNAL CODE)
				(GO RESTART))
			      (T (GO RET]
		CLOSE
		    (TAB 0 0 T)
		    (PRIN1 "[connection terminated]" T)
		    (CLOSECONNECTION CONNECTION)
		    (TERPRI T)
		RET (OR BUTTONCHAR (TAB 0 0 T))
		    (RETURN CONNECTION])

(SETREMOTETERMINAL

  [LAMBDA (CONNECTION TTYPE WIDTH LENGTH)
                                   (* lmm "24-SEP-78 04:02")

    (PROG [(OJ (OPNJFN (fetch
 OUT of
 CONNECTION]
          (SELECTQ (fetch
 CNTYPE of
 CONNECTION)
		   ((PUP PUPSERVER PUPUSER JOB SUBSYS FORK)
		     (AND TTYPE (SENDPUPPARAMETER OJ 4 TTYPE))
		     (AND LENGTH (SENDPUPPARAMETER OJ 3 LENGTH))
		     (AND WIDTH (SENDPUPPARAMETER OJ 2 WIDTH)))
		   ((NET NETSERVER NETUSER)
		                   (* I am using old-telnet protocol, which doesn't allow this)

		     NIL)
		   (HELP CONNECTION (QUOTE TYPE?])

(RESTORETERMSTATUS

  [LAMBDA (TERMSTATUS)             (* lmm "18-JUL-78 04:55")

    (ENABLEPROCESSCAPS)
    (JS STIW (XWD 0 -5)
	(fetch JOBTIW of TERMSTATUS))
    (JS STIW (XWD 0 400000Q)
	(fetch FORKTIW of TERMSTATUS))
    (ASSEMBLE
 NIL
	      (MOVEI 1 , 100Q)
	      (CV2 (fetch
 MODEWORD of
 TERMSTATUS))
	      (JS STPAR)           (* not restored by SETMOD since not in term table 

				   (e.g. page width & length))

	      (FASTCALL SETMOD))
    (JS DIC 400000Q -1)            (* turn off all channels)

    (JS AIC 400000Q (fetch CHANNELMASK of TERMSTATUS))
                                   (* and turn back on the ones which were on before)

    (JS STTYP 100Q (fetch TERMTYPE of TERMSTATUS))
    (COND
      (BYTELISPFLG                 (* because the SFPOS jsys is parc-only)

		   (EQ (fetch
 TERMTYPE of
 TERMSTATUS)
		       12Q)
		   (JS 526Q 100Q 0)
		                   (* SFPOS)
))
    NIL])

(GETTERMSTATUS

  [LAMBDA NIL                      (* lmm "18-JUL-78 04:53")

    (create
 TERMSTATUS])

(SETFORK

  [LAMBDA (FORK OFFSET AC3 AC4 MAPAC4)
                                   (* lmm " 1-JUN-78 00:41")

    (SELECTQ (CHECKFORK FORK NIL T)
	     (2                    (* halted, ok)
)
	     (NIL                  (* dead)

		  (SETQ FORK (CFORK)))
	     (PROGN                (* in case it is running -

				   can't SFACS unless halted)

		    (JS HFORK FORK)))
    (ASSEMBLE
 NIL
	      (CV AC3)
	      (PUSHN)
	      (CV AC4)
	      (PUSHN)
	      (CV FORK)
	      (MOVEI 2 , 0)
	      (POPN 4)
	      (POPN 3)
	      (JS SFACS)

          (* set relay fork's ac's to be the same as mine (AC2=0) -

	  this is to set up AC's 3 and 4 which contain the arguments (this hack wouldn't work if there were more args))



	  )
    (OR SHAREDPAGE (SETSHAREDPAGE
))
    (CLOSER (LOC SHAREDPAGE)
	    0)
    (MAPPAGEDOWN
 FORK (LOC SHAREDPAGE))
    (COND
      (MAPAC4 (MAPPAGEDOWN
 FORK AC4)))
    (JS SFORK FORK (IPLUS OFFSET (LOC SHAREDPAGE)))
    FORK])

(MAPPAGEDOWN

  [LAMBDA (FORK LOC)               (* lmm " 1-JUN-78 01:44")

    (JS PMAP (XWD 400000Q (SETQ LOC (LRSH LOC 11Q)))
	(XWD FORK LOC)
	160000000000Q)])
)
(MOVD? (QUOTE TELNET)
       (QUOTE CHAT))

(RPAQQ TELNETEXITCHAR
 32Q)

(RPAQ LASTCONNECTION
 NIL)

(RPAQ LASTCHATEXITCHAR
 NIL)

(RPAQ SHAREDPAGE
 NIL)

(RPAQ CHATDEBUGFLG
 NIL)

(RPAQ RELAYFORK
 NIL)

(RPAQ TIMERFORK
 NIL)
[PUTDQ? CHATSIGNAL (LAMBDA (X)
			   (SELECTQ X (T (PRIN1 "[nothing happening]" T))
				    (ERROR "unexpected signal" X]
(LOAD? (QUOTE <LISPUSERS>NET.COM)
       LDFLG)
(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(ACCESSFNS FLAGWORD
 ((FORKHALT (BIT 1 DATUM))
		     (SIGNAL (BIT 2 DATUM))
		     (DATAERROR (BIT 3 DATUM))
		     (INS (BIT 4 DATUM))
		     (STATECHANGE (BIT 5 DATUM))
		     (TIMEOUT (BIT 6 DATUM))))

(RECORD TERMSTATUS
 (JOBTIW FORKTIW MODEWORD CHANNELMASK TERMTYPE)
		   JOBTIW _(JS RTIW (XWD 0 -5)
			       NIL NIL 2)
		   FORKTIW _(JS RTIW 400000Q NIL NIL 2)
		   MODEWORD _(JS RFMOD 100Q NIL NIL 2)
		   CHANNELMASK _(JS RCM 400000Q NIL NIL 1)
		   TERMTYPE _(JS GTTYP 100Q NIL NIL 2)
		   [ACCESSFNS MODEWORD ((PAGEWIDTH (BITS 13Q 21Q DATUM))
			       (PAGELENGTH (BITS 4 12Q DATUM])
]
DONTEVAL@LOAD 
(LOADCOMP (QUOTE <LISPUSERS>NET))
)
(DEFINEQ

(SETSHAREDPAGE

  [LAMBDA NIL                      (* lmm "28-JUL-78 01:38")

    (ASSEMBLE
 NIL
	      [CQ (OR SHAREDPAGE (SETQ SHAREDPAGE (GETBLK 1]
                                   (* area to move patch code to)

	      (MOVEI 2 , FLAGWORD)
                                   (* move patch code from)

	      (MOVEI 4 , 0 (1))
	      (SUBI 4 , 0 (2))     (* 4 contains relocation amount)

	  RELOC
	      (CAIL 2 , OUT)
	      (JRST ENDLP)
	      (MOVE 5 , 0 (2))     (* full word)

	      (MOVEI 3 , 0 (5))    (* effective address)

	      (ADD
 5 , 4)          (* relocate)

	      (CAIL 3 , FLAGWORD)
                                   (* too small)

	      (CAILE 3 , OUT)      (* in range)

	      (SUB 5 , 4)
	      (MOVEM 5 , 0 (1))
	      (ADDI 1 , 1)
	      (AOJA 2 , RELOC)
	  ENDLP
	      (MOVEI 1 , 400000Q)
	      (JS RIR)             (* returns LEVTAB,,CHNTAB in 2)

	      (CQ SHAREDPAGE)
	      (SUBI 1 , FLAGWORD)
	      (ADDI 1 , DINT)
	      (HRLI 1 , 2)
	      (MOVEM 1 , 13Q (2))
                                   (* data error interrupt -

				   channel 13q)

	      (SUBI 1 , DINT)
	      (ADDI 1 , STATEINT)
	      (MOVEM 1 , 14Q (2))
                                   (* state change interrupt -

				   channel 14Q)

	      (SUBI 1 , STATEINT)
	      (ADDI 1 , FRKINT)
	      (MOVEM 1 , 23Q (2))
                                   (* fork termination interrupt)

	      (SUBI 1 , FRKINT)
	      (ADDI 1 , INSINT)
	      (MOVEM 1 , 15Q (2))
                                   (* INS/INR interrupt -

				   channel 15q)

	      (SUBI 1 , INSINT)
	      (ADDI 1 , LPC2)
	      (HLR 2 , 2)          (* LEVTAB now in 1)

	      (MOVE 2 , 1 (2))     (* LPC2 in 2)

	      (MOVEM 2 , 0 (1))    (* save in stored LPC2 location)

	      (JRST OUT)
	  FLAGWORD
	      (0)

          (* flag word for events. -

	  Bit 1: fork halt. -

	  Bit 2: control-K seen. -

	  Bit 3: data error on connection. -

	  Bit 4: INS/INR recieved. -

	  Bit 5: network state change -

	  Bit 6: timeout)



	      (JRST RELAY)         (* jump to relay code)

	      (JRST PEEK)          (* routine to peek for character)

	      (JRST DISMISS)       (* routine to wait a while)

	  DOBIN
	      (MOVNI 2 , 1)        (* first word of routine to do "BIN" which can be interrupted out of)

                                   (* set ac2 to negate to check if after return from BIN)

	  FPC (SKIPN 2 , FLAGWORD)
	      (JS BIN)
	  LPC (JRST 0 (7))
	  STATEINT
	      (MOVEM 1 , S1)
	      (HRLZI 1 , 10000Q)
	      (JRST FXUP)
	  INSINT
	      (MOVEM 1 , S1)
	      (HRLZI 1 , 20000Q)
	      (JRST FXUP)
	  DINT(MOVEM 1 , S1)
	      (HRLZI 1 , 40000Q)
	      (JRST FXUP)
	  FRKINT
	      (MOVEM 1 , S1)       (* save AC1)

	      (HRLZI 1 , 200000Q)
	  FXUP(IORM 1 , FLAGWORD)
	      (HRRZ 1 , @ LPC2)    (* get PC interrupted from)

	      (CAIL 1 , FPC)       (* first interruptable instruction)

	      (CAILE 1 , LPC)      (* must be before return)

	      (JRST RTRN)          (* not in range)

	      (MOVEI 1 , DOBIN)
	      (MOVEM 1 , @ LPC2)
	  RTRN(MOVE 1 , S1)
	      (JS DEBRK)
	      (0)
	  S1  (0)
	  LPC2(0)
	  PEEK(CQ (ASSEMBLE
 NIL

          (* run in lower fork to interrupt upper when char available from file -

	  takes JFN in 1, location to store byte (FCHAR (FX)) in 4)



			    (MOVEI 1 , 0 (3))
			    (JS BIN)
			    (MOVEM 2 , 0 (4))
			    (JS HALTF)))
	  DISMISS
	      (CQ (ASSEMBLE
 NIL    (* when (AC3) ms. goes by without any activity by superiour or given fork , halt)

			    (MOVEI 1 , -1)
                                   (* Lisp fork -

				   our parent)

			    (MOVE 2 , 4)
                                   (* Lisp's handle on RELAYFORK)

			    (JS GFRKH)
                                   (* get fork handle)

			    (MOVEI 1 , -1)
                                   (* returns fork handle for us in AC1 if skip-return)

			    (MOVE 6 , 1)
                                   (* save fork handle in 6)

			    (MOVE 5 , 3)
                                   (* save dismiss interval in 5)

			    (SETOB 4 , 7)
			WAITMORE
			    (MOVE 1 , 5)
			    (JS DISMS)
			    (MOVEI 1 , -1)
			    (JS RUNTM)
			    (EXCH 1 , 4)
			    (CAME 1 , 4)
			    (JRST WAITMORE)
			    (MOVE 1 , 6)
			    (JS RUNTM)
			    (EXCH 1 , 7)
			    (CAME 1 , 7)
			    (JRST WAITMORE)
			    (HRLZI 1 , 4000Q)
			    (IORM 1 , FLAGWORD)
			    (JS HALTF)))
	  RELAY
	      (CQ (ASSEMBLE
 NIL

          (* this is the code for the "relay" fork; it is on the SHAREDPAGE so that it can easily access the flag word -

	  Ac3 has (mtoprflg,,outjfn) -

	  AC4 has (crlfflg,,signalchar))



			RLY (MOVEI 1 , 100Q)
			    (JS BIN)
			    (MOVEI 1 , 0 (3))
                                   (* OJFN)

			    (CAIE 2 , 0 (4))
                                   (* SIGNAL CHAR)

			    (JUMPA NSIG)
			    (HRLZI 1 , 100000Q)
			    (IORM 1 , FLAGWORD)
			    (JS HALTF)
			    (JRST RLY)
			NSIG(CAIE 2 , 37Q)
			    (JUMPA PTCH)
			    (MOVEI 2 , 15Q)
			    (JUMPGE 4 , PTCH)
			    (JS BOUT)
			    (MOVEI 2 , 12Q)
			PTCH(JS BOUT)
			    (JUMPL 3 , RLY)
                                   (* no MTOPR if sign bit set)

			    (MOVEI 2 , 21Q)
			    (JS MTOPR)
			    (JUMPA RLY)
			    (JUMP RLY (1))
                                   (* this instruction is here so that an error will happen if this function is made

				   swapped, since it shouldn't be swapped)

			))
	  OUT)
    SHAREDPAGE])
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: CHATBLOCK (ENTRIES TELNET SETFORK)
	SETFORK MAPPAGEDOWN TELNET SETREMOTETERMINAL (GLOBALVARS LASTCONNECTION CHATDEBUGFLG 
								 LASTCHATEXITCHAR TELNETEXITCHAR 
								 TIMERFORK RELAYFORK CONNECTIONARRAY 
								 SHAREDPAGE)
	(NOLINKFNS . T))
(BLOCK: NIL SETSHAREDPAGE GETTERMSTATUS RESTORETERMSTATUS (LOCALVARS . T)
	(GLOBALVARS BYTELISPFLG SHAREDPAGE))
]
STOP