	.title	bspawn
	.enabl	lc
	.nlist	bex
;
;
;	system macros needed
;
;
	.mcall	rcst$,rcvd$,spwn$,alun$s,srda$s,dir$,mrkt$s
	.mcall	wtse$s,sdat$s,ustp$s,astx$s,qiow$s,exit$s
	.mcall	fdbdf$,fdat$a,fdop$a,nmblk$,fsrsz$,finit$,get$
	.mcall	put$,ofnb$,delet$,close$
	.mcall	swstk$
	.page
	.sbttl	local definitions
fillun=1			; lun for file operations
ttylun=2			; lun for terminal messages
srlun=3				; lun for send/receive driver
lf=12				; line feed character
cr=15				; carriage return character
qioefn=1			; event flag for use in terminal messages
ok=0				; value of OK for tools
filerr=-1			; error return for opening file error
fbterr=-2			; error return for free BT error
argerr=-3			; error return for sending arguments error
spnerr=-4			; error return for spawning subtask error
	.page
	.sbttl	local macros
;
;
;	local macros
;
;
;	getlin gets an FCS record into buf with length bufl
;
;
	.macro	getlin	buf,bufl
	mov	#'buf,r1
	get$	#fdb,r1,#'bufl
	add	f.nrbd(r0),r1
	clrb	(r1)
	.endm	getlin
;
;
;	copy copies 0-byte terminated buffer buf into string
;	pointed to by r0
;
;
	.macro	copy	buf
	mov	#'buf,r1
	call	scopy
	.endm	copy
;
;
;	macro for debugging purposes
;
;
	.macro	debug	buf
	mov	#'buf,r1
	call	errmsg
	.endm	debug
;
;	error macro
;
	.macro	error	msg,reason
	mov	#'reason,r0
	mov	#'msg,r1
	call	errmsg
	jmp	sendit
	.endm	error
;
;	fatal error macro
;
	.macro	ferror	msg
	mov	#'msg,r1
	call	errmsg
	jmp	exit
	.endm	ferror
	.page
	.sbttl	local impure data
found:	.blkw	1			; switch if "BT" DCB found
loaded:	.blkw	1			; switch if "BT" driver loaded
dcb:	.blkw	1			; location for address of DCB
ucb:	.blkw	1			; location for assigned UCB
tcb:	.blkw	1			; location for TCB of requestor
offset:	.blkw	1			; location for current offset
loccmd:	.blkw	1			; switch if "local" command
curesb:	.blkw	1			; location to hold ESB addr of AST
ucbptr:	.blkw	b$$t11			; storage for UCB addresses
errsb:	.blkw	<8.*b$$t11>		; storage for exit status blocks
eb=errsb
esbptr:					; array of ESB addresses
	.rept	b$$t11
	.word	eb			; address of ESB
eb=eb+16.				; bump to next ESB
	.endr
reqtsk:					; task name of requestor kept here
	.rept	b$$t11
	.word	0,0
	.endr
number:	.blkb	10.			; buffer to format number into
bspawn:	.rad50	"BSPAWN"		; name of this task
rcvbuf:					; 30 byte buffer for received msgs
sndtsk:	.blkw	2			; first 2 words have sender's name
sndbuf:	.blkw	13.			; actual data area for sends and rcvs
rcstdb:	rcst$	,rcvbuf			; DPB for receive data or stop
rcvddb:	rcvd$	,rcvbuf			; DPB for receive data
spwndb:	spwn$	MCR...,,,,,,spnast,,mcrlin,,,BT	; DPB for spawn call
					; BT is the background terminal for
					; which the loadable driver code is
					; on the distribution
mcrlin:	.blkb	80.			; buffer for MCR command line
img:	.blkb	40.			; buffer to receive the image file
imgl=.-img
arg:	.blkb	512.			; buffer to receive the arg string
argl=.-arg
;
;
;	data blocks and declarations for FCS
;
;
fdb:	fdbdf$				; define FDB
	fdat$a	r.var,fd.cr		; variable length recs, list cctl
	fdop$a	fillun			; lun to use in FCS ops

	.if ndf	SRDRV			; if not using send/receive driver

dnam:	nmblk$	,ARG			; default extension on arg file

	.endc

	fsrsz$	1			; generate FCS buffer space for 1 file
fdsc:	.word	devl			; data-set descriptor
	.word	dev
	.word	dirl
	.word	dir
fill:	.word	0
	.word	tmp
dev:	.ascii	"ST0:"
devl=.-dev
dir:	.ascii	"[105,3]"
dirl=.-dir
tmp:	.blkb	20.			; block to scopy filename into
tsknam:	.ascii	".B"
nhigh:	.byte	0
nlow:	.byte	0
	.ascii	".0"
	.byte	0
	.even
	.page
	.sbttl	pure data sections
null:	.asciz	""
local:	.asciz	"local"
inst:	.asciz	"ins "
taskst:	.asciz	"/task="
final:	.asciz	"/pri=25./run=rem"
fndmsg:	.asciz	"Cannot find BT device in device list."
lodmsg:	.asciz	"Driver for BT not loaded."
filmsg:	.asciz	"Error opening file from requestor."
nbtmsg:	.asciz	"No free BT units available for background task."
argmsg:	.asciz	"Error queuing arguments for sub-task."
spnmsg:	.asciz	"Error spawning background task."
	.even
	.page
	.sbttl	initbt - initialize "BT" information
;
;	this routine, called when BSPAWN first comes to life, performs
;	the following functions:
;
;	1. switches to the system stack and searches for the "BT" DCB
;	2. if found, then places the addresses of all UCB's in the
;	   array ucbptr
;	3. returns to the user stack
;
;	inputs:
;		none
;	outputs:
;		found	YES/NO (1/0) if the DCB for "BT" is found
;		loaded	YES/NO (1/0) if the "BT" driver is loaded in memory
;		dcb	address of "BT" DCB
;		ucbptr	addresses of "BT" UCB's
;
	.enabl	lsb
initbt:
	clr	found			; "BT" not found
	clr	loaded			; "BT" not loaded
	swstk$	40$			; switch to system state
	mov	#$devhd,r0		;# address of device listhead
10$:					;#
	mov	(r0),r0			;# get next DCB address
	beq	30$			;# if == 0, "BT" not found
	cmp	#"BT,d.nam(r0)		;# device name "BT"?
	bne	10$			;# NO
	inc	found			;# indicate "BT" found
	tst	d.pcb(r0)		;# driver loaded?
	beq	30$			;# NO
	inc	loaded			;# indicate driver loaded
	mov	r0,dcb			;# save DCB address
	mov	d.ucb(r0),r1		;# get address of first UCB
	mov	#b$$t11,r2		;# number of UCB's
	mov	#ucbptr,r3		;# address of pointer array
20$:					;#
	mov	r1,(r3)+		;# copy UCB address
	bis	#u2.log,u.cw2(r1)	; mark device logged off
	add	d.ucbl(r0),r1		;# bump to next UCB address
	sob	r2,20$			;# decrement counter and do again
30$:					;#
	return				;# return to user state
40$:
	return				; return to caller
	.page
	.sbttl	getmsg - get next request
;
;	this routine gets the next request for a background spawn.
;	these requests are communicated via send/receive packets.
;	we do a receive data or stop, and an additional receive data
;	if we are stopped and then unstopped by the receive data AST
;
	.enabl	lsb
getmsg:
	dir$	#rcstdb		; receive data or stop
	cmp	#1,$dsw		; receive data?
	beq	10$		; YES
	dir$	#rcvddb		; get data that triggered AST
10$:
	return
	.page
	.sbttl	opnfil - open file with bspawn info and read it
;
;	this routine opens the file named in the request packet in order
;	to fetch the image and argument strings.  If any of the steps in
;	this process fail, the c bit is retured set, otherwise it is
;	cleared.
;
;	inputs:
;		file name in sndbuf
;
;	outputs:
;		the file is opened, the image stored in img, the arguments
;		in arg, and the file is deleted
;
	.enabl	lsb
opnfil:
;
;	first build data-set descriptor
;
	mov	#tmp,r0				; buffer for file name
	copy	sndbuf				; copy name into it
	mov	#tmp,r0				; crunch to upper case
	call	upper				; crunch to upper case
	mov	#tmp,r1				; address again
	call	length				; calculate length
	mov	r0,fill				; place length in data-set
;
;	open file for reading
;
	mov	#fdb,r0				; FDB address
	mov	#fdb+f.fnb,r1			; FNB address
	mov	#fdsc,r2			; data-set desc address
	clr	r3				; no default FNB
	call	.parse				; parse file name
	bcs	10$				; c set => parse error
	ofnb$	#fdb,#fo.rd			; open file at read access
	bcs	10$				; c set => error
;
;	now read the records and delete the file
;
	getlin	img,imgl			; get image name
	getlin	arg,argl			; get arguments
	delet$	#fdb				; delete file after closing
	clc					; c clear => success
10$:
	return
	.page
	.sbttl	getfbt - get free BT unit
;
;	this routine searches for a free BT unit.  If found, it is
;	logged in under the UIC of the requestor, and the task name
;	of the background task is formatted and rad50'ed.
;	if no units are available, the c bit is set, else it is cleared
;
	.enabl	lsb
getfbt:
	mov	#reqtsk,r0		; starting address of owner tasks
	mov	#b$$t11,r1		; initialize counter
	mov	#maxbck,r2		; maximum back tasks/requestor
	mov	#sndtsk,r3		; address of task name to find
	clr	tcb			; initialize task not found
	swstk$	2$			; switch to system state
3$:
	cmp	(r0),sndtsk		; first half match?
	bne	4$			; NO
	cmp	2(r0),sndtsk+2		; second half match?
	bne	4$			; NO
	dec	r2			; increment number of background tasks
	beq	1$			; if == 0, then requestor has limit
4$:
	add	#4,r0			; bump pointer to next entry
	sob	r1,3$			; decrement and try again
	call	$srstd			;# search for task in STD
	bcs	1$			;# c set => not found
	mov	r0,tcb			;# save TCB address
1$:					;#
	return				;# return to user state
2$:
	mov	tcb,r0			; get TCB address
	beq	40$			; if == 0, return error
	mov	t.ucb(r0),r0		; have UCB address of requestor's TI:
	clr	r2			; initialize offset
	mov	#b$$t11,r3		; initialize counter
10$:
	mov	ucbptr(r2),r1		; get next BT UCB address
	bit	#u2.log,u.cw2(r1)	; is it logged on?
	bne	20$			; NO
	add	#2,r2			; bump offset by 2
	sob	r3,10$			; decrement counter and go again
	br	40$			; return error
20$:
	bic	#u2.log!u2.prv,u.cw2(r1); log it on and init non-priveleged
	bit	#u2.prv,u.cw2(r0)	; is TI: priveleged?
	beq	30$			; NO
	bis	#u2.prv,u.cw2(r1)	; make "BT" priveleged
30$:
	mov	u.luic(r0),u.luic(r1)	; login UIC
	mov	u.uic(r0),u.uic(r1)	; default UIC
	mov	r1,ucb			; save ucb address for errmsg
	mov	r2,offset		; save offset for spntsk
	clc				; clear c bit for multiply
	rol	r2			; multiply by 2
	mov	sndtsk,reqtsk(r2)	; copy requestor task name
	mov	sndtsk+2,reqtsk+2(r2)	;
;
;	now format the unit number in octal for the task name
;
	mov	#number,r0		; buffer to format into
	movb	u.unit(r1),r1		; number to format
	mov	#1,r2			; desire leading zeros
	call	$cbtmg			; convert byte to octal
	movb	-(r0),nlow		; copy low byte into task name
	movb	-(r0),nhigh		; copy high byte
	clc				; c clear => success
	br	50$
40$:
	sec				; c set => error
50$:
	return
	.page
	.sbttl	fmtmcr - routine to format the MCR command line
;
;	this routine formats the MCR command line for the spawn directive.
;	if the image is "local", it copies the arguments to mcrlin and sets
;	loccmd = 1, else it sets loccmd to 0 and formats the INS command for
;	spawning the tool.
;
	.enabl	lsb
fmtmcr:
	mov	#mcrlin,r0			; destination buffer
	copy	arg				; assume local
	mov	#1,loccmd			;
	mov	#local,r0			; streq(local,image) == YES?
	mov	#img,r1				;
	call	streq				;
	bcc	10$				; YES
	clr	loccmd				; not local
	mov	#mcrlin,r0			; destination buffer
	copy	inst				; concatenate strings
	copy	img
	copy	taskst
	copy	tsknam
	copy	final
10$:
	return
	.page
	.sbttl	sndarg - send arguments to subtask
;
;	this routine sends the arguments to the task prior to spawning it
;
	.enabl	lsb
sndarg:
	clc					; initially c bit clear
	tst	loccmd				; local?
	bne	10$				; YES, no args to send

	.if df	SRDRV				; use send/receive driver

	alun$s	#srlun,#"SR,#0			; assign lun to send/receive
	bcs	10$				; c set => error
	mov	#tsknam,r0			; address to start conversion
	mov	#1,r1				; don't stop at periods
	call	$cat5				; convert chars 1-3
	mov	r1,r4				; save value
	mov	#1,r1				; do again
	call	$cat5				; convert chars 4-6
	mov	r1,r5				; save it
	mov	#arg,r1				; address of buffer
	call	length				; length in r0
	qiow$s	#io.wlb,#srlun,#qioefn,,,,<r1,r0,r4,r5,#0,#1>	; send args

	.iff					; use argument file

	mov	#4,fill				; set up data-set descriptor
	mov	#tmp,r0				;
	movb	#'B,(r0)+			;
	movb	nhigh,(r0)+			;
	movb	nlow,(r0)+			;
	movb	#'0,(r0)			;
	mov	#fdb,r0				; FDB for parse
	mov	#fdb+f.fnb,r1			; FNB for parse
	mov	#fdsc,r2			; data-set desc for parse
	mov	#dnam,r3			; default FNB
	call	.parse				; parse file name
	bcs	10$				; c set => error
	ofnb$	,#fo.wrt			; open file at write access
	bcs	10$				; c set => error
	mov	#arg,r1				; address of buffer
	call	length				; length in r0
	mov	r0,r2				; length in r2
	put$	#fdb,r1,r2			; write record
	close$					; close the file

	.endc

10$:
	return
	.page
	.sbttl	spntsk - spawn background task
;
;	this routine spawns the background task.
;
	.enabl	lsb
spntsk:
	mov	#mcrlin,r1			; MCR buffer address
	call	length				; calculate length
	mov	offset,r2			; get offset into esbptr
	add	#esbptr,r2			; (r2) is exit status bl addr
	mov	#spwndb,r3			; address of spwn DPB
	mov	(r2),s.pwes(r3)			; exit status bl addr
	mov	r0,s.pwcl(r3)			; length of command line
	mov	ucb,r2				; get "BT" UCB address
	movb	u.unit(r2),r2			; get unit number
	mov	r2,s.pwvt(r3)			; unit number of "BT"
	dir$	#spwndb				; spawn task
	bcs	10$				; c set => error
	mov	#sndbuf,r0			; get send buffer address
	movb	#ok,(r0)+			; return OK status
	copy	tsknam				; return task name
10$:
	return
	.page
	.sbttl	sndmsg - send response to user
;
;	this routine sends the response in sndbuf to the requestor
;
	.enabl	lsb
sndmsg:
	sdat$s	#sndtsk,#sndbuf		; send message to requestor
	ustp$s	#sndtsk			; unstop waiting task
	return
	.page
	.sbttl	spnast - exit ast routine for subtasks
;
;	this routine is entered when one of the background tasks spawned
;	by BSPAWN exits.  This routine simply searches through its array
;	of error status block addresses, in an effort to find the one that
;	caused the AST (passed on the bottom of the stack).  If found, the
;	UCB for that "BT" unit is located, and the u2.log bit is set to
;	indicate that the "terminal" is not logged in (i.e. free for use)
;
	.enabl	lsb
spnast:
	mov	(sp)+,curesb			; save current ESB address
	mov	r0,-(sp)			; save registers
	mov	r1,-(sp)			;
	clr	r0				; initialize offset
	mov	#b$$t11,r1			; initialize counter
10$:
	cmp	esbptr(r0),curesb		; is it this ESB?
	beq	20$				; YES
	add	#2,r0				; increment offset
	sob	r1,10$				; decrement counter and go again
	br	30$				; unknown sub-task
20$:
	mov	ucbptr(r0),r1			; have "BT" UCB address
	bis	#u2.log,u.cw2(r1)		; log "terminal" off
	clc					; clear c bit for multiply
	rol	r0				; multiply by 2
	clr	reqtsk(r0)			; clear task name
	clr	reqtsk+2(r0)			;
30$:
	mov	(sp)+,r1			; restore registers
	mov	(sp)+,r0			;
	astx$s					; dismiss AST
	.page
	.sbttl	unsast - unstop ourselves
;
;
;	receive data AST routine
;
;	simply unstops the current task, since it is stopped for a
;	receive data or stop
;
unsast:
	ustp$s	#bspawn			; unstop ourselves
	astx$s				; dismiss AST
	.page
	.sbttl	streq - check for string equality
;
;	this routine checks for the equality of two 0-byte terminated
;	strings.  If equal, c-bit clear, else c-bit set
;
;	inputs:
;		r0	address of one string
;		r1	address of other string
;
;	outputs:
;		r0,r1	destroyed
;		c bit	set if not equal
;		c bit	clear if equal
;
	.enabl	lsb
streq:
	cmpb	(r0)+,(r1)		; compare next character
	bne	10$			; if !=, return c-bit set
	tstb	(r1)+			; is this 0-byte?
	bne	streq			; NO, try next character
	clc				; c clear => EQUAL
	br	20$			; return
10$:
	sec				; c set => NOT EQUAL
20$:
	return
	.page
	.sbttl	upper - crunch 0-byte terminated string to upper case
;
;
;	routine to crunch 0-byte terminated string to upper case
;
;	call sequence - call upper
;
;	inputs:
;
;		r0 - address of 0-byte terminated string
;
;	outputs:
;		string will have lower case letters changed to upper case
;		r0 is destroyed
;
leta=141
letz=172
umask=40
upper:
	cmpb	(r0),#leta
	blt	3$
	cmpb	(r0),#letz
	bgt	3$
	bicb	#umask,(r0)
3$:
	tstb	(r0)+
	bne	upper
	return
	.page
	.sbttl	length - calculate length of 0-byte terminated string
;
;	routine to calculate the length of the zero byte terminated
;	string pointed to by r1. length returned in r0, r1 is left
;	unmodified
;
;
length:
	clr	r0			; initialize count
	mov	r1,-(sp)		; save r1
1$:
	tstb	(r1)+			; see if 0 byte
	beq	2$			; yes, done
	inc	r0
	br	1$
2$:
	mov	(sp)+,r1		; restore r1
	return
	.page
	.sbttl	scopy - copy 0-byte terminated string into destination
;
;
;	routine to copy 0-byte terminated string pointed to by r1
;	to string pointed to by r0.  r1 is left pointing to character
;	after z byte, and r0 points to next available location
;
scopy:
	movb	(r1)+,(r0)+		; copy byte
	bne	scopy			; try again
	tstb	-(r0)			; backup one byte
	return
	.page
	.sbttl	errmsg - display error message and return
;
;
;	routine to display error message on terminal.  address of
;	zero byte terminated message is passed in r1.
;	the reason for the error is passed in r0, and copied into
;	the send message buffer.
;
;
;
;
;	errmsg - print error message on console, place error return in
;	sndbuf
;
;
;
;	local buffer used by errmsg
;
outbuf:	.byte	lf
	.ascii	"bspawn - "
obuf:	.blkb	132.
	.even
	.enabl	lsb
errmsg:
	movb	r0,sndbuf		; put reason in send buffer
	tstb	(r1)			; see if null message
	beq	20$			; YES
	mov	#obuf,r0		; destination
	call	scopy			; copy string
	movb	#cr,(r0)+		; copy return into buffer
	clrb	(r0)			; terminate string
	mov	#outbuf,r1		; calculate length
	call	length			; length in r0
	qiow$s	#io.wlb,#ttylun,#qioefn,,,,<r1,r0>
20$:
	mov	ucb,r0			; get ucb address
	beq	10$			; if == 0, not allocated yet
	bis	#u2.log,u.cw2(r0)	; set "BT" as logged off
	mov	offset,r0		; get offset
	clc				; clear c bit for multiply
	rol	r0			; multiply by 2
	clr	reqtsk(r0)		; clear task name
	clr	reqtsk+2(r0)		;
10$:
	return
	.page
	.sbttl	main - bspawn main routine
;
;	this is the main routine of the bspawn task
;	it basically coordinates the rest of the activities by calling
;	other modules to do particular types of work
;
	.enabl	lsb
start:
	finit$				; initialize FCS
	alun$s	#ttylun,#"TI,#0		; assign lun to TI:
	clr	ucb			; no UCB allocated yet
	call	initbt			; initialize "BT" variables
	tst	found			; was "BT" found?
	bne	10$			; YES
	ferror	fndmsg			; report error and die
10$:
	tst	loaded			; is the driver loaded?
	bne	20$			; YES
	ferror	lodmsg			; report error and die
20$:
	srda$s	#unsast			; establish receive data AST address
100$:					; main loop starts here
	clr	ucb			; indicate UCB not allocated yet
	call	getmsg			; get next request
	call	opnfil			; open file and read records
	bcc	30$			; c clear => successful
	error	null,filerr		; report error to requestor
30$:
	call	getfbt			; get a free "BT" unit
	bcc	40$			; c clear => successful
	error	null,fbterr		; report error to requestor
40$:
	call	fmtmcr			; format MCR command line
	call	sndarg			; send arguments to subtask
	bcc	50$			; if c clear => successful
	error	null,argerr		; notify user
50$:
	call	spntsk			; spawn the task
	bcc	sendit			; c clear => successful
	error	null,spnerr		; report error to requestor
sendit:
	call	sndmsg			; send response to requestor
	jmp	100$			; loop forever
exit:
	exit$s				; task exit
	.end	start
