Trailing-Edge
-
PDP-10 Archives
-
BB-P363B-SM_1985
-
t20/nipgen/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 11-Oct-83
SEARCH GLXMAC, ORNMAC ; Get required symbols
PROLOG (NIPGEN) ; Declare our name
.DIREC FLBLST ; Generate clean listing
PARSET ; Declare external PARSER routines
EXTERN PARSER ; ...
TOPS10 <COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 1985.>
; 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.
.TEXT "REL:GLXLIB/SEARCH, REL:OPRPAR/SEGMENT:LOW"
; Program version information
NIPVER==4 ; Major version number
NIPEDT==21 ; 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 Service Information Block......................... 15
; 5.3 Node Information Block............................ 16
; 5.4 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 Downline Loaded Nodes............................. 30
; 9.2 LAT(PLUTO) Downline Load Parameters............... 32
; 9.3 LAT(LAT-11) Downline Load Parameters.............. 33
; 9.4 MCB Downline Load Parameters...................... 34
; 9.5 Adjacent Nodes.................................... 35
; 9.6 Remote Nodes...................................... 37
; 9.7 Network Management Information.................... 38
; 9.8 File Transfer Testing............................. 39
; 9.9 Access Information................................ 40
; 10. File Generation
; 10.1 NCP.CMD........................................... 41
; 10.2 NIPTST.CTL........................................ 43
; 10.3 NIPNFT.CTL........................................ 48
; 11. Support Routines
; 11.1 Node Information Block Manipulation............... 50
; 11.2 Circuit Table Manipulation........................ 55
; 11.3 File Processing................................... 58
; 11.4 S$ASK............................................. 59
; 11.5 S$ERRO............................................ 61
; 11.6 CMPADR - Compare node addresses................... 62
; 11.7 P$NAD - Parse DECnet node address................. 63
; 11.8 Node Address Typeout.............................. 64
; 11.9 Service Information Block Output.................. 65
; 11.10 EXPSIB............................................ 66
; 11.11 CPYTXT............................................ 67
; 11.12 K%ECHO............................................ 68
; 11.13 Memory Allocation................................. 69
; 12. The End................................................... 70
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 28-Mar-85 by Marty Palmieri
Change code so that if SERVICE is configured for the DTE the
circuit state is always set ON in the NCP.CMD file. Also only
issue the SET CIRCUIT STATE ON and SET CIRCUIT SERVICE ENABLED
once for each circuit. Change keyword LAT to LAT-DECSA.
21 1-May-85 by Gunnar Lindell
NFT commands for TOPS-20 were wrong.
Add ENABLE command to NIPTST.CMD.
22 21-Aug-85 by Marty Palmieri
Set maximum area number to 63 not 31
#; 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
KL.CI2==1 ; Up to one CI-20 on a KL10
CI.CIP==^D16 ; Up to sixteen ports on a CI-20
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<0>, %D<0>, %%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
IFE %N,< ;; If no devices on controller
XXDLL X, \%%K
>; End IFE %N
IFN %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
IFE %D,< ;; If no drops on controller
XXDLL X, \%%K, \%%N
>; End IFE %D
IFN %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 IFN %D
DLLNXT %%N, %%M ;; Bump to next device
>; End REPEAT %N
>; End IFN %N
DLLNXT %%K, K ;; Bump to next controller
>; End REPEAT K
RADIX %%R ;; Reset orignal 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 -- Service Information Block
; Each node which is downline loaded has a service information
; block containing all information needed to service that node.
;
PHASE 0 ; These are offsets
SIBBCT:! BLOCK 1 ; Byte count remaining in buffer
SIBBPT:! BLOCK 1 ; Byte pointer into buffer
SIBBSZ:! BLOCK 1 ; Buffer size in words
SIBBUF:! BLOCK 1 ; Address of buffer
SIB.SZ:! ; Length of service information block
DEPHASE
SUBTTL Data Structures -- Node Information Block
; Each node declared within NIPGEN has a node information block
;
; !=======================================================!
; ! SIXBIT Node Name !
; !=======================================================!
; ! Node Address !
; !=======================================================!
; ! Message Flags (NF%xxx) !
; !=======================================================!
; ! Address of Circuit Parse Block !
; !=======================================================!
; ! AOBJN Pointer to Circuit Table !
; !=======================================================!
; ! !
; ! NML Access Information Block !
; ! !
; !=======================================================!
; ! !
; ! NFT Access Information Block !
; ! !
; !=======================================================!
; ! Address of Service 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%AFT==1B1 ; Ask about file transfer tests
NF%TFT==1B2 ; Test file transfer
NIBCPB:! BLOCK 1 ; Address of circuit parse block
NIBSPB:! BLOCK 1 ; Address of service 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
NIBSIB:! BLOCK 1 ; Address of service information block
TOPS20 < ; If TOPS-20 version
NIBCSO:! BLOCK 1 ; Address of circuit oned table
NIBCSE:! BLOCK 1 ; Address of circuit service enabled table
>; End TOPS20
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%SCK==1B0 ; Service circuit flag
CD%TYP==77B8 ; Circuit type
CT%NI==1 ; NIA-20 ethernet
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
TOPS20 <CT%MAX==CT%KDP>
CD%ASN==777777B35 ; Address of ASCIZ circuit name
TOPS20 <
CKTCID:! BLOCK 1 ; Circuit ID in internal format
CI%DEV==77B8 ; Device type
CI%KON==777B17 ; Controller number
CI%UNI==777B26 ; Unit number
CI%DRP==777B35 ; Drop number (port for CI's)
> ; End TOPS20
CKTNIB:! BLOCK 1 ; Address of remote node's NIB
CKT.SZ:! ; Length of circuit description entry
DEPHASE
TOPS20 <
KONNAM: EXP 0
ASCII /NI/ ; NIA-20 ethernet
ASCII /CI/ ; CI-20 SCA virtual circuit
ASCII /DTE/ ; DTE-20 interface
ASCII /DMC/ ; DMC-11 line driver
ASCII /DMR/ ; DMR-11 line driver
ASCII /KDP/ ; KDP-11 line driver
> ; End TOPS20
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,,KLSPDB],<KL10>
KEYTAB [KSCPDB,,KSSPDB],<KS10>
$ETAB
>; End TOPS10
; Parser Function Descriptor Block for Circuit Counts
NUMPDB: $NUMBER (CFMPDB,^D10)
; Parser Function Descriptor Block for Node Type
NTYPDB: $KEY (CFMPDB,NTYTAB)
NTYTAB: $STAB
KEYTAB ASKL11,<LAT-11>
KEYTAB ASKLAT,<LAT-DECSA>
KEYTAB ASKMCB,<MCB>
$ETAB
; Parser Function Descriptor Block for Ethernet Addresses
EADPDB: $FIELD (CFMPDB,<Hexadecimal ethernet address>,<$BREAK(HEXMSK)>)
; Parser Function Descriptor Block for Service Passwords
SPWPDB: $FIELD (CFMPDB,<Hexadecimal service password>,<$BREAK(HEXMSK)>)
; 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 NI,SY.ETH>
TOPS20 <DLLXPD NI,SY.KL1,SY.ETH>
$ETAB
; Parser Function Descriptor Block for KL10 service circuits
KLSPDB: $KEY (CFMPDB,KLSTAB,$BREAK(CIRMSK))
KLSTAB: $STAB
DLLXPD DTE,SY.KL1,KL.MCB
TOPS10 <DLLXPD NI,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
; Parser Function Descriptor Block for KS10 service circuits
TOPS10 < ; If TOPS-10 version
KSSPDB: $KEY (CFMPDB,KSSTAB,$BREAK(CIRMSK))
KSSTAB: $STAB
$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
; Break Mask for Hexadecimal Numbers
HEXMSK: 777777,,777777 ; All control characters
777754,,001777 ; Except numbers and "-"
403777,,777777 ; And uppercase A-F
403777,,777777 ; And lower case a-f
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 OUTSIB ; Current output service info block
$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,,KLSPDB] ; Get address of parse blocks
>; End TOPS20
HLRZ S2,(S1) ; Get circuit parse block address
MOVEM S2,NIBCPB(P1) ; Save in NIB
HRRZ S2,(S1) ; Get service circuit block address
MOVEM S2,NIBSPB(P1) ; Save in NIB
MOVE S1,P1 ; Get address of host's NIB
$CALL ASKDLL ; Go ask about downline loaded nodes
MOVE S1,P1 ; Get address of host's NIB
SETZ S2, ; No superior host NIB
$CALL ASKADJ ; Go ask about adjacent nodes
MOVE S1,P1 ; Get address of host's NIB
$CALL ASKNML ; Go ask about any NML information
$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 -- Downline Loaded Nodes
; Call with host's NIB in S1
ASKDLL: $SAVE <P1,P2,P3> ; Save P1, P2 and P4
MOVE P2,S1 ; Save address of NIB IN P2
MOVE S1,NIBSPB(P2) ; Get service circuit parse block
SKIPN @.CMDAT+1(S1) ; Is parse table empty?
$RETT ; Yes, return now
$TEXT (,<^M^J^JFor node ^W/NIBNAM(P2)/:>)
$TEXT (,<Downline load definition section.>)
$TEXT (,<(Type an extra CR when through)>)
ASKDL1: ASK$ (<^M^JTarget node name: >,RNNPDB)
$CALL P$NODE ; Get node name
JUMPF .RETT ; Return now if just confirm
TLNN S1,770000 ; Skip if SIXBIT style node name
ERROR$ (<Invalid node name: "^D/S1/">,ASKDL1)
CAMN S1,NIBNAM(P2) ; Guard against foolishness
ERROR$ (<Invalid node name: "^W/S1/">,ASKDL1)
MOVE P1,S1 ; Save node name in P1
ASKDL2: ASK$ (< ^W/P1/'s node address: >,NDAPDB)
$CALL P$NAD ; Get node address
JUMPF ASKDL2 ; Loop back on error
MOVE S2,S1 ; Get node address
MOVE S1,P1 ; Get node name
$CALL GETNIB ; Get Node Information Block
JUMPF ASKDL1 ; Ask again if can't
MOVE P1,S1 ; Save NIB address in P1
SKIPE NIBSIB(P1) ; Does node already have a SIB?
JRST ASKDL3 ; Yes, continue
MOVEI S1,SIB.SZ ; Get size of service information block
$CALL GETCOR ; Allocate needed memory
MOVEM S2,NIBSIB(P1) ; Save address in node's NIB
; Continued on next page
; Continued from previous page
ASKDL3: ASK$ (< ^W/NIBNAM(P2)/'s service circuit for ^W/NIBNAM(P1)/: >,@NIBSPB(P2))
$CALL P$KEYW ; Get address of circuit descriptor
MOVE S1,(S1) ; Get circuit descriptor word
TXO S1,CD%SCK ; Set service circuit flag
MOVE S2,P2 ; Get address of host's NIB
HRL S2,P1 ; And address of target node's NIB
$CALL ADDCKT ; Add circuit to circuit table
JUMPF ASKDL1 ; Ask again if can't
ASK$ (< ^W/NIBNAM(P1)/'s node type: >,NTYPDB)
$CALL P$KEYW ; Get address of node specific routine
MOVE P3,S1 ; Save in P3
DMOVE S1,P1 ; Get target and host node's NIBs
$CALL (P3) ; Call node specific routine
JRST ASKDL1 ; Loop back for all service nodes
SUBTTL Configuration Dialog -- LAT-DECSA Downline Load Parameters
; Call with target node's NIB in S1, host node's NIB in S2.
ASKLAT: $SAVE <P1,P2> ; Save P1 and P2
DMOVE P1,S1 ; Save NIB addresses
MOVE S1,NIBSIB(P1) ; Get address of service info block
$CALL SETSIB ; Set up current service info block
$TEXT (PUTSIB,<SET NODE ^W/NIBNAM(P1)/ CPU PDP-11>)
ASK$ (< ^W/NIBNAM(P1)/'s service password: >,SPWPDB)
$CALL P$FLD ; Get address of answer
$TEXT (PUTSIB,<SET NODE ^W/NIBNAM(P1)/ SERVICE PASSWORD ^T/1(S1)/>)
ASK$ (< ^W/NIBNAM(P1)/'s ethernet address: >,EADPDB)
$CALL P$FLD ; Get address of answer
$TEXT (PUTSIB,<SET NODE ^W/NIBNAM(P1)/ HARDWARE ADDRESS ^T/1(S1)/>)
$TEXT (PUTSIB,<SET NODE ^W/NIBNAM(P1)/ DUMP FILE ^I/DMPITX/:^W/NIBNAM(P1)/.DMP
SET NODE ^W/NIBNAM(P1)/ SECONDARY LOADER ^I/SYSITX/:PLUTO2.SYS
SET NODE ^W/NIBNAM(P1)/ TERTIARY LOADER ^I/SYSITX/:PLUTO3.SYS
SET NODE ^W/NIBNAM(P1)/ LOAD FILE ^I/SYSITX/:^W/NIBNAM(P1)/.SYS>)
$RETT ; And return
SUBTTL Configuration Dialog -- LAT(LAT-11) Downline Load Parameters
; Call with target node's NIB in S1, host node's NIB in S2.
ASKL11: $SAVE <P1,P2> ; Save P1 and P2
DMOVE P1,S1 ; Save NIB addresses
MOVE S1,NIBSIB(P1) ; Get address of service info block
$CALL SETSIB ; Set up current service info block
$TEXT (PUTSIB,<SET NODE ^W/NIBNAM(P1)/ CPU PDP-11>)
ASK$ (< ^W/NIBNAM(P1)/'s ethernet address: >,EADPDB)
$CALL P$FLD ; Get address of answer
$TEXT (PUTSIB,<SET NODE ^W/NIBNAM(P1)/ HARDWARE ADDRESS ^T/1(S1)/>)
$TEXT (PUTSIB,<SET NODE ^W/NIBNAM(P1)/ DUMP FILE ^I/DMPITX/:^W/NIBNAM(P1)/.DMP
SET NODE ^W/NIBNAM(P1)/ SECONDARY LOADER ^I/SYSITX/:SECUNA.SYS
SET NODE ^W/NIBNAM(P1)/ TERTIARY LOADER ^I/SYSITX/:TERUNA.SYS
SET NODE ^W/NIBNAM(P1)/ LOAD FILE ^I/SYSITX/:^W/NIBNAM(P1)/.SYS>)
$RETT ; And return
SUBTTL Configuration Dialog -- MCB Downline Load Parameters
; Call with target node's NIB in S1, host node's NIB in S2.
ASKMCB: $SAVE <P1,P2> ; Save P1 and P2
DMOVE P1,S1 ; Save NIB addresses
MOVE S1,NIBSIB(P1) ; Get address of service info block
$CALL SETSIB ; Set up current service info block
$TEXT (PUTSIB,<SET NODE ^W/NIBNAM(P1)/ CPU PDP-11
SET NODE ^W/NIBNAM(P1)/ SERVICE NODE VERSION 0
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 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>)
$RETT ; And return
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
MOVX S1,NF%AFT ; Ask about file transfer tests
IORM S1,NIBFLG(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
$CALL ADDCKT ; Add circuit to circuit table
JUMPF ASKAJ1 ; Ask again if can't
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) ; ...
TXNE S2,CD%SCK ; Is this a service circuit?
JRST ASKAJ6 ; Yes, skip this circuit
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
MOVX T1,NF%AFT ; Ask about file transfer tests
IORM T1,NIBFLG(P1) ; ...
JRST ASKRM1 ; And then loop back for more
SUBTTL Configuration Dialog -- Network Management Information
; ASKNML is called to ask user for any network management information
; needed for testing the host system. Call with address of host's
; NIB in S1.
ASKNML: $SAVE <P1,P2,P3> ; Save P1, P2, and P3
MOVE P2,S1 ; Save address of host's NIB in P2
TXZ FL,FL%HDR ; Clear header output flag
MOVE P3,NIBCKT(P2) ; Get AOBJN pointer to circuit table
ASKNM1: SKIPN P1,CKTNIB(P3) ; Get NIB of next node
JRST ASKNM2 ; Skip this if no NIB
MOVE S2,CKTCDW(P3) ; Get circuit descriptor word
TXNE S2,CD%SCK ; Is this a service circuit?
JRST ASKNM2 ; Yes, skip this circuit
MOVX S1,NF%MCB ; Is this node an MCB?
TDNN S1,NIBFLG(P1) ; ...
JRST ASKNM2 ; No, skip this node
TXON FL,FL%HDR ; Output header line yet?
$TEXT (,<^M^J^JNetwork management information section.>)
$TEXT (,<^M^JFor MCB ^W/NIBNAM(P1)/:>)
MOVEI S1,NIBNML(P1) ; Get address of NML's AIB
HRROI S2,[ASCIZ /Network management's/] ; And address of message
$CALL ASKAIB ; Ask about that MCB's NML information
ASKNM2: ADDI P3,CKT.SZ-1 ; Offset to next circuit table entry
AOBJN P3,ASKNM1 ; Loop for all nodes
$RETT ; And return
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
MOVX S1,NF%AFT ; Ask about file transfer tests?
TDNN S1,NIBFLG(P1) ; ...
JRST ASKNF2 ; No, 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 ; Is this the host NIB?
JRST GENNC2 ; Yes, don't generate an entry
$TEXT (PUTFIL,<SET NODE ^A>) ; Output node definition line
MOVE S1,NIBNAD(P1) ; Get node address
$CALL PUTNAD ; Type into file
$TEXT (PUTFIL,< NAME ^W/NIBNAM(P1)/>) ;Finish line
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 GENNC9 ; Skip this if no circuits
TXZ FL,FL%HDR ; Clear header output flag
MOVE P3,NIBCKT(P4) ; Get AOBJN pointer to circuit table
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
TXNN P2,CD%SCK ; Is this a service circuit?
JRST GENNC4 ; No, skip service information
$TEXT (PUTFIL,<>) ; Output blank line
$TEXT (PUTFIL,<SET NODE ^W/NIBNAM(P1)/ HOST ^W/NIBNAM(P4)/
SET NODE ^W/NIBNAM(P1)/ SERVICE CIRCUIT ^T/(P2)/>)
MOVE S1,NIBSIB(P1) ; Get address of node's SIB
MOVE S1,SIBBUF(S1) ; Get address of service text buffer
$TEXT (PUTFIL,<^T/(S1)/^A>) ; Output information to file
GENNC4: ADDI P3,CKT.SZ-1 ; Offset to next circuit table entry
AOBJN P3,GENNC3 ; Loop for all nodes
MOVE P3,NIBCKT(P4) ; Get AOBJN pointer to circuit table
GENNC5: SKIPN P1,CKTNIB(P3) ; Get address of next NIB
JRST GENNC8 ; Skip this if no NIB
TXON FL,FL%HDR ; Blank line already output?
$TEXT (PUTFIL,<>) ; No, output blank line
MOVE P2,CKTCDW(P3) ; Get circuit descriptor word
LOAD S1,P2,CD%TYP ; Get circuit type
CAXN S1,CT%DTE ; Is this for a DTE?
JRST GENNC6 ; Attempt an "on" anyway
TXNE P2,CD%SCK ; Is this a service circuit?
JRST GENNC7 ; Yes, then we don't
GENNC6: MOVE S1,CKTCID(P3) ; Get circuit ID
MOVE S2,NIBCSO(P4) ; and table of circuits on'ed
$CALL CHKCKT ; Sould we "on" this circuit?
JUMPF GENNC7 ; Match, so it's already been on'ed
MOVEM S2,NIBCSO(P4) ; Save address of on'ed block
$TEXT (PUTFIL,<SET CIRCUIT ^T/(P2)/ STATE ON>)
GENNC7: TXNN P2,CD%SCK ; Is this a service circuit?
JRST GENNC8 ; No, then doesn't get service enabled
MOVE S1,CKTCID(P3) ; Get circuit ID (internal format)
MOVE S2,NIBCSE(P4) ; and "enabled" block
$CALL CHKCKT ; Have we already enabled this circuit?
JUMPF GENNC8 ; Yes, don't do it again
MOVEM S2,NIBCSE(P4) ; Save address on "enabled" block
$TEXT (PUTFIL,<SET CIRCUIT ^T/(P2)/ SERVICE ENABLED>)
GENNC8: ADDI P3,CKT.SZ-1 ; Offset to next circuit table entry
AOBJN P3,GENNC5 ; Loop for all nodes
GENNC9: $TEXT (PUTFIL,<>) ; Output blank line
$TEXT (PUTFIL,<RETURN>) ; Finish the command file
$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
MOVE P2,CKTCDW(P3) ; Get circuit descriptor word
TXNE P2,CD%SCK ; Is this a service circuit?
JRST GENTS5 ; Yes, skip over
MOVX S1,NF%MCB ; Is this an MCB?
TDNN S1,NIBFLG(P1) ; ...
JRST GENTS5 ; No, skip over
$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
TXNE P2,CD%SCK ; Is this a service circuit?
JRST GENTL2 ; Yes, skip over
$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^I/NFTITX//ASCII (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 ADDCK3 ; 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) ; ...
TOPS20 < HRRZ S1,P1 ; Address of circuit name
$CALL P$CCID ; Convert circuit ID to internal format
TRN
MOVEM S1,CKTCID(P4) ; and save it
>; End TOPS20
$RETT] ; And return
CAME P1,CKTCDW(P4) ; Yes, using the same circuit twice?
JRST ADDCK2 ; No, continue
LOAD S1,P1,CD%TYP ; Get circuit type code
CAXE S1,CT%NI ; Is this an NIA-20 circuit?
JRST ADDCK4 ; No, go complain about duplicate
ADDCK2: ADDI P4,CKT.SZ-1 ; Offset to next circuit table entry
AOBJN P4,ADDCK1 ; Loop to check all circuits in table
ADDCK3: 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
ADDCK4: MOVE S1,CKTNIB(P4) ; Get NIB of circuit owner
TXNN P1,CD%SCK ; Is this a service circuit?
SKIPA S2,[[ASCIZ |Circuit|]] ; No, get standard description
MOVEI S2,[ASCIZ |Service circuit|] ; Yes, get different description
ERROR$ (<^T/(S2)/ ^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
ADDCK5: TXNN P1,CD%SCK ; Is this a service circuit?
SKIPA S2,[[ASCIZ |circuit|]] ; No, get standard description
MOVEI S2,[ASCIZ |service circuit|] ; Yes, get different description
ASK$ (<^W/NIBNAM(P3)/'s new ^T/(S2)/ 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 ADDCK4 ; 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$CCID - Parse circuit identifier
; Call with address of ASCII circuit name in S1. Return with circuit ID
; in internal format in S1.
TOPS20 <
P$CCID: $SAVE <P1,P2> ; Save P1 and P2
HRLI S1,(POINT 7)
MOVE P1,S1 ; Save byte pointer to name
MOVE T3,[POINT 7,T2] ; Byte pointer to copy name
MOVEI S2,5 ; Max of 5 bytes (one word)
MOVEI T4,5 ; Max number of bytes
SETZB T2,P2 ; Clear out destination, and circuit ID
P$CC20: SOJL T4,[$RETF] ; Terminated too soon. invalid
ILDB T1,P1 ; Get a byte
CAIL T1,140 ; Is it lower case?
SUBI T1,40 ; Yes, make it upper case
CAIN T1,"-" ; Did it include the dash?
JRST P$CC21 ; Yes, stop here.
IDPB T1,T3 ; Save in copying string
SOJG S2,P$CC20 ; Get another byte
$RETF ; Illegal name
P$CC21: MOVEI T1,CT%MAX ; Maximum device number
P$CC22: CAMN T2,KONNAM(T1) ; Is this the device we care about?
JRST P$CC23 ; Yes, exit
SOJGE T1,P$CC22 ; Try for next device number
$RETF
P$CC23: STORE T1,P2,CI%DEV ; Store in circuit ID we are building
$CALL P$CC28 ; Get a number from the string
STORE T1,P2,CI%KON ; Store as device number in circuit ID
$CALL P$CC28 ; Get the next number from the string
STORE T1,P2,CI%UNI ; Save unit number
$CALL P$CC28 ; Get next number (if any)
STORE T1,P2,CI%DRP ; Save as drop number (port on CI)
MOVE S1,P2 ; Get the circuit ID we just built
$RETT
P$CC28: SETZ T1, ; Clear destination number
P$CC29: ILDB T2,P1 ; Get next digit
CAIL T2,"0" ; Range
CAILE T2,"9" ; check
$RET ; Not a digit
SUBI T2,"0" ; Convert to number
IMULI T1,^D10 ; Shift original number
ADD T1,T2 ; Add in current digit
JRST P$CC29 ; And get another digit
$RET
>; End TOPS20
SUBTTL Support Routines -- CHKCKT
; Call with internal circuit ID in S1 and table address in S2
TOPS20 <
CHKCKT: $SAVE <P1>
MOVE P1,S1 ; Copy circuit ID
JUMPE S2,CHKCK2 ; If no table address, then make one
MOVE T2,S2
CHKCK1: SKIPN T1,(T2) ; Anything in cell?
JRST CHKCK3 ; No, then no match so insert this one
CAMN S1,T1 ; Is this circuit already in there?
$RETF ; Yes, then return failure
AOBJN T2,CHKCK1 ; No, try the next one if any
CHKCK2: HLRE S1,S2 ; Get negative table entry count
MOVNS S1 ; Make positive
ADDI S1,^D20 ; Increase table size a bit
$CALL GETCOR ; Allocate memory for table
JUMPF [ SETZ S2, ; If error no block address
.RETT ] ; and say we didn't match
MOVNS S1 ; Create AOBJN pointer to table
HRL S2,S1 ; ...
MOVE T2,S2
CHKCK3: MOVEM P1,(T2) ; Save internal ID
$RETT
>; End TOPS20
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 -- Service Information Block Output
; Routine to set up SIB for output to from $TEXT. Call with
; address of SIB in S1.
SETSIB: MOVEM S1,OUTSIB ; Save address of output SIB
$RETT ; And return
; Routine called to output a character to a service information block.
; Call with character in S1, address of SIB in SIBADR.
PUTSIB: $SAVE <P1,P2> ; Save P1 and P2
MOVE P1,S1 ; Save output character
MOVE P2,OUTSIB ; Get address of current SIB
PUTSI1: SOSLE SIBBCT(P2) ; Any room left in current SIB?
JRST PUTSI2 ; Yes, go output character and return
MOVE S1,P2 ; Get address of SIB
$CALL EXPSIB ; Expand buffer
JRST PUTSI1 ; Loop back and try again
PUTSI2: IDPB P1,SIBBPT(P2) ; Store output character
$RETT ; And return
SUBTTL Support Routines -- EXPSIB
; Routine called to expand service info block's buffer. Call with
; address of SIB in S1.
EXPSIB: $SAVE <P1> ; Save P1
MOVE P1,S1 ; Save address of SIB in P1
MOVE S1,SIBBSZ(P1) ; Get current size of buffer
ADDI S1,20 ; Increase by twenty words
$CALL GETCOR ; Allocate a larger chunk of memory
EXCH S1,SIBBSZ(P1) ; Exchange old and new buffer sizes
EXCH S2,SIBBUF(P1) ; And buffer addresses
JUMPE S1,EXPSI1 ; Skip copy if no previous buffer
PUSH P,S1 ; Save buffer size
PUSH P,S2 ; And buffer address
HRLZS S2 ; Build BLT pointer to copy old buffer
HRR S2,SIBBUF(P1) ; ...
ADD S1,SIBBUF(P1) ; Calculate last word of transfer
BLT S2,-1(S1) ; Copy old buffer into new buffer
POP P,S2 ; Get back address of buffer
MOVE S1,(P) ; Get size of old buffer
$CALL M%RMEM ; Free up memory
POP P,S1 ; Get back size of old buffer
EXPSI1: IMULI S1,5 ; Convert size into byte count
SUBI S1,1 ; Calculate number of bytes used
SUB S1,SIBBCT(P1) ; ...
MOVE S2,SIBBSZ(P1) ; Get size of buffer
IMULI S2,5 ; In words
SUB S2,S1 ; Calculate bytes remaining
MOVEM S2,SIBBCT(P1) ; And save
MOVE S2,SIBBUF(P1) ; Get address of buffer
TLO S2,(POINT 7) ; Construct byte pointer
ADJBP S1,S2 ; ...
MOVEM S1,SIBBPT(P1) ; And save
$RETT ; 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>>