Trailing-Edge
-
PDP-10 Archives
-
BB-H240E-BM_1985
-
tools/netpth.mac
There are 9 other files named netpth.mac in the archive. Click here to see a list.
TITLE NETPTH Display the path from this node to any other
SUBTTL Stu Grossman October 1982
; Feature switches and macros for TOPS10 and TOPS20
;
; In future, I would like to remove the feature tests and make the program
; execute both under TOPS-10 and TOPS-20. Until then, I have only inserted
; feature tests where absolutely needed. In the 20 version, more could be
; commented out. /Gunnar Lindell
IFNDEF FT10,<FT10==:0>
IFNDEF FT20,<FT20==:1>
DEFINE $TOPS10 <IFN FT10>
DEFINE $NOTOPS10 <IFE FT10>
DEFINE $TOPS20 <IFN FT20>
DEFINE $NOTOPS20 <IFE FT20>
IF1,<
$TOPS10 <PRINTX -- Assembling TOPS10 NETPTH -->
$TOPS20 <PRINTX -- Assembling TOPS20 NETPTH -->
>
$TOPS20 <
SEARCH MONSYM,MACSYM
>
SEARCH UUOSYM,MACTEN,SCNMAC
.REQUEST REL:SCAN
$TOPS20 <
.REQUIRE SYS:MACREL
>
IFNDEF FTTIME,<FTTIME=0>
SALL ; Clean listings
F=0
T1=1
T2=2
T3=3
T4=4
P1=5
P2=6
P3=7
P4=10
P=17
N==P3
C==P4
F.SEQL==1B0 ; Scanner has seen an "="
.HELPR==:.POPJ
TWOSEG 400K ; Make us high and low
; Program version information
NPHVER==4 ; With DECnet phase IV
NPHMIN==0 ; Minor version
NPHEDT==4 ; Edit version
NPHWHO==0 ; Who last edited
%%NPH==VRSN.(NPH) ; Full word version
LOC 137
.JBVER::! EXP %%NPH
RELOC
SUBTTL Revision History
COMMENT &
Edit Description
4 31-Jan-85 by Bill Davenport
Fixed up to preserve VERFLG when asking for the circuit back
to a node.
3 15-Jan-85 by Gunnar Lindell
Port NETPTH to TOPS-20. Assemble NETPTH-10 or -20 depending on switch.
2 19-Dec-84 by Carl Appellof
Modified to print the other half of each circuit on the path.
Put response time code under FTTIME, normally off.
1 6-Jun-84 by Bill Davenport
Fixed to work with DECnet phase IV nodes.
&; End Revsion History
SUBTTL MACROS
;Define macro that halts (the error mechanism of this program)
DEFINE XHALT(X) <
JRST [ MOVEI T1,.
JRST DOHALT]
>
; Handy macro for manipulating string blocks
DEFINE STRBLK(MAX<XX>,STRING)<
XX==0
IRPC STRING,<XX==XX+1>
XWD XX,1+<MAX+3>/4
IFB <STRING>,<BLOCK <MAX+3>/4>
CC==^D36-8
XX==0
IRPC STRING,<
XX==XX+"STRING"_CC
CC==CC-8
IFL CC,<CC==^D36-8
XX
XX==0>
>
IFN CC-<^D36-8>,XX
>
DEFINE ERROR(PFX,TEXT)<
JRST [MOVX T1,<SIXBIT |NET'PFX|> ;; Get Prog name, error prefix
MOVE T2,["?",,[ASCIZ |TEXT|]] ;; Get lead char, error text
JRST ERRDIE] ;; And go croak
>
DEFINE WARN(PFX,TEXT)<
PUSHJ P,WRNRTN ;; Call the warning routine
JUMP [SIXBIT |NET'PFX| ;; Get Prog name, error prefix
"%",,[ASCIZ |TEXT|]] ;; Get lead char, error text
>
$TOPS20 <
;Define structure to get a signed byte from T1
DEFSTR SGNBYT,T1,35,8
>
SUBTTL Main program starts here
NETPTH: JFCL ; Ignore CCL entry
RESET ; Blow away the world
SETZ F, ; Clear all flags
MOVE P,STKPTR ; Set up stack
SETZM EXUNT ; Clear "exit when done" flag
SETZM X.NODE ; Clear executor node name storage
CONTIN: PUSHJ P,GETCMD ; Read a command line
MOVEM T1,CURNOD ; Make source be the current node
MOVEM T2,ENDNOD ; Save pointer to destination node
MOVE T1,T2 ; Get pointer to end node
PUSHJ P,GETNNM ; Get node number of end node
MOVEM T1,ENDNUM ; Save it for later
PUSHJ P,GETXTR ; Get local node name
MOVEM T1,LCLNOD ; Save it for everybody else
; Print out banner
PUSHJ P,.TCRLF## ; Skip a line before banner
MOVEI T1,[ASCIZ |[Routing path from |] ; Get header
PUSHJ P,.TSTRG## ; Type it out
MOVE T1,CURNOD ; Get name of first node
SETZ T2, ; No enforced field length
PUSHJ P,.TNNAM ; Type it out
PUSHJ P,.TSPAC## ; Space over
MOVE T1,CURNOD ; Get node address
PUSHJ P,.TNNAD ; Type it out
MOVEI T1,[ASCIZ | to |] ; Type out predicate
PUSHJ P,.TSTRG## ; . . .
MOVE T1,ENDNOD ; Get end node name
SETZ T2, ; No enforced field length
PUSHJ P,.TNNAM ; Type it out too
PUSHJ P,.TSPAC## ; Space over
MOVE T1,ENDNOD ; Get node address
PUSHJ P,.TNNAD ; Type it out
PUSHJ P,.TRBRK## ; Type out closing bracket
PUSHJ P,.TCRLF## ; Type a crlf
PUSHJ P,.TCRLF## ; Type another line
MOVEI T1,[ASCIZ | From Via Back Thru Cost Hops|]
PUSHJ P,.TSTRG## ; Type out column headers
PUSHJ P,.TCRLF## ; <CRLF>
SUBTTL Main loop
; Starting with the current node, find out what circuit is used to get to
; the end node, and then find out which node is connected to the other end
; of that circuit. When we find out the node on the other other end of the
; circuit, make that the current node, and start over. We stop when the
; current node becomes the end node.
MOVE T1,CURNOD ; Get pointer to current node spec
PUSHJ P,OPNLNK ; Go open link to foreign NML
JRST NSPERR ; Can't even link to ourselves!
LOOP:
MOVE T1,CURNOD ; Get current node name
MOVEI T2,^D7 ; Enforced field length
PUSHJ P,.TNNAM ; Type it out
MOVE T1,CURNOD ; Get current node address
PUSHJ P,.TNNAD ; Type it out
MOVEI T1,[ASCIZ / =>/]
PUSHJ P,.TSTRG## ;Type an arrow
MOVE T1,ENDNUM ;Get terminal node's number
PUSHJ P,GETCKT ; Get circuit between here and there
MOVE P1,T1 ; Save it for later
MOVEI T2,^D8 ; Enforced field length
PUSHJ P,.TCASC ; Type it out
MOVEI T1,[ASCIZ | / |]
PUSHJ P,.TSTRG## ;Type a pipe
MOVE T1,CURNOD ;Get current node
PUSHJ P,GETNNM ;Get number from it
MOVEM T1,CURNUM ;Save it for later
MOVE T1,P1 ; Get circuit name back
PUSHJ P,GETNOD ; Get node on other end of the circuit
MOVEM T1,CURNOD ; Make it the new current node
PUSHJ P,CLSLNK ;Don't need this link any more
PUSH P,VERFLG ;Save DECnet version info for a bit
MOVE T1,CURNOD ;So open new one
PUSHJ P,OPNLNK ;to next node on the chain.
JRST [MOVEI T1,[ASCIZ /????????/]
PUSHJ P,.TSTRG##
JRST NOLNK]
MOVE T1,CURNUM ;Get number of previous node on chain
DMOVE P1,COST ;Save cost and hops from orig. circuit
PUSHJ P,GETCKT ;Ask new node how to go backwards
MOVEI T2,^D8 ;Enforced field length
PUSHJ P,.TCASC ;Type back circuit name
NOLNK: MOVEI T1,[ASCIZ /<= /]
PUSHJ P,.TSTRG##
MOVE T1,CURNOD ;Get new node again
MOVEI T2,^D7 ; Enforced field length
PUSHJ P,.TNNAM ; Type out the foreign node name
MOVE T1,CURNOD ; Get current node address
PUSHJ P,.TNNAD ; Type it out
SKIPE T1,LASERR ;Any error on last connect?
JRST NSPERR ;Yes, quit now and tell why.
PUSHJ P,.TTABC## ; Type a tab
IFN FTTIME,<
MOVE T1,CITIME ; Get length of CI
PUSHJ P,TIMPNT ; Print it out
> ;END FTTIME
PUSHJ P,.TTABC##
MOVE T1,P1 ;Get cost of forward circuit
PUSHJ P,.TDECW## ;Type it out.
PUSHJ P,.TTABC##
MOVE T1,P2 ;and HOPS
PUSHJ P,.TDECW## ; too
IFN FTTIME,<
PUSHJ P,.TTABC## ; Type another tab
PUSHJ P,TIMAVG ; Get average of responses
PUSHJ P,TIMPNT ; Print out the average resp time
> ;END IFN FTTIME
PUSHJ P,.TCRLF## ; Finish up with a <CRLF>
MOVE T1,VERFLG ; Get version of next node
EXCH T1,(P) ; Save; get back previous version
MOVEM T1,VERFLG ; And set for later comparison
MOVE P1,CURNOD ; Get pointer to current node
MOVE P2,ENDNOD ; Get pointer to end node
ILDB T1,P1 ; Get low order part of destnode addr
ILDB T2,P1 ; And high order part of addr
LSH T2,^D8 ; Shift into position
IOR T1,T2 ; And combine
ILDB T2,P2 ; Get low order part of end node addr
ILDB T3,P2 ; And high order part of addr
LSH T3,^D8 ; Shift into position
IOR T2,T3 ; And combine
SKIPG VERFLG ; Was current node less than phase IV ?
ANDI T2,1777 ; Yes, mask off area stuff
POP P,VERFLG ; Reset next node's version
CAME T1,T2 ; Same network address?
JRST LOOP ; No, start over
DMOVE T1,P1 ; Now check node names
PUSHJ P,CMPSTR ; Compare them
JRST LOOP ; Different, start over
PUSHJ P,CLSLNK ; Close the final network link
PUSHJ P,.TCRLF## ; Add another CRLF for good effect
JRST CONTIN ; No, go back to command mode
SUBTTL GETCMD Read a command line from the user
; This routine will read in command lines of the form:
;
; Destination=Source
; =Source ; Destination defaults to executor node
; Destination ; Source defaults to executor node
; Destination= ; Same as above
;
; Destination and source must both be reachable nodes. If they are unknown,
; unreachable, or improperly formatted, an appropriate message will be printed,
; and a new command line will be requested.
; Switches (when implememted) may be inserted anywhere except in the middle of
; a node name.
;
; Call: PUSHJ P,GETCMD ; Takes no arguments
; <Only return> ; T1 & T2 contain byte pointers to the
; ; node names in standard NML format.
; ; Ie: <Low#><High#><Length><Name>
;
GETCMD:
; Here after user typed continue (after ^Zing out)
REDNO5: MOVE T1,ISCARG ; Get arg for .ISCAN
PUSHJ P,.ISCAN## ; Init SCAN
; Here after blank line
REDNO1: SKIPN EXUNT ; Do we wnat to exit ???
JRST REDNO2 ; No, do command scanning
EXIT 1, ; Yes, quit now
SETZM EXUNT ; Reset flag
JRST REDNO5 ; And re-init line
; Here to scan new command line
REDNO2: SETZM N.DEST ; Clear this too
SETZM N.SRC ; Clear this too
SETOM DEFFLG ; Allow one node name to be defaulted
MOVE T1,PSCARG ; Get arg for .PSCAN
PUSHJ P,.PSCAN## ; Init the line
JFCL
MOVEI T1,[ASCIZ |NETPTH>|] ; Get prompt
PUSHJ P,.TSTRG## ; Type it out
TXZ F,F.SEQL ; Indicate no "=" seen yet
REDNO0: PUSHJ P,REDNOD ; Go read one name
SKIPN N.SPEC ; Did we parse a node spec?
JUMPLE C,REDEOL ; No, end of line also?
CAIE C,"=" ; Did we get an =??
JRST REDNOF ; No, go see what we got
TXOE F,F.SEQL ; Have we been here before?
ERROR (MES,More than one equals sign in command string)
MOVE T1,[POINT 8,N.SPEC] ; Get BP to node id
MOVE T2,[POINT 8,N.DEST] ; Get BP to destination area
PUSHJ P,CPYNOD ; Copy N.SPEC to N.DEST
JRST REDNO0 ; And try again
;Here when character in C is not "="
REDNOF: SKIPLE C ; Did line terminate properly?
PUSHJ P,REDJEL ; No, go eat it up
MOVE T1,[POINT 8,N.SPEC] ; Get BP to node id
MOVE T2,[POINT 8,N.SRC] ; Get ptr to source area
TXNN F,F.SEQL ; Have we seen an = sign yet?
MOVE T2,[POINT 8,N.DEST] ; No, this is just a source spec
PUSHJ P,CPYNOD ; Copy N.SPEC to N.SRC or N.DEST
REDEOL: CAMN C,[.CHEOF] ; Did user type a ^Z ???
SETOM EXUNT ; Yes, flag exit on end of processing
TXNN F,F.SEQL ; Did we see an equals sign?
SKIPE N.DEST ; No, was a destination specified?
SKIPA ; Yes
JRST REDNO1 ; No, quit now
; Install defaults
MOVE T1,[POINT 8,N.SRC] ; Get BP to source
SKIPN N.SRC ; Did we get a source node?
PUSHJ P,DEFXTR ; No, default it to the executor
MOVE T2,[POINT 8,N.SRC] ; Get pointer to source area
PUSHJ P,CPYNOD ; Copy the default for source node
MOVE T1,[POINT 8,N.DEST] ; Get BP to dest
SKIPN N.DEST ; Did we get a destination node?
PUSHJ P,DEFXTR ; No, default to the executor
MOVE T2,[POINT 8,N.DEST] ; Get pointer to destination area
PUSHJ P,CPYNOD ; Copy default for destination node
MOVE T1,[POINT 8,N.SRC] ; Get BP to source node name
MOVE T2,[POINT 8,N.DEST] ; Get BP to dest node name
PUSHJ P,CMPNOD ; Are they the same??
TRNA ; No, alls well
ERROR (SDS,Source and destination nodes are the same)
MOVE T1,[POINT 8,N.SRC] ; Get BP to source node name
MOVE T2,[POINT 8,N.DEST] ; Get BP to dest node name
POPJ P, ; And return happily
REDJEL: JUMPLE C,.POPJ ; Did line end properly??
WARN (JEL,Junk at end of line - ignored)
PUSHJ P,.TICHR## ; Read a char
JUMPG C,.-1 ; Loop till we hit eol
POPJ P,
SUBTTL REDNOD Read node names for the command scanner
; Read one node name or number, checking for validity, skipping spaces, etc.
; Return name in N.SPEC as a standard DECnet node name string.
;
; Call: PUSHJ P,REDNOD ; Go read a name or number
; Only return; node name in N.SPEC, terminating character in C.
;
REDNOD: PUSHJ P,.SAVE2## ; Save some Ps
SETZM N.SPEC ; Clear number and name length fields
PUSHJ P,.TIAUC## ; Get a character
CAIE C," " ; Is it a space?
PUSHJ P,.REEAT## ; No, put it back
; Loop around gathering up node name.
MOVE P1,[POINT 8,N.SPEC,7+8+8] ; Get BP to 1st byte of name
MOVEI P2,6 ; Set up maximum name length
JRST REDNO8 ; Enter loop at correct point
REDNO4: IDPB C,P1 ; Save the char
REDNO8: PUSHJ P,.TIAUC## ; Get a char
PUSHJ P,.TICAN## ; Is it alphanumeric??
JRST REDNO6 ; No, we are done
CAIGE C,"A" ; Are we alphabetic??
CAIE P2,6 ; No, digit - is it first??
TRNA ; No to either, go do normal stuff
JRST REDNO7 ; Yes, go do special stuff
SOJGE P2,REDNO4 ; Loop back for entire node name
CAMN P2,[-1] ; First time through??
WARN (NLS,Node name longer than six characters)
JRST REDNO8 ; Go eat extraneous characters
; Here if 1st char of node name is a digit. User wants to use #
REDNO7: PUSHJ P,.DECNC## ; Read in decimal node number
JUMPE N,REDNOB ; Zero node numbers are naughty
DPB N,[POINT 8,N.SPEC,7] ; Install the low order byte
LSH N,-8 ; Get the high order byte
DPB N,[POINT 8,N.SPEC,7+8] ; Install the high order byte
JRST REDNOA ; Go map name and give skip return
; Here to install length of node name
REDNO6: SKIPGE P2 ; Did user type too much?
SETZ P2, ; Yes, name gets truncated
MOVEI T1,6 ; Get max node name length
SUB T1,P2 ; Compute length of name
JUMPE T1,REDRET ; Return now if nothing was parsed
DPB T1,[POINT 8,N.SPEC,7+8+8] ; Install length
; Here to map the name to a number, and determine reachability
REDNOA: MOVE T1,[POINT 8,N.SPEC] ; Get pointer to node spec
PUSHJ P,MAPIT ; Map number into name (or vice versa)
JRST REDNOE ; Unknown component
PUSHJ P,ISRECH ; Is it reachable?
ERROR (URN,Unreachable node)
;Here just before returning to caller. Eat trailing spaces.
REDRET: CAIN C," " ; Was terminating character a space???
PJRST .TIAUC## ; Yes, we hate spaces
POPJ P, ; And return
; Here when name to number mapping operation fails
REDNOE: CAIN P2,6 ; Did user give a node number??
REDNOB: ERROR (INN,Illegal node number) ; Yes, give correct message
ERROR (UKN,Unknown node name)
SUBTTL GETXTR Return exector node name
; Call: PUSHJ P,GETXTR ; No args
; <Return +1 always, T1/ BP to executor node ID>
;
DEFXTR: AOSE DEFFLG ; Have we been here before??
ERROR (NNS,No node names specified) ; Yes, no good
GETXTR: MOVE T1,[POINT 8,X.NODE] ; Get pointer
SKIPE X.NODE ; Have we been here before??
POPJ P, ; Yes, we're all set
MOVEI T2,9 ; Get length of node name buffer
MOVEM T2,NTREX+.NTBYT ; Stuff it
MOVEI T2,NTREX ; Get arg for NTMAN.
$TOPS10 <
NTMAN. T2, ; Read the executor ID
HALT . ; Silly program error
>
$TOPS20 <
EXCH T1,T2 ; T1 is jsys ac
NTMAN% ; Execute jsys
ERJMP NTMERR ; Go handle NTMAN error
EXCH T1,T2 ; Retrieve T1
>
PUSHJ P,MAPIT ; Go do mapping if necessary
WARN (EDN,Executor node does not have a name)
POPJ P, ; Return
SUBTTL ISRECH Tests for node reachability
; This routine will skip if the node spec pointed to by T1 is reachable.
;
; Call: MOVx T1,BP to node spec
; PUSHJ P,ISRECH
; <Return +1 if not reachable>
; <Return +2 if reachable> ; In either case T1 is not disturbed
ISRECH: PUSH P,T1 ; Save T1 for later
MOVEM T1,NTRCH+.NTEID ; Install pointer to entity ID
MOVEI T2,RCHBLN ; Get buffer length
MOVEM T2,NTRCH+.NTBYT ; Install it
MOVEI T2,NTRCH ; Get arg for NTMAN.
$TOPS10 <
NTMAN. T2, ; Read the info
TRNA ; Error, go analyze
JRST ISREC1 ; No error, steam on
CAME T2,[NERES%] ; Did we run out of space??
HALT .
>
$TOPS20 <
MOVE T1,T2 ; Jsys AC
NTMAN% ; Execute jsys
ERJMP .+2 ; On error, go on after next
JRST ISREC1 ; Success, proceed
MOVE T1,NTRCH+.NTERR ; Get error code
CAME T1,[NERES%] ; Resource failure?
JRST NTMERR ; Go handle other NTMAN error
>
SKIPA T1,[RCHBLN] ; Correct length
ISREC1: MOVE T1,NTRCH+.NTBYT ; Get length of string
MOVE T2,[POINT 8,RCHBUF] ; Get buffer length
MOVEI T3,0 ; Get parameter number
PUSHJ P,FNDPRM ; Go hunting
$TOPS10 <
JRST TPOPJ ; Can't find param, assume unreachable
>
$TOPS20 <
JRST TPOPJ1 ; Can't find param, assume reachable
>
CAIE T1,0 ; Is it ON (executor only)
CAIN T1,4 ; Or REACHABLE??
TRNA ; Yes to either
JRST TPOPJ ; No, punt
TPOPJ1: POP P,T1 ; Restore T1
AOS (P) ; Prepare for
POPJ P, ; a skip return
TPOPJ: POP P,T1 ; Restore T1
POPJ P, ; And return
SUBTTL GETCKT Get the circuit between current node and ENDNOD
; This routine will return the circuit between CURNOD and ENDNOD. The
; circuit id will be a CASCII string pointed to by T1.
;
; Call: PUSHJ P,GETCKT
; <Return +1 Always> T1/ ASCIZ byte pointer to circuit id
GETCKT: SKIPG VERFLG ; Connected to v3 NML or earlier ??
ANDI T1,1777 ; Yes, clear area number junk
MOVE T2,[POINT 8,CKTNIC,7+8+8] ; Get pointer to NICE message
IDPB T1,T2 ; Install low order byte
LSH T1,-^D8 ; Get high order part of node number
IDPB T1,T2 ; Stuff it
MOVEI T1,CKTNLN ; Get length of NICE message
MOVE T2,[POINT 8,CKTNIC] ; Get pointer to NICE message
PUSHJ P,SNDMSG ; Go send the message
SETOM RSPNFG ; Set Response About Node flag
PUSHJ P,REDRSP ; Read the response
DMOVEM T1,PTRHLD ; Put pointers in a safe place
MOVEI T3,0 ; Get reachability
PUSHJ P,FNDPRM ; Go hunting
JRST GETCK1 ; If we can't find plod on
CAIE T1,0 ; Is it ON (executor only)
CAIN T1,4 ; Or REACHABLE??
TRNA ; Yes to either
ERROR (URN, Unreachable node)
GETCK1: DMOVE T1,PTRHLD ; Sart back at begining
MOVEI T3,^D820 ; COST parameter
PUSHJ P,FNDPRM ; Try to find it.
SETO T1, ; Not there, use 0.
MOVEM T1,COST ; Save it
DMOVE T1,PTRHLD ; Start of message again.
MOVEI T3,^D821 ; HOPS
PUSHJ P,FNDPRM ; Find it too.
SETO T1,
MOVEM T1,HOPS ; Save it too.
DMOVE T1,PTRHLD ; Restore pointer to message again.
MOVEI T3,^D822 ; Output Circuit parameter number
PUSHJ P,FNDPRM ; Go look for circuit id
ERROR (CFO,Can't find Output Circuit parameter)
POPJ P, ; Return with T1 pointing to circuit id
SUBTTL GETNOD Get the node at the other end of the circuit in T1
; This routine will get the node that is on the other side of the circuit in
; CIRBUF on the node CURNOD. The node will be returned in SIXBIT in T1.
;
; Call: MOVE T1,[BP to CASCII ckt id]
; PUSHJ P,GETNOD
; <Return +1 Always> T1/ SIXBIT node id
GETNOD: PUSHJ P,.SAVE1## ; Save a P
MOVE P1,T1 ; Save pointer to circuit
DMOVE T1,PTRHLD ; Restore pointers from last response
MOVEI T3,^D830 ; Adjacency parameter
PUSHJ P,FNDPRM ; Go look for adjacent node
JRST NODNM3 ; No such parameter, do usual thing
MOVE T1,T2 ; Get second part of parameter
MOVE T2,[POINT 8,N.SPEC] ; Get pointer to handy area
SETZ T3, ; Clear an AC
IDPB T3,T2 ; Zero first byte of node number
IDPB T3,T2 ; Zero second byte of node number
PUSHJ P,CPYCAS ; Copy parameter to a safe place
MOVE T1,[POINT 8,N.SPEC] ; Get BP for the mapping function
NODNM4: PUSHJ P,MAPIT ; Map the node name
ERROR (UDS,Unknown destination node name)
MOVE T1,[POINT 8,N.SPEC] ; Return pointer to node spec
POPJ P, ; ...
; Here when we have to do a TELL curnod SHOW CIRCUIT ckt STATUS
NODNM3: MOVEI T2,.NTCKT ; Get default entity type
SKIPGE VERFLG ; Are we talking to version 2 NML??
MOVEI T2,.NTLIN ; Yes, use lines instead
DPB T2,[POINT 3,NODNIC,7+8] ; Install entity type in NICE message
MOVE T2,[POINT 8,NODNIC,7+8] ; Get pointer to NICE message
MOVE T1,P1 ; Get back pointer to ckt id
PUSHJ P,CPYCAS ; Copy the circuit id into the msg
ILDB T1,P1 ; Get length of circuit id
ADDI T1,3 ; Correct for all overhead
MOVE T2,[POINT 8,NODNIC] ; Get fresh pointer to NICE
PUSHJ P,SNDMSG ; Send message
SETZM RSPNFG ; Clear response node flag
PUSHJ P,REDRSP ; Read the response message
MOVEI T3,^D800 ; Get parameter number for ADJACENT
; NODE parameter
PUSHJ P,FNDPRM ; Get node number into T1
ERROR (CFA,Can't find Adjacent Node parameter)
MOVE T2,[POINT 8,N.SPEC] ; Get pointer to handy holding place
IDPB T1,T2 ; Save low part of node number
LSH T1,-8 ; Get high order part into place
IDPB T1,T2 ; Install that too
SETZ T1, ; Clear an ac
IDPB T1,T2 ; Zero length name so far
MOVE T1,[POINT 8,N.SPEC] ; Get pointer back again
JRST NODNM4 ; Map it and do final fixups
SUBTTL FNDPRM Get the value of a parameter
; This routine will search through a string of NICE parameter ids and values,
; and return the value of a certain parameter. This routine is called with
; T1 containing the number of NICE bytes, T2 contains a byte pointer to a
; block of NICE bytes, and T3 contains the parameter number.
;
; On return T1 (and possibly T2) will contain the value of the parameter. If
; the parameter is a binary number, the AC will contain the number (as a real
; PDP-10 integer). If the parameter value is a byte string, AC will contain
; an ILDB pointer to a CASCII string. For coded multiples, only the first
; two values will be returned, T1 and T2 will contain them.
FNDPRM: PUSHJ P,.SAVE1## ; Get a more permanent AC
MOVE P1,T3 ; And save parameter number
PUSHJ P,NICSET ; Set up for NICBYT
; Here for each new parameter we find
NEWPRM: PUSHJ P,NICBYT ; Get low byte of parameter number
POPJ P, ; Can't find parameter, let caller know
MOVE T2,T1 ; Save low byte in T2
PUSHJ P,NICBYT ; Get high byte of paramter number
ERROR (NBY,High byte of parameter number missing in NEWPRM)
LSH T1,8 ; Put high part in place
IORI T1,(T2) ; Install low part
CAME T1,P1 ; Did we get the right parameter??
JRST NXTPRM ; No, skip to next parameter
PUSHJ P,REDPRM ; Go get the parameter value in T1&T2
JRST .POPJ1 ; And give skip return
; Here when we have to skip over the data portion of this parameter value
NXTPRM: PUSHJ P,SKPPRM ; Skip over the data portion of parm
JRST NEWPRM ; And try again
SUBTTL NICBYT, NICPTR, NICSET NICE byte string manipulation routines
; Call this to set up for calls to NICBYT
NICSET: DMOVEM T1,NICCNT ; Put BP and count in safe place
POPJ P,
; Call this for each byte to be read from NICE message
NICBYT: SOSGE NICCNT ; Any bytes left??
POPJ P, ; No, give skip return
ILDB T1,NICBPT ; Yes, get one
.POPJ1: AOS (P) ; And give
.POPJ: POPJ P, ; skip return
; Get current ILDB pointer to NICE string
NICPTR: MOVE T1,NICBPT ; Get current NICE pointer
POPJ P,
SUBTTL NICE parameter control routines
; SKPPRM - Skip over the data portion of a parameter
SKPPRM: PUSHJ P,NICBYT ; Get DATA TYPE field
ERROR (NDT,No data type field in SKPPRM)
TRNN T1,200 ; Coded field??
JRST UNCOD ; No, do image data stuff
TRNE T1,100 ; Single field?
JRST CMULT ; No, go do Coded Multiple stuff
; Here for Coded Single fields
ANDI T1,77 ; Make just byte count
BYTSKP: MOVE T2,T1 ; Get count into a safe place
SCLOP: JUMPLE T2,.POPJ ; Jump if no more bytes left
PUSHJ P,NICBYT ; Get a byte
ERROR (NCS,No byte when reading coded single field in SCLOP)
SOJA T2,SCLOP ; Jump if not done
; Here for skipping over Coded Multiples
CMULT: ANDI T1,77 ; Make field count
CMLOP: PUSH P,T1 ; Save it better
PUSHJ P,SKPPRM ; Call ourselves recursivly
POP P,T1 ; Restore count
SOJG T1,CMLOP ; Skip multiple fields
POPJ P, ; And return triumphant!
; Here for uncoded (image) fields
UNCOD: TRNN T1,100 ; ASCII image field?
JRST NOASC ; No, go do numbers
AIMAGE: PUSHJ P,NICBYT ; Get byte count
POPJ P, ; Ok if short terminated
JRST BYTSKP ; and go to the string skipper
; Here for binary numbers. If length is 0, then treat like ASCII image
; otherwise just jump off to BYTSKP.
NOASC: ANDI T1,17 ; Mask to data length
JUMPE T1,AIMAGE ; Zero implies image field
JRST BYTSKP ; Go to string skipper
SUBTTL REDPRM Read a parameter from a NICE message
; The parameter value will either returned in T1 or T1 will contain a byte
; pointer to a CASCII string. For coded multiple, T1 will be as above for the
; first parameter and T2 will be similar, except it will be for the second
; parameter.
REDPRM: PUSHJ P,NICBYT ; Get DATA TYPE byte
ERROR (NDT,No Data type byte in REDPRM)
MOVE T2,T1 ; Put it into a safe place
LSH T1,-6 ; Reduce it to top two bits
JRST @FMTTAB(T1) ; And call the right routine
FMTTAB: EXP GETBIN ; 000 Binary number
EXP GETASC ; 100 ASCII image
EXP GETCSN ; 200 Coded single
EXP GETCML ; 300 Coded multiple
; This routine will build a number from a string of eight bit bytes. The
; bytes are stored backwards (least significant byte first), and must be
; reversed before assembly.
GETBIN: ANDI T2,17 ; Reduce to data length
JUMPN T2,GETBI1 ; Jump if not image field
PUSHJ P,NICBYT ; Get length of field
ERROR (LFM,Length field missing in GETBIN)
MOVE T2,T1 ; Put length in a safe place
GETBI1: PUSHJ P,NICBYT ; Get a byte from the number
ERROR (VBM,Value byte missing in GETBI1)
PUSH P,T1 ; Save one byte of number
SETZ T1, ; Clear receiving buffer
SOSLE T2 ; Skip if no more bytes
PUSHJ P,GETBI1 ; Get rest of number
LSH T1,8 ; Make room for more
IOR T1,0(P) ; Bring in that byte
ADJSP P,-1 ; Fix the stack
POPJ P, ; And return
; This routine will get an IDLB pointer to a CASCII string
GETASC==NICPTR ; Get byte pointer from byte getter
; Here to get the value of a Coded Single into T1
GETCSN: ANDI T2,77 ; Reduce to data size
JRST GETBI1 ; And jump into the fray
; Here to get Coded Multiples
GETCML: ANDI T2,77 ; Reduce to size
CAILE T2,2 ; .LE. two items??
MOVEI T2,2 ; No, force it down to two
MOVE T3,T2 ; Get count into a safe place
PUSHJ P,REDPRM ; Read the first parameter
CAIE T3,2 ; Another parameter?
POPJ P, ; No, just return
PUSH P,T1 ; Save it for later
PUSHJ P,REDPRM ; Read the second parameter
MOVE T2,T1 ; Put second param into T2
POP P,T1 ; Put first parameter into T1
POPJ P, ; And return
SUBTTL REDRSP Read a response message from the network
; This routine will read a response from the network, and skip over the
; response data (everything except the meat of the message). It will also
; call NICSET to set up for reading the data.
NICPUT: SOSGE RSPCNT ; Any room left?
POPJ P, ; No, no skip return
IDPB T1,RSPPTR ; Yes, install the byte
JRST .POPJ1 ; And skip return
REDRSP: MOVEI T1,RSPLEN ; Set up length of buffer
MOVEM T1,RSPCNT ; Save it
MOVE T1,[POINT 8,RSPBUF] ; Get pointer to buffer
MOVEM T1,RSPPTR ; Save that too
PUSHJ P,REDMSG ; Read first message
PUSHJ P,NICSET ; Set up pointers
PUSHJ P,NICBYT ; Get first byte of message
ERROR (FBM,First byte missing in REDRSP)
$TOPS20 <
LOADE T1,SGNBYT ; Get signed byte
>
CAIE T1,1 ; Single complete response???
JRST REDR.1 ; No, try for multiple
PUSHJ P,EATHDR ; Eat the common header info
PUSHJ P,EATEID ; Eat up entity id
PUSHJ P,MOVRSP ; Move remaining part of response
REDR.2: MOVEI T1,RSPLEN ; Get response buffer length
SUB T1,RSPCNT ; Compute number of bytes in buffer
MOVE T2,[POINT 8,RSPBUF] ; Get pointer to response stuff
POPJ P, ; And return
REDR.1: CAIE T1,2 ; Start of multiple response??
ERROR (CHM,Cannot handle multiple segment response)
SKIPN NICCNT ; Any header stuff left???
JRST RSPLOP ; No, go read next message
PUSHJ P,EATHDR ; Yes, eat common part of header
SKIPE NICCNT ; Message should be finished
ERROR (MSF,NICE message should be finished)
RSPLOP: PUSHJ P,REDMSG ; Read message from the network
PUSHJ P,NICSET ; Set up for calls to NICBYT
PUSHJ P,NICBYT ; Get Return Code
ERROR (NRC,No return code in RSPLOP)
CAIN T1,1 ; Success return??
JRST PRSSUC ; Yes, parse as such
CAIN T1,2 ; Seperated responses???
ERROR (SRP,Separated response illegal)
CAIN T1,3 ; Or, is it this one?
ERROR (USC,Unknown response segment code)
CAIE T1,200 ; End of multiple responses?
ERROR (EOM,End of multiple response illegal)
SKIPE NICCNT ; Did message end properly??
PUSHJ P,EATHDR ; No, go eat the header
JRST REDR.2 ; Yes, finish up the buffer and return
PRSSUC: PUSHJ P,EATHDR ; Eat common part of header
PUSHJ P,EATEID ; Eat entity id
PUSHJ P,MOVRSP ; Move response into response buffer
JRST RSPLOP ; And go back for more
MOVRSP: PUSHJ P,NICBYT ; Get a byte from the network buffer
POPJ P, ; No more, quit now
PUSHJ P,NICPUT ; Install it in the response buffer
ERROR (CWR,Couldnt write to response buffer)
JRST MOVRSP ; And start over
EATHDR: PUSHJ P,NICBYT ; Read first half of error detail
ERROR (MED,Missing error detail)
PUSHJ P,NICBYT ; Read second half of error detail
ERROR (M2D,Missing second part of error detail)
PUSHJ P,NICBYT ; Get number of bytes in error message
ERROR (MLF,Missing length field)
SKIPE T1 ; Message length should be zero
ERROR (MLZ,Message length non-zero)
POPJ P, ; And return now
EATEID: SKIPN RSPNFG ; Is this for a node id??
JRST AIMAGE ; No, skip this
PUSHJ P,NICBYT ; Yes, skip low order byte of number
JRST BADEID
PUSHJ P,NICBYT ; Skip high order byte of number
JRST BADEID
PUSHJ P,NICBYT ; Get start of node id
JRST BADEID
TRZ T1,200 ; Clear the "executor" bit
PJRST BYTSKP ; And go skip some bytes
BADEID: ERROR (BEI,Bad Node entity returned)
SUBTTL MAPIT Map from node number to node name
; Call: MOVx T1,BP to node spec
; PUSHJ P,MAPIT
; <+1 return if node is unknown>
; <+2 return if success>
; In either case T1/ original BP
MAPIT: MOVEM T1,NTMAP+.NTBPT ; Set up pointer to info to be mapped
MOVEI T2,9 ; Get length of MAPBUF
MOVEM T2,NTMAP+.NTBYT ; Stuff it
MOVEI T2,NTMAP ; Get arg for NTMAN.
$TOPS10 <
NTMAN. T2, ; Read mapping from monitor
TRNA ; Oops, something went wrong...
JRST .POPJ1 ; Give skip return
CAME T2,[NEURC%] ; Unrecognised component?
HALT . ; No, croak fatally
>
$TOPS20 <
SAVEAC T1 ; Save jsys AC
MOVE T1,T2 ; Get jsys AC
NTMAN% ; Do jsys
ERJMP .+2 ; -error, skip next
JRST .POPJ1 ; Success, skip return
MOVE T2,NTMAP+.NTERR ; Get error code
CAME T2,[NEURC%] ; Unrecognized component?
JRST NTMERR ; Go handle other NTMAN error
>
POPJ P, ; Yes, let user handle this one
SUBTTL OPNLNK & CLSLNK Open and close NICE links to a foreign NML
; This routine will open a NICE link to the node in CURNOD
$TOPS10 <
OPNLNK: SETZM LASERR ;NO ERROR CODE YET
ILDB T2,T1 ; Skip first byte
ILDB T2,T1 ; Skip second byte of node number
ILDB T2,T1 ; Get length of node name
SKIPN T2 ; Is it legal?
ERROR (ZNN,Zero length node name)
HRLM T2,CNODE ; Save length of name in string block
MOVE T3,[POINT 8,CNODE+1] ; Get pointer to destination
OPNLN1: ILDB T4,T1 ; Get byte from node name
IDPB T4,T3 ; Stuff it into the NSP. block
SOJG T2,OPNLN1 ; Loop till done
IFN FTTIME,<
PUSHJ P,TIMRST ; Reset timing data base
PUSHJ P,TIMBEG ; Start CI timer
> ;END FTTIME
MOVEI T1,ENTACT ; Get addr for NSP.
NSP. T1, ; Open up link to foreign node
JRST OPNLNE ; Print nice error mess
IFN FTTIME,<
PUSHJ P,TIMEND ; Stop timer
MOVEM T1,CITIME ; Save amount of time for this CI
> ;END FTTIME
HRRZ T1,ENTACT+.NSACH ; Get channel number
MOVEM T1,NETCHN ; Save it for SNDMSG and REDMSG
MOVEM T1,RCCBLK+.NSACH ; Install channel number in CC block
MOVEI T1,RCCBLK ; Get arg for NSP.
NSP. T1, ; Read Connect Confirm Data
JRST OPNLNE ; Report NSP. error
LDB T1,[POINT 8,CCDATA+1,7] ; Get version number of foreign NML
SUBI T1,3 ;Make NML v3 = 0
MOVEM T1,VERFLG ; Remember which version of NML
JRST .POPJ1
OPNLNE: MOVEM T1,LASERR
POPJ P,
CLSLNK: MOVE T1,NETCHN ; Get network channel number
MOVEM T1,DSCBLK+.NSACH ; Install it in NSP. block
MOVEI T1,DSCBLK ; Get pointer to NSP. arg block
NSP. T1, ; Do Synchronus Disconnect
JRST NSPERR ; Report NSP. error
MOVE T1,NETCHN ; Get network channel number
MOVEM T1,RELBLK+.NSACH ; Install it in NSP. block
MOVEI T1,RELBLK ; Get arg for releasing channel
NSP. T1, ; Drop the channel
JRST NSPERR ; Report NSP. error
POPJ P,
>
$TOPS20 <
;TOPS-20 versions of OPNLNK and CLSLNK
;OPNLNK - enter with byte pointer to node address and name in T1
;
;T1 points to 2 bytes of node address, 1 byte of node name and length followed
; by indicated number of bytes making up node name
OPNLNK: CALL .SAVE1## ;Save P1
MOVE P1,T1 ;Move byte pointer to preserved AC
;Build DECnet file spec in DCNNAM. Goal is: DCN:nodename-NCU;BDATA:004000000
; where 004,000,000 represents the version information.
HRROI T1,DCNNAM ;Pointer to destination
HRROI T2,[ASCIZ /DCN:/] ;String to copy
SETZ T3, ;Copy until 0 byte
SOUT%
EJSHLT
;Updated pointer in T1, let it stay there
ILDB T2,P1 ;Get first byte of node address
ILDB T2,P1 ;Get 2nd -"-
ILDB T3,P1 ;Get count of bytes in node name
SKIPN T3 ;Make sure there are some...
ERROR (ZLN,Zero length node name)
MOVE T2,P1 ;Move pointer in place for SOUT
MOVNS T3 ;Negate count for SOUT
SOUT%
EJSHLT
;DCNNAM is now: DCN:nodename
HRROI T2,[ASCIZ /-NCU;BDATA:004000000/] ;The rest of the node name
SETZ T3, ;Copy until 0 byte
SOUT%
EJSHLT
;DCNNAM is now built, get a JFN for the link and open it.
MOVX T1,GJ%SHT ;Short form GTJFN
HRROI T2,DCNNAM ;Pointer to DCNNAM
GTJFN%
EJSHLT
MOVEM T1,DCNJFN ;Save JFN
IFN FTTIME,<
CALL TIMRST ;Reset timers
CALL TIMBEG ;Start connect timer
> ;END FTTIME
MOVE T1,DCNJFN ;Retrieve JFN
MOVE T2,[FLD(^D8,OF%BSZ)!FLD(.GSNRM,OF%MOD)!OF%RD!OF%WR]
OPENF% ;Open with 8 bit bytes, ASCII mode
EJSHLT
;Now wait for connect: loop checking the status of the link.
; (In future if there is a need for it, this could be rewritten to use PSI)
MOVX T1,^D500 ;Wait 1/2 a sec
DISMS%
DO. ;LOOP
CALL STSLNK ; Get status for link
TXNE T1,MO%CON ; Connected?
EXIT. ; Yes, proceed
TXNN T1,MO%WCC ; Waiting for connect?
IFSKP. ; Yes
MOVX T1,^D2000 ; Wait a second
DISMS%
LOOP. ; Loop back
ELSE. ; Not waiting for connect
HRRZ P1,T1 ; Remember error code for a while
MOVE T1,['NETPTH'] ; Give error message
MOVE T2,["?",,[ASCIZ /Connection rejected, reason:/]]
CALL .ERMSG## ; Type it out
CALL .TCRLF##
MOVEI T1,[ASCIZ /Unknown disconnect code/]
CAIG P1,DSCHGH ; Known code?
MOVE T1,DSCCOD(P1) ; -yes, get its address
CALL .TSTRG## ; Output
CALL .TCRLF##
HALTF%
ENDIF.
ENDDO. ;End of DO.
;Come here when link is connected. Stop timer, read optional data to find
; out remote NML version
IFN FTTIME,<
CALL TIMEND ;Stop timer
MOVEM T1,CITIME ;Save CI timer
> ;END FTTIME
MOVE T1,DCNJFN ;Get JFN
MOVX T2,.MORDA ;Read optional data
MOVE T3,[POINT 8,CCDATA] ;Pointer to optional data
MTOPR% ;Get data
EJSHLT
LDB T1,[POINT 8,CCDATA,7] ;Get version number
CAIGE T1,2 ; Sanity check the remote version #
ERROR (UVN,Remote NML reports unknown version number)
SUBI T1,3 ; Make NML V3 = 0
MOVEM T1,VERFLG ; Save remote version #
JRST .POPJ1
;STSLNK - read status of a link
;
;Returns status in T1
STSLNK: MOVE T1,DCNJFN ;Get JFN
MOVX T2,.MORLS ;Read Link Status
MTOPR%
EJSHLT
MOVE T1,T3 ;Move result to T1
RET
;CLSLNK - close network link
CLSLNK: MOVE T1,DCNJFN ;Get JFN
CLOSF% ;Close link
ERJMP [ MOVE T1,DCNJFN ;On error, try with ABORT CLOSE
TXO T1,CZ%ABT
CLOSF%
ERJMP .+1 ;Just return on error
JRST .+1] ; and on success..
RET
;Macro to generate disconnect codes
DEFINE DSCERR(COD,TXT) <
[ASCIZ /'TXT/]
>
;DECnet disconnect codes
DSCCOD:
DSCERR (^D0,<Reject or disconnect by object>)
DSCERR (^D1,<Resource allocation failure>)
DSCERR (^D2,<Destination node does not exist>)
DSCERR (^D3,<Remote node shutting down>)
DSCERR (^D4,<Destination process does not exist>)
DSCERR (^D5,<Invalid process name field>)
DSCERR (^D6,<Object is busy>)
DSCERR (^D7,<Unspecified error>)
DSCERR (^D8,<Abort by management>)
DSCERR (^D9,<Abort by object>)
DSCERR (^D10,<Invalid node name>)
DSCERR (^D11,<Local node shut>)
REPEAT <^D20-^D11>,<
DSCERR (777,<Unknown disconnect code received>)
>
DSCERR (^D21,<CI with illegal destination address>)
DSCERR (^D22,<CC with illegal destination address>)
DSCERR (^D23,<CI or CC with zero source address>)
DSCERR (^D24,<Flow control violation>)
REPEAT <^D31-^D24>,<
DSCERR (777,<Unknown disconnect code received>)
>
DSCERR (^D32,<Too many connections to node>)
DSCERR (^D33,<Too many connections to destination process>)
DSCERR (^D34,<Access not permitted>)
DSCERR (^D35,<Logical link services mismatch>)
DSCERR (^D36,<Invalid account>)
DSCERR (^D37,<Segsize too small>)
DSCERR (^D38,<No response from destination process>)
DSCERR (^D39,<Node unreachable>)
DSCERR (^D40,<Link aborted due to data loss>)
DSCERR (^D41,<Destination process does not exist>)
DSCERR (^D42,<Confirmation of di>)
DSCERR (^D43,<Image data field too long>)
DSCHGH==:^D43
;NTMERR - handle NTMAN errors
;
; Entry: T1/ argument block pointer
NTMERR: MOVE P1,T1 ;Save argument pointer
MOVE T1,[SIXBIT /NETPTH/]
MOVE T2,["?",,[ASCIZ /NTMAN failed, reason:/]]
CALL .ERMSG##
CALL .TCRLF##
MOVE P1,.NTERR(P1) ;Get reason code
SETZ P2, ; Clear loop index
DO. ; LOOP
HLRE T1,NTMCOD(P2) ; Get next pointer from table
CAMN T1,P1 ; Found reason code?
EXIT. ; -yes, exit loop
AOJ P2, ; Move to next entry
CAIG P2,NEHGH% ; Done all?
LOOP. ; -no, go on
SETZ P2, ; Set to zero
ENDDO.
HRRZ T1,NTMCOD(P2) ; and get error text pointer
CALL .TSTRG##
CALL .TCRLF##
HALTF%
JRST NETPTH
;Define macro to generate error table
DEFINE NTMFAI (COD,TXT) <
COD,,[ASCIZ /'TXT/]
>
NTMCOD:
NTMFAI (0,<Unknown reason code returned>)
NTMFAI (NEUFO%,<Unrecognized function or option>)
NTMFAI (NEIMF%,<Invalid message format>)
NTMFAI (NEPRV%,<Privilege violation.>)
NTMFAI (NEMPE%,<Management program error>)
NTMFAI (NEUPT%,<Unrecognized parameter type>)
NTMFAI (NEURC%,<Unrecognized component>)
NTMFAI (NEINI%,<Invalid identification>)
NTMFAI (NELCE%,<Line communication error>)
NTMFAI (NECWS%,<Component in wrong state>)
NTMFAI (NERES%,<Resource error>)
NTMFAI (NEIPV%,<Invalid parameter value>)
NTMFAI (NENRM%,<No room (or slot already taken)>)
NTMFAI (NEPNA%,<Parameter not applicable>)
NTMFAI (NEPVL%,<Parameter value too long>)
NTMFAI (NEOPF%,<Operation failure>)
NTMFAI (NEFNS%,<Function not supported>)
NTMFAI (NEIPG%,<Invalid parameter grouping>)
NTMFAI (NEPAM%,<Parameter missing>)
NEHGH%==:NEPAM%
>
SUBTTL SNDMSG and REDMSG Network I/O routines
; Call: MOVEI T1,length-of-message
; MOVE T2,[BP to message]
; PUSHJ P,SNDMSG
; <Return +1 Always>
$TOPS10 <
SNDMSG: DMOVEM T1,SNDBLK+.NSAA1 ; Install byte count and byte pointer
MOVE T1,NETCHN ; Get network channel number
MOVEM T1,SNDBLK+.NSACH ; Install it
IFN FTTIME,<
PUSHJ P,TIMBEG ; Start timing response
> ;END FTTIME
MOVEI T1,SNDBLK ; Get address of arg block
NSP. T1, ; Send the data
JRST NSPERR ; Report NSP. error
POPJ P, ; Return happily
; REDMSG will read data from the network. It will return T1 with a byte count,
; and T2 with a byte pointer. T1 and T2 will be supplied by me, and ignored
; if they are set up.
REDMSG: MOVE T1,NETCHN ; Get channel number for network
MOVEM T1,RCVBLK+.NSACH ; Install it
DMOVE T1,[MSGLEN ; Length of my buffer
POINT 8,MSGBUF] ; Pointer to my buffer
DMOVEM T1,RCVBLK+.NSAA1 ; Install in NSP. arg block
MOVEI T1,RCVBLK ; Get arg for NSP.
NSP. T1, ; Read data from network
JRST NSPERR ; Report NSP. error
IFN FTTIME,<
PUSHJ P,TIMEND ; Stop timing response
> ;END FTTIME
MOVEI T1,MSGLEN ; Get size of message buffer
SUB T1,RCVBLK+.NSAA1 ; Compute number of bytes received
MOVE T2,[POINT 8,MSGBUF] ; Get pointer to message buffer
POPJ P,
>
$TOPS20 <
;TOPS-20 versions of SNDMSG and REDMSG
;SNDMSG - send a message to remote NICE listener
;
;Call with T1/length of message
; T2/byte pointer to message
; CALL SNDMSG
;Returns +1 always
;
SNDMSG:
IFN FTTIME,<
PUSH P,T1 ;Save T1 and T2
PUSH P,T2
CALL TIMBEG ;Start timer
POP P,T2 ;Retrieve AC
POP P,T1
> ;END FTTIME
MOVN T3,T1 ;Move negated count to T3 for SOUT
MOVE T1,DCNJFN ;Get JFN
SOUTR%
EJSHLT
RET
;REDMSG - read a message off remote NICE listener
;
;Returns with T1/byte count
; T2/byte pointer
;
REDMSG: MOVE T1,DCNJFN ;Get JFN
MOVE T2,[POINT 8,MSGBUF] ;Read to MSGBUF
MOVNI T3,MSGLEN ;Negated max count for SINR
SINR%
EJSHLT
IFN FTTIME,<
PUSH P,T3 ;Save T3 in case TIMEND wipes it out
CALL TIMEND ;Stop timer
POP P,T3 ;Retrieve count
> ;END FTTIME
MOVX T1,MSGLEN ;Get max count
ADD T1,T3 ;Get actual count
MOVE T2,[POINT 8,MSGBUF] ;Make pointer for user
RET
>
SUBTTL Miscellaneous and sundry routines
; .TNNAM Type out the standard style node name pointed to by T1
.tnnam: ibp t1
ibp t1
pjrst .tcasc
; .TNNAD Type out standard node address pointed to by T1
.TNNAD: PUSH P,T1 ; Save byte pointer
ILDB T1,(P) ; Get first byte of address
ILDB T2,(P) ; And second byte
LSH T2,^D8 ; Combine in T1
IOR T1,T2 ; ...
MOVEM T1,(P) ; Save
MOVEI T1,"(" ; Delimit node address
PUSHJ P,.TCHAR## ; ...
LDB T1,[POINT 6,(P),25] ; Get area number
JUMPE T1,TNNAD1 ; Skip if no area number
PUSHJ P,.TDECW## ; Type in decimal
MOVEI T1,"." ; Add delimiter
PUSHJ P,.TCHAR## ; ...
TNNAD1: LDB T1,[POINT 10,(P),35] ; Get node address
PUSHJ P,.TDECW## ; Type in decimal
MOVEI T1,")" ; Add delimiter
PUSHJ P,.TCHAR## ; ...
ADJSP P,-1 ; Clean stack
POPJ P, ; And return
; .TCASC Type out a counted ASCII string pointed to by BP in T1
; Enforced field length is in T2
.TCASC: PUSHJ P,.SAVE3## ; Save several Ps
DMOVE P1,T1 ; Put BP and count in a safe place
ILDB P3,P1 ; Get number of chars into P3
SUB P2,P3 ; Calculate number of pad characters
TCASC1: JUMPE P3,TCASC2 ; Jump if no more bytes
ILDB T1,P1 ; Get another byte
PUSHJ P,.TCHAR## ; Type it out
SOJA P3,TCASC1 ; Bop the count and start over
TCASC2: JUMPLE P2,.POPJ ; Return if no more pads needed
PUSHJ P,.TSPAC## ; Pad with a space
SOJA P2,TCASC2 ; Loop for all needed pads
; CASSIX - Convert counted ASCII to SIXBIT
CASSIX: ILDB T2,T1 ; Get byte count
CAILE T2,6 ; More than six bytes
MOVEI T2,6 ; Yes, make it six
SETZ T3, ; Clear receiving buffer
CASSI1: JUMPLE T2,CASSI3 ; Return when byte count hits zero
LSH T3,6 ; Make room for next byte
ILDB T4,T1 ; Get a byte from the string
SUBI T4," " ; Make it SIXBIT
IOR T3,T4 ; Install new byte
SOJA T2,CASSI1 ; Do it all over again
CASSI3: MOVE T1,T3 ; Get data into right AC
CASSI2: SKIPE T1 ; Prevent infinite loops
TLNE T1,770000 ; Left justified yet??
POPJ P, ; Yes, we're all done
LSH T1,6 ; No, try again
JRST CASSI2 ; . . .
SUBTTL Various string movement and comparison routines
; GETNNM get the node number from the node spec pointed to by T1
GETNNM: ILDB T2,T1 ; Get low order part of number
ILDB T1,T1 ; Get high order part
LSH T1,8 ; Get high part into place
IORI T1,(T2) ; Make it a whole number
POPJ P,
; CPYNOD - Copy a node spec from one place to another. T1 is source, T2 is
; destination.
CPYNOD: ILDB T3,T1 ; Get low order byte of node number
IDPB T3,T2 ; Install it in dest
ILDB T3,T1 ; Get high order byte of node number
IDPB T3,T2 ; Install that too
; CPYCAS - Copy a counted ascii string from one place to another. T1 is
; source, T2 is destination.
CPYCAS: ILDB T4,T1 ; Get byte count
IDPB T4,T2 ; Install it
CPYCA1: JUMPE T4,.POPJ ; Return if done
ILDB T3,T1 ; Get a byte
IDPB T3,T2 ; Stuff it
SOJA T4,CPYCA1 ; Loop till done
CMPNOD: ILDB T3,T1 ; Get low order number from string 1
ILDB T4,T2 ; Get low order number from string 2
CAME T3,T4 ; Are they the same??
POPJ P, ; No, give failure return
CMPSTR: PUSHJ P,.SAVE1## ; Get a safe register
ILDB P1,T1 ; Get length of string 1
ILDB T3,T2 ; Get length of string 2
CAME P1,T3 ; Are they the same length??
POPJ P, ; No, give failure return
CMPST1: JUMPE P1,.POPJ1 ; Jump if strings are identical
ILDB T3,T1 ; Get a byte from string 1
ILDB T4,T2 ; Get a byte from string 2
CAME T3,T4 ; Are they the same???
POPJ P, ; Nope, fail
SOJA P1,CMPST1 ; Yes, try next byte
SUBTTL Time Accounting Routines
IFN FTTIME,<
; These routines provide a facility for computing the average real time that
; it takes for an event to occur. There is a routine for resetting the time
; data base, there is one for starting the timing of an event, there is one
; for finishing the timing of an event, and there is a routine for returning
; the average timing of the event.
; Call TIMRST with no args to reset the time data base
TIMRST: SETZM TIMTOT ; Clear time totals
SETZM TIMCNT ; Clear time count
SETZM TIMSTR ; Non-zero means we are timing now
POPJ P, ; And return
; Call TIMBEG to begin a timing interval
TIMBEG: MSTIME T1, ; Get time into T1
MOVEM T1,TIMSTR ; Set time of starting interval
POPJ P, ; And just return
; Call TIMEND to end a timing interval, return with T1/ time interval
TIMEND: SKIPN TIMSTR ; Were we timing an interval???
POPJ P, ; No, quit
MSTIME T1, ; Get current time
SUB T1,TIMSTR ; Compute length of this interval
ADDM T1,TIMTOT ; Add that to the total
AOS TIMCNT ; Increment teh number of intervals
SETZM TIMSTR ; Indicate we have stopped timing
POPJ P,
; Call TIMAVG to return the average amount of time spent for all intervals
TIMAVG: MOVE T1,TIMTOT ; Get total amount of time
IDIV T1,TIMCNT ; Compute average
POPJ P, ; Return
; TIMPNT will print out the time interval contained in T1 in units of seconds
TIMPNT: PUSHJ P,.SAVE1## ; Save one
ADDI T1,^D5 ; Round up to 100'ths of seconds
IDIVI T1,^D1000 ; Convert milliseconds to seconds
MOVE P1,T2 ; Save remainder
PUSHJ P,.TDECW## ; Type out seconds
MOVEI T1,"." ; Get decimal point
PUSHJ P,.TCHAR## ; Print that too
MOVE T1,P1 ; Get back remainder
IDIVI T1,^D10 ; Convert milliseconds to 100'ths
PJRST .TDECW## ; Type out fraction
> ;END FTTIME
SUBTTL WRNRTN and ERRDIE Error handling routines
WRNRTN: PUSHJ P,.PSH4T## ; Save all the important acs
MOVE T3,@-4(P) ; Get the instruction after PUSHJ to us
LDB T4,[POINT 9,T3,8] ; Get the opcode
CAIE T4,JUMP_-^D27 ; Is it a jump?
XHALT . ; No, die horribly
MOVE T1,0(T3) ; Get first arg for .ERMSG
MOVE T2,1(T3) ; Get second arg for .ERMSG
PUSHJ P,.ERMSG## ; Call the processor
PUSHJ P,.TCRLF## ; Tie it off with a CRLF
PUSHJ P,.POP4T## ; Restore the world
POPJ P,
ERRDIE: PUSHJ P,.ERMSG## ; Issue the error message
PUSHJ P,.TCRLF## ; Followed by a CRLF
PUSHJ P,.CLRBF## ; Clear typeahead
JRST NETPTH ; And start over
SUBTTL NSP. Error handling
$TOPS20 <
NSPERR: TMSG <?DECnet error
>
XHALT .
DOHALT: HALTF%
>
$TOPS10 <
NSPERR: PUSHJ P,.SAVE1## ; Save an AC
MOVE P1,T1 ; Save error from NSP. uuo
MOVE T1,['NETNSP'] ; Get message prefix
MOVE T2,["?",,[ASCIZ |NSP. error |]] ; Get error prefix
PUSHJ P,.ERMSG## ; Print message
CAILE P1,MAXERR ; Do we know this error code?
SETZ P1, ; No, use general unknown
HRR T1,NSPERC(P1) ; Get address of error text
PUSHJ P,.TSTRG## ; Type it out
PUSHJ P,.TCRLF## ; Type a <CRLF>
JRST NETPTH ; And restart gracefully
DEFINE ERRMAC(code,text),<
IF1,<IFN code-<.-NSPERC>,<
PRINTX ?NSP. error code out of order in NSPERC table>>
ERRMC1(\code,text)
>
DEFINE ERRMC1(code,text),<[ASCIZ |(code) text|]>
NSPERC: ERRMAC 0, <Unknown Error, code in AC 1>
ERRMAC NSABE%,<Argument Block Format Error>
ERRMAC NSALF%,<Allocation failure>
ERRMAC NSBCN%,<Bad channel number>
ERRMAC NSBFT%,<Bad format type in process block>
ERRMAC NSCFE%,<Connect Block format error>
ERRMAC NSIDL%,<Interrupt data too long>
ERRMAC NSIFM%,<Illegal flow control mode>
ERRMAC NSILF%,<Illegal function>
ERRMAC NSJQX%,<Job quota exhausted>
ERRMAC NSLQX%,<Link quota exhausted>
ERRMAC NSNCD%,<No connect data to read>
ERRMAC NSPIO%,<Percentage input out of bounds>
ERRMAC NSPRV%,<No Privileges to Perform Function>
ERRMAC NSSTB%,<Segment size too big>
ERRMAC NSUKN%,<Unknown node name>
ERRMAC NSUXS%,<Unexpected State: Unspecified>
ERRMAC NSWNA%,<Wrong number of arguments>
ERRMAC NSWRS%,<Function called in wrong state>
;New error codes (to be re-ordered):
ERRMAC NSCBL%,<Connect block length error>
ERRMAC NSPBL%,<Process block length error>
ERRMAC NSSBL%,<String block length error>
ERRMAC NSUDS%,<Unexpected State: Disconnect Sent>
ERRMAC NSUDC%,<Unexpected State: Disconnect Confirmed>
ERRMAC NSUCF%,<Unexpected State: No Confidence>
ERRMAC NSULK%,<Unexpected State: No Link>
ERRMAC NSUCM%,<Unexpected State: No Communication>
ERRMAC NSUNR%,<Unexpected State: No Resources>
;Error codes which correspond to DECnet disconnect codes.
ERRMAC NSRBO%,<Rejected by Object>
ERRMAC NSDBO%,<Disconnected by Object>
ERRMAC NSRES%,<No Resources at Remote Node>
ERRMAC NSUNN%,<Unrecognized Node Name>
ERRMAC NSRNS%,<Remote Node Shut Down>
ERRMAC NSURO%,<Unrecognized Object>
ERRMAC NSIOF%,<Invalid Object Name Format>
ERRMAC NSOTB%,<Object Too Busy>
ERRMAC NSABM%,<Abort by Management>
ERRMAC NSABO%,<Abort by Object>
ERRMAC NSINF%,<Invalid Node Name Format>
ERRMAC NSLNS%,<Local Node Shut Down>
ERRMAC NSACR%,<Access Control Rejection>
ERRMAC NSNRO%,<No Response from Object>
ERRMAC NSNUR%,<Node Unreachable>
ERRMAC NSNLK%,<No Link>
ERRMAC NSDSC%,<Disconnect Complete>
ERRMAC NSIMG%,<Image Field Too Long>
ERRMAC NSREJ%,<Unspecified Reject Reason>
ERRMAC NSBCF%,<Bad combination of NS.EOM & NS.WAI flags>
ERRMAC NSADE%,<Address Error>
MAXERR==.-NSPERC-1
>
SUBTTL Pure data and Low segment
STKPTR: IOWD STKLEN,STACK ; Set up stack from this word
XLIST ; Turn off listing for a moment
LIT ; Generate literals in hiseg
LIST ; Turn on listing after lits
RELOC 0
; Argument block for mapping node numbers into node names
NTMAP: EXP .NTLST
EXP 0
EXP 0
EXP .NTMAP
EXP 0
EXP 0
POINT 8,MAPBUF
EXP 0
EXP 0
MAPBUF: BLOCK <9+3>/4
; Argument block for reading the executor node name
NTREX: EXP .NTLST
EXP 0
EXP 0
EXP .NTREX
EXP 0
EXP 0
POINT 8,X.NODE
EXP 0
EXP 0
; Argument block for reading the status of a node
NTRCH: EXP .NTLST
EXP .NTNOD
EXP 0
EXP .NTSHO
EXP .NTSTA
EXP 0
POINT 8,RCHBUF
EXP 0
EXP 0
RCHBLN==100
RCHBUF: BLOCK <RCHBLN+3>/4
NICBUF: BLOCK 30 ; Buffer for NICE
NICLEN==<.-NICBUF>*4
; The following is an NSP. arg block for doing an Enter Active to another NML
ENTACT: NS.WAI+.NSFEA_^D18+3 ; Enter Active, Please Wait
EXP 0 ; Channel number
EXP CBLK ; Connect Block pointer
; The following block is used to read the connect confirm data
RCCBLK: XWD .NSFRC,5 ; Read connect data function
EXP 0 ; Channel number
EXP CCDATA ; Pointer to string block
EXP 0
EXP 0
CCDATA: STRBLK ^D16 ; Connect Confirm Data string block
; The next block is used for sending data over the network
SNDBLK: NS.EOM+NS.WAI+.NSFDS_^D18+4 ; Blocking data send and end of message
EXP 0 ; Channel number goes here
EXP 0 ; Byte count goes here
EXP 0 ; Byte pointer goes here
; This block is used for receiving data from the network (via NSP.)
RCVBLK: NS.WAI+.NSFDR_^D18+4 ; Blocking data receive
EXP 0 ; Channel number
EXP 0 ; Byte count
EXP 0 ; Byte pointer
; This is a disconnect block
DSCBLK: XWD .NSFSD,3 ; Synchronus disconnect
EXP 0 ; Channel number goes here
EXP 0 ; No disconnect data
; This is a channel release block
RELBLK: XWD .NSFRL,2 ; Release this channel
EXP 0 ; Channel number goes here
MSGBUF: BLOCK ^D50 ; Lotsa room for network data
MSGLEN==<.-MSGBUF+3>*4 ; # of 8 bit bytes
RSPCNT: BLOCK 1 ; Number of bytes left in response buffer
RSPPTR: BLOCK 1 ; BP into buffer
RSPBUF: BLOCK ^D100 ; Buffer for total response
RSPLEN==<.-RSPBUF+3>*4
; The following is a connect block for opening the network connections
CBLK: EXP CBLEN ; .NSCNL
EXP CNODE ; .NSCND
EXP CSOURC ; .NSCSD
EXP CDEST ; .NSCDD
EXP CUSER ; .NSCUS
EXP CPASS ; .NSCPW
EXP CACC ; .NSCAC
EXP CUDATA ; .NSCUD
CBLEN==.-CBLK
CNODE: STRBLK 6 ; Max six chars for node names
CDEST: EXP 3 ; .NSDFL
EXP 0 ; .NSDFM
EXP .OBNIC ; .NSDOB
CSOURC: EXP 5
EXP 1,0,0 ; Format 1, no object type or PPN
EXP SRCSTR ; Address of my name
CUSER==<CPASS==<CACC==0>> ; No USER-ID, PASSWORD, or ACCOUNT
CUDATA: XWD 3,CUDLEN ; Special string block for NML
BYTE (8) 4,0,0 ; version number
CUDLEN==.-CUDATA
SRCSTR: STRBLK ^D6,<NETPTH> ; My name
; The following is NICEese for SHOW NODE xxx STATUS
CKTNIC: BYTE (8) ^D20,1_4+.NTNOD,0,0,0
CKTNLN==5 ; Number of bytes in this NICE message
; The following is NICese for SHOW CIRCUIT xxx STATUS
NODNIC: BYTE (8) ^D20,1_4+.NTCKT ; Circuit id goes here
EXP 0,0,0,0 ; and here, and here, and here
; The following two locations must be kept together
NICCNT: BLOCK 1 ; Remaining byte count for NICE message
NICBPT: BLOCK 1 ; NICE byte pointer
NICRTN: BLOCK 1 ; Driver for getting NICE bytes
LASERR: BLOCK 1 ; Last NSP. error from OPNLNK
VERFLG: BLOCK 1 ;-1=Phase 2, 0=phase 3, 1=phase 4
RSPNFG: BLOCK 1 ; Parsing a response for a NODE entity
NETCHN: BLOCK 1 ; Channel for NSP.'s
LCLNOD: BLOCK 1 ; Name of the local node
CURNOD: BLOCK 1 ; Name of current node
CURNUM: BLOCK 1 ; Number of current node
EXUNT: BLOCK 1 ; Exit when done flag
; The following two locs must be consecutive
ENDNOD: BLOCK 1 ; Name of node we are seeking
ENDNUM: BLOCK 1 ; Number of end node
IFN FTTIME,<
TIMTOT: BLOCK 1 ; Total amount of time elapsed so far
TIMCNT: BLOCK 1 ; Number of intervals
TIMSTR: BLOCK 1 ; Real time at start of this interval
CITIME: BLOCK 1 ; Length of this CI
> ;END FTTIME
PTRHLD: BLOCK 2 ; Holding area for response pointer
; used betwixt GETCKT and GETNOD
DEFFLG: BLOCK 1 ; =0 means we have defaulted already
COST: BLOCK 1 ; COST of a circuit
HOPS: BLOCK 1 ; and HOPS
X.NODE: BLOCK 3 ; Executor node name goes here
N.SPEC: BLOCK 3 ; Node name goes here
N.DEST: BLOCK 3 ; Holds destination node spec
N.SRC: BLOCK 3 ; Holds source node spec
$TOPS20 <
;Data specific to TOPS-20
DCNJFN: BLOCK 1 ; One word for JFN
DCNNAM: BLOCK ^D10 ; More than adequate space for name
> ; End of $TOPS20
STACK: BLOCK 50
STKLEN==.-STACK
SUBTTL SCAN control blocks
; Control block for .ISCAN
ISCARG: XWD ISCLEN,ISCBLK ; T1 for call to .ISCAN
ISCBLK: EXP 0
EXP 0
EXP 0
EXP 0
EXP 0
EXP 0
ISCLEN==.-ISCBLK
PSCARG: XWD PSCLEN,PSCBLK
PSCBLK: XWD 0,0
XWD 0,0
XWD 0,0
XWD 0,0
PSCLEN==.-PSCBLK
END NETPTH