Trailing-Edge
-
PDP-10 Archives
-
BB-X117B-SB_1986
-
10,7/nml/nmlevl.bli
There is 1 other file named nmlevl.bli in the archive. Click here to see a list.
! UPD ID= 329, SNARK:<6.1.NML>NMLEVL.BLI.10, 14-May-85 17:22:04 by GLINDELL
! Event 96.7 is now used to trigger DTE checks, along with 4.7.
! However, 96.7 does not get displayed.
!
! UPD ID= 294, SNARK:<6.1.NML>NMLEVL.BLI.9, 15-Mar-85 14:47:33 by GLINDELL
! LOGGING FILE name for TOPS20 is SERR:ERROR.SYS, not SYS:ERROR.SYS
! (QAR #838116)
!
! UPD ID= 286, SNARK:<6.1.NML>NMLEVL.BLI.8, 13-Mar-85 14:37:42 by GLINDELL
! A bug in the GET_CURRENT_JULIAN routine - did not take timezone on the
! 20 into account. Would only show up on network management (0.*) events.
!
! UPD ID= 239, SNARK:<6.1.NML>NMLEVL.BLI.7, 20-Jan-85 16:48:30 by GLINDELL
! 1. Increase MAX_EVENTS_ON_QUEUE to 8
! 2. Fix a bug in GET_LOCAL_EVENT for NODE entity, didnt skip 0 length byte
! in entity ID.
! 3. Default area number if none there when generating event text
! 4. Call LOGEVT instead of SEND_TO_OPERATOR
!
! UPD ID= 217, SNARK:<6.1.NML>NMLEVL.BLI.6, 14-Dec-84 18:49:47 by GLINDELL
! 1. Sleep 5 seconds before disconnecting an incoming event link.
! 2. Remove 'apply patch' message and set all sink flags if incoming
! event is from a MCB.
! 3. Feed received event to the EVENT_PROCESSOR and not to the RECORDER.
!
! UPD ID= 205, SNARK:<6.1.NML>NMLEVL.BLI.5, 10-Dec-84 15:25:43 by HALPIN
! Get MONSYM Library file out of default directory, not BLI:
!
! UPD ID= 87, SLICE:<6.1.NML>NMLEVL.BLI.4, 18-Sep-84 15:01:14 by GUNN
! WORK:<GUNN.NML>NMLEVL.BLI.3 21-Aug-84 14:47:36, Edit by GUNN
!
! Remove definitions of $NTPSI and $NTEVQ. They are now in MONSYM.
!
! WORK:<GUNN.NML>NMLEVL.BLI.2 21-Aug-84 12:07:18, 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= 38, SNARK:<6.1.NML>NMLEVL.BLI.3, 24-May-84 16:28:59 by GLINDELL
! Send 2-byte entity type field to SPEAR
! Make intelligent guess whether incoming entity type fields are 1- or 2-byte.
! Remove use of XPORT library
! Make GET_LOCAL_EVENT and EVENT_RECEIVER give up control depending on
! MAX_EVENTS_ON_QUEUE
! Increase display buffer size
! Handle error returns from $NMU$TEXT in macro $DSP_TEXT
! Fix a bug in EVENT_RECEIVER that caused NO LINK status
!
! PH4:<GLINDELL>NMLEVL.BLI.84 3-Mar-84 14:12:30, Edit by GLINDELL
! Ident 4.
! Support multiple event transmitters.
! Add MONITOR_LOGGER
!
! Ident 3.
! Make CONSOLE_LOGGER send its output to ORION for distribution to OPRs
! Add EVENT_TRANSMITTER.
!
! PH4:<GLINDELL>NMLEVL.BLI.86 16-Feb-84 13:19:15, Edit by GLINDELL
! Ident 2.
! Add CONSOLE_LOGGER
!
! PH4:<GLINDELL>NMLEVL.BLI.27 1-Feb-84 13:06:36, Edit by GLINDELL
!
! Continue work on the event logger
%title 'NMLEVL -- NML Event Logger'
module NMLEVL (
ident = '04.05'
) =
begin
! COPYRIGHT (c) 1983 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 provides the processes and routines that make up the
! event logger.
!
! Environment: TOPS-10/20 user mode under NML.
! Will NOT run on MCB.
!
! Module history:
!
! This module was created from the combined sources of the phase III
! modules NMLEVR, NMLEVT and NMLEVX. The module has then been expanded
! to support the full event logging functionality.
!
! Author: Gunnar Lindell (phase IV)
! Scott Robinson, Dale Gunn, Steven Jenness (phase III)
!
!--
!
! Include files
!
library 'NMLLIB'; ! Required definitions
%if $TOPS20
%then
library 'MONSYM'; ! Monitor symbols
library 'JLNKG'; ! JSYS linkage definitions
%fi
require 'NCPCOM'; ! Needed for NCP$SEND_TO_OPERATOR
!
! Sanity check for correct library
!
%if $mcb
%then
%error('Compiled with $MCB on but module does not support MCB')
%fi
!
! Table of contents
!
! Note, the functions are ordered in the following way:
! - initialization
! - from input of events to output of events
! - subroutines to a certain function follow immediately after the function
forward routine
NML$EVENT_INITIALIZE : novalue, ! Routine, initializes event logger
GET_LOCAL_EVENT : novalue, ! Process, reads events from monitor
SET_EVENT_INTERRUPTS : novalue, ! Routine, turns on event interrupts
EVENT_READ, ! Routine, do NTMAN to read event
EVENT_SIGNAL :
VANILLA_INTERRUPT_LINKAGE novalue,
! Monitor event interrupt routine
NML$DECLARE_EVENT : novalue, ! Routine, read NML event
EVENT_RECEIVER : novalue, ! Process, receive remote event
WAIT_FOR_CONNECT, ! Routine, wait for remote connect
READ_EVENT_REQUESTS : novalue, ! Routine, read remote event
READ_ONE_EVENT, ! Routine, read one event
EVENT_PROCESSOR : novalue, ! Routine, filters and distributes
! events.
CO_EVENT_PROCESSOR, ! Routine, called to log events
EVENT_RECORDER : novalue, ! Routine, distributes events to local
! sinks.
CONSOLE_LOGGER : novalue, ! Process, logs events to OPR/ORION
FILE_LOGGER : novalue, ! Process, logs events to SYSERR
MONITOR_LOGGER : novalue, ! Process, logs events to user process
EVENT_REMOTE_RECORDER : novalue, ! Routine, distributes filters to
! remote nodes.
SINK_NODE_MATCH, ! Routine, NMU$QUEUE_SCAN match
EVENT_TRANSMITTER : novalue, ! Process, sends events to other nodes
CONNECT_TO_REMOTE, ! Routine, connects to remote node
MAKE_EVENT_MESSAGE, ! Routine, converts REB to EM
MAKE_LOST_EVENT: novalue, ! Routine, makes an event lost
GET_CURRENT_JULIAN : novalue, ! Routine, get current julian time
JULIAN_TO_STRING, ! Routine, make string of julian time
EQUEUE_RESET : novalue, ! Routine, resets event queue
EQUEUE_INSERT : novalue, ! Routine, inserts into event queue
EQUEUE_REMOVE; ! Routine, removes from event queue
!
! External references
!
! Routines
external routine
NML$DLW_CHECK_CIRCUIT, ! Notify Data Link Watcher
NMU$QUEUE_MANAGER, ! Generalized queue management routines
NMU$SCHED_MANAGER, ! Scheduler
NMU$MEMORY_MANAGER, ! Memory management routines
NML$GET_VDB_PARAMETER, ! Extract data for specific parameter
NML$SET_VDB_PARAMETER, ! Set parameter in Volatile DB
NMU$TABLE_ROUTINES, ! Table handling routines
NMU$NETWORK_UTILITIES, ! Network interface
NML$EVL_APPLY_FILTER, ! Event logger filter routine
NML$EVL_EVENT_TEXT, ! Event logger event text
NMU$TEXT, ! Output formatting routines
NCP$EVENT_FMT_DATA : novalue, ! Format event parameters and counters
%if $TOPS20
%then
LOGEVT : novalue, ! **Temporary log event routine*
%fi
NCP$SEND_TO_OPERATOR : novalue; ! Do a WTO
! Variables
external
NMLVER, ! Network Managment version number
DECECO, ! Digital ECO number
USRECO; ! User ECO number
!
! Local macros
!
! This macro will remake a 7 bit ASCII string to a 8 bit one
macro
C_STRING [ ] = ! Counted string
C_CHAR(%char(%charcount(%remaining)),%explode(%remaining)) %;
macro
C_CHAR [B1,B2,B3,B4] =
((%C B1 ^ (%bpval-8))
%if not %null(B2)
%then
or (%C B2 ^ (%bpval-16))
%if not %null(B3)
%then
or (%C B3 ^ (%bpval-24))
%if not %null(B4)
%then
or (%C B4 ^ (%bpval-32))
%fi %fi %fi) %;
! The BYTE8(N) generates a subblock for N 8-bit bytes.
macro
$byte8(N) = $sub_block((N+3)/4) %;
! This macro can only be used in the context of the console logger.
! It provides a simple interface to the $NML$TEXT text formatter.
! It is a direct translation from the $RSP_TEXT macro in NCPRSP.
macro
$DSP_TEXT (FMT) =
(local I;
I = $NMU$TEXT (DSP_PTR,
.DSP_MAX_LENGTH - .DSP_LENGTH,
FMT
%if %length gtr 1
%then ,%remaining
%fi);
if .I geq 0
then DSP_LENGTH = .DSP_LENGTH + .I
else TASK_INFO('INTERNAL ERROR IN NML: Overflow in display buffer in CONSOLE_LOGGER')) %;
!
! DECnet parameters and literals
!
! Pointers for the three sinks
bind
LOGGING_CONSOLE_PTR = ch$ptr (uplit (%char (CONSOLE_))),
LOGGING_FILE_PTR = ch$ptr (uplit (%char (FILE_))),
LOGGING_MONITOR_PTR = ch$ptr (uplit (%char (MONITOR_)));
! Pointer to do 'SET LOGGING FILE NAME SYS/SERR:ERROR.SYS'
%if $TOPS10
%then
bind
LOGGING_NAME_ADR = uplit (C_STRING ('SYS:ERROR.SYS'));
%fi
%if $TOPS20
%then
bind
LOGGING_NAME_ADR = uplit (C_STRING ('SERR:ERROR.SYS'));
%fi
! Define NICE parameter numbers for NAME and STATE, and values for STATE.
literal
LOGGING_STATE_PARAMETER = 0,
LOGGING_NAME_PARAMETER = 100,
STATE_ON = 0,
STATE_OFF = 1,
STATE_HOLD = 2;
! Define EVENT buffer size. This is an architectural definition
literal
BUFFER_LENGTH = 200, ! Buffer len in bytes
BUFFER_SIZE = ch$allocation (BUFFER_LENGTH, 8), ! In words
BUFFER_ALLOCATION = BUFFER_SIZE*%upval; ! In addr units
! Define console logger display buffer size
literal
DSP_BUFFER_LENGTH = 2048,
DSP_BUFFER_SIZE = ch$allocation (DSP_BUFFER_LENGTH, 7),
DSP_BUFFER_ALLOCATION = DSP_BUFFER_SIZE * %upval;
! Define time intervals
literal
TWO_SECONDS = 2;
! Define # of event transmitters
literal
NR_EVENT_TRANSMITTERS = 2;
! Define maximum # of events on a single queue
literal
MAX_EVENTS_ON_QUEUE = 8;
!
! Data structures
!
!
! Event buffer block definitions
! These are handled by the EQUEUE_* routines.
!
! macro: EVENT_BUFFER Defines
! value: EVENT_BUFFER_SIZE Defines
!
$field EVENT_BUFFER_FIELDS =
set
EB_QUEUE = [$sub_block (Q_ENTRY_SIZE)], ! Queue link
EB_ALLOCATION = [$short_integer], ! Length of allocated memory
EB_LENGTH = [$short_integer], ! Length of message
EB_BUFFER = [$sub_block (0)] ! Beginning of buffer with message
tes;
literal
EVENT_BUFFER_SIZE = $field_set_size,
EVENT_BUFFER_ALLOCATION = $field_set_units;
macro
EVENT_BUFFER =
block field (EVENT_BUFFER_FIELDS, Q_ENTRY_FIELDS) %;
!
! Event time definition.
!
! The JULIAN_TIME_BLOCK keeps event time information in Julian format.
! It is pointed to by the REB.
!
field JULIAN_TIME_FIELDS =
set
JULIAN_DAY = [ $integer ],
JULIAN_SECOND = [ $integer ],
JULIAN_MILLISECOND = [ $integer ]
tes;
literal
JULIAN_TIME_SIZE = $field_set_size;
macro
JULIAN_TIME_BLOCK =
block [JULIAN_TIME_SIZE] field (JULIAN_TIME_FIELDS) %;
!
! Definitions for the event transmitter/remote logger
!
! There is one SINK_NODE_BLOCK for each sink node that is currently active
! Active means that there are events queued to be transmitted to it
$field SINK_NODE_FIELDS =
set
SINK_NODE_QUEUE = [ $sub_block(Q_ENTRY_SIZE) ],
SINK_NODE_ID = [ $byte8(NODE_ID_BUFFER_LENGTH) ],
EVENT_COUNT = [ $short_integer ],
SINK_NODE_WORKED_ON = [ $bits(1) ],
QH_EVENT_LIST = [ $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) %;
! Define scheduler queue entry for event transmitter
$field TQ_FIELDS =
set
TQ_QUEUE = [ $sub_block(Q_ENTRY_SIZE) ],
TQ_SINK_NODE_ID = [ $byte8(NODE_ID_BUFFER_LENGTH) ]
tes;
literal
TQ_SIZE = $field_set_size,
TQ_ALLOCATION = $field_set_units;
macro
TQ_BLOCK = block [TQ_SIZE] field (TQ_FIELDS) %;
!
! Own storage
!
own
CONSOLE_QUEUE: EVENT_QUEUE, ! Logging Console event queue
FILE_QUEUE : EVENT_QUEUE, ! Logging File event queue
MONITOR_QUEUE : EVENT_QUEUE, ! Logging Monitor event queue
QH_SINK_NODES : Q_HEADER, ! Header for queue of active sink nodes
TRANSMIT_QUEUE : SQ_HEADER, ! Scheduler queue header for event
! transmitters
LOCAL_NMX_EVENT : EVENT_BLOCK; ! Used for flagging local events
%global_routine ('NML$EVENT_INITIALIZE') : novalue =
!++
! Functional description:
!
! NM$EVENT_INITIALIZE initializes the NMLEVL module. It creates all
! event logger processes, and calls the volatile database to do the
! equivalent of
! NCP> SET LOGGING FILE NAME SYS:ERROR.SYS
! NCP> SET LOGGING FILE STATE ON
! which is the default state of the event logger.
!
!--
begin
!
! Reset the local logging queues and create the local logging processes
!
EQUEUE_RESET (CONSOLE_QUEUE, MAX_EVENTS_ON_QUEUE);
EQUEUE_RESET (FILE_QUEUE, MAX_EVENTS_ON_QUEUE);
EQUEUE_RESET (MONITOR_QUEUE, MAX_EVENTS_ON_QUEUE);
NMU$QUEUE_RESET(QH_SINK_NODES);
NMU$SQUEUE_RESET (TRANSMIT_QUEUE);
NMU$SCHED_CREATE (CONSOLE_LOGGER, 250, 0, ch$asciz ('LOGGING-CONSOLE'));
NMU$SCHED_CREATE (FILE_LOGGER, 100, 0, ch$asciz ('LOGGING-FILE'));
NMU$SCHED_CREATE (MONITOR_LOGGER, 250, 0, ch$asciz ('LOGGING_MONITOR'));
begin
local I;
incr I from 0 to NR_EVENT_TRANSMITTERS - 1 do
NMU$SCHED_CREATE( EVENT_TRANSMITTER, 250, 0,
ch$asciz ('EVENT-TRANSMITTER'));
end;
!
! Create the event receiver process
!
NMU$SCHED_CREATE (EVENT_RECEIVER, 250, 0, ch$asciz ('EVENT_RECEIVER'));
!
! Create the "get local events" process
!
NMU$SCHED_CREATE (GET_LOCAL_EVENT, 250, 0, ch$asciz ('GET-LOCAL-EVENT'));
!
! SET LOGGING FILE NAME SYS:ERROR.SYS
! SET LOGGING FILE STATE ON
!
NML$SET_VDB_PARAMETER (ENTITY_LOGGING,
LOGGING_FILE_PTR,
LOGGING_NAME_PARAMETER,
uplit (LOGGING_NAME_ADR));
NML$SET_VDB_PARAMETER (ENTITY_LOGGING,
LOGGING_FILE_PTR,
LOGGING_STATE_PARAMETER,
uplit (STATE_ON));
end; ! End of NML$EVENT_INITIALIZE
%routine ('GET_LOCAL_EVENT', TASK, RESOURCE) : novalue =
!++
!
! Functional decsription:
!
! GET_LOCAL_EVENT is the process that (together with its subordinates)
! reads events off the DECnet layers in the monitor.
!
! SET_EVENT_INTERRUPTS are called to enable event interrupts. The interrupt
! routine is EVENT_SIGNAL that will trigger the LOCAL_NMX_EVENT scheduler
! event block.
!
! GET_LOCAL_EVENT then loops calling EVENT_READ to get the next event.
! EVENT_READ will try to read an event and block if none is available
! waiting for the interrupt routine.
!
! Returning from EVENT_READ there is an event to process. The REB is
! stored with the data from the event block. The format of the event
! block read from the monitor is in the form of an "NQ" block.
!
!--
begin
local
RAW_BUFFER, ! Address of RAW Event Data
RAW_COUNT, ! Length of Event Data Read
RAW_BUFFER_POINTER, ! Pointer to raw buffer
REB : RAW_EVENT_BLOCK, ! Event block
IN_PTR, ! Pointer into RAW Event
JTB : JULIAN_TIME_BLOCK, ! Julian time block
REPEAT_COUNT; ! Knows when to do NMU$SCHED_PAUSE
while (RAW_BUFFER = NMU$MEMORY_GET (BUFFER_ALLOCATION)) eqla 0 do
NMU$SCHED_SLEEP (10);
! Get Single RAW Buffer
! Turn on event interrupts
SET_EVENT_INTERRUPTS();
! Initialize REPEAT_COUNT
REPEAT_COUNT = 0;
!
! Loop reading Events and copying them to Processed Buffers
!
while $true do
begin
! Check if time to let others run
if ((REPEAT_COUNT = .REPEAT_COUNT + 1) eql MAX_EVENTS_ON_QUEUE)
then begin
REPEAT_COUNT = 0;
NMU$SCHED_PAUSE();
end;
IN_PTR = RAW_BUFFER_POINTER = ch$ptr (.RAW_BUFFER,, 8);
!
! Read an Event and format it into the Processed Buffer
!
RAW_COUNT = EVENT_READ (BUFFER_LENGTH, .IN_PTR);
!
! Clear fields of REB that will be defaulted later.
REB[REB_SOURCE_POINTER] = 0;
REB[REB_SINK_FLAGS] = 0;
!
! Now get event class and type
REB [REB_EVENT_CODE] = GETW (IN_PTR);
! Now get event time (Julian format)
JTB[JULIAN_DAY] = GETW(IN_PTR); ! Get julian day
JTB[JULIAN_SECOND] = GETW(IN_PTR); ! Get julian second
JTB[JULIAN_MILLISECOND] = GETW(IN_PTR); ! Get julian millisecond
REB [REB_TIME_BLOCK] = JTB;
! Get entity type, and dispatch on the type
!
! Note: Already parsed parts of RAW_BUFFER are used as storage for the
! node ID.
begin
local ENTYPE : $SIGNED_BYTE_VALUE;
ENTYPE = GETB(IN_PTR);
REB [REB_ENTITY_TYPE] = .ENTYPE[VALUE];
%if $TOPS10
%then
! For DECnet Phase III 7.02 compatability
! This code will (try to) handle the ambiguity with 1-byte entity fields
! versus 2-byte ones. MCBs that have not been patched (patch # TBS) send
! a 2-byte field, while the architecture specifies a 1-byte field.
!
! We can assume (95% ?) that if the next byte is a zero byte, then it
! was probably a "long" entity type field.
!
! However, if we got a 377 byte (NO ENTITY) then we might have a parameter
! 0 coming next (e.g. event 2.0 generates that)
begin
local XPTR;
XPTR = .IN_PTR;
if GETB(XPTR) eql 0
then begin
if .REB[REB_ENTITY_TYPE] eql NO_ENTITY_
then begin
if GETB(XPTR) neq 0 ! Probably 2-byte field
then begin
GETB(IN_PTR);
end;
end else begin
GETB(IN_PTR);
end;
end;
end;
%fi ! End %if $TOPS10
selectone .REB [REB_ENTITY_TYPE] of
set
[ENTITY_NODE] : ! Node Entity
begin
local
LENGTH,
TEMP_PTR;
REB [REB_ENTITY_POINTER] = TEMP_PTR = .RAW_BUFFER_POINTER;
ch$wchar_a (ch$rchar_a (IN_PTR), TEMP_PTR);
ch$wchar_a (ch$rchar_a (IN_PTR), TEMP_PTR);
! Store Node Address
ch$wchar (0, .TEMP_PTR); ! and set for mapping function
IN_PTR = ch$plus (.IN_PTR, ch$rchar_a(IN_PTR)); ! Skip length
LENGTH = NODE_ID_BUFFER_LENGTH; ! Maximum Length Node_ID
$NML$MAP_NODE_ID (LENGTH, .RAW_BUFFER_POINTER);
end;
[ENTITY_AREA, ENTITY_LOGGING] : ! Area and logging entity
begin
REB [REB_ENTITY_POINTER] = .IN_PTR;
IN_PTR = ch$plus (.IN_PTR, 1);
end;
[ENTITY_LINE, ENTITY_CIRCUIT, ENTITY_MODULE] :
begin
local
LENGTH;
REB [REB_ENTITY_POINTER] = .IN_PTR;
LENGTH = ch$rchar (.IN_PTR) + 1;
IN_PTR = ch$plus (.IN_PTR, .LENGTH);
end;
[NO_ENTITY_] : ! No Entity
0;
[otherwise] : TASK_INFO('Bad entity type from monitor');
tes;
end;
! Set data pointer, and calculate # of data bytes from the difference in
! pointers.
REB [REB_DATA_POINTER] = .IN_PTR;
REB [REB_DATA_LENGTH] = .RAW_COUNT -
ch$diff (.IN_PTR, .RAW_BUFFER_POINTER);
!
! If the event is 96.7 (LCG specific), let the Data Link Watcher know about
! it, but don't log it.
!
! If the event is 4.7 (Circuit down, circuit fault), poke the Data Link
! watcher as well but do log the event.
!
if (.REB [REB_EVENT_CODE] eql 96^6 + 7)
or (.REB [REB_EVENT_CODE] eql 4^6 + 7)
then NML$DLW_CHECK_CIRCUIT (.REB [REB_ENTITY_POINTER]);
if (.REB [REB_EVENT_CODE] neq 96^6 + 7)
then NML$DECLARE_EVENT (REB);
end;
end; ! End of GET_LOCAL_EVENT
%routine('SET_EVENT_INTERRUPTS') : novalue =
!++
!
! Functional description:
!
! Enables event interrupts.
!
! Formal parameters:
!
! None
!
! Routine value:
!
! None
!
!--
begin
!
! Reset the event block and allow for new 'schedules'
!
NMU$SCHED_EVENT (LOCAL_NMX_EVENT, $false);
%if $TOPS10 ! Set up event interrupt for TOPS10
%then
begin
local
TEMP,
ARGBLK : vector [3];
builtin
UUO;
register
T1;
TEMP = ALLOCATE_INTERRUPT_CHANNEL (EVENT_SIGNAL);
ARGBLK [0] = $PCDVT;
ARGBLK [1] = (.TEMP * 4) ^ 18;
ARGBLK [2] = 0;
T1 = PS$FAC + ARGBLK;
UUO (1, PISYS$ (T1));
end;
%fi
! Set up event interrupts for TOPS20
%if $TOPS20
%then
begin
local CHANNEL; ! Interrupt channel to use
! Reserve a channel, and tell what interrupt routine
CHANNEL = ALLOCATE_INTERRUPT_CHANNEL ( EVENT_SIGNAL );
! Activate it
ACTIVATE_INTERRUPT ( .CHANNEL );
! Tell monitor to start
$$NML_INTERFACE_EXPAND( $NTPSI, ! Set PSI channel
ENTITY_LOGGING, ! Entity type
0, ! No entity ID
0, ! No qualifier
.CHANNEL); ! Interrupt channel
end;
%fi
end; ! End of SET_EVENT_INTERRUPTS
%routine ('EVENT_READ', MAX_LENGTH, BUFFER_POINTER) =
!++
!
! Functional description:
!
! This routine will read an event from the local NMX. If there is no
! outstanding event (i.e. the returned count is zero), it will sleep
! until woken up by the .PCDVT interrupt.
!
! Formal parameters:
!
! MAX_LENGTH Maximum length of the entire event buffer
! BUFFER_POINTER Where to put the event info
!
! Routine value:
!
! Number of bytes actually returned from the NMX
!
!--
begin
local LEN;
while $true do
begin
LEN = .MAX_LENGTH;
selectone $NML$GET_LOCAL_EVENT (LEN, .BUFFER_POINTER) of
set
[NICE$_SUC] : if .LEN gtr 0
then return .LEN
else NMU$SCHED_WAIT(LOCAL_NMX_EVENT,0);
%if $tops10
%then
[NICE$_OPF] : NMU$SCHED_WAIT(LOCAL_NMX_EVENT,0);
%fi
[otherwise] : TASK_ERROR (
'Illegal error from NMX while reading events');
tes;
end;
! Will never get here but BLISS wants a value statement so...
return 0;
end; ! End of EVENT_READ
%routine ('EVENT_SIGNAL', INTERRUPT_DATA) :
VANILLA_INTERRUPT_LINKAGE novalue =
!++
!
! Functional description:
!
! This is the interrupt level routine that will flag local events. It
! will cause the routine EVENT_READ to wake up.
!
! Formal parameters:
!
! INTERRUPT_DATA The status word returned from the interrupt
! control block.
!
!--
begin
NMU$SCHED_FLAG (LOCAL_NMX_EVENT);
end;
%global_routine ('NML$DECLARE_EVENT', REB : ref RAW_EVENT_BLOCK) : novalue =
! Debugging name = EV%DEC
!++
! Functional description:
!
! DECLARE_EVENT is called in two ways:
! - by a network management layer routine that logs an event
! - by GET_LOCAL_EVENT
!
! Its argument is a REB, and its function is to default the following
! fields in the REB:
! REB_SINK_FLAGS
! REB_SOURCE_POINTER
! REB_TIME_BLOCK
!
!--
begin
local
JTB : JULIAN_TIME_BLOCK; ! Declare julian time block
! If no sink flags supplied, default to all on
if .REB[REB_SINK_FLAGS] eql 0
then REB[REB_CONSOLE] = REB[REB_FILE] = REB[REB_MONITOR] = 1;
! If no source supplied, default to local node
if .REB[REB_SOURCE_POINTER] eql 0
then REB[REB_SOURCE_POINTER] = NMU$NETWORK_LOCAL();
! If no time supplied, get local julian time
if .REB[REB_TIME_BLOCK] eql 0
then begin
GET_CURRENT_JULIAN(JTB);
REB[REB_TIME_BLOCK] = JTB;
end;
! After all defaults has been put in, call the EVENT_PROCESSOR
EVENT_PROCESSOR(.REB); ! Next down the line....
end; ! End of NML$DECLARE_EVENT
%routine ('EVENT_RECEIVER', TASK, RESOURCE) : novalue =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is the top level of the Network Management
! Event receiver. The receiver is responsible for
! accepting connections from remote NMLs, verifying their
! privilege to perform logging functions based on access control
! information provided with the connection.
!
! FORMAL PARAMETERS
!
! TASK - Address of task block for this task
! RESOURCE - Address of cell for this task to use as
! a resource variable.
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! NONE.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
BUFFER_PTR; ! General I/O buffer pointer
BUFFER_PTR = ch$ptr (NMU$MEMORY_GET (BUFFER_ALLOCATION),, 8);
!
! Loop forever, wait for link connected, read requests until disconnected.
!
while $true do
begin
!
! Put our Network Management version number into the buffer
! to send as the optional data on a link connect acceptance.
!
begin
local
PTR;
PTR = .BUFFER_PTR; ! Point to connect accept buffer
PUTB (.NMLVER, PTR); ! Store NM major version
PUTB (.DECECO, PTR); ! Store our minor (ECO) version
PUTB (.USRECO, PTR); ! Store customer ECO number
end;
begin
local
LINK_ID; ! Open logical link identifier
LINK_ID = WAIT_FOR_CONNECT (EVENT_OBJECT, 3, .BUFFER_PTR);
READ_EVENT_REQUESTS (.LINK_ID, .BUFFER_PTR, BUFFER_LENGTH);
NMU$NETWORK_CLOSE (.LINK_ID, 0, 0);
end;
end;
end; ! End of NML$RECEIVE_EVENT
%routine ('WAIT_FOR_CONNECT', OBJECT, DATA_LEN, DATA_PTR) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine opens a target link for connection by
! another task. When a connect is attempted the user
! access rights are checked and the source task's version
! number is checked. If all checks are ok, then the
! link is accepted (sending the optional acceptance data)
! and the LINK_ID is returned. If any check fails,
! a reject is sent with the appropriate error code.
!
! FORMAL PARAMETERS
!
! OBJECT - DECnet object code
! DATA_LEN - Number of bytes in optional accept data
! DATA_PTR - Pointer to optional acceptance data
!
! IMPLICIT INPUTS
!
! NONE.
!
! ROUTINE VALUE:
!
! The LINK_ID of the opened link.
!
! SIDE EFFECTS:
!
! NONE.
!
!--
begin
local
LINK_HANDLE, ! Handle of link
CBLK : CONNECT_BLOCK, ! Link connection block
CONNECTED, ! Boolean indicating connect success
REASON; ! Link rejection reason
!
! Initially link is not connected
!
CONNECTED = $false;
!
! Loop until the link is connected
!
while not .CONNECTED do
begin
!
! Set the object code and clear the task name and descriptor.
!
CBLK [CB_OBJECT] = .OBJECT;
CBLK [CB_TASK_LENGTH] = 0;
CBLK [CB_DESCRIPTOR_LENGTH] = 0;
CBLK [CB_HOST_LENGTH] = 0;
CBLK [CB_USERID_LENGTH] = 0;
CBLK [CB_PASSWORD_LENGTH] = 0;
CBLK [CB_ACCOUNT_LENGTH] = 0;
CBLK [CB_DATA_LENGTH] = 0;
!
! Wait for a connect to this target task
!
if (LINK_HANDLE = NMU$NETWORK_OPEN (TARGET_LINK, CBLK, 0, 0, 0)) geq 0
then
!
! Accept the Connection
!
if not (CONNECTED = NMU$NETWORK_ACCEPT (.LINK_HANDLE,
.DATA_LEN,.DATA_PTR))
then
NMU$NETWORK_CLOSE (.LINK_HANDLE, 0, 0);
end;
!
! Return handle (id) of link that was opened and accepted.
!
return .LINK_HANDLE
end; ! End of WAIT_FOR_CONNECT
%routine ('READ_EVENT_REQUESTS', LINK_ID, BUF_PTR, BUF_LEN) : novalue =
!++
!
! Functional description:
!
! This routine reads events from a link. It loops and calls
! READ_ONE_EVENT until there are no more events. When that
! happens, then the routine waits a few seconds and tries
! again. If that fails, then the routine returns and the link
! is closed by the caller. In this way we hope to not have to
! reopen links all the time if someone is sending a lot of
! events to us.
!
!--
begin
local REPEAT_COUNT;
REPEAT_COUNT = 0;
while $true do begin ! Loop while link stays up
! Time to let anyone else run?
if ((REPEAT_COUNT = .REPEAT_COUNT + 1) eql MAX_EVENTS_ON_QUEUE)
then begin
REPEAT_COUNT = 0;
NMU$SCHED_PAUSE(); ! Let the rest of the world run
end;
! Read an event
if not READ_ONE_EVENT(.LINK_ID, .BUF_PTR, .BUF_LEN)
then begin
REPEAT_COUNT = 0; ! Reset count
NMU$SCHED_SLEEP(5); ! and take a volountary nap
if not READ_ONE_EVENT(.LINK_ID, .BUF_PTR, .BUF_LEN) ! Try again
then exitloop; ! Cant do any more, return and close
end;
end; ! End WHILE TRUE
return;
end; ! End of READ_EVENT_REQUESTS
%routine ('READ_ONE_EVENT', LINK_ID, BUF_PTR, BUF_LEN) =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine reads one event from a link. If there is no
! event available, it returns $false, otherwise $true.
!
! FORMAL PARAMETERS
!
! LINK_ID - Identifier for logical link to do looping on
!
!--
begin
local
REB : RAW_EVENT_BLOCK,
JTB : JULIAN_TIME_BLOCK,
BYTE_COUNT, ! Received EVENT request message length
PTR; ! Message pointer
REB [REB_TIME_BLOCK] = JTB;
PTR = .BUF_PTR;
!
! Check if we received a message, or read completed for some
! other reason. (Maybe the link was disconnected.)
!
! Correctly formatted event messages are always at least 15 bytes long
if (BYTE_COUNT = NMU$NETWORK_READ (.LINK_ID, .BUF_LEN, .BUF_PTR))
leq 14
then return $false; ! No more events
!
! Put the EVENT on the queue to be processed.
!
! Read function code and verify it
if ch$rchar_a(PTR) neq 1 then return $false;
! Read sink flags
REB [REB_SINK_FLAGS] = ch$rchar_a (PTR);
! Read event class and type
REB [REB_EVENT_CODE] = GETW (PTR);
! Get julian day, second and millisecond
JTB[JULIAN_DAY] = GETW(PTR);
JTB[JULIAN_SECOND] = GETW(PTR);
JTB[JULIAN_MILLISECOND] = GETW(PTR);
! If julian day is less than 365*2, then we are probably reading an event
! off a MCB. The MCB's send uptime instead of absolute time. Anyhow, if its
! coming from a MCB, set the sink flags to all sinks.
if .JTB[JULIAN_DAY] lss 365*2
then REB[REB_CONSOLE] = REB[REB_FILE] = REB[REB_MONITOR] = 1;
! Now pick up pointer to source node, and then step over the source node field
REB [REB_SOURCE_POINTER] = .PTR;
PTR = ch$plus (.PTR, 2);
PTR = ch$plus (.PTR, ch$rchar_a (PTR));
! Get entity type and pick up pointer to entity ID
begin
local ENTYPE : $SIGNED_BYTE_VALUE;
ENTYPE = GETB(PTR);
REB [REB_ENTITY_TYPE] = .ENTYPE[VALUE];
end;
! This code will (try to) handle the ambiguity with 1-byte entity fields
! versus 2-byte ones. MCBs that have not been patched (patch # TBS) send
! a 2-byte field, while the architecture specifies a 1-byte field.
!
! We can assume (95% ?) that if the next byte is a zero byte, then it
! was probably a "long" entity type field.
!
! However, if we got a 377 byte (NO ENTITY) then we might have a parameter
! 0 coming next (e.g. event 2.0 generates that)
begin
local XPTR;
XPTR = .PTR;
if GETB(XPTR) eql 0
then begin
if .REB[REB_ENTITY_TYPE] eql NO_ENTITY_
then begin
if GETB(XPTR) neq 0 ! Probably 2-byte field
then begin
GETB(PTR);
end;
end else begin
GETB(PTR);
end;
end;
end;
REB [REB_ENTITY_POINTER] = .PTR;
! Find out # of bytes to step over based on entity type
selectone .REB [REB_ENTITY_TYPE] of
set
[ENTITY_NODE] :
begin
PTR = ch$plus (.PTR, 2);
PTR = ch$plus (.PTR, ch$rchar_a (PTR));
end;
[ENTITY_CIRCUIT, ENTITY_LINE, ENTITY_MODULE] :
PTR = ch$plus (.PTR, ch$rchar_a (PTR));
[ENTITY_LOGGING, ENTITY_AREA] :
PTR = ch$plus (.PTR, 1);
tes;
! Finally get pointer to data, and calculate data length based on current
! pointer versus starting pointer.
REB[REB_DATA_POINTER] = .PTR;
REB [REB_DATA_LENGTH] =
.BYTE_COUNT - ch$diff (.PTR, ch$plus (.BUF_PTR, 1));
! Call the event recorder to log this event
EVENT_PROCESSOR (REB);
return $true; ! Return success
end; ! End of READ_EVENT_REQUESTS
%routine ('EVENT_PROCESSOR', REB : ref RAW_EVENT_BLOCK) : novalue =
!++
! Functional description:
!
! The event processor interfaces to the filter database to determine
! whether an event should be filtered or not. All the work is done by
! the filter database routines and a coroutine to the event processor
! names CO_EVENT_PROCESSOR.
!
!--
begin
NML$EVL_APPLY_FILTER(
.REB[REB_SINK_FLAGS], ! Sink flags
.REB[REB_EVENT_CODE], ! Event class and type
.REB[REB_ENTITY_TYPE], ! Event entity type
.REB[REB_ENTITY_POINTER], ! Event entity ID pointer
.REB, ! Address of REB
CO_EVENT_PROCESSOR ! Coroutine
);
end; !End of EVENT_PROCESSOR
%routine('CO_EVENT_PROCESSOR' , SINK_FLAGS,
LOCAL_DESTINATION,
DESTINATION_NODE,
REB : ref RAW_EVENT_BLOCK) =
!++
!
! Functional description:
!
! The CO_EVENT_PROCESSOR is called by the event logger database when
! a sink is detected for an event. Receiving the callback, the EVENT_
! RECORDER is called for events bound for the local node, and the
! EVENT_REMOTE_RECORDER is called for events bound for remote nodes.
!
! Note: we may clobber the fields in the REB since the event logger
! database are passed the relevant fields in the first call (as long
! as we dont destroy the entity ID of course....)
!
!--
begin
REB[REB_SINK_FLAGS] = .SINK_FLAGS;
if .LOCAL_DESTINATION neq 0
then EVENT_RECORDER(.REB)
else EVENT_REMOTE_RECORDER(.REB, .DESTINATION_NODE);
return $true; ! Unless $true is returned,
! the search for filters is stopped
end; ! End of CO_EVENT_PROCESSOR
%routine ('EVENT_RECORDER', REB : ref RAW_EVENT_BLOCK) : novalue =
!++
! Functional description:
!
! This routine dequeues requests to the local node and logs
! them to the appropriate Event Sink.
!
!--
begin
local STATE, ! STATE of sink value
TEMP; ! Temporary value
! Go through the sinks one by one
if .REB[REB_CONSOLE] neq 0
then begin
if not NML$GET_VDB_PARAMETER( ENTITY_LOGGING,
LOGGING_CONSOLE_PTR,
LOGGING_STATE_PARAMETER,
STATE)
then STATE = STATE_OFF;
if .STATE neq STATE_OFF
then if (TEMP = MAKE_EVENT_MESSAGE(.REB)) neqa 0
then EQUEUE_INSERT(CONSOLE_QUEUE, .TEMP);
end;
if .REB[REB_FILE] neq 0
then begin
if not NML$GET_VDB_PARAMETER( ENTITY_LOGGING,
LOGGING_FILE_PTR,
LOGGING_STATE_PARAMETER,
STATE)
then STATE = STATE_OFF;
if .STATE neq STATE_OFF
then if (TEMP = MAKE_EVENT_MESSAGE(.REB)) neqa 0
then EQUEUE_INSERT(FILE_QUEUE, .TEMP);
end;
if .REB[REB_MONITOR] neq 0
then begin
if not NML$GET_VDB_PARAMETER( ENTITY_LOGGING,
LOGGING_MONITOR_PTR,
LOGGING_STATE_PARAMETER,
STATE)
then STATE = STATE_OFF;
if .STATE neq STATE_OFF
then if (TEMP = MAKE_EVENT_MESSAGE(.REB)) neqa 0
then EQUEUE_INSERT(MONITOR_QUEUE, .TEMP);
end;
end; !End of EVENT_RECORDER
%routine ('CONSOLE_LOGGER', TASK, RESOURCE) : novalue =
!++
!
! Functional description:
!
! This process logs events to the 'logging console', i.e. on TOPS-20
! to OPR/ORION for distribution to all operator terminals
!
!--
begin
local
EB : ref EVENT_BUFFER; ! Event buffer
!
! Top level loop for Event requests
!
while $true do ! Main NML Request processing loop
begin
EB = EQUEUE_REMOVE (CONSOLE_QUEUE);
if (
while $true do
begin
local
STATE;
if not NML$GET_VDB_PARAMETER (ENTITY_LOGGING,
LOGGING_CONSOLE_PTR,
LOGGING_STATE_PARAMETER,
STATE)
then STATE = STATE_OFF;
if .STATE neq STATE_HOLD then exitloop .STATE;
!
! Wait for state to change
!
NMU$SCHED_SLEEP (10); ! Temporary hack
end ! End while
) eql STATE_ON ! Rest of IF conditional
then begin
local
DSP_ADR, ! Display buffer address
DSP_PTR, ! Display buffer pointer
DSP_MAX_LENGTH, ! Max # of bytes in display buffer
DSP_LENGTH, ! Remaining # of bytes in display buf
OUT_PTR, ! Display buffer origin pointer
IN_PTR, ! Pointer to event buffer
EVENT_CLASS, ! Event class
EVENT_TYPE, ! Event type
EVENT_ENTITY_TYPE, ! Event entity type
TEMP; ! Temporary variable
DSP_ADR = NMU$MEMORY_GET(DSP_BUFFER_ALLOCATION);
if .DSP_ADR neqa 0
then begin
! First make pointers to event buffer and to display
! buffer. It is ironic that we now have to unpack
! the EB again.....
IN_PTR = ch$ptr(EB[EB_BUFFER],,8);
OUT_PTR = DSP_PTR = ch$ptr(.DSP_ADR,,7);
DSP_MAX_LENGTH = DSP_BUFFER_LENGTH;
DSP_LENGTH = 0;
$DSP_TEXT('%/%N');
! First line of type out is
! "DECNET Event 4.7, Circuit down, circuit fault"
! Therefore read past two first bytes (function code
! and sink flags)
TEMP = GETB(IN_PTR);
TEMP = GETB(IN_PTR);
! Now get event class and type
TEMP = GETW(IN_PTR);
EVENT_CLASS = .TEMP<$$EVENT_CLASS>;
EVENT_TYPE = .TEMP<$$EVENT_TYPE>;
TEMP = NML$EVL_EVENT_TEXT(.EVENT_CLASS,.EVENT_TYPE);
if .TEMP eqla 0
then TEMP =
ch$asciz('** Unknown event class and type **');
$DSP_TEXT('DECNET Event type %D.%D, %A%/%N',
.EVENT_CLASS,
.EVENT_TYPE,
.TEMP
);
begin
local
JTB : JULIAN_TIME_BLOCK,
NODEADR,
LEN;
! 3 * 2 bytes with julian time
JTB[JULIAN_DAY] = GETW(IN_PTR);
JTB[JULIAN_SECOND] = GETW(IN_PTR);
JTB[JULIAN_MILLISECOND] = GETW(IN_PTR);
! Get and type out event source node ID
$DSP_TEXT('Event came from node %N');
NODEADR = GETW(IN_PTR);
if .NODEADR<10,6> eql 0
then begin
local TEMP;
TEMP = NMU$NETWORK_LOCAL();
TEMP = GETW (TEMP);
NODEADR<10,6> = .TEMP<10,6>;
end;
$DSP_TEXT('%M.%M %N',.NODEADR<10,6>,.NODEADR<0,10>);
LEN = GETB(IN_PTR); ! Get length of node ID string
$DSP_TEXT('(%#A), %N',.LEN,.IN_PTR);
IN_PTR = ch$plus(.IN_PTR,.LEN);
! Now type out event time
$DSP_TEXT('%A%/%N', JULIAN_TO_STRING(
.JTB[JULIAN_DAY],
.JTB[JULIAN_SECOND],
.JTB[JULIAN_MILLISECOND]
));
end;
! Now type out entity
begin
local LEN, ! Temporary
ENTYPE : $SIGNED_BYTE_VALUE;
ENTYPE = GETB(IN_PTR);
selectone (EVENT_ENTITY_TYPE = .ENTYPE[VALUE]) of
set
[ENTITY_AREA] :
$DSP_TEXT('%/ Area %M%/%N', GETB(IN_PTR));
[ENTITY_CIRCUIT, ENTITY_LINE, ENTITY_MODULE] :
begin
if .EVENT_ENTITY_TYPE eql ENTITY_CIRCUIT
then $DSP_TEXT('%/ Circuit %N')
else if .EVENT_ENTITY_TYPE eql ENTITY_LINE
then $DSP_TEXT('%/ Line %N')
else $DSP_TEXT('%/ Module %N');
LEN = GETB(IN_PTR);
$DSP_TEXT('%#A%/%N', .LEN, .IN_PTR);
IN_PTR = ch$plus(.IN_PTR, .LEN);
end;
[ENTITY_LOGGING] : GETB(IN_PTR);
[ENTITY_NODE] :
begin
local NODEADR;
NODEADR = GETW(IN_PTR);
if .NODEADR<10,6> leq 1
then $DSP_TEXT('%/ Node %M %N', .NODEADR<0,10>)
else $DSP_TEXT('%/ Node %M.%M %N',
.NODEADR<10,6>,.NODEADR<0,10>);
LEN = GETB(IN_PTR);
$DSP_TEXT('(%#A)%/%N', .LEN, .IN_PTR);
IN_PTR = ch$plus(.IN_PTR, .LEN);
end;
tes;
end;
! Now type out the value of the parameters
NCP$EVENT_FMT_DATA(
.EVENT_CLASS + EVENT_ENTITY_BASE,
.EVENT_ENTITY_TYPE,
DSP_PTR,
.DSP_LENGTH,
.DSP_MAX_LENGTH,
.EB[EB_LENGTH],
ch$diff(.IN_PTR, ch$ptr(EB[EB_BUFFER],,8)),
IN_PTR);
$DSP_TEXT('%/%N');
$DSP_TEXT('%/');
! Do a WTO to display the message to all operators
%if $TOPS10
%then NCP$SEND_TO_OPERATOR(0, .OUT_PTR);
%fi
%if $TOPS20
%then LOGEVT (.DSP_ADR);
%fi
! Release display buffer
NMU$MEMORY_RELEASE(.DSP_ADR, DSP_BUFFER_ALLOCATION);
end;
end;
! Release memory whether STATE_ON or STATE_OFF
NMU$MEMORY_RELEASE (.EB, .EB [EB_ALLOCATION]);
end; ! End big while $true loop
end; ! End of CONSOLE_LOGGER
%routine ('FILE_LOGGER', TASK, RESOURCE) : novalue =
!++
! Functional description:
!
! This process logs events to the 'logging file', i.e. on TOPS-20 to
! the system error file through SYERR% jsys.
!
!--
begin
local
EB : ref EVENT_BUFFER; ! Event buffer
!
! Top level loop for Event requests
!
while $true do ! Main NML Request processing loop
begin
EB = EQUEUE_REMOVE (FILE_QUEUE);
if (
while $true do
begin
local
STATE;
if not NML$GET_VDB_PARAMETER (ENTITY_LOGGING,
LOGGING_FILE_PTR,
LOGGING_STATE_PARAMETER,
STATE)
then STATE = STATE_OFF;
if .STATE neq STATE_HOLD then exitloop .STATE;
!
! Wait for state to change
!
NMU$SCHED_SLEEP (10); ! Temporary hack
end ! End while
) eql STATE_ON ! Rest of IF conditional
then begin
%if $TOPS20
%then
!
! This code does all processing for SYSERR logging under TOPS-20
!
DECLARE_JSYS (GTAD, TIME, SYSGT, SYERR);
field
SYSERR_FIELDS =
set
SY_COD = [0, 27, 9, 0], ! SYSERR Error Code
SY_T20 = [0, 18, 1, 0], ! Bit flagging TOPS-20 Made Entry
SY_VER = [0, 12, 6, 0], ! Header Version
SY_HLN = [0, 9, 3, 0], ! Header Length
SY_LEN = [0, 0, 9, 0], ! Data Length
SY_DTE = [1, 0, 36, 0], ! Date of Entry
SY_UPT = [2, 0, 36, 0], ! System Uptime at
! time of Logging
SY_PSN = [3, 0, 36, 0], ! Processor Serial Number
SY_DAT = [4, 0, 0, 0], ! Data portion of Entry
SY_DTL = [4, 0, 36, 0], ! Length (in 8-bit Bytes of
! remainder of data portion
SY_DTS = [5, 0, 0, 0] ! Event Data String
tes;
literal
SYSERR_HEADER_ALLOCATION = 5,
SYSERR_ERROR_CODE = %O'240';
local
SYSERR_ENTRY : ref block field (SYSERR_FIELDS),
SYSERR_ALLOCATION;
!
! Allocate SYSERR Entry
!
SYSERR_ALLOCATION = SYSERR_HEADER_ALLOCATION + ((.EB [EB_LENGTH] + 4)/4);
SYSERR_ENTRY = NMU$MEMORY_GET (.SYSERR_ALLOCATION);
SYSERR_ENTRY [SY_COD] = SYSERR_ERROR_CODE;
SYSERR_ENTRY [SY_T20] = 1;
SYSERR_ENTRY [SY_VER] = 1;
SYSERR_ENTRY [SY_HLN] = SYSERR_HEADER_ALLOCATION - 1;
SYSERR_ENTRY [SY_LEN] = ((.EB [EB_LENGTH] + 4)/4) + 1;
$$GTAD (; SYSERR_ENTRY [SY_DTE]);
begin
local
MILLISECONDS;
$$TIME (; MILLISECONDS);
SYSERR_ENTRY [SY_UPT] = .MILLISECONDS/((1000*3600*24)/(1^18));
! Convert to Days,,Fractions of Days
end;
$$SYSGT (%sixbit'APRID'; SYSERR_ENTRY [SY_PSN]);
! SPEAR wants 2-byte entity type field for the times being....
! Will change in future, SPEAR body version will then be updated.
! SYSERR_ENTRY [SY_DTL] = .EB [EB_LENGTH];
! ch$move (.EB [EB_LENGTH],
! ch$ptr (EB [EB_BUFFER],, 8),
! ch$ptr (SYSERR_ENTRY [SY_DTS],, 8));
! Add one to length to account for extra entity byte
SYSERR_ENTRY [SY_DTL] = .EB [EB_LENGTH] + 1;
! Event has the following layout:
! 12 bytes
! 1 byte giving length of node name
! n bytes of node name
! 1 byte entity type
! <1 zero byte to be inserted>
! the rest of message
begin
local EVPTR, SYPTR, I, REST;
EVPTR = ch$ptr(EB[EB_BUFFER],,8);
SYPTR = ch$ptr(SYSERR_ENTRY[SY_DTS],,8);
! First move the 12 bytes
ch$move(12, .EVPTR, .SYPTR);
EVPTR = ch$plus(.EVPTR, 12);
SYPTR = ch$plus(.SYPTR, 12);
! Get the node name length
I = GETB(EVPTR);
PUTB(.I,SYPTR);
! and move the node name
ch$move(.I, .EVPTR, .SYPTR);
EVPTR = ch$plus(.EVPTR, .I);
SYPTR = ch$plus(.SYPTR, .I);
! Calculate # of bytes in last segment
! ( = length - 12 bytes - count byte - node name length -
! entity type byte)
REST = .EB[EB_LENGTH] - 12 - 1 - .I - 1;
! Get the entity type byte and write a word
begin
local ENTYPE : $SIGNED_BYTE_VALUE;
ENTYPE = GETB(EVPTR);
I = .ENTYPE[VALUE];
PUTW(I,SYPTR);
end;
! Now copy the rest of the message
ch$move(.REST, .EVPTR, .SYPTR);
! We dont need to update pointers here since were done...
end;
$$SYERR (.SYSERR_ENTRY,
.SYSERR_ENTRY [SY_HLN] + .SYSERR_ENTRY [SY_LEN]);
NMU$MEMORY_RELEASE (.SYSERR_ENTRY, .SYSERR_ALLOCATION);
!
%fi ! End of $TOPS20
%if $TOPS10 %then
!
! This code does SYSERR (via DAEMON) processing for TOPS10
!
local
ERROR_BUFFER : ref vector,
ERROR_BUFFER_SIZE;
register
T1;
builtin
UUO;
ERROR_BUFFER_SIZE = 3 + (.EB [EB_LENGTH] + 4) / 4;
ERROR_BUFFER = NMU$MEMORY_GET (.ERROR_BUFFER_SIZE);
ERROR_BUFFER [0] = $DMERR; ! Install DAEMON function call
ERROR_BUFFER [1] = %o '240'; ! Install generic DECnet event code
! SPEAR wants 2-byte entity type field for the times being....
! Will change in future, SPEAR body version will then be updated.
! ERROR_BUFFER [2] = .EB [EB_LENGTH]; ! Install size of NICE msg
! ch$move (.EB [EB_LENGTH], ! \
! ch$ptr (EB [EB_BUFFER],,8),! > Install NICE message
! ch$ptr (ERROR_BUFFER [3],,8));! /
! Add one to length to account for extra entity byte
ERROR_BUFFER [2] = .EB [EB_LENGTH] + 1;
! Event has the following layout:
! 12 bytes
! 1 byte giving length of node name
! n bytes of node name
! 1 byte entity type
! <1 zero byte to be inserted>
! the rest of message
begin
local EVPTR, SYPTR, I, REST;
local ENTYPE : $SIGNED_BYTE_VALUE;
EVPTR = ch$ptr(EB[EB_BUFFER],,8);
SYPTR = ch$ptr(ERROR_BUFFER[3],,8);
! First move the 12 bytes
ch$move(12, .EVPTR, .SYPTR);
EVPTR = ch$plus(.EVPTR, 12);
SYPTR = ch$plus(.SYPTR, 12);
! Get the node name length
I = GETB(EVPTR);
PUTB(.I,SYPTR);
! and move the node name
ch$move(.I, .EVPTR, .SYPTR);
EVPTR = ch$plus(.EVPTR, .I);
SYPTR = ch$plus(.SYPTR, .I);
! Calculate # of bytes in last segment
! ( = length - 12 bytes - count byte - node name length -
! entity type byte)
REST = .EB[EB_LENGTH] - 12 - 1 - .I - 1;
! Get the entity type byte and write a word
ENTYPE = GETB(EVPTR);
I = .ENTYPE[VALUE];
PUTW(I,SYPTR);
! Now copy the rest of the message
ch$move(.REST, .EVPTR, .SYPTR);
! We dont need to update pointers here since were done...
end;
T1 = .ERROR_BUFFER_SIZE ^ 18 + .ERROR_BUFFER;
if not UUO (1, DAEMON (T1))
then
begin
literal
TXT_SIZ = 100;
local
TXT_LEN,
TXT_PTR,
TXT_BUF: vector [ch$allocation (TXT_SIZ)];
TXT_LEN = TXT_SIZ;
TXT_PTR = ch$ptr (TXT_BUF);
TXT_LEN = $NMU$TEXT (TXT_PTR, .TXT_LEN,
'.DMERR function call to DAEMON failed; %N');
if .T1 eql (.ERROR_BUFFER_SIZE^18 + .ERROR_BUFFER)
then
$NMU$TEXT (TXT_PTR, .TXT_LEN,
'DAEMON not running')
else
$NMU$TEXT (TXT_PTR, .TXT_LEN,
'error code %O',
.T1);
TASK_INFO (ch$ptr (TXT_BUF));
end;
NMU$MEMORY_RELEASE (.ERROR_BUFFER, .ERROR_BUFFER_SIZE);
%fi ! End of $TOPS10
end;
! Release memory whether STATE_ON or STATE_OFF
NMU$MEMORY_RELEASE (.EB, .EB [EB_ALLOCATION]);
end; ! End big while $true loop
end; !End of FILE_LOGGER
%routine ('MONITOR_LOGGER', TASK, RESOURCE) : novalue =
!++
!
! Functional description:
!
! This process logs events to the 'logging monitor', i.e. on TOPS-20
! to a user DECnet process.
!
!--
begin
local
EB : ref EVENT_BUFFER; ! Event buffer
!
! Top level loop for Event requests
!
while $true do ! Main NML Request processing loop
begin
EB = EQUEUE_REMOVE (MONITOR_QUEUE);
if (
while $true do
begin
local
STATE;
if not NML$GET_VDB_PARAMETER (ENTITY_LOGGING,
LOGGING_MONITOR_PTR,
LOGGING_STATE_PARAMETER,
STATE)
then STATE = STATE_OFF;
if .STATE neq STATE_HOLD then exitloop .STATE;
!
! Wait for state to change
!
NMU$SCHED_SLEEP (10); ! Temporary hack
end ! End while
) eql STATE_ON ! Rest of IF conditional
then while $true do
begin
! This while $true loop is only for the purpose of
! providing an exit on error mechanism through 'exitloop'
! There is no true loop, and all paths will do an exitloop
%if $tops10
%then
1; ! [TBS]
%fi
%if $tops20
%then
DECLARE_JSYS(GTJFN,OPENF,SOUT,CLOSF,MTOPR,DVCHR,RLJFN);
local NAME_PTR,
DST_STR : vector[ch$allocation(150)],
DST_PTR,
LEN,
JFN,
TMP,
DEVCHR,
STATUS;
! Get NAME value; contains host and task name/object ID
if not NML$GET_VDB_PARAMETER (ENTITY_LOGGING,
LOGGING_MONITOR_PTR,
LOGGING_NAME_PARAMETER,
NAME_PTR)
then exitloop; ! Exit if failed to get NAME
! Move name to ASCIZ string
DST_PTR = ch$ptr(DST_STR,,7);
LEN = GETB(NAME_PTR);
ch$move(.LEN,.NAME_PTR,.DST_PTR);
DST_PTR = ch$plus(.DST_PTR, .LEN);
PUTB(0,DST_PTR); ! Make ASCIZ
! Do a GTJFN on the string
if not $$GTJFN(GJ_SHT,ch$ptr(DST_STR);JFN,TMP)
then exitloop; ! If failed to GTJFN
if not $$OPENF(.JFN, %O'100000' ^ 18 + OF_RD + OF_APP; TMP)
then begin
$$RLJFN(.JFN;TMP); ! Release JFN
exitloop; ! and exit since failed to OPENF
end;
! Check device type
$$DVCHR(.JFN;TMP,DEVCHR,TMP);
if ((.DEVCHR ^ -18) and %O'777') eql $DVDCN
then begin
! It is DCN: => wait until connected
NMU$SCHED_SLEEP(1); ! Sleep 1 second
if (while $true do
begin
$$MTOPR(.JFN,$MORLS,.TMP,.TMP; STATUS,TMP);
if (.STATUS and MO_CON) neq 0
then exitloop $true;
if (.STATUS and MO_WCC) eql 0
then exitloop $false;
NMU$SCHED_SLEEP(10); ! Sleep 10 seconds
end
) eql $false
then begin
$$CLOSF(.JFN; TMP);
exitloop;
end;
end;
! Now output event record
$$SOUT(.JFN, ch$ptr(EB[EB_BUFFER],,8), - .EB[EB_LENGTH], 0;
TMP,TMP,TMP);
! Close link
$$CLOSF(.JFN; TMP);
exitloop;
%fi
end; ! End 'dummy' while $true
! Release memory whether STATE_ON or STATE_OFF
NMU$MEMORY_RELEASE (.EB, .EB [EB_ALLOCATION]);
end; ! End big while $true loop
end; ! End of MONITOR_LOGGER
%routine('EVENT_REMOTE_RECORDER' , REB : ref RAW_EVENT_BLOCK,
DESTINATION_NODE) : novalue =
!++
!
! Functional description:
!
! The EVENT_REMOTE_RECORDER distributes events bound for remote nodes.
!
!--
begin
local EB : ref EVENT_BUFFER,
SINK_NODE_PTR : ref SINK_NODE_BLOCK,
TQ_PTR : ref TQ_BLOCK;
if (EB = MAKE_EVENT_MESSAGE(.REB)) eqla 0 then return;
! See if this sink node is known
SINK_NODE_PTR = NMU$QUEUE_SCAN(QH_SINK_NODES,
.DESTINATION_NODE,
SINK_NODE_MATCH);
if .SINK_NODE_PTR eqla 0
then begin ! Create sink node block
if (SINK_NODE_PTR = NMU$MEMORY_GET(SINK_NODE_ALLOCATION)) eqla 0
then begin
NMU$MEMORY_RELEASE(.EB, .EB[EB_ALLOCATION]);
return;
end;
if (TQ_PTR = NMU$MEMORY_GET(TQ_ALLOCATION)) eqla 0
then begin
NMU$MEMORY_RELEASE(.EB, .EB[EB_ALLOCATION]);
NMU$MEMORY_RELEASE(.SINK_NODE_PTR, SINK_NODE_ALLOCATION);
return;
end;
! Initialize sink node block
ch$move(NODE_ID_BUFFER_LENGTH,
.DESTINATION_NODE,
ch$ptr(SINK_NODE_PTR[SINK_NODE_ID],,8));
SINK_NODE_PTR[EVENT_COUNT] = 0;
SINK_NODE_PTR[SINK_NODE_WORKED_ON] = $false;
NMU$QUEUE_RESET(SINK_NODE_PTR[QH_EVENT_LIST]);
NMU$QUEUE_INSERT(QH_SINK_NODES, .SINK_NODE_PTR);
! Initialize TQ block
ch$move(NODE_ID_BUFFER_LENGTH,
.DESTINATION_NODE,
ch$ptr(TQ_PTR[TQ_SINK_NODE_ID],,8));
! Schedule it
NMU$SQUEUE_INSERT(TRANSMIT_QUEUE, .TQ_PTR);
end;
! Is there room in the queue?
if .SINK_NODE_PTR[EVENT_COUNT] eql MAX_EVENTS_ON_QUEUE
then NMU$MEMORY_RELEASE(.EB, .EB[EB_ALLOCATION])
else begin
if .SINK_NODE_PTR[EVENT_COUNT] eql (MAX_EVENTS_ON_QUEUE - 1)
then MAKE_LOST_EVENT(.EB);
NMU$QUEUE_INSERT(SINK_NODE_PTR[QH_EVENT_LIST], .EB);
SINK_NODE_PTR[EVENT_COUNT] = .SINK_NODE_PTR[EVENT_COUNT] + 1;
end;
return;
end; ! End of EVENT_REMOTE_RECORDER
%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.
!
! 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_ID],,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 ('EVENT_TRANSMITTER', TASK, RESOURCE) : novalue =
!++
! Functional description:
!
! This task runs forever removing remote requests
! from the request queue and sending them to the appropriate
! remote node for processing.
!
! Formal parameters:
!
! TASK Task block address
! RESOURCE Task resource address
!
! Routine value: none
! Side effects: none
!
!--
begin
local
EB : ref EVENT_BUFFER,
SINK_NODE_PTR : ref SINK_NODE_BLOCK,
TQ_PTR : ref TQ_BLOCK,
LINK_ID;
while $true do
begin
! Get next sink node to service
TQ_PTR = NMU$SQUEUE_REMOVE(TRANSMIT_QUEUE);
! If pointer is non-zero, go ahead
if .TQ_PTR neqa 0
then begin
! Find the associated sink node block
SINK_NODE_PTR = NMU$QUEUE_SCAN(QH_SINK_NODES,
ch$ptr(TQ_PTR[TQ_SINK_NODE_ID],,8),
SINK_NODE_MATCH);
! Release TQ block, no more use for it
NMU$MEMORY_RELEASE(.TQ_PTR, TQ_ALLOCATION);
! If we found a sink node block, proceed
if .SINK_NODE_PTR neqa 0
then if .SINK_NODE_PTR[SINK_NODE_WORKED_ON] eql $false
then begin
! We are now working on this sink node
SINK_NODE_PTR[SINK_NODE_WORKED_ON] = $true;
! Open a network link to this sink node
LINK_ID = CONNECT_TO_REMOTE(
ch$ptr(SINK_NODE_PTR[SINK_NODE_ID],,8));
! Get all events on this sink node,
! and ship them off one by one
while (EB =
NMU$QUEUE_REMOVE(SINK_NODE_PTR[QH_EVENT_LIST]))
neqa 0 do begin
! Decrement # of events on queue
SINK_NODE_PTR[EVENT_COUNT] =
.SINK_NODE_PTR[EVENT_COUNT] - 1;
! Send the events if LINK_ID non-zero
if .LINK_ID gtr 0
then NMU$NETWORK_WRITE(
.LINK_ID,
$true,
.EB[EB_LENGTH],
ch$ptr(EB[EB_BUFFER],,8));
! No more use for the EB block
NMU$MEMORY_RELEASE(.EB,
.EB[EB_ALLOCATION]);
! Allow others in; they might event
! give me a new event to work on!
NMU$SCHED_PAUSE();
end;
! This sink node block is now empty, unlink and
! deallocate
if (NMU$QUEUE_EXTRACT(QH_SINK_NODES, .SINK_NODE_PTR))
eql $true then NMU$MEMORY_RELEASE(.SINK_NODE_PTR,
SINK_NODE_ALLOCATION);
! Close the network link with remote
NMU$NETWORK_CLOSE(.LINK_ID, 0, 0);
end;
end;
end;
end; ! End of EVENT_TRANSMITTER
%routine ('CONNECT_TO_REMOTE', NODE_ID_PTR) =
!++
! Functional description:
!
! This routine connects to the EVENT listener on the
! host specified in the request. It does not return
! until the connection is made (or determined to be
! next to impossible).
!
! Formal parameters:
!
! .NODE_ID_PTR Pointer to target node-id
!
! Routine value:
!
! Link id of DECnet link to remote EVENT listener
!
! Side effects: none
!
!--
begin
local
CONN_BLK : CONNECT_BLOCK,
LINK_ID,
CBPTR;
! Optional data is version information
CBPTR = ch$ptr(CONN_BLK[CB_DATA_BUFFER],,8);
PUTB(.NMLVER,CBPTR); ! NML version
PUTB(.DECECO,CBPTR); ! DEC Eco #
PUTB(.USRECO,CBPTR); ! User Eco #
CONN_BLK [CB_DATA] = ch$ptr (CONN_BLK [CB_DATA_BUFFER],, 8);
CONN_BLK [CB_DATA_LENGTH] = 3;
CONN_BLK [CB_OBJECT] = EVENT_OBJECT;
CONN_BLK [CB_DESCRIPTOR_LENGTH] = 0;
CONN_BLK [CB_TASK_LENGTH] = 0;
CONN_BLK [CB_HOST_LENGTH] = ch$rchar (ch$plus (.NODE_ID_PTR, 2)) + 3;
CONN_BLK [CB_HOST] = .NODE_ID_PTR;
CONN_BLK [CB_USERID] = 0;
CONN_BLK [CB_USERID_LENGTH] = 0;
CONN_BLK [CB_ACCOUNT] = 0;
CONN_BLK [CB_ACCOUNT_LENGTH] = 0;
CONN_BLK [CB_PASSWORD] = 0;
CONN_BLK [CB_PASSWORD_LENGTH] = 0;
decr NTIMES from 3 to 1 do
begin
LINK_ID = NMU$NETWORK_OPEN (SOURCE_LINK, CONN_BLK, 0, 0, 0);
if .LINK_ID geq 0 then exitloop;
NMU$SCHED_SLEEP (TWO_SECONDS);
end;
return .LINK_ID
end; ! End of CONNECT_TO_REMOTE
%routine ('MAKE_EVENT_MESSAGE', REB : ref RAW_EVENT_BLOCK) =
!++
!
! Functional description:
!
!--
begin
local
EB : ref EVENT_BUFFER; ! Event buffer
begin
local
ALLOCATION;
ALLOCATION = EVENT_BUFFER_ALLOCATION + ! Event buffer header
1 + ! FUNCTION CODE
1 + ! SINK FLAGS
2 + ! EVENT CODE
2 + 2 + 2 + ! EVENT TIME
2 + 1 + 6 + ! SOURCE NODE
1 + max (0, 9, 17) + ! EVENT ENTITY
.REB [REB_DATA_LENGTH]; ! EVENT_DATA
if (EB = NMU$MEMORY_GET (.ALLOCATION)) eqla 0
then return 0; ! No memory.
EB [EB_ALLOCATION] = .ALLOCATION; ! Save allocation length.
end;
begin ! Construct NICE event message
local
OUT_PTR;
OUT_PTR = ch$ptr (EB [EB_BUFFER],, 8);
! Function code is = 1
ch$wchar_a (1, OUT_PTR);
! Write sink flags
ch$wchar_a (.REB [REB_SINK_FLAGS], OUT_PTR);
! Write event code
PUTW((REB[REB_EVENT_CODE]), OUT_PTR);
! Now write time
begin
bind JTB = .REB[REB_TIME_BLOCK] : JULIAN_TIME_BLOCK;
PUTW((JTB[JULIAN_DAY]), OUT_PTR);
PUTW((JTB[JULIAN_SECOND]), OUT_PTR);
PUTW((JTB[JULIAN_MILLISECOND]), OUT_PTR);
end;
! Now copy source node ID (address and name)
begin
local
TEMP_PTR;
TEMP_PTR = .REB [REB_SOURCE_POINTER];
! Node address
ch$wchar_a (ch$rchar_a (TEMP_PTR), OUT_PTR);
ch$wchar_a (ch$rchar_a (TEMP_PTR), OUT_PTR);
! Node name
OUT_PTR = ch$move (ch$rchar (.TEMP_PTR) + 1, .TEMP_PTR, .OUT_PTR);
end;
! Now write event entity
begin
local
LENGTH;
! Entity type
PUTB ((.REB [REB_ENTITY_TYPE]), OUT_PTR);
! Dispatch on entity type to copy entity ID
selectoneu .REB [REB_ENTITY_TYPE] of
set
[ENTITY_NODE] :
OUT_PTR = ch$move (2 + 1 + ch$rchar (
ch$plus (.REB [REB_ENTITY_POINTER], 2)),
.REB [REB_ENTITY_POINTER],
.OUT_PTR);
[ENTITY_LINE, ENTITY_CIRCUIT, ENTITY_MODULE] :
OUT_PTR = ch$move (1 + ch$rchar (.REB [REB_ENTITY_POINTER]),
.REB [REB_ENTITY_POINTER],
.OUT_PTR);
[ENTITY_LOGGING, ENTITY_AREA] :
ch$wchar_a (ch$rchar (.REB [REB_ENTITY_POINTER]), OUT_PTR);
[NO_ENTITY_] : 0;
[otherwise] : TASK_INFO(
'Bad entity type in event received from monitor');
tes;
end;
! Now copy event data
begin
local
LENGTH;
if (LENGTH = .REB [REB_DATA_LENGTH]) gtr 0
then
OUT_PTR = ch$move (.LENGTH, .REB [REB_DATA_POINTER], .OUT_PTR);
end;
! Insert length of message.
EB [EB_LENGTH] = ch$diff (.OUT_PTR, ch$ptr (EB [EB_BUFFER],, 8));
end;
return .EB; ! Return address of buffer block.
end; !End of MAKE_EVENT_MESSAGE
%routine('MAKE_LOST_EVENT', EB : ref EVENT_BUFFER) : novalue =
!++
!
! Functional description:
!
! Turns current event into a lost event
!
! Formal parameters:
!
! EB Points to EVENT_BUFFER containing event message to change
!
!--
begin
local PTR, TEMP;
! Point past function code and sink flags
TEMP = PTR = ch$ptr(EB[EB_BUFFER],2,8);
! Maybe already lost event?
if (GETB(PTR) eql 0) and (GETB(PTR) eql 0) then return;
! Make this event lost (event 0.0)
PTR = .TEMP;
PUTB(0,PTR);
PUTB(0,PTR);
! Pass julian time and source node address
PTR = ch$plus(.PTR, 6 + 2);
TEMP = GETB(PTR); ! Get node name length
PTR = ch$plus(.PTR, .TEMP); ! Pass node name string
! No entity
PUTB(NO_ENTITY_ and %O'377', PTR); ! Put out NO ENTITY
! Change length so end of message is here
EB[EB_LENGTH] = ch$diff(.PTR, ch$ptr(EB[EB_BUFFER],,8));
return;
end; ! End of MAKE_LOST_EVENT
%routine('GET_CURRENT_JULIAN' , JTB : ref JULIAN_TIME_BLOCK) : novalue =
!++
!
! Functional description:
!
! This routine accepts a pointer to an JTB as input and fills in the
! current julian time.
!
! Routine value:
!
! None
!
!--
begin
literal CORRECTION_FACTOR = ((1977 - 1858) * 365 + (1977 - 1858) / 4
- (31 + 28 + 31 + 30 + 31 + 30 + 31 + 31 + 30 + 31)
+ (1 - 17)) * 2;
local CURTIM;
! Get current time
TIME_CURRENT (0,CURTIM);
! If TOPS-20, then we need to adjust for the time zone
%if $tops20
%then
begin
local TIME_ZONE;
DECLARE_JSYS (TMON);
$$TMON ($SFTMZ; TIME_ZONE);
CURTIM = .CURTIM - (.TIME_ZONE * 60 * 60 * (1^18))/(24 * 60 * 60);
end;
%fi
! Now convert to julian half day format
JTB [JULIAN_DAY] = .CURTIM <17,19> - CORRECTION_FACTOR;
JTB [JULIAN_SECOND] = (.CURTIM <0,17>*24*60*60)/(1^18);
JTB [JULIAN_MILLISECOND] = 1^15; ! Milli-seconds not yet supported
end; ! End of GET_CURRENT_JULIAN
%routine('JULIAN_TO_STRING', JULIAN_HALF_DAY, SECOND, MILLISECOND) =
!++
!
! Functional description:
!
! This routine returns a pointer to the date and time text string
! corresponding to the input julian time.
!
! Routine is courtesy of Paul Baker.
!
!--
BEGIN
LITERAL
TIME_BUFFER_LENGTH = 80;
MACRO
LEAP_YEAR =
.YEAR<0,2,0> EQL 0 %;
BIND
MONTH_TEXT = UPLIT('***',
'JAN',
'FEB',
'MAR',
'APR',
'MAY',
'JUN',
'JUL',
'AUG',
'SEP',
'OCT',
'NOV',
'DEC') : VECTOR [13];
OWN
TIME_BUF : VECTOR [CH$ALLOCATION(TIME_BUFFER_LENGTH)],
MONTH_TABLE : INITIAL (365,31,28,31,30,31,30,31,31,30,31,30,31)
VECTOR [13],
TB : VECTOR[10]; ! There is no structure defined for
! a display time block. 5 entries
! are used, but allocate a few extra
! to be sure...
LOCAL
DSP_PTR,
DSP_MAX_LENGTH,
DSP_LENGTH,
YEAR,
MONTH,
DAY,
HH,
MM,
SS,
UPTIME_FLAG,
TEMP;
DSP_PTR = ch$ptr(TIME_BUF,,7);
DSP_MAX_LENGTH = TIME_BUFFER_LENGTH;
DSP_LENGTH = 0;
YEAR = 1977; ! Set base date
MONTH = 1;
DAY = 1;
IF .JULIAN_HALF_DAY LSS 365 * 2 ! Uptime? (less than year 1)
THEN
BEGIN
UPTIME_FLAG = $TRUE;
DAY = 0 ! Count uptime from 0 days
END
ELSE
BEGIN
UPTIME_FLAG = $FALSE;
WHILE 1 DO ! Calculate the year
BEGIN
IF LEAP_YEAR
THEN
TEMP = .JULIAN_HALF_DAY - (366 * 2)
ELSE
TEMP = .JULIAN_HALF_DAY - (365 * 2);
IF .TEMP GEQ 0
THEN
BEGIN
JULIAN_HALF_DAY = .TEMP;
YEAR = .YEAR + 1;
END
ELSE
EXITLOOP;
END; ! End of WHILE 1 - Calculate year
IF LEAP_YEAR ! Set correct length of February
THEN
MONTH_TABLE [2] = 29
ELSE
MONTH_TABLE [2] = 28;
WHILE 1 DO ! Calculate the month
BEGIN
TEMP = .JULIAN_HALF_DAY - (.MONTH_TABLE [.MONTH] * 2);
IF .TEMP GEQ 0
THEN
BEGIN
JULIAN_HALF_DAY = .TEMP;
MONTH = .MONTH + 1;
END
ELSE
EXITLOOP;
END ! End of WHILE 1 - Calculate month
END; ! END of IF Uptime
DAY = .DAY + .JULIAN_HALF_DAY / 2; ! Calculate correct day
IF .JULIAN_HALF_DAY<0,1,0> ! AM or PM?
THEN
HH = 12
ELSE
HH = 0;
TEMP = .SECOND / 3600;
SECOND = .SECOND - .TEMP * 3600;
HH = .HH + .TEMP;
MM = .SECOND / 60;
SS = .SECOND - .MM * 60;
IF .UPTIME_FLAG EQL $TRUE ! Uptime? (less than year 1)
THEN
$DSP_TEXT('uptime was %D day(s)%N', .DAY)
ELSE
$DSP_TEXT('occurred %D-%A-%D%N',
.DAY, ch$ptr(month_text[.month]), .YEAR);
TB[0] = .HH;
TB[1] = .MM;
TB[2] = .SS;
if .MILLISECOND neq %O'100000'
then $DSP_TEXT(' %3Z',TB)
else begin
TB[3] = .MILLISECOND;
TB[4] = 1000;
$DSP_TEXT(' %5Z',TB);
end;
RETURN ch$ptr(TIME_BUF,,7); ! Return string pointer
END; ! End JULIAN_TO_STRING
%routine ('EQUEUE_RESET', EQ: ref EVENT_QUEUE, LENGTH) : novalue =
!++
! Functional description:
!
! None
!
! Formal parameters: none
!
! Routine value: none
! Side effects: none
!
!--
begin
NMU$SQUEUE_RESET (.EQ);
EQ [EQ_COUNT] = 0;
EQ [EQ_LENGTH] = .LENGTH;
end; ! End of EQUEUE_RESET
%routine ('EQUEUE_INSERT',
EQ: ref EVENT_QUEUE, EB : ref EVENT_BUFFER) : novalue =
!++
! Functional description:
!
! None
!
! Formal parameters: none
!
! Routine value: none
! Side effects: none
!
!--
begin
if .EQ [EQ_COUNT] eql .EQ [EQ_LENGTH]
then
begin
NMU$MEMORY_RELEASE (.EB, .EB [EB_ALLOCATION]);
return;
end;
EQ [EQ_COUNT] = .EQ [EQ_COUNT] + 1;
if .EQ [EQ_COUNT] eql .EQ [EQ_LENGTH]
then
begin
local
LNG,
PTR;
PTR = ch$ptr (EB [EB_BUFFER], 2, 8);
if (ch$rchar (.PTR) eql 0) and
(ch$rchar (ch$plus (.PTR, 1)) eql 0)
then ! Last event is lost event
begin
EQ [EQ_COUNT] = .EQ [EQ_COUNT] - 1;
NMU$MEMORY_RELEASE (.EB, .EB [EB_ALLOCATION]);
return;
end;
!
! Turn current event into 'lost event' event
!
MAKE_LOST_EVENT(.EB);
end;
NMU$SQUEUE_INSERT (.EQ, .EB);
end; ! End of EQUEUE_INSERT
%routine ('EQUEUE_REMOVE', EQ: ref EVENT_QUEUE) =
!++
! Functional description:
!
! None
!
! Formal parameters: none
!
! Routine value: none
! Side effects: none
!
!--
begin
local
EB;
EB = NMU$SQUEUE_REMOVE (.EQ);
EQ [EQ_COUNT] = .EQ [EQ_COUNT] - 1;
.EB
end; ! End of EQUEUE_REMOVE
! End of module NMLEVL
end
eludom
! Local Modes:
! Mode:BLISS
! Comment Column:40
! Comment Rounding:+1
! End: