	.title	K1180S	Server things unique to the exec we are using
	.ident	/2.0.06/
	.include	/SY:[1,2]COMMON.MAC/
	.include	/IN:K11MAC.MAC/
	.iif ndf, xrb	, .error ; INCULDE for [1,2]COMMON.MAC failed
	.iif ndf, k11inc, .error ; INCLUDE for IN:K11MAC.MAC failed
	.title	K1180S

	.psect	$code
	.enabl	lc
	.enabl	gbl

	.macro	clrfqb
	call	$clrfq
	.endm	clrfqb

	.macro	clrxrb
	call	$clrxr
	.endm	clrxrb



;	do a SYSTAT (also host commands)
;
;	01-Feb-84  11:11:34  Brian Nelson
;
;	We have several options for doing the remote WHO command.
;	First of all, we could spawn a job on a PK (or VT for M+)
;	and get  the output sent to a disk file and then send the
;	disk file over to the  reqesting Kermit.  This would have
;	the  advantage of keeping the command consistant with the
;	system managers desires.
;	The other option,  of course, is to do it ourself via the
;	appropiate  monitor directives  to get  that information.
;	That  option is really  only available for RSTS since RSX
;	does not have the directives needed to get that info from
;	the exec.  For now, I will  use the second option.  To be
;	used,  Kermit must run with  temporary privileges (RSTS).
;	To  patch out,  add (at task build time) the following to
;	the tkb command file.
;
;	GBLPAT=K11WHO:SYSTAT+0:240
;
;	It would, of course, be fairly straight forward to do the
;	SYSTAT  on a PK as I already  have the code to log output
;	to disk.
;
;
;	input:	@r5	value of channel to do i/o on, zero --> terminal
;	output:	r0	rsts error code if any.


	.macro	dosys	jobnum	,type
	mov	type	,-(sp)
	mov	jobnum	,-(sp)
	call	.dosys
	cmp	(sp)+	,(sp)+
	.endm	dosys



	.sbttl	the real work of systat

systat::br	5$			; skip the error exit
	mov	#10.	,r0		; return protection violation
	return				; bye

5$:	save	<r1,r2,r3,r4,r5>	; save all registers please
	sub	#120	,sp		; allocate a text buffer
	call	getprv			; we need temp privs
	mov	#512.	,xrb+0		; try a peek to see if we have
	.peek				; priv's to run with
	movb	firqb	,r0		; well ?
	bne	100$			; none, so exit please

	clr	r4			; index # of job to do


10$:	mov	sp	,r3		; point to our local buffer now
	inc	r4			; jobnumber := jobnumber+1
	dosys	r4	,#0		; do the uu.sys part 0 please
	tstb	r0			; did it work ?
	beq	20$			; yes
	cmpb	r0	,#10.		; no job of such number present?
	beq	80$			; yes, just do the next job then
	br	100$			; no, exit then as we are all done
20$:	tstb	firqb+5			; is the job we found attached ?
	bmi	80$			; yes, skip it then
	deccvt	r4,r3,#3		; convert job number to ascii
	add	#3	,r3		; and point to end of the string
	movb	#40	,(r3)+		; stuff a space in
	movb	#40	,(r3)+		; stuff a space in
	call	cvtppn			; convert the ppn next
	movb	#40	,(r3)+		; again a space please
	call	cvtkb			; get the kb number next
	mov	#firqb+22,r1		; get the program name next
	call	rad			; convert to ascii and fix pointer
	dosys	r4	,#1		; get the current size now
	movb	firqb+16,r0		; where it returned the size
	deccvt	r0,r3,#5		; convert with at least 3 spaces
	add	#5	,r3		; move the pointer right along
	movb	#'K	,(r3)+		; the size please
	movb	#40	,(r3)+		; spaces again
	movb	#40	,(r3)+		; spaces again
	movb	#40	,(r3)+		; spaces again
	dosys	r4	,#0		; get the info part zero back
	mov	#firqb+34,r1		; and the current RTS name now
	call	rad			; convert to ascii and fix pointer
	clrb	@r3			; all done at last
	mov	sp	,r3		; point back to the buffer
	call	doio			; do the i/o at last
80$:	br	10$			; next please


100$:	cmpb	r0	,#18.		; end of the table ?
	bne	110$			; no
	clr	r0			; yes
110$:	add	#120	,sp		; pop the local buffer
	unsave	<r5,r4,r3,r2,r1>	; pop temps and exit
	call	drpprv			; please do this
	return




	.sbttl	utilities and the actual i/o

doio:	tst	@r5			; channel zero today ?
	bne	10$			; no, assume disk then
	print	r3
	print	#200$
	br	100$
10$:	strlen	r3			; try to a disk file now
	calls	putrec	,<r3,r0,@r5>	; write to the passed LUN
100$:	return

200$:	.byte	cr,lf,0
	.even


rad:	calls	rdtoa	,<r3,(r1)+>	; common code to to rad50 cvt
	add	#3	,r3		; pointer := pointer + 3
	calls	rdtoa	,<r3,(r1)+>	; common code to to rad50 cvt
	add	#3	,r3		; pointer := pointer + 3
	return



	.sbttl	misc utilities

cvtppn:	save	<r0,r1>			; save temps please
	sub	#20	,sp		; convert ppn to ascii next
	mov	sp	,r0		; a pointer to the ppn
	clr	r1			; get the project number now
	bisb	firqb+27,r1		; ok
	bne	10$			; if <> 0 then a real account
	mov	#200$	,r1		; if eq 0 then not logged it yet
	br	20$			; copy over *,*
10$:	deccvt	r1,r0,#3		; convert it to decimal
	add	#3	,r0
	movb	#',	,(r0)+		; stuff a comma in please
	clr	r1			; get the programmer number now
	bisb	firqb+26,r1		; ok
	deccvt	r1,r0,#3		; convert it to decimal
	mov	sp	,r1		; point to the buffer now
20$:	movb	#40	,(r3)+		; stuff a space into our result
	mov	#7	,r0		; seven characters to copy
30$:	movb	(r1)+	,(r3)+		; and copy the rest of it
	sob	r0	,30$		; simple
	movb	#40	,(r3)+		; stuff a space into our result
	movb	#40	,(r3)+		; stuff a space into our result
	movb	#40	,(r3)+		; stuff a space into our result
	add	#20	,sp		; pop the local buffer
	unsave	<r1,r0>
	return
	
200$:	.asciz	/  *,  */
	.even

cvtkb:	save	<r0,r1>			; convert kb number to ascii
	sub	#10	,sp		; allocate a local buffer
	mov	sp	,r1		; point to it
	movb	firqb+5	,r0		; KB number to convert
	movb	#'K	,(r3)+		; insert a header
	movb	#'B	,(r3)+		; simple
	deccvt	r0,r1,#3		; can't ever be more than 127
	mov	r3	,-(sp)		; saev the output pointer now
	mov	#3	,r0		; three at most to copy over
10$:	cmpb	@r1	,#40		; a space present ?
	beq	20$			; yes, please ignore it
	movb	@r1	,(r3)+		; copy it over at last
20$:	inc	r1			; next ch please
	sob	r0	,10$		; simple
	movb	#40	,(r3)+		; insert some spaces now
	movb	#40	,(r3)+		; insert some spaces now
	movb	#40	,(r3)+		; insert some spaces now
	movb	#40	,(r3)+		; insert some spaces now
	mov	(sp)+	,r3		; restore the old pointer
	add	#5	,r3		; say we copied 5+2 characters over
	add	#10	,sp		; pop the local buffer and exit
	unsave	<r1,r0>			; pop registers
	return
	


$clrxr:	save	<r0>
	mov	#xrb	,r0
10$:	clr	(r0)+
	cmp	r0	,#xrb+14
	blos	10$
	unsave	<r0>
	return



$clrfq:	save	<r0>
	mov	#firqb	,r0
10$:	clr	(r0)+
	cmp	r0	,#firqb+36
	blos	10$
	unsave	<r0>
	return




.dosys:	clrfqb				; clear the firqb out first
	movb	#uu.sys	,firqb+fqfun	; do a systat call to RSTS
	movb	2(sp)	,firqb+4	; job number to do it for
	movb	4(sp)	,firqb+5	; which type (0 or 1)
	.uuo				; simple
	movb	firqb	,r0		; return with error code in r0
	return				; bye
	.sbttl	do the server C command for RSTS/E version 8

;	13-Apr-84  13:15:50  Brian Nelson
;
;	input:	@r5	address of command string
;		2(r5)	LUN to send the output to, zero implies TT:
;	output:	r0	error code (rms or RSTS/E)
;
;	Note:	This is a very SIMPLE version of the code I wrote
;		several years ago to do complete PK handling.  In
;		this version, we NEVER try to read anything  from
;		the users keyboard, nor do we EVER write anything
;		to it  since it is assumed that we are supporting
;		the server host command packet stuff. Any attempt
;		by the invoked CCL/DCL command to read input will
;		cause the program (and job) to be aborted.


	.iif ndf, corcom, corcom = 460

	.psect	pkbuff	,rw,lcl,rel,con,d

pkbuff:	.blkb	200
pkbufp:	.word	0
pkbufs:	.word	0
jobnum:	.word	0
	.even
pkbsiz	=	200

	.sbttl	the real work of sercmd
	.psect	$code

sercmd::clr	pkbufs			; insure no data is left in buffer
	mov	#jfsys	,xrb+0		; get temp privs back
	.set				; simple to do
	call	openpk			; find an available PK
	tst	r0			; perhaps we could not get one
	bne	100$			; r0 will have RSTS/E error code
	call	logv8			; get logged in on the PK
	tst	r0			; if it fails, it's the error code
	bne	100$			; oops
	mov	r1	,jobnum		; save the jobnumber please
	movb	#'c&37	,-(sp)		; no, force a control C
	call	putpk			; simple
	mov	#2	,xrb+0		; wait a moment
	.sleep				; simple. any i/o will wake us up
5$:	call	getpk			; eat the result of the control C
	tst	r0			; loop until eofeof error (11)
	beq	5$			; go back for more
	mov	#10	,r1		; wait for kmon
10$:	mov	jobnum	,-(sp)		; simple
	call	jobsts			; waiting for KB input now ?
	tst	r0			; well?
	bmi	15$			; ok
	mov	#1	,xrb+0		; wait a moment
	.sleep				; simple. any i/o will wake us up
	sob	r1	,10$		;

15$:	mov	@r5	,-(sp)		; do it
	call	sendcmd			; ok
	mov	#10	,xrb+0		; wait a little while before checking
	.sleep				; job status. any i/o will reset this


20$:	call	getpk			; now get the result of the command
	tst	r0			; did it work ?
	bne	30$			; no, find out why then
	call	output			; dump the ch read to somewhere
	br	40$
30$:	mov	jobnum	,-(sp)		; the job number
	call	jobsts			; find out what's happening here
	tst	r0			; if ge, then it's just running
	bmi	90$			; it's waiting for input or all done
	mov	#1	,xrb+0		; if ok, take a one second nap
	.sleep				; simple
40$:	br	20$			; try to get some more data now

90$:	mov	#377	,r0		; a fake error to return

100$:	mov	#jfsys	,xrb+0
	.clear
	call	killpk
	return


	.sbttl	where to put the output

output:	tst	2(r5)			; the LUN to use
	bne	10$			; a disk
	movb	r1	,-(sp)		; the terminal
	mov	sp	,r1		; a pointer
	print	r1	,#1		; dump it
	tst	(sp)+			; pop the buffer and exit
	br	100$			; bye
10$:	movb	r1	,r0		; rms output today
	mov	2(r5)	,r1		; the channel
	call	putcr0			; simple to do
100$:	return				; bye


	pk.lun	=	12.


openpk:	mov	r1	,-(sp)		; save this one today
	clr	r1			; start at PK0:
10$:	clrfqb				; insure no defaults
	movb	#opnfq	,firqb+fqfun	; open the thing up now
	movb	#pk.lun*2,firqb+fqfil	; channel number times 2
	movb	r1	,firqb+fqdevn	; device unit number please
	movb	#377	,firqb+fqdevn+1	; unit is for real here
	mov	#"PK	,firqb+fqdev	; device name also
	calfip				; try to open it up
	movb	firqb	,r0		; get the rsts error code if any
	beq	100$			; all is well
	cmpb	r0	,#6		; invalid device ?
	beq	100$			; yes exit with this error
	inc	r1			; else try again
	br	10$			; next please
100$:	mov	(sp)+	,r1		; pop r1 and exit
	return

	.sbttl	create a logged in job for the PK (version 8 only)

;	Creates a job under the current account for the PK that's
;	open on PK.LUN.
;
;	returns: r0	rsts error code
;		 r1	created job number


logv8:	movb	#uu.sys	,firqb+fqfun	; get the user's default RTS please
	clr	firqb+4			; current job, systat part 0
	.uuo				; simple, can't fail either
	mov	firqb+26,-(sp)		; save the user's account number
	mov	firqb+32,-(sp)		; save the user's defkbm
	mov	firqb+30,-(sp)		; save the user's defkbm
	clrfqb				; now get the kb number for the PK
	movb	#uu.fcb	,firqb+fqfun	; get the DDB returned for it
	movb	#pk.lun	,firqb+fqfun+1	; channel number that we want
	.uuo				; default to GET DDB info
	movb	firqb+14,-(sp)		; save it
	asrb	(sp)			; not times two please

	clrfqb				; version 8, enter a run time system
	mov	#firqb+fqfun,r0		; at the p.new entry point
	movb	#uu.job	,(r0)+		; create a job function for fip
	movb	#20!100!200,(r0)+	; create logged in @ defkbm always
	movb	(sp)+	,(r0)+		; kb number to attach to job
	clr	(r0)+			; unused field
	mov	(sp)+	,(r0)+		; user's default run time system
	mov	(sp)+	,(r0)+		; both rad50 words please
	clr	(r0)+			; unused field
	mov	(sp)+	,@r0		; account number also
	bisb	#40	,firqb+4	; set flag for account to login to
	movb	corcom	,-(sp)		; save this please
	clrb	corcom			; core common is also passed
	.uuo				; try to create the job now
	movb	(sp)+	,corcom		; restore first byte of core common
	movb	firqb+4	,r1		; created job number please
	asr	r1			; but not times two
	movb	firqb	,r0		; did it work?
	bne	110$			; no
	tstb	firqb			; huh
	clc				; yes, flag success and exit
	return				; bye

110$:	sec				; job creation failed, exit
	return				; set a flag and return


	
	.sbttl	pkread/write	i/o for the pk


getpk:	clrxrb				; clear xrb
	tst	pkbufs			; any buffered data left to get?
	bne	10$			; no
	call	200$			; reload the buffer please
	tst	r0			; get anything ?
	bne	100$			; no, exit
10$:	mov	pkbufp	,r0		; yes, get a pointer to the buffer
	clr	r1			; avoid sign extension
	bisb	pkbuff(r0),r1		; get the ch now
	inc	pkbufp			; advance the pointer for next time
	dec	pkbufs			; one less character left to get
	clr	r0			; say it worked
100$:	return				; bye

200$:	clr	pkbufp			; no data, clear buffer pointer
	clrxrb				; no defaults
	mov	#pkbsiz	,xrb+xrlen	; as many as we can grab
	mov	#pkbuff	,xrb+xrloc	; buffer location
	movb	#pk.lun*2,xrb+xrci	; channel #
	inc	xrb+xrtime		; wait at most one second
	.read				; read from pk
	movb	firqb	,r0		; get any error codes
	bne	210$			; no
	mov	xrb+xrbc,pkbufs		; it worked, init the bytes left
210$:	return				; back to work...


putpk:	clrxrb				; no odd things please
	inc	xrb+xrlen		; one ch to do
	mov	sp	,xrb+xrloc	; buffer location
	add	#2	,xrb+xrloc	; off by one
	mov	#1	,xrb+xrbc	; byte count
	movb	#pk.lun*2,xrb+xrci	; channel #
	mov	#9.	,xrb+xrmod	; record 9%
	.write				; write to pk
	movb	firqb	,r0		; result
	mov	(sp)+	,(sp)		; pop ch that we wrote
	return				; back to work...


	.sbttl	pk utilities


sendcmd:mov	r1	,-(sp)
	mov	4(sp)	,r1		; command address to send to PK
10$:	tstb	@r1			; done yet ?
	beq	100$			; yes, exit
	movb	(r1)+	,-(sp)		; loop until a null is found
	call	putpk			; simple
	br	10$			; next please
100$:	mov	(sp)+	,r1		; pop register we used
	mov	(sp)+	,(sp)		; pop address of string and exit
	mov	#cr	,-(sp)		; finish with a carriage return
	call	putpk			; simple
	return
	

waitpk:	clrxrb				; no odd things please
	mov	sp	,xrb+xrloc	; buffer location
	movb	#pk.lun*2,xrb+xrci	; channel #
	mov	#6.	,xrb+xrmod	; record 2+4
	.write				; write to pk
	tstb	firqb			; result
	beq	100$			; it's ready for a command
	cmpb	firqb	,#28.		; need a control C?
	beq	100$
	sec				; it's not ready	
	return
100$:	clc
	return				; back to work...


killpk:	clrxrb				; no odd things please
	mov	sp	,xrb+xrloc	; buffer location
	movb	#pk.lun*2,xrb+xrci	; channel #
	mov	#20	,xrb+xrmod	; record 2+4
	.write				; write to pk
	clrfqb				; now close it up
	movb	#clsfq	,firqb+fqfun	; simple
	movb	#pk.lun*2,firqb+fqfil	; channel to do
	calfip				; do it
	return				; back to work...

	
	.sbttl	jobsts	return status of the controlled job


;	input:	2(sp)	job number 
;	output:	r0	< 0 then kb stall, 0 waiting for tt output, > 0 running
;
;	This will be called to determine when the spawned job should
;	be aborted.
;
;	r0	= -2	the job is logged out, waiting for input or
;			in a kmon wait
;	r0	= -1	timeout
;	r0	= 0	job is waiting for output to the PK
;	r0	> 0	job is in a run state

	.jbstat	=	12
	.jbwait	=	14
	.iif ndf, j2con	,j2con	=	4
	.iif ndf, j2nopr,j2nopr	=	10000
	.iif ndf, js.kb	,js.kb	=	2
	.iif ndf, js.tel,js.tel	=	4000


jobsts:	mov	r1	,-(sp)		; we may access these here
	mov	r2	,-(sp)		; save these also
	movb	#uu.sys	,firqb+fqfun	; for looking up a job
	movb	6(sp)	,firqb+fqfun+1	; job number to do
	movb	#1	,firqb+fqfun+2	; part two to do please
	.uuo				; do it
	tstb	firqb			; did it work ?
	bne	90$			; no, return abort please
	bit	#jfnopr	,firqb+6	; logged in ?
	bne	90$			; no, return abort then
	mov	firqb+.jbstat,r1	; get the current jbstat word
	mov	firqb+.jbwait,r2	; get the current jbwait word
	com	r1			; and get the and of the two
	bic	r1	,r2		; if result <> 0 then job is
	bne	10$			; running ok
	bit	#js.kb	,firqb+.jbwait	; not running, stalled for kb input?
	bne	90$			; yes, abort the job then
	bit	#js.tel	,firqb+.jbwait	; waiting for tt output
	bne	80$			; yes

10$:	mov	firqb+34,xrb+0		; no, check the elapsed time please
	add	#j2con	,xrb+0		; simple
	.peek				; do it
	tstb	firqb			; did that work ?
	bne	90$			; no, die
	cmp	xrb+0	,#300		; allow three minutes at most
	bhis	95$			; no, die
	mov	#1	,r0		; all is well, exit
	br	100$

80$:	clr	r0			; job is waiting on tt output
	br	100$			; bye

90$:	mov	#-2	,r0		; waiting on KB or logged out
	br	100$			; bye

95$:	mov	#-1	,r0		; timeout
	br	100$			; exit

100$:	mov	(sp)+	,r2		; exit
	mov	(sp)+	,r1
	mov	(sp)+	,(sp)		; pop parameter and exit
	return

	.end
