#-h- getmsg.ias       823 asc 14-oct-80 13:39:25
	.title	getmsg
;
;	this routine implements the following interface
;
;	n = getmsg(buf)
;
;	a rcv$t macro call is attempted first.  If this fails, oldmak is
;	called to getmcr of prompt for arguments
;
	.mcall	tcsmc$
	tcsmc$				; mcall other TCS macros
ap=%5
buf=2
sdb:	sdbdf$	,255.			; send data block
pblk:	.byte	1,0			; parameter block for oldmak call
	.blkw	1
getmsg::
	rcv$t	#sdb,buf(ap)		; receive arguments
	bcs	getold			; c set => go call oldmak
	mov	buf(ap),r1		; buffer address
	mov	r1,r2			;
	mov	(r1)+,r0		; place count in r0
	mov	r0,r3			;
	beq	trmn8			; if == 0, terminate string
10$:
	movb	(r1)+,(r2)+		; copy character
	sob	r3,10$			; do next one
trmn8:
	clrb	(r2)			; terminate with 0-byte
	br	done
getold:
	mov	buf(ap),pblk+2		; build Fortran call block
	call	oldmak			; GMCR or prompt
done:
	return
	.end
#-h- tcspwn.ias      2360 asc 14-oct-80 13:39:29
	.title	tcspwn
;
;	this routine implements the following interface
;
;	status = tcspwn(desc)
;
;	where desc is a 5-word integer array with the following entries:
;
;	desc(1) = length of command line
;	desc(2) = address of command line
;	desc(3) = command type (TS.USE, TS.DOT, TS.DOL, TS.INS)
;	desc(4) = length of argument array
;	desc(5) = address of argument array
;
;	if type != TS.USE, desc(4) == 0
;
;	status returns
;		OK(0)	successful completion
;		EOF(-1)	image load failure
;		ERR(-3)	subtask completed abnormally
;
	.mcall	tcsmc$
	tcsmc$			; mcall rest of TCS macros
;
;	defined symbols
;
d.cmdl=0			; desc offsets
d.cmda=2
d.cmdt=4
d.argl=6
d.arga=10
ap=%5
desc=2
ok=0
eof=-1
err=-3
;
;	local data
;
msg:	.blkb	256.		; buffer for arguments
tdb:	tdbdf$			; task descriptor block
	tdeb$a	esb		; associated error status block
	tdpr$a	jp.pi,pr.rst!pr.tev!pr.chn,10	; TCP privileged, can initiate
				; subtasks, be notified of events and send/
				; receive messages
esb:	esbdf$			; error status block
sdb:	sdbdf$	msg,,tdb	; send data block
;
;	code
;
tcspwn::
	mov	desc(ap),r1	; descriptor address in r1
	mov	#msg,r2		; address of message buffer
	mov	d.argl(r1),r4	; length of args in r4
	cmp	r4,#253.	; see if too long
	ble	5$
	mov	#253.,r4	; don't overflow buffer
5$:
	mov	r4,(r2)+	; place count in buffer
	beq	20$		; if == 0, no args to send
	mov	d.arga(r1),r3	; address of argument array
10$:
	movb	(r3)+,(r2)+	; copy byte
	sob	r4,10$		; do next one
20$:
	tdbd$t	#tdb		; declare TDB active
	run$t	#tdb,d.cmda(r1),d.cmdl(r1),d.cmdt(r1),#sdb	; spawn it
	bcs	50$		; c set => load error
	ckev$t	TERM,#tdb,STOP	; wait for event
	tst	r0		; see if TERM or TDB
	bne	30$		; if != 0, address of TDB
	abrt$t	#tdb		; abort subtask upon ^C
	ckev$t	,#tdb,STOP	; wait for it to complete
30$:
	rdev$t			; read event info for tdb in r0
	bitb	#if.nl,t.evnt(r0)	; load failure?
	bne	50$		; YES
	bit	#ev.ab,t.evbf+e.tr(r0)	; abnormal exit?
	bne	45$		;YES
	bit	#ev.st,t.evbf+e.tr(r0)	; exit with status?
	bne	40$		; YES
	mov	#ok,r1		; return OK
	br	60$		; return
40$:
	mov	t.evbf+e.ts(r0),r2	; get exit status
	mov	#ok,r1		; assume OK
	cmp	#ex$suc,r2	; success?
	beq	60$		; YES
	cmp	#ex$war,r2	; warning?
	beq	60$		; YES
45$:
	mov	#err,r1		; return ERR
	br	60$
50$:
	mov	#eof,r1		; return EOF
60$:
	tdbr$t	#tdb		; release TDB
	mov	r1,r0		; return status
	return
	.end
#-h- enbint.ias       303 asc 14-oct-80 13:39:32
	.title	enbint
;
;	call enbint
;
;	enables the current task as the ^C task, if the task has pr.ctc
;	privelege
;
;	due to the way the priveleges are passed by tcspwn, this will only
;	work for the shell invoked from PDS
;
	.mcall	ctc$t
enbint::
	ctc$t	CLAIM		; claim ^C - if error, ignore
	return
	.end
