Google
 

Trailing-Edge - PDP-10 Archives - bb-lw55a-bm - language-sources/blissnet.req
There are 21 other files named blissnet.req in the archive. Click here to see a list.
!  COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1980, 1986.
!  ALL RIGHTS RESERVED.
!  
!  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 THAT IS NOT SUPPLIED BY DIGITAL.

!++
! FACILITY:
!   Transportable BLISS Interface to DECnet
!
! ABSTRACT:
!   This file is the source for the LIBRARY file for the BLISS/DECnet interface.
!   It contains the macros and field definitions that the user program calls to
!   use the interface.
!
! ENVIRONMENT:
!   This file must be used in conjunction with XPORT.  The macros herein make
!   extensive use of XPORT user and internal macros.
!
! AUTHOR: Paul S. Winalski, CREATION DATE: 14 July 1980
!
! MODIFIED BY:
!
!   Larry Campbell, Dec. 81 through Aug 82
!
! 02  - Process FORMAT keyword for passive open
! 01  - various modifications found necessary during TOPS-20 implementation
!--

LIBRARY 'BLI:XPORT';

COMPILETIME
    $xpn$key_ok = 0;
    
!------------------------------------------------------------------------
!
! Object Type Literals
!

LITERAL
    XPN$K_TASK		= 0,	! User task
    XPN$K_FAL_V1	= 1,	! File Access Listener (FAL/DAP version 1)
    XPN$K_URDS		= 2,	! Unit Record Services (URDS)
    XPN$K_ATS		= 3,	! Application Terminal Services (ATS)
    XPN$K_CTS		= 4,	! Command Terminal Services (CTS)
    XPN$K_RSX_V1	= 5,	! RSX-11M Task Control - version 1
    XPN$K_OPERATOR	= 6,	! Operator Services Interface
    XPN$K_MANAGER	= 7,	! Node Resource Manager
    XPN$K_IBM_3270	= 8,	! IBM 3270-BSC Gateway
    XPN$K_IBM_2780	= 9,	! IBM 2780-BSC Gateway
    XPN$K_IBM_3790	= 10,	! IBM 3790-SDLC Gateway
    XPN$K_TPS		= 11,	! TPS Application
    XPN$K_DIBOL		= 12,	! RT-11 DIBOL Application
    XPN$K_TOPS20_TH	= 13,	! TOPS-20 Terminal Handler
    XPN$K_TOPS20_RS	= 14,	! TOPS-20 Remote Spooler
    XPN$K_RSX_V2	= 15,	! RSX-11M Task Control - version 2
    XPN$K_TLK		= 16,	! TLK Utility
    XPN$K_FAL_V4	= 17,	! File Access Listener (FAL/DAP version 4)
    XPN$K_HLD		= 18,	! RSX-11S Remote Task Loader
    XPN$K_NICE		= 19,	! NICE Process
    XPN$K_NML		= 19,	! Network Management Listener
    XPN$K_NETCPY	= 20,	! RSTS/E media transfer program
    XPN$K_DECMAIL	= 22,	! DECmail Message Router
    XPN$K_REMACP	= 23,	! Remote terminal handler, host side
    XPN$K_REMTERM	= 24,	! Remote terminal handler, terminal side
    XPN$K_MIRROR	= 25,	! Network Loopback Mirror
    XPN$K_EVL		= 26,	! Network Event Listener
    XPN$K_KMAIL		= 27,	! VMS MAIL facility
    XPN$K_X25		= 31,	! X.25 Gateway
    XPN$K_TEST		= 63,	! DECnet RSX Test Tool
    XPN$K_DTR		= 63,	! DECnet Test Receiver object

!*** Temporary or experimental object types

    XPN$K_PASS_THROUGH  =123,   ! Pass-through ("Poor man's routing")
    XPN$K_MAIL20        =201,   ! TOPS-20 mail server
    XPN$K_MS_NAME_SRV   =209    ! Name server for DECmail/MS

    ;

!------------------------------------------------------------------------
!
! Disconnect Reason Codes
!

LITERAL
    XPN$K_NORMAL	= 0,	! No error
    XPN$K_ALLOCFAIL	= 1,	! Resource allocation failure
    XPN$K_NOSUCHNODE	= 2,	! Destination node does not exist
    XPN$K_SHUTDOWN	= 3,	! Node shutting down
    XPN$K_NOPROC	= 4,	! Destination process does not exist
    XPN$K_BADPROC	= 5,	! Invalid process name field
    XPN$K_QOVERFLOW	= 6,	! Destination process queue overflow
    XPN$K_UNSPEC	= 7,	! Unspecified error condition
    XPN$K_THIRD		= 8,	! Third party aborted the logical link
    XPN$K_USER		= 9,	! Link aborted by user process
    XPN$K_FLOWCTL	= 24,	! Flow control violation (illegal FCVAL in link services message)
    XPN$K_NOCON		= 32,	! Too many connections to node
    XPN$K_NOPROCCON	= 33,	! Too many connections to destination process
    XPN$K_NOACCESS	= 34,	! Access not permitted; unacceptable ID or password
    XPN$K_BADSERV	= 35,	! Logical link SERVICES mismatch
    XPN$K_NOACCOUNT	= 36,	! Unacceptable account information
    XPN$K_BADSEG	= 37,	! SEGSIZE too small
    XPN$K_EXIT		= 38,	! Dialogue process aborted, timed out, or canceled request
    XPN$K_NOPATH	= 39,	! No path to destination node
    XPN$K_FLOWFAIL	= 40,	! Flow control failure
    XPN$K_NOLINK	= 41,	! Destination logical link does not exist
    XPN$K_CONFIRM	= 42,	! Confirmation of disconnect initiate message
    XPN$K_TOOLONG	= 43,	! Image data field too long
    XPN$K_INTERFACE	= 255	! BLISS/DECnet interface error
    ;

!------------------------------------------------------------------------
!
! Function Code literals
!

$LITERAL
    XPN$K_OPEN		= $DISTINCT,		! OPEN
    XPN$K_EVENT		= $DISTINCT,		! EVENT_INFO
    XPN$K_PUT		= $DISTINCT,		! PUT
    XPN$K_GET		= $DISTINCT,		! GET
    XPN$K_DISCONNECT	= $DISTINCT,		! DISCONNECT
    XPN$K_CLOSE		= $DISTINCT;		! CLOSE
    
!------------------------------------------------------------------------
!
! BLISS/DECnet Network Link Block 
!
    
! NLB
    
$FIELD $xpn$nlb_fields = SET
    NLB$H_LENGTH	= [$SHORT_INTEGER],	! Length of NLB
    NLB$B_LEVEL		= [$BYTE],		! BLISSNET change level number
    NLB$B_VERSION	= [$BYTE],		! BLISSNET version number
    NLB$B_FUNCTION	= [$BYTE],		! Network function code
    NLB$B_SUBFUNC	= [$BYTE],		! Subfunction code
    NLB$V_MODIFIERS	= [$BITS(8)],		! Function modifiers
	$OVERLAY( NLB$V_MODIFIERS )		!
    NLB$V_WAIT		= [$BIT],		!     wait for completion
    NLB$V_IRPT_ENAB	= [$BIT],		!     enable interrupts
    NLB$V_DATA_REQ	= [$BIT],		!     request data
    NLB$V_END_MSG	= [$BIT],		!     set EOM flag in segment
    NLB$V_STRING	= [$BIT],		!     get string message
    NLB$V_ABORTALL	= [$BIT],		!     abort all links
    NLB$V_REMEMBER	= [$BIT],		!     remember connect info on close
    NLB$V_PMR           = [$BIT],               !     poor-man's routing allowed
	$CONTINUE
    
    NLB$B_TIMEOUT	= [$BYTE],		! Timeout value in seconds
    NLB$V_STATUS	= [$BITS(16)],		! Interface status:
	$OVERLAY( NLB$V_STATUS )		!
    NLB$V_PASSIVE	= [$BIT],		!     link is passive
    NLB$V_ACTIVE	= [$BIT],		!     link is active
    NLB$V_FIRST_SEG	= [$BIT],		!     segment is first segment
    NLB$V_LAST_SEG	= [$BIT],		!     segment is last segment
    NLB$V_CONN_REQ	= [$BIT],		!     connect request pending
    NLB$V_ABORTED	= [$BIT],		!     abort notification pending
    NLB$V_DISCONNECTED  = [$BIT],               !     link has been disconnected
    NLB$V_IRPT_MSG	= [$BIT],		!     interrupt message pending
    NLB$V_LINK_MSG      = [$BIT],               !     link service msg penging
    NLB$V_DATA_MSG	= [$BIT],		!     data message pending
    NLB$V_DISC_MSG	= [$BIT],		!     disconnect message pending
    NLB$V_COMPLETED	= [$BIT],		!     previous I/O operation completed
    NLB$V_OPEN		= [$BIT],		!     link is open
    NLB$V_CONNECTED	= [$BIT],		!     link is connected
    NLB$V_WORKING	= [$BIT],		!     interface is busy
    NLB$V_SHUTDOWN	= [$BIT],		!     link is being shut down
	$CONTINUE
    
    NLB$B_MAX_LINKS	= [$BYTE],		! max. number of passive links
    NLB$B_MAX_MSGS	= [$BYTE],		! max. number queued unread msgs
    NLB$H_MAX_BSPACE	= [$SHORT_INTEGER],	! max. system buffer space
    NLB$H_RECEIVE_MAX	= [$SHORT_INTEGER],	! max. segment/message size
    NLB$B_LCL_FORMAT	= [$BYTE],		! local object descriptor format
    NLB$B_LCL_OBJTYP	= [$BYTE],		! local object type
    NLB$B_REM_FORMAT	= [$BYTE],		! remote object descriptor format
    NLB$B_REM_OBJTYP	= [$BYTE],		! remote object type
    NLB$H_LCL_USER	= [$SHORT_INTEGER],	! local user code
    NLB$H_LCL_GROUP	= [$SHORT_INTEGER],	! local group code
    NLB$A_LCL_DESCR	= [$REF_DESCRIPTOR],	! local object descriptor address
    NLB$A_NODE_NAME	= [$REF_DESCRIPTOR],	! node name descriptor address
    NLB$A_REM_DESCR	= [$REF_DESCRIPTOR],	! remote object descriptor address
    NLB$A_USER_ID	= [$REF_DESCRIPTOR],	! connect user ID descriptor address
    NLB$A_PASSWORD	= [$REF_DESCRIPTOR],	! connect password descriptor address
    NLB$A_ACCOUNT	= [$REF_DESCRIPTOR],	! connect accounting info descriptor address
    NLB$A_OPTIONAL	= [$REF_DESCRIPTOR],	! optional connect data descriptor
    NLB$H_REM_USER	= [$SHORT_INTEGER],	! remote user code
    NLB$H_REM_GROUP	= [$SHORT_INTEGER],	! remote group code
    NLB$T_STRING	= [$DESCRIPTOR(DYNAMIC)],	! input data message
	$OVERLAY( $SUB_FIELD(NLB$T_STRING,STR$H_LENGTH) )
    NLB$H_STRING	= [$SHORT_INTEGER],	!     length
	$OVERLAY( $SUB_FIELD(NLB$T_STRING,STR$A_POINTER) )
    NLB$A_STRING	= [$POINTER],		!     pointer
	$OVERLAY( NLB$T_STRING )
    NLB$T_DATA		= [$DESCRIPTOR(DYNAMIC)],	! input data message
	$OVERLAY( $SUB_FIELD(NLB$T_DATA,XPO$H_LENGTH) )
    NLB$H_UNITS		= [$SHORT_INTEGER],	!     length
	$OVERLAY( $SUB_FIELD(NLB$T_DATA,XPO$A_ADDRESS) )
    NLB$A_DATA		= [$ADDRESS],		!     address
	$CONTINUE
    
    NLB$H_REQ_SIZE	= [$SHORT_INTEGER],	! input data request size
    NLB$V_VALIDITY	= [$BITS(16)],		! field validity bits:
	$OVERLAY( NLB$V_VALIDITY )		!
    NLB$V_REM_OBJTYP	= [$BIT],		!     remote object type
    NLB$V_REM_FORMAT	= [$BIT],		!     remote format
    NLB$V_REM_GROUP	= [$BIT],		!     remote group code
    NLB$V_REM_USER	= [$BIT],		!     remote user code
    NLB$V_LCL_OBJTYP	= [$BIT],		!     local object type
    NLB$V_LCL_FORMAT	= [$BIT],		!     local format
    NLB$V_LCL_GROUP	= [$BIT],		!     local group code
    NLB$V_LCL_USER	= [$BIT],		!     local user code
    NLB$V_LS_INFO	= [$BIT],		!     link status information
	$CONTINUE
    
    NLB$T_INTERRUPT	= [$DESCRIPTOR(DYNAMIC)],	! interrupt message
	$OVERLAY( $SUB_FIELD(NLB$T_INTERRUPT,STR$H_LENGTH) )
    NLB$H_INTERRUPT	= [$SHORT_INTEGER],	!     length
	$OVERLAY( $SUB_FIELD(NLB$T_INTERRUPT,STR$B_DTYPE) )
    NLB$B_INT_DTYPE	= [$BYTE],		!     data type
	$OVERLAY( $SUB_FIELD(NLB$T_INTERRUPT,STR$A_POINTER) )
    NLB$A_INTERRUPT	= [$POINTER],		!     pointer
	$CONTINUE
    
    NLB$T_DISCONNECT	= [$DESCRIPTOR(DYNAMIC)],	! disconnect message
	$OVERLAY( $SUB_FIELD(NLB$T_DISCONNECT,STR$H_LENGTH) )
    NLB$H_DISCONNECT	= [$SHORT_INTEGER],	!     length
	$OVERLAY( $SUB_FIELD(NLB$T_DISCONNECT,STR$B_DTYPE) )
    NLB$B_DISC_DTYPE	= [$BYTE],		!     data type
	$OVERLAY( $SUB_FIELD(NLB$T_DISCONNECT,STR$A_POINTER) )
    NLB$A_DISCONNECT	= [$POINTER],		!     pointer
	$CONTINUE
    
    NLB$A_OUTPUT	= [$REF_DESCRIPTOR],	! address of output msg descr.
    NLB$Z_USER		= [$INTEGER],		! user value
    NLB$G_DISC_CODE	= [$INTEGER],		! disconnect reason code
    NLB$G_LCL_DISC	= [$INTEGER],		! local disconnect reason code
    NLB$G_COMP_CODE	= [$INTEGER],		! primary completion code
    NLB$G_2ND_CODE	= [$INTEGER],		! secondary completion code
    NLB$V_LINKSTAT	= [$BITS(8)],		! link status information:
	$OVERLAY( NLB$V_LINKSTAT )		!
    NLB$V_REM_BACKPR	= [$BIT],		!     remote NCB backpressured off link
    NLB$V_DATA_INHIB	= [$BIT],		!     outbound data msgs inhibited
    NLB$V_IRPT_INHIB	= [$BIT],		!     outbound interrupt msgs inhibited
    NLB$V_LCL_BACKPR	= [$BIT],		!     local NCB backpressured off link
    NLB$V_QUEUE_FULL	= [$BIT],		!     inbound message queue full
    NLB$V_LCL_RESUME	= [$BIT],		!     incoming message flow to resume
	$CONTINUE
	
    NLB$B_LCL_DATA	= [$BYTE],		! local data request count
    NLB$B_LCL_IRPT	= [$BYTE],		! local interrupt request count
    NLB$B_REM_DATA	= [$BYTE],		! remote data request count
    NLB$B_REM_IRPT	= [$BYTE],		! remote interrupt request count
    NLB$B_FLOW_CTL	= [$BYTE],		! flow control option in effect
    NLB$H_XMIT_MAX	= [$SHORT_INTEGER],	! maximum outbound message size
    NLB$H_CHANNEL	= [$SHORT_INTEGER],	! channel number (system specific)
    NLB$H_MBX_CHAN	= [$SHORT_INTEGER],	! mailbox channel number (system specific)
    NLB$A_IOSB		= [$ADDRESS],		! address of IOSB (system specific)
    NLB$A_NCB		= [$ADDRESS],		! address of descriptor for NCB (sysetm specific)
    NLB$H_LUN		= [$SHORT_INTEGER],	! logical unit number (system specific)
    NLB$H_QUEUE_LUN	= [$SHORT_INTEGER],	! queue logical unit number (system specific)
    NLB$H_LLA		= [$SHORT_INTEGER],	! logical link address (system specific)
    NLB$H_ULA		= [$SHORT_INTEGER],	! user link address (system specific)
%IF %SWITCHES (TOPS20)
%THEN
    NLB$H_JFN		= [$SHORT_INTEGER],	! job file number (system specific)
    NLB$V_INT_STS       = [$BITS (18)],         ! Interrupt status (system specific)
        $OVERLAY (NLB$V_INT_STS)
    NLB$V_INT_SET       = [$BIT],               ! Interrupts set up (system specific)
        $CONTINUE
%FI
    NLB$B_EFN		= [$BYTE],		! event flag number (system specific)
    NLB$B_BUFFERS	= [$BYTE]		! number of read buffers
    TES;
    
! End of NLB
    
LITERAL NLB$K_LENGTH = $FIELD_SET_SIZE;		! length of NLB

LITERAL
    NLB$K_VERSION = 0,				! BLISSNET version number
    NLB$K_LEVEL = 1;				! BLISSNET change level

!
! NLB Function code values
!

$LITERAL
    NLB$K_OPEN		= $DISTINCT,		! open a link
    NLB$K_EVENT		= $DISTINCT,		! get event information
    NLB$K_PUT		= $DISTINCT,		! send information
    NLB$K_GET		= $DISTINCT,		! receive information
    NLB$K_DISCONNECT	= $DISTINCT,		! disconnect a link
    NLB$K_CLOSE		= $DISTINCT;		! close a link

!
! NLB Subfunction code values
!

$LITERAL
    NLB$K_DATA		= $DISTINCT,		! TYPE = DATA
    NLB$K_INTERRUPT	= $DISTINCT,		! TYPE = INTERRUPT
    NLB$K_LINK_SERV	= $DISTINCT,		! TYPE = LINK_SERVICE
    NLB$K_SYNCH		= $DISTINCT,		! TYPE = DISCONNECT/SYNCHRONOUS
    NLB$K_ABORT		= $DISTINCT,		! TYPE = ABORT
    NLB$K_ACCEPT	= $DISTINCT,		! TYPE = ACCEPT
    NLB$K_REJECT	= $DISTINCT;		! TYPE = REJECT

!
! NLB Flow Control Type values
!

$LITERAL
    NLB$K_NONE		= $DISTINCT,		! none
    NLB$K_SEGMENT	= $DISTINCT,		! by segments
    NLB$K_MESSAGE	= $DISTINCT;		! by messages

!
! End of NLB-related field and literal definitions
!
!----------------------------------------------------------------------

!----------------------------------------------------------------------
!
! Utility Macros
!
!----------------------------------------------------------------------

!
! $XPN$FORCE - Force the expansion of what follows
!

MACRO
    $xpn$force [] =
	%QUOTE %EXPAND %REMAINING
	%,

!
! $XPN$REQUIRED - Kick out a warning and exit if 'value' is null
!
    
    $xpn$required( value, parameter_name ) =
	%IF %NULL(value)
	%THEN
	    %WARN( parameter_name, ' parameter must be specified' )
	    %QUOTE %QUOTE %EXITMACRO
	%FI
	%,

!
! $XPN$CONFLICT - Returns TRUE if more than one of the values in 'list' are
!		  specified, else FALSE
!
    
    $xpn$conflict( list ) =
	0 %QUOTE %EXPAND $xpn$$conflict( list, %REMAINING ) GTR 1
	%,

!
! $XPN$$CONFLICT - Generates '+ 1' for each item in the argument list that is
!		   not null
!

    $xpn$$conflict( list ) [] =
	%IF NOT %NULL( %QUOTE %EXPAND %REMOVE(list) )
	%THEN
	    + 1
	%FI
	%QUOTE %EXPAND $xpn$$conflict( %REMAINING )
	%,

!
! $XPN$KEY_CHECK - Tests that 'value' is one of the keywords in 'keyword_list'.
!		   returns 1 if so, otherwise 0
!

    $xpn$key_check( value, keyword_list ) =
	%ASSIGN( $xpn$key_ok, 0 )
	$xpn$$key_test( value, %REMOVE(keyword_list) )
	%NUMBER( $xpn$key_ok )
	%,

!
! $XPN$KEY_TEST - Same as $XPN$KEY_CHECK, except that it kicks out an error
!		  message if 'value' is not in the 'keyword_list' as well as
!		  returning 1 or 0
!
    
    $xpn$key_test( value, keyword_list, parameter_name ) =
	%IF $xpn$key_check( value, keyword_list )
	%THEN
	    1
	%ELSE
	    %PRINT('"', %REMOVE(value), '" is an invalid ', parameter_name, ' parameter value' )
	    %MESSAGE('"', %REMOVE(value), '" is an invalid ', parameter_name, ' parameter value' )
	    %WARN( '... possible values are ', $xpn$key_words( %REMOVE(keyword_list) ) )
	    0
	%FI
	%,

!
! $XPN$$KEY_TEST - Assigns a value of 1 to compiletime variable $XPN$KEY_OK if
!		   'value' is identical to one of the keywords on the parameter
!		   list
!
    
    $xpn$$key_test( value, keyword ) [] =
	%IF %IDENTICAL( value, keyword )
	%THEN
	    %ASSIGN( $xpn$key_ok, 1 )
	%ELSE
	    $xpn$$key_test( value, %REMAINING )
	%FI
	%,

!
! $XPN$KEY_WORDS - Generates a comma-separated list of keyword strings from a
!		   list of keywords
!
    
    $xpn$key_words [ keyword ] =
	%IF %COUNT NEQ 0
	%THEN
	    ', ',
	%FI
	%STRING( keyword )
	%,
!
! $XPN$PAREN_TEST - returns 1 if 'parameter' is parenthesized
!
    
    $xpn$paren_test( parameter ) =
	%IF %NULL(parameter) 
	%THEN
	    0
	%ELSE
	    $xpn$$paren( %REMOVE(parameter), parameter )
	%FI
	%,

!
! $XPN$$PAREN - Internal macro called by $XPN$PAREN_TEST to test for 
!		parenthesization
!
    
    $xpn$$paren( no_parens, parens ) =
	%IF %LENGTH EQL 2
	%THEN
	    %IF %IDENTICAL( no_parens, parens )
	    %THEN
		0
		%EXITMACRO
	    %FI
	%FI
	1
	%,

!
! $XPN$FIRST - Returns the first argument of its parameter list
!

    $xpn$first( first ) =
	first
	%,

!
! $XPN$SECOND - Returns the second argument of its parameter list
!
    
    $xpn$second( first, second ) =
	second
	%,

!
! $XPN$THIRD - Returns the third argument in its parameter list
!
    
    $xpn$third( first, second, third ) =
	third
	%,

!
! $XPN$LITERAL - Returns a character pointer to a UPLIT containing 'literal text'
!
    
    $xpn$literal( literal_text ) =
	CH$PTR( UPLIT %BLISS16(BYTE) %BLISS32(BYTE) ( literal_text ) )
	%,

!
! $XPN$STR_DECLARE - 'type' is either BIND or LOCAL.  If 'string_info' is
!		     a quoted string, creates an OWN descriptor pointing to it.
!		     If it is a parenthesized list, it generates a BIND to
!		     an XPORT temporary string descriptor (created and allocated
!		     by $FORMAT), or a LOCAL declaration of a VOLATILE string
!		     descriptor.  If 'string_info' is not a quoted string or
!		     a paren list, it is assumed to be the address of a
!		     descriptor, and 'name' is simply bound to it.
!
    
    $xpn$str_declare( type, name, string_info ) [] =
	%IF $xpn$key_test( type, (BIND,LOCAL), 'Type' )
	%THEN
	    %IF %ISSTRING( %REMOVE(string_info) )
	    %THEN
		OWN name: $STR_DESCRIPTOR( STRING = %QUOTE %REMOVE(string_info) );
	    %ELSE
		%IF $xpn$paren_test( string_info )
		%THEN
		    %IF %IDENTICAL( type, BIND )
		    %THEN
			BIND name = $STR_FORMAT( string_info );
		    %ELSE
			LOCAL name: $STR_DESCRIPTOR() VOLATILE;
		    %FI
		%ELSE
		    BIND name = string_info;
		%FI
	    %FI
	%FI
	%,

!
! $XPN$STR_LOCAL_INIT - Generates code to initialize the local string 
!			descriptor 'name' to 'string_info' if 'string_info'
!			is a paren list of the form (count,pointer)
!
	    
    $xpn$str_local_init( name, string_info ) [] =
        %IF NOT %ISSTRING( %REMOVE(string_info) ) AND $xpn$paren_test( string_info )
        %THEN
            $xpn$str_desc( name, string_info )
        %FI
        %,

!
! $XPN$STR_DESC - Generates code to initialize string descriptor 'desc' to
!		  value 'string_desc'
!
	
    $xpn$str_desc( desc, string_desc ) [] =
        %IF %ISSTRING( %REMOVE(string_desc) )
        %THEN
    	    desc[STR$H_LENGTH] = %CHARCOUNT( %REMOVE(string_desc) );
	    desc[STR$B_DTYPE] = STR$K_DTYPE_T;
	    desc[STR$B_CLASS] = STR$K_CLASS_F;
	    desc[STR$A_POINTER] = $xpn$literal( %QUOTE %REMOVE(string_desc) );
        %ELSE
            %IF NOT $xpn$paren_test( string_desc )
	    %THEN
	        BEGIN
	        BIND $xpn$$desc = string_desc: $STR_DESCRIPTOR();
	        desc[STR$H_LENGTH] = .$xpn$$desc[STR$H_LENGTH];
	        desc[STR$B_DTYPE] = .$xpn$$desc[STR$B_DTYPE];
	        desc[STR$B_CLASS] = STR$K_CLASS_F;
	        desc[STR$A_POINTER] = .$xpn$$desc[STR$A_POINTER]
	        END;
	    %ELSE
	        desc[STR$H_LENGTH] = $xpn$first( %REMOVE(string_desc) );
	        desc[STR$B_DTYPE] = STR$K_DTYPE_T;
	        desc[STR$B_CLASS] = STR$K_CLASS_F;
	        desc[STR$A_POINTER] = $xpn$second( %REMOVE(string_desc) );
	    %FI
        %FI
        %,

!
! $XPN$BIN_DECLARE - Same as $XPN$STR_DECLARE, except for XPORT binary data
!		     descriptors instead of string descriptors
!
	
    $xpn$bin_declare( type, name, binary_info ) [] =
	%IF $xpn$key_test( type, (BIND,LOCAL), 'Type' )
	%THEN
	    %IF $xpn$paren_test( binary_info )
	    %THEN
		%IF %IDENTICAL( type, BIND )
		%THEN
		    OWN name: $XPO_DESCRIPTOR();
		%ELSE
		    LOCAL name: $XPO_DESCRIPTOR() VOLATILE;
		%FI
	    %ELSE
		BIND name = binary_info;
	    %FI
	%FI
	%,

!
! $XPN$BIN_INIT - Like $XPN$STR_INIT execpt for binary descriptors
!
    
    $xpn$bin_init( name, binary_info ) [] =
	%IF $xpn$paren_test( binary_info )
	%THEN
	    $xpn$bin_desc( name, binary_info )
	%FI
	%,

!
! $XPN$BIN_DESC - Generates code for run-time initialization of an XPORT
!		  binary data descriptor
!
    
    $xpn$bin_desc( desc, data_desc ) [] =
	%IF NOT %NULL( $xpn$third( %REMOVE(data_desc) ) )
	%THEN
	    %IF NOT $xpn$key_test( $xpn$third( %REMOVE(data_desc) ),
		(FULLWORDS, UNITS) )
	    %THEN
		%MESSAGE( '... FULLWORDS assumed' )
		%PRINT( '... FULLWORDS assumed' )
	    %FI
	%FI
	%IF NOT $xpn$paren_test( data_desc )
	%THEN
	    BEGIN
	    BIND $xpn$$desc = data_desc: $XPO_DESCRIPTOR();
	    desc[XPO$H_LENGTH] = .$xpn$$desc[XPO$H_LENGTH];
	    desc[XPO$B_DTYPE] = .$xpn$$desc[XPO$B_DTYPE];
	    desc[XPO$B_CLASS] = XPO$K_CLASS_F;
	    desc[XPO$A_ADDRESS] = .$xpn$$desc[XPO$A_ADDRESS]
	    END;
	%ELSE
	    desc[XPO$H_LENGTH] =
		%IF %IDENTICAL( $xpn$third( %REMOVE(data_desc) ), UNITS )
		%THEN
		    $xpn$first( %REMOVE(data_desc) );
		%ELSE
		    %UPVAL * ( $xpn$first( %REMOVE(data_desc) ) );
		%FI
	    desc[XPO$B_DTYPE] = XPO$K_DTYPE_BU;
	    desc[XPO$B_CLASS] = XPO$K_CLASS_F;
	    desc[XPO$A_ADDRESS] = $xpn$second( %REMOVE(data_desc) );
	%FI
	%;

!
! NLB initialization internal macros
!

MACRO

!
! $XPN$OPT_PRESET - Generates a PRESET list item initializing NLB$fieldname 
!		    to 'value'
!

    $xpn$opt_preset( fieldname, value ) [] =
	, [ %NAME('NLB$',fieldname) ] = value
	%,
!
! $XPN$OPT_BITSET - Generates a PRESET list item to initialize NLB$fieldname to 1
!
    
    $xpn$opt_bitset( fieldname, value ) [] =
	, [ %NAME('NLB$',fieldname) ] = 1
	%,

!
! $XPN$PLIT_STRING - Generates a UPLIT that is an XPORT descriptor for the
!		     string data given by 'length' and 'pointer'
!
    
    $xpn$plit_string( length, pointer ) [] =
	UPLIT(
	    %BLISS32(
		STR$K_CLASS_F^24 + STR$K_DTYPE_T^16 + length,
		pointer )
	    %BLISS16(
		length,
		STR$K_CLASS_F^8 + STR$K_DTYPE_T,
		pointer )
	    %BLISS36(
		STR$K_CLASS_F^27 + STR$K_DTYPE_T^18 + length,
		pointer )
	    )
	%,

!
! $XPN$PLIT_DATA - Generates a UPLIT for an XPORT binary data descriptor
!		   pointing to the data given by 'length' and 'addr'
!
	
    $xpn$plit_data( length, addr ) [] =
	UPLIT(
	    %BLISS32(
		XPO$K_CLASS_F^24 + XPO$K_DTYPE_BU^16 + length,
		addr )
	    %BLISS16(
		length,
		XPO$K_CLASS_F^8 + XPO$K_DTYPE_BU,
		addr )
	    %BLISS36(
		XPO$K_CLASS_F^27 + XPO$K_DTYPE_BU^18 + length,
		addr )
 	    )
	%,

!
! $XPN$STRING_PRESET - Generates a PRESET item for NLB$A_fieldname, the address
!		       of a descriptor for 'value'
!
	
    $xpn$string_preset( errtext, fieldname, value ) [] =
        %IF %ISSTRING( %REMOVE(value) )
	%THEN
    	    , [ %NAME('NLB$A_',fieldname) ] =
	        $xpn$plit_string( %CHARCOUNT( %REMOVE(value) ),
		    $xpn$literal( %QUOTE %REMOVE(value) ) )
        %ELSE
		
    	    %IF NOT $xpn$paren_test( value )
	    %THEN
	        %WARN( 'descriptor not allowed as ', errtext, ' parameter value' )
	        %EXITMACRO
	    %FI
		
	    , [ %NAME('NLB$A_',fieldname) ] =
		$xpn$plit_string( %REMOVE(value) )
	%FI %,

!
! $XPN$BINARY_PRESET - Same as $XPN$STRING_PRESET, except it generates an XPORT
!		       binary data descriptor instead of a string descriptor
!
    
    $xpn$binary_preset( errtext, fieldname, value ) [] =
	%IF NOT $xpn$paren_test( value )
	%THEN
	    %WARN( 'descriptor not allowed as ', errtext, ' parameter value' )
	    %EXITMACRO
	%FI
	
	, [ %NAME('NLB$A_',fieldname) ] =
	
	%IF NOT %NULL($xpn$third( %REMOVE(value) ) )
	%THEN
	    %IF NOT $xpn$key_test( $xpn$third( %REMOVE(value) ), ( FULLWORDS, UNITS),
		'binary data descriptor' )
	    %THEN
		%MESSAGE( '... FULLWORDS assumed' )
		%PRINT( '... FULLWORDS assumed' )
	    %FI
	%FI
	
	%IF %IDENTICAL( $xpn$third( %REMOVE(value) ), UNITS )
	%THEN
	    $xpn$plit_data( %REMOVE(value) )
	%ELSE
	    $xpn$plit_data( ( $xpn$first( %REMOVE(value) ) ) * %UPVAL,
		$xpn$second( %REMOVE(value) ) )
	%FI
	%;

!
! NLB Initialization Macros
!

KEYWORDMACRO
    $XPN_NLB(
	type,					! link type
	node,					! node name
	format,					! object descriptor format
	object,					! object type
	descriptor,				! object descriptor
	group_code,				! group code
	user_code,				! user code
	id,					! user ID
	password,				! access control password
	accounting,				! account name
	string,					! optional connect data (string)
	binary_data,				! optional connect data (binary)
	buffer_size,				! maximum buffer size
	user,					! user program NLB value
	timeout,				! timeout value
	flow_control,				! type of flow control for link
	max_bufferspace,			! max. system buffer space
	max_messages,				! max. messages pending
	max_links,				! max. links to be opened
	buffers					! number of read buffers
	) =
	
	BLOCK[NLB$K_LENGTH] FIELD($XPN$NLB_FIELDS)
	
	%IF %EXPAND $xpn$conflict( 1, (type,node,format,object,descriptor,
	    group_code,user_code,id,password,accounting,string,binary_data,
	    buffer_size,user,timeout,flow_control,max_bufferspace,max_links,
	    buffers) )
	%THEN
	    
	    %IF %NULL(type)
	    %THEN
		%INFORM( 'TYPE=ACTIVE defaulted for static NLB initialization' )
	    %FI
		
	    PRESET(
		[NLB$H_LENGTH] = NLB$K_LENGTH,			! NLB length
		[NLB$B_VERSION] = NLB$K_VERSION,		! BLISSNET version
		[NLB$B_LEVEL] = NLB$K_LEVEL			! BLISSNET change level
		$xpn$opt_preset( B_TIMEOUT, timeout )	! TIMEOUT=
		
		%IF %NULL(type)
		%THEN
		    , [ NLB$V_ACTIVE ] = 1
		%ELSE
		    %IF %EXPAND $xpn$key_test( type, (PASSIVE,ACTIVE), 'TYPE=' )
		    %THEN
			, [ %NAME('NLB$V_', type) ] = 1
		    %FI
		%FI
		
		$xpn$opt_preset( B_MAX_LINKS, max_links )	! MAX_LINKS=
		$xpn$opt_preset( B_MAX_MSGS, max_messages )	! MAX_MESSAGES =
		$xpn$opt_preset( H_MAX_BSPACE, max_bufferspace)	! MAX_BUFFERSPACE=
		$xpn$opt_preset( H_RECEIVE_MAX, buffer_size )	! BUFFER_SIZE=
		$xpn$opt_preset( B_BUFFERS, buffers )		! BUFFERS=
		
		%IF %IDENTICAL( type, PASSIVE )	! PASSIVE link:
		%THEN
		    $xpn$opt_preset( B_LCL_FORMAT, format )	! FORMAT=
		    $xpn$opt_bitset( V_LCL_FORMAT, format )
		    $xpn$opt_preset( B_LCL_OBJTYP, object )	!   OBJECT=
		    $xpn$opt_bitset( V_LCL_OBJTYP, object )	
		    $xpn$string_preset( 'DESCRIPTOR=', LCL_DESCR, descriptor ) !  DESCRIPTOR=
		    
		%ELSE						! ACTIVE link:
		    $xpn$opt_preset( B_REM_FORMAT, format )	!   FORMAT=
		    $xpn$opt_bitset( V_REM_FORMAT, format )
		    $xpn$opt_preset( B_REM_OBJTYP, object )	!   OBJECT=
		    $xpn$opt_bitset( V_REM_OBJTYP, object )
		    $xpn$opt_preset( H_REM_USER, user_code )	! USER_CODE=
		    $xpn$opt_bitset( V_REM_USER, user_code )
		    $xpn$opt_preset( H_REM_GROUP, group_code )	! GROUP_CODE=
		    $xpn$opt_bitset( V_REM_GROUP, group_code )
		    $xpn$string_preset( 'DESCRIPTOR=', REM_DESCR, descriptor )	! DESCRIPTOR=
		    $xpn$string_preset( 'NODE=', NODE_NAME, node )	! NODE=
		    $xpn$string_preset( 'ID=', USER_ID, id )		! ID=
		    $xpn$string_preset( 'PASSWORD=', %QUOTE PASSWORD, password )	! PASSWORD=
		    $xpn$string_preset( 'ACCOUNTING=', ACCOUNT, accounting )	! ACCOUNTING=
		    %IF %EXPAND $xpn$conflict( string, binary_data )
		    %THEN
			%WARN( 'STRING= and BINARY_DATA= are mutually exclusive' )
		    %ELSE
	
			$xpn$string_preset( 'STRING=', OPTIONAL, string )	! STRING=
			$xpn$binary_preset( 'BINARY_DATA=', OPTIONAL, binary_data )	! BINARY_DATA=
		    %FI
		%FI
		
		%IF NOT %NULL(flow_control) 			! FLOW_CONTROL=
		%THEN
		    %IF %EXPAND $xpn$key_test( flow_control,
			(NONE,SEGMENT,MESSAGE), 'FLOW_CONTROL' )
		    %THEN
		        $xpn$opt_preset( B_FLOW_CTL, %NAME('NLB$K_',flow_control) )
		    %FI
		%FI
		
		$xpn$opt_preset( Z_USER, user )			! USER=
		
		)
	%FI %;

!
! $XPN$VALUE - Generates an assignment of 'value' to blockname[NLB$fieldname]
!

MACRO
    $xpn$value( blockname, fieldname, value ) [] =
	blockname[ %NAME('NLB$',fieldname) ] = value;
	%;

!
! $XPN$BITSET - Generates an assignment of 1 to blockname[NLB$fieldname]
!

MACRO
    $xpn$bitset( blockname, fieldname, value ) [] =
	blockname[ %NAME('NLB$',fieldname) ] = 1;
	%;

!
! $XPN$DESCRSET - Generates an assignment of 'value' to blockname[NLB$fieldname]
    
MACRO
    $xpn$descrset( blockname, fieldname, value, param ) [] =
	$xpn$value( blockname, fieldname, value )
	%;

KEYWORDMACRO
    $XPN_NLB_INIT(
	nlb,
	type=ACTIVE,
	node,
	format,
	object=XPN$K_TASK,
	descriptor,
	group_code,
	user_code,
	id,
	password,
	accounting,
	string,
	binary_data,
	max_messages,
	max_links,
	max_bufferspace,
	buffer_size,
	user,
	timeout,
	flow_control=NONE,
	buffers
	) =
	
	%IF %EXPAND $xpn$conflict( string, binary_data )
	%THEN
	    %WARN( 'STRING= and BINARY_DATA= are mutually exclusive' )
	%FI
	
	%EXPAND $xpn$required( nlb, 'NLB=' )
	
	BEGIN
	BIND nlb$ = nlb: %EXPAND $xpn$force( $XPN_NLB() );
	
	$xpn$str_declare( BIND, $xpn$node, node )
	$xpn$str_declare( BIND, $xpn$descriptor, descriptor )
	$xpn$str_declare( BIND, $xpn$id, id )
	$xpn$str_declare( BIND, $xpn$password, password )
	$xpn$str_declare( BIND, $xpn$accounting, accounting )
	$xpn$str_declare( BIND, $xpn$string, string )
	$xpn$bin_declare( BIND, $xpn$binary, binary_data )

	$xpn$bin_init( $xpn$binary, binary_data );
	CH$FILL( 0, NLB$K_LENGTH * %UPVAL, CH$PTR( nlb$, 0, %BPUNIT ) );
	nlb$[NLB$H_LENGTH] = NLB$K_LENGTH;			! NLB length
	nlb$[NLB$B_LEVEL] = NLB$K_LEVEL;			! BLISSNET change level
	nlb$[NLB$B_VERSION] = NLB$K_VERSION;			! BLISSNET version number
	
	$xpn$value( nlb$, B_TIMEOUT, timeout )			! TIMEOUT=
	
	%IF %EXPAND $xpn$key_test( type, (ACTIVE,PASSIVE), 'TYPE=')  ! TYPE=
	%THEN
	    nlb$[ %NAME('NLB$V_',type) ] = 1;
	%FI
	
	$xpn$value( nlb$, B_MAX_LINKS, max_links )		! MAX_LINKS=
	$xpn$value( nlb$, B_MAX_MSGS, max_messages )		! MAX_MESSAGES=
	$xpn$value( nlb$, H_MAX_BSPACE, max_bufferspace )	! MAX_BUFFERSPACE=
	$xpn$value( nlb$, H_RECEIVE_MAX, buffer_size )		! BUFFER_SIZE=
	$xpn$value( nlb$, B_BUFFERS, buffers )			! BUFFERS=
	
	%IF %IDENTICAL( type, ACTIVE )
	
	%THEN							! ACTIVE link:
	    $xpn$value( nlb$, B_REM_FORMAT, format )		!   FORMAT=
	    $xpn$bitset( nlb$, V_REM_FORMAT, format )
	    $xpn$value( nlb$, B_REM_OBJTYP, object )		!   OBJECT=
	    $xpn$bitset( nlb$, V_REM_OBJTYP, object )
	    $xpn$value( nlb$, H_REM_USER, user_code )		!   USER_CODE=
	    $xpn$bitset( nlb$, V_REM_USER, user_code )
	    $xpn$value( nlb$, H_REM_GROUP, group_code )		!   GROUP_CODE=
	    $xpn$bitset( nlb$, V_REM_GROUP, group_code )
	    $xpn$descrset( nlb$, A_NODE_NAME, $xpn$node, node )	!   NODE=
	    $xpn$descrset( nlb$, A_REM_DESCR, $xpn$descriptor, descriptor ) !   DESCRIPTOR=
	    $xpn$descrset( nlb$, A_USER_ID, $xpn$id, id )	!   ID=
	    $xpn$descrset( nlb$, A_PASSWORD, $xpn$password, password )	!   PASSWORD=
	    $xpn$descrset( nlb$, A_ACCOUNT, $xpn$accounting, accounting )	!   ACCOUNT=
	    $xpn$descrset( nlb$, A_OPTIONAL, $xpn$string, string )	!   STRING=
	    $xpn$descrset( nlb$, A_OPTIONAL, $xpn$binary, binary_data )	!   BINARY_DATA=
	
	%ELSE							! PASSIVE link:
	    $xpn$value( nlb$, B_LCL_OBJTYP, object )		!   OJBECT=
	    $xpn$bitset( nlb$, V_LCL_OBJTYP, object )
	    $xpn$descrset( nlb$, A_LCL_DESCR, $xpn$descriptor, descriptor )	!   DESCRIPTOR=
	%FI
	
	%IF %EXPAND $xpn$key_test( flow_control,		! FLOW_CONTROL=
	    (NONE,SEGMENT,MESSAGE), 'FLOW_CONTROL=' )
	%THEN
	    nlb$[NLB$B_FLOW_CTL] = %NAME('NLB$K_',flow_control);
	%FI
	
	$xpn$value( nlb$, Z_USER, user )			! USER=
	XPN$_NORMAL
	END
	%;

!
! Imperative macro support macros
!

!
! $XPN$NLB_VECTOR - Declares a vector of NLB addresses, sets the 0-th
!		    entry in the vector to the count of remaining entries,
!		    and initializes the remaining entries
!

MACRO
    $xpn$nlb_vector [nlb_address] =
	
	%IF %IDENTICAL( %COUNT, 0 )
	%THEN
	    LOCAL xpn_vector$: VECTOR[ %LENGTH+1 ];
	    xpn_vector$[0] = %LENGTH;
	%FI
	
	xpn_vector$[ %COUNT+1 ] = nlb_address
	%;

!
! $XPN$ZERO - Generates a zero if 'parameter' is null, otherwise generates
!	      'parameter'
!
	
MACRO
    $xpn$zero( parameter ) =
	
	%IF %NULL(parameter)
	%THEN
	    0
	%ELSE
	    parameter
	%FI
	%;

!
! $XPN$IGNORE - Eats its parameter list and generates nothing
!

MACRO
    $xpn$ignore( parameter ) =
	%;

!
! $XPN$OPTION_TEST - Checks that each item on the 'option_list' is found in
!		     the 'keyword_list'.  Returns 1 if this is so, 0 otherwise
!
	
MACRO
    $xpn$option_test( keyword_list, option_list, text ) =
    
	%IF %NULL( %REMOVE(option_list) )
	%THEN 
	    %EXITMACRO
	%FI
	
	%ASSIGN( $xpn$key_ok, 1 )
	$xpn$ignore( $xpn$$option_test( text, keyword_list, %REMOVE(option_list) ) )
	%NUMBER( $xpn$key_ok )
	%;

!
! $XPN$$OPTION_TEST - Tests that the value of 'option_item' is one of the
!		      keywords in 'keyword_list'.  If so, 1 is returned.
!		      Otherwise, 0 is returned and an error message is 
!		      generated.
!

MACRO
    $xpn$$option_test( text, keyword_list ) [ option_item ] =
	
	%IF NOT $xpn$key_test( option_item, keyword_list, text )
	%THEN
	    %ASSIGN( $xpn$key_ok, 0 )
	%FI
    
	1
	%;

!
! $XPN$CALL - Generates a routine call to a BLISSnet first-level support
!	      routine.  'routine_name' is declared EXTERNAL ROUTINE.
!	      If 'failure' is XPN$FAILURE or XPN$NF_FAILURE, that routine
!	      is also declared EXTERNAL ROUTINE.  NLB$[NLB$B_FUNCTION] and
!	      NLB$[NLB$B_SUBFUNC] are set from the 'function' and
!	      'subfunction' parameters.  'success' and 'failure' are
!	      put in the routine call as the addresses of the success and
!	      failure action routines.  The NLB address is always NLB$
!

MACRO
    $xpn$call( routine_name, function, subfunction, success, failure ) =
	$xpn$value( nlb$, B_FUNCTION, function )
	$xpn$value( nlb$, B_SUBFUNC, subfunction )
	
	BEGIN
	EXTERNAL ROUTINE routine_name
	    %BLISS32( : ADDRESSING_MODE(LONG_RELATIVE) );
	
	%IF $xpn$key_check( failure, ( XPN$FAILURE, XPN$NF_FAILURE ) )
	%THEN
	    EXTERNAL ROUTINE failure
		%BLISS32( : ADDRESSING_MODE(LONG_RELATIVE) );
	%FI
	
	routine_name( nlb$, $xpn$zero(success), failure )
	END
	%;

!
! Imperative Macros
!

KEYWORDMACRO
    $XPN_OPEN(
	nlb,
	type=ACTIVE,
	node,
	format,
	object,
	descriptor,
	group_code,
	user_code,
	id,
	password,
	accounting,
	string,
	binary_data,
	option,
	options,
	buffer_size,
	user,
	timeout,
	flow_control,
	max_messages,
	max_bufferspace,
	max_links,
	buffers,
	success,
	failure=XPN$FAILURE
	) =
	
	%IF %EXPAND $xpn$conflict( option, options )
	%THEN
	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
	%FI
	
	%IF %EXPAND $xpn$conflict( string, binary_data )
	%THEN
	    %WARN( 'STRING= and BINARY_DATA= are mutually exclusive' )
	%FI
	
	%EXPAND $xpn$required( nlb, 'NLB=' )
	
	BEGIN
	BIND nlb$ = nlb: %EXPAND $xpn$force( $XPN_NLB() );
	
	$xpn$str_declare( BIND, $xpn$node, node )
	$xpn$str_declare( BIND, $xpn$descriptor, descriptor )
	$xpn$str_declare( BIND, $xpn$id, id )
	$xpn$str_declare( BIND, $xpn$password, password )
	$xpn$str_declare( BIND, $xpn$accounting, accounting )
	$xpn$str_declare( BIND, $xpn$string, string )
	$xpn$bin_declare( BIND, $xpn$binary, binary_data )

	$xpn$bin_init( $xpn$binary, binary_data )
	$xpn$value( nlb$, B_TIMEOUT, timeout )			! TIMEOUT=
	
	%IF %EXPAND $xpn$key_test( type, (ACTIVE,PASSIVE), 'TYPE=')  ! TYPE=
	%THEN
	    nlb$[ NLB$V_PASSIVE ] = %IDENTICAL( type, PASSIVE );
	    nlb$[ NLB$V_ACTIVE ] = %IDENTICAL( type, ACTIVE );
	%FI
	
	$xpn$value( nlb$, B_MAX_LINKS, max_links )		! MAX_LINKS=
	$xpn$value( nlb$, B_MAX_MSGS, max_messages )		! MAX_MESSAGES=
	$xpn$value( nlb$, H_MAX_BSPACE, max_bufferspace )	! MAX_BUFFERSPACE=
	$xpn$value( nlb$, H_RECEIVE_MAX, buffer_size )		! BUFFER_SIZE=
	$xpn$value( nlb$, B_BUFFERS, buffers )			! BUFFERS=
	
	%IF %IDENTICAL( type, ACTIVE )
	
	%THEN							! ACTIVE link:
	    $xpn$value( nlb$, B_REM_FORMAT, format )		!   FORMAT=
	    $xpn$bitset( nlb$, V_REM_FORMAT, format )
	    $xpn$value( nlb$, B_REM_OBJTYP, object )		!   OBJECT=
	    $xpn$bitset( nlb$, V_REM_OBJTYP, object )
	    $xpn$value( nlb$, H_REM_USER, user_code )		!   USER_CODE=
	    $xpn$bitset( nlb$, V_REM_USER, user_code )
	    $xpn$value( nlb$, H_REM_GROUP, group_code )		!   GROUP_CODE=
	    $xpn$bitset( nlb$, V_REM_GROUP, group_code )
	    $xpn$descrset( nlb$, A_NODE_NAME, $xpn$node, node )	!   NODE=
	    $xpn$descrset( nlb$, A_REM_DESCR, $xpn$descriptor, descriptor )	!   DESCRIPTOR=
	    $xpn$descrset( nlb$, A_USER_ID, $xpn$id, id )		!   ID=
	    $xpn$descrset( nlb$, A_PASSWORD, $xpn$password, password )	!   PASSWORD=
	    $xpn$descrset( nlb$, A_ACCOUNT, $xpn$accounting, accounting )	!   ACCOUNT=
	    $xpn$descrset( nlb$, A_OPTIONAL, $xpn$string, string )	!   STRING=
	    $xpn$descrset( nlb$, A_OPTIONAL, $xpn$binary, binary_data )	!   BINARY_DATA=
	
	%ELSE							! PASSIVE link:
	    $xpn$value( nlb$, B_LCL_FORMAT, format )            ![2]   FORMAT=
	    $xpn$bitset( nlb$, V_LCL_FORMAT, format )           ![2]
	    $xpn$value( nlb$, B_LCL_OBJTYP, object )		!   OJBECT=
	    $xpn$bitset( nlb$, V_LCL_OBJTYP, object )
	    $xpn$descrset( nlb$, A_LCL_DESCR, $xpn$descriptor, descriptor )	!   DESCRIPTOR=
	%FI
	
	%IF NOT %NULL(flow_control)
	%THEN
	    %IF %EXPAND $xpn$key_test( flow_control,		! FLOW_CONTROL=
		(NONE,SEGMENT,MESSAGE), 'FLOW_CONTROL=' )
	    %THEN
		nlb$[NLB$B_FLOW_CTL] = %NAME('NLB$K_',flow_control);
	    %FI
	%FI
	
	$xpn$value( nlb$, Z_USER, user )			! USER=
	
	%IF ( NOT %NULL(option) OR NOT %NULL(options) )		! OPTION=
	    AND NOT %EXPAND $xpn$conflict( option, options )
	%THEN
            $xpn$ignore( $xpn$option_test( (PMR,WAIT),( option %REMOVE(options) ), 'OPTIONS=' ) )
            %IF $xpn$key_check( WAIT, (option %REMOVE(options)) )
            %THEN
                nlb$[NLB$V_WAIT] = 1;
            %ELSE
                nlb$[NLB$V_WAIT] = 0;
            %FI
            %IF $xpn$key_check( PMR, (option %REMOVE(options)) )
            %THEN
                nlb$[NLB$V_PMR] = 1;
            %ELSE
                nlb$[NLB$V_PMR] = 0;
            %FI
	%ELSE
	    nlb$[NLB$V_WAIT] = 0;
            nlb$[NLB$V_PMR] = 0;
	%FI
	
	$xpn$call( XPN$OPEN, XPN$K_OPEN, 0, success, failure )
	END
	%;

KEYWORDMACRO
    $XPN_EVENT_INFO(
	nlb,
	nlb_vector,
	event_nlb,
	option,
	options,
	user,
	success,
	failure=XPN$FAILURE
	) =
	
	%IF %EXPAND $xpn$conflict( nlb, nlb_vector )
	%THEN
	    %WARN( 'NLB= and NLB_VECTOR= are mutually exclusive' )
	%FI
	
	%IF %EXPAND $xpn$conflict( option, options )
	%THEN
	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
	%FI
	
	%IF %NULL(nlb)
	%THEN
	    %EXPAND $xpn$required( nlb_vector, 'NLB_VECTOR= or NLB=' )
	    %IF %NULL(event_nlb)
	    %THEN
		%WARN( 'EVENT_NLB= parameter is required when NLB_VECTOR= is specified' )
	    %FI
	%FI
	
	%IF %NULL(nlb_vector)
	%THEN
	    %EXPAND $xpn$required( nlb, 'NLB_VECTOR= or NLB=' )
	%FI
	
	BEGIN
	
	%IF %NULL(nlb_vector)
	%THEN							! NLB= specified
	    %IF NOT %NULL(nlb)
	    %THEN
		LOCAL xpn_vector$: VECTOR[2];
		xpn_vector$[0] = 1;
		xpn_vector$[1] = nlb;
	    %FI
	%ELSE							! NLB_VECTOR= specified
	    %IF %NULL( %REMOVE(nlb_vector) )
	    %THEN
		%WARN( 'NLB_VECTOR= list is empty' )
		BIND xpn_vector$ = 0;
	    %ELSE
		%IF NOT $xpn$paren_test(nlb_vector)
		%THEN						!   vector address specified
		    BIND xpn_vector$ = nlb_vector;
		%ELSE						!   nlb address list specified
		    $xpn$nlb_vector( %REMOVE(nlb_vector) );
		%FI
	    %FI
	%FI
	    
	BEGIN
	EXTERNAL ROUTINE XPN$EVENT_INFO
	    %BLISS32( : ADDRESSING_MODE(LONG_RELATIVE) );
	
	%IF $xpn$key_check( failure, ( XPN$FAILURE, XPN$NF_FAILURE ) )
	%THEN
	    EXTERNAL ROUTINE failure
		%BLISS32( : ADDRESSING_MODE(LONG_RELATIVE) );
	%FI
	
	XPN$EVENT_INFO( xpn_vector$, $xpn$zero(success), failure,
	    $xpn$zero(event_nlb),
	    
	    %IF NOT %NULL(option) OR NOT %NULL(options)		! OPTION=
	    %THEN
		%IF NOT %NULL(option) AND NOT %NULL(options)
		%THEN
		    0
		%ELSE
		    %IF $xpn$key_test( option %REMOVE(options), WAIT, 'OPTION=' )
		    %THEN
			1
		    %ELSE
			0
		    %FI
		%FI
	    %ELSE
	        0
	    %FI
	    )
	END
	END
	%;

!
! $XPN$OPTION_SET - Sets option bits in the NLB.  'keyword_list' is a list of 
!		    pairs of the form (keyword, fieldname).  'option_list' is
!		    a list of all the valid keywords.  NLB$[NLB$V_fieldname]
!		    is set to 1 if 'keyword' is found on the 'option_list'.
!		    Otherwise an error message is generated.
!

MACRO
    $xpn$option_set( keyword_list, option_list ) =
	
	%IF %NULL( %REMOVE(option_list) )
	%THEN
	    %EXITMACRO
	%FI
	
	$xpn$$option_set( option_list, %REMOVE(keyword_list) )
	%;

!
! $XPN$$OPTION_SET - Called by $XPN$OPTION_SET to handle the processing of a
!		     single (keyword, fieldname) pair.
!

MACRO
    $xpn$$option_set( option_list ) [ keyword_pair ] =
	
	nlb$[ %NAME('NLB$V_', $xpn$second( %REMOVE(keyword_pair))) ] =
	    $xpn$key_check( $xpn$first( %REMOVE(keyword_pair)), option_list )
	%;

!
! $XPN$OPTION_CONFLICT - Returns TRUE if both members of 'keyword_pair' are
!			 present in 'option_list'
!

MACRO 
    $xpn$option_conflict( keyword_pair, option_list ) =
	$xpn$key_check( $xpn$first(%REMOVE(keyword_pair)), option_list )
	    AND $xpn$key_check( $xpn$second(%REMOVE(keyword_pair)), option_list )
	%;

KEYWORDMACRO
    $XPN_PUT(
	nlb,
	type=DATA,
	string,
	binary_data,
	option,
	options,
	request_count,
	user,
	success,
	failure=XPN$FAILURE
	) =
	
	%IF %EXPAND $xpn$conflict( option, options )
	%THEN
	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
	%ELSE
	    %IF NOT %NULL( option %REMOVE(options) )
	    %THEN
		$xpn$ignore( $xpn$option_test( (END_OF_MESSAGE,ENABLE_INTERRUPTS,
		    REQUEST_DATA), ( option %REMOVE(options) ), 
		    'OPTION= or OPTIONS=' ) )
	    %FI
	%FI
	
	%IF %EXPAND $xpn$conflict( string, binary_data )
	%THEN
	    %WARN( 'STRING= and BINARY_DATA= are mutually exclusive' )
	%FI
	
	%EXPAND $xpn$required( nlb, 'NLB=' )
	
	$xpn$ignore( $xpn$key_test( type, (DATA, INTERRUPT, ACCEPT, LINK_SERVICE),
	    'TYPE=' ) )
	
	BEGIN
	BIND nlb$ = nlb: %EXPAND $xpn$force( $XPN_NLB() );
	
	%IF NOT $xpn$conflict( string, binary_data )
	%THEN
	    $xpn$bin_declare( LOCAL, $xpn$output, binary_data )
	%FI
	
	$xpn$str_declare( LOCAL, $xpn$output, string )
	$xpn$str_local_init( $xpn$output, string )
	$xpn$bin_init( $xpn$output, binary_data )
	
	$xpn$descrset( nlb$, A_OUTPUT, $xpn$output, string binary_data )	! STRING= or BINARY_DATA=
	$xpn$value( nlb$, Z_USER, user )			! USER=
	$xpn$value( nlb$, H_REQ_SIZE, $xpn$zero(request_count) ) ! REQUEST_COUNT=
	
	%IF ( NOT %NULL(option) OR NOT %NULL(options) )		! OPTION=
	    AND NOT %EXPAND $xpn$conflict( option, options )
	%THEN
	    %IF $xpn$key_test( option %REMOVE(options), END_OF_MESSAGE, 'OPTION=' )
	    %THEN
		nlb$[NLB$V_END_MSG] = 1;
	    %ELSE
		nlb$[NLB$V_END_MSG] = 0;
	    %FI
	%ELSE
	    nlb$[NLB$V_END_MSG] = 0;
	%FI
	
	$xpn$call( XPN$PUT,
	    XPN$K_PUT, 
	    %NAME('NLB$K_',%EXACTSTRING( MIN( 9, %CHARCOUNT(type) ),
		%C' ', type ) ),
	    success,
	    failure )
	
	END
	%;

KEYWORDMACRO
    $XPN_GET(
	nlb,
	type=DATA,
	buffer_size,
	characters,
	fullwords,
	units,
	option,
	options,
	user,
	success,
	failure=XPN$FAILURE
	) =
	
	%IF %EXPAND $xpn$conflict( option, options )
	%THEN
	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
	%ELSE
	    %IF NOT %NULL(option) OR NOT %NULL( %REMOVE(options) )
	    %THEN
		%IF $xpn$option_test( (WAIT,STRING,BINARY), 
		    ( option %REMOVE(options) ), 'OPTION= or OPTIONS=' )
		%THEN
		    %IF $xpn$option_conflict( (STRING,BINARY), ( option %REMOVE(options) ) )
		    %THEN
			%WARN( 'STRING and BINARY options are mutually exclusive' )
		    %FI
		%FI
	    %FI
	%FI
	
	%IF %EXPAND $xpn$conflict( characters, (fullwords,units) )
	%THEN
	    %WARN( 'Character and binary data parameters are mutually exclusive' )
	%FI
	
	%IF %EXPAND $xpn$conflict( fullwords, units )
	%THEN
	    %WARN( 'FULLWORDS= and UNITS= are mutually exclusive' )
	%FI
	
	%IF $xpn$key_test( type, (DATA,INTERRUPT,DISCONNECT), 'TYPE=' )
	%THEN
	%FI
	
	%IF $xpn$key_check( BINARY, (option %REMOVE(options)) )
	%THEN
	    %IF NOT %NULL(characters)
	    %THEN
		%WARN( 'BINARY option and CHARACTERS= parameter are mutually exclusive' )
	    %FI
	%ELSE
	    %IF NOT %NULL(fullwords) OR NOT %NULL(units)
	    %THEN
		%WARN( 'STRING option conflicts with UNITS= or FULLWORDS= parameters' )
	    %FI
	%FI
	
	%EXPAND $xpn$required( nlb, 'NLB=' )
	
	BEGIN
	BIND nlb$ = nlb: %EXPAND $xpn$force( $XPN_NLB() );
	
	$xpn$value( nlb$, Z_USER, user )			! USER=
	$xpn$value( nlb$, H_RECEIVE_MAX, buffer_size )		! BUFFER_SIZE=
	
	%IF NOT %NULL(fullwords)				! FULLWORDS=
	%THEN
	    $xpn$value( nlb$, H_REQ_SIZE, (fullwords)*%UPVAL )
	%FI
	$xpn$value( nlb$, H_REQ_SIZE, units )			! UNITS=
	
	$xpn$value( nlb$, H_REQ_SIZE, characters )		! CHARACTERS=
	
	%IF $xpn$key_check( WAIT, ( option %REMOVE(options) ) )	! OPTIONS=
	%THEN
	    nlb$[NLB$V_WAIT] = 1;
	%ELSE
	    nlb$[NLB$V_WAIT] = 0;
	%FI
	
	%IF $xpn$key_check( BINARY, ( option %REMOVE(options) ) )
	%THEN
	    nlb$[NLB$V_STRING] = 0;
	%ELSE
	    nlb$[NLB$V_STRING] = 1;
	%FI
	
	$xpn$call( XPN$GET, NLB$K_GET, %NAME('NLB$K_',type), success, failure )
	
	END
	%;

KEYWORDMACRO
    $XPN_DISCONNECT(
	nlb,
	type,
	string,
	binary_data,
	code,
	option,
	options,
	user,
	success,
	failure=XPN$FAILURE
	) =
	
	%IF %EXPAND $xpn$conflict( option, options )
	%THEN
	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
	%ELSE
	    %IF NOT %NULL( option %REMOVE(options) )
	    %THEN
		$xpn$ignore( $xpn$key_test( option %REMOVE(options), (WAIT),
		    'OPTION= or OPTIONS=' ) )
	    %FI
	%FI
	
	%EXPAND $xpn$required( nlb, 'NLB=' )
	%EXPAND $xpn$required( type, 'TYPE=' )
	$xpn$ignore( $xpn$key_test( type, (SYNCH,ABORT,REJECT), 'TYPE=' ) )
	
	BEGIN
	BIND nlb$ = nlb: %EXPAND $xpn$force( $XPN_NLB() );
	
	$xpn$str_declare( LOCAL, $xpn$output, string )
	%IF %EXPAND $xpn$conflict( string, binary_data )
	%THEN
	    %WARN( 'STRING= and BINARY_DATA= are mutually exclusive' )
	%ELSE
	    $xpn$bin_declare( LOCAL, $xpn$output, binary_data )
	%FI
	$xpn$str_local_init( $xpn$output, string )
	$xpn$bin_init( $xpn$output, binary_data )
	$xpn$value( nlb$, Z_USER, user )			! USER=
	$xpn$value( nlb$, G_LCL_DISC, code )			! CODE=
        %IF %NULL (string) AND %NULL (binary_data)
        %THEN
            $xpn$value( nlb$, A_OUTPUT, 0)
        %ELSE
            $xpn$descrset( nlb$, A_OUTPUT, $xpn$output, string binary_data ) ! STRING= or BINARY_DATA=
	%FI
	$xpn$option_set( ((WAIT,WAIT)), ( option %REMOVE(options) ) ); ! OPTION=
	
	$xpn$call( XPN$DISCONNECT, NLB$K_DISCONNECT,
	    %NAME('NLB$K_',type), success, failure )
	
	END
	%;

KEYWORDMACRO
    $xpn_close(
	nlb,
	user,
	option,
	options,
	success,
	failure=XPN$FAILURE
	) =
	
	%IF %EXPAND $xpn$conflict( option, options )
	%THEN
	    %WARN( 'OPTION= and OPTIONS= are mutually exclusive' )
	%ELSE
	    %IF NOT %NULL( option %REMOVE(options) )
	    %THEN
		$xpn$ignore( $xpn$option_test( (ABORT_ALL,REMEMBER),
		    ( option %REMOVE(options) ), 'OPTION= or OPTIONS=' ) )
	    %FI
	%FI
	
	%EXPAND $xpn$required( nlb, 'NLB=' )
	
	BEGIN
	BIND nlb$ = nlb: %EXPAND $xpn$force( $XPN_NLB() );
	
	$xpn$value( nlb$, Z_USER, user )			! USER=
	
	%IF $xpn$key_check( ABORT_ALL, (option %REMOVE(options)) )
	%THEN
	    nlb$[NLB$V_ABORTALL] = 1;
	%ELSE
	    nlb$[NLB$V_ABORTALL] = 0;
	%FI
	
	%IF $xpn$key_check( REMEMBER, (option %REMOVE(options)) )
	%THEN
	    nlb$[NLB$V_REMEMBER] = 1;
	%ELSE
	    nlb$[NLB$V_REMEMBER] = 0;
	%FI
	
	$xpn$call( XPN$CLOSE, XPN$K_CLOSE, 0, success, failure )
	
	END
	%;

KEYWORDMACRO
    $XPN_ERRMSG(
	code,
	buffer,
	length,
	include
	) =
	
	%IF NOT %NULL( %REMOVE(include) )
	%THEN
	    $xpn$ignore( $xpn$option_test( 
		(TEXT,IDENTIFIER,SEVERITY,FACILITY), include, 'INCLUDE=' ) )
	%FI
	
	%EXPAND $xpn$required( code, 'CODE=' )
	%EXPAND $xpn$required( buffer, 'BUFFER=' )
	%EXPAND $xpn$required( length, 'LENGTH=' )
	
	BEGIN
	EXTERNAL ROUTINE XPN$ERRMSG
	    %BLISS32( : ADDRESSING_MODE(LONG_RELATIVE) );
	
	XPN$ERRMSG( code, buffer, length,
	    $xpn$key_check( FACILITY, include )^3 OR
	    $xpn$key_check( SEVERITY, include )^2 OR
	    $xpn$key_check( IDENTIFIER, include )^1 OR
	    $xpn$key_check( TEXT, include )
	    )
	
	END
	%;

!
! BLISSNET completion code definitions
!

COMPILETIME
    $xpn$base_val = 0;				! base value for comp. codes

LITERAL
    xpn$k_vms_code	= 48,			! VMS facility code
    xpn$k_msg_code	= 0 %BLISS32( + 48^16 + 1^15 ),	! completion code constant
    xpn$k_severity_s	= 1,			! Success
    xpn$k_severity_w	= 0,			! Warning
    xpn$k_severity_i	= 3,			! Information
    xpn$k_severity_e	= 2,			! Error
    xpn$k_severity_f	= 4;			! Fatal

!+
!   This macro is for use in a SELECT statement that wants to select
!   XPN error codes (as distinct from any other codes).  This is necessary
!   in systems without globally-defined facility codes (TOPS-10 and TOPS-20,
!   for example).
!-
MACRO
    xpn$$select_xpn_errors =
        XPN$_NLBADDR,
        XPN$_NORMAL TO XPN$_MSGNOTFD1,
        XPN$_ABORTED TO XPN$_ERROR,
        XPN$_NO_OPEN TO XPN$_NO_ACCESS,
        XPN$_ACTIVE TO XPN$_ACCVIO %;

!+
!   This macro is used to define the completion codes and their
!   associated messages.
!-
MACRO
    xpn$$define_codes =
    !+
    !   The following codes are used by
    !   XPN$NF_FAILURE to display the function that caused the error and the
    !   address of the NLB.   
    !-
    %QUOTE %ASSIGN( $xpn$base_val, %QUOTE %X'0300' )

    $xpn$comp_code( NLBADDR,	I, 'for NLB at !8XL (hex)' )

    !+
    !   Now for the "normal" codes
    !-

    %QUOTE %ASSIGN( $xpn$base_val, %QUOTE %X'0400' )		! SUCCESS messages

    $xpn$comp_code( NORMAL,		S, 'normal successful completion' )
    $xpn$comp_code( NO_EVENT,	S, 'no event has occurred' )
    $xpn$comp_code( CONNECT,	S, 'connect request pending' )
    $xpn$comp_code( INTERRUPT,	S, 'interrupt message pending' )
    $xpn$comp_code( DATA,		S, 'data message pending' )
    $xpn$comp_code( LINK_SERV,	S, 'link service message pending' )
    $xpn$comp_code( INCOMPLETE,	S, 'operation incomplete' )
    $xpn$comp_code( COMPLETED,	S, 'previous operation completed' )
    $xpn$comp_code( MSGNOTFND,	S, 'message not found' )
    $xpn$comp_code( BUFFEROVF,	S, 'message text overflows buffer; truncated' )
    $xpn$comp_code( MSGNOTFD1,	S, 
        'message not found; message number = !8XL (hex)' )

    %QUOTE %ASSIGN( $xpn$base_val, %QUOTE %X'1400' )		! WARNING messages

    $xpn$comp_code( ABORTED,	W, 'link has been aborted' )
    $xpn$comp_code( DISCONN,	W, 'link has been disconnected' )
    $xpn$comp_code( MSGTRUNC,	W, 'message truncated to sixteen characters' )
    !+
    !   The following code MUST be a warning message under VMS.
    !-
    $xpn$comp_code( ERROR,	W, '!AS from !AS' )

    %QUOTE %ASSIGN( $xpn$base_val, %QUOTE %X'2400' )		! ERROR messages

    $xpn$comp_code( NO_OPEN,	E, 'operating system failed to open link' )
    $xpn$comp_code( NO_NET,		E, 'DECnet is not available' )
    $xpn$comp_code( NO_PRIV,	E, 'insufficient privilege for attempted operation' )
    $xpn$comp_code( ABORT,		E, 'physical link went down' )
    $xpn$comp_code( DEVOFFLINE,	E, 'physical link shutting down' )
    $xpn$comp_code( NO_MEMORY,	E, 'insufficient dynamic memory to complete request' )
    $xpn$comp_code( NO_LINKS,	E, 'no logical links available' )
    $xpn$comp_code( DIR_FULL,	E, 'network name/object data base is full' )
    $xpn$comp_code( DUPLICATE,	E, 'network name/object already declared by another process' )
    $xpn$comp_code( NOSUCHNODE,	E, 'node is unknown' )
    $xpn$comp_code( UNREACH,	E, 'node is known but unreachable' )
    $xpn$comp_code( NOSUCHOBJ,	E, 'object is unknown at local or remote node' )
    $xpn$comp_code( REJECTED,	E, 'connect request rejected' )
    $xpn$comp_code( TIMEOUT,	E, 'request completion time limit expired' )
    $xpn$comp_code( FREE_MEM,	E, 'error freeing dynamic memory' )
    $xpn$comp_code( GET_MEM,	E, 'error allocating dynamic memory' )
    $xpn$comp_code( OVERRUN,	E, 'incoming message exceeds buffer size' )
    $xpn$comp_code( NOT_OPEN,	E, 'NLB has not been opened' )
    $xpn$comp_code( RESALLOC,	E, 
        'Error allocating operating system-dependent resource' )
    $xpn$comp_code( FREEEF,		E, 'error freeing event flag' )
    $xpn$comp_code( THIRD,		E, 'third party disconnected link' )
    $xpn$comp_code( UNEXPECTED,	E, 
        'unexpected return status from operating system' )
    $xpn$comp_code( NOSOLICIT,	E, 
        'interrupt message not solicited by partner task' )
    $xpn$comp_code( NO_ACCESS,	E, 'access information invalid at remote node' )
    $xpn$comp_code( PMR_ERROR,  E, 'poor-man''s routing error')

    %QUOTE %ASSIGN( $xpn$base_val, %QUOTE %X'4400' )	! FATAL messages

    $xpn$comp_code( ACTIVE,		F, 
        'link must be PASSIVE for connect accept or reject' )
    $xpn$comp_code( BAD_NLB,	F, 'invalid NLB' )
    $xpn$comp_code( BAD_SIZE,	F, 'invalid NLB size field' )
    $xpn$comp_code( BAD_DESCR,	F, 'NLB contains invalid descriptor' )
    $xpn$comp_code( BADVECTOR,	F, 'NLB vector length LEQ zero' )
    $xpn$comp_code( VERSION,	F, 'NLB version does not match Interface version' )
    $xpn$comp_code( BAD_FLAGS,	F, 'invalid or inconsistent NLB flag settings' )
    $xpn$comp_code( BUG,		F, 'internal BLISS/DECnet Interface error' )
    $xpn$comp_code( BAD_REQ,	F, 'invalid request code in NLB' )
    $xpn$comp_code( BAD_ADDR,	F, 'invalid memory address' )
    $xpn$comp_code( ILLOGIC,	F, 'operation requested out of sequence' )
    $xpn$comp_code( IVCONNECT,	F, 'error in connect information' )
    $xpn$comp_code( NO_NODE,	F, 'no node name specified' )
    $xpn$comp_code( IVNODELEN,	F, 'node name length LSS 0 or GTR 6' )
    $xpn$comp_code( NO_PWD,		F, 'password must be specified if username is specified' )
    $xpn$comp_code( IVUSERLEN,	F, 'username length LSS 0 or GTR 8' )
    $xpn$comp_code( IVPWDLEN,	F, 'password length LSS 0 or GTR 8' )
    $xpn$comp_code( IVACCTLEN,	F, 'account length LSS 0 or GTR 16' )
    $xpn$comp_code( IVFORMAT,	F, 'object descriptor format missing or invalid' )
    $xpn$comp_code( NO_OBJECT,	F, 'no object number specified' )
    $xpn$comp_code( NO_DESCR,	F, 'format 1 or 2 requested but no object descriptor specified' )
    $xpn$comp_code( IVDESCLEN,	F, 'bad object descriptor length' )
    $xpn$comp_code( IVOPTLEN,	F, 'optional data length LSS 0 or GTR 16' )
    $xpn$comp_code( NOUSRCODE,	F, 'format 2 requested but user code not specified' )
    $xpn$comp_code( NOGRPCODE,	F, 'format 2 requested but no group code specified' )
    $xpn$comp_code( FUNCTION,	F, 'invalid NLB function code' )
    $xpn$comp_code( SUBFUNC,	F, 'NLB subfunction field conflicts with requested operation' )
    $xpn$comp_code( NOREQUEST,	F, 'no connect request pending' )
    $xpn$comp_code( BAD_NCB,	F, 'bad Network Connect Block' )
    $xpn$comp_code( ACCVIO,		F, 'cannot read or write memory location' )

    %;                      ! End of xpn$$define_codes


!
! $XPN$COMP_CODE - Generates a LITERAL declaration of XPN$_name as a completion
!		   code value of severity 'severity'.  The base value of the
!		   completion code is in compiletime variable $XPN$BASE_VAL,
!		   which is incremented by 8 as a result of this macro call.
!		   The value for the completion code is:
!
!		   	$XPN$BASE_VAL
!
!		   in BLISS16,
!
!                       $XPN$BASE_VAL + XPN$K_SEVERITY_severity
!
!                  in BLISS36, and
!
!			%X'00488000' + $XPN$BASE_VAL + XPN$K_SEVERITY_severity
!
!		   in BLISS32.
MACRO
    $xpn$comp_code( name, severity, text ) =
	
	LITERAL %NAME( 'XPN$_', name ) =
	
	xpn$k_msg_code + $xpn$base_val
	
	%BLISS32( + %NAME( 'XPN$K_SEVERITY_', severity ) )
	
	%BLISS36( + %NAME( 'XPN$K_SEVERITY_', severity ) )

        ;

	%ASSIGN( $xpn$base_val, $xpn$base_val + 8 )
	
	%;

xpn$$define_codes