Google
 

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

!++
!
! FACILITY: MCB Network Management
!
! ABSTRACT:
!
!    Event Preprocessing and conversion of Network Event Items is
!    accomplished here. SIGNALed events are filtered before passing
!    to a higher user.
!
!
! ENVIRONMENT: MCB V3.0
!
! AUTHOR: Scott G. Robinson	CREATION DATE: 14-OCT-80
!
! MODIFIED BY:
!
! 01 - Support MCB V3.1 Signal Dispatch
! 02 - Update to MCB V3.2 Naming Conventions
! 03 - Add support for MCB Event Logging
! 04 - LOG_EVENT: log EVENTS_LOST_EVENT if NMX event queue exceeds a max length
! 05 - Move def of MAX_EVENT_QUEUE_DEPTH to NMXPAR
! 06 - Change line/circuit references to common link block
! 07 - Use new event queue data block
! 08 - Use new event filter masks
! 09 - Fix un-mapping bug (return without re-map to OLD_BIAS) in LOG_EVENT.
!       Alan D. Peckham, 14-Apr-82
! 10 - Complete rework of NM support.
!      Construct event message at QIO time.
! 11 - Fix length bug in TRY_SOME_EVENTS.
! 12 - Change message format for events going to NML.
!      Update EVENTS_PROCESSED when an event is transferred to an IOP.
!      Change event CCB buffer de-allocation in order to handle access msg.
! 13 - Update EVENT_QUEUE_COUNT and EVENTS_PROCESSED only on event.
!--

!
! INCLUDE FILES:
!

library 'XPORTX';

library 'MCBLIB';

library 'NMXPAR';

library 'NMXLIB';

!
! TABLE OF CONTENTS:
!

forward routine
    EVPRLB : NMX$LKG_UCB_IOP novalue,
    EVPWAT : MCB_DB_CCB novalue,
    $NMEVT,
    LOG_EVENT : CALL$ novalue,
    TRY_SOME_EVENTS : LINKAGE_DB novalue;

!
! Literal values
!

literal
    EVENTS_LOST_EVENT = 0^0 + 0,
    PARAMETER_COUNT = 0,
    SIGNAL_CODE = 1,
    EVENT_CODE = 2,
    EVENT_ENTITY = 3,
    EVENT_BUFFER_PTR = 4;

!
global routine EVPRLB (UCB, IOP) : NMX$LKG_UCB_IOP novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!--

    begin

    map
        IOP : ref NMX_IOP_BLOCK;

    local
	NMXDB : ref NMXDB_BLOCK;

    $MCB_RSX_TO_MCB (.UCB, NMXDB);
!
! Add the IOP to the queue and try to process an Event Buffer
!
    $NMX_ENQUEUE (NMXDB [NMX_EVENT_IOPS], .IOP);
    TRY_SOME_EVENTS (NMXDB [NMX_BASE]);
    $MCB_MCB_TO_RSX (NMXDB [NMX_BASE]);
    end;					!of EVPRLB
global routine EVPWAT (NMXDB, CCB) : MCB_DB_CCB novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!--

    begin

    map
	CCB : ref block field (C_NM_FIELDS),
	NMXDB : ref NMXDB_BLOCK;

    CCB [C_STS] = $NM$ERR_URC;          ! Unrecognized Entity Applies Here
    !
    ! Not ready for this
    !
    $NMX_RETURN_NMX_CCB (.CCB);
    end;                                ! of EVPWAT
global routine $NMEVT (SIGV, MV, NMXDB) = 	!Signal Event Processor

!++
! FUNCTIONAL DESCRIPTION:
!
!    This routine is dispatched by the MCB from the Secondary Signal Vector.
!    If the Signal was for CE$EVT then we process the signal otherwise we let
!    it fall through to other service routines.
!
!
! FORMAL PARAMETERS:
!
!	MV - the mechanism vector
!       SIGV - the Signal Parameter vector
!       NMXDB - the Enable Vector (which points at NMXs data base)
!
! IMPLICIT INPUTS:
!
!	Misc NMXDB items
!
! IMPLICIT OUTPUTS:
!
!       Misc NMXDB items
!
! ROUTINE VALUE:
!
!	true - if we processed the Signal
!       false - if we didn't process the Signal
!
! SIDE EFFECTS:
!
!	Can call itself (NMX) with a process synchronous call.
!--

    begin

    map
	MV : ref vector,			! Mechanism Vector
	SIGV : ref vector,			! Signal Vector
	NMXDB : ref NMXDB_BLOCK;		! NMX Data Base

!
! Return true if for us otherwise false
!

    if .SIGV [SIGNAL_CODE] neq CE$EVT then return false;

    if .SIGV [PARAMETER_COUNT] neq 4 then return false;

    if .SIGV [EVENT_CODE] neq ((96 + 5)^6 + 13)
    then
        begin

        local
            EV_ADR : ref vector,
            EV_WORD;

        NMXDB [NMX_EVENTS_SIGNALED] = .NMXDB [NMX_EVENTS_SIGNALED] + 1;

        selectoneu (EV_ADR = .(SIGV [EVENT_CODE]) <6, 9, 0>) of
            set
            [0 to 6] :
                begin
                EV_ADR = .EV_ADR*NMX_FILTER_ALLOCATION;
                EV_ADR = .EV_ADR + NMXDB [NMX_EVENT_FILTERS];
                end;
            [96 to 127] :
                EV_ADR = NMXDB [NMX_SYSTEM_FILTERS];
            [otherwise] :
                return true;
            tes;

        EV_WORD = .EV_ADR [0];
        EV_ADR = EV_ADR [1]; %(force auto-increment)%

        if .(SIGV [EVENT_CODE]) <4, 1> neq 0
        then
            EV_WORD = .EV_ADR [0];

        EV_WORD = .EV_WORD^-.(SIGV [EVENT_CODE]) <0, 4>;

        if .EV_WORD then CALL$P (LOG_EVENT, .NMXDB [NMX_NMX_PIX], .SIGV);

        end
    else
        CALL$P (LOG_EVENT, .NMXDB [NMX_NMX_PIX], SIGV [0]);

    true
    end;					!of $NMEVT
routine LOG_EVENT (SIGV) : CALL$ novalue = 	!Log an Event

!++
! FUNCTIONAL DESCRIPTION:
!
!    LOG_EVENT is called to actually build an Event Buffer and queue it
!    for processing by an RSX Task. Event queue lengths are monitored to
!    handle lost events.
!
!
! FORMAL PARAMETERS:
!
!    .SIGV - Address of the Signal Parameter Vector
!
! IMPLICIT INPUTS:
!
!    Various NMXDB items
!
! IMPLICIT OUTPUTS:
!
!    Various NMXDB items
!
! COMPLETION CODES:
!
!	None
!
! SIDE EFFECTS:
!
!       I/O Packets could be completed to RSX.
!--

    begin

    map
	SIGV : ref vector;			! Signal Vector

    stacklocal
        OLD_MAP;

    local
	CCB : ref block field (C_NM_FIELDS);

    external
	MCB$GAW_PROCESS_DATA_BASE : vector [2];

    bind
	NMXDB = MCB$GAW_PROCESS_DATA_BASE [1] : ref NMXDB_BLOCK,
        EVTDB = NMXDB[NMX_EVENT_QUEUE] : NMX_EVENT_BLOCK;

    SMAP$ (OLD_MAP);
    NMXDB [NMX_EVENTS_LOGGED] = .NMXDB [NMX_EVENTS_LOGGED] + 1;

!
! Check queue depth: if full, discard signal and count a lost event.
!                             then call try_some_events to unload the queue
!                             then return
!
    if .EVTDB[EVENT_QUEUE_COUNT] eql .EVTDB[EVENT_QUEUE_LENGTH]
    then
        begin
        EVTDB[EVENTS_LOST] = .EVTDB[EVENTS_LOST] + 1;
        MAP$ (.OLD_MAP);
        return;
        end;

!
! If logging this event would fill the queue, change the event to a lost_event
!
    EVTDB [EVENT_QUEUE_COUNT] = .EVTDB [EVENT_QUEUE_COUNT] + 1;

    if .EVTDB[EVENT_QUEUE_COUNT] eql .EVTDB[EVENT_QUEUE_LENGTH]
    then
        begin

        field
            LAST_CCB = [1, 0, %bpaddr, 0];

        CCB = .EVTDB [$sub_field (EVENT_QUEUE, LAST_CCB)];

        if .CCB neqa 0
        then

            if (.CCB [C_PRM1] neq 0) and
               (.CCB [C_PRM2] eql EVENTS_LOST_EVENT)
            then
                begin
                EVTDB[EVENT_QUEUE_COUNT] = .EVTDB[EVENT_QUEUE_COUNT] - 1;
                EVTDB [EVENTS_LOST] = .EVTDB [EVENTS_LOST] + 1;
                MAP$ (.OLD_MAP);
                return;
                end;

        EVTDB[EVENTS_LOST] = .EVTDB[EVENTS_LOST] + 1;
        SIGV [EVENT_CODE] = EVENTS_LOST_EVENT;
        SIGV [EVENT_ENTITY] = 0;
        end;

!
! Try to allocate a CCB and a buffer if failed update a counter;
! If successful then the CCB Buffer is mapped
!

    if not $MCB_GET_CCB (CCB)
    then
	begin
        EVTDB [EVENT_QUEUE_COUNT] = .EVTDB [EVENT_QUEUE_COUNT] - 1;

        if .SIGV [EVENT_CODE] neq EVENTS_LOST_EVENT
        then
            EVTDB [EVENTS_LOST] = .EVTDB [EVENTS_LOST] + 1;

        MAP$ (.OLD_MAP);
	return;
	end;

    CCB [C_PRM1] = 1;                   ! Event message
    CCB [C_PRM3] = 0;                   ! No entity type
    CCB [C_PRM5] = 0;                   ! No buffer at present

    if (CCB [C_PRM2] = .SIGV [EVENT_CODE]) gtr 0
    then
        begin                           ! LINE, CIRCUIT, or MODULE entity

        if (CCB [C_PRM4] = .SIGV [EVENT_ENTITY]) gtr 0
        then
            (CCB [C_PRM3])<0, 8> = .(CCB [C_PRM4])<8, 8>;

        CCB [C_PRM3] = .CCB [C_PRM3] - 1;
        end
    else
        begin                           ! NODE or NO entity
        (CCB [C_PRM2])<15, 1> = 0;

        if (CCB [C_PRM4] = .SIGV [EVENT_ENTITY]) eql 0
        then
            CCB [C_PRM3] = .CCB [C_PRM3] - 1;

        end;

    begin

    local
        CNT,
        PTR;

    PTR = .SIGV [EVENT_BUFFER_PTR];
    CNT = ch$rchar_a (PTR);

    if (CCB [C_CNT] = .CNT) neq 0
    then
        begin

        local
            BUF;

        if $MCB_GET_BUFFER (.CNT, BUF)
        then
            begin
            CCB [C_ADDR] = .BUF;
            SMAP$ (CCB [C_BIAS]);
            CCB [C_PRM5] = .CNT;
            $MCB_MOVE_BUFFER_TO_BUFFER (.CNT, .PTR, .BUF);
            end
        else
            CCB [C_CNT] = 0;

        end;

    end;
!
! We have the Event Buffer. Queue the CCB into the Event Queue and try to
! notify an RSX user.
!
    $MCB_QUEUE_CCB (EVTDB [EVENT_QUEUE], .CCB);
    TRY_SOME_EVENTS (NMXDB [NMX_BASE]);
    MAP$ (.OLD_MAP);
    end;					!of LOG_EVENT
routine TRY_SOME_EVENTS (NMXDB) : LINKAGE_DB novalue =

!++
! FUNCTIONAL DESCRIPTION:
!
!    TRY_SOME_EVENTS tries to give some events from the Event Queue to
!    an RSX task.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!       NMXDB EVENT and IOP Queues
!
! IMPLICIT OUTPUTS:
!
!       NMXDB EVENT and IOP Queues
!
! COMPLETION CODES:
!
!	None
!
! SIDE EFFECTS:
!
!       This routine must be called in MCB mode!
!--

    begin

    map
	NMXDB : ref NMXDB_BLOCK;

    bind
        EVTDB = NMXDB [NMX_EVENT_QUEUE] : NMX_EVENT_BLOCK,
	IOPQ = NMXDB [NMX_EVENT_IOPS] : vector;

    while true do
	begin

        label
            FILL_BUFFER;

        stacklocal
	    ERROR_CODE;

	local
	    AMOUNT,
	    CCB : ref block field (C_NM_FIELDS),
	    IOP : ref NMX_IOP_BLOCK;

        bind
            LEFT = ERROR_CODE,
            PTR = AMOUNT;

        !
        ! Look for waiting event and IOP to transfer it to
        !

        if (IOP = .IOPQ [0]) eqla 0 then exitloop;

        if (CCB = .vector [EVTDB [EVENT_QUEUE], 0]) eqla 0 then exitloop;

        !
        ! Construct message in IOP buffer from CCB
        !
FILL_BUFFER :
        begin                       ! FILL_BUFFER
        MAP$ (.IOP [I_NMX_BIAS]);
        PTR = .IOP [I_NMX_ADDR];
        LEFT = .IOP [I_NMX_CNT];

        if (LEFT = .LEFT - 1) lss 0
        then leave FILL_BUFFER with ERROR_CODE = $NM$ERR_OCM;

        ch$wchar (.CCB [C_PRM1], .PTR); ! Message type

        if ch$rchar_a (PTR) eql 1
        then
            begin
            EVTDB [EVENT_QUEUE_COUNT] = .EVTDB [EVENT_QUEUE_COUNT] - 1;
            EVTDB [EVENTS_PROCESSED] = .EVTDB [EVENTS_PROCESSED] + 1;

            if (LEFT = .LEFT - 4) lss 0
            then leave FILL_BUFFER with ERROR_CODE = $NM$ERR_OCM;

            PUTW (CCB [C_PRM2], PTR);   ! Event Class and Type (2 bytes)
            !
            ! Now the EVENT ENTITY
            !
            begin                       ! EVENT ENTITY
            PUTW (CCB [C_PRM3], PTR);   ! ENTITY TYPE

            case .CCB [C_PRM3] from 0 to 4 of   ! ENTITY ID
                set
                [0] :                   ! NODE entity
                    begin

                    if (LEFT = .LEFT - 2) lss 0 then leave FILL_BUFFER with ERROR_CODE = $NM$ERR_OCM;

                    PUTW (CCB [C_PRM4], PTR);
                    end;
                [1, 3, 4] :             ! LINE, CIRCUIT, or MODULE entity
                    begin

                    local
                        ENTITY_BLOCK : ref block field (NMX_GENERAL_FIELDS);

                    if (ENTITY_BLOCK = $NMX_MAP_NMXID (.CCB [C_PRM4])) neqa 0
                    then
                        begin

                        bind
                            ID_LEN = .ENTITY_BLOCK [GENERAL_NAME_LENGTH] + 1,
                            ID_PTR = byt$ptr (ENTITY_BLOCK [GENERAL_NAME_LENGTH]);

                        if (LEFT = .LEFT - ID_LEN) lss 0 then leave FILL_BUFFER with ERROR_CODE = $NM$ERR_OCM;

                        $MCB_MOVE_BUFFER_TO_BUFFER (ID_LEN, ID_PTR,
                                                    (.IOP [I_NMX_BIAS], .PTR));
                        PTR = ch$plus (.PTR, ID_LEN);
                        end
                    else
                        begin           ! Bad NMXID
                        PTR = ch$plus (.PTR, -2);
                        PUTV (-1, PTR);
                        end;

                    MAP$ (.IOP [I_NMX_BIAS]);
                    end;
                [inrange, outrange] :
                    0;                  ! NO entity
                tes;

            end;
            end;
        !
        ! Now the EVENT DATA
        !

        if (LEFT = .LEFT - .CCB [C_CNT]) lss 0 then leave FILL_BUFFER with ERROR_CODE = $NM$ERR_OCM;

	$MCB_MOVE_BUFFER_TO_BUFFER (.CCB [C_CNT], (.CCB [C_BIAS], .CCB [C_ADDR]), .PTR);
        PTR = ch$plus (.PTR, .CCB [C_CNT]);
        ERROR_CODE = NM$SUC;
        end;                        ! FILL_BUFFER
        PTR = ch$diff (.PTR, .IOP [I_NMX_ADDR]);
        AMOUNT = .PTR;
        !
        ! Complete IOP
        !
	$NMX_DEQUEUE (IOPQ, IOP);       ! Dequeue IOP
	$NMX_RETURN_RSX_IOP (.IOP, .ERROR_CODE, .AMOUNT);
        !
        ! Return resources 
        !
	$MCB_DEQUEUE_CCB (EVTDB [EVENT_QUEUE], CCB);    ! Dequeue Event
        MAP$ (.CCB [C_BIAS]);

        if .CCB [C_PRM5] neq 0
        then
            $MCB_RETURN_BUFFER (.CCB [C_PRM5], .CCB [C_ADDR]);

        $MCB_RETURN_CCB (.CCB);
	end;

    end;					!of TRY_SOME_EVENTS

end

eludom
! Local Modes:
! Comment Column:36
! Comment Start:!
! Mode:BLISS
! Auto Save Mode:2
! End: