title SYSCHK Check up on system job
subttl Variables and stuff

a=1
b=2
c=3
d=4
n=5
obp=6
p=17

clic=10

define utyi ac
	camn obp,@toop
	 .hang
	camn obp,@tobep
	 jrst [	move obp,@tobbp
		jrst .-3]
	ildb ac,obp
	andi ac,377
termin

define syscal a,b
	.call [setz ? sixbit \a\ ? b ((setz)) ]
termin

subttl Startup

	loc 100
go:	move p,[-lpdl,,pdl-1]
	.suset [.runame,,winner]	; get name of winner using me
	skipe runflg
	 jrst setdon
	setom runflg
	move a,[-nsyms,,syms]
symlp:	move b,(a)
	.eval b,
	 .value
	movem b,(a)
	aobjn a,symlp
	move a,syscn
	movei b,1
	pushj p,makpag
	move a,toip	;make sure we have the pages the buffer pointers are in
	move b,nct
	pushj p,makpag
	move a,toop
	pushj p,makpag
	move a,tobep
	pushj p,makpag
	move a,tobbp
	pushj p,makpag
	.open [21,,'TTY]
	 .lose
setdon:	syscal cnsget,[	1000,, ? 2000,,vsz
			2000,,hsz ? 2000,,ltctyp]
	 .lose
	.close
	setzm vpos
	setzm hpos
	skipge n,@syscn
	 .value [asciz/:Cannot find the SYS consoleKILL
/]
	andi n,77
	syscal cnsget,[1000,,400000(n)
		       2000,,a ? 2000,,a ? 2000,,a]
	 .value
	movem a,ftctyp
	cain a,%tntv
	 .value [asciz/:The SYS console is a TV???KILL
/]
	.value [asciz/:vk /]

subttl Main SPYing routine
	movsi a,n
	iorm a,toip	;set up index field for indirection
	iorm a,toop
	iorm a,tobep
	iorm a,tobbp
	move a,@tobbp
	move b,@tobep
	sub b,a
	pushj p,makpag	;make sure we have the page(s) the buffer itself is in
	move obp,@toop	;have to start somewhere
	camn obp,@tobep
	 move obp,@tobbp
	ibp obp
bfrstp:	setzm bytcnt
	setzm msgbfr
	move d,[msgbfr,,msgbfr+1]
	blt d,msgbfr+37
	move d,[440700,,msgbfr]
	movei a,177	;rubout means no "Message from ..." nonsense
	idpb a,d
	aos bytcnt

lpe:	utyi a
	trze a,%txdis
	 jrst typd	;display or cursor pos, dispatch
	caile a,173
	 jrst lpe
typit:	aos hpos
	idpb a,d
	aos bytcnt
	jrst lpe

typd:	cail a,typdmx
	 jrst lpe
	jrst @typdtb(a)

typdtb:	tymov	;move cursor
	tymov1	;dummy for above
	LPE	;clear eof
	lpe	;clear eol
	LPE	;delete fwd
	lpe	;terminet motor on
	lpe	;   "       "   off
	tyecrl	;crlf to datapoints & imlacs
	lpe	;"nop for superduper image mode"
	LPE	;bs
	LPE	;lf
	tyecrl	;cr
	lpe	;output reset
	lpe	;quote
	tyefs	;fwd space
	tymov1	;move cursor new style
	LPE	;clear screen
typdmx==.-typdtb

tymov:	utyi c	;old vpos
	utyi b	;old hpos or 201
	utyi a	;new vpos
	utyi b	;new hpos
	skipe ftctyp
	 jrst tymov0
	sub a,c
	exch a,b
	idiv b,vsz
	move b,c
	exch a,b
tymov0:	camn a,vpos
	 jrst tymov2		;no change in vertical position
	movem a,vpos
	jrst tyecrl
tymov2:	movei a,40
	camge b,hpos
	 movem b,hpos		;oh gronk I don't know why this is
	camn b,hpos
	 jrst lpe
	idpb a,d
	aos bytcnt
	aos hpos
	soja b,tymov2+1
tymov1:	utyi a	;new vpos
	utyi b	;new hpos
	skipe ftctyp
	 jrst tymov0
	exch a,b
	idiv b,vsz
	move b,c
	exch a,b
	jrst tymov0

tyefs:	movei a,40
	jrst typit

tyecrl:	SETZM HPOS
	syscal open,[[.uao,,clic] ? ['CLI,,] ? winner ? ['HACTRN] ? 3000,,a]
	 jrst [	movei a,30.*2.
		.sleep a,	;RMS says this will be fixed soon...
		jrst .-1]
	move a,[440700,,msgbfr]
	syscal siot,[movei clic ? a ? bytcnt]
	.LOSE
	.close clic,
	jrst bfrstp

;get the same page the sys job has in its page whose address is in a, # words in b
makpag:	andi a,-1
	push p,a
	ash a,-10.
	movem a,cblk1	;get first page
	.call cblk
	 .value
	pop p,a
	addi a,-1(b)	;address of last word
	ash a,-10.
	camn a,cblk1
	 popj p,
	movem a,cblk1
	.call cblk	;crosses page boundary, get second page
	 .value
	popj p,

subttl Data area

cblk:	setz
	sixbit \CORBLK\
	1000,,210000	;read access, fail if can't
	[-1]		;put page in self
	cblk1
	setzi 400000	;get from sys job
cblk1:	0		;gets -#pages,,page # to start
bytcnt:	0		;count of bytes
msgbfr:	block 100	;allow plenty of space for message
ltctyp:	0		;local tctyp
ftctyp:	0		;foreign tctyp
vsz:	0		;local vertical screen size
hsz:	0		;  "   horizontal  "    "
vpos:	0		;current (hopefully) local vertical cursor pos
hpos:	0		;current (hopefully) local horizontal cursor pos
runflg:	0		;nonzero if setup done already
winner:	0		;who is using me

syms:
irps x,,[NCT TOBEP TOBBP TOIP TOOP SYSCN]
x:	squoze 0,x
termin
nsyms==.-syms
consta ? variab
lpdl==20
pdl:	block lpdl
patch":	block 100

end go