Trailing-Edge
-
PDP-10 Archives
-
BB-X116A-BB_1984
-
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 ; Get required symbols
.DIREC FLBLST ; Generate clean listing
PROLOG (NIPGEN) ; Declare our name
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 1984.
; 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 <
.TEXT "REL:GLXLIB/SEARCH"
>; End TOPS10
; Program version information
NIPVER==2 ; Major version number
NIPEDT==5 ; Edit level (see Edit History)
NIPWHO==0 ; Editor
NIPMIN==0 ; Minor version number
%%NIP==VRSN.(NIP) ; Full word version
TOPS10 <
LOC 137
.JBVER::! EXP %%NIP ; Store program version
RELOC
>; End TOPS10
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 Parameters............................... 4
; 4. Macros
; 4.1 ASK$.............................................. 5
; 4.2 ERROR$............................................ 6
; 5. Data Structures
; 5.1 Access Information Block.......................... 7
; 5.2 Node Information Block............................ 8
; 6. Data Segment
; 6.1 File Descriptor Blocks............................ 9
; 6.2 Parser Function Descriptor Blocks................. 10
; 6.3 Volatile Data..................................... 15
; 7. Program Initialization.................................... 16
; 8. Dialog starts here........................................ 17
; 9. Configuration Dialog
; 9.1 KL10 System....................................... 18
; 9.2 MCB Front End..................................... 20
; 9.3 KS10 System....................................... 22
; 9.4 Remote Nodes...................................... 24
; 9.5 Access Information................................ 25
; 10. File Generation
; 10.1 NCP.CMD........................................... 26
; 10.2 NIPTST.CTL........................................ 28
; 10.3 NIPNFT.CTL........................................ 32
; 11. Support Routines
; 11.1 Node Information Block Manipulation............... 33
; 11.2 Link Table Manipulation........................... 38
; 11.3 File Processing................................... 40
; 11.4 S$ASK............................................. 41
; 11.5 S$ERRO............................................ 43
; 11.6 CPYATM............................................ 44
; 12. The End................................................... 45
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".
#; End Revision History
SUBTTL Symbol Definitions -- Assembly Parameters
; Additional ACs
FL==.A13 ; Flags register
FL%NEC==1B0 ; No echo of user input
FL%HCT==3B2 ; Host node's CPU type
.CPKS1==0 ; KS10 CPU
.CPKL1==1 ; KL10 CPU
; Assembly constants
PDLLEN==^D200 ; Length of stack
PRM.SZ==^D80 ; Prompt string length in characters
TXT.SZ==^D132 ; Text buffer length in characters
ATM.SZ==^D132 ; Atom buffer length in characters
UID.SZ==^D16 ; User-id length in characters
ACC.SZ==^D16 ; Account length in characters
PSW.SZ==^D16 ; Password length in characters
; DECnet constants
MAXADR==^D255 ; Maximum node address
; Configuration constants
TOPS10 < ; If TOPS10
SY.KL1==6 ; Up to six KL10s on a system
KL.MCB==3 ; Up to three MCBs on a KL10
SY.MCB==SY.KL1*KL.MCB ; Number of MCBs on a system
KS.KMC==1 ; Up to one KMC11 on KS10
KS.KDU==2 ; Up to two DUP11s on a KMC11
KS.KDP==KS.KMC*KS.KDU ; Number of KDPs on a KS10
>; End TOPS10
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
MC.KDP==MC.KMC*MC.KDU ; Number of KDPs on a MCB
MC.SYN==<MC.DMC+MC.DMR+MC.KDP> ; Number of synchronous lines on an MCB
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 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 ; There 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==.-AIBUID ; 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 !
; !=======================================================!
; ! Message Flags (NF%xxx) !
; !=======================================================!
; ! Address of Data Link Parse Block !
; !=======================================================!
; ! AOBJN Pointer to Links 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 ; Says this is an MCB
NF%NFT==1B1 ; Says we should test NFT
NIBLPB:! BLOCK 1 ; Address of data link parse block
NIBLNK:! BLOCK 1 ; AOBJN pointer to link table
NIBNML:! BLOCK AIB.SZ ; NML access information
NIBNFT:! BLOCK AIB.SZ ; NFT access information
NIB.SZ==.-NIBNAM ; Length of node 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 Segment -- File Descriptor Blocks
; File Descriptor Blocks
NCPFD: ; File descriptor block for NCP.CMD
TOPS10 < ; If TOPS10 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 TOPS20 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 TOPS10 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 TOPS20 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 TOPS10 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 TOPS20 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: $BUILD 1
$SET (.CMFNP,CM%FNC,.CMINI)
$EOB
; Parser Function Descriptor Block for Confirms
CFMPDB: $BUILD 1
$SET (.CMFNP,CM%FNC,.CMCFM)
$EOB
; Parser Function Descriptor Block for Node Names
NDNPDB: $BUILD 1
$SET (.CMFNP,,<FLD(.CMNOD,CM%FNC)!CM%PO!CM%NSF>)
$EOB
; Parser Function Descriptor Block for Node Addresses
NDAPDB: $BUILD 2
$SET (.CMFNP,CM%FNC,.CMNUM)
$SET (.CMDAT,,^D10)
$EOB
; Parser Function Descriptor Block for CPU Type
CPUPDB: $BUILD 4
$SET (.CMFNP,,<FLD(.CMKEY,CM%FNC)!CM%DPP>)
$SET (.CMDAT,,CPUTAB)
$SET (.CMDEF,,0)
$EOB
CPUTAB: $STAB
KEYTAB .CPKL1,<KL10>
KEYTAB .CPKS1,<KS10>
$ETAB
; Parser Function Descriptor Block for Link Counts
NUMPDB: $BUILD 2
$SET (.CMFNP,CM%FNC,.CMNUM)
$SET (.CMDAT,,^D10)
$EOB
; Parser Function Descriptor Block for Remote Node Names
RNNPDB: $BUILD 1
$SET (.CMFNP,CM%FNC,.CMCFM)
$SET (.CMFNP,CM%LST,NDNPDB)
$EOB
; Parser Function Descriptor Block for YES/NO Answer
YNOPDB: $BUILD 2
$SET (.CMFNP,CM%FNC,.CMKEY)
$SET (.CMFNP,CM%LST,CFMPDB)
$SET (.CMDAT,,YNOTAB)
$EOB
YNOTAB: $STAB
KEYTAB FALSE,<NO>
KEYTAB TRUE,<YES>
$ETAB
; Parser Function Descriptor Block for User-id
UIDPDB: $BUILD 1
$SET (.CMFNP,CM%FNC,.CMCFM)
$SET (.CMFNP,CM%LST,UIDPD1)
$EOB
UIDPD1: $BUILD 1
$SET (.CMFNP,CM%FNC,.CMTXT)
$EOB
; Parser Function Descriptor Block for Account
ACCPDB: $BUILD 1
$SET (.CMFNP,CM%FNC,.CMCFM)
$SET (.CMFNP,CM%LST,ACCPD1)
$EOB
ACCPD1: $BUILD 1
$SET (.CMFNP,CM%FNC,.CMTXT)
$EOB
; Parser Function Descriptor Block for Password
PSWPDB: $BUILD 1
$SET (.CMFNP,CM%FNC,.CMCFM)
$SET (.CMFNP,CM%LST,PSWPD1)
$EOB
PSWPD1: $BUILD 1
$SET (.CMFNP,CM%FNC,.CMTXT)
$EOB
; Parser Function Descriptor Block for KL10 data links
KLLPDB: $BUILD 2
$SET (.CMFNP,CM%FNC,.CMKEY)
$SET (.CMDAT,,KLLTAB)
$EOB
DEFINE XXMCB(CPU,NNN),<KEYTAB ,DTE-CPU-NNN>
KLLTAB: $STAB
..CPU==0
REPEAT SY.KL1,<
..MCB==1
REPEAT KL.MCB,<
XXMCB \..CPU,\..MCB
..MCB==..MCB+1
>; END REPEAT KL.MCB
..CPU==..CPU+1
>; END REPEAT SY.KL1
$ETAB
; Parser Function Descriptor Block for MCB data links
MCLPDB: $BUILD 2
$SET (.CMFNP,CM%FNC,.CMKEY)
$SET (.CMDAT,,MCLTAB)
$EOB
DEFINE XXDMC(NNN),<KEYTAB ,DMC-NNN>
DEFINE XXDMR(NNN),<KEYTAB ,DMR-NNN>
DEFINE XXKDP(KMC,DUP),<KEYTAB ,KDP-KMC-DUP>
MCLTAB: $STAB
..DMC==0
REPEAT MC.DMC,<
XXDMC \..DMC
..DMC==..DMC+1
>; END REPEAT MC.DMC
..DMR==0
REPEAT MC.DMR,<
XXDMR \..DMR
..DMR==..DMR+1
>; END REPEAT MC.DMR
..KMC==0
REPEAT MC.KMC,<
..DUP==0
REPEAT MC.KDU,<
XXKDP \..KMC,\..DUP
..DUP==..DUP+1
>; END REPEAT MC.KDU
..KMC==..KMC+1
>; END REPEAT MC.KMC
$ETAB
; Parser Function Descriptor Block for KS10 data links
KSLPDB: $BUILD 2
$SET (.CMFNP,CM%FNC,.CMKEY)
$SET (.CMDAT,,KSLTAB)
$EOB
DEFINE XXKDP(KMC,DUP),<KEYTAB ,KDP-KMC-DUP>
KSLTAB: $STAB
..KMC==0
REPEAT KS.KMC,<
..DUP==0
REPEAT KS.KDU,<
XXKDP \..KMC,\..DUP
..DUP==..DUP+1
>; END REPEAT KS.KDU
..KMC==..KMC+1
>; END REPEAT KS.KMC
$ETAB
SUBTTL Data Segment -- Volatile Data
; GLXLIB initialization block
NIPIB: $BUILD (IB.SZ) ; Initialization block
$SET (IB.PRG,,'NIPGEN') ; Program name
$SET (IB.FLG,,IT.OCT) ; Require command terminal
$EOB
; 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 PROMPT,<<PRM.SZ+1+4>/5> ; Prompt string storage
$DATA TXTBUF,<<TXT.SZ+1+4>/5> ; Command string storage
$DATA ATMBUF,<<ATM.SZ+1+4>/5> ; Atom string storage
$DATA CSTBLK,<.CMABC+1> ; Command state block
$DATA NODLST,<MAXADR+1> ; 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
SETZ FL, ; Clear flags register
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 TOPS10
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?
HRROI S1,[ASCIZ |KL10|] ; Yes.
TXNE S2,F%KS10&RHMASK ; Are we a KS?
HRROI S1,[ASCIZ |KS10|] ; Yes, say so
>; End TOPS10
MOVEM S1,CPUPDB+.CMDEF ; Install the default
TOPS10 < ; If TOPS10
$TEXT (,<NIPGEN for DECnet-10 version 3.0>)
>; End TOPS20
TOPS20 < ; If TOPS20
$TEXT (,<NIPGEN for DECnet-20 version 3.0>)
>; End TOPS20
SUBTTL Dialog starts here
DIALOG: $TEXT (,<^J^JHost node definition section.>)
DIALO1: ASK$ (<^JHost name: >,NDNPDB)
TLNN S1,770000 ; Skip if SIXBIT style node name
ERROR$ (<Invalid node name: "^D/S1/">,DIALO1)
MOVE P1,S1 ; Save node name in P1
MOVEM P1,HSTNIB ; Save in HSTNIB for later use
DIALO2: ASK$ (<^W/P1/'s node address: >,NDAPDB)
SKIPLE S1 ; Node address valid?
CAXLE S1,MAXADR ; ...
ERROR$ (<Invalid node address: "^D/S1/">,DIALO2)
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
ASK$ (<^W/NIBNAM(P1)/'s CPU type: >,CPUPDB)
HRRZ S1,(S1) ; Get CPU type code
STORE S1,FL,FL%HCT ; Save host's CPU type
MOVEI S2,KLLPDB ; Get address of KL10 link parse block
CAXN S1,.CPKS1 ; KS10 CPU?
MOVEI S2,KSLPDB ; Yes, get address of KS10 link parse block
MOVEM S2,NIBLPB(P1) ; Save in NIB for later use
MOVEI S2,ASKKL ; Get address of KL10 routine
CAXN S1,.CPKS1 ; KS10 CPU?
MOVEI S2,ASKKS ; Yes, get address of KS10 routine
MOVE S1,P1 ; Get address of host's NIB
$CALL (S2) ; Call appropriate configuration routine
$CALL ASKRMT ; Now go ask about remote nodes
$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 -- KL10 System
; Call with host's NIB address in S1
ASKKL: $SAVE <P1,P2,P3> ; Save P1, P2, and P3
MOVE P2,S1 ; Save address of host NIB in P2
$TEXT (,<^JFor node ^W/NIBNAM(P2)/:>)
ASKKL1: ASK$ (<How many MCBs do you wish to test? >,NUMPDB)
SKIPL S1 ; Valid answer?
CAXLE S1,SY.MCB ; ...
ERROR$ (<Invalid number of MCBs: "^D/S1/">,ASKKL1)
JUMPE S1,.RETT ; If no links, return now
MOVE P3,S1 ; Save MCB count in P3
DMOVE S1,P2 ; Get address of NIB and count of links
$CALL CRELKT ; Create links table for this NIB
ASKKL2: ASK$ (<^JMCB node name: >,NDNPDB)
TLNN S1,770000 ; Skip if SIXBIT style node name
ERROR$ (<Invalid node name: "^D/S1/">,ASKKL2)
CAMN S1,NIBNAM(P2) ; Guard against foolishness
ERROR$ (<Invalid node name: "^W/S1/">,ASKKL2)
MOVE P1,S1 ; Save node name in P1
ASKKL3: ASK$ (< ^W/P1/'s node address: >,NDAPDB)
SKIPLE S1 ; Node address valid?
CAXLE S1,MAXADR ; ...
ERROR$ (<Invalid node address: "^D/S1/">,ASKKL3)
MOVE S2,S1 ; Get node address
MOVE S1,P1 ; Get node name
$CALL GETNIB ; get Node Information Block
JUMPF ASKKL2 ; Ask again if can't
MOVE P1,S1 ; Save NIB address in P1
MOVX S1,NF%MCB ; Set MCB flag in NIB
IORM S1,NIBFLG(P1) ; ...
MOVEI S1,MCLPDB ; Get address of link parse block
MOVEM S1,NIBLPB(P1) ; Save for later use
; Continued on next page
; Continued from previous page
ASKKL4: ASK$ (< ^W/NIBNAM(P2)/'s link to ^W/NIBNAM(P1)/: >,@NIBLPB(P2))
HLL S2,(S1) ; Get address of ASCIZ link name
HRR S2,P1 ; And address of MCB's NIB
MOVE S1,P2 ; Get address of host's NIB
$CALL ADDLKT ; Add link to host's link table
JUMPF ASKKL4 ; Ask again if can't
MOVEI S1,NIBNML(P1) ; Get address of NML's AIB
MOVE S2,P1 ; And address of NIB
$CALL ASKAIB ; Ask for access information
SOJG P3,ASKKL2 ; Loop back for all MCBs
MOVE P3,NIBLNK(P2) ; Get AOBJN pointer to link table
ASKKL5: HRRZ S1,(P3) ; Get NIB of next MCB
MOVE S2,P2 ; Get address of host NIB
$CALL ASKMCB ; Ask about that MCB's configuration
AOBJN P3,ASKKL5 ; Loop for all MCBs
$RETT ; And then return
SUBTTL Configuration Dialog -- MCB Front End
; Call with MCB's NIB address in S1, host's NIB in S2
ASKMCB: $SAVE <P1,P2,P3,P4> ; Save P1, P2, P3, and P4
MOVE P2,S1 ; Save address of MCB NIB in P2
MOVE P4,S2 ; Save address of host NIB in P4
$TEXT (,<^JFor node ^W/NIBNAM(P2)/:>)
ASKMC1: ASK$ (<How many synchronous lines do you wish to test? >,NUMPDB)
SKIPL S1 ; Valid answer?
CAXLE S1,MC.SYN ; ...
ERROR$ (<Invalid number of synchronous lines: "^D/S1/">,ASKMC1)
JUMPE S1,.RETT ; If no links, return now
MOVE P3,S1 ; Save synchronous line count in P3
DMOVE S1,P2 ; Get address of NIB and count of links
$CALL CRELKT ; Create links table for this NIB
ASKMC2: ASK$ (<^JRemote node name: >,NDNPDB)
TLNN S1,770000 ; Skip if SIXBIT style node name
ERROR$ (<Invalid node name: "^D/S1/">,ASKMC2)
CAME S1,NIBNAM(P2) ; Guard against foolishness
CAMN S1,NIBNAM(P4) ; ...
ERROR$ (<Invalid node name: "^W/S1/">,ASKMC2)
MOVE P1,S1 ; Save node name in P1
ASKMC3: ASK$ (< ^W/P1/'s node address: >,NDAPDB)
SKIPLE S1 ; Node address valid?
CAXLE S1,MAXADR ; ...
ERROR$ (<Invalid node address: "^D/S1/">,ASKMC3)
MOVE S2,S1 ; Get node address
MOVE S1,P1 ; Get node name
$CALL GETNIB ; Get Node Information Block
JUMPF ASKMC2 ; Ask again if can't
MOVE P1,S1 ; Save NIB address in P1
; Continued on next page
; Continued from previous page
ASKMC4: ASK$ (< ^W/NIBNAM(P2)/'s link to ^W/NIBNAM(P1)/: >,@NIBLPB(P2))
HLL S2,(S1) ; Get address of ASCIZ link name
HRR S2,P1 ; And address of remote node's NIB
MOVE S1,P2 ; Get address of MCB's NIB
$CALL ADDLKT ; Add link to MCB's link table
JUMPF ASKMC4 ; Ask again if can't
MOVX S1,NF%MCB ; Is this an MCB?
TDNN S1,NIBFLG(P1) ; ...
CAMN P1,HSTNIB ; Or the host node?
JRST ASKMC5 ; Yes, don't ask about NFT
ASK$ (< Test file transfers to ^W/NIBNAM(P1)/? ^A>,YNOPDB)
HRRE TF,(S1) ; Get answer
JUMPF ASKMC5 ; Skip this if answer is no
MOVX S1,NF%NFT ; Set NFT flag
IORM S1,NIBFLG(P1) ; ...
MOVEI S1,NIBNFT(P1) ; Get address of NFT's AIB
MOVE S2,P1 ; And address of NIB
$CALL ASKAIB ; Ask for access information
ASKMC5: SOJG P3,ASKMC2 ; Loop back for all synchronous lines
$RETT ; And then return
SUBTTL Configuration Dialog -- KS10 System
; Call with KS10's NIB address in S1
ASKKS: $SAVE <P1,P2,P3> ; Save P1, P2, and P3
MOVE P2,S1 ; Save address of KS10 NIB in P2
$TEXT (,<^JFor node ^W/NIBNAM(P2)/:>)
ASKKS1: ASK$ (<How many KDPs do you wish to test? >,NUMPDB)
SKIPL S1 ; Valid answer?
CAXLE S1,KS.KDP ; ...
ERROR$ (<Invalid number of KDPs: "^D/S1/">,ASKKS1)
JUMPE S1,.RETT ; If no links, return now
MOVE P3,S1 ; Save KDP count in P3
DMOVE S1,P2 ; Get address of NIB and count of links
$CALL CRELKT ; Create links table for this NIB
ASKKS2: ASK$ (<^JRemote node name: >,NDNPDB)
TLNN S1,770000 ; Skip if SIXBIT style node name
ERROR$ (<Invalid node name: "^D/S1/">,ASKKS2)
CAMN S1,NIBNAM(P2) ; Guard against foolishness
ERROR$ (<Invalid node name: "^W/S1/">,ASKKS2)
MOVE P1,S1 ; Save node name in P1
ASKKS3: ASK$ (< ^W/P1/'s node address: >,NDAPDB)
SKIPLE S1 ; Node address valid?
CAXLE S1,MAXADR ; ...
ERROR$ (<Invalid node address: "^D/S1/">,ASKKS3)
MOVE S2,S1 ; Get node address
MOVE S1,P1 ; Get node name
$CALL GETNIB ; Get Node Information Block
JUMPF ASKKS2 ; Ask again if can't
MOVE P1,S1 ; Save NIB address in P1
; Continued on next page
; Continued from previous page
ASKKS4: ASK$ (< ^W/NIBNAM(P2)/'s link to ^W/NIBNAM(P1)/: >,@NIBLPB(P2))
HLL S2,(S1) ; Get address of ASCIZ link name
HRR S2,P1 ; And address of remote node's NIB
MOVE S1,P2 ; Get address of KS10's NIB
$CALL ADDLKT ; Add link to KS10's link table
JUMPF ASKKS4 ; Ask again if can't
MOVX S1,NF%MCB ; Is this an MCB?
TDNN S1,NIBFLG(P1) ; ...
CAMN P1,HSTNIB ; Or the host node?
JRST ASKKS5 ; Yes, don't ask about NFT
ASK$ (< Test file transfers to ^W/NIBNAM(P1)/? ^A>,YNOPDB)
HRRE TF,(S1) ; Get answer
JUMPF ASKKS5 ; Skip this if answer is no
MOVX S1,NF%NFT ; Set NFT flag
IORM S1,NIBFLG(P1) ; ...
MOVEI S1,NIBNFT(P1) ; Get address of NFT's AIB
MOVE S2,P1 ; And address of NIB
$CALL ASKAIB ; Ask for access information
ASKKS5: SOJG P3,ASKKS2 ; Loop back for all KDPs
$RETT ; And then return
SUBTTL Configuration Dialog -- Remote Nodes
ASKRMT: $TEXT (,<^J^JRemote node definition section.>)
$TEXT (,<(Type an extra CR when through)>)
$SAVE <P1> ; Save P1
ASKRM1: ASK$ (<^JRemote node name: >,RNNPDB)
MOVE P1,S1 ; Save node name in P1
HRRZ S1,CR.PDB(S2) ; Get PDB that was parsed
CAIN S1,RNNPDB ; Was it a confirm?
$RETT ; Yes, return now
TLNN P1,770000 ; Skip if SIXBIT style node name
ERROR$ (<Invalid node name: "^D/P1/">,ASKRM1)
ASKRM2: ASK$ (< ^W/P1/'s node address: >,NDAPDB)
SKIPLE S1 ; Node address valid?
CAXLE S1,MAXADR ; ...
ERROR$ (<Invalid node address: "^D/S1/">,ASKRM2)
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
MOVE P1,S1 ; Save NIB address in P1
MOVX S1,NF%MCB ; Is this an MCB?
TDNN S1,NIBFLG(P1) ; ...
CAMN P1,HSTNIB ; Or the host node?
JRST ASKRM1 ; Yes, don't ask about NFT
ASK$ (< Test file transfers to ^W/NIBNAM(P1)/? ^A>,YNOPDB)
HRRE TF,(S1) ; Get answer
JUMPF ASKRM1 ; Loop back if answer is no
MOVX S1,NF%NFT ; Set NFT flag
IORM S1,NIBFLG(P1) ; ...
MOVEI S1,NIBNFT(P1) ; Get address of NFT's AIB
MOVE S2,P1 ; And address of NIB
$CALL ASKAIB ; Ask for access information
JRST ASKRM1 ; And then loop back for more
SUBTTL Configuration Dialog -- Access Information
; ASKAIB is called to ask user for access information. Call with
; address of AIB in S1, address of corresponding NIB in S2.
ASKAIB: $SAVE <P1,P2> ; Save P1 and P2
DMOVE P1,S1 ; Save address of AIB and NIB
MOVEI S1,AIB.SZ ; Get size of AIB
MOVE S2,P1 ; And address of AIB
$CALL .ZCHNK ; Zero AIB block
ASK$ (< ^W/NIBNAM(P2)/'s user-id: >,UIDPDB)
HRRZ S1,CR.PDB(S2) ; Get FDB we parsed with
CAIN S1,UIDPDB ; 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 CPYATM ; Copy user-id into it
ASKAI1: ASK$ (< ^W/NIBNAM(P2)/'s account: >,ACCPDB)
HRRZ S1,CR.PDB(S2) ; Get FDB we parsed with
CAIN S1,ACCPDB ; 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 CPYATM ; Copy user-id into it
ASKAI2: TXO FL,FL%NEC ; Disable terminal echo
ASK$ (< ^W/NIBNAM(P2)/'s password: >,PSWPDB)
TXZ FL,FL%NEC ; Reenable terminal echo
HRRZ S1,CR.PDB(S2) ; Get FDB we parsed with
CAIN S1,PSWPDB ; 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 CPYATM ; 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 NIPGEN version ^V/.JBVER/
!
ENTER NCP
>)
MOVSI P2,-<MAXADR+1> ; Make AOBJN pointer to NODLST
GENNC1: SKIPN P1,NODLST(P2) ; Is there a node defined?
JRST GENNC2 ; No, continue
CAME P1,HSTNIB ; Skip if this is the host node
$TEXT (PUTFIL,<SET NODE ^D/NIBNAD(P1)/ NAME ^W/NIBNAM(P1)/>)
GENNC2: AOBJN P2,GENNC1 ; Loop for all nodes in NODLST
; Continued on next page
; Continued from previous page
$TEXT (PUTFIL,<>) ; Add a blank line
MOVE P4,HSTNIB ; Get address of host's NIB
LOAD S1,FL,FL%HCT ; Get host's CPU type
CAXN S1,.CPKL1 ; KL10 CPU?
SKIPN P3,NIBLNK(P4) ; Yes, get AOBJN pointer to link table
JRST GENNC4 ; Skip this if not KL10 or no links
GENNC3: HRRZ P1,(P3) ; Get address of next MCB's NIB
HLRZ P2,(P3) ; And address of link description
$TEXT (PUTFIL,<SET NODE ^W/NIBNAM(P1)/ CPU PDP-11
SET NODE ^W/NIBNAM(P1)/ SERVICE CIRCUIT ^T/(P2)/
SET NODE ^W/NIBNAM(P1)/ SECONDARY LOADER SYS:DTEMPS.SYS
SET NODE ^W/NIBNAM(P1)/ TERTIARY LOADER SYS:DTEMPT.SYS
SET NODE ^W/NIBNAM(P1)/ LOAD FILE SYS:^W/NIBNAM(P1)/.SYS
SET NODE ^W/NIBNAM(P1)/ HOST ^W/NIBNAM(P4)/
SET NODE ^W/NIBNAM(P1)/ SECONDARY DUMPER SYS:DTEDMP.SYS
SET NODE ^W/NIBNAM(P1)/ DUMP FILE SYS:^W/NIBNAM(P1)/.DMP
SET CIRCUIT ^T/(P2)/ SERVICE ENABLED
>)
AOBJN P3,GENNC3 ; Loop for all MCBs
GENNC4: $TEXT (PUTFIL,<RETURN>)
$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 NIPGEN version ^V/.JBVER/
!
.NOERROR
.R OPR
*DISABLE OUTPUT-DISPLAY ALL-MESSAGES
*ENTER NCP>)
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 link
; Continued on next page
; Continued from previous page
LOAD S1,FL,FL%HCT ; Get host's CPU type
CAXN S1,.CPKL1 ; KL10 CPU?
SKIPN P3,NIBLNK(P4) ; Yes, get AOBJN pointer to link table
JRST GENTS4 ; Skip this if not KL10 or no links
GENTS1: HRRZ P1,(P3) ; Get address of next MCB's NIB
HLRZ P2,(P3) ; And address of link description
$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>)
PUSH P,P3 ; Save AOBJN pointer for a bit
SKIPN P3,NIBLNK(P1) ; Get AOBJN pointer to MCB's links
JRST GENTS3 ; Skip this if no links
GENTS2: HLRZ S1,(P3) ; Get address of link name
HRRZ S2,(P3) ; And address of remote NIB
$TEXT (PUTFIL,<SET CIRCUIT ^T/(S1)/ STATE OFF ! Node ^W/NIBNAM(S2)/>)
AOBJN P3,GENTS2 ; Loop for all circuits on MCB
$TEXT (PUTFIL,<*WAIT 35>) ; Wait for MCB to settle down
GENTS3: POP P,P3 ; Restore AOBJN pointer to host's links
; Continued on next page
; Continued from previous page
$TEXT (PUTFIL,<*SHOW EXECUTOR CHARACTERISTICS
*WAIT 35
*LOOP EXECUTOR COUNT 25 LENGTH 100
*WAIT 35
*LOOP NODE ^D/NIBNAD(P4)/ 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 link
$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>)
AOBJN P3,GENTS1 ; Loop for all MCBs
GENTS4: $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 links 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,NIBLNK(P4) ; Get AOBJN pointer to link table
$RETT ; No links, return now
GENTL1: HRRZ P1,(P3) ; Get NIB of remote node
HLRZ P2,(P3) ; And address of link description
$TEXT (PUTFIL,<!
! Testing link ^T/(P2)/ to node ^W/NIBNAM(P1)/
!
*SET CIRCUIT ^T/(P2)/ STATE ON
*WAIT 35
*LOOP NODE ^D/NIBNAD(P1)/ COUNT 25 LENGTH 100 ! Node ^W/NIBNAM(P1)/
*WAIT 35
*SET CIRCUIT ^T/(P2)/ STATE OFF
*WAIT 35>)
AOBJN P3,GENTL1 ; Loop for all links
$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 NIPGEN version ^V/.JBVER/
!
.NOERROR>)
MOVSI P2,-<MAXADR+1> ; Make AOBJN pointer to NODLST
GENNF1: SKIPN P1,NODLST(P2) ; Is there a node defined?
JRST GENNF2 ; No, continue
MOVX S1,NF%NFT ; Want to test NFT to this node?
TDNN S1,NIBFLG(P1) ; ...
JRST GENNF2 ; No, skip this
$TEXT (PUTFIL,<!
! ***** Testing NFT to node ^W/NIBNAM(P1)/
!
.R NFT
*COPY ^W/NIBNAM(P1)/::/USER:^T/NFTUID(P1)/:^T/NFTACC(P1)/:^T/NFTPSW(P1)/=NIPNFT.CTL/ASCII
*COPY NFTNIP.CTL=^W/NIBNAM(P1)/::NIPNFT.CTL/ASCII/USER:^T/NFTUID(P1)/:^T/NFTACC(P1)/:^T/NFTPSW(P1)/
*DELETE ^W/NIBNAM(P1)/::NIPNFT.CTL/USER:^T/NFTUID(P1)/:^T/NFTACC(P1)/:^T/NFTPSW(P1)/
*EXIT
.R FILCOM
*TTY:=NIPNFT.CTL,NFTNIP.CTL
.DELETE NFTNIP.CTL>)
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> ; Save P1 and P2
DMOVE P1,S1 ; Save node name and address
SKIPE S1,NODLST(P2) ; Number already assigned?
CAME P1,NIBNAM(S1) ; Yes, node names match?
SKIPA ; No, continue
$RETT ; Yes, return now
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 M%GMEM ; Allocate memory for NIB
JUMPF [$STOP (CGM,Can't get required 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,-<MAXADR+1> ; 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 ADDNI2 ; Duplicate name, go ask what to do
AOBJN P3,ADDNI1 ; Empty slot, or not duplicate, loop
MOVE S1,NIBNAD(P1) ; Get node address
SKIPE P4,NODLST(S1) ; Is node number already assigned?
JRST ADDNI3 ; Yes, go ask what to do
MOVEM P1,NODLST(S1) ; 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
ADDNI2: ERROR$ (<^W/NIBNAM(P4)/ is already assigned node address ^D/NIBNAD(P4)/>)
ASK$ (<Do you wish to redefine node ^W/NIBNAM(P4)/? >,YNOPDB)
HRRE TF,(S1) ; Get answer
$RETIF ; Return FALSE if answer is no
MOVE S1,NIBNAD(P4) ; Get node address
SETZM NODLST(S1) ; 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(P2) ; 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
ADDNI3: ERROR$ (<Node address ^D/NIBNAD(P4)/ already assigned to node ^W/NIBNAM(P4)/>)
ASK$ (<Do you wish to reassign address ^D/NIBNAD(P4)/ to node ^W/NIBNAM(P1)/? >,YNOPDB)
HRRE TF,(S1) ; Get answer
$RETIF ; Return FALSE if answer is no
MOVE S1,NIBNAD(P1) ; Get node address
MOVEM P1,NODLST(S1) ; Store new assignment in NODLST
ADDNI4: ASK$ (<^W/NIBNAM(P4)/'s new node address: >,NDAPDB)
SKIPLE S1 ; Node address valid?
CAXLE S1,MAXADR ; ...
ERROR$ (<Invalid node address: "^D/S1/">,ADDNI4)
MOVEM S1,NIBNAD(P4) ; Save new node address
MOVE S1,P4 ; Get address of NIB
$CALL ADDNIB ; Add to NODLST
JUMPF ADDNI4 ; Can't, go ask again
MOVE S1,P1 ; Get NIB's address
$RETT ; And return
SUBTTL Support Routines -- Link Table Manipulation
; Routine to set up a link table for a NIB. Call with S1
; containing the address of the NIB, S2 the link count.
CRELKT: $SAVE <P1,P2> ; Save P1 and P2
DMOVE P1,S1 ; Save NIB address and link count
MOVE S1,P2 ; Get link count
$CALL M%GMEM ; Allocate memory for table
JUMPF S..CGM ; Jump if can't get needed memory
MOVEM S2,NIBLNK(P1) ; Save table address in NIB
MOVN S1,P2 ; Get negative link count
HRLM S1,NIBLNK(P1) ; Form AOBJN pointer in NIB
$RETT ; Return
; Routine to add a link to a NIB's link table. Call with
; S1 containing the address of the NIB to which the link
; is to be added, S2 containing XWD address of ASCIZ link
; name, address of NIB.
;
; Routine returns FALSE if link can't be added to table.
ADDLKT: $SAVE <P1,P2,P3> ; Save P1, P2, and P3
DMOVE P1,S1 ; Save arguments in P1 and P2
MOVE P3,NIBLNK(P1) ; Get AOBJN pointer to link table
ADDLK1: SKIPN (P3) ; Find an empty slot?
JRST [MOVEM P2,(P3) ; Yes, insert link here
$RETT] ; And return
HLRZ S1,(P3) ; Get data link of this entry
HLRZ S2,P2 ; Get data link of new entry
CAMN S1,S2 ; Using the same link twice?
JRST ADDLK2 ; Yes, go ask what to do
AOBJN P3,ADDLK1 ; Loop to check all links in table
$STOP (TWS,Link table is the wrong size)
ADDLK2: HRRZ S2,(P3) ; Get NIB for node already using link
ERROR$ (<Link ^T/(S1)/ already assigned to node ^W/NIBNAM(S2)/>)
ASK$ (<Do you wish to reassign ^T/(S1)/ to node ^W/NIBNAM(P2)/? >,YNOPDB)
HRRE TF,(S1) ; Get answer
$RETIF ; Return now if answer was no
EXCH P2,(P3) ; Store new link assignment
ADDLK3: ASK$ (<^W/NIBNAM(P1)/'s new link to ^W/NIBNAM(P2)/: >,@NIBLPB(P1))
HLL S2,(S1) ; Get address of ASCIZ link name
HRR S2,P2 ; And address of remote node's NIB
MOVE S1,P1 ; Get address of local node's NIB
$CALL ADDLKT ; Add link to local node's link table
JUMPF ADDLK3 ; Ask again if can't
$RETT ; Return now if successful
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%:
;
; Return returns TRUE after getting an answer which parses
; correctly from the user.
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
$SAVE <P1> ; Save P1
MOVE P1,S1 ; Save PDB address in P1
S$ASK1: MOVX S1,CM%RAI!CM%XIF ; Set parsing flags
MOVEM S1,CSTBLK+.CMFLG ; ...
MOVX S1,.PRIIN ; Get terminal input JFN
HRLM S1,CSTBLK+.CMIOJ ; Store into command state block
MOVX S1,.PRIOU ; Get the terminal output JFN
HRRM S1,CSTBLK+.CMIOJ ; Set it up
HRROI S1,PROMPT ; Set up address of prompt string
MOVEM S1,CSTBLK+.CMRTY ; ...
HRROI S1,TXTBUF ; Set up address of command buffer
MOVEM S1,CSTBLK+.CMBFP ; ...
MOVEM S1,CSTBLK+.CMPTR ; ...
MOVEI S1,TXT.SZ ; Get size of TXTBUF
MOVEM S1,CSTBLK+.CMCNT ; Set up counts
MOVEM S1,CSTBLK+.CMINC ; ...
HRROI S1,ATMBUF ; Set up address of atom buffer
MOVEM S1,CSTBLK+.CMABP ; ...
MOVEI S1,ATM.SZ ; And set up size of atom buffer
MOVEM S1,CSTBLK+.CMABC ; ...
MOVEI S1,CSTBLK ; Get address of command state block
MOVEI S2,INIPDB ; Get address of .CMINI PDB
$CALL S%CMND ; Reset the CSB and prompt the user
; Continued on next page
; Continued from previous page
S$ASK2: MOVX S1,.NULIO ; Get the null JFN
TXNE FL,FL%NEC ; Do we want no echo?
HRRM S1,CSTBLK+.CMIOJ ; Yes, set it up
MOVEI S1,CSTBLK ; Get CSTBLK
MOVE S2,P1 ; Get PDB address
$CALL S%CMND ; Go parse this one
MOVE S1,CR.FLG(S2) ; Get flags
TXNE S1,CM%NOP ; Did we parse?
ERROR$ (<^E/[-1]/: "^T/ATMBUF/">,S$ASK1) ; No, tell user and try again
TXNE S1,CM%RPT ; Is a reparse needed?
JRST S$ASK2 ; Yes, go do it
TXNE FL,FL%NEC ; Was echo turned off?
$TEXT (,<>) ; Yes, echo a carriage return
TXNE S1,CM%EOC ; Did command terminate with a <CRLF>?
JRST S$ASK3 ; Yes, don't bother with a confirm
MOVX S1,.PRIOU ; Get the terminal output JFN
HRRM S1,CSTBLK+.CMIOJ ; Always make confirms echo
MOVEI S1,CSTBLK ; Get CSTBLK address
MOVEI S2,CFMPDB ; Get FDB for confirm
$CALL S%CMND ; Did line end here?
MOVE S1,CR.FLG(S2) ; Get the response flags
TXNE S1,CM%NOP ; Did we get a confirm
ERROR$ (<Not confirmed: "^T/ATMBUF/">,S$ASK1)
TXNE S1,CM%RPT ; Is a reparse needed ?
JRST S$ASK2 ; Yes, go do it
S$ASK3: MOVE S1,CR.RES(S2) ; Get the response field
$RETT ; And finish up
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 -- CPYATM
; Routine called to copy parsed atom into alternate storage
; Call with size of string storage in S1, byte pointer in S2.
CPYATM: $SAVE <P1,P2,P3> ; Save P1, P2, and P3
MOVE P3,S1 ; Save string size in P3
MOVEI P1,@S2 ; Get effective address in P1
ANDX S2,BP.POS!BP.SIZ ; Mask byte pointer to position and size
IOR P1,S2 ; Construct byte pointer in P1
MOVE P2,[POINT 7,ATMBUF] ; Get pointer to atom buffer
CPYAT1: 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,CPYAT1 ; Loop till done copying string
$RETT ; And then return
SUBTTL The End
NIPLIT:! LSTOF. ; Literals (XLISTed)
LIT ; Literals
LSTON.
NIPEND:! END NIPGEN