Google
 

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: