Google
 

Trailing-Edge - PDP-10 Archives - TOPS-20_V6.1_DECnetSrc_7-23-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