Google
 

Trailing-Edge - PDP-10 Archives - decnet_mcb_cusps_703a - 10,7/dcnmcb/nipgen.mac
There are 9 other files named nipgen.mac in the archive. Click here to see a list.
	TITLE	NIPGEN	Network Installation Procedure test GENerator
	SUBTTL	William C. Davenport/WXD	4-SEP-85

	SEARCH	GLXMAC, ORNMAC		; Get required symbols
	PROLOG	(NIPGEN)		; Declare our name
	.DIREC	FLBLST			; Generate clean listing
	PARSET				; Declare external PARSER routines
	EXTERN	PARSER			; ...

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1983,1985,1986. ALL RIGHTS RESERVED.
;
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
; ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
; COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
; AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

TOPS10 <COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION  1983,1986. ALL RIGHTS RESERVED.>
\;END COPYRIGHT MACRO

	.TEXT	"REL:GLXLIB/SEARCH, REL:OPRPAR/SEGMENT:LOW"


; Program version information

	NIPVER==4			; Major version number
	NIPEDT==25			; Edit level (see Edit History)
	NIPWHO==0			; Editor
	NIPMIN==0			; Minor version number

	%%NIP==VRSN.(NIP)		; Full word version

	LOC	137
.JBVER::! EXP	%%NIP			; Store program version
	RELOC
	SUBTTL	Table of Contents


;               TABLE OF CONTENTS FOR NIPGEN
;
;
;                        SECTION                                   PAGE
;    1. Table of Contents.........................................   2
;    2. Revision History..........................................   3
;    3. Symbol Definitions
;         3.1   Assembly Constants................................   6
;         3.2   Configuration Constants...........................   7
;    4. Macros
;         4.1   ASK$..............................................   9
;         4.2   ERROR$............................................  10
;         4.3   DLLXPD............................................  11
;         4.4   DLLNXT............................................  12
;         4.5   XXDLL.............................................  13
;    5. Data Structures
;         5.1   Access Information Block..........................  14
;         5.2   Node Information Block............................  15
;         5.3   Circuit Table.....................................  17
;    6. Data Segment
;         6.1   File Descriptor Blocks............................  18
;         6.2   Parser Function Descriptor Blocks.................  19
;         6.3   Permanent Data....................................  25
;         6.4   Volatile Data.....................................  26
;    7. Program Initialization....................................  27
;    8. Dialog starts here........................................  28
;    9. Configuration Dialog
;         9.1   Adjacent Nodes....................................  30
;         9.2   Remote Nodes......................................  32
;         9.3   File Transfer Testing.............................  33
;         9.4   Access Information................................  34
;   10. File Generation
;        10.1   NCP.CMD...........................................  35
;        10.2   NIPTST.CTL........................................  37
;        10.3   NIPNFT.CTL........................................  42
;   11. Support Routines
;        11.1   Node Information Block Manipulation...............  44
;        11.2   Circuit Table Manipulation........................  49
;        11.3   File Processing...................................  52
;        11.4   S$ASK.............................................  53
;        11.5   S$ERRO............................................  55
;        11.6   CMPADR - Compare node addresses...................  56
;        11.7   P$NAD - Parse DECnet node address.................  57
;        11.8   Node Address Typeout..............................  58
;        11.9   CPYTXT............................................  59
;        11.10  K%ECHO............................................  60
;        11.11  Memory Allocation.................................  61
;   12. The End...................................................  62
	SUBTTL	Revision History


COMMENT	#

Edit	Description

*****   Start of version 2   *****

1	11-Oct-83 by Bill Davenport

	Complete reworking of original program to address issues
	raised by QAR 125588.  Based on earlier program of same
	name by Stu Grossman.

2	25-Oct-83 by Bill Davenport

	Fix the copying of user-id, account, and password to respect
	the size of those fields in an access information block (AIB).
	Also fix allocation of string storage to allocate enough room
	for trailing null bytes.  Increase size of atom buffer to avoid
	ABS stopcodes from GLXSCN.

3	28-Nov-83 by Bill Davenport

	Fix the NFT command files to include /ASCII so that transfers
	to systems other than TOPS-10 and TOPS-20 work properly.  Also
	change the title output at startup to print the DECnet version
	number instead of the NIPGEN version.

4	30-Nov-83 by Bill Davenport

	Up the number of KLs supported under TOPS-10 to six!

5	1-Dec-83 by Bill Davenport

	Fix the /ASCII switch again.  It belongs on the right side
	of the NFT commands, and not on the remote node's file-spec.
	Also change questions asking about the "configuration" to
	ask about what should be "tested".


; Revision History continued on next page
; Revision History continued from previous page


****    Start of version 4 for DECnet version 4.0    ****

6	9-Feb-84 by Bill Davenport

	Many changes to make runable on TOPS-20.  Largest is
	conversion to use OPRPAR for parsing.

7	15-May-84 by Bill Davenport

	Add feature test FTUNSUPPORTED to exclude support of un-
	supported hardware.

10	30-Aug-84 by Bill Davenport

	Use new GLXLIB routine K%ECHO to disable terminal echoing of
	passwords.

11	7-Sep-84 by Bill Davenport

	Rework all questions dealing with adjacent nodes.

12	13-Nov-84 by Bill Davenport

	Add questions dealing with dependent nodes.

13	27-Nov-84 by Bill Davenport

	Changed maximum acceptable node number to 1023 for DECnet
	phase IV.  Change the ethernet circuit identifier to NI-n-n
	for TOPS-20.

14	17-Dec-84 by Bill Davenport

	Changed node address parsing to allow specification of area
	numbers.  Also changed program structure to make this work.
	Add code to ask for NML access information for MCBs.


; Revision History continued on next page
; Revision History continued from previous page


15	15-Jan-85 by Bill Davenport

	Add SET CIRCUIT x STATE ON commands to the NCP.CMD file.
	Change dependent node dialog into downline load dialog.
	Add complete support for downline servicing of LAT(PLUTO),
	LAT(LAT-11), and MCB nodes.

16	24-Jan-85 by Bill Davenport

	Set flags to ask about file transfer tests defined in the
	remote node definition section.

17	14-Mar-85 by Bill Davenport

	Add SET CIRCUIT SERVICE ENABLED commands for all service
	circuits.  Close a hole which could trap a user trying to
	insert more circuits than are in parse table (by duplicating
	circuit of last entry).

20	20-Mar-85 by Bill Davenport

	Remove CI circuits from TOPS-10 supported list.

21	1-Apr-85 by Bill Davenport

	Change TOPS-10 ethernet circuit name to ETH-n.  Output SET
	CIRCUIT commands at end of NCP.CMD file.  Make sure each
	circuit gets output only once.

22	3-Apr-85 by Bill Davenport

	Change adjacent node definition section to recognize MCBs and
	to generate the correct service information.  Incorporate the
	service information block into the node information block.  Ask
	about additional downline loaded nodes after asking about any
	adjacent nodes.

23	6-May-85 by Bill Davenport

	Remove all LAT related dialog.  This dialog will form the basis
	for the new LATGEN program.

24	4-Sep-85 by Leo
	Do Copyrights.

25	11-Nov-85 by Carl Appellof

	Fix "SET NODE nnnn NAME xxxx" to use area.address in GENNCP.
#; End Revision History
	SUBTTL	Symbol Definitions  --  Assembly Constants


; Feature Test Switches

	ND FTUNSUPPORTED, 0	; Exclude support for unsupported hardware


; Additional ACs

	FL==.A13		; Flags register
		FL%HDR==1B0		; Header line output flag


; Assembly constants

	PDLLEN==^D200		; Length of stack
	NOD.MX==^D100		; Maximum number of nodes supported
	PRM.SZ==^D80		; Prompt string length in characters
	DFL.SZ==^D80		; Default string length in characters
	CMD.SZ==1000		; Command data block size in words
	UID.SZ==^D16		; User-id length in characters
	ACC.SZ==^D16		; Account length in characters
	PSW.SZ==^D16		; Password length in characters


; DECnet constants

	MAXARE==^D63		; Maximum area number
	MAXADR==^D1023		; Maximum node address
	SUBTTL	Symbol Definitions  --  Configuration Constants


; TOPS10 Configuration constants

TOPS10 <			; If TOPS-10 version
IFE FTUNSUPPORTED,<		; If just supported hardware
	SY.KL1==3		; Up to three KL10s on a system 
>; End IFE FTUNSUPPORTED
IFN FTUNSUPPORTED,<		; If unsupported hardware
	SY.KL1==6		; Up to six KL10s on a system 
>; End IFN FTUNSUPPORTED
	KL.MCB==3		; Up to three MCBs on a KL10
	SY.ETH==1		; Up to one Ethernet on a system
IFE FTUNSUPPORTED,<		; If just supported hardware
	KL.CI2==0		; No CI-20s
>; End IFE FTUNSUPPORTED
IFN FTUNSUPPORTED,<		; If unsupported hardware
	KL.CI2==1		; Up to one CI-20 on a KL10
	CI.CIP==^D16		; Up to sixteen ports on a CI-20
>; End IFN FTUNSUPPORTED

	KS.KMC==1		; Up to one KMC11 on KS10
	KS.KDU==2		; Up to two DUP11s on a KMC11
>; End TOPS10
; TOPS20 Configuration constants

TOPS20 <			; If TOPS-20 version
	SY.KL1==1		; Up to one KL10 on a system 
	KL.MCB==3		; Up to three MCBs on a KL10

	SY.ETH==1		; Up to one Ethernet on a system
	KL.CI2==1		; Up to one CI-20 on a KL10
	CI.CIP==^D16		; Up to sixteen ports on a CI-20
>; End TOPS20


; MCB Configuration constants

	MC.DMC==4		; Up to four DMC11s on an MCB
	MC.DMR==4		; Up to four DMR11s on an MCB
	MC.KMC==2		; Up to two KMC11s on an MCB
	MC.KDU==4		; Up to four DUP11s on a KMC11
	SUBTTL	Macros  --  ASK$


; Macro to ask a question and parse answer
; Use:
;	ASK$	(TEXT,PDB)
;
; Where:
;	TEXT	- $TEXT form of prompt
;		  (May not make references to P)
;	PDB	- Address of parser data block
;
; ASK$ preserves all acs except S1 and S2.  On return, S1 has
; the value, and S2 the address of the response block.

DEFINE	ASK$(TEXT$,PDB$,%DUMMY),<
	$CALL	S$ASK		;; Call generic ask routine
	LSTOF.			;; Don't list expansion
	.XCREF	%DUMMY		;; Don't waste CREF space
	.NODDT	%DUMMY		;; Don't waste symbol table space
	JRST	%DUMMY		;; Skip this
	XWD	0,[ITEXT <TEXT$>]	;; Prompt string
	PDB$			;; Parser data block
%DUMMY:	LSTON.			;; Skip around to here
>; END DEFINE ASK$
	SUBTTL	Macros  --  ERROR$


; Macro to print an error message and continue elsewhere
; Use:
;	ERROR$	(TEXT,ADDR)
;
; Where:
;	TEXT	- $TEXT form of error message
;		  (May not make references to P)
;	ADDR	- Continuation address (.+1 if empty)
;
; ERROR$ preserves all acs.

DEFINE	ERROR$(TEXT$,ADDR$,%DUMMY),<
	$CALL	S$ERRO		;; Call generic error routine
	LSTOF.			;; Don't list expansion
	.XCREF	%DUMMY		;; Don't waste CREF space
	.NODDT	%DUMMY		;; Don't waste symbol table space
	JRST	%DUMMY		;; Skip this
	XWD	0,[ITEXT <TEXT$>]	;; Error message string
	XWD	0,ADDR$		;; Continuation address
%DUMMY:	LSTON.			;; Skip around to here
>; END DEFINE ERROR$
	SUBTTL	Macros  --  DLLXPD


; Macro for generation of circuit parse list
; Use:
;	DLLXPD	(X,K,N,D)
;
; Where:
;
;	X	- Device name (e.g. DTE, NI, KDP, etc.)
;	K	- Controller count
;	N	- Device count (per controller)
;	D	- Drop count (per device)

DEFINE	DLLXPD	(X, K, N, D, %%R, %%K, %%N, %%M, %%D),<

%%R==<%%K==<%%N==<%%M==<%%D==0>>>>	;; Initialize all locals
.XCREF	%%R, %%K, %%N, %%M, %%D		;; Don't waste CREF space
.NODDT	%%R, %%K, %%N, %%M, %%D		;; Or symbol table space

%%R==10					;; Save current RADIX
RADIX	^D10				;; Everything in decimal RADIX
%%K==0					;; Starting with controller 0
REPEAT	K,<				;; For each controller
	IFB <N>,<			;; If no devices on controller
		XXDLL	X, \%%K
	>; End IFB <N>
	IFNB <N>,<			;; If devices on controller
		%%N==0			;; Starting with device 0
		%%M==N			;; End with device N-1
		IFIDN <X><DTE>,<	;; If DTE controller
			%%N==1		;; Start with device 1
			%%M==N+1	;; End with device N
		>; End IFIDN <X><DTE>
		REPEAT	N,<		;; For each device on a controller
			%%D==0		;; Starting with drop 0
			IFB <D>,<	;; If no drops on controller
				XXDLL	X, \%%K, \%%N
			>; End IFB <D>
			IFNB <D>,<	;; If drops on controller
				REPEAT	D,<	;; For each drop on a device
					XXDLL	X, \%%K, \%%N, \%%D
					DLLNXT	%%D, D	;; Bump to next drop
				>; End REPEAT D
			>; End IFNB <D>
			DLLNXT	%%N, %%M	;; Bump to next device
		>; End REPEAT N
	>; End IFNB <N>
	DLLNXT	%%K, K			;; Bump to next controller
>; End REPEAT K

RADIX	%%R				;; Reset original RADIX

>; End DEFINE DLLXPD
	SUBTTL	Macros  --  DLLNXT


; Helper macro for DLLXPD for generation of numbers in alphabetic
; order (e.g. 0, 1, 10, 11, ..., 19, 2, 20, ...)
; Use:
;	DLLNXT	(N, M)
;
; Where:
;
;	N	- Current number (set to next number)
;	M	- Number of numbers in sequence (maximum +1)


DEFINE	DLLNXT	(N, M, %%N, %%F),<

%%N==<%%F==0>				;; Initialize all locals
.XCREF	%%N, %%F			;; Don't waste CREF space
.NODDT	%%N, %%F			;; Or symbol table space

%%N==N					;; Save current value
%%F==0					;; Clear special case flag
IFN %%N,<				;; If other than 0'th entry
	IFL <10*%%N-M>,<		;; If next multiple less than maximum
		N==10*%%N		;; Then step up to next multiple
		%%F==1			;; Set flag
	>; End IFL <10*%%N-M>
	IFGE <%%N+1-M>,<		;; If next entry at maximum (or past)
		N==%%N/10+1		;; Drop to previous multiple
		%%F==1			;; Set flag
	>; End IFGE <%%N+1-M>
>; End IFN N
IFE %%F,<				;; If special case flag not set
	N==N+1				;; Step to next entry
	REPEAT 10,<			;; Repeat until test is false
		IFE <10*<N/10>-N>,<	;; If next entry even multiple
			N==N/10		;; Drop to previous multiple
		>; End IFE <10*<N/10>-N>
	>; End Repeat 10
>; End IFE %%F

>; End DEFINE DLLNXT
	SUBTTL	Macros  --  XXDLL


; Macro to generate actual parse table entries
; Use:
;	XXDLL	(X, K, N, D)
;
; Where:
;
;	X	- Device name (e.g. DTE, NI, KDP, etc.)
;	K	- Controller number in alpha
;	N	- Device number in alpha (only for multi-device controllers)
;	D	- Drop number in alpha (only for multi-drop devices)


DEFINE	XXDLL	(X, K, N, D, %%L),<
	%%L==FLD (CT%'X, CD%TYP)	;; Circuit type code
	IFB <N>,<
		KEYTAB	[%%L+[ASCIZ |X-K|]],<X-K>
	>; End IFB <N>
	IFNB <N>,<
		IFB <D>,<
			KEYTAB	[%%L+[ASCIZ |X-K-N|]],<X-K-N>
		>; End IFB <D>
		IFNB <D>,<
			KEYTAB	[%%L+[ASCIZ |X-K-N'.'D|]],<X-K-N'.'D>
		>; End IFNB <D>
	>; End IFNB <N>
>; End DEFINE XXDLL
	SUBTTL	Data Structures  --  Access Information Block


; Access Information Blocks are used to hold the user-id, account,
; and password for NML and NFT uses.
;
;	!=======================================================!
;	!                 ASCIZ User-id string                  !
;	!=======================================================!
;	!                 ASCIZ Account string                  !
;	!=======================================================!
;	!                 ASCIZ Password string                 !
;	!=======================================================!

	PHASE	0		; These are offsets

AIBUID:! BLOCK	<UID.SZ+1+4>/5	; User-id
AIBACC:! BLOCK	<ACC.SZ+1+4>/5	; Account
AIBPSW:! BLOCK	<PSW.SZ+1+4>/5	; Password

AIB.SZ:!			; Length of Access Information Block

	DEPHASE
	SUBTTL	Data Structures  --  Node Information Block


; Each node declared within NIPGEN has a node information block
;
;	!=======================================================!
;	!                   SIXBIT Node Name                    !
;	!=======================================================!
;	!                     Node Address                      !
;	!=======================================================!
;	!                    Flags (NF%xxx)                     !
;	!=======================================================!
;	!            Address of Circuit Parse Block             !
;	!=======================================================!
;	!            AOBJN Pointer to Circuit Table             !
;	!=======================================================!
;	!                                                       !
;	!             NML Access Information Block              !
;	!                                                       !
;	!=======================================================!
;	!                                                       !
;	!             NFT Access Information Block              !
;	!                                                       !
;	!=======================================================!

	PHASE	0		; These are offsets

NIBNAM:! BLOCK	1		; SIXBIT node name
NIBNAD:! BLOCK	1		; Node address
NIBFLG:! BLOCK	1		; Flags
	NF%MCB==1B0			; Node is an MCB
	NF%TFT==1B1			; Test file transfer
NIBCPB:! BLOCK	1		; Address of circuit parse block
NIBCKT:! BLOCK	1		; AOBJN pointer to circuit table
NIBNML:! BLOCK	AIB.SZ		; NML access information
NIBNFT:! BLOCK	AIB.SZ		; NFT access information

NIB.SZ:!			; Length of node information block

	DEPHASE
; Some useful aliases

	NMLUID==NIBNML+AIBUID		; NML user-id
	NMLACC==NIBNML+AIBACC		; NML account
	NMLPSW==NIBNML+AIBPSW		; NML password

	NFTUID==NIBNFT+AIBUID		; NFT user-id
	NFTACC==NIBNFT+AIBACC		; NFT account
	NFTPSW==NIBNFT+AIBPSW		; NFT password
	SUBTTL	Data Structures  --  Circuit Table


; Each NIB with declared circuits has a circuit table pointed to
; by NIBCKT.  This table consists of individual circuit descriptions
;
;	!=======================================================!
;	!                Circuit Descriptor Word                !
;	!=======================================================!
;	!             Address of Remote Node's NIB              !
;	!=======================================================!

	PHASE	0		; These are offsets

CKTCDW:! BLOCK	1		; Circuit descriptor word
	 CD%TYP==777B8			; Circuit type
		CT%ETH==1			; Ethernet
		CT%NI==1			; Ethernet (TOPS-20 name)
		CT%CI==2			; CI-20 SCA virtual circuit
		CT%DTE==3			; DTE-20 interface
		CT%DMC==4			; DMC-11 line driver
		CT%DMR==5			; DMR-11 line driver
		CT%KDP==6			; KDP-11 line driver
	 CD%ASN==777777B35		; Address of ASCIZ circuit name
CKTNIB:! BLOCK	1		; Address of remote node's NIB

CKT.SZ:!			; Length of circuit description entry

	DEPHASE
	SUBTTL	Data Segment  --  File Descriptor Blocks


; File Descriptor Blocks

NCPFD:				; File descriptor block for NCP.CMD
TOPS10 <			; If TOPS-10 version
	$BUILD	(FDMSIZ)	; Build FD
	  $SET	(.FDLEN,FD.LEN,FDMSIZ)	; Store length of FD
	  $SET	(.FDSTR,,'DSK   ')	; Store file structure
	  $SET	(.FDNAM,,'NCP   ')	; Store filename
	  $SET	(.FDEXT,,'CMD   ')	; Store extension
	$EOB
>; End TOPS10
TOPS20 <			; If TOPS-20 version
	XWD	NCP.SZ,0	; Size of file string
	ASCIZ	|DSK:NCP.CMD|	; File description
NCP.SZ==.-NCPFD
>; End TOPS20

TSTFD:				; File descriptor block for NIPTST.CTL
TOPS10 <			; If TOPS-10 version
	$BUILD	(FDMSIZ)	; Build FD
	  $SET	(.FDLEN,FD.LEN,FDMSIZ)	; Store length of FD
	  $SET	(.FDSTR,,'DSK   ')	; Store file structure
	  $SET	(.FDNAM,,'NIPTST')	; Store filename
	  $SET	(.FDEXT,,'CTL   ')	; Store extension
	$EOB
>; End TOPS10
TOPS20 <			; If TOPS-20 version
	XWD	TST.SZ,0	; Size of file string
	ASCIZ	|DSK:NIPTST.CTL|	; File description
TST.SZ==.-TSTFD
>; End TOPS20

NFTFD:				; File descriptor block for NIPNFT.CMD
TOPS10 <			; If TOPS-10 version
	$BUILD	(FDMSIZ)	; Build FD
	  $SET	(.FDLEN,FD.LEN,FDMSIZ)	; Store length of FD
	  $SET	(.FDSTR,,'DSK   ')	; Store file structure
	  $SET	(.FDNAM,,'NIPNFT')	; Store filename
	  $SET	(.FDEXT,,'CTL   ')	; Store extension
	$EOB
>; End TOPS10
TOPS20 <			; If TOPS-20 version
	XWD	NFT.SZ,0	; Size of file string
	ASCIZ	|DSK:NIPNFT.CTL|	; File description
NFT.SZ==.-NFTFD
>; End TOPS20
	SUBTTL	Data Segment  --  Parser Function Descriptor Blocks


; Initial Parser Function Descriptor Block

INIPDB:	$INIT	(CFMPDB)


; Parser Function Descriptor Block for Confirms

CFMPDB:	$CRLF


; Parser Function Descriptor Block for Node Names

NDNPDB:	$NODNM	(CFMPDB,,<$FLAGS(CM%PO!CM%NSF)>)


; Parser Function Descriptor Block for Node Addresses

NDAPDB:	$NUMBER	(NDAPD1,^D10,<Area number or node address>)
NDAPD1:	$TOKEN	(NDAPD2,<.>,$ALTERNATE(CFMPDB))
NDAPD2:	$NUMBER	(CFMPDB,^D10,<Node address>)


; Parser Function Descriptor Block for CPU Specific Dialog Routine

TOPS10 <				; If TOPS-10 version
CPUPDB:	$KEY	(CFMPDB,CPUTAB,<$PDEFAULT(DEFAUL)>)

CPUTAB:	$STAB
	  KEYTAB [KLCPDB],<KL10>
	  KEYTAB [KSCPDB],<KS10>
	$ETAB
>; End TOPS10


; Parser Function Descriptor Block for Circuit Counts

NUMPDB:	$NUMBER	(CFMPDB,^D10)
; Parser Function Descriptor Block for Remote Node Names

RNNPDB:	$CRLF	(<$ALTERNATE(NDNPDB)>)


; Parser Function Descriptor Block for YES/NO Answer

YNOPDB:	$KEY	(CFMPDB,YNOTAB,<$DEFAULT(NO)>)

YNOTAB:	$STAB
	  KEYTAB FALSE,<NO>
	  KEYTAB TRUE,<YES>
	$ETAB


; Parser Function Descriptor Block for User-id

UIDPDB:	$CTEXT	(CFMPDB,,<$ALTERNATE(CFMPDB)>)


; Parser Function Descriptor Block for Account

ACCPDB:	$CRLF	(<$ALTERNATE(ACCPD1)>)

ACCPD1:	$CTEXT	(CFMPDB)


; Parser Function Descriptor Block for Password

PSWPDB:	$CRLF	(<$ALTERNATE(PSWPD1)>)

PSWPD1:	$CTEXT	(CFMPDB)
; Parser Function Descriptor Block for KL10 circuits

KLCPDB:	$KEY	(CFMPDB,KLCTAB,$BREAK(CIRMSK))

KLCTAB:	$STAB
	DLLXPD	CI,SY.KL1,KL.CI2,CI.CIP
	DLLXPD	DTE,SY.KL1,KL.MCB
TOPS10 <DLLXPD	ETH,SY.ETH>
TOPS20 <DLLXPD	NI,SY.KL1,SY.ETH>
	$ETAB
; Parser Function Descriptor Block for MCB circuits

MCCPDB:	$KEY	(CFMPDB,MCCTAB,$BREAK(CIRMSK))

MCCTAB:	$STAB
	DLLXPD	DMC,MC.DMC
	DLLXPD	DMR,MC.DMR
	DLLXPD	KDP,MC.KMC,MC.KDU
	$ETAB
; Parser Function Descriptor Block for KS10 circuits

TOPS10 <				; If TOPS-10 version
KSCPDB:	$KEY	(CFMPDB,KSCTAB,$BREAK(CIRMSK))

KSCTAB:	$STAB
	DLLXPD	KDP,KS.KMC,KS.KDU
	$ETAB
>; End TOPS10
; Break Mask for Circuits

CIRMSK:	777777,,777760			; All control characters
	777744,,001760			; Except "-", ".", and numbers
	400000,,000760			; Upper case alphabetics
	400000,,000760			; And lower case alphabetics
	SUBTTL	Data Segment  --  Permanent Data


; TOPS20 entry vector

TOPS20 <				; If TOPS-20 version
NIPEVC:	JRST	NIPGEN			; Normal start
	JRST	NIPGEN			; Reenter address
	EXP	%%NIP			; Program version
NIPEVL==.-NIPEVC			; Entry vector length
>; End TOPS20


; GLXLIB initialization block

NIPIB:	$BUILD	(IB.SZ)			; Initialization block
	  $SET	(IB.PRG,,'NIPGEN')	; Program name
	  $SET	(IB.FLG,,IT.OCT)	; Require command terminal
	$EOB


; NIPGEN full name

NIPNAM:	TOPS10	<ASCIZ |NIPGEN-10|>	; Full name including suffix
	TOPS20	<ASCIZ |NIPGEN-20|>	; ...


; NFT Access Information ITEXT Block

NFTITX:	TOPS10	<ITEXT (/USER:^T/NFTUID(P1)/:^T/NFTACC(P1)/:^T/NFTPSW(P1)/)>
	TOPS20	<ITEXT (/USER:^T/NFTUID(P1)//ACCOUNT:^T/NFTACC(P1)//PASSWORD:^T/NFTPSW(P1)/)>


; System specific devices

SYSITX:	TOPS10	<ITEXT (SYS:)>		; System device
	TOPS20	<ITEXT (SYS:)>

DMPITX:	TOPS10	<ITEXT (XPN:)>		; Dump device
	TOPS20	<ITEXT (SYS:)>
	SUBTTL	Data Segment  --  Volatile Data


; Impure storage

	$DATA	PDL,PDLLEN		; Program stack

LOWBEG:!				; Start of area cleared on restart
	$DATA	HSTNIB			; Address of host's NIB
	$DATA	OUTFD			; Address of current output file's FD
	$DATA	OUTIFN			; IFN of output file
	$DATA	OUTFOB,FOB.SZ		; File Operation Block of output file
	$DATA	DEFARE			; Default area number

	$DATA	PROMPT,<<PRM.SZ+1+4>/5>	; Prompt string storage
	$DATA	DEFAUL,<<DFL.SZ+1+4>/5>	; Default string storage
	$DATA	PARBLK,PAR.SZ		; Parser control block
	$DATA	CMDBLK,CMD.SZ		; Command data area

	$DATA	NODLST,NOD.MX		; Node list (pointers to NIBs)
LOWSIZ==.-LOWBEG			; Size of area to clear
	SUBTTL	Program Initialization


NIPGEN:	RESET				; Blow away the world
	MOVE	P,[IOWD PDLLEN,PDL]	; Set up stack

	MOVEI	S1,IB.SZ		; Get length of init block
	MOVEI	S2,NIPIB		; Get addr of block
	$CALL	I%INIT			; Initialize GLXLIB

	MOVEI	S1,LOWSIZ		; Zero impure data segment
	MOVEI	S2,LOWBEG		; ...
	$CALL	.ZCHNK			; ...

TOPS10 <				; If TOPS-10 version
	$TEXT	(,<NIPGEN for DECnet-10 version 4.0>)
>; End TOPS20
TOPS20 <				; If TOPS-20 version
	$TEXT	(,<NIPGEN for DECnet-20 version 4.0>)
>; End TOPS20
	SUBTTL	Dialog starts here


DIALOG:	$TEXT	(,<^M^J^JHost node definition section.>)

DIALO1:	ASK$	(<^M^JHost name: >,NDNPDB)
	$CALL	P$NODE			; Get node name
	TLNN	S1,770000		; Skip if SIXBIT style node name
	  ERROR$ (<Invalid node name: "^D/S1/">,DIALO1)

	MOVE	P1,S1			; Save node name in P1

DIALO2:	ASK$	(<^W/P1/'s node address: >,NDAPDB)
	$CALL	P$NAD			; Get node address
	JUMPF	DIALO2			; Loop back on error

	MOVE	S2,S1			; Get node address
	MOVE	S1,P1			; Get node name
	$CALL	GETNIB			; Get Node Information Block
	SKIPT				; Skip if successful
	  $STOP	(CCN,Can't create host's Node Information Block)
	MOVE	P1,S1			; Save address of NIB in P1
	MOVEM	P1,HSTNIB		; Save address in HSTNIB for later use

	MOVE	S1,NIBNAD(P1)		; Get host's network address
	LSH	S1,-^D10		; Get host's area number
	MOVEM	S1,DEFARE		; Save as default area number

					; Continued on next page
					; Continued from previous page

TOPS10 <				; If TOPS-10 version
	MOVX	S2,%FTERR		; Get feature tests
	GETTAB	S2,			; From the monitor
	  SETZ	S2,			;  Default to nothing
	SETZ	S1,			; Assume nothing
	TXNE	S2,F%KL10&RHMASK	; Are we a KL?
	  MOVEI	S1,[ASCIZ |KL10|]	;  Yes.
	TXNE	S2,F%KS10&RHMASK	; Are we a KS?
	  MOVEI	S1,[ASCIZ |KS10|]	;  Yes, say so
	$TEXT	(<-1,,DEFAUL>,<^T/(S1)/^A^0>) ; Install the default
	ASK$	(<^W/NIBNAM(P1)/'s CPU type(^T/DEFAUL/): >,CPUPDB)
	$CALL	P$KEYW			; Get address of circuit parse block
>; End TOPS10
TOPS20 <				; If TOPS-20 version
	MOVEI	S1,[KLCPDB]		; Get address of parse block
>; End TOPS20

	MOVE	S2,(S1)			; Get circuit parse block address
	MOVEM	S2,NIBCPB(P1)		; Save in NIB

	MOVE	S1,P1			; Get address of host's NIB
	SETZ	S2,			; No superior host NIB
	$CALL	ASKADJ			; Go ask about adjacent nodes

	$CALL	ASKRMT			; Now go ask about remote nodes
	$CALL	ASKNFT			; Go ask about file transfer testing

	$CALL	GENNCP			; Generate NCP.CMD command file
	$CALL	GENTST			; Generate NIPTST.CTL control file
	$CALL	GENNFT			; Generate NIPNFT.CTL control file

	$CALL	I%EXIT			; And then exit
	SUBTTL	Configuration Dialog  --  Adjacent Nodes


; Call with node's NIB address in S1, node's host NIB (or zero) in S2

ASKADJ:	$SAVE	<P1,P2,P3,P4>		; Save P1, P2, P3, and P4

	MOVE	P2,S1			; Save address of node's NIB in P2
	MOVE	P3,S2			; And host's NIB in P3

	MOVX	S1,NF%MCB		; Is this an MCB?
	TDNE	S1,NIBFLG(P2)		; ...
	  SKIPA	S1,[-1,,[ASCIZ |MCB|]]	; Yes, get special node type and skip
	HRROI	S1,[ASCIZ |node|]	; No, get generic node type

	$TEXT	(,<^M^J^JFor ^T/(S1)/ ^W/NIBNAM(P2)/:>)
	$TEXT	(,<Adjacent node definition section.>)
	$TEXT	(,<(Type an extra CR when through)>)

ASKAJ1:	ASK$	(<^M^JAdjacent node name: >,RNNPDB)
	$CALL	P$NODE			; Get node name
	JUMPF	ASKAJ4			; Exit loop if just confirm
	TLNN	S1,770000		; Skip if SIXBIT style node name
	  ERROR$ (<Invalid node name: "^D/S1/">,ASKAJ1)
	SKIPE	P3			; Have a host NIB?
	CAME	S1,NIBNAM(P3)		; Yes, guard against foolishness
	CAMN	S1,NIBNAM(P2)		; Guard against foolishness
	  ERROR$ (<Invalid node name: "^W/S1/">,ASKAJ1)
	MOVE	P1,S1			; Save node name in P1

ASKAJ2:	ASK$	(<    ^W/P1/'s node address: >,NDAPDB)
	$CALL	P$NAD			; Get node address
	JUMPF	ASKAJ2			; Loop back on error

	MOVE	S2,S1			; Get node address
	MOVE	S1,P1			; Get node name
	$CALL	GETNIB			; Get Node Information Block
	JUMPF	ASKAJ1			; Ask again if can't
	MOVE	P1,S1			; Save NIB address in P1

					; Continued on next page
					; Continued from previous page

ASKAJ3:	ASK$	(<    ^W/NIBNAM(P2)/'s circuit to ^W/NIBNAM(P1)/: >,@NIBCPB(P2))
	$CALL	P$KEYW			; Get address of circuit descriptor
	MOVE	S1,(S1)			; Get circuit descriptor word
	MOVE	S2,P2			; Get address of host's NIB
	HRL	S2,P1			; And address of adjacent node's NIB
	PUSH	P,S1			; Save circuit descriptor
	$CALL	ADDCKT			; Add circuit to circuit table
	POP	P,S1			; Get back circuit descriptor
	JUMPF	ASKAJ1			; Ask again if can't
	LOAD	S1,S1,CD%TYP		; Get circuit type
	CAXE	S1,CT%DTE		; Is this a DTE?
	JRST	ASKAJ1			; No, loop back
	MOVEI	S1,NIBNML(P1)		; Get address of NML's AIB
	HRROI	S2,[ASCIZ /Network management/] ;And address of message
	$CALL	ASKAIB			; Get network management information

	JRST	ASKAJ1			; Loop back for all adjacent nodes

ASKAJ4:	MOVE	P4,NIBCKT(P2)		; Get AOBJN pointer to circuit table
ASKAJ5:	SKIPN	P1,CKTNIB(P4)		; Get NIB of next node
	  JRST	ASKAJ6			; Skip this if no NIB
	MOVE	S2,CKTCDW(P4)		; Get circuit descriptor word
	LOAD	S1,S2,CD%TYP		; Get circuit type
	CAXE	S1,CT%DTE		; A DTE?
	  JRST	ASKAJ6			; No, skip this node
	MOVX	S1,NF%MCB		; Mark this node as an MCB
	IORM	S1,NIBFLG(P1)		; ...
	MOVEI	S1,MCCPDB		; Get MCB circuit parse block address
	MOVEM	S1,NIBCPB(P1)		; Save in NIB
	MOVE	S1,P1			; Get address of MCB NIB
	MOVE	S2,P2			; Get address of host NIB
	$CALL	ASKADJ			; Ask about that MCB's adjacencies
ASKAJ6:	ADDI	P4,CKT.SZ-1		; Offset to next circuit table entry
	AOBJN	P4,ASKAJ5		; Loop for all nodes

	$RETT				; Return
	SUBTTL	Configuration Dialog  --  Remote Nodes


ASKRMT:	$TEXT	(,<^M^J^JRemote node definition section.>)
	$TEXT	(,<(Type an extra CR when through)>)

	$SAVE	<P1>			; Save P1

ASKRM1:	ASK$	(<^M^JRemote node name: >,RNNPDB)
	$CALL	P$NODE			; Get node name
	JUMPF	.RETT			; Return now if just confirm
	MOVE	P1,S1			; Save node name in P1
	TLNN	P1,770000		; Skip if SIXBIT style node name
	  ERROR$ (<Invalid node name: "^D/P1/">,ASKRM1)

ASKRM2:	ASK$	(<    ^W/P1/'s node address: >,NDAPDB)
	$CALL	P$NAD			; Get node address
	JUMPF	ASKRM2			; Loop back on error

	MOVE	S2,S1			; Get node address
	MOVE	S1,P1			; Get node name
	$CALL	GETNIB			; Get Node Information Block
	JUMPF	ASKRM1			; Ask again if can't

	JRST	ASKRM1			; And then loop back for more
	SUBTTL	Configuration Dialog  --  File Transfer Testing


; ASKNFT is called to ask user about testing NFT for all nodes.

ASKNFT:	$SAVE	<P1,P2>			; Save P1 and P2

	TXZ	FL,FL%HDR		; Clear header line output flag

	MOVSI	P2,-NOD.MX		; Make AOBJN pointer to NODLST
ASKNF1:	SKIPN	P1,NODLST(P2)		; Is there a node defined?
	  JRST	ASKNF2			; No, continue

	MOVX	S1,NF%MCB		; Is this an MCB?
	TDNN	S1,NIBFLG(P1)		; ...
	CAMN	P1,HSTNIB		; Or the host node?
	  JRST	ASKNF2			; Yes, don't ask about NFT

	TXON	FL,FL%HDR		; Output header line yet?
	  $TEXT	(,<^M^J^JFile Transfer test section.^J>)

	ASK$	(<Test file transfers to ^W/NIBNAM(P1)/? ^A>,YNOPDB)
	$CALL	P$KEYW			; Get YES/NO answer
	HRRE	TF,S1			; ...
	JUMPF	ASKNF2			; Skip this if answer is no

	MOVX	S1,NF%TFT		; Set NFT flag
	IORM	S1,NIBFLG(P1)		; ...

	MOVEI	S1,NIBNFT(P1)		; Get address of NFT's AIB
	HRROI	S2,[ASCIZ /File transfer/]	; And address of message
	$CALL	ASKAIB			; Ask for access information

ASKNF2:	AOBJN	P2,ASKNF1		; Loop for all nodes in NODLST

	$RETT				; And then return
	SUBTTL	Configuration Dialog  --  Access Information


; ASKAIB is called to ask user for access information.  Call with
; address of AIB in S1, address of description string in S2.

ASKAIB:	$SAVE	<P1,P2>			; Save P1 and P2

	DMOVE	P1,S1			; Save address of AIB and string

	MOVEI	S1,AIB.SZ		; Get size of AIB
	MOVE	S2,P1			; And address of AIB
	$CALL	.ZCHNK			; Zero AIB block

	ASK$	(<    ^T/(P2)/ user-id: >,UIDPDB)
	$CALL	P$NFLD			; Get type of answer
	CAXN	S1,.CMCFM		; Was it the confirm?
	  JRST	ASKAI1			; Yes, ask for account
	MOVEI	S1,UID.SZ		; Get length of user-id
	MOVE	S2,[POINT 7,AIBUID(P1)]	; And pointer to user-id storage
	$CALL	CPYTXT			; Copy user-id into it

ASKAI1:	ASK$	(<    ^T/(P2)/ account: >,ACCPDB)
	$CALL	P$NFLD			; Get type of answer
	CAXN	S1,.CMCFM		; Was it the confirm?
	  JRST	ASKAI2			; Yes, ask for password
	MOVEI	S1,ACC.SZ		; Get length of account
	MOVE	S2,[POINT 7,AIBACC(P1)]	; And pointer to account storage
	$CALL	CPYTXT			; Copy user-id into it

ASKAI2:	SETZ	S1,			; Disable terminal echo
	$CALL	K%ECHO			; ...
	ASK$	(<    ^T/(P2)/ password: >,PSWPDB)
	SETO	S1,			; Reenable terminal echo
	$CALL	K%ECHO			; ...
TOPS20 <				; If TOPS-20 version
	$TEXT	(,<>)			; Echo a carriage return
>; End TOPS20
	$CALL	P$NFLD			; Get type of answer
	CAXN	S1,.CMCFM		; Was it the confirm?
	  $RETT				; Yes, return now
	MOVEI	S1,PSW.SZ		; Get length of password
	MOVE	S2,[POINT 7,AIBPSW(P1)]	; And pointer to password storage
	$CALL	CPYTXT			; Copy user-id into it

	$RETT				; And return
	SUBTTL	File Generation  --  NCP.CMD


; Call to generate NCP.CMD file from internal data base

GENNCP:	$SAVE	<P1,P2,P3,P4>		; Save P1, P2, P3 and P4

	MOVEI	S1,NCPFD		; Get address of file descriptor block
	$CALL	OPNFIL			; Open file for writing
	JUMPF	OPNERR			; Jump if we have problems

	MOVE	S1,OUTIFN		; Get assigned IFN for file
	SETO	S2,			; Obtain an exact FD
	$CALL	F%FD			; Get address of complete FD
	$TEXT	(,<[Generating ^F/(S1)/]>)

; Now to generate the actual text of the file

	$TEXT	(PUTFIL,<!
! NCP.CMD  --  Node definition file
!
! Generated: ^H/[-1]/ by ^T/NIPNAM/ version ^V/.JBVER/
!
ENTER NCP
>)

	MOVSI	P2,-NOD.MX		; Make AOBJN pointer to NODLST
GENNC1:	SKIPN	P1,NODLST(P2)		; Is there a node defined?
	  JRST	GENNC2			; No, continue
	CAMN	P1,HSTNIB		; Skip if this is the host node
	  JRST	GENNC2
	$TEXT	(PUTFIL,<SET NODE ^A>)
	MOVE	S1,NIBNAD(P1)
	$CALL	PUTNAD
	$TEXT	(PUTFIL,< NAME ^W/NIBNAM(P1)/>)
GENNC2:	AOBJN	P2,GENNC1		; Loop for all nodes in NODLST

					; Continued on next page
					; Continued from previous page

	MOVE	P4,HSTNIB		; Get address of host's NIB
	SKIPN	P3,NIBCKT(P4)		; Get AOBJN pointer to circuit table
	  JRST	GENNC8			; Skip this if no circuits

GENNC3:	SKIPN	P1,CKTNIB(P3)		; Get address of next NIB
	  JRST	GENNC4			; Skip this if no NIB
	MOVE	P2,CKTCDW(P3)		; Get circuit descriptor word
	LOAD	S1,P2,CD%TYP		; Is this an MCB?
	CAXE	S1,CT%DTE		; ...
	  JRST	GENNC4			; No, skip this circuit
	$TEXT	(PUTFIL,<
SET NODE ^W/NIBNAM(P1)/ CPU PDP-11
SET NODE ^W/NIBNAM(P1)/ HOST ^W/NIBNAM(P4)/
SET NODE ^W/NIBNAM(P1)/ SERVICE NODE VERSION 0
SET NODE ^W/NIBNAM(P1)/ SERVICE CIRCUIT ^T/(P2)/
SET NODE ^W/NIBNAM(P1)/ SECONDARY LOADER ^I/SYSITX/DTEMPS.SYS
SET NODE ^W/NIBNAM(P1)/ TERTIARY LOADER ^I/SYSITX/DTEMPT.SYS
SET NODE ^W/NIBNAM(P1)/ LOAD FILE ^I/SYSITX/^W/NIBNAM(P1)/.SYS
SET NODE ^W/NIBNAM(P1)/ SECONDARY DUMPER ^I/SYSITX/DTEDMP.SYS
SET NODE ^W/NIBNAM(P1)/ DUMP FILE ^I/DMPITX/^W/NIBNAM(P1)/.DMP
SET CIRCUIT ^T/(P2)/ SERVICE ENABLED>)
GENNC4:	ADDI	P3,CKT.SZ-1		; Offset to next circuit table entry
	AOBJN	P3,GENNC3		; Loop for all nodes

GENNC5:	SETZ	P2,			; Set previous circuit descriptor
	MOVE	P3,NIBCKT(P4)		; Get AOBJN pointer to circuit table
	$TEXT	(PUTFIL,<>)		; Output a blank line

GENNC6:	SKIPE	P1,CKTNIB(P3)		; Get address of next NIB
	CAMN	P2,CKTCDW(P3)		; Same circuit as previous circuit?
	  JRST	GENNC7			; Skip this if no NIB or same circuit
	MOVE	P2,CKTCDW(P3)		; Get circuit descriptor word
	$TEXT	(PUTFIL,<SET CIRCUIT ^T/(P2)/ STATE ON>)
GENNC7:	ADDI	P3,CKT.SZ-1		; Offset to next circuit table entry
	AOBJN	P3,GENNC6		; Loop for all nodes

GENNC8:	$TEXT	(PUTFIL,<>)		; Add a blank line
	$TEXT	(PUTFIL,<RETURN>)	; Leave NCP

	$CALL	CLSFIL			; Close output file
	JUMPF	CLSERR			; Jump if error closing file

	$RETT				; Return
	SUBTTL	File Generation  --  NIPTST.CTL


; Call to generate NIPTST.CTL file from internal data base

GENTST:	$SAVE	<P1,P2,P3,P4>		; Save P1, P2, P3 and P4

	MOVEI	S1,TSTFD		; Get address of file descriptor block
	$CALL	OPNFIL			; Open file for writing
	JUMPF	OPNERR			; Jump if we have problems

	MOVE	S1,OUTIFN		; Get assigned IFN for file
	SETO	S2,			; Obtain an exact FD
	$CALL	F%FD			; Get address of complete FD
	$TEXT	(,<[Generating ^F/(S1)/]>)

; Now to generate the actual text of the file

	$TEXT	(PUTFIL,<!
! NIPTST.CTL  --  Loopback tests control file
!
! Generated: ^H/[-1]/ by ^T/NIPNAM/ version ^V/.JBVER/
!>)
TOPS10 <				; If TOPS-10 version
	$TEXT	(PUTFIL,<.NOERROR
.R OPR>)
>; End TOPS10
TOPS20 <				; If TOPS-20 version
	$TEXT	(PUTFIL,<@NOERROR
@ENABLE
@OPR>)
>; End TOPS20
	$TEXT	(PUTFIL,<*DISABLE OUTPUT-DISPLAY ALL-MESSAGES
*ENTER NCP>)

					; Continued on next page
					; Continued from previous page

	MOVE	P4,HSTNIB		; Get NIB for host
	$TEXT	(PUTFIL,<!
! ***** Testing node ^W/NIBNAM(P4)/ *****
!
*SET KNOWN CIRCUITS STATE OFF
*WAIT 35
*SHOW EXECUTOR CHARACTERISTICS
*WAIT 35
*LOOP EXECUTOR COUNT 25 LENGTH 100
*WAIT 35>)

	MOVE	S1,P4			; Get NIB address of host
	$CALL	GENTSL			; Generate tests for each circuit

	SKIPN	P3,NIBCKT(P4)		; Get AOBJN pointer to circuit table
	  JRST	GENTS6			; Skip this if no circuits

GENTS1:	SKIPN	P1,CKTNIB(P3)		; Get address of next NIB
	  JRST	GENTS5			; Skip this if no NIB
	MOVX	S1,NF%MCB		; Is this an MCB?
	TDNN	S1,NIBFLG(P1)		; ...
	  JRST	GENTS5			; No, skip over
	MOVE	P2,CKTCDW(P3)		; Get circuit descriptor word

	$TEXT	(PUTFIL,<!
! ***** Testing MCB ^W/NIBNAM(P1)/ *****
!
*SET CIRCUIT ^T/(P2)/ STATE ON
*WAIT 35
*SET EXECUTOR NODE ^W/NIBNAM(P1)/^A>)
	SKIPE	NMLUID(P1)		; Output user-id if set
	  $TEXT	(PUTFIL,< USER ^T/NMLUID(P1)/^A>)
	SKIPE	NMLACC(P1)		; Output account if set
	  $TEXT	(PUTFIL,< ACCOUNT ^T/NMLACC(P1)/^A>)
	SKIPE	NMLPSW(P1)		; Output password if set
	  $TEXT	(PUTFIL,< PASSWORD ^T/NMLPSW(P1)/^A>)
	$TEXT	(PUTFIL,<
*WAIT 35>)

					; Continued on next page
					; Continued from previous page

	PUSH	P,P3			; Save AOBJN pointer for a bit
	SKIPN	P3,NIBCKT(P1)		; Get AOBJN pointer to MCB's circuits
	  JRST	GENTS4			; Skip this if no circuits
GENTS2:	SKIPN	S2,CKTNIB(P3)		; Get remote node's NIB
	  JRST	GENTS3			; Skip this if no NIB
	MOVE	S1,CKTCDW(P3)		; Get circuit descriptor word
	$TEXT	(PUTFIL,<SET CIRCUIT ^T/(S1)/ STATE OFF	! Node ^W/NIBNAM(S2)/>)
GENTS3:	ADDI	P3,CKT.SZ-1		; Offset to next circuit table entry
	AOBJN	P3,GENTS2		; Loop for all circuits on MCB
	$TEXT	(PUTFIL,<*WAIT 35>)	; Wait for MCB to settle down
GENTS4:	POP	P,P3			; Restore AOBJN pointer to host's circuits

	$TEXT	(PUTFIL,<*SHOW EXECUTOR CHARACTERISTICS
*WAIT 35
*LOOP EXECUTOR COUNT 25 LENGTH 100
*WAIT 35
*LOOP NODE ^A>)
	MOVE	S1,NIBNAD(P4)		; Get node's address
	$CALL	PUTNAD			; Type into file
	$TEXT	(PUTFIL,< COUNT 25 LENGTH 100	! Node ^W/NIBNAM(P4)/
*WAIT 35>)

	MOVE	S1,P1			; Get address of MCB's NIB
	$CALL	GENTSL			; Generate tests to each circuit

	$TEXT	(PUTFIL,<!
! Finished testing node ^W/NIBNAM(P1)/
!
*SET KNOWN CIRCUITS STATE ON
*WAIT 35
*CLEAR EXECUTOR NODE
*SET CIRCUIT ^T/(P2)/ STATE OFF
*WAIT 35>)

GENTS5:	ADDI	P3,CKT.SZ-1		; Offset to next circuit table entry
	AOBJN	P3,GENTS1		; Loop for all nodes

					; Continued on next page
					; Continued from previous page

GENTS6:	$TEXT	(PUTFIL,<!
! Finished testing
!
*SET KNOWN CIRCUITS STATE ON
*WAIT 35>)

	$CALL	CLSFIL			; Close output file
	JUMPF	CLSERR			; Jump if error closing file

	$RETT				; Return

					; Continued on next page
					; Continued from previous page

; Routine called to generate loopback tests for all circuits of a node
; Call with NIB address in S1.

GENTSL:	$SAVE	<P1,P2,P3,P4>		; Save P1, P2, P3, and P4

	MOVE	P4,S1			; Save NIB address in P4

	SKIPN	P3,NIBCKT(P4)		; Get AOBJN pointer to circuit table
	  $RETT				; No circuits, return now
GENTL1:	SKIPN	P1,CKTNIB(P3)		; Get NIB of remote node
	  JRST	GENTL2			; Skip this if no NIB
	MOVE	P2,CKTCDW(P3)		; Get circuit descriptor word

	$TEXT	(PUTFIL,<!
! Testing ^W/NIBNAM(P4)/'s circuit ^T/(P2)/ to node ^W/NIBNAM(P1)/
!
*SET CIRCUIT ^T/(P2)/ STATE ON
*WAIT 35
*LOOP NODE ^A>)
	MOVE	S1,NIBNAD(P1)		; Get node's address
	$CALL	PUTNAD			; Type into file
	$TEXT	(PUTFIL,< COUNT 25 LENGTH 100	! Node ^W/NIBNAM(P1)/
*WAIT 35
*SET CIRCUIT ^T/(P2)/ STATE OFF
*WAIT 35>)

GENTL2:	ADDI	P3,CKT.SZ-1		; Offset to next circuit table entry
	AOBJN	P3,GENTL1		; Loop for all circuits

	$RETT				; And then return
	SUBTTL	File Generation  --  NIPNFT.CTL


; Call to generate NIPNFT.CTL file from internal data base

GENNFT:	$SAVE	<P1,P2,P3,P4>		; Save P1, P2, P3, and P4

	MOVEI	S1,NFTFD		; Get address of file descriptor block
	$CALL	OPNFIL			; Open file for writing
	JUMPF	OPNERR			; Jump if we have problems

	MOVE	S1,OUTIFN		; Get assigned IFN for file
	SETO	S2,			; Obtain an exact FD
	$CALL	F%FD			; Get address of complete FD
	$TEXT	(,<[Generating ^F/(S1)/]>)

; Now to generate the actual text of the file

	$TEXT	(PUTFIL,<!
! NIPNFT.CTL  --  Network file transfer tests control file
!
! Generated: ^H/[-1]/ by ^T/NIPNAM/ version ^V/.JBVER/
!>)

	MOVSI	P2,-NOD.MX		; Make AOBJN pointer to NODLST
GENNF1:	SKIPN	P1,NODLST(P2)		; Is there a node defined?
	  JRST	GENNF2			; No, continue
	MOVX	S1,NF%TFT		; Want to test NFT to this node?
	TDNN	S1,NIBFLG(P1)		; ...
	  JRST	GENNF2			; No, skip this

					; Continued on next page
					; Continued from previous page

	$TEXT	(PUTFIL,<!
! ***** Testing network file transfer to node ^W/NIBNAM(P1)/
!>)
TOPS10 <				; If TOPS-10 version
	$TEXT	(PUTFIL,<.NOERROR
.R NFT
*COPY ^W/NIBNAM(P1)/::^I/NFTITX/ = NIPNFT.CTL/ASCII
*COPY NFTNIP.CTL = ^W/NIBNAM(P1)/::^I/NFTITX/ NIPNFT.CTL/ASCII
*DELETE ^W/NIBNAM(P1)/::^I/NFTITX/ NIPNFT.CTL
*EXIT
.R FILCOM
*TTY:=NIPNFT.CTL,NFTNIP.CTL
.DELETE NFTNIP.CTL>)
>; End TOPS10

TOPS20 <				; If TOPS-20 version
	$TEXT	(PUTFIL,<@NOERROR
@R NFT
*COPY (from) NIPNFT.CTL/ASCII (to) ^W/NIBNAM(P1)/::^I/NFTITX/
*COPY (from) ^W/NIBNAM(P1)/::NIPNFT.CTL/ASCII^I/NFTITX/ (to) NFTNIP.CTL
*DELETE (remote files) ^W/NIBNAM(P1)/::NIPNFT.CTL^I/NFTITX/
*EXIT
@R FILCOM
*TTY:=NIPNFT.CTL,NFTNIP.CTL
@DELETE (files) NFTNIP.CTL>)
>; End TOPS20

GENNF2:	AOBJN	P2,GENNF1		; Loop for all nodes in NODLST

	$CALL	CLSFIL			; Close output file
	JUMPF	CLSERR			; Jump if error closing file

	$RETT				; Return
	SUBTTL	Support Routines  --  Node Information Block Manipulation


; Routine to get a NIB for a node.  Call with S1 containing the
; node's name, and S2 containing the node's address.  Routine will
; return the address of the NIB in S1.  FALSE return if node can't
; be added due to name/address conflict with existing node.

GETNIB:	$SAVE	<P1,P2,P3,P4>		; Save P1, P2, P3, and P4

	DMOVE	P1,S1			; Save node name and address

	MOVSI	P3,-NOD.MX		; Get AOBJN pointer to NODLST
GETNI1:	SKIPE	P4,NODLST(P3)		; Empty slot?
	CAME	P1,NIBNAM(P4)		; No, correct node name?
	  JRST	GETNI2			; No, skip it
	MOVE	S1,NIBNAD(P4)		; Get NIB's node address
	MOVE	S2,P2			; Get subject's node address
	$CALL	CMPADR			; Are they the same node?
	JUMPF	GETNI2			; Skip if not
	TXNE	P2,76000		; Yes, subject node have area number?
	  MOVEM	P2,NIBNAD(P4)		; Yes, update NIB
	MOVE	S1,P4			; Get address of NIB
	$RETT				; And return
GETNI2:	AOBJN	P3,GETNI1		; Loop back for entire NODLST

	DMOVE	S1,P1			; Get node name and address
	$CALL	CRENIB			; Create NIB for this node

	$RET				; And return
; Routine to create a NIB for a node.  Call with S1 containing the
; node's name, and S2 containing the node's address.  Routine will
; return the address of the NIB in S1.  FALSE return if node can't
; be added due to name/address conflict with existing node.

CRENIB:	$SAVE	<P1,P2>			; Save P1 and P2

	DMOVE	P1,S1			; Save node name and address

	MOVEI	S1,NIB.SZ		; Get size of node information block
	$CALL	GETCOR			; Allocate needed memory

	MOVEM	P1,NIBNAM(S2)		; Save node name in NIB
	MOVEM	P2,NIBNAD(S2)		; Save node address in NIB
	MOVE	P1,S2			; Save address of NIB in P1

	MOVE	S1,P1			; Get address of NIB
	$CALL	ADDNIB			; Add NIB to NODLST
	$RETIT				; Return now if successful

	MOVEI	S1,NIB.SZ		; Get size of NIB
	MOVE	S2,P1			; And address of NIB
	$CALL	M%RMEM			; Return memory

	$RETF				; And return FALSE
; Routine used by CRENIB to add node to NODLST

ADDNIB:	$SAVE	<P1,P2,P3,P4>		; Save P1, P2, P3, and P4

	MOVE	P1,S1			; Save NIB address in P1

	MOVSI	P3,-NOD.MX		; Get AOBJN pointer to NODLST
	MOVE	S1,NIBNAM(P1)		; Get node name
ADDNI1:	SKIPE	P4,NODLST(P3)		; Empty slot?
	CAME	S1,NIBNAM(P4)		; No, duplicate name?
	SKIPA				; Empty slot, or not duplicate, skip
	  JRST	ADDNI5			; Duplicate name, go ask what to do
	AOBJN	P3,ADDNI1		; Empty slot, or not duplicate, loop

	MOVSI	P3,-NOD.MX		; Get AOBJN pointer to NODLST
	MOVE	S1,NIBNAD(P1)		; Get node address
ADDNI2:	SKIPE	P4,NODLST(P3)		; Empty slot?
	CAME	S1,NIBNAD(P4)		; No, duplicate address?
	SKIPA				; Empty slot, or not duplicate, skip
	  JRST	ADDNI6			; Duplicate address, go ask what to do
	AOBJN	P3,ADDNI2		; Empty slot, or not duplicate, loop

	MOVSI	P3,-NOD.MX		; Get AOBJN pointer to NODLST
ADDNI3:	SKIPN	P4,NODLST(P3)		; Empty slot?
	  JRST	ADDNI4			; Yes, go store NIB and return
	AOBJN	P3,ADDNI3		; Loop to find an empty slot
	$STOP	(NLF,Node list full)

ADDNI4:	MOVEM	P1,NODLST(P3)		; Save NIB address in NODLST

	MOVE	S1,P1			; Get address of NIB
	$RETT				; And return

					; Continued on next page
					; Continued from previous page

; Here if node name is already assigned

ADDNI5:	ERROR$	(<^W/NIBNAM(P4)/ is already assigned node address ^A>)
	MOVE	S1,NIBNAD(P4)		; Get node's address
	$CALL	TYPNAD			; Type onto terminal
	$TEXT	(,<>)			; Finish the line
	ASK$	(<Do you wish to redefine node ^W/NIBNAM(P4)/? >,YNOPDB)
	$CALL	P$KEYW			; Get YES/NO answer
	HRRE	TF,S1			; ...
	$RETIF				; Return FALSE if answer is no

	SETZM	NODLST(P3)		; Clear previous assignment

	MOVE	S1,NIBNAD(P1)		; Get new node address
	EXCH	S1,NIBNAD(P4)		; Save in old NIB, get old node address
	MOVE	P2,S1			; Save old address for a bit

	MOVE	S1,P4			; Get address of altered NIB
	$CALL	ADDNIB			; Add to NODLST
	JUMPF	[MOVEM	P2,NIBNAD(P4)	; Can't, put old address back
		 MOVEM	P4,NODLST(P3)	; Put NIB back into NODLST
		 JRST	ADDNI2]		; And go ask again what to do

	MOVEI	S1,NIB.SZ		; Get size of NIB
	MOVE	S2,P1			; Address of NIB
	$CALL	M%RMEM			; Return the memory

	MOVE	S1,P4			; Get NIB's address
	$RETT				; And return

					; Continued on next page
					; Continued from previous page

; Here if node address is already assigned

ADDNI6:	ERROR$	(<Node address ^A>)
	MOVE	S1,NIBNAD(P4)		; Get node's address
	$CALL	TYPNAD			; Type onto terminal
	$TEXT	(,< already assigned to node ^W/NIBNAM(P4)/>)
	ASK$	(<Do you wish to reassign address to node ^W/NIBNAM(P1)/? >,YNOPDB)
	$CALL	P$KEYW			; Get YES/NO answer
	HRRE	TF,S1			; ...
	$RETIF				; Return FALSE if answer is no

	MOVEM	P1,NODLST(P3)		; Store new assignment in NODLST

ADDNI7:	ASK$	(<^W/NIBNAM(P4)/'s new node address: >,NDAPDB)
	$CALL	P$NAD			; Get node address
	JUMPF	ADDNI7			; Loop back on error

	MOVEM	S1,NIBNAD(P4)		; Save new node address

	MOVE	S1,P4			; Get address of NIB
	$CALL	ADDNIB			; Add to NODLST
	JUMPF	ADDNI7			; Can't, go ask again

	MOVE	S1,P1			; Get NIB's address
	$RETT				; And return
	SUBTTL	Support Routines  --  Circuit Table Manipulation


; Routine to add a circuit to a NIB's circuit table.  Call with
; S1 containing the circuit descriptor word for the circuit,
; S2 containing XWD address of remote NIB, address of local NIB.
;
; Routine returns FALSE if circuit can't be added to table.

ADDCKT:	$SAVE	<P1,P2,P3,P4>		; Save P1, P2, P3, and P4
	MOVE	P1,S1			; Save circuit descriptor in P1
	HLRZ	P2,S2			; Remote node's NIB in P2
	HRRZ	P3,S2			; And local node's NIB in P3

ADDCK0:	SKIPN	P4,NIBCKT(P3)		; Get AOBJN pointer to circuit table
	  JRST	ADDCK4			; Jump if table not set up
ADDCK1:	SKIPN	CKTNIB(P4)		; Find an empty slot?
	  JRST	[MOVEM	P1,CKTCDW(P4)	; Yes, insert circuit here
		 MOVEM	P2,CKTNIB(P4)	; ...
		 $RETT]			; And return
	MOVE	S1,CKTCDW(P4)		; Get circuit descriptor
	CAME	S1,P1			; Using the same circuit twice?
	  JRST	ADDCK2			; No, continue
	LOAD	S1,P1,CD%TYP		; Get circuit type code
	CAXE	S1,CT%ETH		; Is this an ethernet circuit?
	  JRST	ADDCK5			; No, go complain about duplicate
ADDCK2:	CAMLE	P1,CKTCDW(P4)		; Should circuit be inserted here?
	  JRST	ADDCK3			; No, continue
	EXCH	P1,CKTCDW(P4)		; Yes, store circuit here, get previous
	EXCH	P2,CKTNIB(P4)		; ...
ADDCK3:	ADDI	P4,CKT.SZ-1		; Offset to next circuit table entry
	AOBJN	P4,ADDCK1		; Loop to check all circuits in table
ADDCK4:	MOVE	S1,P3			; Get NIB address
	$CALL	EXPCKT			; Expand current circuit table
	$RETIF				; Return if can't
	JRST	ADDCK0			; And try again

					; Continued on next page
					; Continued from previous page

ADDCK5:	MOVE	S1,CKTNIB(P4)		; Get NIB of circuit owner
	ERROR$	(<Circuit ^T/(P1)/ already assigned to node ^W/NIBNAM(S1)/>)
	ASK$	(<Do you wish to reassign ^T/(P1)/ to node ^W/NIBNAM(P2)/? >,YNOPDB)
	$CALL	P$KEYW			; Get YES/NO answer
	HRRE	TF,S1			; ...
	$RETIF				; Return now if answer was no
	EXCH	P2,CKTNIB(P4)		; Store new circuit assignment
	ASK$	(<^W/NIBNAM(P3)/'s new circuit to ^W/NIBNAM(P2)/: >,@NIBCPB(P3))
	$CALL	P$KEYW			; Get address of circuit descriptor
	MOVE	S1,(S1)			; Get circuit descriptor word
	MOVE	S2,P3			; Get address of host's NIB
	HRL	S2,P2			; And address of remote node's NIB
	$CALL	ADDCKT			; Add circuit to circuit table
	JUMPF	ADDCK5			; Ask again if can't
	$RETT				; Return now if successful
; Routine to expand the circuit table of a NIB.  Call with
; address of NIB in S1.  Routine returns false if unable
; to expand circuit table.

EXPCKT:	$SAVE	<P1>			; Save P1
	MOVE	P1,S1			; Save NIB address in P1

	HLRE	S1,NIBCKT(P1)		; Get negative table entry count
	MOVNS	S1			; Make positive
	ADDI	S1,^D10			; Increase table size a bit
	IMULI	S1,CKT.SZ		; Convert into word count
	$CALL	M%GMEM			; Allocate memory for table
	$RETIF				; Return if can't get needed memory
	PUSH	P,S2			; Save table address
	IDIVI	S1,CKT.SZ		; Convert table size into entry count
	POP	P,S2			; Restore table address
	MOVNS	S1			; Create AOBJN pointer to table
	HRL	S2,S1			; ...
	EXCH	S2,NIBCKT(P1)		; Store new table pointer, get previous
	JUMPE	S2,.RETT		; All done if no previous table
	HLRE	S1,S2			; Get old table's negative entry count
	MOVNS	S1			; Make positive
	IMULI	S1,CKT.SZ		; Convert into word count
	HRRZS	S2			; Isolate previous table address
	PUSH	P,S1			; Save previous table size
	PUSH	P,S2			; And address
	ADD	S1,NIBCKT(P1)		; Calculate ending address+1 of BLT
	HRLZS	S2			; Create BLT pointer
	HRR	S2,NIBCKT(P1)		; ...
	BLT	S2,-1(S1)		; Copy previous table into new table
	POP	P,S2			; Get back previous table address
	POP	P,S1			; And size
	$CALL	M%RMEM			; Release memory
	$RETT				; And return
	SUBTTL	Support Routines  --  File Processing


; Routine called to open file.  Call with address of FD in S1.

OPNFIL:	$SAVE	<P1>			; Save P1
	MOVE	P1,S1			; Save address of FD in P1
	MOVEM	P1,OUTFD		; Save address of FD in case error

	MOVEI	S1,FOB.SZ		; Clear FOB block
	MOVEI	S2,OUTFOB		; ...
	$CALL	.ZCHNK			; ...

	MOVEM	P1,OUTFOB+FOB.FD	; Store address of file descriptor
	MOVX	S1,FLD(7,FB.BSZ)	; Set byte size of 7 bits
	MOVEM	S1,OUTFOB+FOB.CW	; ...

	MOVEI	S1,FOB.SZ		; Get size of FOB
	MOVEI	S2,OUTFOB		; And address
	$CALL	F%OOPN			; Open file for output
	$RETIF				; Return now if error
	MOVEM	S1,OUTIFN		; Store output file IFN
	$RETT				; And return


; Routine called to close file.

CLSFIL:	MOVE	S1,OUTIFN		; Get output file IFN
	$CALL	F%REL			; Close output file
	$RET				; And return


; Routine called to output one character to file.  Call with
; character to output in S1.

PUTFIL:	MOVE	S2,S1			; Get byte to be output
	MOVE	S1,OUTIFN		; Get output file's IFN
	$CALL	F%OBYT			; Output the character to file
	JUMPF	PUTERR			; Jump if error writing character
	$RETT				; Return


; Error routines

OPNERR:	$FATAL	(<File "^F/@OUTFD/" open error - ^E/S1/>)
CLSERR:	$FATAL	(<File "^F/@OUTFD/" close error - ^E/S1/>)
PUTERR:	$FATAL	(<File "^F/@OUTFD/" output error - ^E/S1/>)
	SUBTTL	Support Routines  --  S$ASK


; Routine called by invocation of ASK$ macro.
; Linkage:
;	$CALL	S$ASK
;	JRST	DUMMY%
;	XWD	0,[ITEXT <Prompt string>]
;	EXP	PDB		;Parser data block address
; DUMMY%:
;
; Returns TRUE after getting an answer which parses
; correctly from the user.  On return, the parser has been
; set up for extracting the parsed fields.

S$ASK:	PUSH	P,S1			; Save S1
	MOVE	S1,-1(P)		; Get return address (address of JRST)
	MOVE	S1,1(S1)		; Fetch address of ITEXT literal
	EXCH	S1,(P)			; Save on stack, get back S1
	$TEXT	(<-1,,PROMPT>,<^I/@(P)/^0>)	; Build prompt string
	MOVEM	S1,(P)			; Save S1 again
	MOVE	S1,-1(P)		; Get return address (address of JRST)
	MOVE	S1,2(S1)		; Get address expression of PDB
	EXCH	S1,(P)			; Get S1, save address expression
	MOVEI	S1,@(P)			; Get effective address of PDB
	ADJSP	P,-1			; Clean up stack
	LOAD	S2,INIPDB,PB.FDB	; Get length of $INIT FDB
	ADDI	S2,INIPDB		; Calculate address of parser area
	MOVEM	S1,PB%NXT(S2)		; Set up address of parser data block
	MOVEI	S1,INIPDB		; Get address of init parser data block
	MOVEM	S1,PAR.TB+PARBLK	; Set into parser control block
	MOVEI	S1,PROMPT		; Get address of prompt string
	MOVEM	S1,PAR.PM+PARBLK	; Set into parser control block
	MOVEI	S1,CMDBLK		; Get address of block to store data
	MOVEM	S1,PAR.CM+PARBLK	; Set into parser control block
	SETZM	PAR.SR+PARBLK		; Set so don't rescan last command

					; Continued on next page
					; Continued from previous page

	MOVEI	S1,CMD.SZ		; Clear command data area
	MOVEI	S2,CMDBLK		; ...
	$CALL	.ZCHNK			; ...

	MOVEI	S1,COM.SZ-1		; Set initial size of command block
	STORE	S1,.MSTYP+CMDBLK,MS.CNT	; ...

	MOVEI	S1,PAR.SZ		; Get size of parser block
	MOVEI	S2,PARBLK		; And address
	$CALL	PARSER			; Parse the command
	JUMPF	S$ASK1			; Jump if error parsing answer

	MOVEI	S1,COM.SZ+CMDBLK	; Point to first argument
	$CALL	P$SETU			; Set up for second pass
	$RETT				; And return TRUE

S$ASK1:	MOVE	S2,PRT.EM(S2)		; Get address of error text
	ERROR$	<^T/(S2)/>		; Print the error message
	JRST	S$ASK			; And try again
	SUBTTL	Support Routines  --  S$ERRO


; Routine called by invocation of ERROR$ macro.
; Linkage:
;	$CALL	S$ERRO
;	JRST	DUMMY%
;	XWD	0,[ITEXT <Error message string>]
;	XWD	0,ADDR		;CONTINUATION ADDRESS
; DUMMY%:
;
; Routine preserves all acs.

S$ERRO:	PUSH	P,S1			; Save S1
	MOVE	S1,-1(P)		; Get return address (address of JRST)
	MOVE	S1,1(S1)		; Fetch address of ITEXT literal
	EXCH	S1,(P)			; Save on stack, get back S1
	$TEXT	(T%TTY,<? ^W6/[%%.MOD]/ ^I/@(P)/>)	; Issue message
	MOVEM	S1,(P)			; Save S1 again
	MOVE	S1,-1(P)		; Get return address (address of JRST)
	SKIPE	S1,2(S1)		; Get continuation address if any
	  HRRM	S1,-1(P)		; And save on stack
	POP	P,S1			; Restore S1
	$RET				; And return
	SUBTTL	Support Routines  --  CMPADR - Compare node addresses


; Routine called to compare two DECnet node addresses.  Call with
; addresses to compare in S1 and S2.  Returns true if both addresses
; are the same.

CMPADR:	$SAVE	<P1,P2>			; Save P1 and P2

	DMOVE	P1,S1			; Get a copy of addresses in P1-P2
	ANDI	S1,1777			; Isolate node numbers
	ANDI	S2,1777			; ...
	CAME	S1,S2			; Node numbers match?
	  $RETF				; No, no need to check area numbers
	LSH	P1,-^D10		; Isolate area numbers
	LSH	P2,-^D10		; ...
	SKIPE	P1			; Is either area number zero?
	SKIPN	P2			; ...
	  $RETT				; Yes, then they match
	CAME	P1,P2			; Else they must be the same
	  $RETF				; No, false return
	$RETT				; Return
	SUBTTL	Support Routines  --  P$NAD - Parse DECnet node address


; Routine called to parse a DECnet node address (a.n format).
; Returns true if valid address with address in S1.

P$NAD:	$SAVE	<P1,P2>			; Save P1 and P2
	SETZ	P1,			; Get default area number
	$CALL	P$NUM			; Get area number or node address
	MOVE	P2,S1			; Save in P2
	$CALL	P$TOK			; Parse "." if full format
	JUMPF	P$NAD1			; Jump if not a.n format
	MOVE	P1,P2			; Save area number in P1
	$CALL	P$NUM			; Get node address
	MOVE	P2,S1			; Save in P2
P$NAD1:	SKIPL	P1			; Valid area number?
	CAILE	P1,MAXARE		; ...
	  ERROR$ (<Invalid node area: "^D/P1/">,.RETF)
	SKIPLE	P2			; Valid node address?
	CAILE	P2,MAXADR		; ...
	  ERROR$ (<Invalid node address: "^D/P2/">,.RETF)
	SKIPN	S1,P1			; Get area number
	MOVE	S1,DEFARE		; Get default area if none
	LSH	S1,^D10			; Shift into place
	IOR	S1,P2			; Add node address
	$RETT				; And return
	SUBTTL	Support Routines  --  Node Address Typeout

; Routines called to output a node address.  Call TYPNAD to output
; to terminal, PUTNAD to output to file via PUTFIL.  Call with node
; address in S1.

TYPNAD:	MOVE	S2,S1			; Get a copy
	LSH	S1,-^D10		; Isolate area number
	ANDI	S2,1777			; And node number
	SKIPE	S1			; Have an area number?
	  $TEXT	(,<^D/S1/.^A>)		; Yes, output it
	$TEXT	(,<^D/S2/^A>)		; Output node number
	$RETT				; And return

PUTNAD:	MOVE	S2,S1			; Get a copy
	LSH	S1,-^D10		; Isolate area number
	ANDI	S2,1777			; And node number
	SKIPE	S1			; Have an area number?
	  $TEXT	(PUTFIL,<^D/S1/.^A>)	; Yes, output it
	$TEXT	(PUTFIL,<^D/S2/^A>)	; Output node number
	$RETT				; And return
	SUBTTL	Support Routines  --  CPYTXT


; Routine called to copy parsed text string into alternate storage
; Call with size of string storage in S1, byte pointer in S2.

CPYTXT:	$SAVE	<P1,P2,P3>		; Save P1, P2, and P3
	MOVEI	P1,@S2			; Get effective address in P1
	MOVE	P3,S1			; Save string size in P3
	ANDX	S2,BP.POS!BP.SIZ	; Mask byte pointer to position and size
	IOR	P1,S2			; Construct byte pointer in P1
	$CALL	P$PREV			; Set up to reread current token
	$CALL	P$TEXT			; Get address of ASCIZ string
	MOVEI	P2,1(S1)		; Build byte pointer to string
	HRLI	P2,(POINT 7)		; ...
CPYTX1:	ILDB	S1,P2			; Get a byte
	SOSGE	P3			; If no more room for string
	  SETZ	S1,			; Then dummy up end of string
	IDPB	S1,P1			; Save it
	JUMPN	S1,CPYTX1		; Loop till done copying string
	$RETT				; And then return
	SUBTTL	Support Routines  --  K%ECHO


; Routine called to enable/disable terminal echoing when prompting
; for passwords.  S1 contains 0 to disable echoing, non-zero to
; enable echoing.

TOPS20 <				; If TOPS-20 version
K%ECHO:	$SAVE	<P1>			; Save P1
	MOVE	P1,S1			; Save echo flag
	MOVX	S1,.PRIIN		; JFN for principal terminal
	RFMOD				; Read current echo setting
	ERJMP	.RETF			; Error?
	TXO	S2,TT%ECO		; Set echo flag
	SKIPN	P1			; Disable echoing?
	  TXZ	S2,TT%ECO		; Yes, clear echo flag
	SFMOD				; Set new terminal mode
	ERJMP	.RETF			; Error?
	$RETT				; Return
>; End IFN TOPS20
	SUBTTL	Support Routines  --  Memory Allocation


; Routine called to allocate memory.  Call with size of chunk in S1.
; Address of allocated memory is returned in S2.

GETCOR:	$CALL	M%GMEM			; Allocate memory
	JUMPF	[$STOP	(CGM,Can't get required memory)]
	$RETT				; Return
	SUBTTL	The End


NIPLIT:! LSTOF.				; Literals (XLISTed)
	 LIT				; Literals
	 LSTON.

NIPEND:!
TOPS10 < END	NIPGEN>
TOPS20 < END	<NIPEVL,,NIPEVC>>