Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	title	nrtsrv - Program to service NVTHAC links

	.text	"/symseg:low/locals"

	search	glxmac		;get galaxy's symbols
	prolog	(nrtsrv)

TOPS20<	PRINTX	? Wrong.
	END>

	sall			;pretty(er) listings

;version information

	nrsver==1
	nrsmin==0
	nrsedt==5
	nrswho==0

	%%nrs==vrsn.(nrs)	;make the version obvious
	glob %%nrs
	loc	137		;<.jbver>
	exp	%%nrs
	reloc

;revisions
; 3-Sept-80	Edit #4
;	Don't let NRTSRV run if it is a [1,2] job.
;
; 21-Oct-80	Edit #5
;	Restrict the number of chars in an output message (to tops-20)
;	to 40. decimal.  This is because of murphy's set-host hack
;

;register definitions

	l=.a13			;pointer to the link block

;Helper to define symbols
	define $def(name,size<1>)<name==%%%loc
	%%%loc==%%%loc+size>

	subttl	Symbols - helpful definitions

	uu.dmr==uu.bjp		;Task Disable Message Reassembly
	uu.fsp==1b1		;Full Scnser Pty
	dc.dar==2		;data with end of record

	nd	tibfsz,10	;task input buffer size
	nd	pobfsz,10	;pty output buffer size
	nd	pibfsz,10	;pty input buffer size
	nd	tobfsz,10	;task output buffer size

	nd	adtime,10	;do an AUDIT every 10 seconds.
	nd	sltime,adtime*^D1000 ;sleep between audits

	nd	lnkmax,50	;maximum number of links
	nd	pdllen,70	;stack length

	subttl	LBLOCK - link block definitions

	%%%loc==0		;init the $def macro

	$def	l$link		;contains the link number (ordinal)

;pty control locations
	$def	p$chan		;channel the pty is open on
	$def	p$trmn		;number of terminal pty controls
	$def	p$ibuf,pibfsz+3+3 ;Pty input buffer
	$def	p$obuf,pobfsz+3+3 ;Pty output buffer
	$def	p$isr,2		;interrupt service routine for pty
	$def	p$svac,2	;AC save area for ptyisr

;tsk control locations
	$def	t$stat		;status for the TSK device
	$def	t$chan		;TSK channel number
	$def	t$ibuf,tibfsz+3+3 ;TSK input buffer
	$def	t$obuf,tobfsz+3+3 ;TSK output buffer
	$def	t$isr,2		;TSK interrupt service routine
	$def	t$svac,2	;AC save area

	$def	l$size,0	;size of the link block

	subttl	INIT - Code to initialize nrtsrv

go:	jfcl			;ignore CCL entry
	move	s1,[xwd firzer,firzer+1]
	setzm	-1(s1)
	blt	s1,lstzer	;clear out the data base
	move	p,[iowd pdllen,pdl] ;set up the stack
	reset			; and close all the channels

;now get the GLXLIB high segment.
	setz	s1,		;a zero length IB
	$call	i%init		;get the galaxy high-seg
	setzm	.jbpfh		;keep stupid glxlib from trying
				; to page out the entire program.
	setom	newlok		;clear the "newlnk" interlock

;now see if we are already logged in as [1,2], if so, halt.
;  This prevents stupid operators from compromising the system's
;  security

	getppn	s1,		;get our ppn
	camn	s1,[xwd 1,2]	;operator?
	  $stop	(CRO,NRTSRV may NOT be run as an operator job.)


;now log us in as [2,5] (So users don't get logged in for free)
	move	s1,[xwd -4,t1]	;arg block is 4 wds long
	move	t1,[xwd 2,5]	;ppn
	seto	t2,		;privs
	dmove	t3,[sixbit | NRT-Server |] ;name
	login	s1,		;log us in (so we can open TSK)

;now detach us from FRCLIN
	movsi	s1,-1		;get a -1 in the LH
	attach	s1,		; and detach us
	 $stop	(DTF,Detach failed.)

;set up the PSI system
	movei	s1,vector	;get the address of the interrupt vector
	piini.	s1,		;init the PSI system
	 $STOP	(CIP,<Couldn't init the PSI system.>)
	movx	s1,ps.fon	;turn the system on
	pisys.	s1,		;turn it on
	 $call	s..cip		;?

;	jrst	loop		;go run the main code

	subttl	LOOP - Main driver for nrtsrv

loop:	movx	s1,%cndtm	;gettab for the universal
	gettab	s1,		; date/time
	 $stop	(UDF,<Gettab for Universal Date/Time failed.>)
	movem	s1,time		;remember the time
	caml	s1,audtim	;if it's time, go
	$call	audit		; make a through check of things.

;now loop over each link looking for ones that "want service"
sloop:	movsi	p1,-lnkmax	;aobjn pointer for LNKTBL
	skipl	l,lnktbl(p1)	;look at the next link entry
	aobjn	p1,.-1		; if not requesting service, go on.
	jumpge	p1,sleep	;if aobjn is done, so are we.
	hrrzs	lnktbl(p1)	;clear the "request bit"
	$call	service		;go service the request
	jrst	sloop		; and re-start the scan
				; This gives better service to low
				; links, but it probably doesn't matter

;nothing more to do.  Give up the CPU for a while
sleep:	movx	t1,<xwd 0,sltime> ;get length of time to sleep
	hiber	t1,		;zzz.
	 $stop	(HDS,<Hiber uuo failed.>)
	jrst	loop		;do it till we get it wrong.

	subttl	SERVICE - routine to service requests

servic:	skipn	t$chan(l)	;if no task is assigned
	jrst	tskep		; then "NEWLNK" want's one

srvdsp:	move	t1,t$stat(l)	;get the task state
	cail	t1,.tksid	; range check
	caile	t1,.tksok	; the state
	$stop	(ITS,<Illegal task state - ^O/t1/.>)
	jrst	@.+1(t1)	;dispatch on the state
	jrst	died		;.tksid - link down
	jrst	wait		;.tksci - waiting for a connect
	$call	s..its		;.tkscc - we don't send connects
	jrst	copy		;.tksok - running ok

;here if we are the PASSIVE task waiting for some one to connect
wait:	$call	tskgst		;recompute the TSK state
	CAIN	S1,.TKSOK	;We just got a connect
	 $CALL	SNDCFG		;Send config so RSTS or VAX know who we are
	caie	s1,.tksci	;if we've left CI state
	jrst	srvdsp		; go see what state we're in now
	$warn	(<Un-explained interrupt on passive tsk ^O/t$chan(l)/.>)
	$rett			;return with that warning

;here if the TSK channel died
died:	$call	ptycls		;stop the job, close the pty
	$call	tskcls		;free the TSK channel
	move	s1,l$link(l)	;get the channel number
	setzm	lnktbl(s1)	; and free the link number
	movx	s1,l$size	;get the size
	hrrz	s2,l		; and address of this channel block
	$call	m%rmem		;return the block to the free pool
	$call	audit		;make sure there is a passive link
	$rett			; and we're done

	subttl	COPY - Routines to actually push the data.

copy:	skipn	p$chan(l)	;if we haven't assigned a pty yet
	$call	ptyopn		; then go do so.

t2p:	skipg	p$obuf+.bfctr(l) ;see if there is room in the buffer
	$call	dopout		;if not, try to get some
	skipg	p$obuf+.bfctr(l) ;see if there is some now
	jrst	p2t		;if not, let the tsk back up

	$call	dotin		;do an "in" (only if necessary)
	skipg	t$ibuf+.bfctr(l);see if there is input data
	jrst	p2t		;if not, go look at the other side
	move	s2,p$obuf+.bfctr(l);get the minimum of the
	caml	s2,t$ibuf+.bfctr(l); of the two buffer
	move	s2,t$ibuf+.bfctr(l); counts

	movn	s1,s2		;get the negative of that value
	addm	s1,t$ibuf+.bfctr(l); and fixup the counts
	addm	s1,p$obuf+.bfctr(l); for both buffers
t2pcpy:	ildb	s1,t$ibuf+.bfptr(l);get and
	idpb	s1,p$obuf+.bfptr(l); put the byte
	sojg	s2,t2pcpy	;loop over all bytes
	jrst	t2p		;go back and try to find more work

p2t:	skipg	t$obuf+.bfctr(l);see if the output buffer is available
	$call	dotout		; if not, try to do an "out"
	skipg	t$obuf+.bfctr(l);see if it's ok now
	jrst	cpydon		; if not, then we're done for now

	$call	dopin		;try to get pty data
	skipg	p$ibuf+.bfctr(l);see if we got any
	jrst	cpydon		;if not, we're done
	move	s2,p$ibuf+.bfctr(l);calculate the
	caml	s2,t$obuf+.bfctr(l); minimum of the two
	move	s2,t$obuf+.bfctr(l); counts
	movn	s1,s2		;and
	addm	s1,p$ibuf+.bfctr(l); update the counts
	addm	s1,t$obuf+.bfctr(l); by what we're about to copy
p2tcpy:	ildb	s1,p$ibuf+.bfptr(l);get a byte
	idpb	s1,t$obuf+.bfptr(l); and send it
	sojg	s2,p2tcpy	;loop over all
	jrst	p2t		;go look for more work

cpydon:	$call	dopout		;send any pty data
	$call	dotout		; task data as well
	$rett			;done.

	subttl	AUDIT - Routine to check things out...

audit:	$save	<p1>		;conventions.
	movx	t1,adtime*3	;get audit increment
	add	t1,time		; and calculate time to do next audit
	movem	t1,audtim	;remember it.

;first scan to make sure we have a passive channel
	movsi	p1,-lnkmax	;aobjn pointer
audit1:	skipn	l,lnktbl(p1)	;see if this channel is in use
	jrst	audit2		; if not, go check the next one
	skipn	t$chan(l)	;make sure there is a TSK assigned
	jrst	audit2		; if not, just skip over the link
	$call	tskgst		;get the status
	cain	s1,.tksci	;if we are in CI
	jrst	audit3		; then we found our passive tsk
audit2:	aobjn	p1,audit1	;loop over them all (if necessary)
	$call	newlnk		;if none, make one.

audit3:	$rett

	subttl	ISRs - Interrupt service routines.

;isr's are called from the appropriate location in the link block
;	s1/ location +1 of the call to the isr

tskisr:	subi	s1,t$isr+2	;get the location of the block
	move	s2,l$link(s1)	;get the link number in s2
	xor	s1,lnktbl(s2)	;compare the two addresses
	trne	s1,-1		; and if they aren't equal
	 $stop	(IWA,Interrupt to wrong address.)
	movsi	s1,(1b0)	;get the "service me" bit
	iorb	s1,lnktbl(s2)	;set it and get our block addr back
	dmove	s1,t$svac(s1)	;reload the ac's
	debrk.			; and we're done

ptyisr:	subi	s1,p$isr+2	;get the location of the block
	move	s2,l$link(s1)	;get the link number in s2
	xor	s1,lnktbl(s2)	;compare the two addresses
	trne	s1,-1		; and if they aren't equal
	 $call	s..iwa		;interrupt to wrong address
	movsi	s1,(1b0)	;get the "service me" bit
	iorb	s1,lnktbl(s2)	;set it and get our block addr back
	dmove	s1,p$svac(s1)	;reload the ac's
	debrk.			; and we're done

	subttl	NEWLNK - Routine to allocate storage for a new link.

newlnk:	aose	newlok		;we only want one level in here at once
	$rett			;return if some one else is here

;first find a free slot in LNKTBL
	movsi	t1,-lnkmax	;aobjn pointer to lnktbl
	skipe	lnktbl(t1)	;start looking
	aobjn	t1,.-1		; keep looking
	jumpge	t1,[setom newlok;if no free links, release the lock
		    $rett]	; and return (will try again next audit)
	movx	s1,l$size	;get the size of a link block
	$call	m%gmem		;allocate a new link block
	hrli	s2,(1b0)	;get the "want's service" bit
	movem	s2,lnktbl(t1)	;mark the link as in use and wanting
	hrrzm	t1,l$link(s2)	;remember the link number
	setom	newlok		;free the interlock
	$rett			; and return

	subttl	TSKEP - Routine to assign a new task channel

;first open the TSK device
tskep:	move	s1,[xwd 4,t1]	;filop open argument list
	movx	t1,fo.asc+.focre;open a new channel, assign chan
	movx	t2,uu.aio+uu.dmr+.iobyt ;byte mode, non-blocking
	movx	t3,<sixbit |TSK|>;device name
	hrli	t4,t$obuf(l)	;output buffer
	hrri	t4,t$ibuf(l)	; input buffer too
	filop.	s1,		;open the TSK
	 $stop	(OTF,Open of the TSK channel failed.)
	ldb	s1,[pointr (t1,fo.chn)] ;get the assigned channel number
	movem	s1,t$chan(l)	; and remember it

;set up buffer fings
	movei	s1,t$obuf+3+1(l);address of link word in the buffer
	hrli	s1,(1b0)	;magic flag that says "virgin"
	movsi	s2,(point 8,0)	;byte size
	dmovem	s1,t$obuf(l)	;set up pointer to buffer ring

	setz	s1,		;zero initial status
	hrri	s2,t$obuf+3+1(l);address of next buffer in ring (first)
	hrli	s2,tobfsz+1	;size of this buffer
	dmovem	s1,t$obuf+3(l)	;init the header of the single buffer

;input too...
	movei	s1,t$ibuf+3+1(l);address of link to buffer ring
	hrli	s1,(1b0)	;virgin bit
	movsi	s2,(point 8,0)	;byte size
	dmovem	s1,t$ibuf(l)	;set up buffer control block

	setz	s1,		;init status
	hrri	s2,t$ibuf+3+1(l);link to next (aka first) buffer
	hrli	s2,tibfsz+1	;task input buffer size
	dmovem	s1,t$ibuf+3(l)	;init the buffer header

;now attach the TSK to the interrupt system
	dmove	s1,[dmovem s1,0	;isr first save's s1, s2
		    jsp s1,tskisr] ;then call's the isr
	hrri	s1,t$svac(l)	;fixup the addr of the save routine
	dmovem	s1,t$isr(l)	; and init it for this task

;calculate the vector offset for this device
	move	s2,l$link(l)	;get our link
	addi	s2,(s2)		;tsk uses the even slots
	lsh	s2,2		;multiply by 4 to get offset

;now fill in the vector information
	movei	s1,t$isr(l)	;get the address of the ISR
	movem	s1,vector+.psvnp(s2) ;and save it as the "new pc"
	movx	s1,ps.vto	;get the appropriate "flags"
	movem	s1,vector+.psvfl(s2) ;and save the "flags"

;now connect the device
	movx	s1,ps.fac+t1	;function is "add device"
	move	t1,t$chan(l)	;this is the channel
	hrl	t2,s2		;this is the vector offset
	hrri	t2,ps.rid+ps.rod+ps.rol ;the enabled conditions
	setz	t3,		;clear the reserved word
	pisys.	s1,		;add the tsk device
	 $stop	(PAT,Pisys uuo to add the TSK device failed.)

;now put the TSK in the passive state
	move	s1,[xwd 4,t1]	;argument block length and address
	movx	t1,.tkfep	;function is "enter passive"
	move	t2,t$chan(l)	;get the channel
	move	t3,srcnpd	;the remote NPD
	move	t4,rmtnpd	;the local descriptor
	tsk.	s1,		;enter passive state
	 $stop	(EPF,Enter passive state TSK uuo failed.)
;	pjrst	tskgst		;set up the status and return

	subttl	TSKGST - routine to get the status of a TSK channel

tskgst:	move	s1,[xwd 3,t1]	;address of the TSK. arg block
	movx	t1,.tkfrs	;function is return status
	move	t2,t$chan(l)	;channel number
	setz	t3,		;status goes here
	tsk.	s1,		;do the uuo
	 $stop	(RSF,Read status TSK. uuo failed.)
	movem	t3,t$stat(l)	;save the status
	move	s1,t3		;also return it in s1
	$rett			; and we're done

	subttl	TSKIO - Routines to do in/out uuo's to the TSK device

dotin:	skiple	t$ibuf+.bfctr(l);if there is already data there
	$rett			; then don't clobber it

	move	s1,[xwd 3,t1]	;arg list
	movx	t1,.tkfin	;in uuo function
	move	t2,t$chan(l)	;channel
	setz	t3,		;eor notification
	tsk.	s1,		;do the uuo.
	 caia			;skip if something is worng
	$rett			;return if ok
	cain	s1,tkils%	;if it's "illegal in this state"
	jrst	tsklwd		; then the link went down
	caie	s1,tkudw%	;if it's an unknown error
	jrst	tskerr		; go to common code to look at it
	txne	t1,io.err+io.eof;if the link wen't down
	jrst	tsklwd		;go set flags to clean up.
	$rett			;let loop catch the problems.

dotout:	move	s1,t$obuf+.bfctr(l) ;get the number of free chars
	caxl	s1,tobfsz*4	;if all the chars are free
	$rett			; then don't do the out

	move	s1,[xwd 3,t1]	;arg list address
	movx	t1,.tkfot	;output uuo
	move	t2,t$chan(l)	;channel
	movx	t3,dc.dar	;data with end of record
	tsk.	s1,		;do the output uuo
	 caia			; skip if an error
	$rett			;return if not.
	cain	s1,tkils%	;if it's "illegal in this state"
	jrst	tsklwd		; then the link went down
	caie	s1,tkudw%	;was the error "didn't work"
	jrst	tskerr		;go describe the error
	txnn	t1,io.eof+io.err;if it's just async i/o
	jrst	[setzm t$obuf+.bfctr(l) ;say the buffer is full
		 $rett]		;and return (tskser remembers the size)


tskerr:	$warn	(<TSK I/O error ^O/s1/, DEVIOS = ^O/t3/.>)
tsklwd:	$call	tskgst		;if link is down, recompute the state
	move	s1,l$link(l)	;get the link number
	movsi	s2,(1b0)	;get the "want service" flag
	iorm	s2,lnktbl(s1)	;set it so some one will notice
	$rett			; and let loop clean up

SNDCFG:	PUSHJ	P,DOTOUT	;Make dummy out happen
	MOVEI	T1,CFGMSG	;Send configuration msg
	PJRST	SNDMSG

	EXP	10
CFGMSG:	BYTE(8) 1,1,0,0,11,0,10,0
;	Config--' ^ ^ ^  ^ ^  ^ ^
;		  ? ? ?  | ?  | ?
;	System=TOPS10----'    |
;	Protocol=TOPS20-------'

SNDMSG:
	MOVE	T2,-1(T1)
	HRLI	T1,441000	;Set up byte pointer
SNDMS0:	ILDB	T3,T1		;GET BYTE
	IDPB	T3,T$OBUF+.BFPTR(L)	;Put it in the buffer
	SOJG	T2,SNDMS0	;back for more
	SETZM	T$OBUF+.BFCTR(L);no more bytes in here
	PJRST	dotout		;Send it

	subttl	PTYOPN - Routine to init the PTY side of a link.

;first open the PTY device
ptyopn:	move	s1,[xwd 4,t1]	;filop arg block
	movx	t1,fo.asc+.focre ;assign channel and open it
	movx	t2,uu.aio+uu.fsp ;full scnser control
	movx	t3,<sixbit |PTY|>;device name
	hrli	t4,p$obuf(l)	;output buffer address
	hrri	t4,p$ibuf(l)	;input buffer address
	filop.	s1,		;open the devic
	 $stop	(OPF,<Open of the PTY device failed - ^O/s1/.>)
	ldb	s1,[pointr (t1,fo.chn)];get the assigned channel
	movem	s1,p$chan(l)	; and remember it for later.

;set up the buffer rings
	movei	s1,p$obuf+3+1(l);address of link word in the buffer
	hrli	s1,(1b0)	;magic flag that says "virgin"
	movsi	s2,(point 7,0)	;byte size
	dmovem	s1,p$obuf(l)	;set up pointer to buffer ring

	setz	s1,		;zero initial status
	hrri	s2,p$obuf+3+1(l);address of next buffer in ring (first)
	hrli	s2,pobfsz+1	;size of this buffer
	dmovem	s1,p$obuf+3(l)	;init the header of the single buffer

;input too...
	movei	s1,p$ibuf+3+1(l);address of link to buffer ring
	hrli	s1,(1b0)	;virgin bit
	movsi	s2,(point 7,0)	;byte size
	dmovem	s1,p$ibuf(l)	;set up buffer control block

	setz	s1,		;init status
	hrri	s2,p$ibuf+3+1(l);link to next (aka first) buffer
	hrli	s2,pibfsz+1	;task input buffer size
	dmovem	s1,p$ibuf+3(l)	;init the buffer header

;now attach the PTY to the interrupt system
	dmove	s1,[dmovem s1,0	;isr fisrt saves the ac's
		    jsp s1,ptyisr] ;then to common code
	hrri	s1,p$svac(l)	;relocate to the correct save area
	dmovem	s1,p$isr(l)	; and init it for this pty

;calculate the vector offset for this device
	move	s2,l$link(l)	;get our link
	addi	s2,1(s2)	;pty uses the odd slots
	lsh	s2,2		;multiply by 4 to get offset

;now fill in the vector information
	movei	s1,p$isr(l)	;get the address of the ISR
	movem	s1,vector+.psvnp(s2) ;and save it as the "new pc"
	movx	s1,ps.vto	;get the appropriate "flags"
	movem	s1,vector+.psvfl(s2) ;and save the "flags"

;now connect the device
	movx	s1,ps.fac+t1	;function is "add device"
	move	t1,p$chan(l)	;this is the channel
	hrl	t2,s2		;this is the vector offset
	hrri	t2,ps.rid+ps.rod+ps.rol ;the enabled conditions
	setz	t3,		;clear the reserved word
	pisys.	s1,		;add the pty device
	 $stop	(PAP,Pisys uuo to add the PTY device failed.)

;now force initia on the new line
	move	s1,p$chan(l)	;get the pty channel
	iondx.	s1,		; and get the PTY udx
	 $stop	(CFI,Error while trying to force INITIA on line.)
	andi	s1,777		;get just the PTY number
	movx	s2,%cnpty	;get the offset of the
	gettab	s2,		; first pty
	 $call	s..cfi		;?
	movx	t1,<sixbit |INITIA|> ;command to force
	hlrz	t2,s2		;tty number of first PYT
	addi	t2,.uxtrm(s1)	;tty UDX of controled terminal
	movem	t2,p$trmn(l)	;save it for posteity
	move	s1,[xwd 2,t1]	;arglist for frcuuo
	frcuuo	s1,		;force initia
	 jfcl			;we tried.  (Really should work...)
	$rett			;done

	subttl	PTYIO - Routines to do in/out uuo's to the PTY

dopin:	skiple	p$ibuf+.bfctr(l);if there is already data there
	$rett			; then don't write over it

	move	s1,p$chan(l)	;get the channel
	movx	s2,.foinp	;the filop in function
	dpb	s1,[pointr (s2,fo.chn)] ;set the channel
	move	s1,[xwd 1,s2]	;arglist descriptor
	filop.	s1,		;do the output
	 $warn	(<PTY input error = ^O/s1/.>)
	$rett			;done.

dopout:	move	s1,p$obuf+.bfctr(l);see if the output buffer
	caxl	s1,pobfsz*5	; is empty.  if so,
	$rett			; don't do an output on it

	move	s1,p$chan(l)	;get the channel
	movx	s2,.foout	;get the output fucntion
	dpb	s1,[pointr (s2,fo.chn)] ;set the channel
	move	s1,[xwd 1,s2]	;arglist descriptor
	filop.	s1,		;do the output
	 jfcl			;pty's suck.
;	 $warn (<PTY output error = ^O/s1/.>)
	$rett

	subttl	PTYCLS - Routine to close a PTY

ptycls:	skipn	s1,p$chan(l)	;first make sure there is a PTY
	$rett			; if none, we're done.

	jobsts	s1,		;see if we are controlling anyone
	 $stop	(JUF,Jobsts UUO failed.)
	ldb	t2,[pointr (s1,jb.ujn)] ;get the job number
	jumpe	t2,ptycl1	;if none, just go free the pty

;stop the job on the PTY
	move	s1,[xwd 2,t1]	;frcuuo arg list is 2 wds long
	move	t1,[sixbit |.halt|] ;just a gentle
	frcuuo	s1,		; whack!
	 jfcl			;this doesn't work
;	 $stop	(FUS,<Frcuuo to stop job ^O/t2/ failed.>)

;now get rid of the PTY.  First remove it from the PI system
ptycl1:	movx	s1,ps.frc+t1	;remove function, arg blk in t1
	move	t1,p$chan(l)	;pty channel
	move	t2,l$link(l)	;get the link number
	addi	t2,1(t2)	; pty's are the odd vector blocks
	lsh	t2,^D18+2	;shift half words (and multiply by 4)
	setz	t3		;clear the "reserved word"
	pisys.	s1,		;remove the PTY
	 $stop	(RPF,Pisys to remove the PTY channel failed.)

;now release the PTY
	movx	s2,.forel	;filop release function
	move	s1,p$chan(l)	;get the channel
	dpb	s1,[pointr (s2,fo.chn)] ;store the channel number
	move	s1,[xwd 1,s2]	;length - arg list address
	filop.	s1,		;release the PTY
	 $stop	(FRP,Filop to release the PTY failed.)
	setzm	p$chan(l)	;indicate the PTY is no longer assigned
	$rett			; and we're done

	subttl	TSKCLS - Routine to close the TSK channel

tskcls:	skipn	t$chan(l)	;make sure the task is assigned
	$stop	(TNA,TSKCLS was called with no channel assigned.)

;first disconnect the TSK from the PI system
	movx	s1,ps.frc+t1	;function "remove" arglist in t1-t3
	move	t1,t$chan(l)	;get the channel
	move	t2,l$link(l)	;get the link number
	addi	t2,(t2)		;we use the even offsets
	lsh	t2,^D18+2	;multiply by 4 and put in the LH(t2)
	setz	t3,		;clear the "reserved word"
	pisys.	s1,		;remove the TSK
	 $stop	(TRF,Pisys to remove the TSK channel failed.)

;now release the channel
	movx	s2,.forel	;filop release function
	move	s1,t$chan(l)	;the channel number
	dpb	s1,[pointr (s2,fo.chn)] ;put it where filop likes it
	move	s1,[xwd 1,s2]	;arg-list length and address
	filop.	s1,		;do the release
	 $stop	(FTR,Filop to release the TSK channel failed.)
	setzm	t$chan(l)	;say the TSK is gone
	$rett			; and we're done

	subttl	DATA - Data area

firzer:	;start zeroing here on a restart
time:	block	1		;current time
audtim:	block	1		;time of next audit
pdl:	block	pdllen		;stack
vector:	block	lnkmax*2*4	;interrupt vector block
lnktbl:	block	lnkmax		;table of pointers to link blocks
				; sign bit means "want's serivce"
newlok:	block	1		;interlock for creating links
lstzer:	block	1		;last word to zero

srcnpd:	xwd	4,.+1		;our name
	exp	0		;ignore the node
	exp	10		;10 characters
	ascii	|ANF-NRTsrv|	;our name

rmtnpd:	xwd	4,.+1		;address
	exp	-1		;any node
	exp	4		;4 char pattern
	byte	(7) 0, "2", "7", "*" ;match any object 23
	exp	0

	end	go