Trailing-Edge
-
PDP-10 Archives
-
BB-X117B-SB_1986
-
10,7/nml/nmlevd.bli
There is 1 other file named nmlevd.bli in the archive. Click here to see a list.
! UPD ID= 238, SNARK:<6.1.NML>NMLEVD.BLI.7, 20-Jan-85 16:48:21 by GLINDELL
! 1. Remove debugging code that did implicit SET KNOWN EVENTS for console
! and monitor.
! 2. Add event 96.0 to the monitor filter table
!
! UPD ID= 204, SNARK:<6.1.NML>NMLEVD.BLI.6, 10-Dec-84 15:24:15 by HALPIN
! Get MONSYM Library file out of default directory, not BLI:
!
! UPD ID= 86, SLICE:<6.1.NML>NMLEVD.BLI.5, 18-Sep-84 15:00:18 by GUNN
! WORK:<GUNN.NML>NMLEVD.BLI.3 21-Aug-84 14:43:32, Edit by GUNN
!
! Remove definition of $NTSLM. It is in now MONSYM.
!
! WORK:<GUNN.NML>NMLEVD.BLI.2 21-Aug-84 12:06:09, Edit by GUNN
!
! Change to accomodate new LIBRARY conventions. MONSYM.L36 and JLNKG.L36
! are now explicity declared here rather than in NMULIB.
!
! UPD ID= 62, SNARK:<6.1.NML>NMLEVD.BLI.4, 26-Jun-84 16:04:56 by GLINDELL
! Module too big: a 'field' should be a '$field'
!
! UPD ID= 37, SNARK:<6.1.NML>NMLEVD.BLI.3, 24-May-84 16:28:33 by GLINDELL
! Check size of response buffer when writing to it on SHOW commands
!
! PH4:<GLINDELL>NMLEVD.BLI.2 29-Feb-84 20:31:39, Edit by GLINDELL
! Ident 3.
! APPLY_FILTER tested for 0 instead of for $true at return of callback.
!
! PH4:<GLINDELL>NMLEVD.BLI.13 16-Feb-84 13:14:43, Edit by GLINDELL
! Ident 2.
! Move the database to get the event text to NMARCH.
! Minor other changes
!
! PH4:<GLINDELL>NMLEVD.BLI.80 1-Feb-84 13:05:59, Edit by GLINDELL
!
! Continue work on event logger database
%title 'NMLEVD -- NML Event Logger Database handler'
module NMLEVD (
ident = 'X04.03'
) =
begin
! COPYRIGHT (c) 1984 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! 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: DECnet-10/20 V4.0 Network Management Layer (NML)
!
! ABSTRACT:
!
! This module contains the routines that interface to the EVENT
! LOGGER volatile database.
!
! ENVIRONMENT: TOPS-10/20 User mode under NML
!
! AUTHOR: Gunnar Lindell, 22-Dec-1983
!
!--
!
! INCLUDE FILES
!
library 'NMLLIB'; ! All required definitions
%if $TOPS20
%then
library 'MONSYM'; ! Monitor symbols
library 'JLNKG'; ! JSYS linkage definitions
%fi
%if $TOPS10
%then literal $NTSLM = -4;
%fi
require 'NMLEXT'; ! NML external routines
!
! TABLE OF CONTENTS
!
! Global routines (called from other modules) have names that begin with
! NML$EVL_. Local routines are the rest.
forward routine
NML$EVL_INITIALIZE : novalue, ! Initialize data base
NML$EVL_INSERT_PARAMETER, ! Insert logging parameter
NICE_DECODE, ! Decode NICE messages
PROCESS_EVENT, ! Process event
INSERT_EVENT, ! Insert event
FIND_EVENT, ! Search database
RECOMPUTE_MONITOR_FILTER :
novalue, ! Recompute the monitor filter
RECOMPUTE_CLASS_FILTER :
novalue, ! Recompute the filters for a class
NML$EVL_DELETE_PARAMETER, ! Delete logging parameter
DELETE_EVENT, ! Delete event
CLEAN_UP: novalue, ! Clean up after deleting events
FIND_NEXT_CLASS, ! Search for next non-zero class
NML$EVL_READ_EVENTS, ! Read logging parameter
SHOW_SINK_NODE, ! Show events for a sink node
EVENT_ENCODE : novalue, ! Make NICE response of an event
NML$EVL_APPLY_FILTER, ! Apply all relevant filters
SEARCH_FILTER, ! Search for filters
NML$EVL_SET_VDB_PARAMETER, ! NML internal SET logging parameter
NML$EVL_CLR_VDB_PARAMETER, ! NML internal CLEAR logging parameter
NML$EVL_GET_VDB_PARAMETER, ! NML internal READ logging parameter
NML$EVL_EVENT_TEXT, ! Get the event text for an event
SINK_NODE_MATCH, ! Match sink node (NMU$QUEUE_SCAN)
CLASS_MATCH, ! Match class (NMU$QUEUE_SCAN)
EVENT_ENTITY_MATCH, ! Match event entity block ( " ")
ENTITY_FILTER_MATCH, ! Match event entity block ( " ")
GET_MEMORY, ! Memory allocator
RELEASE_MEMORY : novalue ! Memory deallocator
;
!
! External routines
!
external routine
NMU$NETWORK_LOCAL, ! Get local node address and name
NML$CONVERT_ENTITY_ID; ! Convert entity ID
!
! Local macros
!
! The BYTE8(N) generates a subblock for N 8-bit bytes.
macro
$byte8(N) = $sub_block((N+3)/4) %;
!
! DECnet parameters and bit fields
!
! Parameter numbers:
literal
SINK_NODE_PARAMETER = 200,
EVENT_PARAMETER = 201;
! Bit fields for CONSOLE, FILE and MONITOR sinks.
macro
CONSOLE_MASK = 0,1,0 %,
FILE_MASK = 1,1,0 %,
MONITOR_MASK = 2,1,0 %,
SINK_MASK = 0,3,0 %;
! Bit fields for EVENT CLASS and "EVENT QUALIFIER" in NICE messages
macro
NICE_EVENT_CLASS_MASK = 0,9,0 %,
NICE_EVENT_QUALIFIER_MASK = 14,2 %;
!++
!
! Generate event code table. This table contains all events that are
! known (generated) by the host.
!
! The table contains event class and type, event applicability and the
! event text.
!
! The applicability field determines whether the event is associated with
! a particular entity on the local node, with no entity on the local node,
! with all entities on the local node or only with remote nodes.
! Define the fields of an event entry in the table.
$field EVENT_LIST_FIELDS =
set
EV_CLASS = [ $short_integer ],
EV_TYPE = [ $short_integer ],
EV_APPL = [ $short_integer ],
EV_TEXT = [ $integer ]
tes;
literal
EVENT_LIST_SIZE = $field_set_size;
! GEN_EVENT_TABLE and GEN1_EVENT_TABLE generate the preset value for
! one event
macro GEN_EVENT_TABLE[NAM] =
GEN1_EVENT_TABLE(%count, %remove(NAM)) %;
macro GEN1_EVENT_TABLE(INDEX,A,B,C,D) =
[INDEX, EV_CLASS] = A,
[INDEX, EV_TYPE] = B,
[INDEX, EV_APPL] = C,
[INDEX, EV_TEXT] = ch$ptr(uplit(%asciz D)) %;
! MAKE_EVENT_TABLE generates the event table
!
! NML$EVENTS (the events) are generated in NMARCH
macro MAKE_EVENT_TABLE [] =
literal NR_EVENTS = %length;
own EVENT_TABLE : blockvector[NR_EVENTS, EVENT_LIST_SIZE]
field (EVENT_LIST_FIELDS)
preset (GEN_EVENT_TABLE(%remaining)) %;
! Now expand the event table
MAKE_EVENT_TABLE($NML$EVENTS);
! The list of event classes that the monitor might generate are listed here.
! RECOMPUTE_MONITOR_FILTER accesses this list to find out what global
! masks it has to care about. Also, there is a parallell data table to
! this table that holds the current global masks. The size of that table
! (MONITOR_FILTER_TABLE) is generated in the macro expansion.
! The $MONITOR_FILTER macro generates counts the arguments and puts that
! into a compile-time constant.
compiletime
MONITOR_FILTER_COUNT = 0;
macro
$MONITOR_FILTER [F1] =
%assign(MONITOR_FILTER_COUNT , MONITOR_FILTER_COUNT + 1)
F1 %;
! The monitor currently generates event classes 2 through 6. Add to the
! list below if needed.
bind MONITOR_FILTER_ADR = plit($MONITOR_FILTER(2,3,4,5,6,96));
!++
!
! Define FILTER
!
! FILTER is a data structure that will represent one filter mask. A filter
! mask represents the event types within an event class. There are a maximum
! of 32 event types within an event class. If bit 0 in BLISS sense is set,
! that means that event type 0 shall be logged and NOT filtered.
!
!--
macro
$FILTER = $bits(32) %;
!++
!
! Define EVENT_ENTITY_BLOCK
!
! The EVENT_ENTITY_BLOCK represents the filter associated to a source
! entity. The source entity can be AREA, CIRCUIT, LINE, MODULE or NODE.
! In the block, the entity type is kept as well as the entity ID or name.
! The filter for the entity is also kept, as well as queue link information.
! The event class for the entity is implied by the CLASS_BLOCK that points
! to the EVENT_ENTITY_BLOCK
!
!--
$field
EVENT_ENTITY_FIELDS =
set
EVENT_ENTITY_QUEUE = [ $sub_block(Q_ENTRY_SIZE) ],
EVENT_ENTITY_TYPE = [ $tiny_integer ],
EVENT_ENTITY_ID = [ $byte8(2 + max(0,9,17)) ],
EVENT_ENTITY_FILTER = [ $filter ]
tes;
literal
EVENT_ENTITY_SIZE = $field_set_size,
EVENT_ENTITY_ALLOCATION = $field_set_units;
macro
EVENT_ENTITY_BLOCK = block [ EVENT_ENTITY_SIZE ]
field ( EVENT_ENTITY_FIELDS ) %;
!++
!
! Define CLASS_FILTER
!
! The CLASS_FILTER is a subblock within the CLASS_BLOCK structure.
! It represents the filter information associated with one event class.
! The event class number is implied by its position within the CLASS_
! BLOCK along with the CLASS_LOW and CLASS_HIGH specifiers. The CLASS_
! FILTER points to a list of EVENT_ENTITY_BLOCKS. If there is no entity
! that matches there is also a "catch-all" global filter defined.
!
!--
$field CLASS_FILTER_FIELDS =
set
GLOBAL_FILTER = [ $filter ],
QH_EVENT_ENTITY = [ $sub_block(Q_HEADER_SIZE) ]
tes;
literal
CLASS_FILTER_SIZE = $field_set_size;
macro
CLASS_FILTER_BLOCK = block [ CLASS_FILTER_SIZE ]
field (CLASS_FILTER_FIELDS) %;
!++
!
! Define CLASS_BLOCK
!
! The CLASS_BLOCK represents the filter information for a sequence of
! 8 event classes. The CLASS_LOW and the CLASS_HIGH gives the boundaries
! of the event classes. The CLASS_LOW is always a multiple of 8. (Note
! that the CLASS_HIGH is superfluous information).
!
! For each class within the sequence a CLASS_FILTER subblock is allocated.
! See above for a description of the CLASS_FILTER.
!
! The CLASS_BLOCK also has queue information to link it to the other
! CLASS_BLOCK's.
!
! Note: It will only be useful to represent event classes that can be
! generated on the local system. (Remote events are not filtered).
! The local event classes are:
! 0-6 NML to physical link layer
! 96-127 TOPS-10/TOPS-20 specific events
! It is assumed that only one of the TOPS-20 specific classes will
! be needed. Therefore, more than two CLASS_BLOCKs will seldom be
! used. The first one will contain all the common classes 0-7 so
! this points to a reasonably efficient representation of data.
!
!++
$field
CLASS_FIELDS =
set
CLASS_QUEUE = [ $sub_block(Q_ENTRY_SIZE) ],
CLASS_LOW = [ $integer ],
CLASS_HIGH = [ $integer ],
CLASS_FILTER_AREA = [ $sub_block(8 * CLASS_FILTER_SIZE) ]
tes;
literal
CLASS_SIZE = $field_set_size,
CLASS_ALLOCATION = $field_set_units;
macro
CLASS_BLOCK = block [ CLASS_SIZE ] field ( CLASS_FIELDS ) %;
!++
!
! Define SINK_NODE_BLOCK
!
! The SINK_NODE_BLOCK represents one sink node and the local sinks
! on that sink node. It contains the sink node name for identification.
! The sink node name is represented as 2 bytes with the node number,
! 1 byte length of node name (possibly 0) followed by 6 bytes of node
! name. For easy reference, the flag SINK_NODE_LOCAL is set if this is the
! local node.
!
! The SINK_NODE_BLOCK has a CLASS_BLOCK queue header for each local sink
! on the sink node. If the local sink is not active, the CLASS_BLOCK list
! will not contain any entries.
!
! Also there is information on what transmitter queue that services this
! sink node. This is an index that the event logger module NMXEVT will use.
!
! To string all SINK_NODE_BLOCKs together, there is queue information.
!
! The head of the event data structure is QH_SINK_NODES that point to
! the first SINK_NODE_BLOCK.
!
!--
$field
SINK_NODE_FIELDS =
set
SINK_NODE_QUEUE = [ $sub_block(Q_ENTRY_SIZE) ],
SINK_NODE_NAME = [ $byte8(NODE_ID_BUFFER_LENGTH) ],
SINK_NODE_LOCAL = [ $bits(1) ],
QH_CONSOLE_CLASS = [ $sub_block(Q_HEADER_SIZE) ],
QH_FILE_CLASS = [ $sub_block(Q_HEADER_SIZE) ],
QH_MONITOR_CLASS = [ $sub_block(Q_HEADER_SIZE) ]
tes;
literal
SINK_NODE_SIZE = $field_set_size,
SINK_NODE_ALLOCATION = $field_set_units;
macro
SINK_NODE_BLOCK = block [ SINK_NODE_SIZE ] field (SINK_NODE_FIELDS) %;
!++
!
! Here follows a brief layout of the structure of the database:
!
! QH_SINK_NODES
! |
! |
! v
! SINK_NODE_BLOCK
! | QH_FILE_CLASS ----> CLASS_BLOCK
! | QH_CONSOLE_CLASS | CLASS_LOW
! | | CLASS_HIGH
! | | 8 * CLASS_FILTER_AREA
! | | QH_EVENT_ENTITY ---------> EVENT_ENTITY_BLOCK
! | | GLOBAL_FILTER | ENTITY_ID
! | | | FILTER
! | | |
! | | |
! | | EVENT_ENTITY_BLOCK
! | |
! | CLASS_BLOCK
! |
! |
! SINK_NODE_BLOCK
!
!--
!++
!
! Define NICE_BLOCK
!
! The routines to insert and delete parameters (NML$EVL_INSERT_PARAMETER and
! NML$EVL_DELETE_PARAMETER) need to scan parts of a NICE message to get the
! SINK NODE and EVENT parameters and their values.
!
! For simplicity there is one scanning routine that does all the work.
! The result is put into a NICE_BLOCK for further use.
!
! The NICE_BLOCK contains the sink node name in canonical format,
! the sink type {CONSOLE, FILE and MONITOR}, a flag "KNOWN EVENTS"
! signifying all local events, the event class and filter, the event
! entity type that applies (can be NO_ENTITY) and the entity ID in
! canonical format.
!
! Only one instance of a NICE_BLOCK will exist.
!
!--
$field NICE_BLOCK_FIELDS =
set
NB_SINK_NODE_ID = [ $byte8(NODE_ID_BUFFER_LENGTH) ],
NB_SINK_TYPE = [ $tiny_integer ],
NB_KNOWN_EVENTS = [ $bits(1) ],
NB_EVENT_CLASS = [ $integer ],
NB_EVENT_FILTER = [ $filter ],
NB_EVENT_ENTITY_TYPE = [ $tiny_integer ],
NB_EVENT_ENTITY_ID = [ $byte8(2 + max(0,9,17)) ]
tes;
literal
NICE_BLOCK_SIZE = $field_set_size;
macro
NICE_BLOCK = block [ NICE_BLOCK_SIZE] field ( NICE_BLOCK_FIELDS ) %;
!++
!
! Define FILTER_BLOCK
!
! The routine that searches the filter data base (NML$EVL_APPLY_FILTER) and
! the subroutines it calls, need a way to communicate what they are
! searching for.
!
! The FILTER BLOCK contains what sink types the event should be logged at,
! the event class and type, the entity type (possibly NO_ENTITY_) and the
! entity ID. There is also a bit set if this is event 0.0 that has to be
! special cased.
!
! There will be one instance of a FILTER_BLOCK.
!
!--
$field FILTER_BLOCK_FIELDS =
set
FB_SINK_FLAGS = [ $bits(3) ],
$overlay(FB_SINK_FLAGS)
FB_SINK_CONSOLE = [ $bits(1) ],
FB_SINK_FILE = [ $bits(1) ],
FB_SINK_MONITOR = [ $bits(1) ],
FB_EV_0_0 = [ $bits(1) ],
FB_EVENT_CLASS = [ $short_integer ],
FB_EVENT_FILTER = [ $filter ],
FB_ENTITY_TYPE = [ $tiny_integer ],
FB_ENTITY_ID = [ $byte8(2 + max(0,9,17))]
tes;
literal
FILTER_BLOCK_SIZE = $field_set_size;
macro
FILTER_BLOCK = block [ FILTER_BLOCK_SIZE ] field ( FILTER_BLOCK_FIELDS) %;
!++
!
! Define SHOW_BLOCK
!
! The routines that reads through the database to return all events
! uses a SHOW_BLOCK for communication. The principle is the same as
! for the NICE_BLOCK and the FILTER_BLOCK.
!
! The top level READ/SHOW routine NML$EVL_READ_EVENTS will set the
! values in the SHOW_BLOCK, and subroutines will read parameters
! off the SHOW_BLOCK
!
! Only one instance of a SHOW_BLOCK will exist.
!
!--
$field SHOW_BLOCK_FIELDS =
set
SB_RETPTR = [ $address ],
SB_SINK_SENT = [ $bits(1) ],
SB_SINK_TYPE = [ $tiny_integer ],
SB_SINK_NODE_ID = [ $byte8(NODE_ID_BUFFER_LENGTH) ]
tes;
literal
SHOW_BLOCK_SIZE = $field_set_size;
macro
SHOW_BLOCK = block [ SHOW_BLOCK_SIZE ] field ( SHOW_BLOCK_FIELDS ) %;
!++
!
! Data declarations
!
!--
! Define sink node queue header. This is the head of the data base, and leads
! to everything else.
own
QH_SINK_NODES : Q_HEADER;
! Define nice block. This is the only instance of a nice block and is used in
! several routines.
own
NB : NICE_BLOCK;
! Define filter block. This is the only instance of a filter block and it is
! used in NML$EVL_APPLY_FILTER and subordinates.
own
FB : FILTER_BLOCK;
! Define show block. This is the only instance of a show block and it is
! used in NML$EVL_READ_EVENTS and subordinates
own
SB: SHOW_BLOCK;
! Define global pointers. These are used by all routines.
own
SINK_NODE_PTR : ref SINK_NODE_BLOCK,
QH_CLASS : ref Q_HEADER,
CLASS_PTR : ref CLASS_BLOCK,
CLASS_FILTER_PTR : ref CLASS_FILTER_BLOCK,
EVENT_ENTITY_PTR : ref EVENT_ENTITY_BLOCK;
! Define MONITOR_FILTER_TABLE. This table is maintained by RECOMPUTE_MONITOR_
! FILTER and keeps the current global masks. The size of the table is
! determined by the compiletime constant MONITOR_FILTER_COUNT.
own
MONITOR_FILTER_TABLE : vector[MONITOR_FILTER_COUNT];
%global_routine('NML$EVL_INITIALIZE') : novalue =
! DDT name: ED%INI
!++
!
! Functional description:
!
! Resets sink node queue header.
! Performs equivalent to 'SET LOGGING FILE KNOWN EVENTS'
!
!--
!++
!
! Design notes:
!
! NML$EVL_INITIALIZE initializes the event logger volatile database.
! It is called by NML$VDB_INITIALIZE in NMLVDB.
!
! 1. The sink node queue header is reset.
! 2. The equivalent of 'SET LOGGING FILE SINK EXECUTOR KNOWN EVENTS'
! is performed.
!
! (2) is accomplished by writing appropriate data into a NICE_BLOCK
! and calling PROCESS_EVENT(INSERT_EVENT)
!
!--
begin
! Reset the sink node queue header
NMU$QUEUE_RESET(QH_SINK_NODES);
! Now perform the equivalent of
!
! NCP> SET LOGGING FILE KNOWN EVENTS SINK EXECUTOR
!
! Setup the NB block and call PROCESS_EVENT
if NML$CONVERT_ENTITY_ID( ENTITY_NODE, %ref(0),
ch$ptr(NB[NB_SINK_NODE_ID],,8)) neq $true
then begin
TASK_INFO(
'INTERNAL ERROR: Could not initialize event database'
);
return;
end;
NB[NB_SINK_TYPE] = FILE_ ;
NB[NB_KNOWN_EVENTS] = $true;
NB[NB_EVENT_ENTITY_TYPE] = NO_ENTITY_ ;
if PROCESS_EVENT(INSERT_EVENT) neq NICE$_SUC
then begin
TASK_INFO(
'INTERNAL ERROR IN NMLT20: Could not initialize event database'
);
return;
end;
return;
end; ! End of NML$EVL_INITIALIZE
%global_routine('NML$EVL_INSERT_PARAMETER', ENTITY_TYPE, QUALIFIER,
PARM_LEN, PARM_PTR) =
! DDT name: ED%INS
!++
!
! FUNCTIONAL DESCRIPTION
!
! Insert a parameter in the logging database
!
! FORMAL PARAMETERS
!
! ENTITY_TYPE Character pointer to entity type
! QUALIFIER Character sequence pointer to the qualifier parameter
! PARM_LEN The length of the parameter data
! PARM_PTR Character sequence pointer to the parameter data
!
! ROUTINE VALUE
!
! NICE return code
!
! SIDE EFFECTS
!
! NONE
!
!--
!++
!
! Design notes:
!
! NML$EVL_INSERT_PARAMETER inserts an event parameter into the
! event logger volatile database. It is called by VDB_CHANGE in
! NMLVDB.
!
! 1. NICE_DECODE is called to decode the NICE message, extract
! the data and write the data to a NICE_BLOCK. All routines
! noted below will use the NICE_BLOCK.
! 2. PROCESS_EVENT will then be called with INSERT_EVENT as
! coroutine.
! 3. PROCESS_EVENT is a "jacket" routine that resolves the
! 'KNOWN SINKS' case. It calls a supplied coroutine to process
! each relevant sink (console, file and monitor).
! 4. INSERT_EVENT will call FIND_EVENT to locate the relevant data
! block. FIND_EVENT can optionally build the data structure on
! its way through the data structure, and this option is used
! by INSERT_EVENT.
! 5. FIND_EVENT returns with pointers set up to point to the data
! blocks in question, existing before or newly created.
! 6. INSERT_EVENT stores the event filters into the database
! 7. RECOMPUTE_MONITOR_FILTER is called to recompute the global
! filter mask.
!
!--
begin
! Call NICE_DECODE to decode the incoming NICE message (or rather the
! parameter part of the message) into a NICE_BLOCK (NB).
if ( NICE_DECODE( .ENTITY_TYPE, .QUALIFIER, .PARM_LEN, .PARM_PTR)
eql $false ) then return NICE$_IMF; ! Illegal message format
! Call PROCESS_EVENT to do the job
return PROCESS_EVENT(INSERT_EVENT);
end; ! End of NML$EVL_INSERT_PARAMETER
%routine('NICE_DECODE' , ENTITY_TYPE, QUALIFIER,
PARM_LEN, PARM_PTR) =
!++
!
! Functional description:
!
! Decompose NICE message to NICE_BLOCK
!
! Formal parameters:
!
! ENTITY_TYPE Pointer to entity type
! QUALIFIER Character sequence pointer to the qualifier parameter
! PARM_LEN The length of the parameter data
! PARM_PTR Character sequence pointer to the parameter data
!
! Returns: $false syntax error
! $true all well
!
!--
!++
!
! For reference, some NCP commands and their NICE representation is listed
! below:
! (SET LOGGING MONITOR prefix and corresponding NICE prefix is
! excluded. Also, SINK NODE parameter is 310 octal, and EVENT
! parameter is 311 octal)
!
! EVENT 4.1 311 000 377 004 000 001 002
! EVENT 4.1-5 311 000 377 004 000 001 016
! EVENT 4.* 311 000 377 004 200
! KNOWN EVENTS 311 000 377 000 300
!
! EVENT 4.1 CIRCUIT DTE-0-1 311 000 003 007 "D" "T" "E" "-" "0" "-" "1"
! 004 000 001 002
!
! NODE ETHER:: 311 000 000 005 "E" "T" "H" "E" "R"
! 004 000 001 002
!
! NODE 124 311 000 000 000 174 000 004 000 001 002
!
! EVENT 4.1 SINK NODE ETHER:: 311 000 377 004 000 001 002 310 000 005
! "E" "T" "H" "E" "R"
!
! SINK NODE 124 311 000 377 004 000 001 002 310 000 000
! 174 000
!--
begin
! Copy qualifying sink node to NB block, and default local node if necessary
if .QUALIFIER neq 0
then begin ! There is a qualifier around
if GETW(QUALIFIER) neq SINK_NODE_PARAMETER
then return $false;
end;
if NML$CONVERT_ENTITY_ID( ENTITY_NODE, QUALIFIER,
ch$ptr(NB[NB_SINK_NODE_ID],,8)) neq $true
then return $false;
! Get logging sink type
NB[NB_SINK_TYPE] = GETB(ENTITY_TYPE);
! Verify that it the event parameter
if GETW(PARM_PTR) neq EVENT_PARAMETER then return $false;
! Now get the EVENT_ENTITY_TYPE (signed byte) and EVENT_ENTITY_ID
begin
local TMP : $SIGNED_BYTE_VALUE;
TMP = GETB(PARM_PTR);
NB[NB_EVENT_ENTITY_TYPE] = .TMP[VALUE];
end;
if NML$CONVERT_ENTITY_ID( .NB[NB_EVENT_ENTITY_TYPE], PARM_PTR,
ch$ptr(NB[NB_EVENT_ENTITY_ID],,8)) neq $true
then return $false;
! Now retrieve the event class and type
!
! The format is:
! 1st word: Bits 14-15 0 = single class
! 2 = all events for class
! 3 = KNOWN EVENTS
! 0-8 Event class if bits 14-15 are 0 or 2
!
! If bits 14-15 are 0 a filter is specified in the following bytes:
! Byte 1 has the count of bytes to follow; the bytes to follow have
! bit x set if filter x is filtered.
! I.e. sequence 001 002 means type 1 (001 001 would have meant type 0)
! and 002 000 001 means type 8 (Good luck.....)
!
begin
local TMP;
NB[NB_KNOWN_EVENTS] = $false; ! Initialize to false
TMP = GETW(PARM_PTR); ! Get event class word
selectone .TMP<NICE_EVENT_QUALIFIER_MASK> of
set
[0] : ! Single class
begin
local COUNT, I, TYPE_VALUE;
NB[NB_EVENT_CLASS] = .TMP<NICE_EVENT_CLASS_MASK>;
COUNT = GETB(PARM_PTR); ! Get the count byte
TYPE_VALUE = 0;
incr I from 0 to .COUNT-1 do
TYPE_VALUE = .TYPE_VALUE or (GETB(PARM_PTR) ^ (8*.I));
NB[NB_EVENT_FILTER] = .TYPE_VALUE;
end;
[1] : return $false; ! Value 1 not allowed
[2] : ! All types for class
begin
NB[NB_EVENT_CLASS] = .TMP<NICE_EVENT_CLASS_MASK>;
NB[NB_EVENT_FILTER] = -1;
end;
[3] : begin ! All known events
NB[NB_KNOWN_EVENTS] = $true;
NB[NB_EVENT_CLASS] = 0; ! Better clear
NB[NB_EVENT_FILTER] = 0;
end;
[otherwise] : return $false; ! Cannot happen....
tes;
end;
return $true;
end;
%routine('PROCESS_EVENT' , ROUTINE_TO_CALL) =
!++
!
! Functional description:
!
! This routine resolves the 'KNOWN EVENTS' case. It is called by
! NML$EVL_INSERT_PARAMETER, NML$EVL_VDB_INITIALIZE and
! NML$EVL_DELETE_PARAMETER.
!
! It dissolves the 'KNOWN EVENTS' into the single event classes and
! calls the supplied routine to process the event.
!
! Formal parameters:
!
! ROUTINE_TO_CALL The routine that will process a single event,
! typically INSERT_EVENT or DELETE_EVENT
!
! Implicit inputs:
!
! NB, the NICE BLOCK
!
! Returns:
!
! NICE message code, NICE$_SUC if all went well
!
!--
begin
bind routine
PROCESSING_ROUTINE = .ROUTINE_TO_CALL;
! If not 'KNOWN EVENTS' then its a single event.
if .NB[NB_KNOWN_EVENTS] eql $false
then begin ! Single event
if PROCESSING_ROUTINE() eql $false
then return NICE$_MPE
else return NICE$_SUC;
end
else begin
! KNOWN EVENTS: step through EVENT_TABLE and pick up all events
! that answer to the given entity
local I, ! Index
LAST_CLASS, ! Last event class seen
APPL; ! Applicability of event
LAST_CLASS = -1; ! Initialize to no class seen
! Loop over all events
incr I from 0 to NR_EVENTS - 1
do begin
! First check if this event applies
APPL = .EVENT_TABLE[.I, EV_APPL];
if (.APPL eql ANY_ENTITY)
or (.APPL eql .NB[NB_EVENT_ENTITY_TYPE])
or ((.APPL neq NO_LOCAL)
and (.NB[NB_EVENT_ENTITY_TYPE] eql NO_ENTITY_))
then begin ! This event applies
if .EVENT_TABLE[.I, EV_CLASS] neq .LAST_CLASS
then begin ! Change of class
if .LAST_CLASS neq -1
then begin ! Not first class
if PROCESSING_ROUTINE() eql $false
then return NICE$_MPE;
end;
! Come here on all changes of class
LAST_CLASS = .EVENT_TABLE[.I, EV_CLASS];
NB[NB_EVENT_CLASS] = .LAST_CLASS;
NB[NB_EVENT_FILTER] = 1 ^ .EVENT_TABLE[.I, EV_TYPE];
end
else begin ! No change of class
NB[NB_EVENT_FILTER] =
.NB[NB_EVENT_FILTER]
or 1 ^ .EVENT_TABLE[.I, EV_TYPE];
end;
end;
end;
! Falling out here there might be a class to set
if .LAST_CLASS neq -1
then if PROCESSING_ROUTINE() eql $false
then return NICE$_MPE;
end;
return NICE$_SUC;
end; ! End of PROCESS_EVENT
%routine('INSERT_EVENT') =
!++
!
! Functional description:
!
! This routine inserts a single event. It reads all data it needs
! from the NB (NICE_BLOCK) and inserts the data into the database
! appropriately.
!
! INSERT_EVENT will also call the routine that recomputes the
! monitor filter.
!
! Formal parameters:
!
! None
!
! Implicit inputs:
!
! NB, the NICE_BLOCK filled in
!
! Returns:
!
! $false Something went wrong
! $true All well
!
!--
begin
! Call FIND_EVENT to do the work. Set the create flag to make it build
! the data structures.
if FIND_EVENT( $true ) eql -1 then return $false;
! Now insert the filter: to GLOBAL_FILTER if NO_ENTITY_ , else to
! event entity filter
if .NB[NB_EVENT_ENTITY_TYPE] eql NO_ENTITY_
then
CLASS_FILTER_PTR[GLOBAL_FILTER] =
.CLASS_FILTER_PTR[GLOBAL_FILTER] or .NB[NB_EVENT_FILTER]
else
EVENT_ENTITY_PTR[EVENT_ENTITY_FILTER] =
.EVENT_ENTITY_PTR[EVENT_ENTITY_FILTER] or
.NB[NB_EVENT_FILTER]
;
! Need to recompute monitor filter, not delete operation
RECOMPUTE_MONITOR_FILTER( $false );
return $true;
end; ! End of INSERT_EVENT
%routine('FIND_EVENT' , CREATE_FLAG ) =
!++
!
! Functional description:
!
! This routine is the "workhorse" of the event data base routines.
! It will search for a specific entry, matching all criterias like
! sink node name, sink type, class number and source entity ID.
!
! Along its way it may create the data structure, and insert data
! from the NB (NICE_BLOCK). However, it will not store any filters
! into the data structures, it will merely build all structures that
! are needed to get to the point where the filters are to be stored.
! The CREATE flag is used by the INSERT_PARAMETER routine. The reason
! for the filters not being stored are that the higher level INSERT_
! PARAMETER will resolve the KNOWN_EVENTS case.
!
! Formal parameters:
!
! CREATE_FLAG If this parameter is = $TRUE then create
! data structures if needed.
!
! Implicit input:
!
! The routine assumes that NB (the NICE_BLOCK) has been setup for
! the search.
!
! Returns:
!
! -1 NMLT20 error.
!
! 0 The searched entry was not in the database. (If CREATE
! was set, it has now been created)
!
! 1 The searched entry was in the database.
!
! Implicit outputs:
!
! The following pointers have been set to point to the matching
! blocks:
!
! SINK_NODE_PTR
! CLASS_PTR
! CLASS_FILTER_PTR
! EVENT_ENTITY_PTR
!
! Note: if NO ENTITY was input, EVENT_ENTITY_PTR will be zero.
!
!--
begin
local RETURN_VALUE; ! The value to return
SINK_NODE_PTR = 0; ! Clear all pointers (just in case)
CLASS_PTR = 0;
CLASS_FILTER_PTR = 0;
EVENT_ENTITY_PTR = 0;
QH_CLASS = 0; ! Clear also pointer
RETURN_VALUE = 1; ! Assume data structure is there
! Search through the sink node list to see it this sink node exists
! before.
SINK_NODE_PTR = NMU$QUEUE_SCAN(QH_SINK_NODES,
ch$ptr(NB[NB_SINK_NODE_ID],,8),
SINK_NODE_MATCH);
! If the sink node block didnt exist, check if it should be created.
if .SINK_NODE_PTR eql 0
then begin
if .CREATE_FLAG eql $false
then return 0 ! Just return...
else begin
RETURN_VALUE = 0; ! We had to create, it wasnt there
SINK_NODE_PTR = GET_MEMORY(SINK_NODE_ALLOCATION);
ch$move(NODE_ID_BUFFER_LENGTH, ch$ptr(NB[NB_SINK_NODE_ID],,8),
ch$ptr(SINK_NODE_PTR[SINK_NODE_NAME],,8));
SINK_NODE_PTR[SINK_NODE_LOCAL] =
ch$eql(2+1+6, ch$ptr(NB[NB_SINK_NODE_ID],,8),
2+1+6, NMU$NETWORK_LOCAL(),
0);
NMU$QUEUE_RESET(SINK_NODE_PTR[QH_CONSOLE_CLASS]);
NMU$QUEUE_RESET(SINK_NODE_PTR[QH_FILE_CLASS]);
NMU$QUEUE_RESET(SINK_NODE_PTR[QH_MONITOR_CLASS]);
NMU$QUEUE_INSERT(QH_SINK_NODES,.SINK_NODE_PTR);
end;
end;
! Come here with a pointer to the sink node block in SINK_NODE_PTR.
! Proceed to pick up the correct class queue header.
case .NB[NB_SINK_TYPE] from LOGGING_LO to LOGGING_HI of
set
[CONSOLE_] : QH_CLASS = SINK_NODE_PTR[QH_CONSOLE_CLASS];
[FILE_] : QH_CLASS = SINK_NODE_PTR[QH_FILE_CLASS];
[MONITOR_] : QH_CLASS = SINK_NODE_PTR[QH_MONITOR_CLASS];
[outrange] : return -1; ! In case....
tes;
! Now we have a queue header pointing to a list of class blocks.
! Search through the list to see if this class block exists
CLASS_PTR = NMU$QUEUE_SCAN(.QH_CLASS, .NB[NB_EVENT_CLASS], CLASS_MATCH);
! If there was not a matching class block, check if it should be created.
! Remember, each class block holds 8 class filters, CLASS_LOW being a
! multiple of 8.
if .CLASS_PTR eql 0
then begin
if .CREATE_FLAG eql $false
then return 0
else begin
RETURN_VALUE = 0; ! We had to create..
CLASS_PTR = GET_MEMORY(CLASS_ALLOCATION);
CLASS_PTR[CLASS_LOW] = (.NB[NB_EVENT_CLASS]/8) * 8; ! Lower limit
CLASS_PTR[CLASS_HIGH] = .CLASS_PTR[CLASS_LOW] + 7; ! Upper limit
begin ! Reset all entity queue headers,
! store 0 into all global filters
local I; ! Just an index
CLASS_FILTER_PTR = CLASS_PTR[CLASS_FILTER_AREA];
incr I from 0 to 7 do
begin
NMU$QUEUE_RESET(CLASS_FILTER_PTR[QH_EVENT_ENTITY]);
CLASS_FILTER_PTR[GLOBAL_FILTER] = 0;
CLASS_FILTER_PTR = .CLASS_FILTER_PTR + CLASS_FILTER_SIZE;
end;
end;
NMU$QUEUE_INSERT(.QH_CLASS,.CLASS_PTR);
end;
end;
! At this point, CLASS_PTR points to the correct class block.
! First, make CLASS_FILTER_PTR point to the correct CLASS_FILTER subblock.
! Second, if the entity type was NO ENTITY then no more need to be done
CLASS_FILTER_PTR = CLASS_PTR[CLASS_FILTER_AREA] +
(.NB[NB_EVENT_CLASS] - .CLASS_PTR[CLASS_LOW]) *
CLASS_FILTER_SIZE;
if .NB[NB_EVENT_ENTITY_TYPE] eql NO_ENTITY_
then return .RETURN_VALUE ! No more to do, return value
else begin
! At this point, there is an entity specifier and we must search
! the entity lists. This is done in the usual way with NMU$QUEUE_SCAN.
! If there is no match, check if an EVENT_ENTITY block should be
! created.
EVENT_ENTITY_PTR =
NMU$QUEUE_SCAN(CLASS_FILTER_PTR[QH_EVENT_ENTITY],
NB, EVENT_ENTITY_MATCH);
if .EVENT_ENTITY_PTR eql 0
then begin
if .CREATE_FLAG eql $false
then return 0
else begin
RETURN_VALUE = 0;
EVENT_ENTITY_PTR = GET_MEMORY(EVENT_ENTITY_ALLOCATION);
EVENT_ENTITY_PTR[EVENT_ENTITY_TYPE] =
.NB[NB_EVENT_ENTITY_TYPE];
ch$move(2 + max(0,9,17), ch$ptr(NB[NB_EVENT_ENTITY_ID],,8),
ch$ptr(EVENT_ENTITY_PTR[EVENT_ENTITY_ID],,8));
EVENT_ENTITY_PTR[EVENT_ENTITY_FILTER] = 0;
NMU$QUEUE_INSERT(CLASS_FILTER_PTR[QH_EVENT_ENTITY],
.EVENT_ENTITY_PTR);
end;
end;
end;
return .RETURN_VALUE; ! Return 0 or 1
end; ! End of FIND_EVENT
%routine ('RECOMPUTE_MONITOR_FILTER' , DELETE_FLAG) : novalue =
!++
!
! Functional description:
!
! This routine will recompute the monitor filter
!
! Formal parameters:
!
! DELETE_FLAG If this parameter is $TRUE then a CLEAR on the
! database is the reason for the call, otherwise it
! is an insert.
!
! Implicit outputs:
!
! May change the global logging masks in the monitor.
!
!--
begin
local INDEX, ! Index into MONITOR_FILTER_TABLE
I, ! Just a loop index
NEW_MASK; ! The new monitor mask
! First check if this event class is used in the monitor, and if so,
! find its index.
INDEX = -1; ! Initialize
incr I from 0 to (.(MONITOR_FILTER_ADR - 1)) - 1 do
if .NB[NB_EVENT_CLASS] eql (.(MONITOR_FILTER_ADR + .I))
then begin
INDEX = .I;
exitloop;
end;
if .INDEX eql -1 then return; ! No more worries, not monitor mask
! Now check whether the routine is called as a result of an INSERT or
! DELETE.
if not .DELETE_FLAG
then ! Means INSERT, easy...
! Just take the old filter and OR with the new one. If the new and
! the old are different, set it in the monitor.
NEW_MASK = .MONITOR_FILTER_TABLE[.INDEX]
or .NB[NB_EVENT_FILTER]
else begin ! DELETE/CLEAR, more work...
! For all sinks on each sink node, locate all filters that belong
! to the event class we are recomputing for...
NEW_MASK = 0; ! Initial state
! Loop over sink nodes
SINK_NODE_PTR = 0;
while (SINK_NODE_PTR =
NMU$QUEUE_NEXT(QH_SINK_NODES,.SINK_NODE_PTR)) neq 0 do
begin
! For each sink, call RECOMPUTE_CLASS_FILTER. That routine
! will find all filters with the given event class for a
! specific sink
QH_CLASS = SINK_NODE_PTR[QH_CONSOLE_CLASS];
RECOMPUTE_CLASS_FILTER(.NB[NB_EVENT_CLASS] , NEW_MASK);
QH_CLASS = SINK_NODE_PTR[QH_FILE_CLASS];
RECOMPUTE_CLASS_FILTER(.NB[NB_EVENT_CLASS] , NEW_MASK);
QH_CLASS = SINK_NODE_PTR[QH_MONITOR_CLASS];
RECOMPUTE_CLASS_FILTER(.NB[NB_EVENT_CLASS] , NEW_MASK);
end;
end;
if .NEW_MASK neq .MONITOR_FILTER_TABLE[.INDEX]
then begin ! Set and store new filter
$$NML_INTERFACE_EXPAND(
$NTSLM, ! Function code 'SET LOGGING MASKS'
ENTITY_LOGGING, ! Entity type
0, ! No entity ID
.NEW_MASK, ! New mask goes to qualifier field
.NB[NB_EVENT_CLASS] ! Selection criteria is event class
);
MONITOR_FILTER_TABLE[.INDEX] = .NEW_MASK;
end;
return;
end; ! End of RECOMPUTE_MONITOR_FILTER
%routine ('RECOMPUTE_CLASS_FILTER' , EVENT_CLASS , MASK ) : novalue =
!++
!
! Functional description:
!
! This routine will locate all filters for a given event class and OR them
! into the word pointed to by MASK. This routine is called after a CLEAR/
! DELETE operation when monitor filters are recomputed.
!
! Formal parameters:
!
! EVENT_CLASS The event class that is being recomputed
! MASK Address of the word whereto the filters are ORed
!
! Implicit outputs:
!
! Changes word pointed to by MASK
!
!--
begin
! Find the class block that answers to this event class
CLASS_PTR = NMU$QUEUE_SCAN(.QH_CLASS, .EVENT_CLASS, CLASS_MATCH);
if .CLASS_PTR eql 0 then return; ! No work needed
! Find the class filter
CLASS_FILTER_PTR =
CLASS_PTR[CLASS_FILTER_AREA] +
(.EVENT_CLASS - .CLASS_PTR[CLASS_LOW]) * CLASS_FILTER_SIZE;
! Apply global filter before looking for any entity filters
.MASK = ..MASK or .CLASS_FILTER_PTR[GLOBAL_FILTER];
! Now step over all entity blocks that belong to this class
EVENT_ENTITY_PTR = 0;
while (EVENT_ENTITY_PTR =
NMU$QUEUE_NEXT(CLASS_FILTER_PTR[QH_EVENT_ENTITY],
.EVENT_ENTITY_PTR)) neq 0 do
! Now OR in the event entity filter
.MASK = ..MASK or .EVENT_ENTITY_PTR[EVENT_ENTITY_FILTER];
return;
end;
%global_routine('NML$EVL_DELETE_PARAMETER', ENTITY_TYPE, QUALIFIER,
PARM_LEN, PARM_PTR) =
! DDT name: ED%DEL
!++
!
! FUNCTIONAL DESCRIPTION
!
! Deletes a parameter in the logging database
!
! FORMAL PARAMETERS
!
! ENTITY_TYPE The entity type number
! QUALIFIER Character sequence pointer to the qualifier parameter
! PARM_LEN The length of the parameter data
! PARM_PTR Character sequence pointer to the parameter data
!
! ROUTINE VALUE
!
! NICE return code
!
! SIDE EFFECTS
!
! NONE
!
!--
!++
!
! Design notes:
!
! NML$EVL_DELETE_PARAMETER deletes an event parameter from the event
! logger volatile database. It is called by VDB_CHANGE in NMLVDB.
!
! 1. NICE_DECODE is called to decode the NICE message, extract the
! data and write the data to the NICE_BLOCK. [Compare with
! NML$EVL_INSERT_PARAMETER]
! 2. PROCESS_EVENT is called with DELETE_EVENT as coroutine.
! 3. PROCESS_EVENT resolves 'KNOWN SINKS' and calls the coroutines
! for each appropriate sink.
! 4. DELETE_EVENT calls FIND_EVENT to locate the relevant data blocks.
! 5. The event parameter is deleted
! 6. CLEAN_UP is called after a DELETE operation in the database.
! It starts at the data blocks containing the deleted event
! parameter and works it way up. If a data block is unused and
! does not point to anything, the block is deallocated.
! 7. RECOMPUTE_MONITOR_FILTER is called to recompute the global filter
! mask.
!
!--
begin
local TEMP; ! Temporary variable
if ( NICE_DECODE( .ENTITY_TYPE, .QUALIFIER, .PARM_LEN, .PARM_PTR)
eql $false ) then return NICE$_IMF; ! Illegal message format
! Call PROCESS_EVENT to do (some of) the work.
if (TEMP = PROCESS_EVENT(DELETE_EVENT)) neq NICE$_SUC then return .TEMP;
! More work (possibly) if this was 'KNOWN EVENTS'
if .NB[NB_KNOWN_EVENTS] eql $true
then begin
NB[NB_EVENT_FILTER] = -1;
while (TEMP = FIND_NEXT_CLASS()) neq -1 do
begin
NB[NB_EVENT_CLASS] = .TEMP;
if (TEMP = DELETE_EVENT()) neq NICE$_SUC then return .TEMP;
end;
end;
return NICE$_SUC;
end; ! End of NML$EVL_DELETE_PARAMETER
%routine('DELETE_EVENT') =
!++
!
! Functional description:
!
! Deletes a single event from the data structure. If as a consequence
! data structures will become unused, the space will be reclaimed
! through calling the CLEAN_UP routine.
!
! DELETE_EVENT will also call the routine that recomputes the monitor
! filter.
!
! Formal parameters:
!
! None.
!
! Implicit inputs:
!
! NB, the NICE block
!
! Returns:
!
! $false Some error occurred
! $true All well
!
! Implicit output:
!
! The monitor filter might be changed
! Data structure might be pruned through calling CLEAN_UP
!
!--
begin
! Call FIND_EVENT to locate the event.
case FIND_EVENT( $false ) from -1 to +1 of
set
[-1] : return $false; ! Should not happen...
[0] : return $true; ! Wasnt there, signal?? **TBS
[+1] : $true; ! Just continue
[outrange] : return $false; ! Should not happen...
tes;
! An entry was found, delete the event type(s) specified
if .NB[NB_EVENT_ENTITY_TYPE] eql NO_ENTITY_ ! No entity specified
then
CLASS_FILTER_PTR[GLOBAL_FILTER] =
.CLASS_FILTER_PTR[GLOBAL_FILTER] and (not .NB[NB_EVENT_FILTER])
else
EVENT_ENTITY_PTR[EVENT_ENTITY_FILTER] =
.EVENT_ENTITY_PTR[EVENT_ENTITY_FILTER] and
(not .NB[NB_EVENT_FILTER])
;
! Now delete unused data structures
CLEAN_UP();
! The monitor filter needs to be recalculated, and it is delete operation
RECOMPUTE_MONITOR_FILTER( $true );
return $true;
end; ! End of DELETE_EVENT
%routine ('CLEAN_UP') : NOVALUE =
!++
!
! Functional description:
!
! CLEAN_UP is called by DELETE_EVENT, i.e. it is called when an
! event has been deleted. CLEAN_UP will try to deallocate unused
! data structures.
!
! Formal parameters:
!
! None.
!
! Implicit inputs:
!
! NB, the NICE block
!
! Returns: NOVALUE
!
!--
begin
! Start with entity layer
if .NB[NB_EVENT_ENTITY_TYPE] neq NO_ENTITY_
then begin ! Yes, there is an entity
! If filter became 0, then remove entity block
if .EVENT_ENTITY_PTR[EVENT_ENTITY_FILTER] eql 0
then begin
! Unlink it from queue and release memory
NMU$QUEUE_EXTRACT(CLASS_FILTER_PTR[QH_EVENT_ENTITY],
.EVENT_ENTITY_PTR);
RELEASE_MEMORY(.EVENT_ENTITY_PTR,EVENT_ENTITY_ALLOCATION);
EVENT_ENTITY_PTR = 0; ! Reset pointer also
end;
end;
! The entity has (possibly) been cleaned. Now check if the CLASS_BLOCK
! can be deallocated. It can if the following conditions are met:
! 1. All global filters are zero
! 2. All event entities lists/queues it points to are empty
begin
local I, ! Declare loop index
CF_PTR : ref CLASS_FILTER_BLOCK; ! And temporary pointer
CF_PTR = CLASS_PTR[CLASS_FILTER_AREA];
incr I from 0 to 7 do
begin
if (.CF_PTR[GLOBAL_FILTER] neq 0) or
(NMU$QUEUE_LENGTH(CF_PTR[QH_EVENT_ENTITY]) neq 0)
then return; ! Cannot deallocate, just return
CF_PTR = .CF_PTR + CLASS_FILTER_SIZE; ! Step forward
end;
end;
! If we get here, then we have passed all CLASS_BLOCK tests and its OK
! to deallocate.
!
! Unlink from queue and release memory
NMU$QUEUE_EXTRACT(.QH_CLASS, .CLASS_PTR);
RELEASE_MEMORY(.CLASS_PTR, CLASS_ALLOCATION);
CLASS_PTR = 0; ! Reset pointers
CLASS_FILTER_PTR = 0;
! Now we may proceed and possibly remove the sink node block too..
!
! The following conditions must be met for removing the sink node block:
! All queue headers (console, file, monitor) must point to empty
! queues.
if NMU$QUEUE_LENGTH(SINK_NODE_PTR[QH_CONSOLE_CLASS]) neq 0 then return;
if NMU$QUEUE_LENGTH(SINK_NODE_PTR[QH_FILE_CLASS]) neq 0 then return;
if NMU$QUEUE_LENGTH(SINK_NODE_PTR[QH_MONITOR_CLASS]) neq 0 then return;
! Come here if all queues were empty: remove sink node block from sink
! node queue, and release memory.
NMU$QUEUE_EXTRACT(QH_SINK_NODES, .SINK_NODE_PTR);
RELEASE_MEMORY(.SINK_NODE_PTR, SINK_NODE_ALLOCATION);
SINK_NODE_PTR = 0; ! Reset pointer too
return;
end; ! End of CLEAN_UP
%routine('FIND_NEXT_CLASS') =
!++
!
! Functional description:
!
! Searches for next non-zero event class, given a sink node and sink type.
!
! This routine is used by the CLEAR KNOWN EVENTS code.
!
! Since this routine always start from the top of the tree,
! care has to be taken to prevent a caller from looping forever,
! i.e. the caller should delete the event class from the database.
!
! Routine value:
!
! -1 No more event classes
! >=0 Next non-zero event class
!
!--
begin
if (SINK_NODE_PTR = NMU$QUEUE_SCAN(QH_SINK_NODES,
ch$ptr(NB[NB_SINK_NODE_ID],,8),
SINK_NODE_MATCH)) eql 0
then return -1; ! Sink node wasnt there
case .NB[NB_SINK_TYPE] from LOGGING_LO to LOGGING_HI of
set
[CONSOLE_] : QH_CLASS = SINK_NODE_PTR[QH_CONSOLE_CLASS];
[FILE_] : QH_CLASS = SINK_NODE_PTR[QH_FILE_CLASS];
[MONITOR_] : QH_CLASS = SINK_NODE_PTR[QH_MONITOR_CLASS];
[outrange] : return -1; ! In case....
tes;
! Now loop over all class blocks for this class
CLASS_PTR = 0;
while ((CLASS_PTR = NMU$QUEUE_NEXT(.QH_CLASS, .CLASS_PTR)) neq 0) do
begin
local I; ! Loop count
incr I from 0 to 7 do ! Step over all classes within block
begin
CLASS_FILTER_PTR = CLASS_PTR[CLASS_FILTER_AREA] +
.I * CLASS_FILTER_SIZE;
if .NB[NB_EVENT_ENTITY_TYPE] eql NO_ENTITY_ then
begin
if .CLASS_FILTER_PTR[GLOBAL_FILTER] neq 0 then
return (.CLASS_PTR[CLASS_LOW] + .I); ! Candidate
end
else begin
! Come here with an entity to look for
EVENT_ENTITY_PTR =
NMU$QUEUE_SCAN(CLASS_FILTER_PTR[QH_EVENT_ENTITY],
NB, EVENT_ENTITY_MATCH);
if .EVENT_ENTITY_PTR neq 0 then
! Event entity filter must be non-zero, otherwise it
! would have been reaped before.
return (.CLASS_PTR[CLASS_LOW] + .I); ! Candidate
end;
end;
end;
return -1; ! No match found
end; ! End of FIND_NEXT_CLASS
%global_routine ('NML$EVL_READ_EVENTS', ENTITY_PTR, QUALIFIER, SELECTOR,
LENGTH, BUFFER_PTR) =
! DDT name: ED%REA
!++
!
! FUNCTIONAL DESCRIPTION
!
! Read information from LOGGING database
!
! FORMAL PARAMETERS
!
! ENTITY_PTR Character sequence pointer to entity id.
! QUALIFIER Character sequence pointer to the qualifier parameter
! SELECTOR The class of entities to return
! LENGTH Address of a variable to be updated with the length
! of the data returned in the buffer
! BUFFER_PTR Address of a character sequence pointer to parameter
! buffer
!
! ROUTINE VALUE
!
! NICE return code
!
! SIDE EFFECTS
!
! NONE
!
!--
!++
!
! Design notes:
!
! [TBS]
!
!--
begin
local
SAV_PTR;
SAV_PTR = ..BUFFER_PTR; ! Save return pointer
! Get logging sink type
SB[SB_SINK_TYPE] = GETB(ENTITY_PTR);
! Fill in return byte pointer
SB[SB_RETPTR] = .BUFFER_PTR;
! Set 'SENT SINK' zero meaning that sink node parameter has not yet been sent
SB[SB_SINK_SENT] = 0;
! If qualifier exists, expand it. Else, default it to executor.
if .QUALIFIER neq 0
then if GETW(QUALIFIER) neq SINK_NODE_PARAMETER
then return NICE$_IMF;
! Check the SINK NODE qualifier and do one of the following things:
! If it is a single node spec, show events for that node
! If it is KNOWN nodes, loop over all sink nodes and show events
! If it is none of these, give 'Illegal message format'
case NML$CONVERT_ENTITY_ID( ENTITY_NODE, QUALIFIER,
ch$ptr(SB[SB_SINK_NODE_ID],,8))
from SIGNIFICANT_ to $true of
set
! Unsupported options
[SIGNIFICANT_, ADJACENT_, LOOPED_, ACTIVE_, $false] :
return NICE$_IMF;
! Single node
[$true] : if ..LENGTH - ch$diff(..SB[SB_RETPTR],.SAV_PTR) geq 60
then begin
if SHOW_SINK_NODE() eql $false then return NICE$_MPE;
end
else return NICE$_REE;
! All known sink nodes
[KNOWN_] :
begin
SINK_NODE_PTR = 0;
while (SINK_NODE_PTR =
NMU$QUEUE_NEXT(QH_SINK_NODES, .SINK_NODE_PTR)) neq 0 do
begin
if ..LENGTH - ch$diff(..SB[SB_RETPTR],.SAV_PTR) lss 60
then return NICE$_REE;
ch$move(NODE_ID_BUFFER_LENGTH,
ch$ptr(SINK_NODE_PTR[SINK_NODE_NAME],,8),
ch$ptr(SB[SB_SINK_NODE_ID],,8));
SB[SB_SINK_SENT] = 0; ! No sink parameter yet
if SHOW_SINK_NODE() eql $false then return NICE$_MPE;
end;
end;
tes;
! All well, update number of characters written
.LENGTH = ..LENGTH - ch$diff(..SB[SB_RETPTR],.SAV_PTR);
return NICE$_SUC;
end; ! End of routine NML$EVL_READ_EVENTS
%routine('SHOW_SINK_NODE') =
!++
!
! Functional description:
!
! Find and show all events for a sink node and sink type.
!
! Formal parameters:
!
! None
!
! Implicit inputs:
!
! The SB block
!
! Implicit outputs:
!
! Writes to the buffer specified by the character pointer in the SB
!
!--
begin
! Find the sink node block associated with this sink node name
SINK_NODE_PTR = NMU$QUEUE_SCAN(QH_SINK_NODES,
ch$ptr(SB[SB_SINK_NODE_ID],,8),
SINK_NODE_MATCH);
if .SINK_NODE_PTR eql 0 then return $false;
! Come here with a pointer to the sink node block in SINK_NODE_PTR.
! Proceed to pick up the correct class queue header.
case .SB[SB_SINK_TYPE] from LOGGING_LO to LOGGING_HI of
set
[CONSOLE_] : QH_CLASS = SINK_NODE_PTR[QH_CONSOLE_CLASS];
[FILE_] : QH_CLASS = SINK_NODE_PTR[QH_FILE_CLASS];
[MONITOR_] : QH_CLASS = SINK_NODE_PTR[QH_MONITOR_CLASS];
[outrange] : return $false; ! In case...
tes;
! Loop over all class blocks in this list
CLASS_PTR = 0;
while ((CLASS_PTR =
NMU$QUEUE_NEXT(.QH_CLASS, .CLASS_PTR)) neq 0) do
begin
local
I; ! Loop count
incr I from 0 to 7 do ! Loop over all classes within block
begin
CLASS_FILTER_PTR = CLASS_PTR[CLASS_FILTER_AREA] +
.I * CLASS_FILTER_SIZE;
EVENT_ENTITY_PTR = 0; ! Ensure this is zero
if .CLASS_FILTER_PTR[GLOBAL_FILTER] neq 0
then begin ! Report this global filter
EVENT_ENCODE(.I); ! For easy calculation of class #
end;
! Now check if there are any event entities.
while ((EVENT_ENTITY_PTR =
NMU$QUEUE_NEXT(CLASS_FILTER_PTR[QH_EVENT_ENTITY],
.EVENT_ENTITY_PTR)) neq 0) do
! Note: if there is an event entity block, there is also
! a non-zero filter since CLEAN_UP otherwise would have
! removed the block.
EVENT_ENCODE(.I);
end; ! End of loop over all events within
! this class block
end; ! End loop over all class blocks
return $true;
end;
%routine('EVENT_ENCODE' , INDEX ) : novalue =
!++
!
! Functional description:
!
! This routine will encode an event specification from the implicit
! inputs in the SB block, and the global pointers.
!
! Formal parameters:
!
! INDEX The index within the class block for easy calculation of
! the event class #. This parameter could be calculated from
! the difference of the class filter pointer and the class
! pointer but its easier this way...
!
! Implicit outputs:
!
! Writes to the character buffer
!
!--
begin
local
ENTYPE, ! Temporary entity type
TEMP, ! Temporary
TEMP_PTR; ! Temporary pointer
! First check whether the sink node parameter has been sent already
if .SB[SB_SINK_SENT] eql 0
then begin
local TEMP, ! Temporary value
TEMP_PTR; ! Temporary pointer
SB[SB_SINK_SENT] = 1; ! Flag that this has been done
! The layout is the following:
! B:2 parameter #
! B CM-2 (302)
! B Unsigned 2 byte decimal # (002)
! B:2 node address
! 100 AI-field
! x length of node name followed by node name string
TEMP = SINK_NODE_PARAMETER;
PUTW(TEMP,.SB[SB_RETPTR]);
PUTB(%O'302',.SB[SB_RETPTR]);
PUTB(%O'002',.SB[SB_RETPTR]);
TEMP_PTR = ch$ptr(SB[SB_SINK_NODE_ID],,8);
TEMP = GETW(TEMP_PTR);
PUTW(TEMP,.SB[SB_RETPTR]);
PUTB(%O'100',.SB[SB_RETPTR]);
TEMP = GETB(TEMP_PTR); ! Length
PUTB(.TEMP,.SB[SB_RETPTR]);
ch$move(.TEMP, .TEMP_PTR, ..SB[SB_RETPTR]);
.SB[SB_RETPTR] = ch$plus(..SB[SB_RETPTR], .TEMP); ! Update pointer
end;
! The layout of the NICE return is the following:
!
! parameter #
!
!
! No entity Circuit,line,module Area Node
! 303 CM-3 304 CM-4 304 305 CM-5
! 201 CS-1 201 CS-1 201 201 CS-1
! B:1 NO_ENTITY_ B:1 ENTITY_TYPE B:1 area B:1 ENTITY_TYPE
! 100 AI 202 002 Unsigned 2
! x Entity ID 0 B:2 Node #
! area # 100 AI
! x Entity ID
!
!
! 002 Unsigned decimal 2 bytes
! B:2 Event class
! 040 Octal image
! B:1 Length of octal image
! n Event filter bit mask
TEMP = EVENT_PARAMETER; ! Put out event parameter
PUTW(TEMP, .SB[SB_RETPTR]);
ENTYPE = (if .EVENT_ENTITY_PTR eql 0
then NO_ENTITY_
else .EVENT_ENTITY_PTR[EVENT_ENTITY_TYPE]);
! Output CM-3, CM-4 or CM-5 depending on entity type
case .ENTYPE from NO_ENTITY_ to ENTITY_HI of
set
[NO_ENTITY_] : PUTB(%O'303', .SB[SB_RETPTR]); ! CM-3
[ENTITY_AREA, ENTITY_CIRCUIT, ENTITY_LINE, ENTITY_MODULE] :
PUTB(%O'304', .SB[SB_RETPTR]); ! CM-4
[ENTITY_NODE] : PUTB(%O'305', .SB[SB_RETPTR]); ! CM-5
[inrange, outrange] : return $false; ! Shouldnt happen...
tes;
! Output CS-1 (201) followed by entity type
PUTB(%O'201', .SB[SB_RETPTR]);
PUTB(.ENTYPE, .SB[SB_RETPTR]);
! Now output the entity ID depending on entity type
! (NO_ENTITY_ not included since there is no entity type to type out)
case .ENTYPE from NO_ENTITY_ to ENTITY_HI of
set
[ENTITY_AREA] :
begin
PUTB(%O'202', .SB[SB_RETPTR]); ! CS-2
PUTB(0, .SB[SB_RETPTR]); ! Byte 0 is zero
PUTB(GETB(ch$ptr(EVENT_ENTITY_PTR[EVENT_ENTITY_ID],,8)),
.SB[SB_RETPTR]);
end;
[ENTITY_CIRCUIT, ENTITY_LINE, ENTITY_MODULE] :
begin
PUTB(%O'100', .SB[SB_RETPTR]); ! AI
TEMP_PTR = ch$ptr(EVENT_ENTITY_PTR[EVENT_ENTITY_ID],,8);
TEMP = GETB(TEMP_PTR);
PUTB(.TEMP, .SB[SB_RETPTR]);
ch$move(.TEMP, .TEMP_PTR, ..SB[SB_RETPTR]);
.SB[SB_RETPTR] = ch$plus(..SB[SB_RETPTR], .TEMP);
end;
[ENTITY_NODE] :
begin
PUTB(%O'002', .SB[SB_RETPTR]); ! 2 byte #
TEMP_PTR = ch$ptr(EVENT_ENTITY_PTR[EVENT_ENTITY_ID],,8);
TEMP = GETW(TEMP_PTR); ! Get node #
PUTW(TEMP, .SB[SB_RETPTR]);
PUTB(%O'100', .SB[SB_RETPTR]); ! AI
TEMP = GETB(TEMP_PTR);
PUTB(.TEMP, .SB[SB_RETPTR]);
ch$move(.TEMP, .TEMP_PTR, ..SB[SB_RETPTR]);
.SB[SB_RETPTR] = ch$plus(..SB[SB_RETPTR], .TEMP);
end;
[inrange] : ;
tes;
! Now output the event class and event type fields
PUTB(%O'002', .SB[SB_RETPTR]); ! 2 unsigned decimal bytes
TEMP = .CLASS_PTR[CLASS_LOW] + .INDEX;
PUTW(TEMP, .SB[SB_RETPTR]);
! Now put out the filter
begin
local FILTER, COUNT;
PUTB(%O'040', .SB[SB_RETPTR]); ! Octal image field
FILTER = (if .EVENT_ENTITY_PTR neq 0
then .EVENT_ENTITY_PTR[EVENT_ENTITY_FILTER]
else .CLASS_FILTER_PTR[GLOBAL_FILTER]);
COUNT = (if .FILTER<24,8,0> neq 0 then 4
else if .FILTER<16,8,0> neq 0 then 3
else if .FILTER<8,8,0> neq 0 then 2
else if .FILTER<0,8,0> neq 0 then 1
else 0);
PUTB(.COUNT, .SB[SB_RETPTR]); ! Output # of event bytes
if .COUNT geq 1 then PUTB(.FILTER<0,8,0>, .SB[SB_RETPTR]);
if .COUNT geq 2 then PUTB(.FILTER<8,8,0>, .SB[SB_RETPTR]);
if .COUNT geq 3 then PUTB(.FILTER<16,8,0>, .SB[SB_RETPTR]);
if .COUNT geq 4 then PUTB(.FILTER<24,8,0>, .SB[SB_RETPTR]);
end;
return;
end;
%global_routine('NML$EVL_APPLY_FILTER', SINK_FLAGS, EVENT_CODE, ENTITY_TYPE,
ENTITY_ID, CALLER_DATA, CALL_BACK) =
! DDT name: ED%FIL
!++
!
! Functional description:
!
! NML$EVL_APPLY_FILTER searches the event data base for filters that
! match a given event.
!
! Formal parameters to NML$EVL_APPLY_FILTER:
!
! SINK_FLAGS the sink types that should be tested (normally all
! sink types). B0 means console, B1 file, B2 monitor.
! EVENT_CODE the event class and type. The event class is in bits
! 6-14, while the type is in bits 0-4.
! ENTITY_TYPE contains the entity type
! ENTITY_ID character sequence pointer to entity ID
! CALLER_DATA data that the caller supplies that is added as argument
! to the callback routine. NML$EVL_APPLY_FILTER does not
! touch this field.
! CALL_BACK routine to call back on matches
!
! Returns:
! $false Something went wrong
! $true All well
!
!--
!++
!
! Design notes:
!
! NML$EVL_APPLY_FILTER is the routine that makes the filtering decisions.
! Based on the input provided by the EVENT_PROCESSOR in NMLEVL the
! routine scans the data base.
!
! The routine scans all sink types on all sink nodes. When a match is
! found, the callback routine in the EVENT_PROCESSOR is called to log
! the event.
!
! The callback routine will be called once for each node for which
! there is a match.
!
! The callback routine is called in the following way:
! CALLBACK(SINK_FLAGS, LOCAL_DESTINATION, DESTINATION_NODE, CALLER_DATA)
! where
!
! SINK_FLAGS the sink types on this sink that should
! receive a copy of the event.
!
! LOCAL_DESTINATION a flag that, if set, means that the
! destination is the local node
!
! DESTINATION_NODE a character pointer to the destination
! node name string.
!
! CALLER_DATA the data the caller supplied
!
! The callback routine is expected to return $TRUE. If it does not,
! the scan through the data base is stopped, and APPLY_FILTER returns
! immediately.
!
! Event 0.0 ("Event records lost") must be treated in a special way.
! The architecture prescribes that event 0.0 is thrown away only if
! i) logging is turned off for event 0.0 and ii) all other events
! are turned off. Hence, a special test is made for event 0.0
!
! 1. The values of the arguments to NML$EVL_APPLY_FILTER are written
! to the FILTER_BLOCK.
! 2. The routine loops over all sink nodes, calling SEARCH_FILTER
! for each sink (console, file, monitor) on each sink node.
! 3. SEARCH_FILTER loops over all class blocks and class entity blocks
! (the latter if appropriate) to find a matching filter.
! If it happens to be event 0.0 return $true always unless no other
! filter is enabled.
! 4. SEARCH_FILTER returns TRUE to NML$EVL_APPLY_FILTER if a filter
! was found and the event was not filtered.
! 5. NML$EVL_APPLY_FILTER notes the return of SEARCH_FILTER. When all
! sinks for a particular node has been checked, NML$EVL_APPLY_FILTER
! checks if there was a TRUE return from any of the sinks. If so,
! the event should be logged at the particular sink node and the
! callback routine supplied by EVENT_PROCESSOR is called.
!
!--
begin
bind routine CALL_BACK_ROUTINE = .CALL_BACK;
local sink_types; ! Bit 0 = console, 1 = file,
! 2 = monitor
! Step 1 is to set the filter block.
FB[FB_SINK_FLAGS] = .SINK_FLAGS<SINK_MASK>; ! Get sink bits
FB[FB_EV_0_0] = (.EVENT_CODE<$$EVENT_CLASS> eql 0)
and (.EVENT_CODE<$$EVENT_TYPE> eql 0);
FB[FB_EVENT_CLASS] = .EVENT_CODE<$$EVENT_CLASS>;
FB[FB_EVENT_FILTER] = 1 ^ .EVENT_CODE<$$EVENT_TYPE>;
! into bit position
FB[FB_ENTITY_TYPE] = .ENTITY_TYPE; ! Entity type
begin
local temp;
temp = .ENTITY_ID; ! NML$CONVERT_ENTITY_ID changes
! input ptr
if NML$CONVERT_ENTITY_ID(.ENTITY_TYPE, temp,
ch$ptr(FB[FB_ENTITY_ID],,8)) neq $true then return $false;
end;
! The FB has now been initialized.
SINK_NODE_PTR = 0;
while (SINK_NODE_PTR =
NMU$QUEUE_NEXT(QH_SINK_NODES, .SINK_NODE_PTR)) neq 0 do
begin
SINK_TYPES<SINK_MASK> = 0; ! Clear out sink types
! Now call SEARCH_EVENT for each sink type
if .FB[FB_SINK_CONSOLE] neq 0
then begin
QH_CLASS = SINK_NODE_PTR[QH_CONSOLE_CLASS];
SINK_TYPES<CONSOLE_MASK> = SEARCH_FILTER();
end;
if .FB[FB_SINK_FILE] neq 0
then begin
QH_CLASS = SINK_NODE_PTR[QH_FILE_CLASS];
SINK_TYPES<FILE_MASK> = SEARCH_FILTER();
end;
if .FB[FB_SINK_MONITOR] neq 0
then begin
QH_CLASS = SINK_NODE_PTR[QH_MONITOR_CLASS];
SINK_TYPES<MONITOR_MASK> = SEARCH_FILTER();
end;
! If any sink type has signalled, log the event through the
! callback routine.
if .SINK_TYPES<SINK_MASK> neq 0
then begin
if CALL_BACK_ROUTINE(.SINK_TYPES<SINK_MASK>,
.SINK_NODE_PTR[SINK_NODE_LOCAL],
ch$ptr(SINK_NODE_PTR[SINK_NODE_NAME],,8),
.CALLER_DATA)
neq $true
then return $false;
end;
! Loop back
end; ! End WHILE...DO
return $true;
end; ! End of NML$EVL_APPLY_FILTER
%routine('SEARCH_FILTER') =
!++
!
! Functional description:
!
! SEARCH_FILTER is called to search a list of class blocks for
! a match.
!
! Formal parameters:
!
! None
!
! Implicit inputs:
!
! FB, the FILTER_BLOCK.
! Also assumes QH_CLASS is set up.
!
! Returns:
!
! $false No match
! $true Match
!
!--
begin
! Find the class block that describes this class
CLASS_PTR = NMU$QUEUE_SCAN(.QH_CLASS, .FB[FB_EVENT_CLASS], CLASS_MATCH);
if .CLASS_PTR eql 0 then return $false; ! No match at all here
! Coming here we know that there is some event turned on (CLASS_PTR =/= 0)
! => event 0.0 should be logged
if .FB[FB_EV_0_0] then return $true;
! Find the class filter for this event class within the class block
CLASS_FILTER_PTR =
CLASS_PTR[CLASS_FILTER_AREA] +
(.FB[FB_EVENT_CLASS] - .CLASS_PTR[CLASS_LOW]) * CLASS_FILTER_SIZE;
! If there is no entity, apply global filter. If there is an entity,
! search entity list for a match.
if .FB[FB_ENTITY_TYPE] eql NO_ENTITY_
then begin
if (.CLASS_FILTER_PTR[GLOBAL_FILTER] and .FB[FB_EVENT_FILTER]) neq 0
then return $true; ! Match
end
else begin ! Search entity queues for a match
! There is an entity specifier, search for it in entity lists.
EVENT_ENTITY_PTR =
NMU$QUEUE_SCAN(CLASS_FILTER_PTR[QH_EVENT_ENTITY],
FB,
ENTITY_FILTER_MATCH);
if .EVENT_ENTITY_PTR eql 0
then begin ! No entity matched, try global filter
if (.CLASS_FILTER_PTR[GLOBAL_FILTER] and
.FB[FB_EVENT_FILTER]) neq 0
then return $true;
end
else begin ! There was an entity, try its filter
if (.EVENT_ENTITY_PTR[EVENT_ENTITY_FILTER] and
.FB[FB_EVENT_FILTER]) neq 0 then return $true;
end;
end;
! If we fall out here, then no match have been made:
return $false;
end; ! End of SEARCH_FILTER
%global_routine ('NML$EVL_EVENT_TEXT', EVENT_CLASS, EVENT_TYPE) =
! DDT name: ED%ETX
!++
!
! Functional description:
!
! This routine retrieves the event text associated with an event
! parameter.
!
! Formal parameters:
!
! EVENT_CLASS The event class
! EVENT_TYPE The event type
!
! Returns: 0 Event not found
! ptr Character pointer to event text
!
!--
begin
local I; ! Loop index
incr I from 0 to NR_EVENTS - 1
do
if (.EVENT_TABLE[ .I, EV_CLASS] eql .EVENT_CLASS)
and (.EVENT_TABLE[ .I, EV_TYPE] eql .EVENT_TYPE)
then return .EVENT_TABLE[ .I, EV_TEXT];
! Come here on no match
return 0;
end; ! End of NML$EVL_EVENT_TEXT
%global_routine ('NML$EVL_SET_VDB_PARAMETER', ENTITY_TYPE, ENTITY_PTR,
PARM_NO, DATA_ADDR) =
! DDT name: ED%SET
!++
! FUNCTIONAL DESCRIPTION:
!
! Inserts the data for a logging parameter into the event logger
! volatile data base. The value of the parameter is stored at the
! address specified by DATA_ADDR
!
! FORMAL PARAMETERS
!
! ENTITY_TYPE Entity type
! ENTITY_PTR Character pointer to entity id
! PARM_NO The parameter number
! DATA_ADDR Address of data of value
!
! IMPLICIT INPUTS
!
! NONE
!
! ROUTINE VALUE
!
! TRUE If the parameter was set
! FALSE If not,
!
! SIDE EFFECTS
!
! NONE
!
!--
begin
TASK_INFO('INTERNAL ERROR: NML$EVL_SET_VDB_PARAMETER erroneously called');
return $TRUE
end; ! End of NML$EVL_SET_VDB_PARAMETER
%global_routine ('NML$EVL_CLR_VDB_PARAMETER', ENTITY_TYPE, ENTITY_PTR,
PARM_NO) =
! DDT name: ED%CLR
!++
! FUNCTIONAL DESCRIPTION:
!
! Removes a logging parameter from the logging database
!
! FORMAL PARAMETERS
!
! ENTITY_TYPE Entity type
! ENTITY_PTR Character pointer to entity id
! PARM_NO The parameter number
!
! IMPLICIT INPUTS
!
! NONE
!
! ROUTINE VALUE
!
! TRUE If the parameter was set
! FALSE If not,
!
! SIDE EFFECTS
!
! NONE
!
!--
begin
TASK_INFO('INTERNAL ERROR: NML$EVL_CLR_VDB_PARAMETER erroneously called');
return $TRUE
end; ! End of NML$EVL_CLR_VDB_PARAMETER
%global_routine ('NML$EVL_GET_VDB_PARAMETER', ENTITY_TYPE, ENTITY_PTR,
PARM_NO, DATA_ADDR) =
! DDT name: ED%GET
!++
! FUNCTIONAL DESCRIPTION:
!
! Reads a parameter from the event logger data base. On return,
! the parameter value is stored at the address specified by DATA_ADDR.
!
! FORMAL PARAMETERS
!
! ENTITY_TYPE Entity type
! ENTITY_PTR Character pointer to entity id
! PARM_NO The parameter number
! DATA_ADDR Address of buffer where parameter value is returned
!
! IMPLICIT INPUTS
!
! NONE
!
! ROUTINE VALUE
!
! TRUE If the parameter was set
! FALSE If not,
!
! SIDE EFFECTS
!
! NONE
!
!--
begin
TASK_INFO('INTERNAL ERROR: NML$EVL_GET_VDB_PARAMETER erroneously called');
return $TRUE
end; ! End of NML$EVL_GET_VDB_PARAMETER
%routine ('SINK_NODE_MATCH' , QE_SINK_NODE, NAME_PTR) =
!++
!
! Functional description:
!
! This is a NMU$QUEUE_SCAN match routine. It is called when searching
! the SINK NODE list. Therefore, QE_SINK_NODE is the current entry in
! the list. The NAME_PTR points to the sink node name string to compare
! with. This string will always be equal to the sink node name in the
! NB block.
!
! Formal parameters:
!
! QE_SINK_NODE Points to entry to be tested in SINK NODE list
! NAME_PTR Character sequence pointer to name string
!
! Returns:
! 0 No match
! <>0 Address of matching entry in queue.
!
!--
begin
map QE_SINK_NODE : ref SINK_NODE_BLOCK; ! Declare
if ch$eql(NODE_ID_BUFFER_LENGTH, ch$ptr(QE_SINK_NODE[SINK_NODE_NAME],,8),
NODE_ID_BUFFER_LENGTH, .NAME_PTR,0) eql 0
then return 0
else return .QE_SINK_NODE;
end; ! End of SINK_NODE_MATCH
%routine('CLASS_MATCH', QE_CLASS, CLASS_NR) =
!++
!
! Functional description:
!
! This is a NMU$QUEUE_SCAN match routine. It is called when searching
! the CLASS list. A match is made if the CLASS_NR is in the class
! range supported by the current class block QE_CLASS.
!
! Formal parameters:
!
! QE_CLASS Points to class block entry
! CLASS_NR The class number that is searched for
!
! Returns:
! 0 no match
! <>0 Address of matching class block entry
!
!--
begin
map QE_CLASS : ref CLASS_BLOCK;
if (.QE_CLASS[CLASS_LOW] leq .CLASS_NR)
and (.CLASS_NR leq .QE_CLASS[CLASS_HIGH])
then return .QE_CLASS
else return 0;
end;
%routine('EVENT_ENTITY_MATCH' , QE_EVENT_ENTITY, NB_PTR) =
!++
!
! Functional description:
!
! This is a NMU$QUEUE_SCAN match routine. It is called when searching
! the EVENT ENTITY list. A match is made if the NICE BLOCK that NB_PTR
! points to contains an entity type and id that matches the entity
! supplied in the EVENT ENTITY block that QE_EVENT_ENTITY points to.
!
! Formal parameters:
!
! QE_EVENT_ENTITY Points to event entity block entry
! NB_PTR Points to NB block
!
! Returns:
!
! 0 no match
! <>0 Address of matching event entity block
!
!--
begin
map QE_EVENT_ENTITY : ref EVENT_ENTITY_BLOCK,
NB_PTR : ref NICE_BLOCK;
if (.NB_PTR[NB_EVENT_ENTITY_TYPE] eql .QE_EVENT_ENTITY[EVENT_ENTITY_TYPE])
and (ch$eql(2 + max(0,9,17), ch$ptr(NB_PTR[NB_EVENT_ENTITY_ID],,8),
2 + max(0,9,17), ch$ptr(QE_EVENT_ENTITY[EVENT_ENTITY_ID],,8),
0) neq 0) then return .QE_EVENT_ENTITY else return 0;
end; ! End of EVENT_ENTITY_MATCH
%routine('ENTITY_FILTER_MATCH' , QE_EVENT_ENTITY, FB_PTR) =
!++
!
! Functional description:
!
! This is a NMU$QUEUE_SCAN match routine. It is called when searching
! the EVENT ENTITY list. A match is made if the FILTER BLOCK that FB_PTR
! points to contains an entity type and id that matches the entity
! supplied in the EVENT ENTITY block that QE_EVENT_ENTITY points to.
!
! Formal parameters:
!
! QE_EVENT_ENTITY Points to event entity block entry
! FB_PTR Points to filter block
!
! Returns:
!
! 0 no match
! <>0 Address of matching event entity block
!
!--
begin
map QE_EVENT_ENTITY : ref EVENT_ENTITY_BLOCK,
FB_PTR : ref FILTER_BLOCK;
if (.FB_PTR[FB_ENTITY_TYPE] eql .QE_EVENT_ENTITY[EVENT_ENTITY_TYPE])
and (ch$eql(2 + max(0,9,17), ch$ptr(FB_PTR[FB_ENTITY_ID],,8),
2 + max(0,9,17), ch$ptr(QE_EVENT_ENTITY[EVENT_ENTITY_ID],,8),
0) neq 0) then return .QE_EVENT_ENTITY else return 0;
end; ! End of ENTITY_FILTER_MATCH
%routine ('GET_MEMORY' , ALLOCATION) =
!++
! Functional description:
!
! This routine is called by all NMLVDE routines to allocate
! memory. In future, it could be enhanced to control the memory
! used by the event logging data base.
!
! Formal parameters:
!
! ALLOCATION - allocation units to allocate
!
! Routine value:
! The address of the allocated block or 0
!
!--
begin
return NMU$MEMORY_GET(.ALLOCATION)
end;
%routine ('RELEASE_MEMORY' , STORAGE_ADDRESS , ALLOCATION) : NOVALUE =
!++
! Functional description:
!
! This routine deallocates memory used by the event logger data base.
!
! Formal parameters:
!
! STORAGE_ADDRESS address of block to release
! ALLOCATION # of allocation units to release
!
! Routine value: NOVALUE
!
!--
begin
NMU$MEMORY_RELEASE (.STORAGE_ADDRESS, .ALLOCATION);
end;
end ! End of module NMLEVD
eludom
! Local Modes:
! Mode:BLISS
! Auto Save Mode:1
! Comment Column:40
! Comment Rounding:+1
! End: