Google
 

Trailing-Edge - PDP-10 Archives - TOPS-20_V6.1_DECnetSrc_7-23-85 - mcb/nmx/nmxpar.req
There is 1 other file named nmxpar.req in the archive. Click here to see a list.
!                    COPYRIGHT (c) 1980, 1981, 1982
!                    DIGITAL EQUIPMENT CORPORATION
!                        Maynard, Massachusetts
!
!     This software is furnished under a license and may  be  used
!     and copied only in accordance with the terms of such license
!     and with the inclusion of the above copyright notice.   This
!     software  or any other copies thereof may not be provided or
!     otherwise made available to any other person.  No  title  to
!     and ownership of the software is hereby transferred.
!
!     The information  in  this  software  is  subject  to  change
!     without  notice  and should not be construed as a commitment
!     by DIGITAL EQUIPMENT CORPORATION.
!
!     DIGITAL assumes no responsibility for the use or reliability
!     of  its  software  on  equipment  which  is  not supplied by
!     DIGITAL.

!+
! NMX Specific Parameters
!-
%if not %declared (XPO$K_VERSION) %then library 'XPORTX' %fi;
%if not %declared (MCB$K_VERSION) %then library 'MCBLIB' %fi;
library 'NMXLIB';
require 'RSXLIB';
require 'BLI:RSXEFC';

$show(all)

!+
! NMX linkages
!-

linkage
    NMX$LKG_CCB = jsr (register = 4),
    NMX$LKG_DB_IOP = jsr (register = 5, register = 1),
    NMX$LKG_NMXID = jsr (register = 1),
    NMX$LKG_TYP_ENT = jsr (register = 0, register = 1),
    NMX$LKG_UCB_IOP = jsr (register = 5, register = 1);

!+
! NMX Global Routine Name Synonyms
!-

macro
    NMX$GET_NMX_CCB = NX_ITC %,         ! Convert IOP to CCB for NMX
    NMX$MAP_ENTITY_ID_TO_DB = NM_ENT %, ! Map entity-id into DB
    NMX$MAP_NMXID_TO_DB = NM_NMX %,     ! Map NMXID into DB
    NMX$RETURN_NMX_CCB = NX_RTC %;      ! Return NMX CCB

!+
! Macros for global routines
!-

macro
    $NMX_GET_NMX_CCB (IOP, CCB) =
        begin
        %if not %declared (NMXDB)
        %then
        %if not %declared (MCB$GAW_PROCESS_DATA_BASE)
        %then
        external MCB$GAW_PROCESS_DATA_BASE : vector [2];
        %fi
        bind NMXDB = MCB$GAW_PROCESS_DATA_BASE [1] : ref NMXDB_BLOCK;
        %fi

        external routine
            NMX$GET_NMX_CCB : NMX$LKG_DB_IOP;

        (CCB = NMX$GET_NMX_CCB (NMXDB [NMX_BASE], IOP)) neqa 0
        end %,
    $NMX_MAP_ENTITY_ID (TYPE, ENTITY_PTR) =
        begin

        external routine
            NMX$MAP_ENTITY_ID_TO_DB : NMX$LKG_TYP_ENT;

        NMX$MAP_ENTITY_ID_TO_DB (TYPE, ENTITY_PTR)
        end %,
    $NMX_MAP_NMXID (NMXID) =
        begin

        external routine
            NMX$MAP_NMXID_TO_DB : NMX$LKG_NMXID;

        NMX$MAP_NMXID_TO_DB (NMXID)
        end %,
    $NMX_RETURN_NMX_CCB (CCB) =
        begin

        external routine
            NMX$RETURN_NMX_CCB : NMX$LKG_CCB novalue;

        NMX$RETURN_NMX_CCB (CCB);
        end %,
    $NMX_RETURN_RSX_IOP (IOP, STS, CNT) =
        begin
        %if not %declared (NMXDB)
        %then
        %if not %declared (MCB$GAW_PROCESS_DATA_BASE)
        %then
        external MCB$GAW_PROCESS_DATA_BASE : vector [2];
        %fi
        bind NMXDB = MCB$GAW_PROCESS_DATA_BASE [1] : ref NMXDB_BLOCK;
        %fi

        local
            $NMX$UCB : ref block field (UCB_FIELDS);

        $MCB_MCB_TO_RSX (NMXDB [NMX_BASE], $NMX$UCB);
        $RSX_FINISH_IOP (.$NMX$UCB, IOP, STS, CNT);
        $MCB_RSX_TO_MCB (.$NMX$UCB);
        end %;
!+
! NMX Signal Definitions
!-
DECLARE_SEVERITY (NMX, ERROR, SEVERE);

$NMX_SEVERE (NMX$_ILE, 'Internal Logic Error')
$NMX_SEVERE (NMX$_NNX, 'No NMX Process')
$NMX_SEVERE (NMX$_IFM, 'Invalid Function Modifier')      
$NMX_SEVERE (NMX$_ICP, 'Invalid CCB Parameters')
$NMX_ERROR (NMX$_IEC, 'Invalid Event Class')
$NMX_SEVERE (NMX$_IID, 'Invalid NMXID')


!
literal
    true = (1 eql 1),
    false = (1 eql 0);

macro
     RAD50 =
         %if %bliss(bliss36)
         %then %rad50_10
         %else %rad50_11
         %fi %;

structure
    BYTE_VECTOR [I; N] =
    %bliss16([N] (BYTE_VECTOR + I)<0, 8>)
    %bliss36([N/4] (BYTE_VECTOR + I/4)<(I mod 4)*8, 8>)
    ;

!
! Macro - PUTB
!
! Function - To write a 8 bit value to the next position in
!            a DECnet byte string.  The pointer to the byte
!            string is updated to point to the next free position.
!
! Parameters -
!
!    VAL        8 Bit value to write
!    PTR_ADR    Address of byte string pointer
!

macro
     PUTB (VAL,PTR_ADR) =
         ch$wchar_a(VAL,PTR_ADR) % ;

!
! Macro - PUTW
!
! Function - To write a 16 bit value as the next two bytes in
!            a DECnet byte string.  The pointer to the byte
!            string is updated to point to the next free position.
!
! Parameters -
!
!    VAL_PTR    Address of 16 bit value to write
!    PTR_ADR    Address of byte string pointer

macro
     PUTV (VAL,PTR_ADR) =
         begin
         ch$wchar_a((VAL and %o'377'),PTR_ADR);
         ch$wchar_a((VAL^-8 and %o'377'),PTR_ADR);
         end %,
     PUTW (VAL_PTR,PTR_ADR) = 
         begin
         bind VAL_ADR = VAL_PTR;
         ch$wchar_a(.VAL_ADR<0,8,0>,PTR_ADR);
         ch$wchar_a(.VAL_ADR<8,8,0>,PTR_ADR);
         end % ;

!
!+
! Additional field definitions for IOP used by NMX
!-

$field                                  ! This block is based at I_PRM in IOPs
    NMX_OVERLAY_IOP_FIELDS =
        set
           $overlay (I_PRM)
        I_NMX_BIAS = [$address],        ! Buffer Descriptor Bias
        I_NMX_ADDR = [$address],        ! Buffer Descriptor Offset
        I_NMX_CNT = [$integer],         ! Buffer length
        I_NMX_TYPE = [$integer],        ! NMX_TYPE_FIELD in IOP
        I_NMX_ENTITY = [$address],      ! Address in user space of entity
        I_NMX_QUALIFIER= [$address],    ! Address in user space of qualifier
        I_NMX_TIME = [$address],        ! Address in user space of time block
           $continue
           $overlay (I_NMX_TYPE)
         I_NM_QUAL = [$sub_field (I_NMX_TYPE, N$QUAL)],
	 I_NM_FUNC = [$sub_field (I_NMX_TYPE, N$FFNC)],
	 I_NM_ENTITY = [$sub_field (I_NMX_TYPE, N$IENT)],
	 I_NM_SELECT = [$sub_field (I_NMX_TYPE, N$SELE)]
           $continue
        tes;

macro
     NMX_IOP_BLOCK =
         block field(IOP_FIELDS, NMX_OVERLAY_IOP_FIELDS) %;

!
! RSX I/O Function Codes
!

literal
    IOP_KIL = 0,			! Cancel I/O
    IOP_WLB = 1,			! Write Logical Block
    IOP_RLB = 2,			! Read Logical Block
    IOP_ATT = 3,			! Attach Device
    IOP_DET = 4,			! Detach Device
    IOP_MOU = 5,			! Mount Volume
    IOP_DMO = 6,			! Dismount Volume
    IOP_CLO = 7,			! Network close, from RSX
    IOP_FNA = 10,			! Find File in Directory
    IOP_RNA = 11,                       ! Remove File in Directory
    IOP_ENA = 12,                       ! Enter File in Directory
    IOP_ACR = 13,                       ! Access File for Read
    IOP_ACW = 14,                       ! Access File for Write
    IOP_ACE = 15,                       ! Access File for Extend
    IOP_DAC = 16,                       ! Deaccess File
    IOP_RVB = 17,                       ! Read Virtual Block
    IOP_WVB = 18,                       ! Write Virtual Block
    IOP_EXT = 19,                       ! Extend File
    IOP_CRE = 20,                       ! Create File
    IOP_DEL = 21,                       ! Delete File
    IOP_RAT = 22,                       ! Read File Attributes
    IOP_WAT = 23,                       ! Write File Attributes
    IOP_XMT = 25,			! Transmit data
    IOP_RCV = 26,			! Receive data
    IOP_CON = 27,			! Connect processing
    IOP_DSC = 28,			! Disconnect processing
    IOP_CTL = 29;			! Control
!+
! Additional field definitions for CCB used by NMX
!-

$field
     NMX_OVERLAY_CCB_FIELDS =
         set
            $overlay(C_LIX)
         C_NMX_EID = [$integer],        ! Full EID specification
            $continue
            $overlay (C_PRM1)
         C_NMX_TYPE = [$address],       ! NMX_TYPE_FIELD in CCB
            $continue
            $overlay (C_PRM3)
         C_NMX_CNT = [$address],        ! Amount left in buffer
         C_NMX_STATE = [$address],      ! Current processing State for function
         C_NMX_IOP = [$address]         ! Address of IOP for this CCB
            $continue
         tes;

macro
     NMX_CCB_BLOCK =
         block field(C_NM_FIELDS, NMX_OVERLAY_CCB_FIELDS) %;

literal
       NMX_NMPAR_SIZE = NMX_NMPAR_LEN,
       NMX_NMPAR_ALLOCATION = NMX_NMPAR_LENGTH;

macro
     NMX_NMPAR_BLOCK =
         block[NMX_NMPAR_SIZE] field(NMX_NMPAR_FIELDS) %;

!++
! Entity state machine descriptions
!--
$literal
    ST$INI = $distinct,		        ! (not sent yet)
    ST$SC  = $distinct,		        ! Session Control
    ST$NSP = $distinct,                 ! Network Services
    ST$XPT = $distinct,                 ! Transport
    ST$OWN = $distinct,                 ! Line/circuit Owner
    ST$PRO = $distinct,                 ! Line/circuit Provider
    ST$DON = 0,                         ! Done
    ST$LO = min (ST$INI, ST$SC, ST$NSP, ST$XPT, ST$OWN, ST$PRO, ST$DON),
    ST$HI = max (ST$INI, ST$SC, ST$NSP, ST$XPT, ST$OWN, ST$PRO, ST$DON);
!
! Entity data base entry.
! This field set describes an entry in the NMX data base
! which contains the information to find an entity block
! for the supported entities (LINE, CIRCUIT, and MODULE).
!

$field
    NMX_ENTITY_BLOCK_FIELDS =
        set
        NMX_ENTITY_BLOCK_BIAS = [$integer],
        NMX_ENTITY_BLOCK_ADDRESS = [$address],
        NMX_ENTITY_BLOCK_ENTRIES = [$integer],
        NMX_ENTITY_BLOCK_LENGTH = [$address]
        tes;

literal
    NMX_ENTITY_BLOCK_SIZE = $field_set_size,
    NMX_ENTITY_BLOCK_ALLOCATION = $field_set_units;

macro
    NMX_ENTITY_BLOCK =
        block[NMX_ENTITY_BLOCK_SIZE] field (NMX_ENTITY_BLOCK_FIELDS) %;

!
!       Event queue block
!
$field
    NMX_EVENT_FIELDS =
        set
        EVENT_QUEUE = [$sub_block(2)],  ! Queue of Processed Events
        EVENT_QUEUE_COUNT = [$tiny_integer],    ! Number of Outstanding Events
        EVENT_QUEUE_LENGTH = [$tiny_integer],   ! Maximum event queue depth
        EVENTS_PROCESSED = [$integer],  ! Events processed
        EVENTS_LOST = [$integer]        ! Events lost
        tes;

literal
    NMX_EVENT_SIZE = $field_set_size,
    NMX_EVENT_ALLOCATION = $field_set_units;

macro
    NMX_EVENT_BLOCK =
        block[NMX_EVENT_SIZE] field (NMX_EVENT_FIELDS) %;
!
!       Event filter mask block
!
$field
    NMX_FILTER_FIELDS =
        set
        FILTER_MASK = [$BITS (32)]      ! 32 bit mask
        tes;

literal
    NMX_FILTER_SIZE = $field_set_size,
    NMX_FILTER_ALLOCATION = $field_set_units;
!
!	NMX Resident Data Base format
!
$field
    NMXDB_FIELDS =
        set
        NMX_BASE = [$sub_block (0)],    ! Field for base of NMXDB
        NMX_TIMER_COUNT = [$byte],      ! MCB LLC Timer Service Byte
        NMX_TIMER_BYTE  = [$byte],      ! Reserved Byte
        NMX_NMX_EID = [$integer],
            $overlay (NMX_NMX_EID)
        NMX_NMX_LIN = [$byte],
        NMX_NMX_PIX = [$byte],          ! PIX of NMX process
            $continue
        NMX_SC_EID = [$integer],
            $overlay (NMX_SC_EID)
        NMX_SC_LIN = [$byte],
        NMX_SC_PIX = [$byte],           ! PIX of SC process
            $continue
        NMX_NSP_EID = [$integer],
            $overlay (NMX_NSP_EID)
        NMX_NSP_LIN = [$byte],
        NMX_NSP_PIX = [$byte],          ! PIX of NSP process
            $continue
        NMX_XPT_EID = [$integer],
            $overlay (NMX_XPT_EID)
        NMX_XPT_LIN = [$byte],
        NMX_XPT_PIX = [$byte],          ! PIX of XPT process
            $continue
        NMX_LINES = [$sub_block(NMX_ENTITY_BLOCK_SIZE)],
        NMX_CIRCUITS = [$sub_block(NMX_ENTITY_BLOCK_SIZE)],
        NMX_MODULES = [$sub_block(NMX_ENTITY_BLOCK_SIZE)],
        NMX_EXECUTOR_NUMBER = [$integer],       ! Executor node-id
        NMX_EXECUTOR_NAME = [$byte_string (7)],
           $overlay (NMX_EXECUTOR_NAME)
        NMX_EXECUTOR_NAME_LENGTH = [$tiny_integer],
           $continue
        NMX_NEXT_LUN_ID = [$tiny_integer],
            $align (fullword)
        NMX_LUN_QUEUE = [$sub_block(2)],   ! Queue of Open LUN Blocks
                                           ! Event Filter Masks for classes
        NMX_EVENT_FILTERS = [$sub_block(7*NMX_FILTER_SIZE)], ! [0 to 6]
        NMX_SYSTEM_FILTERS = [$sub_block(NMX_FILTER_SIZE)],  ! [96 to 127]
        NMX_EVENT_QUEUE = [$sub_block (NMX_EVENT_SIZE)],
        NMX_EVENT_IOPS = [$sub_block(2)],  ! Queue of IOPs awaiting Events
        NMX_EVENTS_SIGNALED = [$integer],  ! Number of Events Signaled
        NMX_EVENTS_LOGGED = [$integer],    ! Number of Events Logged
        NMX_NMLINI_ADDR = [$address],      ! NML initialization buffer address
        NMX_NMLINI_CNT = [$short_integer]  ! NML initialization buffer length
        tes;

literal
       NMXDB_SIZE = $field_set_size,
       NMXDB_ALLOCATION = $field_set_units,
       MAX_EVENT_QUEUE_DEPTH = 3;	!added here 01OCT81 used in LOG_EVENT

macro
     NMXDB_BLOCK =
        block[NMXDB_SIZE] field(NMXDB_FIELDS) %;
!
$field
      NMX_GENERAL_FIELDS =              ! These define common fields in entity blocks
          set
          GENERAL_NAME = [$byte_string (17)],  ! The Name of this Entity in I-16 format
              $overlay (GENERAL_NAME)
          GENERAL_NAME_LENGTH = [$tiny_integer],
              $continue
          GENERAL_SYSTEM_FLAGS = [$byte],       ! Specified at Create Time
          $align(word)
          GENERAL_ID = [$integer],      ! The Logging ID for this Entity
              $overlay (GENERAL_ID)
              GENERAL_ID_INDEX = [$byte],       ! The Table Index
              GENERAL_ID_TYPE = [$byte],        ! The Entity Type
              $continue
          GENERAL_PROVIDER_ID = [$integer],     ! The Provider's CCB Id
              $overlay (GENERAL_PROVIDER_ID)
              GENERAL_PROVIDER_LIX = [$byte],   ! Line Index (Well,... Almost)
              GENERAL_PROVIDER_PIX = [$byte],   ! Process Index
              $continue
          GENERAL_OWNER_ID = [$integer],        ! The Owner's CCB Id
              $overlay (GENERAL_OWNER_ID)
              GENERAL_OWNER_LIX = [$byte],      ! Line Index (Well,... Almost)
              GENERAL_OWNER_PIX = [$byte]       ! Process Index
              $continue
          tes;

literal
       NMX_GENERAL_SIZE = $field_set_size,
       NMX_GENERAL_ALLOCATION = $field_set_units;

macro
     NMX_GENERAL_BLOCK =
         block[NMX_GENERAL_SIZE] field(NMX_GENERAL_FIELDS) %;

!+
! Link service block
!-

$field
    NMX_LINK_FIELDS =
        set
        LINK_GENERAL = [$sub_block(NMX_GENERAL_SIZE)],
        LINK_USER_ID = [$integer],
        LINK_LUN_BLOCK = [$address],     ! Address of assigned LUN block
        LINK_STATE = [$tiny_integer],
        LINK_SUBSTATE = [$tiny_integer],
        LINK_SERVICE_STATE = [$tiny_integer],
        LINK_SERVICE_SUBSTATE = [$tiny_integer]
        tes;

literal
    NMX_LINK_SIZE = $field_set_size,
    NMX_LINK_ALLOCATION = $field_set_units;

macro
    NMX_LINK_BLOCK =
        block[NMX_LINK_SIZE] field (NMX_GENERAL_FIELDS, NMX_LINK_FIELDS) %;

$literal
    SS$OFF = $DISTINCT,
    SS$PASSIVE = 0,                     ! Link service states
    SS$PASSIVE_OPEN = $DISTINCT,
    SS$REFLECTING = $DISTINCT,
    SS$CLOSED = $DISTINCT,
    SS$OPEN = $DISTINCT,
    SS$CLOSED_REFLECTING = $DISTINCT,
    SS$HIGH = max (SS$OFF, SS$PASSIVE, SS$PASSIVE_OPEN, SS$REFLECTING, SS$CLOSED, SS$OPEN, SS$CLOSED_REFLECTING);

$literal
    SB$IDLE = 0,                        ! Line service substates
    SB$REFLECTING = $DISTINCT,
    SB$LOADING = $DISTINCT,
    SB$DUMPING = $DISTINCT,
    SB$TRIGGERING = $DISTINCT,
    SB$LOOPING = $DISTINCT;

$field
    NMX_CIRCUIT_FIELDS =                ! These define the CIRCUIT_BLOCK
	set
        CIRCUIT_LINK = [$sub_block(NMX_LINK_SIZE)],
        $align(word)
        CIRCUIT_SERVICE_TIMER = [$integer]
	tes;

literal
        NMX_CIRCUIT_BLOCK_SIZE = $field_set_size,
        NMX_CIRCUIT_BLOCK_ALLOCATION = $field_set_units;

macro
     NMX_CIRCUIT_BLOCK =
         block [NMX_CIRCUIT_BLOCK_SIZE] field(NMX_CIRCUIT_FIELDS, NMX_LINK_FIELDS, NMX_GENERAL_FIELDS) %;
!
$field
    NMX_LINE_FIELDS =                   ! These define the LINE_BLOCK
	set
        LINE_LINK = [$sub_block(NMX_LINK_SIZE)]
        $align(word)
	tes;

literal
        NMX_LINE_BLOCK_SIZE = $field_set_size,
        NMX_LINE_BLOCK_ALLOCATION = $field_set_units;

macro
     NMX_LINE_BLOCK =
         block [NMX_LINE_BLOCK_SIZE] field(NMX_LINE_FIELDS, NMX_LINK_FIELDS, NMX_GENERAL_FIELDS) %;
!
$field
    NMX_MODULE_FIELDS =                ! These define the MODULE_BLOCK
	set
        MODULE_GENERAL = [$sub_block(NMX_GENERAL_SIZE)]
	tes;

literal
        NMX_MODULE_BLOCK_SIZE = $field_set_size,
        NMX_MODULE_BLOCK_ALLOCATION = $field_set_units;

macro
     NMX_MODULE_BLOCK =
         block [NMX_MODULE_BLOCK_SIZE] field(NMX_MODULE_FIELDS, NMX_GENERAL_FIELDS) %;
!
!
macro $NM$_SUC =
      NM$SUC
      %print('Function Completed Successfuly') %;
!
!+
! NMX Queue Management Definitions
!-

! Field mapping for queue header
$field QHD_FIELDS =
    set
    Q_HEAD = [$address],
    Q_TAIL = [$address]
    tes;

macro
    $NMX_QUEUE_INITIALIZE (QUE) =
        begin
	bind
	    $NMX$QUE = QUE: block field (QHD_FIELDS);

        $NMX$QUE [Q_HEAD] = 0;
        $NMX$QUE [Q_TAIL] = $NMX$QUE [Q_HEAD]
        end %,

    $NMX_ENQUEUE (QUE, STR) =		! Queue STR to tail of QUE
	begin
	bind
	    $NMX$QUE = QUE: block field (QHD_FIELDS),
	    $NMX$STR = STR: block field (QHD_FIELDS);

	$NMX$STR [Q_HEAD] = 0;
	.$NMX$QUE [Q_TAIL] = $NMX$STR [Q_HEAD];
	$NMX$QUE [Q_TAIL] = $NMX$STR [Q_HEAD]
	end %,

    $NMX_DEQUEUE (QUE, STR) =		! Dequeue from QUE to STR
	begin

        linkage
            $NMX$LKG_QUE = jsr (register = 0; register = 1) :
                nopreserve (1, 2, 3) preserve (0, 4, 5) clearstack valuecbit;

        external routine
            $QRMVF : $NMX$LKG_QUE;

        ! not C-bit = true

        not $QRMVF (QUE; STR)
	end %;
!
$show(none)
!
!	*** End of NMXPAR ***
!