Trailing-Edge
-
PDP-10 Archives
-
BB-R595B-SM_11-9-85
-
mcb/xpt/xptsel.bli
There is 1 other file named xptsel.bli in the archive. Click here to see a list.
module XPTSEL (
IDENT = 'X01730'
) =
begin
!
! COPYRIGHT (c) 1980, 1981, 1982
! DIGITAL EQUIPMENT CORPORATION
! Maynard, Massachusetts
!
! 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.
!
!++
! FACILITY: Transport
!
! ABSTRACT:
!
! Transport Select module: Determines what line to send
! a forwarded message over. Builds routing headers for
! the messages. Calls Forwarding to transmit the messages.
!
! ENVIRONMENT: MCB
!
! AUTHOR: L. Webber , CREATION DATE: 2-Aug-79
!
! MODIFIED BY:
!
! L. Webber, 2-Aug-79 : VERSION 01
!
! 1.01 L. Webber, 3-Oct-79
! Replaced routines SELECTOR and HDR_BUILD, added RCVECL, RCVPH2,
! BLDPH2, BLDPH3, and INTERCEPT
!
! 1.02 L. Webber, 3-Apr-80
! Modified to support node and line sub-data-bases
!
! 1.03 L. Webber, 30-Jun-80
! Modify to use MCBLIB macros
!
! 1.04 L. Webber, 3-Oct-80
! Modify to recognize own node name in routing header
!
! 1.05 A. Peckham, 16-Oct-80
! Do not translate C_LIN in CCB from ECL in RCVECL.
!
! 1.06 A. Peckham, 21-Oct-80
! Change all CE_ERR returns into SIGNAL_STOPs.
!
! 1.07 A. Peckham, 22-Oct-80
! Set adjustment factor to zero in BLDPH3 for ECL CCBs.
!
! 1.08 A. Peckham, 22-Oct-80
! Fix adjustment factor problems once and for all....
!
! 1.09 A. Peckham, 24-Oct-80
! Change some CE_ERRs back from SIGNAL_STOPs.
!
! 1.10 L. Webber, 31-Oct-80
! Check source & dest addrs for 0 in RCVECL
!
! 1.11 L. Webber, 20-Nov-80
! Modify to intercept DI's
!
! 1.12 L. Webber, 11-Dec-80
! Modify to support MCB 3.1
!
! 1.13 L. Webber, 13-Jan-80
! Replace "no link" DC with "bad routing header" DC
!
! 1.14 L. Webber, 23-Jan-81
! Add counter and event-logging code
!
! 1.15 L. Webber, 9-Feb-81
! Change references to Forwarding routines (ECLFWD, FORWARDER, TERMINATE)
! to CALL$E
!
! 1.16 L. Webber, 9-Feb-81
! Change references back (a interface module has been added)
!
! 1.17 L. Webber, 10-Feb-81
! MAPBUF is now a macro
!
! 1.18 L. Webber, 11-Feb-81
! Put the local node name in a Phase II routing header when the local
! node is the source, instead of the number.
!
! 1.19 L. Webber, 20-Feb-81
! Fix linkage in RCVDAT (C_LIX already translated from LIX)
!
! 1.20 L. Webber, 20-Feb-81
! Don't flag a DC which can't be intercepted.
!
! 1.21 L. Webber, 23-Feb-81
! Make the Event Buffer data an image field.
!
! 1.22 L. Webber, 25-Feb-81
! Make calls to $CDBV and $CBDMG CALL$E's
!
! 1.23 L. Webber, 3-Mar-81
! Change code for implementing local routing (ECL-ECL)
!
! 1.24 L. Webber, 5-Mar-81
! If a Phase II packet is received with a numeric destination
! node name, the header is not useable and must be rebuilt if
! the adjacent node is Phase II.
!
! 1.25 L. Webber, 5-Mar-81
! Split INTERCEPT into its own XPESEL module.
!
! 1.26 L. Webber, 11-Mar-81
! Take out "return-to-sender" processing for packets from the
! ECL; NSP never uses the feature.
!
! 1.27 L. Webber, 12-Mar-81
! Fix BLDPH2 so that if the source node is adjacent and Phase 2,
! the ASCII source name is put into the routing header.
!
! 1.28 L. Webber, 16-Mar-81
! Fix a couple of "cleanup" places so that they UNSPAWN the
! spawned CCB, instead of just releasing it.
!
! 1.29 L. Webber, 16-Mar-81
! Modify so that only links where at least one end is Phase II (not
! II+) are intercepted.
!
! 1.30 L. Webber, 18-Mar-81
! Fix bug in RCVPH2 that was inspecting the wrong line as the
! output one.
!
! 1.31 L. Webber, 19-Mar-81
! Fix the same bug in RCVDAT.
!
! 1.32 L. Webber, 20-Mar-81
! Fix mistake in header-flag parameter in a call to BLDPH2.
!
! 1.33 L. Webber, 3-Apr-81
! Put LIX for input line as entity into LOG_EVENT call (except
! for the Aged Packet Loss event, which takes no entity).
!
! 1.34 L. Webber, 17-Apr-81
! Fix RCVPH2 to map to input line data base when processing
! a packet for self.
!
! 1.35 L. Webber, 1-May-81
! Make sure no more than 60 bytes goes in the Event Buffer in
! UNREACH in RCVPH2.
!
! 1.36 L. Webber, 6-May-81 *** TEMPORARY ***
! Crash when an invalid format message is received from a Phase
! II node.
!
! 1.37 L. Webber, 6-May-81
! Set C.LIX (the input channel) to 0 when sending a packet to the
! local node in RCVECL.
!
! 1.38 L. Webber, 6-May-81 *** TEMPORARY ***
! Fix PH2HDR to call a mismatch between source name and adjacent
! node name "unreachable" instead of "format error", so that the
! event doesn't cause a crash while 1.36 is in.
!
! 1.39 L. Webber, 8-May-81
! Fix local link code in RCVECL to do an LDBRT on resource failure.
!
! 1.40 L. Webber, 11-May-81
! Take out 1.36 and 1.38.
!
! 1.41 L. Webber, 1-Jun-81
! Modify all LOG_EVENT calls for a circuit entity to pass the NMXid.
!
! 1.42 L. Webber, 3-Jun-81
! Allocate a specific buffer size instead of an SDB.
!
! 1.43 L. Webber, 4-Jun-81
! Set C_LIN in Select, not Forwarding, when going to the ECL.
!
! 1.44 L. Webber, 25-Jun-81
! Modify UNREACH subroutine of RCVPH2 to call SEND_DC (in XPESEL)
! instead of constructing and sending the DC itself.
!
! 1.45 L. Webber, 7-Jul-81
! Fix RCVDAT to handle congestion by UNSPAWNing before TOSSing.
!
! 1.46 L. Webber, 20-Jul-81
! Decrement INPUTcount when sending a DC back to the source of a
! buffer in RCVPH2, thus closing the books on the buffer.
!
! 1.47 L. Webber, 22-Jul-81
! Enhance 1.46 to clear out a CCB's type code when it is allocated
! in RCVPH2 and RCVDAT. This assures that _TERMINATE (1.12) will do the
! right thing with INPUTcount even when the CCB isn't actually forwarded
! anywhere.
!
! 1.48 L. Webber, 24-Jul-81
! Fix local link processing in RCVECL to get a CCB as well as a buffer.
!
! 1.49 L. Webber, 31-Jul-81
! Fix RCVPH2 so that a bogus "Phase II" packet will not cause a
! SIGNAL_STOP, but instead will cause a "packet format error" event
! to be logged and the packet to be discarded.
!
! 1.50 L. Webber, 5-Aug-81
! Fix the first call to TOSS in RCVDAT to pass information which has
! not yet been determined, as 0.
!
! 1.51 L. Webber, 6-Aug-81
! Zero out both adjustment factor and buffer type of a newly acquired
! CCB in RCVECL. (Cf. 1.47).
!
! 1.52 L. Webber, 12-Aug-81
! Fix UNREACH in RCVPH2 to zero out the adjustment factor in the
! spawned CCB before sending a DC.
!
! 1.53 L. Webber, 12-Aug-81
! Fix 1.49 to refer to the right CCB (CCB_P) throughout.
!
! 1.54 L. Webber, 12-Aug-81
! Fix 1.52 to un-adjust the pass-through CCB before zeroing out
! the adjustment factor. Also, un-chain the pass-through (i.e.,
! zero out the spawned CCB's C_CHN).
!
! 1.55 L. Webber, 16-Sep-81
! Fix all three main routines so that a line state for a selected
! output circuit other than "running" will make a node unreachable over
! that circuit. This is to handle the window during which TLI has
! brought the circuit down, but XPT hasn't processed the "line down"
! CCB.
!
! 1.56 L. Webber, 16-Sep-81
! Modify BLDPH2 so that, if the source node is a Phase II node, it
! searches first the input circuit for the packet and then all circuits
! for an matching adjacent Phase II node. If it finds one, it converts
! the address into an ASCII node name. The change from the old way
! of doing things is that all circuits and not just the input circuit
! are checked.
!
! 1.57 L. Webber, 20-Sep-81
! Fix 1.55 not to check the "output circuit" for a packet to the
! local node.
!
! 1.58 A. Peckham, 23-Sep-81
! Fix dot bug in RCVPH2.
!
! 1.59 L. Webber, 24-Sep-81
! Modify event logging calls to use new macros for storing parameters
! in the Event Buffer.
!
! 1.60 L. Webber, 16-Oct-81
! Change UNREACH in RCVPH2 not to DC an unreachable packet if the
! source node is 2+, but rather just to toss the packet.
!
! 1.61 L. Webber, 16-Nov-81
! Fix RCVDAT when destination is unreachable, to address the input
! circuit data base before incrementing the "transit packets in"
! counter (currently the output data base for OL = -1 is being ad-
! dressed).
!
! 1.62 L. Webber, 21-Dec-81
! Fix UNREACH in RCVPH2 so that it exchanges the source and destination
! node names, and recognizes a DC in a packet with a routing header.
!
! 1.63 L. Webber, 17-Feb-82
! Fix UNREACH in RCVPH2 to log a packet header using a pointer to the
! beginning of the header, not the pointer used to scan it.
!
! 1.64 L. Webber, 23-Feb-82
! Add maintenance of DLLquota.
!
! 1.65 L. Webber, 24-Feb-82
! Fix bug in RCVECL that lost routing header buffers when a packet
! was discarded.
!
! 1.66 L. Webber, 3-Mar-82
! Fix RCVPH2 to increment right circuit data base for Transit In's,
! when the output circuit is Phase III.
!
! 1.67 L. Webber, 3-Mar-82
! Streamline the whole module somewhat. This mostly involves minor
! rearranging of code, but the following features have been deleted:
!
! 1. Validating the source node address in RCVECL (it is assumed that
! NSP is a good guy).
! 2. Validating the output circuit in RCVECL (ditto).
! 3. Taking out the scan of the Node Translate Table in PH2HDR. This
! table is no longer generated anyway. Just in case, the code is
! only commented out.
!
! 1.68 L. Webber, 19-Mar-82
! Fix a bug in UNREACH in RCVPH2 that misused the buffer pointer to
! packets received without routing headers, resulting in invalid DC's
! being sent.
! Change code in the same module that threw away a packet with an invalid
! routing header. The new code tries to DC the packet as best it can.
! (It also takes less space.)
!
! 1.69 A. Peckham, 19-Apr-82
! Eliminate calls to LOG_EVENT, GETNODE, GETLINE, PKTB_HDR.
! PKTA_HDR has gone to XPE.
! Make calls to $CDBV and $CBDMG regular linkages again
! and rename them to CDTB and CBTD respectively.
!
! 1.70 A. Peckham, 14-Jun-82
! Fix UNREACH in RCVPH2 to log PACKET HEADER parameter
! for all errors except for $XPT$E_FMT.
!
! 1.71 A. Peckham, 2-Jul-82
! Rename INTERCEPT to INTPH2.
!
! 1.72 D.Brannon, 22-Sep-83
! Moved TERMINATE in the VISITS check in MAINLINE to
! after the references to the CCB to avoid a race.
!
! 1.73 D.Brannon, 23-Sep-83
! Add a check in PH2HDR for a zero length destination name.
!
!--
!
! TABLE OF CONTENTS
!
forward routine
RCVECL,
RCVDAT: novalue,
RCVPH2: novalue,
BLDPH2,
BLDPH3,
PH2HDR;
!
! INCLUDE FILES:
!
require 'XPTMAC';
!
! MACROS:
!
macro GETBUF(len,ccb) =
BEGIN
MAP CCB: REF BLOCK FIELD (C_XPT_FIELDS);
IF $MCB_GET_BUFFER (len,ccb[C_ADDR]) THEN BEGIN
SMAP$(ccb[C_BIAS]);
ccb[C_XPT_ALLOCATION] = len;
TRUE
END
ELSE FALSE
end%;
!
! EQUATED SYMBOLS:
!
!
! OWN STORAGE:
!
!
! EXTERNAL REFERENCES:
!
external routine
FORWARDER,
ECLFWD,
CDTB,
CBTD,
RE_QUEUE: novalue,
TERMINATE: novalue,
UNSPAWN: novalue;
global
routine RCVECL (CCB_P) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine processes data packets received from a local Transport
! user. It determines the output line (or local Transport user) corresponding
! to the specified destination, and attempts to forward the packet to that
! destination. If the destination is unreachable, it will attempt to return
! the packet to the source Transport user. If the packet is returned to
! sender, or if a congestion or resource error occurs during processing of the
! packet, the function CCB is returned to the caller with an error.
!
! FORMAL PARAMETERS
!
! CCB_P - address of the function CCB, which points to the
! packet to be transmitted.
!
! IMPLICIT INPUTS
!
! CB[C_PRM1] - source address
! CB[C_PRM2] - destination node address
! CB[C_STS] - bit 0, if on, specifies that "return to sender" be
! set in the header
! CB[C_LIN] - channel to send the packet on, or 0 if Select is to
! determine the channel
!
! ROUTINE VALUE: A "success" code, or one of several "failure" codes
! COMPLETION CODES:
!
! CS_SUC - success
! CE_DIS - destination unreachable; packet will be separately returned
! to sender if so requested
! CE_RTE - packet rejected for because of congestion or resource failure
! CE_NTE - source Transport user has not issued an OPEN to Transport
! CE_ERR - invalid parameter specified
!
! SIDE EFFECTS:
!
! On a success return, Select has taken control of the
! CCB passed it; that CCB should not be used by the caller again.
!
!--
begin
local NODEb,LINEb;
require 'XPTSYM';
local CCB: ref block field (C_XPT_fields);
map CCB_P: ref block field(C_fields);
local OTYPE,OLINE,SOURCE,DEST,CALLER,RET;
!--------------------------------------------!
! !
! Routine to do "unreachability" processing !
! !
!--------------------------------------------!
routine UNREACH (CB,CALLER,SOURCE,DEST) =
begin
literal NO_NODEb = 0; ! Make sure NODEb isn't mapped
literal NO_LINEb = 0; ! Ditto for LINEb
require 'XPTSYM';
map CB: ref block field(C_XPT_fields);
COUNTER_INCREMENT(XPTDB,XPTunreach_loss); ! Increment node counter
$NM_LOG_BEGIN();
PARAMETER_CM(0,4); ! Multiple fields, 4 of them
PARAMETER_H_1(,uplit(2)); ! Hex field, 1 byte: (canned) routing flags
PARAMETER_DU_2(,DEST); ! Decimal unsigned, 2 bytes: dest. address
PARAMETER_DU_2(,SOURCE); ! Decimal unsigned, 2 bytes: source address
PARAMETER_H_1(,uplit(0)); ! Hex field, 1 byte: (canned) forwarding flags
$NM_LOG_END(4^6+$XPT$E_UNR,-1); ! "unreachability packet loss" event
if .CB [C_XPT_ALLOCATION] neq 0 then ! Get rid of our CCB
$MCB_RETURN_CCB_AND_BUFFER(.CB [C_XPT_ALLOCATION],.CB) ! (with or
else $MCB_RETURN_CCB(.CB); ! without a buffer)
return(CE_DIS) ! and return an error
end;
!****************** START OF ROUTINE MAINLINE **************************!
!
! Pick up the parameters and validate them
!
CCB = .CCB_P;
DEST = .CCB[C_PRM2]; ! Pick up the destination address
NODEb = $XPT_GET_NODE_DB(.DEST); ! and address its data base entry
if .NODEb eql 0 then ! Invalid destination -
return (CE_ERR); ! return "parameter error"
SOURCE = .CCB[C_PRM1]; ! Pick up the source address
OLINE = .CCB[C_LIN]; ! Pick up the output line
CALLER = .CCB[C_PIX]; ! Pick up Transport user's PDV index
!
! Determine the output line
!
if .OLINE eql 0 ! Line not specified - default
then if not .Local_node
then OLINE = .OL;
!
! Spawn a CCB
!
if not $MCB_GET_CCB (CCB)
then return (CE_RTE);
CCB [C_XPT_ALLOCATION] = 0;
if .OLINE eql 0 then
begin ! Local link:
local TMPCCB: ref block field (C_FIELDS), BUFSIZE;
TMPCCB = .CCB_P; ! Trace through the input CCB chain
BUFSIZE = 0;
do ! and accumulate message length
BUFSIZE = .BUFSIZE + .TMPCCB[C_CNT]
while (TMPCCB = .TMPCCB[C_CHN]) neqa 0;
if not GETBUF(.BUFSIZE,CCB) ! Get a buffer that size
then begin ! and if failure
$MCB_RETURN_CCB(.CCB); ! then return CCB
return (CE_RTE); ! and "resource error"
end;
end; ! Not local link - just get the CCB
if .OLINE neq 0 then !If the path isn't local,
CCB[C_STK] = .CCB_P; ! chain in the pass-through CCB
CCB[C_PRM4] = 0;
!
! Check destination for unreachability
!
LINEb = $XPT_GET_LINE_DB(.OLINE);
if (not .Reach !Destination
or ((.OLINE neq 0) and (.LINEstate neq RU))) then! unreachable:
return (UNREACH(.CCB,.CALLER,.SOURCE, ! do "unreachability"
.DEST)); ! processing
!
! Destination is local
!
RET %(the return from Forwarding)% =
(if .OLINE eql 0 then
if .Local_node then begin
OTYPE = 0; !Set output type to "local"
CCB[C_CNT] = !Copy the data
$MCB_COPY_CHAIN_TO_BUFFER(.CCB_P, ! into the single
(.CCB[C_BIAS],.CCB[C_ADDR])); ! data buffer
CCB[C_LIX] = 0; !Input channel is null
if (ECLFWD(.CCB,.SOURCE,.DEST,0) !Try to forward the packet
neq CS_SUC) then ! to the specified user
return ($MCB_RETURN_CCB_AND_BUFFER !Failed -
(.CCB[C_PRM5],.CCB); CE_RTE) ! set error code
else begin !Worked -
TERMINATE(.CCB_P,CS_SUC); ! return the input
INPUTquota = .INPUTquota - 1; ! buffer (but don't
CS_SUC ! return the admission
end ! permit)
end
else SIGNAL_STOP (CE_ERR) !Output line = 0, destination not Self
!
! Adjacent node is Phase II
!
else begin
LINEb = $XPT_GET_LINE_DB(.OLINE);
if ((.Nty eql PhTwo) or (.Nty eql TOPS20)) then begin
if .Nty eql PhTwo then !Set output type to
OTYPE = 1 ! "Phase II" or
else OTYPE = 2; ! "Phase II+/Phase III"
RET =
(if (.Nid neq .DEST) then !Destination isn't adjacent -
SIGNAL_STOP (CE_ERR) ! bomb
else BLDPH2(.CCB,0,.DEST, !Otherwise, build a
.SOURCE,.OLINE,0)); ! Phase II header
end
!
! Adjacent node is Phase III - build a Phase III header
!
else begin
OTYPE = 2; !Set output type to "Phase II+/III"
RET = BLDPH3 (.CCB,0,.DEST,.Tid,0);
end;
!
! Error in building the header - return an error
!
if .RET neq CS_SUC then return (CCBRT$(.CCB); .RET)
!
! Message is ready to be sent - give it to Forwarding
!
else begin
if ((RET = FORWARDER(.CCB,.OLINE))
eql CS_SUC) then ! If Forwarding accepts packet,
COUNTER_INCREMENT(LINEb,XPTend_xmt);! update packets counter
.RET
end
end);
!
! Forwarding rejected packet as "unreachable"
!
if .RET eql CE_DIS then
UNREACH (.CCB,.CALLER,.SOURCE,.DEST)
!
! Forwarding rejected packet for congestion reasons
!
else if .RET eql CE_RTE then begin
if .CCB [C_XPT_ALLOCATION] neq 0 then
$MCB_RETURN_CCB_AND_BUFFER(.CCB [C_XPT_ALLOCATION],.CCB)
else $MCB_RETURN_CCB(.CCB);
CE_RTE
end
!
! Forwarding accepted packet - return "success"
!
else begin
if .OTYPE eql 1 then !Going to a Phase II node -
CALL$E(INTPH2,PD_XPE,.CCB_P,1, ! do intercept
DEST,SOURCE); ! processing
CS_SUC
end
end; !End of RCVECL
global
routine RCVDAT (CCB_P): novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine processes data packets received from the Data Link
! Link Layer which have Phase III routing headers. It determines
! the output line (or local Transport user) corresponding to the
! specified destination, and attempts to forward the packet to that
! destination. If the destination is unreachable, the routine will
! try to return the packet to its source node. If the immediate
! destination (the adjacent node on the output line) is Phase II,
! BLDPH2 will be called to translate the routing header. If the
! destination is "standard" Phase II, the packet will not be thrown
! away on congestion or resource failure, but will be queued for
! eventual reprocessing.
!
! FORMAL PARAMETERS
!
! CCB_P - CCB for the received packet - the "pass-through" CCB
!
! IMPLICIT INPUTS
!
! Reach, OL, Nty, Nid, User
!
! ROUTINE VALUE: NONE
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! May modify the routing header in the pass-through buffer.
!
!--
begin
local NODEb,LINEb;
require 'XPTSYM';
local CCB: ref block field (C_XPT_fields);
map CCB_P: ref block field(C_fields);
local DEST,SOURCE,ILINE,OLINE,RET,RFLG,VISIT;
pointer PTR;
macro RTS = biton (.RFLG,RTSflg)%;
macro RQR = biton (.RFLG,RQRflg)%;
!-----------------------------------------------------!
! !
! Routine to either throw away a packet or queue it !
! for eventual reprocessing !
! !
!-----------------------------------------------------!
routine TOSS (CCB,OLINE,ILINE,DEST): novalue =
begin
local LINEb;
literal NO_NODEb = 0; !This is to get around a BLISS glitch
require 'XPTSYM';
LINEb = $XPT_GET_LINE_DB(.OLINE); ! Address line data base entry
if ((.OLINE neq 0) ! If the destination isn't local,
and (.Nty eql PhTwo) ! and it's standard Phase II
and (.Nid eql .DEST)) ! and it's the adjacent node
then RE_QUEUE(.CCB) ! then requeue CCB for later
else begin !
if .OLINE neq 0 then ! Transit congestion -
COUNTER_INCREMENT(LINEb,XPTxit_cng)! log that
else begin ! Path-end congestion -
LINEb = $XPT_GET_LINE_DB(.ILINE); ! Log that (on
COUNTER_INCREMENT(LINEb,XPTend_cng); ! the input line)
end;
TERMINATE(.CCB,CE_RTE); !Otherwise, throw buffer away
end;
end;
!---------------------------------------------!
! !
! Routine to do "unreachability" processing !
! !
!---------------------------------------------!
routine UNREACH (CCB,CCB_P,SOURCE,DEST,RFLG,CODE): novalue =
begin
literal NO_NODEb = 0; ! To keep NODEb from being mapped
local LINEb;
require 'XPTSYM';
map CCB: ref block field(C_FIELDS);
map CCB_P: ref block field(C_FIELDS);
pointer PTR;
LINEb = $XPT_GET_LINE_DB(.CCB_P[C_LIX]); ! Address input line data base
if .CODE eql $XPT$E_UNR then ! Increment
COUNTER_INCREMENT(XPTDB,XPTunreach_loss) ! appropriate
else COUNTER_INCREMENT(XPTDB,XPTrange_loss); ! node counter
$NM_LOG_BEGIN();
CALL$E(PKTA_HDR,(PD_XPE),.CCB_P[C_ADDR]); ! Log an "unreachable node" or
$NM_LOG_END(4^6+.CODE,.NMXid); ! "node out of range" event
if ((RQR) and (not (RTS))) then begin ! Valid "return to sender" -
CCB[C_BIAS] = .CCB_P[C_BIAS]; ! Copy routing
CCB[C_ADDR] = .CCB_P[C_ADDR]; ! header into
CCB[C_CNT] = .CCB_P[C_CNT]; ! the spawned CCB
PTR = .CCB[C_ADDR]; ! Address the routing header
putb (.RFLG or RTSflg, PTR); ! Set the RTS flag
putw (.SOURCE,PTR); ! Exchange the source
putw (.DEST,PTR); ! and destination addresses
if FORWARDER(.CCB,.CCB_P[C_LIN]) ! Send back over input line
neq CS_SUC then ! Rejected -
TERMINATE(.CCB,CE_DIS); ! throw away
end
else TERMINATE(.CCB,CE_DIS); ! No "return to sender" - throw away
return;
end;
!******************** START OF ROUTINE MAINLINE *************************!
!
! Analyze the routing header
!
MAPBUF (.CCB_P,PTR); !Map in the buffer
RFLG = getb(PTR); !Pick up the routing flags
DEST = getw(PTR); !Pick up the destination address
SOURCE = getw(PTR); !Pick up the source address
VISIT = ch$rchar(.PTR); !Pick up the visits count
VISIT = .VISIT+1;
ch$wchar_a(.VISIT,PTR);
!
! Calculate the input and output lines
!
NODEb = $XPT_GET_NODE_DB(.DEST); ! Get destination data base address
OLINE = 0;
if not .Local_node then OLINE = .OL;
ILINE = .CCB_P[C_LIN];
LINEb = $XPT_GET_LINE_DB(.ILINE); ! Address input line data base entry
!
! Check the VISITS field in the routing header
!
if ((.VISIT gtru .MAXV) !Too many
or ((RTS) and (.VISIT gtru (2*.MAXV)))) then ! visits -
begin ! throw the
! packet away,
COUNTER_INCREMENT(XPTDB,XPTaged_loss); ! bump "aged loss" and
COUNTER_INCREMENT(LINEb,XPTxit_rcv); ! "transit packet"
$NM_LOG_BEGIN(); ! "aged packet loss"
CALL$E(PKTA_HDR,(PD_XPE),.CCB_P[C_ADDR]); ! event
$NM_LOG_END(4^6+$XPT$E_AGE,-1); !
TERMINATE(.CCB_P,CE_ERR);
return;
end;
!
! Spawn a CCB for the packet
!
if not CCBGT$(CCB) then begin !Couldn't get
TOSS(.CCB_P,.OLINE,.ILINE,.DEST); ! a CCB - get
return; ! rid of packet
end;
CCB[C_STK] = .CCB_P; !Chain pass-through to spawned CCB
CCB[C_PRM4] = 0;
!
! Destination is unreachable
!
LINEb = $XPT_GET_LINE_DB(.OLINE);
if not begin
if .DEST gtru NN then (RET = $XPT$E_RNG; FALSE)
else if (not .Reach
or ((.OLINE neq 0) and (.LINEstate neq RU))) then
(RET = $XPT$E_UNR; FALSE)
else TRUE
end
then begin
UNREACH(.CCB,.CCB_P,.SOURCE,.DEST,.RFLG,.RET);
LINEb = $XPT_GET_LINE_DB(.ILINE);
COUNTER_INCREMENT(LINEb,XPTxit_rcv);
return
end;
!
! Destination is Self
!
if .OLINE eql 0 then
if .Local_node then begin
CCB[C_BIAS] = .CCB_P[C_BIAS]; !Copy buffer
CCB[C_ADDR] = ch$plus(.CCB_P[C_ADDR],6); ! descriptor, incrementing
CCB[C_CNT] = .CCB_P[C_CNT] - 6; ! past the routing header
CCB[C_LIN] = .CCB_P[C_LIN]; !Set the line number
LINEb = $XPT_GET_LINE_DB(.ILINE); ! Increment "arriving
COUNTER_INCREMENT(LINEb,XPTend_rcv); ! packets" ctr
if ECLFWD(.CCB,.SOURCE,.DEST,0) !Pass the buffer to Forwarding
neq CS_SUC !Rejected -
then TOSS(.CCB,.OLINE,.ILINE,.DEST); ! throw it away
end
else BPT(XPT$_DNS,.DEST) !Destination is not Self, but output line is 0
!
! Next node in path is Phase III
!
else if ((.Nty eql Full)
or (.Nty eql Small)) then begin
CCB[C_BIAS] = .CCB_P[C_BIAS]; !Copy the
CCB[C_ADDR] = .CCB_P[C_ADDR]; ! buffer descriptor
CCB[C_CNT] = .CCB_P[C_CNT]; ! from the pass-through to the spawn
LINEb = $XPT_GET_LINE_DB(.ILINE); !Increment "transit packet
COUNTER_INCREMENT(LINEb,XPTxit_rcv);! received" counter
LINEb = $XPT_GET_LINE_DB(.OLINE); !Address output line data base again
RET = FORWARDER(.CCB,.OLINE); !Try to send the buffer out
if .RET eql CE_DIS then !Rejected for unreachability -
UNREACH(.CCB,.CCB_P,.SOURCE, ! do unreachablility
.DEST,.RFLG,$XPT$E_UNR) ! processing
else if .RET neq CS_SUC then !Rejected for congestion -
TOSS(.CCB,.OLINE,.ILINE,.DEST) ! throw buffer away
else COUNTER_INCREMENT(LINEb,XPTxit_xmt) ! Accepted - update packet counter
end
!
! Destination is Phase II
!
else if ((.Nty eql PhTwo)
or (.Nty eql TOPS20)) then begin
LINEb = $XPT_GET_LINE_DB(.ILINE); !Increment "transit packet
COUNTER_INCREMENT(LINEb,XPTxit_rcv);! received" counter
LINEb = $XPT_GET_LINE_DB(.OLINE); !Address output line data base
if .Nid neq .DEST then begin !Destination is not adjacent -
TERMINATE(.CCB,CE_DIS); ! throw buffer away
return;
end;
RET = BLDPH2(.CCB,6,.DEST, !Translate routing header
.SOURCE,.OLINE,.ILINE); ! to Phase II
if .RET eql CE_RTE then begin !Resource failure -
UNSPAWN(.CCB); ! get rid
TOSS(.CCB_P,.OLINE,.ILINE,.DEST)! of buffer
end
else if .RET eql CE_DIS then !Unmappability -
UNREACH(.CCB,.CCB_P,SOURCE, ! treat like
.DEST,.RFLG,$XPT$E_UNR) ! unreachability
else begin !Header built -
RET = FORWARDER(.CCB,.OLINE); ! Try to forward the packet
if .RET eql CE_DIS then ! Unreachable
UNREACH(.CCB,.CCB_P,SOURCE,
.DEST,.RFLG,$XPT$E_UNR)
else if .RET neq CS_SUC then begin ! Congestion
UNSPAWN(.CCB);
TOSS(.CCB_P,.OLINE,.ILINE,.DEST);
end
else begin
COUNTER_INCREMENT(LINEb,XPTxit_xmt);! Update packet counter
if .Nty eql PhTwo then
CALL$E(INTPH2,PD_XPE,.CCB_P,1,DEST,SOURCE)
end
end
end
!
! Invalid adjacent node type
!
else BPT(XPT$_IANT,.Nty);
return;
end; !End of RCVDAT
global
routine RCVPH2 (CCB_P): novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine processes data packets received from the Data
! Link Layer which have Phase II routing headers. It translates
! the routing header to determine the output line (or local
! Transport user) corresponding to the specified destination,
! and attempts to forward the packet to that destination. If
! the destination is unreachable, the routine will return a DC to
! the caller. If the packet is for Self (a local Transport user),
! the spawned CCB is set up to point past the routing header,
! and the packet is forwarded to the ECL. If the destination node
! is also a Phase II node, the packet will be sent to the
! destination unchanged. If the immediate next node over the
! output line is a Phase III node, routine BLDPH3 will be called
! to build a new routing header and point the spawned CCB to it.
! If the destination node address cannot be determined, the packet
! will always be discarded. If, for congestion or resource reasons,
! the packet cannot be forwarded at the time, it will be queued for
! eventual reprocessing if either the source or destination is a
! standard Phase II node; otherwise, it will be discarded.
!
! FORMAL PARAMETERS
!
! CCB_P - CCB for the received packet; the "pass-through" CCB
!
! IMPLICIT INPUTS
!
! Reach, OL, Nty, Nid, User
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
! NONE.
!
! SIDE EFFECTS:
!
! May temporarily modify the buffer descriptor for the pass-through CCB.
!
!--
begin
forward routine TOSS: novalue;
!***********************************************!
! !
! Routine to handle "unreachability" case !
! !
!***********************************************!
routine UNREACH (CCB,CCB_P,ILINE,CODE): novalue =
begin
map CCB: ref block field (C_XPT_fields);
local LINEb;
require 'XPTSYM';
map CCB_P: ref block field(C_XPT_fields);
local LENS,LEND,LINKS,LINKD,RET;
local WORKD: vector[3], WORKS: vector[3];
pointer PTR;
!
! Map in the pass-through buffer; address input line data base
!
MAPBUF(.CCB_P,PTR);
LINEb = $XPT_GET_LINE_DB(.ILINE);
!
! Update node counters and signal an event
!
if .CODE eql $XPT$E_UNR then ! Update
COUNTER_INCREMENT(XPTDB,XPTunreach_loss) ! "unreachability"
else if .CODE eql $XPT$E_RNG then ! or "node out of
COUNTER_INCREMENT(XPTDB,XPTrange_loss) ! range" or "header
else COUNTER_INCREMENT(XPTDB,XPTfmt_loss); ! format error" counter
RET = getb(PTR); ! Pick up "routing flags"
if bitoff(.RET,2) then RET = 5 ! No routing header
else begin ! Routing header -
RET = getb(PTR); ! pick up the first node lgth
PTR = ch$plus(.PTR,.RET); ! jump over the node name
RET = .RET + getb(PTR) + 2 + 1 + 5; ! add in second node lgth
end; ! and the rthdr & NSP hdr
RET = MINU(.RET,55); ! (but don't overflow buffer)
MAPBUF(.CCB_P,PTR);
$NM_LOG_BEGIN();
PARAMETER_HI((if .CODE eql $XPT$E_FMT then 1 else 0),
.RET,.PTR); ! Move "packet beginning" into
$NM_LOG_END(4^6+.CODE,.NMXid); ! Log the event
!
! If the message came from a Phase II+ node, just toss it away
!
if .Nty eql TOPS20 then begin
TOSS(.CCB,0,0,.ILINE);
return;
end;
!
! If the incoming message had a routing header, build the DC routing header
! by reversing the destination and source fields in the input routing header
!
RET = getb(PTR); !Pick up routing or message flags
if bitoff(.RET,2) then !No routing header -
LEND = 0 ! set "no header" indication
else begin ! NOTE: source/dest names switched
! ***
LENS = getb(PTR); !Pick up destination node name length
ch$move(MINU(.LENS,6),.PTR, !Save destination
byt$ptr(WORKS,0)); ! name field
PTR = ch$plus(.PTR,.LENS); !Advance over name
LEND = getb(PTR); !Pick up source node name length
ch$move(MINU(.LEND,6),.PTR, !Save source
byt$ptr(WORKD,0)); ! name field
PTR = ch$plus(.PTR,.LEND); !Advance over name
RET = getb(PTR); !Pick up MSGFLGS
end;
LINKS = getw(PTR); !Get destination and source link
LINKD = getw(PTR); ! addresses, and switch them
!
! Build a DC message with the specified disconnect code
!
if .RET eql DC_MSGflgs then begin !If the message was a DC,
TERMINATE(.CCB,CE_DIS); ! ignore it
return;
end;
if .CCB [C_XPT_ADJUST] neq 0 then begin !Un-adjust the spawned CCB
CCB_P[C_ADDR] = ch$plus(.CCB_P[C_ADDR],-.CCB[C_XPT_ADJUST]);
CCB_P[C_CNT] = .CCB_P[C_CNT] + .CCB[C_XPT_ADJUST];
end;
CCB[C_XPT_TYPE] = 0;
CCB[C_XPT_ADJUST] = 0;
CCB[C_BIAS] = .CCB_P[C_BIAS]; !Copy pass-through
CCB[C_ADDR] = .CCB_P[C_ADDR]; ! buffer descriptor into spawn
CCB[C_CHN] = 0;
INPUTcount = .INPUTcount - 1; !Finish up bookkeeping
DLLquota = .DLLquota + 1; ! for the buffer
CALL$E(SEND_DC,(PD_XPE),.CCB,.LINEb,
.LEND,byt$ptr(WORKD,0),.LENS,byt$ptr(WORKS,0),.LINKD,.LINKS,
(if .CODE eql $XPT$E_FMT then MISC_ERROR else NO_PATH_ERROR));
end;
!*******************************************************!
! !
! Routine to either throw away a packet or queue it !
! for eventual reprocessing !
! !
!*******************************************************!
routine TOSS (CCB,OLINE,DEST,ILINE): novalue =
begin
map CCB: ref block field (C_XPT_fields);
local LINEb;
require 'XPTSYM';
local CCB_P;
CCB_P = .CCB[C_STK];
if
(begin
LINEb = $XPT_GET_LINE_DB(.OLINE);
(.OLINE neq 0)
and (.Nty eql PhTwo)
and (.Nid eql .DEST)
end
or
begin
LINEb = $XPT_GET_LINE_DB(.ILINE);
(.ILINE neq 0)
and (.Nty eql PhTwo)
end)
then RE_QUEUE (if .CCB[C_OWN] eql PD_XPT then
(UNSPAWN(.CCB); .CCB_P)
else .CCB)
else begin
if .OLINE neq 0 then begin
LINEb = $XPT_GET_LINE_DB(.OLINE);
COUNTER_INCREMENT(LINEb,XPTxit_cng);
end
else begin
LINEb = $XPT_GET_LINE_DB(.ILINE);
COUNTER_INCREMENT(LINEb,XPTend_cng);
end;
TERMINATE(.CCB,CE_RTE);
end;
end;
!*********************** START OF MAIN ROUTINE ************************!
local NODEb,LINEb;
require 'XPTSYM';
local CCB: ref block field (C_XPT_fields);
map CCB_P: ref block field(C_FIELDS);
pointer PTR;
local BUFLEN,DEST,SOURCE,OLINE,ILINE,RET,ISHDR,ICPTD;
literal NO_PATH_ERROR = 39; !"No path" disconnect code
literal BAD_ROUT_HDR = 7; !Disconnect code for invalid/no RTHDR
!
! Determine and validate the input line
!
ILINE = .CCB_P[C_LIN];
LINEb = $XPT_GET_LINE_DB(.ILINE);
if ((.Nty neq TOPS20) !Input line is
and (.Nty neq PhTwo)) then begin ! not Phase II:
local RET; !
RET = MIN(19,.CCB_P[C_CNT]); !
$NM_LOG_BEGIN(); !
PARAMETER_HI(1,.RET,.CCB_P[C_ADDR]); ! log a "packet
$NM_LOG_END(4^6+$XPT$E_FMT,.NMXid); ! format error" event
TERMINATE(.CCB_P,CE_ERR); ! and toss
return; ! the packet
end;
ICPTD = 0;
if .Nty eql PhTwo then ICPTD = .ICPTD + 1; ! Not Phase II+ - flag that
!
! Spawn a CCB
!
if not CCBGT$(CCB) then !No CCB available - get rid of packet
(TOSS(.CCB_P,0,0,.ILINE); return);
CCB[C_STK] = .CCB_P; !Chain pass-through to spawned CCB
CCB[C_XPT_TYPE] = 0; !Initialize type code
CCB[C_XPT_ADJUST] = 0; ! and adjustment factor
!
! Parse the routing header
!
MAPBUF(.CCB_P,PTR); ! Map in the packet buffer
if biton (getb(PTR),2) then begin ! Routing header is present -
RET = PH2HDR (ch$plus(.PTR,-1),.ILINE, ! map to source and
SOURCE,DEST); ! destination addresses
ISHDR = TRUE; ! and indicate header is present
end
else begin !No routing header -
RET = CALL$E(INTPH2,PD_XPE, ! "intercept"
.CCB_P,0,DEST,SOURCE); ! the packet
ISHDR = FALSE; ! and indicate no header
ICPTD = 0; ! and that packet's already interceptd
end;
if .RET leq 0 then !Could not get destination -
(UNREACH(.CCB,.CCB_P,.ILINE,-.RET); return); !throw away packet
NODEb = $XPT_GET_NODE_DB(.DEST); ! Address destination data base entry
!
! Determine the output line
!
OLINE = 0;
if not .Local_node then OLINE = .OL;
LINEb = $XPT_GET_LINE_DB(.OLINE);
!
! Destination is unreachable
!
if (not .Reach
or ((.OLINE neq 0) and (.LINEstate neq RU))) then begin
LINEb = $XPT_GET_LINE_DB(.ILINE);
COUNTER_INCREMENT(LINEb,XPTxit_rcv);
UNREACH(.CCB,.CCB_P,.ILINE,$XPT$E_UNR);
return;
end;
!
! Destination is Self
!
if .OLINE eql 0 then
if .Local_node then begin
CCB[C_BIAS] = .CCB_P[C_BIAS]; !Copy buffer
CCB[C_ADDR] = .CCB_P[C_ADDR]; ! descriptor into
CCB[C_CNT] = .CCB_P[C_CNT]; ! spawned CCB
CCB[C_LIN] = .CCB_P[C_LIN]; !Put in line number
if .ISHDR then begin !If packet has a header,
RET = getb(PTR); ! pick up the destination name length
BUFLEN = 1 + 1 + .RET; ! add it into header length
PTR = ch$plus(.PTR,.RET); ! bump pointer past node name field
BUFLEN = .BUFLEN + 1+getb(PTR); ! add source name length
CCB[C_ADDR] = ch$plus(.CCB[C_ADDR],.BUFLEN);
CCB[C_CNT] = .CCB[C_CNT] - .BUFLEN;
end;
LINEb = $XPT_GET_LINE_DB(.ILINE); !Map to input line data base
COUNTER_INCREMENT(LINEb,XPTend_rcv);! Increment packets counter
if ECLFWD(.CCB, !Try to pass the buffer
.SOURCE,.DEST,0) ! to the user process
neq CS_SUC then !If Forwarding rejected the packet,
TOSS(.CCB,0,0,.ILINE) ! get rid of it
else if .ICPTD then !Otherwise, if there was
CALL$E(INTPH2,PD_XPE,.CCB_P, ! a header, intercept
1,DEST,SOURCE) ! the packet
end
else BPT(XPT$_DNS,.DEST) !Invalid "self" destination
!
! Next node in path is Phase III
!
else if ((.Nty eql Full)
or (.Nty eql Small)) then begin
LINEb = $XPT_GET_LINE_DB(.ILINE); !Address input line DB entry
RET = BLDPH3(.CCB,.ISHDR,.DEST,.SOURCE,0); !Build a Phase III header
COUNTER_INCREMENT(LINEb,XPTxit_rcv); ! Increment packets counter
LINEb = $XPT_GET_LINE_DB(.OLINE); !Address output line DB entry
RET = FORWARDER(.CCB,.OLINE); !Try to forward packet
if .RET eql CE_DIS then !If destination is unreachable,
UNREACH(.CCB,.CCB_P,.ILINE, ! perform unreachablilty code
$XPT$E_UNR) !
else if .RET neq CS_SUC then !Congestion problem -
TOSS(.CCB,.OLINE,.DEST,.ILINE) ! get rid of packet
else begin
COUNTER_INCREMENT(LINEb,XPTxit_xmt); ! Success - increment pkts ctr
if .ICPTD then ! Packet had Ph. 2 hdr:
CALL$E(INTPH2,PD_XPE,.CCB_P,1, ! intercept
DEST,SOURCE) ! packet
end
end
!
! Next node in path is Phase II
!
else if ((.Nty eql PhTwo)
or (.Nty eql TOPS20)) then begin
COUNTER_INCREMENT(LINEb,XPTxit_rcv); ! Increment packet counter
if .RET eql 2 then begin !Header is not useable:
RET = getb(PTR); ! Calculate
BUFLEN = 1 + 1 + .RET; ! the length
PTR = ch$plus(.PTR,.RET); ! of the
BUFLEN = .BUFLEN + 1 + getb(PTR); ! old header
RET = BLDPH2(.CCB,.BUFLEN,.DEST,.SOURCE,! Build a
.OLINE,.ILINE); ! new one
if .RET eql CE_RTE then begin ! Resource failure -
TOSS(.CCB,.OLINE,.DEST,.ILINE); ! reschedule
return; ! the CCB
end
else if .RET neq CS_SUC then begin ! Other failure -
UNREACH(.CCB,.CCB_P,.ILINE, ! terminate
$XPT$E_UNR); ! the packet
return; ! as unreachable
end
end
else begin !Header is useable:
CCB[C_BIAS] = .CCB_P[C_BIAS]; ! Copy buffer
CCB[C_ADDR] = .CCB_P[C_ADDR]; ! descriptor into
CCB[C_CNT] = .CCB_P[C_CNT]; ! spawned CCB
end;
LINEb = $XPT_GET_LINE_DB(.OLINE); !Address output line DB entry
if .Nid neq .DEST then !Destination not adjacent -
TOSS(.CCB,.OLINE,.DEST,.ILINE) ! get rid of message
else begin
RET = FORWARDER(.CCB,.OLINE); !Try to send packet out
if .RET eql CE_DIS then !Unreachable destination -
UNREACH(.CCB,.CCB_P,.ILINE, ! perform unreachability code
$XPT$E_UNR) !
else if .RET neq CS_SUC then !Congestion problem -
TOSS(.CCB,.OLINE,.DEST,.ILINE) ! get rid of packet
else begin !Success -
COUNTER_INCREMENT(LINEb,XPTxit_xmt);! Increment packets counter
if (.ICPTD or (.Nty eql PhTwo)) ! Packet had Ph. 2 hdr:
then CALL$E(INTPH2,PD_XPE, ! intercept
.CCB_P,1,DEST,SOURCE) ! packet
end
end
end
!
! Invalid destination node type
!
else BPT(XPT$_IANT,.Nty);
return;
end; !End of RCVPH2
routine PH2HDR (BUFPTR,ILINE,SRCAD,DESTAD) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Analyzes a Phase II routing header and returns the source and
! destination node addresses. It also makes sure that the source
! node name is the same as the adjacent node over the input line.
!
! FORMAL PARAMETERS
!
! PTR - Character pointer to routing header to analyze
! ILINE - Channel number of input line
! SRCAD - Address of location to return source address
! DESTAD - Address of location to return destination address
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE: "Success" or "failure"
! COMPLETION CODES:
!
! 1 Success; addresses returned. Header is useable.
! 2 Success; addresses returned. Header is not useable.
! - $XPT$E_UNR Failure; node is unreachable or unknown
! - $XPT$E_RNG Failure; numeric name is out of range
! - $XPT$E_FMT Failure; packet format error
!
! SIDE EFFECTS:
!
! If "failure" is returned, the source and destination address
! parameters will be set to 0.
!
!--
begin
local LINEb;
require 'XPTSYM';
pointer PTR;
local RET,LEN;
!local NTT: ref block field(NTTfields); !Addresses Node Translation Table entry
!
! Try to directly translate destination name into binary
!
.DESTAD = .SRCAD = 0; !Clear out address parameters
PTR = ch$plus(.BUFPTR,1); !Address destination name in header
LEN = getb(PTR); !Pick up destination name length
if .LEN gtru 6 or .LEN eql 0 then !Invalid dest. name length -
return (-$XPT$E_FMT); ! return an error
RET = CDTB(.PTR,.LEN); ! Call conversion routine
if .RET eql 0 or .RET gtr NN then !Invalid node number -
return (-$XPT$E_RNG) ! return an error
else if .RET gtr 0 then begin !Valid node number obtained -
.DESTAD = .RET; ! save it
RET = 2 ! and continue
end
!
! If the conversion didn't go, check our own node name
!
else if not begin
RET = 1;
.DESTAD = .Tid;
((.LEN eql .NODEname_length) and
ch$eql(.LEN,.PTR,.NODEname_length,byt$ptr(NODEname,0)))
end
!
! If that didn't work, scan node ID blocks for destination name
!
then begin
RET = 0; !Scan through
(incr I from 1 to NLN do begin ! all the lines
LINEb = $XPT_GET_LINE_DB(.I); ! which have
if ((.Nty eql PhTwo) ! adjacent Phase
or (.Nty eql TOPS20)) ! II nodes
then begin
if ((.LEN eql .Nnml) and ! Unequal name lengths disqualify
ch$eql(.LEN,.PTR,.LEN, ! Compare node names
byt$ptr(Nnm)))
then begin ! Hit:
.DESTAD = .Nid; ! map to node address
exitloop(RET=1) ! and stop search
end
end
end);
end;
%(!
! If we didn't find anything, try the Node Translate Table
!
if .RET leq 0 then begin
NTT = VECTOR[NODExlate,1]; !Address first table entry
RET = !Scan through each
(incr I from 1 to .NODExlate do ! table entry
if ch$eql(.LEN,.PTR,.LEN,NTT[NTTname])
then begin ! Hit:
.DESTAD = .NTT[NTTaddr]; ! map to address
exitloop (1) ! stop looking
end
else NTT = NTT[NTTlen]) ! Otherwise, try next entry
end;
)%
!
! Node name not found anywhere - give up
!
if .RET leq 0 then return -$XPT$E_UNR
!
! Validate source name and pick up source address
!
else begin
LINEb = $XPT_GET_LINE_DB(.ILINE); !Address line data base entry
PTR = ch$plus(.PTR,.LEN); !Skip past destination name
LEN = getb(PTR); !Pick up source node name length
if ((.LEN neq .Nnml) !Name lengths don't
or ch$neq(.LEN,.PTR,.LEN, ! match or names
byt$ptr(Nnm))) ! don't compare -
then begin ! clear out
.DESTAD = 0; ! destination address
return (-$XPT$E_FMT) ! and return an error
end
else begin !Source name is OK -
.SRCAD = .Nid; ! pick up source address
return (.RET) ! and return "success"
end
end
end; !End of PH2HDR
routine BLDPH3 (CCB,HDRFLG,DEST,SOURCE,RQR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine builds a Phase III routing header in the spawned CCB.
! All of the information for the header is passed as parameters. If
! HDRFLG is on, the buffer descriptor for the pass-through CCB will be
! adjusted to point past the Phase II routing header in the buffer.
!
! FORMAL PARAMETERS
!
! CCB - Spawned CCB for the packet for which a header is
! to be built.
! HDRFLG - If this flag is 1, the pass-through CCB will be
! adjusted to point past the Phase II routing header.
! DEST - The destination node address.
! SOURCE - The source node address.
! RQRFLG - The "Rqr" bit in the routing header flags will be set
! to this value.
!
! IMPLICIT INPUTS
!
! C_STK in the spawned CCB points to the pass-through CCB.
!
! ROUTINE VALUE: "Success" only
! COMPLETION CODES:
!
! CS_SUC - Success; routing header built.
!
! SIDE EFFECTS:
!
! The pass-through buffer descriptor may be adjusted. If
! it is, the high-order byte of C_PRM4 in the spawned CCB
! will contain the "adjustment factor" for the descriptor.
!
!--
begin
map CCB: ref block field (C_XPT_fields);
pointer PTR;
local BUFPTR,CCB_P,HDRLEN,LEN;
map CCB_P: ref block field(C_FIELDS);
!
! Set up the spawned CCB fields
!
CCB_P = .CCB[C_STK]; !Address the pass-through CCB
PTR = byt$ptr(CCB[C_PRM1],0); !Address data area in spawned CCB
CCB[C_BIAS] = 0; !Set up the buffer
CCB[C_ADDR] = .PTR; ! descriptor to point
CCB[C_CNT] = 6; ! to the data area
CCB[C_CHN] = .CCB_P; !Chain pass-through off
!
! Build the routing header
!
putb(if .RQR then 10 else 2,PTR); !Put in the routing flags
putw(.DEST,PTR); ! and the destination address
putw(.SOURCE,PTR); ! and the source address
putb(1,PTR); ! and the Visits field
!
! If specified, adjust the pass-through descriptor to
! point past the old routing header
!
if .HDRFLG then begin
MAPBUF(.CCB_P,BUFPTR,LEN); !Map in pass-through buffer
PTR = ch$plus(.BUFPTR,1); !Point to destination name field
LEN = getb(PTR); !Pick up name length
PTR = ch$plus(.PTR,.LEN); !Skip past field
HDRLEN = 1 + 1 + .LEN;
LEN = getb(PTR); !Pick up source name length
PTR = ch$plus(.PTR,.LEN); !Skip past name field
HDRLEN = .HDRLEN + 1 + .LEN;
CCB[C_XPT_ADJUST] = .HDRLEN; !Save "adjustment factor"
CCB_P[C_ADDR] = .PTR; !Adjust the buffer descriptor
CCB_P[C_CNT] = .CCB_P[C_CNT] - .HDRLEN; !for the pass-through
end;
!
! Return a "success" code
!
return (CS_SUC)
end; !End of BLDPH3
routine BLDPH2 (CCB,PT_HDR,DEST,SOURCE,OLINE,ILINE) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine builds a Phase II routing header for a data packet. The
! source node name will always be a decimal ASCII representation of the
! specified source node address. The destination node name will be the
! adjacent node over the output line.
!
! FORMAL PARAMETERS
!
! CCB Spawned CCB for the packet for which a header is to be
! built.
! PT_HDR Flag which, if non-zero, indicates that the pass-through
! buffer contains a routing header which the descriptor
! must be adjusted to point past. The value of PT_HDR is
! the number of bytes to skip over.
! DEST Destination node address
! SOURCE Source node address
! OLINE Channel number of output line
! ILINE Channel number of input line
!
! IMPLICIT INPUTS
!
! Nty, Nid
!
! ROUTINE VALUE: "Success", "unreachable destination", or "resource failure"
! COMPLETION CODES:
!
! CS_SUC Success: header built and pointed to by spawned CCB
! CE_DIS Destination is unreachable (it is not the adjacent node)
! CE_RTE Resource failure: could not get an SDB
!
! SIDE EFFECTS:
!
! The pass-through buffer descriptor may be adjusted. If it is,
! the high-order byte of C_PRM4 in the spawned CCB will contain
! the "adjustment factor" for the descriptor.
!
!--
begin
!-----------------------------------------------!
! !
! Routine to scan for a node as an !
! adjacent Phase II node and, if found, !
! convert it into a ASCII node name. !
! !
!-----------------------------------------------!
linkage CONVERT_LINKAGE = JSR (REGISTER=4,REGISTER=5);
routine CONVERT (NODE,LINE,PTRAD): CONVERT_LINKAGE =
begin
local LINEb;
require 'XPTSYM';
LINEb = $XPT_GET_LINE_DB(.LINE); ! Address circuit data base
if ((.Nty eql PhTwo) or (.Nty eql TOPS20)) ! If adjacent node is Phase
then if .Nid eql .NODE then begin ! 2 and is the right one,
putb(.Nnml,.PTRAD); ! adjacent node
.PTRAD = ch$move(.Nnml, ! name into the
byt$ptr(Nnm),..PTRAD); ! specified area,
return TRUE ! and say we hit
end;
FALSE ! No hit - say so
end;
map CCB: ref block field (C_XPT_fields);
local NODEb,LINEb;
require 'XPTSYM';
local RET,SDB_ADDR,LEN,PTRA;
local CCB_P: ref block field(C_XPT_fields);
pointer PTR;
!
! Check destination address for validity
!
LINEb = $XPT_GET_LINE_DB(.OLINE); !Address output line data base entry
if (.Nid neq .DEST) then !Destination is not adjacent over
return (CE_DIS); ! output line - return "unreachable"
!
! Get an SDB
!
if not GETBUF(15,CCB) then !Couldn't get one -
return (CE_RTE); ! return "resource failure"
CCB[C_CHN] = CCB_P = .CCB[C_STK]; !Chain the CCBs
!
! Build the header
!
MAPBUF(.CCB,SDB_ADDR,LEN); !Map in the SDB
PTR = .SDB_ADDR;
putb(PH2_RTflgs,PTR); !Put in the RTFLGS
putb(.Nnml,PTR); !Move in the destination name length
PTR = ch$move(.Nnml, !Move in the destination
byt$ptr(Nnm),.PTR); ! node name from the ID block
PTRA = ch$plus(.PTR,1); !Point to source name field
LINEb = $XPT_GET_LINE_DB(.ILINE);
NODEb = $XPT_GET_NODE_DB(.SOURCE); ! Address source node data base entry
if .SOURCE eql .Tid ! Source is local node -
then begin
putb(.NODEname_length,PTR); ! move in
PTRA = ch$move(.NODEname_length, ! the local
byt$ptr(NODEname,0),.PTRA); ! node name
end
else if not (.Phase2_node and
begin
PTRA = .PTR;
if CONVERT(.SOURCE,.ILINE,PTRA) then TRUE
else if (decr J from NLN to 1 do
(if CONVERT(.SOURCE,.J,PTRA) then exitloop(0))) eql 0
then TRUE
else FALSE
end)
then if ((.ILINE neq 0)
and ((.Nty eql PhTwo) ! Source is
or (.Nty eql TOPS20)) ! adjacent and
and (.Nid eql .SOURCE)) ! Phase II:
then begin !
putb(.Nnml,PTR); ! adjacent
PTRA = ch$move(.Nnml, ! node name
byt$ptr(Nnm),.PTRA); ! into the header
end
else begin ! Otherwise -
RET = CBTD(PTRA,.SOURCE);! translate the source address
putb(.RET,PTR); ! to ASCII and move in the
end; ! translated name length
CCB[C_CNT] = ch$diff(.PTRA,.SDB_ADDR); !Calculate length of header
!
! If requested to do so, adjust the buffer descriptor of the
! pass-through CCB to point past an old header
!
if .PT_HDR neq 0 then begin
CCB[C_XPT_ADJUST] = .PT_HDR; !Set up adjustment factor
CCB_P[C_ADDR] = ch$plus !Bump buffer address
(.CCB_P[C_ADDR],.PT_HDR); ! past Phase III header
CCB_P[C_CNT] = .CCB_P[C_CNT] - .PT_HDR; !Also adjust count
end;
!
! Return "success"
!
return (CS_SUC)
end; !End of BLDPH2
end !End of module XPTSEL
eludom