;CHAOSNET ROUTINES, BASICALLY FROM MC:MOON;NNETWK >
.INSRT SYSTEM; CHSDEF >

DEFINE SYSCAL NAME,ARGS
.CALL [SETZ ? SIXBIT /NAME/ ? ARGS ((SETZ))]
TERMIN

;CHESS PACKET TYPES
PKTPOS==1	;SEND OVER POSITION
PKTRQR==2	;REQUEST RESULT
PKTRES==3	;RETURNNED RESULTS
PKTBKS==4	;CLOSE RING AND START BACKGROUND

;FORMATING OF PACKET FOR TRANSFERING A CHESS POSITION:
 $CXPKT==242000,,%CPKDT		;PACKET TYPE
 $CXBFM==042000,,%CPKDT		;CHEOPS BUFFER MEMORY LOCN
 $CXPRI==242000,,%CPKDT+1	;PRIORITY OPTION
 $CXMOD==042000,,%CPKDT+1	;MODES (WD2 OF CHEOPS ARG BLOCK)
 $CXSTD==242000,,%CPKDT+2	;SETD  (WD3)
 $CXALP==042000,,%CPKDT+2	;ALPHA (WD4)
 $CXBET==242000,,%CPKDT+3	;BETA  (WD5)
 $CXFLG==042000,,%CPKDT+3	;FLAGWORD (WD6)
 $CXCHN==242000,,%CPKDT+4	;CHAIN WORD (WD7)
 $CXPOS==$CXCHN		;FIRST DATA WORD OF POSITION.  NOTE IDPB THIS..
%CXPKL==<10.*2>+<33.*2> ;MAX BYTE LENGTH OF MESSAGE. THIS IS HOW LONG POSITION PACKETS
			; ACTUALLY ARE
;FORMATTING FOR CHEOPS RESULT PACKET
 $CRPKT==242000,,%CPKDT		;PACKET TYPE, SAME AS ABOVE
 $CRBFM==042000,,%CPKDT		;BUFFER ADR, SAME AS ABOVE
 $CRSTD==242000,,%CPKDT+1	;SETD FROM WD3 OF PARAM BLOCK
 $CRPAD==042000,,%CPKDT+1	;PADDING TO MAKE FOLLOWING ALIGN ON PDP10 WORD BOUNDARIES.
;MUST ALIGN ON WORD BOUNDARY
 $CRSTA==242000,,%CPKDT+2	;WD16 STATA (LOW ORDER)
 $CRSTB==042000,,%CPKDT+2	;WD17 STATB (HIGH ORDER)
 $CRVAL==242000,,%CPKDT+3	;WD20 VALUE
 $CRIVL==042000,,%CPKDT+3	;WD21 INITIAL VALUE
 $CRPV1==%CPKDT+4		;WD22,23  PV1
 $CRPV2==%CPKDT+5		;WD24,25  PV2
 $CRPV3==%CPKDT+6		;WD26,27  PV3
 $CRPH1==%CPKDT+7		;WD30,31  PV1 WITH HIM TO MOVE
 $CRPH2==%CPKDT+10		;WD32,33  PV2  "
 $CRPH3==%CPKDT+11		;WD34,35  PV3  "
 $CRHVL==242000,,%CPKDT+12	;VALUE WITH HIM TO MOVE

;FORMATTING FOR CLOSE RING AND START BACKGROUND PACKET
 $CCPKT==242000,,%CPKDT		;PACKET TYPE, SAME AS ABOVE
 $CCBFM==042000,,%CPKDT		;BUFFER ADR, HEAD OF RING
 $CCBF1==242000,,%CPKDT+1	;BUFFER ADR OF BLOCK TO RING TO HEAD BUFFER

;PV WITH OTHER SIDE TO MOVE

;CHAOS NETWORK CONNECT ROUTINE
;
;Call:
;	MOVEI B,host	;host number to connect to
;	MOVEI C,contact name	;an ASCIZ string
;	MOVEI D,window size
;	PUSHJ P,CHACON
;	 lossage	;you may call ANALYZE to get an error message.
;			;If $$ERRHAN is nonzero, we call ANALYZE for you.
;
;Clobbers only T and TT.
;

.VECTOR PKTBUF(%CPMXW)		;Buffer used by Open, Close, and Analyze

CHACON:  MOVEI TT,%CORFC
	SETZM PKTBUF
	MOVE T,[PKTBUF,,PKTBUF+1]
	BLT T,PKTBUF+%CPMXW-1	;For extra luck, clear the packet buffer
	DPB B,[$CPKDA+PKTBUF]	;Destination host
	DPB TT,[$CPKOP+PKTBUF]
	PUSHJ P,CHSTNG		;Store string from C
	SYSCAL CHAOSO,[MOVEI CHNETI ? MOVEI CHNETO]	;Assign Chaos index
	 JRST CHACNL
	SYSCAL PKTIOT,[MOVEI CHNETO ? MOVEI PKTBUF]	;Send RFC or LSN
	 .LOSE 1000
	MOVEI TT,30.*30.	;30-second timeout
	SKIPE DEBUG
	 MOVSI TT,177777	;Or infinite, in debug mode
	LDB T,[$CPKOP+PKTBUF]
	CAIE T,%COLSN		;Get the boring state
	 SKIPA T,[%CSRFS]
	  MOVEI T,%CSLSN
	SYSCAL NETBLK,[MOVEI CHNETO ? T ? TT ? MOVEM TT]	;Await completion of connection
	 JRST CHACNL
	CAIE TT,%CSOPN
	 JRST CHACNL
	JRST POPJ1		;CHACON done

CHACNL:			;CHACON lost
	MOVEI A,CHNETI
	PUSHJ P,ANALYZE
	JFCL		;SKIPS SOMETIMES
	.CLOSE CHNETI,
	POPJ P,

;Send CLOSE packet, then close connection
;Call:	MOVEI C,message		;asciz string
;	PUSHJ P,CHACLS
;	 lossage

CHACLS:	MOVEI T,%COCLS
	DPB T,[$CPKOP+PKTBUF]
	PUSHJ P,CHSTNG
	SYSCAL PKTIOT,[MOVEI CHNETO ? MOVEI PKTBUF]
	SKIPA
	AOS (P)
	.CLOSE CHNETI,
	.CLOSE CHNETO,
	JRST POPJ1

CHSDTO:	MOVEI T,%CODAT		;FINISH FORMATING AND SEND DATA PACKET
	DPB T,[$CPKOP+PKTBUF]   ;-NOTE--BYTE LENGTH SHOULD ALREADY BE IN [$CPKNB+PKTBUF]
	SYSCAL PKTIOT,[MOVEI CHNETO ? MOVEI PKTBUF]
	.VALUE
	POPJ P,


;Store string from C into PKTBUF. Bash T, TT
CHSTNG:	PUSH P,B
	PUSH P,C
	MOVE B,[440800,,PKTBUF+%CPKDT]
	MOVEI TT,0
	HRLI C,440700
CHSTG1:	ILDB T,C
	JUMPE T,CHSTG2
	IDPB T,B
	CAIGE TT,%CPMXC-1
	 AOJA TT,CHSTG1
CHSTG2:	DPB TT,[$CPKNB+PKTBUF]
	POP P,C
	POP P,B
	POPJ P,


; Network error analysis.

;Call:	MOVEI A,pin		;channel number that is losing
;	PUSHJ P,ANALYZE
;	 .VALUE			;always skip-returns
;
;Clobbers only T and TT.  Uses the PUTCHR routine to type out its messages.

.VECTOR WHYINT(4)		;Cruft returned from WHYINT

ANALYZE:
	AOS (P)
	PUSH P,B
	PUSH P,C
ANALN1:	SYSCAL WHYINT,[A ? MOVEM T ;Get device type
			 MOVEM WHYINT ? MOVEM WHYINT+1 ? MOVEM WHYINT+2 ? MOVEM WHYINT+3 ]
	 MOVEI T,0		;Channel not open, probably
	CAIN T,%WYCHA
	 JRST ANLCHA		;Chaos net channel open, further info available
	SYSCAL USRVAR,[MOVEI %JSELF ? MOVEI .RIOS(A) ? MOVEM T] ;Get I/O status wd for channel
	 .LOSE 1000
	LDB TT,[220600,,T]	;only the open-loss code is available
	CAIE TT,%ENAPP		;Other end of pipeline gone, or
	CAIN TT,%ENSDR		;No such directory
	 JRST [	JSP TT,SPEAK	;means destination host dead
		ASCIZ\Destination Host dead.\ ]
	CAIN TT,%EFLDV		;Device full (this one applies to both Arpanet & Chaos net)
	 JRST [	JSP TT,SPEAK
		ASCIZ \All sockets in use.\ ]
	CAIN TT,%ENRDV		;Device not ready
	 JRST [	JSP TT,SPEAK
		ASCIZ \Network down.\ ]
	CAIN TT,%ESCO		;Self-contradictory open
	 JRST [	JSP TT,SPEAK
		ASCIZ \Connection cannot be opened because of inconsistent byte sizes.\ ]
	.CALL [	SETZ		;Some other error - get ITS error message
		'IOPUSH
		SETZ A ]
	 .LOSE 1000
	.CALL [	SETZ
		SIXBIT/OPEN/
		MOVEI (A)	;here we rely on .UAI=0
		['ERR,,]
		MOVEI 3
		SETZ T ]
	 .LOSE 1400
	MOVEI TT,[ASCIZ\? Internal error - \]
	PUSHJ P,ZTYPE
ANAL0:	.CALL [	SETZ		;copy error message to output device
		'IOT,,
		MOVEI (A)
		SETZM T ]
	 .LOSE 1000
	CAIGE T,40
	 JRST ANALYX
	PUSHJ P,PUTCHR
	JRST ANAL0

ANALYX:	.CALL [	SETZ
		SIXBIT/IOPOP/
		SETZI (A) ]
	 .LOSE 1000
ANALX:	MOVEI TT,[ASCIZ /
/]
	PUSHJ P,ZTYPE
	POP P,C
	POP P,B
	POPJ P,

ANALT:	MOVEI TT,[ASCIZ /Attempt to open connection timed out./]
SPEAK:	PUSHJ P,ZTYPE		;send message from TT
	JRST ANALX		; and return

;Analyze on chaos channel, still open

ANLCHA:	MOVE TT,WHYINT		;Connection state
	CAIE TT,%CSLOS
	 CAIN TT,%CSCLS
	  JRST ANLCH1
	CAIE TT,%CSINC
	 JRST ANLCH0		;Still open
	JSP TT,SPEAK
	ASCIZ /Connection broken -- foreign host not communicating./

ANLCH0:	PUSH P,CHSTTB(TT)
	MOVEI TT,[ASCIZ/Timed-out while connection /]
	PUSHJ P,ZTYPE
	POP P,TT
	JRST SPEAK

CHSTTB:	[ASCIZ/closed/]
	[ASCIZ/listening/]
	[ASCIZ/has received RFC/]
	[ASCIZ/has sent RFC/]
	[ASCIZ/open/]
	[ASCIZ/lost/]
	[ASCIZ/broken/]

ANLCH1:	PUSH P,CHSTTB(TT)
	MOVEI TT,[ASCIZ/Connection /]
	PUSHJ P,ZTYPE
	POP P,TT
	PUSHJ P,ZTYPE
	MOVEI TT,[ASCIZ/ -- /]
	PUSHJ P,ZTYPE
	HLRZ TT,WHYINT+1	;get number of input packets
ANLCH2:	SOJL TT,ANALX		;scan input looking for CLS, LOS
	HLRZ T,WHYINT+3		;Pick up input channel number
	SYSCAL PKTIOT,[T ? MOVEI PKTBUF]
	 .LOSE 1000
	LDB T,[$CPKOP+PKTBUF]
	CAIE T,%COCLS
	 CAIN T,%COLOS
	  SKIPA B,[440800,,PKTBUF+%CPKDT]
	   JRST ANLCH2
	LDB C,[$CPKNB+PKTBUF]
ANLCH3:	SOJL C,ANALX
	ILDB T,B
	PUSHJ P,PUTCHR
	JRST ANLCH3


ZTYPE:	PUSH P,B
	PUSH P,A
	MOVEI B,TYO
	SOUT (TT)
	POP P,A
	POP P,B
	POPJ P,

PUTCHR:	PUSH P,A
	MOVE A,T
	PUSHJ P,TYO
	POP P,A
	POPJ P,

DEBUG:	0		;NON-ZERO -> INIFINITE TIMEOUT ON RFC


NSTRT:	MOVEI C,CBABL		;PRIORITY BLOCK, WANT 16 BIT WORD ADR
	MOVEI T,CHXTB
	MOVEI D,1		;USE PRIORITY POINTER
CXTPO1:	PUSHJ P,CXNPOS
	MOVEI ZR,%CXPKL
	DPB ZR,[$CPKNB+PKTBUF]  ;SET # BYTES TO SOMETHING BIG ENUF
	PUSHJ P,CHSDTO
	POPJ P,

CXTPOS:	MOVEI D,2		;ADD TO BACKGROUND
	JRST CXTPO1

CXNPOS:	MOVEI ZR,PKTPOS		;FOLLOWING ROUTINE SEMI-COMPATABLE WITH CXBPOS
	DPB ZR,[$CXPKT+PKTBUF]	;CHEOPS PACKET TYPE
	MOVE ZR,C
	LSH ZR,1		;LISPM ADDRESS 1 UNIBUS LOCN PER ADR, NOT TWO
	DPB ZR,[$CXBFM+PKTBUF]	;CHEOPS BUFFER ADR
	DPB D,[$CXPRI+PKTBUF]	;PRIORITY OPTION
	MOVE TT,[$CXPOS+PKTBUF]
	MOVE B,[-NPC,,1]
CXPK1:	SKIPN A,PIECEL(B)
	JRST CXPK2
	SKIPGE D,CHEOPC(B)
	 JRST [	LDB ZR,[PTID,,PIECE(B)]
		CAIE ZR,PID
		TRO D,40	;THIS P PROMOTED
		JRST .+1]
	MOVE ZR,CHEOSQ(A)
	DPB D,[101000,,ZR]
	IDPB ZR,TT
CXPK2:	AOBJN B,CXPK1
	MOVEI ZR,0
	IDPB ZR,TT		;TERMINATE LIST
	MOVE ZR,-1(T)	;BITS AND MODES WD
	DPB ZR,[$CXMOD+PKTBUF]
	MOVE ZR,-5(T)	;DEPTH
	DPB ZR,[$CXSTD+PKTBUF]
	MOVE ZR,-4(T)	;INITIAL ALPHA
	DPB ZR,[$CXALP+PKTBUF]
	MOVE ZR,-3(T)	;INITIAL BETA
	DPB ZR,[$CXBET+PKTBUF]
	MOVE ZR,-2(T)	;INITIAL FLAGWORD
	DPB ZR,[$CXFLG+PKTBUF]
	MOVE ZR,-6(T)	;CHAIN WORD
	DPB ZR,[$CXCHN+PKTBUF]
	POPJ P,

CXBFNT:	MOVE C,CBBIP		;CLOSE RING, AND START BACKGROUND SEARCH
	LSH C,1
	MOVE T,CBBBP
	SUBI T,40
	LSH T,1
	MOVEI ZR,PKTBKS
	DPB ZR,[$CCPKT+PKTBUF]
	DPB C,[$CCBFM+PKTBUF]
	DPB T,[$CCBF1+PKTBUF]
	MOVEI ZR,3*2
	DPB ZR,[$CPKNB+PKTBUF]	;DATA BYTES IN PACKET
	PUSHJ P,CHSDTO
	POPJ P,

;REQUEST RESULTS FROM CHEOPS
NGTV:	MOVEI C,CBABL
CXGVN:	MOVEI ZR,PKTRQR
	DPB ZR,[$CXPKT+PKTBUF]
	MOVE ZR,C
	LSH ZR,1
	DPB ZR,[$CXBFM+PKTBUF]
	MOVEI ZR,2*2
	DPB ZR,[$CPKNB+PKTBUF]	;PACKET DATA LENGTH IN BYTES
	PUSHJ P,CHSDTO		;SEND REQUEST FOR RESULTS.
	SYSCAL PKTIOT,[MOVEI CHNETI ? MOVEI PKTBUF]
;FOLLOWING SEMI-COMPATABLE WITH HCHGVR
	LDB T,[$CPKOP+PKTBUF]
	CAIE T,%CODAT
	.VALUE		;NOT DATA PACKET
	LDB T,[$CXPKT+PKTBUF]
	CAIE T,PKTRES
	.VALUE		;NOT RESULT PACKET
	LDB J,[$CRSTD+PKTBUF]
	MOVEM J,HCHSTD
	MOVEM J,CHXSTD
	MOVE J,$CRPV1+PKTBUF
	SOSL HCHSTD
	TLNN J,777774
	 JRST [	CLEARM CHXPV1
		CLEARM CHXPV2
		CLEARM CHXPV3
		JRST NTGV1]
	PUSHJ P,HCHMMV
	MOVEM R,CHXPV1
	MOVE J,$CRPV2+PKTBUF
	SOSL HCHSTD
	TLNN J,777774
	 JRST [	CLEARM CHXPV2
		CLEARM CHXPV3
		JRST NTGV1]
	PUSHJ P,HCHMMV
	MOVEM R,CHXPV2
	MOVE J,$CRPV3+PKTBUF
	SOSL HCHSTD
	TLNN J,777774
	 JRST [	CLEARM CHXPV3
		JRST NTGV1]
	PUSHJ P,HCHMMV
	MOVEM R,CHXPV3
NTGV1:	LDB R,[$CRIVL+PKTBUF]
	TRNE R,100000
	ORCMI R,77777
	MOVEM R,CHXIMB
	LDB R,[$CRSTA+PKTBUF]
	LDB J,[$CRSTB+PKTBUF]
	LSH J,20
	IOR J,R
	MOVEM J,CHXSTA
	LDB R,[$CRVAL+PKTBUF]
	TRNE R,100000
	ORCMI R,77777
	MOVEM R,CHXVAL
	POPJ P,