Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

module SCSUB (			! Session Control Subroutines
		ident = 'X01250'
		) =
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:	Session Control
!
! ABSTRACT:	Support subroutines for the MCB Session Control
!
! ENVIRONMENT:	MCB
!
! AUTHOR: 	Buren Hoffman		CREATION DATE: 24-Jun-80
!
! MODIFIED BY:
!	X01010	Changed code to use $byt_ptr macro in place of the
!		ch$ptr macro.
!	X01020	Fixed mapping problem in CONBKI.
!	X01030	Provided error recording byte pointer in CONBKI.
!	X01040	Fixed improper reference to byte value in CONBKI, and
!		corrected dot bug in FINDOB.
!	X01050	Incorporated I$OPN routine.
!	X01060	Fixed logic problems in CONBKI and CONBKO.
!	X01070	CONBKI was storing PIX in wrong location.
!	X01080	Fixed error where buffer length was not being set
!		on incoming connects.
!	X01090	Install new FINDOB routine to allow mapping of named
!		processes on incoming connects.
!	X01100	Removed old external reference to previous mapping table.
!	X01110	Fixed mapping bug in new FINDOB routine.
!	X01120	CONBKI wasn't releasing memory on error condition.
!	X01130	Fixed mapping bug in CONBKI.
!	X01140	Improved documentation, and added info on SIGNAL_STOPs
!	X01150	Bias was not being set for connect block buffer sent to user
!	X01160	Mods to support new Network Management interface.
!	X01170	Use new Comm/Exec to process linkage (.CRDAT for database)
!	X01180	Updated to use library calls, instead of requires.
!	X01190	Fixed bug in decimal to ascii conversion (CNVDA$).
!	X01200	Put routines into alphabetical order
!	X01210	Changed STKCCB to pass along user-provided chain of CCBs.
!	X01220	Cleaned up node-finding in FINDND
!	X01230	Cleanup of CNVAD$ routine
!	X01240	Optimization work
!	x01250	add range check code to FINDND
!--

!
! INCLUDE FILES:
!
library 'SCPRM';		! Our parameter and macro definitions
library 'MCB:MCBLIB';
library 'MCB:RSXLIB';
library 'MCB:XPORTX';
library 'MCB:SCSYS';

require 'NSP:NSINFO';

!
! TABLE OF CONTENTS:
!
forward routine
    CNVAD$,				! Convert ASCII to decimal
    CNVDA$: novalue,			! Convert decimal to ASCII
    CONBKI,				! Do connect data translation
    CONBKO,				! ...
    DO_RCP: linkage_ccb novalue,	! Do RCP processing
    DO_XME: linkage_ccb novalue,	! Do XME processing
    DST_SRC_I,				! Validate dest/src object descriptors
    DST_SRC_O,				!   (same, except for outgoing)
    FINDLL,				! Find available logical link
    FINDND,				! Find node address
    FINDOB,				! Find specified object type
    I$CLS: novalue,			! Close a port
    I$OPN: novalue,			! Open a port
    STKCCB: novalue,			! Stack CCBs and set C_BUF
    STSMAP;				! Map from NSP to SC status

!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
literal				! MENU word in connect message
    U_INFO = 1,			! USRID, PASSWD, and ACCNT info
    U_DATA = 2;			! Optional data

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!

global routine CNVAD$ (PTR , LEN) =

!++
! FUNCTIONAL DESCRIPTION:
!	This routine converts a decimal ASCII field to binary.
!	If a non-numeric character, other than a blank or null
!	is found, zero is returned. A blank or null terminates
!	the conversion.
!
! FORMAL PARAMETERS:
!	PTR = String pointer to the field
!	LEN = Length of the field
!
! IMPLICIT INPUTS:
!	None
!
! ROUTINE VALUE:
!	Numeric value, or zero if non-numeric
!
! COMPLETION CODES:
! SIDE EFFECTS:
!	None
!--

    begin
    local
	DIGIT, VALUE;
    register
	P;

    VALUE = 0;
    P = .PTR;

    incr I from 1 to .LEN do
	begin
	DIGIT = ch$rchar_a (P);
	if (.DIGIT eql 0) or (.DIGIT eql %c' ') then return .VALUE;
	if (.DIGIT geq %c'0') and (.DIGIT leq %c'9')
	then VALUE = (.VALUE * 10) + .DIGIT - %c'0'
	else return 0
	end;

    return .VALUE
    end;

global routine CNVDA$ (NUM, PTR): novalue =

!++
! FUNCTIONAL DESCRIPTION:
!	This routine converts a decimal integer to ASCII.
!
! FORMAL PARAMETERS:
!	NUM = Decimal positive integer
!	PTR = Address of string pointer
!
! IMPLICIT INPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin
    local
	DIGIT;

    DIGIT = (.NUM mod 10) + %c'0';
    NUM = .NUM / 10;
    if .NUM gtr 0 then CNVDA$ (.NUM, .PTR);
    ch$wchar_a (.DIGIT, .PTR)
    end;

global routine CONBKI (CCB, LCCB, LNK) =

!++
! FUNCTIONAL DESCRIPTION:
!	Process incoming connect message.
!
! FORMAL PARAMETERS:
!	CCB	CCB which owns received message
!	LCCB	CCB which owns connect block
!	LNK	Logical link block in use
!
! IMPLICIT INPUTS:
!	LLT mapped
!
! IMPLICIT OUTPUTS:
!	Connect block built in LCCB [C_BUF]
!	LNK [C_PIX] set for destination process
!
! ROUTINE VALUE:
!	True, if successful
!	False, if failure
!
! COMPLETION CODES:
!	LCCB [C_PRM1] set for error xmission
!
! SIDE EFFECTS:
!	None
!--
    begin
    $sc_get_data_base (SCDB);
    map
	CCB: ref block field (C_FIELDS),
	LCCB: ref block field (C_FIELDS),
	LNK: ref block field (LLT_FIELDS);
    local
	PTR,
	EPTR,
	ERR,
	MENU;
    bind
	CB = LCCB [C_ADDR]: ref block field (CB_FIELDS),
	NMT = SCDB [SC_NMT_ADDR]: ref blockvector [, NMT_SIZE] field (NMT_FIELDS);
    label
	CBE;

    EPTR = byt$ptr (LCCB [C_PRM1]);		! This is where to write code
    if not $MCB_GET_DSR (CB_SIZE*bytes_word, CB) ! Get connect block memory
    then
	begin					! No luck, so grouse a bit
	byt$short_string (uplit (-S_ERES), EPTR);
	return false
	end;

    LCCB [C_BIAS] = 0;
    ch$fill (0, CB_SIZE*bytes_word, .CB);		! Clear block to zeroes
    MAP$ (.SCDB [SC_NMT_BIAS]);				! Look at node mapping table
    PTR = byt$ptr (NMT [.CCB [C_PRM1], NMT_NAME]);	! Examine subject name
    if ch$rchar (.PTR) neq 0				! If a name is defined,
    then ch$move (6, .PTR, byt$ptr (CB [CB_NODE]))	!   then move it to CB
    else
	begin
	PTR = byt$ptr (CB [CB_NODE]);			! Undefined, concoct a
	CNVDA$ (.CCB [C_PRM1], PTR);			!   name from number
	ch$fill (%c' ', 6 - ch$diff (.PTR, byt$ptr (CB [CB_NODE])), .PTR)
	end;

    MAP$ (.CCB [C_BIAS]);			! Look at connect message
    PTR = .CCB [C_ADDR];			! ...

    if not (DST_SRC_I (CB [CB_DFMT], PTR) and DST_SRC_I (CB [CB_SFMT], PTR))
    then ERR = -S_EIOF
    else ERR = CBE:
	begin
	MENU = ch$rchar_a (PTR);		! Get menu byte

	if (.MENU and U_INFO) neq 0
	then
	    begin
	    if (CB [CB_RQDL] = ch$rchar_a (PTR)) gtr 16
		then leave CBE with -S_ECBE;
	    ch$move (.CB [CB_RQDL], .PTR, CB [CB_RQID]);
	    PTR = ch$plus (.PTR, .CB [CB_RQDL]);
	    if (CB [CB_PASL] = ch$rchar_a (PTR)) gtr 8
		then leave CBE with -S_ECBE;
	    ch$move (.CB [CB_PASL], .PTR, CB [CB_PASW]);
	    PTR = ch$plus (.PTR, .CB [CB_PASL]);
	    if (CB [CB_ACTL] = ch$rchar_a (PTR)) gtr 16
		then leave CBE with -S_ECBE;
	    ch$move (.CB [CB_ACTL], .PTR, CB [CB_ACNT]);
	    PTR = ch$plus (.PTR, .CB [CB_ACTL])
	    end;

	if (.MENU and U_DATA) neq 0
	then
	    begin
	    if (CB [CB_OPDL] = ch$rchar_a (PTR)) gtr 16
		then leave CBE with -S_ECBE;
	    ch$move (.CB [CB_OPDL], .PTR, CB [CB_OPTD]);
	    PTR = ch$plus (.PTR, .CB [CB_OPDL])
	    end;

	S_SSUC
	end;

    MAP$ (.SCDB [SC_LLT_BIAS]);			! Back to original mapping

    if .ERR eql S_SSUC
    then
	begin
	local
	    PIX;
	if not FINDOB (CB [CB_DFMT], PIX)
	then ERR = -S_EURO else LNK [L_PIX] = .PIX
	end;

    byt$short_string (ERR, EPTR);		! Record the error code

    if .ERR eql S_SSUC
    then
	begin
	LCCB [C_CNT] = CB_SIZE*bytes_word;	! Set connect block length
	return true
	end
    else
	begin
	$MCB_RETURN_DSR (CB_SIZE*bytes_word, .CB);
	return false
	end
    end;

global routine CONBKO (CCB, LCCB) =

!++
! FUNCTIONAL DESCRIPTION:
!	Translates connect block to protocol form, in buffer
!
! FORMAL PARAMETERS:
!	CCB	CCB which owns connect block
!	LCCB	CCB which owns xmit buffer
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	Connect message built in LCCB [C_BUF]
!
! ROUTINE VALUE:
!	True, if successful
!	False, if failure
!
! COMPLETION CODES:
!	CCB [C_STS] set for error
!
! SIDE EFFECTS:
!	None
!--
    begin
    $sc_get_data_base (SCDB);
    map CCB: ref block field (C_FIELDS),
	LCCB: ref block field (C_FIELDS);
    local
	PTR,				! Dest buffer pointer
	MENU,				! Message word to construct
	CB: ref block field (CB_FIELDS),! The connect block
	SAV_MAP;
    label CB_PARSE;

    if not $MCB_GET_DSR (CB_SIZE*bytes_word, CB) ! Memory to copy connect block
    then
	begin
	CCB [C_STS] = S_ERES;		! Not enuf memory !!
	return false
	end;

    SMAP$ (SAV_MAP);			! Save current mapping
    MAP$ (.CCB [C_BIAS]);		! Map to user connect block and copy it
    ch$move (CB_SIZE*bytes_word, .CCB [C_ADDR], byt$ptr (.CB));
    MAP$ (.LCCB [C_BIAS]);		! Map to connect message buffer
    PTR = .LCCB [C_ADDR];		! Point to buffer

    CCB [C_STS] = CB_PARSE:
	begin

	! Check destination & source specs, and copy to msg buffer
	if not (DST_SRC_O(CB [CB_DFMT], PTR) and DST_SRC_O(CB [CB_SFMT], PTR))
	then leave CB_PARSE with S_EIOF;

	MENU = 0;			! See what rest of message contains
	if .CB [CB_RQDL] neq 0 then MENU = U_INFO;		! We have ID
	if .CB [CB_OPDL] neq 0 then MENU = .MENU or U_DATA;	!  and data
	ch$wchar_a (.MENU, PTR);				! Write menu

	if (.MENU and U_INFO) neq 0
	then
	    begin
	    ch$wchar_a (.CB [CB_RQDL], PTR);
	    PTR = ch$move (.CB [CB_RQDL], byt$ptr (CB [CB_RQID]), .PTR);
	    ch$wchar_a (.CB [CB_PASL], PTR);
	    PTR = ch$move (.CB [CB_PASL], byt$ptr (CB [CB_PASW]), .PTR);
	    ch$wchar_a (.CB [CB_ACTL], PTR);
	    PTR = ch$move (.CB [CB_ACTL], byt$ptr (CB [CB_ACNT]), .PTR)
	    end;

	if (.MENU and U_DATA) neq 0
	then
	    begin
	    ch$wchar_a (.CB [CB_OPDL], PTR);
	    PTR = ch$move (.CB [CB_OPDL], byt$ptr (CB [CB_OPTD]), .PTR)
	    end;

	LCCB [C_CNT] = ch$diff (.PTR, .LCCB [C_ADDR]);
	S_SSUC
	end;

    $MCB_RETURN_DSR (CB_SIZE*bytes_word, .CB);	! Recover memory
    MAP$ (.SAV_MAP);				! Finally restore mapping

    if .CCB [C_STS] geq 0
    then return true
    else return false
    end;

global routine DO_RCP (CCB, MODIFIER, LNK): linkage_ccb novalue =

!++
! FUNCTIONAL DESCRIPTION:
!	Do RCP processing
!
! FORMAL PARAMETERS:
!	CCB	CCB address
!	MODIFIER RCP modifier
!	LNK	LNK address
!
! IMPLICIT INPUTS:
!	LLT mapped
!
! IMPLICIT OUTPUTS:
!	CCB scheduled
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--
    begin
    $sc_get_data_base (SCDB);
    map CCB: ref block field (C_FIELDS),
	LNK: ref block field (LLT_FIELDS);

    CCB [C_FNC] = FC_RCP;
    CCB [C_MOD] = .MODIFIER;
    CCB [C_PIX] = .LNK [L_PIX];
    CCB [C_LIX] = .LNK [L_LLA];
    CCB [$sub_field (C_PRM1, LO_BYTE)] = .LNK [L_ULA];
    $MCB_SCHEDULE_CCB (.CCB)
    end;

global routine DO_XME (CCB, MODIFIER, LNK): linkage_ccb novalue =

!++
! FUNCTIONAL DESCRIPTION:
!	Do XME processing
!
! FORMAL PARAMETERS:
!	CCB	CCB address
!	MODIFIER RCP modifier
!	LNK	LNK address
!
! IMPLICIT INPUTS:
!	LLT mapped
!
! IMPLICIT OUTPUTS:
!	CCB scheduled
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--
    begin
    $sc_get_data_base (SCDB);
    map CCB: ref block field (C_FIELDS),
	LNK: ref block field (LLT_FIELDS);

    CCB [C_FNC] = FC_XME;
    CCB [C_MOD] = .MODIFIER;
    CCB [C_PIX] = .SCDB [SC_NSPIX];
    CCB [C_LIX] = .LNK [L_PID];
    $MCB_SCHEDULE_CCB (.CCB)
    end;

global routine DST_SRC_I (BLK, PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!	This routine transcribes source and destination
!	specifications from the message indicated by PTR
!	to the connect block segment identified by BLK.
!	The descriptors are also validated for correct format.
!
! FORMAL PARAMETERS:
!	BLK	DST/SRC block address
!	PTR	Buffer pointer address
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	PTR is updated
!
! ROUTINE VALUE:
!	True is success, else False
!
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--

    begin
    map BLK: ref block field (CBSD_FIELDS);
    bind
	P = .PTR;

    BLK [CB_FMT] = ch$rchar_a (P);		! Get Format Code
    BLK [CB_OBJ] = ch$rchar_a (P);		! Get Object Type

    case .BLK [CB_FMT] from 0 to 2 of
	set

	[0]:
	    if .BLK [CB_OBJ] eql 0
	    then return false;

	[1]:
	    begin
	    if	(.BLK [CB_OBJ] neq 0) or
		((BLK [CB_LEN] = ch$rchar_a (P)) eql 0) or
		(.BLK [CB_LEN] gtr 16)
	    then
		return false
	    else
		begin
		ch$move (.BLK [CB_LEN], .P, byt$ptr (BLK [CB_NAM]));
		P = ch$plus (.P, .BLK [CB_LEN])
		end
	    end;

	[2]:
	    begin
	    if .BLK [CB_OBJ] neq 0 then return false;
	    ch$move (4, .P, byt$ptr (BLK [CB_GRP]));
	    P = ch$plus (.P, 4);
	    if ((BLK [CB_LN2] = ch$rchar_a (P)) eql 0) or
		(.BLK [CB_LN2] gtr 12)
	    then return false;
	    ch$move (.BLK [CB_LN2], .P, byt$ptr (BLK [CB_NM2]));
	    P = ch$plus (.P, .BLK [CB_LN2])
	    end;

	[inrange, outrange]:
	    return false;

	tes;

    return true
    end;

routine DST_SRC_O (BLK, PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!	This routine validates the destination or source object
!	specification in a connect block, and copies it to the
!	buffer.
!
! FORMAL PARAMETERS:
!	BLK	DST/SRC block address
!	PTR	Buffer pointer address
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	PTR is updated
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	True is success, else False
!
! SIDE EFFECTS:
!	None
!--
    begin
    map BLK: ref block field (CBSD_FIELDS);
    local
	LEN,
	DAT;
    bind
	P = .PTR;

    ch$wchar_a (.BLK [CB_FMT], P);
    ch$wchar_a (.BLK [CB_OBJ], P);

    case .BLK [CB_FMT] from 0 to 2 of
	set

	[0]:
	    if .BLK [CB_OBJ] eql 0
	    then return false
	    else return true;

	[1]:
	    begin
	    if (.BLK [CB_OBJ] neq 0) or (.BLK [CB_LEN] eql 0)
	    then return false;
	    LEN = .BLK [CB_LEN];
	    DAT = BLK [CB_NAM]
	    end;

	[2]:
	    begin
	    if .BLK [CB_OBJ] neq 0 then return false;
	    P = ch$move (4, byt$ptr (BLK [CB_DES]), .P);
	    LEN = .BLK [CB_LN2];
	    DAT = BLK [CB_NM2]
	    end;

	[inrange, outrange]:
	    return false;

	tes;

    P = ch$move (1, byt$ptr (LEN), .P);
    P = ch$move (.LEN, byt$ptr (.DAT), .P);
    return true
    end;

global routine FINDLL (LL) =

!++
! FUNCTIONAL DESCRIPTION:
!	Locate an available logical link, and return its index
!	in LL.
!
! FORMAL PARAMETERS:
!	LL	Word to receive logical link index
!
! IMPLICIT INPUTS:
!	LLT mapped
!
! IMPLICIT OUTPUTS:
!	LL block is initialized
!
! ROUTINE VALUE:
!	true = logical link found
!	false = logical link not found
!
! SIDE EFFECTS:
!	None
!--
    begin
    $sc_get_data_base (SCDB);
    bind
	LLT = SCDB [SC_LLT_ADDR]: ref blockvector [,L_SIZE] field (LLT_FIELDS);

    .LL =
	begin
	incr L from 0 to .SCDB [SC_LINKS]-1 do
	    begin
	    bind
		LNK = LLT [.L, L_TOP]: block field (LLT_FIELDS);

	    if (.LNK [L_STATE] eql ST_OFF) and (.LNK [L_FLAGS] eql 0)
	    then
		begin
		ch$fill (0, L_SIZE*bytes_word, byt$ptr (LNK));
		LNK [L_FLAGS] = 0;
		LNK [L_I_TAIL] = LNK [L_I_HEAD];
		LNK [L_O_TAIL] = LNK [L_O_HEAD];
		LNK [L_N_TAIL] = LNK [L_N_HEAD];
		LNK [L_LLA] = .L;
		exitloop .L
		end
	    end
	end;

    if ..LL eql -1
    then false
    else true
    end;

global routine FINDND (CCB, LNK) =

!++
! FUNCTIONAL DESCRIPTION:
!	Determine address of node specified in connect block.
!
! FORMAL PARAMETERS:
!	CCB	CCB pointing to connect block
!	LNK	Link block address
!
! IMPLICIT INPUTS:
!	LLT mapped
!
! IMPLICIT OUTPUTS:
!	LNK [L_RNA] = remote node address
!	LNK [L_CHN] = channel #
!
! ROUTINE VALUE:
!	true = Node address determined
!	false = Node address not determined
!
! SIDE EFFECTS:
!	None
!--
    begin
    $sc_get_data_base (SCDB);
    map
	CCB: ref block field (C_FIELDS),
	LNK: ref block field (LLT_FIELDS);
    local
	REMOTE_NODE_ADDR,
	CHANNEL_NUMBER,
	CH,
	LEN,
	PTR,
	NODE: vector [byt$allocation (6)];
    bind
	NMT = SCDB [SC_NMT_ADDR]: ref blockvector [ , NMT_SIZE] field (NMT_FIELDS);

    MFBF$S (6, .CCB [C_BIAS], .CCB [C_ADDR], byt$ptr (NODE));

    PTR = byt$ptr (NODE);
    LEN = 0;					! Calc length of name
    incr I from 1 to 6 do
	if (CH = ch$rchar_a (PTR)) eql %c' ' or .CH eql 0
	then exitloop
	else LEN = .LEN + 1;

    LNK [L_CHN] = 0;				! Assume not loopnode
    if (LNK [L_RNA] = CNVAD$ (byt$ptr (NODE), .LEN)) neq 0
	then if (.LNK[L_RNA] gtru .SCDB[SC_NODES])
		then return false
		else return true;

    PTR = byt$ptr (NODE);
    incr I from 1 to 6 do			! Do the shift to uppercase
	begin
	if (CH = ch$rchar (.PTR)) geq %c'a' and .CH leq %c'z'
	then CH = .CH - (%c'a' - %c'A');
	ch$wchar_a (.CH, PTR)
	end;

    if .LEN eql 0
    then
	begin
	LNK [L_RNA] = .SCDB [SC_LADDR];
	return true
	end;

    MAP$ (.SCDB [SC_NMT_BIAS]);
    REMOTE_NODE_ADDR = CHANNEL_NUMBER = 0;

    incr N from 0 to .SCDB [SC_NODES] + .SCDB [SC_LOOPS] - 1 do
	begin
	if ch$eql (.LEN, byt$ptr (NODE), .NMT [.N, NMT_NAML], byt$ptr (NMT [.N, NMT_NAME]), 0)
	then
	    begin
	    if .N lss .SCDB [SC_NODES]
	    then
		REMOTE_NODE_ADDR = .NMT [.N, NMT_ADDR]
	    else
		CHANNEL_NUMBER = .NMT [.N, NMT_CHAN];
	    exitloop
	    end
	end;

    MAP$ (.SCDB [SC_LLT_BIAS]);
    LNK [L_RNA] = .REMOTE_NODE_ADDR;
    LNK [L_CHN] = .CHANNEL_NUMBER;
    if (.REMOTE_NODE_ADDR + .CHANNEL_NUMBER) neq 0 then return true else false
    end;

routine FINDOB (DST, PIX) =

!++
! FUNCTIONAL DESCRIPTION:
!	Locate object type, and return process index
!
! FORMAL PARAMETERS:
!	DST	Destination portion of connect block
!	PIX	Place to return process index
!
! IMPLICIT INPUTS:
!	Connect block format checking already performed.
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
!	True if object found
!	False if object not found
!
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--
    begin
    $sc_get_data_base (SCDB);
    map DST: ref block field (CBSD_FIELDS);
    local
	SAV_MAP,
	PROC_NAM,
	NAM_LEN,
	NAM_PTR,
	NAME: vector [byt$allocation (6)];
    bind
	OTN = SCDB [SC_OTN_ADDR]: ref blockvector [,OTN_SIZE] field (OTN_FIELDS),
	ONP = SCDB [SC_ONP_ADDR]: ref blockvector [,ONP_SIZE] field (ONP_FIELDS);

    SMAP$ (SAV_MAP);
    case .DST [CB_FMT] from 0 to 2 of
	set

	[0]:			! Format 0
	    begin
	    MAP$ (.SCDB [SC_OTN_BIAS]);		! Set to object table map
	    NAM_LEN = 0;			! Be pessimistic
	    incr I from 0 to .SCDB [SC_OTN_LEN]-1 do
		begin
		if .DST [CB_OBJ] eql .OTN [.I, OTN_TYPE]
		then
		    begin
		    NAM_PTR = byt$ptr (NAME);	! Copy name to local store
		    ch$move (6, byt$ptr (OTN [.I, OTN_NAME]), .NAM_PTR);
		    NAM_LEN = .OTN [.I, OTN_NLEN];
		    exitloop
		    end
		end;

	    if .NAM_LEN eql 0
	    then
		begin
		MAP$ (.SAV_MAP);		! Restore mapping
		return false			!   and bomb
		end
	    end;

	[1]:			! Format 1
	    begin
	    NAM_PTR = byt$ptr (DST [CB_NAM]);
	    NAM_LEN = .DST [CB_LEN]
	    end;

	[2]:			! Format 2
	    begin
	    NAM_PTR = byt$ptr (DST [CB_NM2]);
	    NAM_LEN = .DST [CB_LN2]
	    end;
	tes;

    MAP$ (.SCDB [SC_ONP_BIAS]);		! Now look at object-to-process table
    PROC_NAM = 0;			! Again, be a pessimist

    incr I from 0 to .SCDB [SC_ONP_LEN]-1 do
	begin
	if ch$eql (.NAM_LEN, .NAM_PTR, .ONP [.I, ONP_NLEN], byt$ptr (ONP [.I, ONP_NAME]), %c'.')
	then
	    begin
	    PROC_NAM = .ONP [.I, ONP_PROC];	! Set selected process name
	    exitloop
	    end
	end;

    MAP$ (.SAV_MAP);				! Restore mapping
    if .PROC_NAM eql 0 then PROC_NAM =		! Default to SCX
	%if %bliss (bliss36) %then %rad50_10 'SCX' %else %rad50_11 'SCX' %fi;
    PDVID$ (.PROC_NAM, .PIX)			! Locate the PIX
    end;

global routine I$CLS (LNK): novalue =

!++
! FUNCTIONAL DESCRIPTION:
!	Issue a close on the specified link to NSP.
!
! FORMAL PARAMETERS:
!	LNK	Link data base address
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--
    begin
    $sc_get_data_base (SCDB);
    map LNK: ref block field (LLT_FIELDS);
    local
	CCB: ref block field (C_FIELDS);

    if .LNK [L_STATE] eql ST_CLI then return;	! If close started, then return
    LNK [LL_CLSI] = true;			! Ok, we are fixing to start
    if CCBGT$ (CCB)
    then
	begin
	$SC_DO_XME (.CCB, N_PCLS, .LNK);
	LNK [L_STATE] = ST_CLI			! Now we've done it
	end
    else
	begin
	LNK [LL_KLOK] = true;			! Request clock service
	LNK [L_TIMER] = 1;			! ...
	SCDB [SCF_KLOK] = true			! ...
	end
    end;

global routine I$OPN: novalue =

!++
! FUNCTIONAL DESCRIPTION:
!	Open an NSP port if one is needed.
!
! FORMAL PARAMETERS:
!	None
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--
    begin
    $sc_get_data_base (SCDB);
    local
	LL,
	SAV_MAP,
	CCB: ref block field (C_FIELDS);
    bind
	LLT = SCDB [SC_LLT_ADDR]: ref blockvector [,L_SIZE] field (LLT_FIELDS);

    if (not .SCDB [SCF_OPEN]) and (.SCDB [SC_IPORT] lss .SCDB [SC_RPORT])
    then
	begin
	if not CCBGT$ (CCB) then return;
	SMAP$ (SAV_MAP);
	MAP$ (.SCDB [SC_LLT_BIAS]);
	if FINDLL (LL)
	then
	    begin
	    bind
		LNK = LLT [.LL, L_TOP]: block field (LLT_FIELDS);

	    CCB [C_PRM1] = LLT [.LL, L_TOP];
	    $SC_DO_XME (.CCB, N_POPN, LNK [L_TOP]);
	    LNK [LL_BUSY] = true;
	    LNK [L_STATE] = ST_OI;
	    SCDB [SCF_OPEN] = true
	    end
	else
	    CCBRT$ (.CCB);

	MAP$ (.SAV_MAP)
	end
    end;

global routine STKCCB (NCCB, OCCB): novalue =

!++
! FUNCTIONAL DESCRIPTION:
!	Performs stacking of NCCB onto OCCB, and transfers
!	buffer pointers.
!
! FORMAL PARAMETERS:
!	NCCB	New top-level CCB
!	OCCB	Old instigator CCB
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--
    begin
    map
	NCCB: ref block field (C_FIELDS),
	OCCB: ref block field (C_FIELDS);

    NCCB [C_STK] = .OCCB;		! Point to originator CCB
    NCCB [C_CHN] = .OCCB [C_CHN];	! Copy chain info
    NCCB [C_BIAS] = .OCCB [C_BIAS];	! Copy buffer info
    NCCB [C_ADDR] = .OCCB [C_ADDR];	! ...
    NCCB [C_CNT] = .OCCB [C_CNT]	! ...
    end;

global routine STSMAP (CODE) =

!++
! FUNCTIONAL DESCRIPTION:
!	Map from NSP error code to SC error code
!
! FORMAL PARAMETERS:
!	CODE	The NSP error code
!
! IMPLICIT INPUTS:
!	None
!
! IMPLICIT OUTPUTS:
!	None
!
! ROUTINE VALUE:
!	SC code value
!
! COMPLETION CODES:
!	None
!
! SIDE EFFECTS:
!	None
!--
    begin
    macro
	C (NSP_CODE, SC_CODE) = ((NSP_CODE - N$LO)^1, SC_CODE) %;
    bind
	STATUS_MAP = TABLE$ (S_EERR, (N$HI - N$LO)^1,
	    C (N$SSUC, S_SSUC),
	    C (N$SACC, S_SSUC),
	    C (N$SREJ, S_ERBO),
	    C (N$ERES, S_ERES),
	    C (N$ECON, S_ENUR),
	    C (N$ESTE, S_EERR),
	    C (N$EOPN, S_ERES),
	    C (N$EABR, S_EABS),
	    C (N$ETMI, S_EERR),
	    C (N$ERMO, S_EIDM),
	    C (N$ELST, S_ELST),
	    C (N$EMTL, S_EMTL),
	    C (N$ECLS, S_EABL),
	    C (N$EABL, S_EABO),
	    C (N$ENUR, S_ENUR)): vector;

    .STATUS_MAP [.CODE - N$LO]
    end;

end
eludom