title	lstat
	subttl	Display Leaf status program

;	Eric Schoen
;	SUMEX Computer Project
;	Stanford University Medical Center
;	Stanford, CA
;	February, 1982

;	Work on Leaf and Sequin implementations in Tenex
;	and Tops-20 was funded by NIH Biotechnology Resouces 
;	Program	under grant RR-00785

;	This module must be assembled with other modules of the
;	Leaf server.  Set its entry vector to LSTAT.

	search pupdef,psqdef
ifn ft10x,<search stenex>
ifn ft20,<search monsym>
	usevar lstvar,lstpvr
	extern	connum,usrnum,contab

sp==16

xtop==0
ytop==2

connx==2
hostx==5
sqtx==↑D35
sqrx==↑D41
statx==↑D47
usrx==↑D58

waitx==2
waity==↑d15

lacstk==100
lpdstk==40
lspstk==20

lstat::	reset
	move p,[iowd lacstk,acstk]
	movem p,acp
	move p,[iowd lpdstk,pdstk]
	move sp,[iowd lspstk,spstk]
	movei a,↑d250		; set 250 ms update interval
	movem a,wtime
	pushj p,mapd
	pushj p,statin
	pushj p,dspini
	pushj p,dostat
	pushj p,unmapd
	pushj p,dspoff
	haltf
	jrst lstat

; routine to init stats
statin:	move a,[cons,,cons+1]
	setzm cons
	blt a,cons+nconn-1
	popj p,

ls cons,nconn

; routine to init display
dspini:	pushj p,dpyini##
	pushj p,turnon##
	pushj p,docp##
	hrroi a,[asciz/          Host                   Send# Rec#  State         User/]
	pushj p,dpsout
	popj p,

; routine to turn off display
dspoff:	pushj p,docp##
	pushj p,turnof##
	popj p,


; main status display routine
dostat: push p,[xtop]
	movei a,ytop
	movem a,ytemp2
	push p,a
	pushj p,saveac
	pushj p,setcur##	; set the cursor
	pushj p,restac
	movsi d,-nconn
dosta0:	skipn a,contab(d)	; get a connection table entry
	 jrst dosta1		; no entry, loop past display
	skipl cons(d)		; was there a connection here before?
	 pushj p,newcon		; no, this is a new connection
	pushj p,dspcon		; update connection stats
	aos ytemp2		; increment y pos
dosta2:	push p,[xtop]		; move the cursor
	push p,ytemp2		; push it
	pushj p,saveac
	pushj p,setcur##	; set the cursor
	pushj p,restac
	aobjn d,dosta0		; loop
	pushj p,statwt		; wait
	 popj p,		; leave if exit wanted
	jrst dostat		; else go again

ls ytemp2,1

; here if we find an unused connection slot in contab
dosta1:	skipge cons(d)		; was there one before?
	 pushj p,kilcon		; yes, kill display of connection
	jrst dosta2		; loop	


; wait loop for display
; simple, for now
statwt:	pushj p,saveac		; set the cursor
	push p,[waitx]
	push p,[waity]
	pushj p,setcur##
	pushj p,dpyout##
	pushj p,restac
	time			; compute next update time
	add a,wtime
	movem a,updtim
statw1:	movei a,100		; see if there's anything to do
	sibe
	 jrst statw2
statw3:	movei a,↑d100		; no, sleep for a bit
	disms
	time
	camge a,updtim
	 jrst statw1
	aos (p)
	popj p,

ls updtim,1

; here when there might be a command
statw2:	pbin			; read a character
	caige a,"a"
	 skipa
	caile a,"z"
	 skipa
	  trz a,40
	cain a,"E"		; exit?
	 jrst exit
	cain a,"R"
	 jrst refrsh		; refresh screen
	cain a,"U"
	 jrst setupd
; commands below here require the program be write enabled
	skipl wrtenb
	 jrst statw3		; not write enabled
	cain a,"K"		; kill a connection?
	 jrst conkil		
	jrst statw3

; here to leave
exit:	hrroi a,[asciz/Exit/]
	pushj p,dpsout
	call dpyout##
	popj p,

; here to set update interval
setupd:	hrroi a,[asciz/Update interval (now /]
	pushj p,dpsout
	hrroi a,temp2
	move b,wtime
	movei c,↑d10
	nout
	 jfcl
	hrroi a,temp2
	pushj p,dpsout
	hrroi a,[asciz/ ms): /]
	pushj p,dpsout
	pushj p,reddec
	skipge b
	 jrst statw3
	movem b,wtime
	aos (p)
	popj p,

; here to refresh screen
refrsh:	setzm cons
	move a,[cons,,cons+1]
	blt a,cons+nconn-1
	pushj p,dspini
	aos (p)
	popj p,

; here to kill a connection
conkil:	hrroi a,[asciz/Kill /]	; prompt
	pushj p,dpsout
	pushj p,redoct
	skipge b		; -1 in b means bad number
	 jrst statw3
	caile b,nconn		; legal connection number?
	 jrst statw3		; no
	move a,contab(b)	; get address of sequin data block
	movei b,DSTR		; destroy the connection
	movem b,seqSta(a)
	aos (p)
	popj p,

; routine to read a number, returned in b
redoct:	call turnof##		; turn on echoing
	hrroi a,temp2		; read a string, with editing
	movei b,4
	setz c,
ifn ft10x,<
	pstin
>
ifn ft20,<
	rdtty
	 jfcl
>
	setz b,			; clobber the terminator
	dpb b,a
	hrroi a,temp2
	movei c,↑d8
	nin
	 seto b,
	pushj p,saveac
	pushj p,turnon##
	pushj p,clrcur##
	push p,[waitx]
	push p,[waity]
	pushj p,setcur##
	pushj p,doeeol##
	pushj p,dpyout##
	pushj p,restac
	popj p,

; routine to read a number, returned in b
reddec:	call turnof##		; turn on echoing
	hrroi a,temp2		; read a string, with editing
	movei b,5
	setz c,
ifn ft10x,<
	pstin
>
ifn ft20,<
	rdtty
	 jfcl
>
	setz b,			; clobber the terminator
	dpb b,a
	hrroi a,temp2
	movei c,↑d10
	nin
	 seto b,
	pushj p,saveac
	pushj p,turnon##
	pushj p,clrcur##
	push p,[waitx]
	push p,[waity]
	pushj p,setcur##
	pushj p,doeeol##
	pushj p,dpyout##
	pushj p,restac
	popj p,

; routine to init new connection on display
; call: pushj p,newcon
;	d/ cx table index
newcon:	setom cons(d)		; say we have a connection here
	setzm sthosf(d)		; say host name isn't displayed
	setzm stsqrf(d)		; say receive sequence isn't displayed
	setzm stsqtf(d)		; say transmit sequence isn't displayed
	setzm stsqsf(d)		; say sequin state isn't displayed
	setzm stusrf(d)		; say user isn't displayed
	pushj p,saveac
	pushj p,doil##		; insert a line for this connection
	pushj p,restac
	hrroi a,temp2		; number it
	hrrz b,d
	movei c,↑d8
	nout
	 jfcl
	hrroi b,[asciz/. /]
	setz c,
	sout
	push p,[connx]
	push p,cy
	pushj p,saveac
	pushj p,setcur##
	pushj p,restac
	hrroi a,temp2
	pushj p,dpsout
	popj p,			; leave

ls sthosf,nconn			; host name flag
ls stsqrf,nconn			; receive sequence flag
ls stsqtf,nconn			; transmit sequence flag
ls stsqsf,nconn			; sequin state flag
ls stusrf,nconn			; user flag

ls sthos,nconn			; host name storage
ls stsqr,nconn			; receive sequence storage
ls stsqt,nconn			; transmit sequence storage
ls stsqs,nconn			; sequin state storage
ls stusr,nconn			; user storage

; routine to kill a connection
; call: pushj p,kilcon
;	d/ cx index
kilcon:	pushj p,saveac
	pushj p,dodl##		; kill line on screen
	pushj p,restac
	setzm cons(d)		; say we don't know about this connection
	popj p,			; return

; routine to display information for this connection
; call: pushj p,dspcon
;	d/ cx table index
dspcon:	move p1,contab(d)
	pushj p,dsphos
	pushj p,dsptrn
	pushj p,dsprec
	pushj p,dspsta
	pushj p,dspusr
	popj p,

; routine to display host
dsphos:	move c,seqfnh(p1)
	camn c,sthos(d)		; is this data different?
	 jrst [skipl sthosf(d)	; no, but is the stored data valid?
		jrst .+1	; no, display it
	       popj p,]		; yes, leave
	movem c,sthos(d)	; save current data
	setom sthosf(d)
	hrroi a,temp2
	movei b,adrtab
	movem c,adrtab
	setzm adrtab+1
	pupnm
	 jfcl
	push p,[hostx]
	push p,cy##
	pushj p,saveac
	pushj p,setcur##
	pushj p,restac
	hrroi a,temp2	
	pushj p,dpsout
	popj p,

ls adrtab,2

; routine to display transmit sequence
dsptrn:	move b,sendsq(p1)
	camn b,stsqt(d)
	 jrst [skipl stsqtf(d)
		jrst .+1
	       popj p,]
	movem b,stsqt(d)
	setom stsqtf(d)
	hrroi a,temp2
	movei c,↑d8
	tlo c,(1b2+3b17)
	caige b,0		; don't try -1
	 jrst [push p,[sqtx]
	       push p,cy##
	       pushj p,saveac
	       pushj p,setcur##
	       pushj p,restac
	       hrroi a,[asciz/ -1/]
	       pushj p,dpsout
	       popj p,]
	nout
	 jfcl
	push p,[sqtx]
	push p,cy##
	pushj p,saveac
	pushj p,setcur##
	pushj p,restac
	hrroi a,temp2
	pushj p,dpsout
	popj p,

; fall through
dsprec:	move b,recvsq(p1)
	camn b,stsqr(d)
	 jrst [skipl stsqrf(d)
		jrst .+1
	       popj p,]
	movem b,stsqr(d)
	setom stsqrf(d)
	hrroi a,temp2
	movei c,↑d8
	tlo c,(1b2+3b17)
	caige b,0		; don't try -1
	 jrst [push p,[sqrx]
	       push p,cy##
	       pushj p,saveac
	       pushj p,setcur##
	       pushj p,restac
	       hrroi a,[asciz/ -1/]
	       pushj p,dpsout
	       popj p,]
	nout
	 jfcl
	push p,[sqrx]
	push p,cy##
	pushj p,saveac
	pushj p,setcur##
	pushj p,restac
	hrroi a,temp2
	pushj p,dpsout	
	popj p,

; routine to display state
dspsta:	move b,seqsta(p1)
	camn b,stsqs(d)
	 jrst [skipl stsqsf(d)
		jrst .+1
	       popj p,]
	movem b,stsqs(d)
	setom stsqsf(d)
	push p,[statx]
	push p,cy##
	pushj p,saveac
	pushj p,setcur##
	pushj p,restac
	hrro a,stattb(b)
	pushj p,dpsout
	popj p,

stattb:	[asciz/CLOS/]
	[asciz/OPEN/]
	[asciz/DLLY/]
	[asciz/BROK/]
	[asciz/DSTR/]
	[asciz/TIMD/]

; routine to display user
dspusr:	move b,usrnum(d)
	camn b,stusr(d)
	 jrst [skipl stusrf(d)
		jrst .+1
	       popj p,]
	movem b,stusr(d)
	setom stusrf(d)
	push p,[usrx]
	push p,cy##
	pushj p,saveac
	pushj p,doeeol##
	pushj p,setcur##
	pushj p,restac
	hrroi a,temp2
	dirst
	 jrst [hrroi a,[asciz/Not logged in/]
	       pushj p,dpsout
	       popj p,]
	hrroi a,temp2
	pushj p,dpsout
	popj p,

; routine to display a string
; call: pushj p,dpsout
;	a/pointer to ASCIZ string
dpsout:	tlc a,-1
	tlcn a,-1
	 hrli a,440700
	push p,a
	setz b,
dps1:	ildb c,a
	jumpe c,dps2
	aoja b,dps1

dps2:	pop p,a
	push sp,b
	push sp,a
	pushj p,saveac
	pushj p,dpystr##
	pushj p,restac
	popj p,

; routine to save acs
saveac:	exch p,acp
	movem 0,1(p)
	movei 0,2(p)
	hrli 0,1
	blt 0,16(p)
	add p,[16,,16]
	exch p,acp
	popj p,

; routine to restore acs
restac:	exch p,acp
	sub p,[16,,16]
	movsi 0,2(p)
	hrri 0,1
	blt 0,15
	move 0,1(p)
	exch p,acp
	popj p,

ls acp,1

; routine to map data pages
mapd:	pushj p,mapwrt		; see if we map write enabled
	movsi a,1
ifn ft10x,<
	hrroi b,[asciz/<SYSTEM>LEAFSV.PMAP;1/]
>
ifn ft20,<
	hrroi b,[asciz/SYSTEM:LEAFSV.PMAP.1/]
>
	gtjfn
	 jrst mapf
	move b,[440000,,202000]
	skipge wrtenb
	 tro b,100000		; do it write enabled
	openf
	 jrst mapf
	movem a,pmjfn
	hrlz a,a
	hrri a,300
	move b,[400000,,300]
	movsi c,100000
	skipge wrtenb
	 tlo c,040000		; write enabled
	movei d,600
mapd1:	pmap
	aoj b,
	caie d,(b)
	 aoja a,mapd1
	popj p,

mapf:	hrroi a,[asciz/Can't map data file... halting/]
	psout
	haltf
	jrst .-1
mapwrt:	hrroi a,[asciz/Write enable data pages? /]
	psout
mapwr1:	pbin
	caige a,"a"
	 skipa
	caile a,"z"
	 skipa
	  trz a,40
	cain a,"Y"
	 jrst [hrroi a,[asciz/es
/]
	       psout
	       setom wrtenb
	       popj p,]
	cain a,"N"
	 jrst [hrroi a,[asciz/o
/]
	       psout
	       setzm wrtenb
	       popj p,]
	movei a,7
	pbout
	jrst mapwr1

ls wrtenb,1

; routine to unmap data pages
unmapd:	seto a,
	move b,[400000,,300]
	movei d,600
unmap1:	pmap
	aoj b,
	caie d,(b)
	 jrst unmap1
	move a,pmjfn
	closf
	 jfcl
	popj p,

ls temp2,10
ls acstk,lacstk
ls pdstk,lpdstk
ls spstk,lspstk
ls pmjfn,1
ls wtime,1

	end