// ChatDisBSP.BCPL - Bob Sproull - Stuff requiring BSP definitions
// Copyright Xerox Corporation 1979
// modified: April 13, 1979  6:04 PM (E. Taft)

get "Chat.d"
get "ChatBSP.d"

external
	[
// outgoing procedures
	ChatDIS; AwaitDisplayConnection

// incoming procedures
	DisReset; DisClose; DisWs
	CheckShiftSwat; BigStack; SmallStack
	OpenLevel1Socket; SetAllocation; ReleasePBI
	OpenRTPSocket; CreateBSPStream
	CallContextList; Block; InitializeContext
	SetTimer; TimerHasExpired
	Enqueue; Unqueue
	Closes
	SetBlock
	GotoLabel

// incoming statics
	TTYStr; TTYSoc; DISStr; DISSoc
	disTypeInCtx; disTypeOutCtx; disDisplayCtx; disEventCtx
	DisErrStack; DisErr; DisMarkCount; staticErrCode
	Running; ChatZone; ConnectionOpen
	ctxQ
	lvUserFinishProc
	]

static	[
	disSavedUFP
	]

//Come here with communications going (TTYSoc, TTYStr ok)
//	ChatZone set up
//	ScreenBuffer => region for screen +DCB
//	ScreenBufferLength = length of both

let ChatDIS() be
[
	DisReset()

// Set up the various kinds of error handling (too many!)
	TTYStr>>ST.error=DisHandleBSPError
	TTYSoc>>BSPSoc.bspOtherPupProc=DisHandlePup
	disSavedUFP = @lvUserFinishProc
	@lvUserFinishProc=DisHandleFinish

//Now start everything up:
	Running=1
	[
	CallContextList(ctxQ!0)
	CheckShiftSwat()
	] repeat
]

and AwaitDisplayConnection() be
	[
	if DISStr then Closes(DISStr)
	DISStr=0

	let lclPort=vec lenPort
	SetBlock(lclPort, 0, lenPort)
	lclPort>>Port.socket^2=#66	//Socket number #66
	OpenLevel1Socket(DISSoc, lclPort)
	SetAllocation(DISSoc, nDisplayPBI, nDisplayPBI-1, nDisplayPBI-1)
	until OpenRTPSocket(DISSoc, ctxQ, modeListenAndWait, 0,0,0, ChatZone)
		do loop
	DISStr=CreateBSPStream(DISSoc)
	DISStr>>ST.error=DisHandleBSPError
	DISSoc>>BSPSoc.bspOtherPupProc=DisHandlePup
	DisReset()
	ConnectionOpen=true
	]


// Various error and finishing code.

and DisHandleFinish(code) be
[
	@lvUserFinishProc=disSavedUFP
	@#420=0				//Let display finish during networking
	let tim=nil
	SetTimer(lv tim, 3000)	// Thirty seconds
	if Running then Running=2	//Flag to stop everything
	Unqueue(ctxQ, disTypeInCtx)
	Unqueue(ctxQ, disTypeOutCtx)
	Unqueue(ctxQ, disDisplayCtx)
	Unqueue(ctxQ, disEventCtx)
	Enqueue(ctxQ, InitializeContext(disEventCtx, 200, DisClose))

	until Running eq 0 % TimerHasExpired(lv tim) do
		CallContextList(ctxQ!0)
]

// Stream Errors: simply arrange to return a flag value that indicates
// what has happened:
//	-1:	Mark
//	-2:	Interrupt (not yet implementable!)
//	-3:	Grounds for closing connection (bad state)

and DisHandleBSPError(str, ec) = valof
[
	staticErrCode=valof [
	switchon ec into
	[
	case ecMarkEncountered:
		resultis -1
	default:			//Bad status -- connection to close
		Block()		//Give other guy chance to run
		resultis -3
	]
	]
	if str eq DISStr then GotoLabel(DisErrStack, DisErr)
	resultis staticErrCode
]

//Called when an error, interrupt, or abort pup is received, and handed
// the very pup.

and DisHandlePup(PBI) be
[CPE
if PBI>>PBI.pup.type eq typeError then
	[
	let C=lv PBI>>PBI.pup.bytes
	let sl=PBI>>PBI.pup.length+(-22-24+1)	//Text length+1
	let fp=C+11
	@fp=(sl lshift 8)+#40	//Length,,space
	fp=BigStack(fp)
	DisWs("*n*l")
	DisWs(fp)			//Print message if any
	DisWs(" [Error PUP]*n*l")
	SmallStack()
	if C!10 eq 2 then		//The only fatal one for now.
	   [
	   finish			//No point in continuing.
	   ]
	]
// Should really check socket, but not easy....
if PBI>>PBI.pup.type eq typeInterrupt then
	[
	DisMarkCount=DisMarkCount+1	//Grumble.....
	]
ReleasePBI(PBI)
]CPE