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