TITLE	NSPTST		Test NSP uuo
	SUBTTL	T.Neustaedter/Tarl
	SEARCH	DCN

	Comment @

This program is intended as an aid to debugging DECnet-10 programs, and
as a working example of a program using the NSP. uuo.

It is intended that this program be used in conjuction with a listing of
NSPUSR.MEM, as many of the requested fields are inadequatley labeled when
this program requests them.

The NSP. uuo in this program will always set NS.WAI, so if you want to
exercise asynchronous I/O, you'll have to write your own hack.

	@


	$ONLY==I.PRM!I.GTT!I.LUO
	$INIT	NSP

;Macro to convert string block length in bytes to words

	DEFINE SLEN(BYTES),<1+<<BYTES+3>/4>>
	XP SMAX,400		;Maximum size for string block arg

;Define some blocks for use in NSP. uuo

$LVAR	FZER			;First zeroed location \
$BLOCK	UBLK,.NSAMX+1		;Block for the NSP uuo 	\
$BLOCK	CBLK,.NSCMX+1		;Connect block	       	 \
$BLOCK	SPDB,.NSDMX+1		;Source PDB (name follows)\
$BLOCK	SPNM,SLEN(^D16)		;Source process name	   |
$BLOCK	DPDB,.NSDMX+1		;Destination PDB       	   | Blocks zeroed
$BLOCK	DPNM,SLEN(^D16)		;Destination process name  |
$BLOCK	NODE,SLEN(^D6)		;Node name block	   | before every
$BLOCK	USER,SLEN(^D39)		;User ID		   | NSP. execution
$BLOCK	PASS,SLEN(^D39)		;Password		  /
$BLOCK	ACCT,SLEN(^D39)		;Account		 /
$BLOCK	DATA,SLEN(^D16)		;User data		/
$BLOCK	SBLK,SLEN(SMAX)		;String block	        |
$LVAR	LZER			;Last zeroed location  /


;Define some values for uuo description macros
;Flags indicating read, write, prived
        FL.R=40
        FL.W=20
        FL.P=10
        FL.=0
;Function code describing format of argument
        FN.CBL=1
        FN.SBL=2
        FN.ARG=3
        FN.BCT=4
        FN.BPT=5
;Macros to add up all the flags in an individual argument
        DEFINE CBL(A,B,C),<FL.'A+FL.'B+FL.'C+FN.CBL>
        DEFINE SBL(A,B,C),<FL.'A+FL.'B+FL.'C+FN.SBL>
        DEFINE ARG(A,B,C),<FL.'A+FL.'B+FL.'C+FN.ARG>
        DEFINE BCT(A,B,C),<FL.'A+FL.'B+FL.'C+FN.BCT>
        DEFINE BPT(A,B,C),<FL.'A+FL.'B+FL.'C+FN.BPT>
;Macro to build up a dispatch entry from all the above
	DEFINE NSPFNC(SIXNAM,ARG1,ARG2,ARG3,ASCNAM),<
	XWD SIXBIT \   SIXNAM \,[<ARG1>B5+<ARG2>B11+<ARG3>B17+.NSF'SIXNAM
				ASCIZ \ASCNAM\]
>

;These are the definitions of all the NSP. functions.  The format of the
;NSPFNC macro is function name followed by the three possible arguments
;of the NSP. UUO.
;
;	R = Read this arg from user's block
;	W = Write this arg into user's block
;	P = Privileged Argument

NSPTAB:
	NSPFNC EA,CBL(R),ARG(R),ARG(R,P),<Enter Active>
	NSPFNC EP,CBL(R),,,<Enter Passive>
	NSPFNC RI,CBL(W),ARG(W),ARG(W),<Read connect data>
	NSPFNC AC,SBL(R),ARG(R),ARG(R,P),<Accept connect>
	NSPFNC RJ,SBL(R),ARG(R,P),,<Reject connect>
	NSPFNC RC,SBL(W),ARG(W),ARG(W),<Read confirm info>
	NSPFNC SD,SBL(R),ARG(R,P),,<Synchronous disconnect>
	NSPFNC AB,SBL(R),ARG(R,P),,<Abort and release>
	NSPFNC RD,SBL(W),ARG(W),,<Read disconnect data>
	NSPFNC RL,,,,<Release channel>
	NSPFNC RS,ARG(W),ARG(W),,<Read status>
	NSPFNC IS,SBL(R),,,<Send interrupt data>
	NSPFNC IR,SBL(W),,,<Read interrupt data>
;	NSPFNC DS,BCT(R,W),BPT(R,W),,<Send normal data>
;	NSPFNC DR,BCT(R,W),BPT(R,W),,<Read normal data>
	NSPFNC SQ,ARG(R),ARG(R),ARG(R),<Set quotas and goals>
	NSPFNC RQ,ARG(W),ARG(W),ARG(W),<Read quotas and goals>
	NSPFNC JS,ARG(R,P),ARG(R,P),,<Set job quotas & goals>
	NSPFNC JR,ARG(W),ARG(W),,<Read job quotas & goals>
	NSPFNC PI,ARG(R),,,<Set PSI reason mask>
NSPLEN=.-NSPTAB


START:	$SETUP			;Init LUUO package
	$INFORM INI,<NSP. test bed package>
	PUSH P,[.]		;save this as address to return to
START1:	$PROMPT T1,%SIXBIT,<Function to execute: .NSF>
	MOVE T2,[IOWD NSPLEN,NSPTAB] ;Pointer to function table
START2:	HLLZ T3,1(T2)		;Get a function name
	CAMN T3,T1		;is this the one?
	 JRST PRCFNC		;yes, process the function
	AOBJN T2,START2		;loop until we find it
	$WARN NSF,<No such function name, available names are:>
	MOVE T2,[IOWD NSPLEN,NSPTAB] ;Pointer to function table
START3:	TSTRG. [ASCIZ \.NSF\]	;Prefix function name
	HLLZ T1,1(T2)		;Get a name
	TSIXN. T1,		;Type it out
	TCHRI. .CHTAB		;Space over
	HRRZ T1,1(T2)		;Get pointer to extra info
	TLINE. 1(T1)		;and type long name
	AOBJN T2,START3		;And loop until we finish typing them out
	JRST START1		;try again.

PRCFNC:
	SETZM FZER		;clean first word of zeroable area
	MOVE T1,[FZER,,FZER+1]	;blt pointer
	BLT T1,LZER		;Clear entire zeroable area.
	HRRZ P1,1(T2)		;Get pointer to detail for this function
	TSTRG. [ASCIZ \** For function \]
	TLINE. 1(P1)		;Type out detailed name
	HRLZ T1,(P1)		;Get function code
	IOR T1,[NS.WAI!.NSAMX]	;Add flags and length
	MOVEM T1,UBLK+.NSAFN	;save in function and length word
	$PROMPT T1,%DECIMAL,<Channel to use: >
	MOVEM T1,UBLK+.NSACH	;save in channel field
	MOVE P1,(P1)		;Get detail on chunks to fill in
	LDB T1,[POINT 6,P1,5]	;get bits indicating type of block
	CALL GETARG		;Get argument to store here
	 JRST PRCEND		;error, abort function.
	MOVEM T1,UBLK+.NSAA1	;Save as argument 1
	LDB T1,[POINT 6,P1,11]	;Get bits for second argument
	CALL GETARG		;Get argument
	 JRST PRCEND
	MOVEM T1,UBLK+.NSAA2	;Save as argument 2
	LDB T1,[POINT 6,P1,17]	;Get bits for third argument
	CALL GETARG		;Get argument
	 JRST PRCEND
	MOVEM T1,UBLK+.NSAA3	;Save as argument 3
	MOVEI T1,UBLK		;pointer to argument block
	NSP. T1,		;do the function
	 $WARN NFF,<NSP uuo failed, Reason: >,TYPERR,T1
	HRRZ T2,UBLK+.NSACH
	$INFORM CHN,<Used channel number >,.TDECW##,T2
	MOVEI T1,SBLK		;Point to the generic string block
	MOVEI T2,[ASCIZ \String block contents: \]
	CALL TYPSBL		;Type it out if relevant
	 JRST PRCEND
	CALL TYPCBL		;Type out the connect block
	 JRST PRCEND
PRCEND:
	JRST START1		;and do again.

TYPERR:	SKIPL T1		;Make sure not negative
	CAXLE T1,ERRMAX		;Range check
	 SETZ T1,		;zero error code is catch all
	TSTRG. @ERRTAB(T1)	;Type out error string
	RET			;and return

ERRTAB:
	[ASCIZ \%NE???(?) Unknown error code\]
	[ASCIZ \%NEABE(1) Argument block format error\]
	[ASCIZ \%NEALF(2) Allocation failure\]
	[ASCIZ \%NEBCN(3) Bad channel number\]
	[ASCIZ \%NEBFT(4) Bad format type in process block\]
	[ASCIZ \%NECFE(5) Connect block format error\]
	[ASCIZ \%NEIDL(6) Interrupt data too long\]
	[ASCIZ \%NEIFM(7) Illegal flow control mode\]
	[ASCIZ \%NEILF(10) Illegal function\]
	[ASCIZ \%NEJQX(11) Job quota exhausted\]
	[ASCIZ \%NELQX(12) Link quota exhausted\]
	[ASCIZ \%NENCD(13) No connect data to read\]
	[ASCIZ \%NEPIO(14) Percentage input out of bounds\]
	[ASCIZ \%NEPRV(15) No privileges to perform function\]
	[ASCIZ \%NESTB(16) Segment size too big\]
	[ASCIZ \%NEUKN(17) Unknown node name\]
	[ASCIZ \%NEUXS(20) Unexpected state: unspecified\]
	[ASCIZ \%NEWNA(21) Wrong number of arguments\]
	[ASCIZ \%NEWRS(22) Function called in wrong state\]
	[ASCIZ \%NECBL(23) Connect block length error\]
	[ASCIZ \%NEPBL(24) Process block length error\]
	[ASCIZ \%NESBL(25) String block length error\]
	[ASCIZ \%NEUDS(26) Unexpected state: disconnect sent\]
	[ASCIZ \%NEUDC(27) Unexpected state: disconnect confirmed\]
	[ASCIZ \%NEUCF(30) Unexpected state: no confidence\]
	[ASCIZ \%NEULK(31) Unexpected state: no link\]
	[ASCIZ \%NEUCM(32) Unexpected state: no communication\]
	[ASCIZ \%NEUNR(33) Unexpected state: no resources\]
	[ASCIZ \%NERBO(34) Rejected by object\]
	[ASCIZ \%NEDBO(35) Disconnected by object (when running) \]
	[ASCIZ \%NERES(36) No resources\]
	[ASCIZ \%NEUNN(37) Unrecognized node name\]
	[ASCIZ \%NERNS(40) Remote node shut down\]
	[ASCIZ \%NEURO(41) Unrecognized object\]
	[ASCIZ \%NEIOF(42) Invalid object name format\]
	[ASCIZ \%NEOTB(43) Object too busy\]
	[ASCIZ \%NEABM(44) Abort by management\]
	[ASCIZ \%NEABO(45) Abort by object\]
	[ASCIZ \%NEINF(46) Invalid node name format\]
	[ASCIZ \%NELNS(47) Local node shut down\]
	[ASCIZ \%NEACR(50) Access control rejection\]
	[ASCIZ \%NENRO(51) No response from object\]
	[ASCIZ \%NENUR(52) Node unreachable\]
	[ASCIZ \%NENLK(53) No link\]
	[ASCIZ \%NEDSC(54) Disconnect complete\]
	[ASCIZ \%NEIMG(55) Image field too long\]
	[ASCIZ \%NEREJ(56) Unspecified reject reason\]
	[ASCIZ \%NEBCF(57) Bad combo of ns.eom & ns.wai flags\]
	[ASCIZ \%NEADE(60) Address error\]
ERRMAX=.-ERRTAB



GETARG:	LDB T2,[POINT 3,T1,35]	;Get the actual function code
	JRST @.+1(T2)		;dispatch
	IFIW RETZER		;(0) No arg, return zero
	IFIW RETCBL		;(1) Get a connect block
	IFIW RETSBL		;(2) Get a string block
	IFIW RETARG		;(3) Get a word
	IFIW RETBCT		;(4) Byte count (save string)
	IFIW RETBPT		;(5) Byte pointer (get from saved)
	IFIW RETERR		;(6) Error, no such code
	IFIW RETERR		;(7) Error, no such code

RETZER:	SETZ T1,		;Return clean AC
	RETSKP			;and success since we didn't fail

RETERR:	$ERROR INV,<Invalid argument code for function>
	EXIT


;Service routine. Read a string into a string block
;Call
;	T1/ Flags
;	T2/ length allowed (in bytes)
;	T3/ Pointer to block to fill in
;Return
;	T1/ Pointer to string block filled in

INPSBL:	CALL .SAV2		;Preserve P1
	MOVE P1,T3		;preserve pointers
	MOVE P2,T2		;preserve length
	TRNN T1,FL.R		;is the monitor going to read this?
	 JRST INPSB3		;No, just set up the block header
INPSB1:	$PROMPT T3,%ASCII,<String: >
	MOVE T3,[POINT 7,.NMUL##] ;BPT to scan string storage area
	MOVE T4,[POINT 8,1(P1)]	;Pointer to string area
INPSB2:	ILDB T1,T3		;get a byte from scan string area
	JUMPE T1,INPSB3		;done, do accounting
	IDPB T1,T4		;Save in string area
	SOJGE T2,INPSB2		;loop
	$WARN STL,<String too long for field>
	MOVE T2,P2		;restore length we will accept
	JRST INPSB1		;and try again.

INPSB3:	MOVE T1,P2		;Copy number of bytes allowed
	SUB P2,T2		;Find out how many bytes we got
	ADDI T1,3		;round up to nearest word
	IDIVI T1,4		;convert into words
	ADDI T1,1		;Add overhead word of header
	HRL T1,P2		;bytes,,words
	MOVEM T1,(P1)		;store as string block header
	MOVE T1,P1		;get back pointer to string block
	RETSKP			;and return success

;Service routine. Type a string block
;Call
;	T1/ Pointer to string block
;	T2/ Descriptor string to type out
;Return
;	RETSKP

TYPSBL:	HLRZ T4,(T1)		;Get number of bytes in string block
	JUMPE T4,.POPJ1##	;Nothing there, return
	TSTRG. (T2)		;Type out descriptor of this string block
	MOVE T3,[POINT 8,1(T1)]	;Byte pointer to data in string block
TYPSB2:	ILDB T2,T3		;Get a byte from string
	TCHRI. (T2)		;Type it out
	SOJG T4,TYPSB2		;Loop until end
	TCRLF.			;end line
	RETSKP

;Service routine. Input a process descriptor block
;Call
;	T1/ Flags from GETARG
;	T2/ Pointer to block to use as PDB block
;	    Block must be immediatley followed by 5 words for process name
;Return
;	T1/ Pointer to PDB block

INPPDB:	CALL .SAV1		;Storage
	MOVE P1,T2		;Save pointer to pdb block
	MOVEI T2,.NSDMX		;Length of PDB
	MOVEM T2,.NSDFL(P1)	;Save in PDB
	MOVEI T2,.NSDMX+1(P1)	;Pointer to process name block
	MOVEM T2,.NSDPN(P1)	;Store in process block
	TRNN T1,FL.R		;Is the monitor going to read this?
	 JRST INPPD6		;No, just keep on going
INPPD2:	$PROMPT T2,%DECIMAL,<Format type 0,1 or 2: >
	SKIPL T2		;Range check
	CAILE T2,2		;to within reason
	 $WARN FTO,<Format type may only be 0,1 or 2>,,,INPPD2
	MOVEM T2,.NSDFM(P1)	;save as format type
	JUMPN T2,INPPD5		;If non-zero format type, skip object type
	$PROMPT T2,%DECIMAL,<Object type: >
	CAXL T2,-2		;Range check
	CAXLE T2,^D255		;to within reason (neg 1 is anything)
	 $WARN OBO,<Object type must be less than 255.>,,,INPPD2
	MOVEM T2,.NSDOB(P1)	;save as object type
	JRST INPPD7		;and skip ppn and process name
INPPD5:
	CAXE T2,2		;Format type 2?
	 JRST INPPD6		;No, don't ask for PPN
	$PROMPT T2,%OCTAL,<PPN (full word format): >
	MOVEM T2,.NSDPP(P1)	;Save in block
INPPD6:
	MOVEI T2,^D16		;Max 16 characters for process name
	MOVE T3,.NSDPN(P1)	;Get pointer to string block area
	TRNE T1,FL.R		;Is this going to be read?
	TSTRG. [ASCIZ \Process name \] ;start up string
	CALL INPSBL		;Get string block
	 RET			;propagate error
INPPD7:	MOVE T1,P1		;get back pointer to process block
	RETSKP			;return success

;Service routine. Type out a PDB
;Call
;	T1/ Pointer to PDB
;	T2/ Pointer to header string

TYPPDB:
	CALL .SAV1		;Storage
	MOVE P1,T1		;Store pointer to PDB
	SKIPN .NSDFM(P1)	;Format type 0?
	SKIPE .NSDOB(P1)	;object type 0?
	TRNA			;Something non zero, lets type this out
	RETSKP			;yes to both being zero, forget about him
	TSTRG. (T2)		;Type out header
	MOVE T1,.NSDFM(P1)	;Get format type
	TSTRG. [ASCIZ \Format type \]
	TDECW. T1,		;TYpe it out in decimal
	TCHRI. ","
	JUMPN T1,TYPPD2		;non zero, skip object type code
	TSTRG. [ASCIZ \ Object type \]
	MOVE T1,.NSDOB(P1)	;Get object type
	TDECW. T1,		;and type it out
	RETSKP			;and return

TYPPD2:	CAIE T1,2		;Format type 2
	 JRST TYPPD3		;No, skip PPN
	TSTRG. [ASCIZ \ PPN=\]	;Indicate PPN coming next
	MOVE T1,.NSDPP(P1)	;Get ppn
	TXWDW. T1,		;Type it out as a PPN
TYPPD3:	SKIPN T1,.NSDPN(P1)	;Get pointer to process name block
	 RETSKP			;None there, done
	MOVEI T2,[ASCIZ \, Name=\] ;header if needed
	JRST TYPSBL		;And type it out, returning


RETCBL:	CALL .SAV2		;save a couple of acs
	MOVE P1,T1		;save flags
	MOVEI T2,.NSCMX		;Get length of connect block
	MOVEM T2,CBLK+.NSCNL	;save as length
	TRNE P1,FL.R		;Is this going to be read?
	TSTRG. [ASCIZ \Node name \] ;head up question
	MOVEI T3,NODE		;pointer to node block
	MOVEI T2,6		;maximum length to node name block
	CALL INPSBL		;Read string block
	 RET			;propagate error
	MOVEM T1,CBLK+.NSCND	;save pointer in connect block
	TRNE P1,FL.R		;Is this going to be read?
	TLINE. [ASCIZ \Source process descriptor:\]
	MOVE T1,P1		;Get back flags again
	MOVEI T2,SPDB		;Pointer to source PDB block
	CALL INPPDB		;Read process descriptor block
	 RET			;failure, return
	MOVEM T1,CBLK+.NSCSD	;Save in connect block
	TRNE P1,FL.R		;Is this going to be read?
	TLINE. [ASCIZ \Destination process descriptor:\]
	MOVE T1,P1		;Get back flags yet again
	MOVEI T2,DPDB		;pointer to destination PDB block
	CALL INPPDB		;Read pdb
	 RET			;propagate return
	MOVEM T1,CBLK+.NSCDD	;save as destination pdb
	TRNE P1,FL.R
	TSTRG. [ASCIZ \User id \]
	MOVE T1,P1		;flags yet again
	MOVEI T2,^D39		;Length
	MOVEI T3,USER		;User id string area
	CALL INPSBL		;Read a string block
	 RET			;propagate return
	MOVEM T1,CBLK+.NSCUS	;store in block
	TRNE P1,FL.R
	TSTRG. [ASCIZ \Password \]
	MOVE T1,P1		;flags yet again
	MOVEI T2,^D39		;Length
	MOVEI T3,PASS		;Password
	CALL INPSBL		;Read a string block
	 RET			;propagate return
	MOVEM T1,CBLK+.NSCPW	;store in block
	TRNE P1,FL.R
	TSTRG. [ASCIZ \Account \]
	MOVE T1,P1		;flags yet again
	MOVEI T2,^D39		;Length
	MOVEI T3,ACCT		;Account string area
	CALL INPSBL		;Read a string block
	 RET			;propagate return
	MOVEM T1,CBLK+.NSCAC	;store in block
	TRNE P1,FL.R
	TSTRG. [ASCIZ \User data \]
	MOVE T1,P1		;flags yet again
	MOVEI T2,^D39		;Length
	MOVEI T3,DATA		;User data string area
	CALL INPSBL		;Read a string block
	 RET			;propagate return
	MOVEM T1,CBLK+.NSCUD	;store in block
	MOVEI T1,CBLK		;Pointer to connect block
	RETSKP

;Type out connect block if anything interesting

TYPCBL:
	SKIPN CBLK+.NSCNL	;Did we use the connect block?
	 RETSKP			;Nope, just return
	TLINE. [ASCIZ \Connect block contains: \]
	SKIPN T1,CBLK+.NSCND	;Is there a node name block?
	 JRST TYPCB1		;No, skip over this
	MOVEI T2,[ASCIZ \Node name: \]
	CALL TYPSBL		;Type the string block out (if anything there)
	 RET
TYPCB1:	SKIPN T1,CBLK+.NSCSD	;Is there a source process descriptor?
	 JRST TYPCB2		;No.
	MOVEI T2,[ASCIZ \Source PDB: \]
	CALL TYPPDB		;Type the PDB
	 RET
	TCRLF.
TYPCB2:	SKIPN T1,CBLK+.NSCDD	;Destination pdb?
	 JRST TYPCB3		;no
	MOVEI T2,[ASCIZ \Destination PDB: \]
	CALL TYPPDB		;Type it out
	 RET
	TCRLF.
TYPCB3:	SKIPN T1,CBLK+.NSCUS	;User id?
	 JRST TYPCB4		;no
	MOVEI T2,[ASCIZ \User ID: \]
	CALL TYPSBL
	 RET
TYPCB4:	SKIPN T1,CBLK+.NSCPW	;Password?
	 JRST TYPCB5		;no
	MOVEI T2,[ASCIZ \Password: \]
	CALL TYPSBL
	 RET
TYPCB5:	SKIPN T1,CBLK+.NSCAC	;Account?
	 JRST TYPCB6		;no
	MOVEI T2,[ASCIZ \Account: \]
	CALL TYPSBL
	 RET
TYPCB6:	SKIPN T1,CBLK+.NSCUD	;User data?
	 JRST TYPCB7
	MOVEI T2,[ASCIZ \User data: \]
	CALL TYPSBL
	 RET
TYPCB7:	RETSKP			;Finit.


RETARG:	TRNN T1,FL.R		;Is this going to be read?
	 TDZA T1,T1		;No, just return a 0
	$PROMPT T1,%OCTAL,<Argument: >
	RETSKP			;Return success

RETSBL:
	MOVEI T2,SMAX		;Get size of string block we will take
	MOVEI T3,SBLK		;Pointer to string block
	JRST INPSBL		;And input it

RETBCT:
RETBPT:
	$DIE UNF,<Unfinished code>
SAVJMP:	EXCH	F,-1(P)		;Swap things around a bit
	EXCH	F,(P)		;muddy the water a bit
	EXCH	F,-1(P)		;make things confusing
	POPJ	P,		;return to caller with stack set up

.SAV1:
	EXCH	P1,(P)		;save current value of P1, get calling PC
	PUSH	P,P1		;push calling PC
	MOVE	P1,-1(P)	;restore original value of PC
	PUSHJ	P,SAVJMP	;return to caller, with stack fixed up
	 SKP			;non skip return
	 AOS	-1(P)		;skip return, bump higher level return pc
	JRST	.RES1		;pop acs off
.SAV2:
	EXCH	P1,(P)		;save current value of P1, get calling PC
	PUSH	P,P2
	PUSH	P,P1		;push calling PC
	MOVE	P1,-2(P)	;restore original value of PC
	PUSHJ	P,SAVJMP	;return to caller, with stack fixed up
	 SKP			;non skip return
	 AOS	-2(P)		;skip return, bump higher level return pc
;	JRST	.RES2		;pop acs off

.RES2:	POP	P,P2		;  few
.RES1:	POP	P,P1		;   acs
	RET			;return to higher level routine

	END START