?Page
?NOCODE,NOICODE,NOMAP,NOCROSSREF,SYMBOLS,INSPECT,SAVEABEND,HIGHPIN,NOLIST
!#############################################################################
!#                                                                           #
!#   MSGLOGER : Version 1.02.03                                              #
!#                                                                           #
!#   Mark Dickinson, 06 June 2001 (BETA).                                    #
!#                                                                           #
!#   Purpose                                                                 #
!#                                                                           #
!#   To log all messages written to it to a disk based log file. It will     #
!#   record the following information from the sender of the message in the  #
!#   log file...                                                             #
!#     o  process name (or cpu,pin if unnamed)                               #
!#     o  process accessor id of the sending process (effective user id)     #
!#     o  the home terminal of the sending process                           #
!#     o  the message text passed to this process.                           #
!#                                                                           #
!#   Features                                                                #
!#     o  process status and error messages logged to an ems event collector #
!#     o  event collector to be used selected by define                      #
!#     o  log file location, file prefix, extents and filecode selected by   #
!#        an assign                                                          #
!#     o  automatically switches log files on the first message of a new day #
!#     o  automatic deletion of old expired log files                        #
!#     o  param used to define number of days to keep a log file before it   #
!#        expires                                                            #
!#     o  can run as a process pair OR as a single process.                  #
!#     o  if running as a process pair will always revert back to the        #
!#        correct primary and backup cpu configuration when the CPUs         #
!#        become available again after a failure.                            #
!#     o  accepts commands via $receive to reconfigure itself on the fly     #
!#                                                                           #
!#   Notes:                                                                  #
!#     Only the first byte of the filename part of the assign is used as     #
!#     the log file prefix, a yymmdd is appended to this.                    #
!#                                                                           #
!#   Starting syntax:                                                        #
!#    add define =logger_ems_collector,class map, file $0                    #
!#    param logger-data-keep 30                                              #
!#    param logger-data-security NOOO                                        #
!#    assign logger-data-file,$system.tacllog.t,code 1003, &                 #
!#                            ext (20,20),rec 132,block 4096                 #
!#    run msgloger /name $tlog,nowait,cpu <pri-cpu>/ [<backup-cpu>]          #
!#                                                                           #
!#   Changes                                                                 #
!#   =======                                                                 #
!#   MID 29Aug2001 Added checks for EMS collector being stopped. Program     #
!#                 will now close EMS collector, check on every EMS write    #
!#                 request to see if it has come back and re-open it when    #
!#                 it finally does. Also added check for an ems collector    #
!#                 name of $NONE being passed. EMS status message logging    #
!#                 will be turned off if this is used as the event collector #
!#                 process name.                                             #
!#   MID 13Sep2001 Corrected checkpoint handling for file close if no backup #
!#                 process is running (to fix error 16 prob where log open   #
!#                 was bypassed on checkoint error).                         #
!#                                                                           #
!#############################################################################
?Page "Globals"
-- Constant information at offset 0 in ALL Marks programming for
-- debugging purposes (to allow matchup with correct source files).
String Version^ID[0:28] := ["MSGLOGER:V01.01.03:2003/04/23"];

!-------------------------------------------------------------------
!                        Constants used.
!-------------------------------------------------------------------
Literal True = -1,
        False = 0,
-- Constants for completion code types.
        Fatal^Error^Code = 3,
        Warning^Error^Code = 1,
        No^Error^Code = 0;

!-------------------------------------------------------------------
!    The status and error log file name, MUST be an EMS collector
!-------------------------------------------------------------------
String EMS^File^Name[0:37]    := 38 * [0]; !MUST be word size for CHKPT
Int    EMS^File               := -2,       !Status and error file
       EMS^File^Namelen       := 0;        !needed by file_open_
String Rcv^name[0:7] := ["$RECEIVE"];

!-------------------------------------------------------------------
!                    The log file parameters
!-------------------------------------------------------------------
String Log^File^Name[0:37]    := 38 * [0];  !MUST be word size for CHKPT
Int    Log^File               := -2,        !Status and error file
       Log^File^Namelen       := 0,         !needed by file_open_
       Log^File^Code          := 1003,
       Log^File^Exts[0:1]     := [20,20],
       Log^File^Recsize       := 133,
       Log^File^Blocksize     := 4096,
       Log^File^Days^Kept     := 0,        ! leave as zero, used in checks for existence
       Log^File^Security      := 0,
       Log^File^Security^Set  := False;    ! for checking, can't check log^file^security value as 0 is legal
String Log^File^Prefix[0:1]   := ["  "];   ! leave as blank for checks for existence
                                           !MUST be 2 bytes even though we only use one
                                           !as checkpoint only works on word elements.

!-------------------------------------------------------------------
!            $RECIEVE file variables used globally.
!-------------------------------------------------------------------
Literal RCVBUFSIZE = 4096;    -- used within the program to prevent buffer overruns
Int    Rcv            := -2,
       .RcvBuffer[0:(RCVBUFSIZE/2)-1];


!-------------------------------------------------------------------
!     Error info to pass pack to the caller by stop or abend.
!-------------------------------------------------------------------
String .Error^Text[0:1023];             !Text passed back (max 127 bytes but we may store more here
                                        ! before truncating it on the write).
Int    Error^Text^Len := 0,             !true length of above to be passed back
       Completion^Code := 0;            !0=Ok, 2=Warn etc. refer to Tandem prog
                                        !reference guide for details.

!-------------------------------------------------------------------
!                         General Purpose
!-------------------------------------------------------------------
Int    Error                  := 0,     !Error variable
       .Buffer[0:559],                  !Misc I/O Buffer, Max Out Size 560 word
       I,
       Count^Read;
!                    Miscellaneous Pointers
String .S^Buffer             := @Buffer '<<' 1,
       .Ptr;

?Page "Globals - EMS"
!-------------------------------------------------------------------
!                         EMS Stuff
!-------------------------------------------------------------------
?SOURCE $SYSTEM.SYSTEM.GPLDEFS
?SOURCE $SYSTEM.ZSPIDEF.ZSPITAL
?SOURCE $SYSTEM.ZSPIDEF.ZEMSTAL

-- Informational and warning
Literal MSGLOGER^EVT^PGM^START          = 1; -- normal info at 0
Literal MSGLOGER^EVT^PGM^START^OK       = 2;
Literal MSGLOGER^EVT^PGM^END^OK         = 3;
Literal MSGLOGER^EVT^PGM^END^FAILED     = 4;
Literal MSGLOGER^EVT^FILE^CREATE^OK     = 5;
Literal MSGLOGER^EVT^FILE^PURGE^OK      = 6;
Literal MSGLOGER^EVT^USER^SHUTDOWN      = 7;
Literal MSGLOGER^EVT^COMMAND^ERROR      = 8;
Literal MSGLOGER^EVT^CONFIG^DISPLAY     = 9;
Literal MSGLOGER^EVT^COMMAND^LOGGED     = 10;
Literal MSGLOGER^EVT^CHECKPOINT^BASE    = 11;
Literal MSGLOGER^EVT^TAKEOVER^RESET     = 12;
Literal MSGLOGER^EVT^STACKCOUNT^RESET   = 13;
Literal MSGLOGER^EVT^USER^TAKEOVER      = 50; -- nonstop info at 50
Literal MSGLOGER^EVT^STARTED^BACKUP     = 51;
Literal MSGLOGER^EVT^STOPPED^BACKUP     = 52;
Literal MSGLOGER^EVT^NOT^NAMED          = 53;
Literal MSGLOGER^EVT^SINGLE^MODE        = 54;
Literal MSGLOGER^EVT^BACKUP^INFO        = 55;
Literal MSGLOGER^EVT^COLLECTOR^UP       = 56;

-- Warning messages
Literal MSGLOGER^EVT^NO^REQUIRED^DEFINE = 150; -- normal warns at 150
Literal MSGLOGER^EVT^NO^REQUIRED^PARAM  = 151;
Literal MSGLOGER^EVT^ILLEGAL^PARAM      = 152;
Literal MSGLOGER^EVT^MSG^DISCARD^ERROR  = 153;
Literal MSGLOGER^EVT^SECURE^ERROR       = 154;
Literal MSGLOGER^EVT^BACKUP^IS^PRIMARY  = 170; -- nonstop warns at 170
Literal MSGLOGER^EVT^POSSIBLE^LOOP      = 171;
Literal MSGLOGER^EVT^COLLECTOR^DOWN     = 172;

-- Fatal and critical
Literal MSGLOGER^EVT^FILE^OPEN^ERROR    = 300; -- normal errors at 300
Literal MSGLOGER^EVT^FILE^IO^ERROR      = 301;
Literal MSGLOGER^EVT^NO^REQUIRED^ASSIGN = 302;
Literal MSGLOGER^EVT^PROGRAMMER^ERROR   = 303;
Literal MSGLOGER^EVT^FILE^CREATE^ERROR  = 304;
Literal MSGLOGER^EVT^FILE^PURGE^ERROR   = 305;
Literal MSGLOGER^EVT^CHECKPOINT^FAILED  = 380; -- nonstop errors at 380
Literal MSGLOGER^EVT^SYSTEM^TAKEOVER    = 381;
Literal MSGLOGER^EVT^NO^FREE^CPUS       = 382;
Literal MSGLOGER^EVT^MAX^TAKEOVERS      = 383;
Literal MSGLOGER^EVT^BAD^BACKUPNUM      = 384;
Literal MSGLOGER^EVT^BACKUP^STARTERR    = 385;
Literal MSGLOGER^EVT^CHECKPOINT^ERROR   = 386;
Literal MSGLOGER^EVT^DEFINATE^LOOP      = 387;

Literal MSGLOGER^VAL^FALSE        = 0;
Literal MSGLOGER^VAL^TRUE         = 1;

Define ZSPI^VAL^MARKD             = "MARKD   "#;
Literal ZSPI^SSN^MSGLOGER         = 1;
Literal ZEMS^VAL^VERSION^MSGLOGER = 1;

!
! SSIDs used in generating event messages
!
LITERAL ssid^size = ($LEN( ZSPI^DDL^SSID^DEF ) + 1) / 2;

INT .our^ssid[0:ssid^size - 1] := [zspi^val^MARKD   ,
                                   zspi^SSN^MSGLOGER,
                                   zems^val^version^MSGLOGER],
    .ems^ssid[0:ssid^size-1]   := [ZSPI^VAL^TANDEM,
                                   ZSPI^SSN^ZEMS,
                                   ZEMS^VAL^VERSION];

!
! This is the buffer in which event messages are built
!
STRUCT .event^buf( zems^ddl^evt^buffer^def );
LITERAL event^buf^size = $LEN( zems^ddl^evt^buffer^def );

!
! A place to save the token value when putting it into an event message
!
STRING .evt^txt[0:201],
       .sptr;              -- a string pointer used in calculations

!
! SS or EMS PUT of values cannot be literals
!
INT true^val  := ZSPI^VAL^TRUE,
    false^val := ZSPI^VAL^FALSE;

!
! Are we logging status messages to EMS
!
INT  Status^Messages^To^EMS := False;

?Page "Globals - Non-Stop Support"
!-------------------------------------------------------------------
!                  NONSTOP Process Pair Stuff
!-------------------------------------------------------------------
LITERAL MAX_TAKEOVERS = 30;      -- max backup fails allowed, to prevent looping
INT     prefered^primary^cpu := -1,  -- where we should be if all cpus are up
                                     -- set to current cpu at initialisation if primary

        prefered^backup^cpu  := -1,  -- where backup should be if nonstop pair
                                     -- set from startup message param if present
                                     -- if left at -1 no backup process used

        current^primary^cpu  := -1,  -- where primary is currently running
                                     -- (may have switched).

        current^backup^cpu   := -1,  -- where backup is currently running

        checkpoint^status    := 0,
        takeover^count       := 0,   -- if > MAX^TAKEOVERS a backup process
                                     -- will no longer be used.
        Backup^Process^Handle[0:9],
        My^Program^NameLen   := 0,
        My^Process^NameLen;
STRING  My^program^Name[0:65],
        My^Process^Name[0:65];

Int     checkpoint^base^required   := TRUE;
Int     Check^Processes^Recomended := FALSE;
Int     stack^count                := 0;
Int     shutdown^requested         := FALSE;
Int     STACK_BASE;   -- where we checkpoint to.

-- This should NOT be checkpointed.
Int     We^Are^Monitoring^CPUs     := FALSE;

?Page "Defined Used"
!-------------------------------------------------------------------
!                         Defines used
!-------------------------------------------------------------------
Define Blank( A, B ) = A ':=' " " & A For (B - 1)#;
Define ZeroFill( A, B ) = A ':=' 0 & A For (B - 1)#;


?Source $SYSTEM.SYSTEM.EXTDECS0(
?AWAITIO,
?CANCEL,
?CHECKMONITOR,
?CHECKPOINT,
?CHECKSWITCH,
?COMPUTEJULIANDAYNO,
?DEFINEINFO,
?EMSADDTOKENS,
?EMSINIT,
?FILEINFO,
?FILE_OPEN_,
?FILE_OPEN_CHKPT_,
?FILE_CLOSE_,
?FILE_CLOSE_CHKPT_,
?FILE_CREATE_,
?FILE_GETINFOLISTBYNAME_,
?FILE_GETRECEIVEINFO_,
?FILE_PURGE_,
?FILENAME_FINDSTART_,
?FILENAME_FINDNEXT_,
?FILENAME_FINDFINISH_,
?FILENAME_TO_PROCESSHANDLE_,
?FNAMECOLLAPSE,
?FNAMEEXPAND,
?MONITORCPUS,
?NUMIN,
?NUMOUT,
?PROCESSORSTATUS,
?PROCESS_CREATE_,
?PROCESS_GETINFO_,
?PROCESS_STOP_,
?PROCESSHANDLE_DECOMPOSE_,
?READ,
?READUPDATE,
?REPLY,
?SETMODE,
?SHIFTSTRING,
?SSGETTKN,
?TIME,
?WRITE,
?WRITEREAD)

Int Proc Do^All^Initialisation;
  Forward;

Proc Process^Params;
  Forward;

PROC write^event^message( num, io^msg, io^len, emphasis );
  INT     num;             -- event number passed by user
  STRING  .io^msg;         -- msg received at end of the wait
  INT     io^len;          -- length of the msg
  INT     emphasis;        -- indicates if critical or not
  Forward;

int proc get_map_define_filename( I^define^name, O^define^value,
                                  IO^max^value^len );
  string .I^define^name, .O^define^value;
  int    .IO^max^value^len;
  Forward;

int proc check^log^files;
  Forward;

proc Message^Processing^Loop;
  Forward;

INT PROC write^log^message( msg^string:msgstring^len );
  String .msg^string;
  Int    msgstring^len;
  Forward;

PROC Clean^Up^Logfiles;
  Forward;

INT PROC Start^Backup^Process;
  Forward;

INT PROC Check^Processes;
  Forward;

PROC Stop^Backup^Process;
  Forward;

Int PROC CPU^Available( IPtr, CPU^To^Check );
  Int IPtr;
  Int CPU^To^Check;
  Forward;

Proc Handle^Checkpoint^Failure( Checkpoint^Status );
  Int Checkpoint^Status;
  Forward;

Proc Show^Configuration;
  Forward;

Proc Process^Command( CommandPtr, CmdFullLen );
  String .CommandPtr;
  Int    CmdFullLen;
  Forward;

int Proc Is^A^Collector^Process( Process^Name:Process^Namelen );
  string .Process^Name;
  int    Process^Namelen;
  Forward;


?Page "MSGLOGER^Mainline^20010530"
!############################################################################
!#                                                                          #
!#   Procedure : MSGLOGER^Mainline^20010530                                 #
!#                                                                          #
!#   NOTE: We return a completion-code and text message when we exit the    #
!#         program. These can be checked from within the TACL :_completion  #
!#         var.                                                             #
!#                                                                          #
!#   We check to see if we are the primary or the backup process.           #
!#   If we are the primary we do program initialisation.                    #
!#   If we are the backup we just call checkmonitor and let the primary     #
!#   checkpoint across to us the information we need.                       #
!#                                                                          #
!#   If we return back here from the processing loop do some cleanup and    #
!#   display any appropriate messages to the event log and in the program   #
!#   completion structure.                                                  #
!#                                                                          #
!############################################################################
Proc MSGLOGER^Mainline^20010530 MAIN;
Begin
  Int Moms^Handle[0:9] := [-1,-1,-1,-1,-1,-1,-1,-1,-1,-1],
      My^Info[0:9]     := [-1,-1,-1,-1,-1,-1,-1,-1,-1,-1];

  -- if we are the primary process...
  Call PROCESS_GETINFO_ ( My^Info,,,, Moms^Handle );

  -- If there is no mom we have no backup process
  --   *** THIS WILL NOT WORK ON A C SYSTEM ***
  If (Moms^Handle = [-1,-1,-1,-1,-1,-1,-1,-1,-1,-1]) Then Begin
     Prefered^Primary^CPU := My^Info[2];            !CPU where we are now
     Current^Primary^CPU  := My^Info[2];            !CPU where we are now
     If Do^All^Initialisation Then Begin            !If we get startup and open files
        Completion^Code := No^Error^Code;
        Call Message^Processing^Loop;
     End;
  End
  Else Begin
  -- else if we are the backup...
     Prefered^Backup^CPU := My^Info[2];             !CPU where we are now
     Current^Backup^CPU  := My^Info[2];             !CPU where we are now
     checkpoint^status := CHECKMONITOR;
     -- *** we should never fall through checkmonitor ! ***
     --     but we do get here after takeover code is executed ????
     Call PROCESS_GETINFO_ ( My^Info,,,, Moms^Handle );
     If (Moms^Handle = [-1,-1,-1,-1,-1,-1,-1,-1,-1,-1])
        Then Error^text ':=' "ERROR: PRIMARY FELL THRU CHECKMONITOR" -> @Ptr
        Else Error^text ':=' "ERROR: BACKUP FELL THRU CHECKMONITOR" -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^PGM^END^FAILED,
                               Error^Text, Error^Text^Len, True );
     Completion^Code := Fatal^Error^Code;
  End;

  !-----------------------------------------------------------------
  ! Write an event message on completion for any automation subsystems to use.
  !-----------------------------------------------------------------
  If (Completion^Code < Fatal^Error^Code) then begin
    Error^text ':=' "INFO: MSGLOGER COMPLETED WITHOUT ERRORS" -> @Ptr;
    Error^Text^Len := @Ptr '-' @Error^Text;
    Call Write^Event^Message( MSGLOGER^EVT^PGM^END^OK,
                              Error^Text, Error^Text^Len, False );
    Error^Text^Len := 0;  -- don't return text to caller if all is OK.
  end
  else begin
    Error^text ':=' "INFO: MSGLOGER FAILED WITH FATAL ERRORS, REFER TO EMS MESSAGES" -> @Ptr;
    Error^Text^Len := @Ptr '-' @Error^Text;
    Call Write^Event^Message( MSGLOGER^EVT^PGM^END^FAILED,
                              Error^Text, Error^Text^Len, False );
  end;

  !-----------------------------------------------------------------
  !       Close any files we may have open.
  !-----------------------------------------------------------------
  If (EMS^File > 0) Then Error := File_Close_( EMS^File );
  If (Log^File > 0) Then Error := File_Close_( Log^File );
  If (Rcv     > -1) Then Error := File_Close_( Rcv );

  !-----------------------------------------------------------------
  ! Return an appropriate job completion code and message text when we
  ! stop. These can both be checked by the calling TACL (allows
  ! netbatch jobs to detect/manage job recovery).
  !-----------------------------------------------------------------
  If Error^Text^Len > 80 Then Error^Text^Len := 80; -- max for stop call
  Error := Process_Stop_( !stop me!,1 !both process pairs!,0 !normal!,
                     Completion^Code,,, Error^Text:Error^Text^Len );
  If (Error <> 0) Then Begin  -- we didn't stop, abend
    Error := Process_Stop_(!stop me!,1 !both process pairs!,1 !abend!,
                       Completion^Code,,, Error^Text:Error^Text^Len );
  End;
End;  ! End of proc MSGLOGER^Mainline^20010525 MAIN

?Page "Do^All^Initialisation"
!############################################################################
!#                                                                          #
!#   Procedure : Do^All^Initialisation                                      #
!#                                                                          #
!#   This procedure performs all initialisation for the program.            #
!#                                                                          #
!#   It will read the define for =ems_collector and default to $0 if not    #
!#   present, the event collector is then openned so it may be used for     #
!#   error logging during the rest of the initialisation.                   #
!#                                                                          #
!#   The startup message is checked for a backup CPU number to see if we    #
!#   need a backup CPU. Assigns and params are read for the other stuff     #
!#   we need.                                                               #
!#                                                                          #
!#   We check we have all the startup information we need.                  #
!#   We start a backup rpcess if required.                                  #
!#   Open the log files.                                                    #
!#   and we are done.                                                       #
!#                                                                          #
!############################################################################
Int Proc Do^All^Initialisation;
Begin
  Int    In^File        := -2,
         Out^Reclen     := 0,
         EMS^Defaulted  := 0;
  String .P1, .P2;
  String define^name[0:37];

  ! Startup message structure
  STRUCT .^ci^startup = RcvBuffer;
  BEGIN
    INT msgcode;
    STRUCT default;
    BEGIN
      INT volume[0:3],
      subvol[0:3];
    END;
    STRUCT infile;
    BEGIN
      INT volume[0:3],
      subvol[0:3],
      dname [0:3];
    END;
    STRUCT outfile;
    BEGIN
      INT volume[0:3],
      subvol[0:3],
      dname [0:3];
    END;
    STRING param[0:131];
  END;

! Template of assign message sent by comint
STRUCT .^ci^assign = RcvBuffer;
  BEGIN
    INT msg^code;
    STRUCT logicalunit;
      BEGIN
        STRING prognamelen,
               progname [0:30],
               filenamelen,
               filename [0:30];
      END;
    INT(32) fieldmask;
    STRUCT tandemfilename;
      BEGIN
        INT volume [0:3],
            subvol [0:3],
            dfile  [0:3];
      END;
    INT primaryextent,
        secondaryextent,
        filecode,
        exclusionspec,
        accessspec,
        recordsize,
        blocksize;
  END;


  !-----------------------------------------------------------------
  ! open our EMS collector process first and foremost
  !-----------------------------------------------------------------
  Status^Messages^To^EMS := True;
  define^name ':=' ["=logger_ems_collector   "];
  -- EMS^File^Namelen := $LEN(EMS^File^Name);  returns 1 ????
  EMS^File^Namelen := 36;
  If NOT get_map_define_filename( define^name, EMS^File^Name,
                                  EMS^File^Namelen )
  then begin
     EMS^File^NameLen := 2;
     EMS^File^Name ':=' "$0" & 0;
     EMS^Defaulted := True;
  end
  else EMS^Defaulted := False;
  Scan EMS^File^Name Until "." -> @SPtr;
  If $CARRY
    Then @SPtr := @EMS^File^Name
    Else @SPtr := @SPtr + 1;
  If (SPtr = "$NONE") Then Status^Messages^To^EMS := False
  Else Begin
    If NOT is^A^Collector^Process( EMS^File^Name:EMS^File^NameLen )
    then begin
      Completion^Code := Fatal^Error^Code;
      Error^Text ':=' "FATAL: " & EMS^File^Name for EMS^File^Namelen &
                      " IS NOT AN EMS COLLECTOR PROCESS" -> @Ptr;
      Error^Text^Len := (@Ptr '-' @Error^Text);
      Error := Process_Stop_( !stop me!,1 !both process pairs!,1 !abend!,
                       Completion^Code,,, Error^Text:Error^Text^Len );
    end;
    Error := File_Open_( EMS^File^Name:EMS^File^NameLen, EMS^File );
    Call Fileinfo( EMS^File, Error );
    If (Error <> 0) Then Begin
      Completion^Code := Fatal^Error^Code;
      Error^Text ':=' "FATAL: UNABLE TO OPEN " &
                    EMS^File^Name for EMS^File^Namelen & ", ERROR nnn" -> @Ptr;
      Call Numout( Ptr[-3], Error, 10, 3 );
      Error^Text^Len := (@Ptr '-' @Error^Text);
      Error := Process_Stop_( !stop me!,1 !both process pairs!,1 !abend!,
                     Completion^Code,,, Error^Text:Error^Text^Len );
    End;
  End;

  !==== From this point onward we have a log file so do not call abend ====
  !==== MID 29 Aug 2001 or have $NONE and set logging off, can still proceed.

  Error^Text ':=' "INFO: PROGRAM INITIALISING" -> @Ptr;
  Error^Text^Len := @Ptr '-' @Error^Text;
  Call Write^Event^Message( MSGLOGER^EVT^PGM^START,
                            Error^Text, Error^Text^Len, False );
  Error^Text^Len := 0;

  If EMS^Defaulted then begin
     Error^Text ':=' "WARNING: NO =LOGGER_EMS_COLLECTOR DEFINE, USING $0" -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^NO^REQUIRED^DEFINE,
                               Error^Text, Error^Text^Len, False );
     Error^Text^Len := 0;
  end;

  !-----------------------------------------------------------------
  ! Open $RECEIVE and get the startup message and all assigns and
  ! params.
  ! Note: I have opened it as nowaited. The system messages are not
  !       bloody well giving an error 6 for my readupdates so rather
  !       than muck about I'll assume that after 0.5 secs inactivity
  !       I've got all the assigns and params I want.
  !-----------------------------------------------------------------
  Error := File_Open_( Rcv^Name:8, Rcv,,,1, 1 !sync 1 for readupdate!, 1 !no open close etc! );
  Call Fileinfo( Rcv, Error );
  If (Error <> 0) Then Begin
    Error^Text ':=' "FATAL: UNABLE TO OPEN $RECEIVE, ERROR nnn" -> @Ptr;
    Call Numout( Ptr[-3], Error, 10, 3 );
    Completion^Code := Fatal^Error^Code;
    Error^Text^Len := @Ptr '-' @Error^Text;
    Call Write^Event^Message( MSGLOGER^EVT^FILE^OPEN^ERROR,
                              Error^Text, Error^Text^Len, True );
    Error := Process_Stop_( !stop me!,1 !both process pairs!,0 !normal!,
                       Completion^Code,,, Error^Text:Error^Text^Len );
  End;

  !---- read open msg, assigns and params we need.
  error := 6;
  while (error = 6) do begin
     Call Readupdate( Rcv, RcvBuffer, RCVBUFSIZE, Count^Read );
     Call Awaitio( Rcv,, Count^Read,, 50D );
     If <> then begin
        Call Fileinfo( Rcv, Error );
        If (Error = 40) then begin
           Call CANCEL( Rcv );     -- Cancel readupdate
           Error := 0;             -- Exit loop
        end
        else begin
           Error^Text ':=' "FATAL: FILE ERROR nnn ON $RECEIVE" -> @Ptr;
           Call Numout( Error^Text[18], Error, 10, 3 );
           Completion^Code := Fatal^Error^Code;
           Error^Text^Len := @Ptr '-' @Error^Text;
           Call Write^Event^Message( MSGLOGER^EVT^FILE^IO^ERROR,
                                     Error^Text, Error^Text^Len, True );
           Return False;
        end;
     End
     Else Begin
        Case $ABS(RcvBuffer[0]) Of
        Begin
          1 -> Begin   ! Starup message
                  ! Check for a backup CPU
                  prefered^backup^cpu := -1;  -- default is no backup cpu
                  if (^ci^startup.param[0] <> 0) then begin
                     Call NUMIN( ^ci^startup.param, prefered^backup^cpu, 10, Error );
                     if ((error <> 0) OR (prefered^backup^cpu > 15)) then begin
                        Error^text ':=' "ERROR: BACKUP CPU NUMBER IS INVALID, IGNORED" -> @Ptr;
                        Error^Text^Len := @Ptr '-' @Error^Text;
                        Call Write^Event^Message( MSGLOGER^EVT^BAD^BACKUPNUM,
                                                  Error^Text, Error^Text^Len, True );
                        prefered^backup^cpu := -1;
                     end;
                  end;
                  Call Reply( RcvBuffer, 0,,, 70 );
                  error := 6;
               End;
          2 -> Begin                 !Assign
                  Call ShiftString(^ci^assign.Logicalunit.Filename,
                                   ^ci^assign.Logicalunit.Filenamelen, 0 );
                  if ^ci^assign.Logicalunit.Filename = "LOGGER-DATA-FILE" then
                  begin
                    Log^File^NameLen := FNAMECOLLAPSE( ^ci^assign.tandemfilename.volume,
                                                       Log^File^Name );
                    Log^File^Name[Log^File^NameLen] := 0;
                    Call ShiftString(Log^File^Name,Log^File^Namelen,0);
                    Log^File^Code      := ^ci^assign.filecode;
                    Log^File^Exts[0]   := ^ci^assign.primaryextent;
                    Log^File^Exts[1]   := ^ci^assign.secondaryextent;
                    Log^File^Recsize   := ^ci^assign.recordsize;
                    Log^File^Blocksize := ^ci^assign.blocksize;
                    -- sanity check
                    If (Log^File^Exts[0] < 4) Then Log^File^Exts[0] := 4;
                    If (Log^File^Exts[1] < 4) Then Log^File^Exts[1] := 4;
                    If (Log^File^BlockSize = 0) Then Log^File^BlockSize := 4096;
                    If ((Log^File^BlockSize <> 4096) AND
                        (Log^File^BlockSize <> 2048) AND
                        (Log^File^BlockSize <> 1024) AND
                        (Log^File^BlockSize <> 512)) Then
                    Begin
                       Log^File^BlockSize := 4096;
                    end;
                    If (Log^File^RecSize < 40) then Log^File^RecSize := 40;
                    end
                    else begin
                    ! Assume an assign left over from another job and ignore it.
                  end;
                  Call Reply( RcvBuffer, 0,,, 70 );
               End;
          3 -> Begin                 !Param
                 Call Process^Params;
                 Call Reply( RcvBuffer, 0,,, 70 );
               End;
          Otherwise -> Begin
                 Call Reply( RcvBuffer, 0,,, 70 );
               End;
        End; !Case
     End; ! If <>
  end;

  !-----------------------------------------------------------------
  ! Close $RECEIVE. We open it again later on in a different mode.
  !-----------------------------------------------------------------
  Call FILE_CLOSE_( Rcv );

  !-----------------------------------------------------------------
  ! Check we got all the assigns and params we needed.
  !-----------------------------------------------------------------
  If (Log^File^Days^Kept = 0) then begin
     Error^Text ':=' "WARNING: MISSING LOGGER-DATA-KEEP PARAM, DEFAULTING TO 30 DAYS" -> @Ptr;
        Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^NO^REQUIRED^PARAM,
                               Error^Text, Error^Text^Len, False );
     Error^Text^Len := 0;
     Log^File^Days^Kept := 30;
  End;
  If NOT Log^File^Security^Set then begin
     Error^Text ':=' "WARNING: MISSING LOGGER-DATA-SECURITY PARAM, DEFAULTING TO NOOO" -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^NO^REQUIRED^PARAM,
                               Error^Text, Error^Text^Len, False );
     Error^Text^Len := 0;
     Log^File^Security := 0;
     Log^File^Security.<4:6> := 4;       ! N
     Log^File^Security.<7:9> := 2;       ! O
     Log^File^Security.<10:12> := 2;     ! O
     Log^File^Security.<13:15> := 2;     ! O
  end;
  If (Log^File^NameLen = 0) then begin
     Completion^Code := Fatal^Error^Code;
     Error^Text ':=' "FATAL: MISSING LOGGER-DATA-FILE ASSIGN. CANNOT CONTINUE" -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^NO^REQUIRED^ASSIGN,
                               Error^Text, Error^Text^Len, True );
     Return False;
  end;
  RSCAN Log^File^Name[Log^File^Namelen-1] until "." -> @Ptr;
  Log^File^Prefix := Ptr[1];

  !-----------------------------------------------------------------
  ! If we are expected to be running as a nonstop pair nows start
  ! the backup process and checkpoint $receive before we open the
  ! disk log files (as if we are running nonstop they need the
  ! backup process).
  !-----------------------------------------------------------------
  If (prefered^backup^cpu <> -1) then    -- A backup process is expected
  BEGIN
    If NOT Start^Backup^Process Then Return FALSE;
    Takeover^Count := 0;   -- don't count as a real takeover
  END;

  !-----------------------------------------------------------------
  ! Open $RECEIVE for user input.
  ! We need to accept controls/setmodes etc as TACL sends them.
  !-----------------------------------------------------------------
  Error := File_Open_( Rcv^Name:8, Rcv,,,,, 0 !get open/close etc! );
  Call Fileinfo( Rcv, Error );
  If (Error <> 0) Then Begin
    Error^Text ':=' "FATAL: UNABLE TO OPEN $RECEIVE, ERROR nnn" -> @Ptr;
    Call Numout( Ptr[-3], Error, 10, 3 );
    Completion^Code := Fatal^Error^Code;
    Error^Text^Len := @Ptr '-' @Error^Text;
    Call Write^Event^Message( MSGLOGER^EVT^FILE^OPEN^ERROR,
                              Error^Text, Error^Text^Len, True );
    Error := Process_Stop_( !stop me!,1 !both process pairs!,0 !normal!,
                       Completion^Code,,, Error^Text:Error^Text^Len );
  End;

  !-----------------------------------------------------------------
  ! If we have a backup then lets checkpoint the open.
  !-----------------------------------------------------------------
  If (current^backup^cpu > -1) then begin
     Error := FILE_OPEN_CHKPT_( rcv, checkpoint^status );
     If (Error <> 0) then begin
        Call Handle^Checkpoint^Failure( checkpoint^status );
        Error := FILE_OPEN_CHKPT_( rcv, checkpoint^status );
        If (Error <> 0) then begin
           Error^Text ':=' "FATAL: $RECEIVE XPT ERR nnn, DETAIL nnn,nnn BACKUP DISABLED" -> @Ptr;
           Call NUMOUT( Error^Text[24], Error, 10, 3 );
           Error := checkpoint^status.<0:7>;
           Call NUMOUT( Error^Text[36], Error, 10, 3 );
           Error := checkpoint^status.<8:15>;
           Call NUMOUT( Error^Text[40], Error, 10, 3 );
           Error^Text^Len := @Ptr '-' @Error^Text;
           Call Write^Event^Message( MSGLOGER^EVT^CHECKPOINT^ERROR,
                                     Error^Text, Error^Text^Len, True );
           prefered^backup^cpu := -1;
           CALL Stop^Backup^Process;
        end;
     end;
  end;

  !-----------------------------------------------------------------
  ! Make sure we can use our log files
  !-----------------------------------------------------------------
  If NOT Check^Log^Files Then Begin
     Completion^Code := Fatal^Error^Code;
     Return False;
  End;

  !-----------------------------------------------------------------
  ! OK, all done
  !-----------------------------------------------------------------
  Error^Text ':=' "INFO: PROGRAM HAS INITIALISED" -> @Ptr;
  Error^Text^Len := @Ptr '-' @Error^Text;
  Call Write^Event^Message( MSGLOGER^EVT^PGM^START^OK,
                            Error^Text, Error^Text^Len, False );
  Error^Text ':=' "**** PROGRAM INITIALISATION COMPLETED ****" -> @Ptr;
  Call Write^Log^Message( Error^Text:(@Ptr '-' @Error^Text) );
  Error^Text^Len := 0;

  Return True;
End;  ! end of int proc Do^All^Initialisation

?Page "Procedure Process^Params"
!#############################################################################
!#                                                                           #
!#   PROCESS^PARAMS:                                                         #
!#                                                                           #
!#   Search through any param strings passed to us looking for parameter     #
!#   values we wish to use.                                                  #
!#                                                                           #
!#   What we are looking for is the number of days the disk based log files  #
!#   are to be kept, and the file security settings to be used for any log   #
!#   files we need to create.                                                #
!#                                                                           #
!#############################################################################
Proc Process^Params;
Begin
  Int i, keyoff, l^error, parmlen, valuelen, lbuffer[0:79], Local^Error;
  String .Ptr1, .Ptr2, .P, .s^lbuffer;
  String .Local^Buffer[0:254];
  Int Error^Count, Sec^Offset, Sec^Value, Sec^Value^Error;

  ! Template of param message sent by comint
  STRUCT .param = RcvBuffer;
    BEGIN
      INT msg^code,
          numparams;
      STRING parameters [0:1023];
    END;

  @Ptr1 := @Param.parameters;
  For i := 0 to (Param.Numparams - 1) do
  begin
    parmlen  := 0;
    valuelen := 0;
    parmlen.<8:15> := Ptr1;       !Get param keyword len
    @Ptr1 := @Ptr1 + 1;           !Move to param keyword
    @ptr2 := @Ptr1 + parmlen;     !Set Ptr2 to len for Value of Keyword
    valuelen.<8:15> := Ptr2;      !Get value len
    @Ptr2 := @Ptr2 + 1;           !Move to value keyword
    Call Shiftstring( Ptr1, parmlen, 0 );
    Call Shiftstring( Ptr2, valuelen, 0 );
    if Ptr1 = "LOGGER-DATA-KEEP"
    then begin
       Local^Buffer ':=' Ptr2 for $MIN( 254, valuelen ) & 0;
       Call NUMIN( Local^Buffer, Log^File^Days^Kept, 10, Local^Error );
       If (Local^Error <> 0) then begin
          Error^Text ':=' "WARNING: ILLEGAL LOGGER-DATA-KEEP PARAM (" &
                           Local^Buffer for valuelen & "), DEFAULTING TO 30 DAYS" -> @Ptr;
          Error^Text^Len := @Ptr '-' @Error^Text;
          Call Write^Event^Message( MSGLOGER^EVT^ILLEGAL^PARAM,
                                    Error^Text, Error^Text^Len, False );
          Error^Text^Len := 0;
          Log^File^Days^Kept := 30;
       end;
    end
    else if Ptr1 = "LOGGER-DATA-SECURITY"
    then begin
       Local^Buffer ':=' Ptr2 for $MIN( 254, valuelen ) & 0;
       Error^Count := 0;
       if (valuelen <> 4) then Error^Count := 1  -- not a security string
       else begin
          Log^File^Security := 0;
          Log^File^Security^Set := False;
          For Sec^Offset := 0 to 3 do begin
             Sec^Value^Error := False;
             Case Local^Buffer[sec^offset] of
             begin
                "A" -> Sec^Value := 0;
                "C" -> Sec^Value := 5;
                "G" -> Sec^Value := 1;
                "N" -> Sec^Value := 4;
                "O" -> Sec^Value := 2;
                "U" -> Sec^Value := 6;
                "-" -> Sec^Value := 7;
                Otherwise -> begin
                       Error^Count := Error^Count + 1;
                       Sec^Value^Error := True;
                             end;
             end; ! case
             If NOT Sec^Value^Error then begin
                Case Sec^Offset of
                begin
                   0 -> Log^File^Security.<4:6>   := Sec^Value;
                   1 -> Log^File^Security.<7:9>   := Sec^Value;
                   2 -> Log^File^Security.<10:12> := Sec^Value;
                   3 -> Log^File^Security.<13:15> := Sec^Value;
                   Otherwise -> !not possible in loop! ;
                end;
             end;
          end;    ! for sec^offset
       end;
       If (Error^Count > 0) then begin
          Error^Text ':=' "WARNING: ILLEGAL LOGGER-DATA-SECURITY PARAM (" &
                          Local^Buffer for valuelen & "), DEFAULTING TO NOOO" -> @Ptr;
          Error^Text^Len := @Ptr '-' @Error^Text;
          Call Write^Event^Message( MSGLOGER^EVT^ILLEGAL^PARAM,
                                    Error^Text, Error^Text^Len, False );
          Error^Text^Len := 0;
          Log^File^Security := 0;
          Log^File^Security.<4:6> := 4;       ! N
          Log^File^Security.<7:9> := 2;       ! O
          Log^File^Security.<10:12> := 2;     ! O
          Log^File^Security.<13:15> := 2;     ! O
       end;
       Log^File^Security^Set := True;
    end
    else begin
       -- a aparam we don't want, so ignore it.
    end;
    @ptr1 := @ptr2 + valuelen;
  end; !* end for *
End; ! End of process^params

!############################################################################
!#                                                                          #
!#  Procedure: Is^A^Collector^Process                                       #
!#                                                                          #
!#  Check the process name passed to see if it is an event collector        #
!#  process. Return true if it is, false if not.                            #
!#                                                                          #
!############################################################################
int Proc Is^A^Collector^Process( Process^Name:Process^Namelen );
   string .Process^Name;
   int    Process^Namelen;
Begin
   int    process^handle[0:9];
   int    Pgm^Name^Len;
   string .Pgm^Name[0:49];
   string .P2;
   string .check^dollar^0;

   ! $0 should always be running, its the system collector
   if (process^Name[0] = "\") then begin
      scan Process^Name until "." -> @check^dollar^0;
      if NOT $CARRY then begin
         if (check^dollar^0[1] = "$0")
           then Return True;
      end;
   end;

   If ((Process^Namelen = 2) AND (Process^Name = "$0"))
      then return True;

   ! Else see if its a user started EMSACOLL task
   Error := FILENAME_TO_PROCESSHANDLE_ (process^Name:Process^Namelen,
                                        process^handle );
   if (Error <> 0) then begin
      S^Buffer ':=' "ERROR nnn ON " &
                    Process^Name for Process^Namelen &
                    ", CANCELLED MSGPOST" -> @P2;
      Call NUMOUT( S^Buffer[6], Error, 10, 3 );
      Call Write^Log^Message( S^Buffer:(@P2 '-' @S^Buffer) );
      return False;
   end;

   Error := PROCESS_GETINFO_ ( process^handle,,,,,,,,,,,, Pgm^Name:50,
                               Pgm^Name^Len );
   If (Error <> 0) then begin
      S^Buffer ':=' "ERROR nnn ON PROCESS_GETINFO_, CANCELLED MSGPOST" -> @P2;
      Call NUMOUT( S^Buffer[6], Error, 10, 3 );
      Call Write^Log^Message( S^Buffer:(@P2 '-' @S^Buffer) );
      return False;
   end;

   Pgm^Name[0] := 0;
   RSCAN Pgm^Name[Pgm^Name^Len - 1] UNTIL "." -> @P2;
   If (P2 = ".EMSACOLL")
      then return True
      else return False;
End; ! end of int proc is^A^Collector^Process


?Page "Utilities Section : Write^Event^Message"
!############################################################################
!#                                                                          #
!#  Procedure : Write^Event^Message                                         #
!#                                                                          #
!#  This procedure accepts the values reformatted from user passed text     #
!#  values with the appropriate tokens in the event buffer using the EMS    #
!#  procedures. It then sends it out to the selected logging collector.     #
!#                                                                          #
!#  note: if errors occur we just return (as if we can't write an error     #
!#        message we can't report an error occurring here anyway).          #
!#                                                                          #
!#  parameters                                                              #
!#  ==========                                                              #
!#  Name                Function                                            #
!#  ------------------  --------------------------------------------------  #
!#  num                 Input                                               #
!#                      the event number to be used.                        #
!#  io^msg              Input                                               #
!#                      The message text to be written to the collector.    #
!#  io^len              Input                                               #
!#                      the length of the message text to be written.       #
!#  emphasis            Input                                               #
!#                      true of false to indicate whether the message is a  #
!#                      critical (true) alert event or a normal (false) not #
!#                      critical message.                                   #
!#                                                                          #
!############################################################################
PROC write^event^message( num, io^msg, io^len, emphasis );
  INT     num;             -- event number passed by user
  STRING  .io^msg;         -- msg received at end of the wait
  INT     io^len;          -- length of the msg
  INT     emphasis;        -- indicates if critical or not
BEGIN
  INT     spi^error := 0,  -- save last error for ABEND purposes
          size;            -- length of the buffer

  -- Use a local buffer for EMS errors/recovery to avoid
  -- overwriting the callers message if they used S^Buffer.
  INT     .Buffer2[0:99];
  STRING  .S^Buffer2;
  @S^Buffer2 := @Buffer2 '<<' 1;

  ! If we are not logging EMS messages then we are done here.
  If NOT Status^Messages^To^EMS then Return;

  ! See if we have an EMS collector (may have closed due to errors)
  If (EMS^File <= 0) then begin
     ! See if its running
     If NOT Is^A^Collector^Process( EMS^File^Name:EMS^File^Namelen )
     then begin
        ! Not a collector process or not running.
        Return;
     end;
     ! If its running open it again.
     Error := File_Open_( EMS^File^Name:EMS^File^NameLen, EMS^File );
     Call Fileinfo( EMS^File, Error );
     If (Error <> 0) Then Return;
     Error := CHECKPOINT( , EMS^File, 1 );
     S^Buffer2 ':=' "INFO: EMS MESSAGES NOW ENABLED, COLLECTOR AVAILABLE AGAIN" -> @SPtr;
     Call Numout( S^Buffer2[27], Error, 10, 3 );
     Call Write^Log^Message( S^Buffer2:(@SPtr '-' @S^Buffer2) );
  end;

  !
  ! Initialise the EMS buffer
  !
  If (spi^error :=
     EMSINIT(
        event^buf,                     -- event build buffer
        event^buf^size,                -- total buffer length (bytes)
        our^ssid,                      -- ssid of reporting subsystem
        num,                           -- the event number
        ZSPI^TKN^MESSAGE,              -- subject token code
        io^msg,                        -- event subject value
        io^len ))                      -- event subject length
     Then Return;

  !
  ! Add several tokens at once
  !
  If (spi^error :=
     EMSADDTOKENS( event^buf, !our ssid by default!,
               --  token code              value      size
                   ZEMS^TKN^EMPHASIS,      emphasis,,
                   ZEMS^TKN^CONSOLE^PRINT, FALSE^VAL ))
     Then Return;

  !
  ! We put a TEXT token into the buffer for console and printing output.
  ! If we did not include a TEXT token the message
  ! "No Printing Directions for this Event" message would be displayed
  ! on the console (or by other printing distributers).
  !
  ! I/O on <file> took <secs> seconds to complete"
  evt^txt ':=' io^msg for io^len -> @sptr;
  If ( spi^error :=
       EMSADDTOKENS( event^buf,                -- event buffer
                     ems^ssid,                 -- a foreign token needs SSID
                     ZEMS^TKN^TEXT,            -- token code
                     evt^txt,                  -- string pointer ref
                     @sptr '-' @evt^txt ))     -- text size in bytes
       Then Return;

  !
  ! This gets the size of the event that was built so we can send it
  ! to our chosen collector
  !
  If ( spi^error :=
       SSGETTKN( event^buf,                    -- event buffer
                 ZSPI^TKN^USEDLEN,             -- special SPI tpken code
                 size ))                       -- size returned here
    Then Return;

  !
  ! Writeread MUST be used to indicate an EMS message (write is text only)
  !
  call WRITEREAD( EMS^File, event^buf, size, 0 );  -- note 0 read count
  ! Check completion, see if we can recover from errors.
  Call Fileinfo( EMS^File, Error );
  If (Error <> 0) then begin
     If (Error = 66) then begin
        ! This is OK (path switch), carry on.
     end
     ! 201 ?, process gone away anyway
     ! We can't write the message, so throw it away and
     ! close the collector, we'll check for it coming back
     ! next time this procedure is called.
     else begin
        ! EMS collector has gone away.
        S^Buffer2 ':=' "ERROR: EMS COLLECTOR ERROR nnn, EMS MESSAGES DISABLED" -> @SPtr;
        Call Numout( S^Buffer2[27], Error, 10, 3 );
        Call Write^Log^Message( S^Buffer2:(@SPtr '-' @S^Buffer2) );
        Error := FILE_CLOSE_( EMS^File );
        Error := FILE_CLOSE_CHKPT_( EMS^File );
        EMS^File := -2;
        Error := CHECKPOINT( , EMS^File, 1 );
     end;
  end;
END;  ! end of procedure write^event^message

?Page "get_map_define_filename"
!############################################################################
!#                                                                          #
!#  Procedure : GET_map_define_filename                                     #
!#                                                                          #
!#  This procedure obtains the filename value from a map define and returns #
!#  the filename value and length to the caller.                            #
!#                                                                          #
!#  It returns true if the information was obtained from the define, or     #
!#  false if the define was not found or was inacessable.                   #
!#                                                                          #
!#  Notes: if errors occur obtaining the define EMS events are written to   #
!#         the event collector.                                             #
!#                                                                          #
!#                                                                          #
!#  parameters                                                              #
!#  ==========                                                              #
!#  Name                Function                                            #
!#  ------------------  --------------------------------------------------  #
!#  I^Define^Filename   Input                                               #
!#                      Identifies the define name required.                #
!#  O^define^value      output                                              #
!#                      Returns the filename value of the map component     #
!#  IO^Max^Value^len    Input/Output                                        #
!#                      On input is the max len of the callers define^value #
!#                      field. On output is the length of the data actually #
!#                      returned in the define^value length.                #
!#                                                                          #
!############################################################################
int proc get_map_define_filename( I^define^name, O^define^value,
                                  IO^max^value^len );
  string .I^define^name, .O^define^value;
  int    .IO^max^value^len;
begin

  ! Define query fields
  String .EXT define^name[0:23],
         .EXT class^name[0:15],
         .EXT attr^name[0:15],
         .EXT value^buf[0:99],
         .work^buf[0:23];    -- temp store define^name for error messages
                             -- due to 32bit pointer complaints with
                             -- using "xxx" & define^name -> @ptr...
  Int    Value^Buf^Len,
         Value^Len,
         Real^Value^Len,
         Info^Request^list[0:4],
         Info^Reply^List[0:4];

  Blank( Define^Name, 24 );
  define^name ':=' I^Define^Name for 24;  -- all defines 24 bytes space filled
  value^buf^len := 34;
  ZeroFill( value^buf, 35 );

  Error := DefineInfo( define^name, class^name, attr^name,
                       value^buf, value^buf^len, value^len );

  If (Error <> 0) Then Begin
    If (Error = 2051) Then Begin
       Completion^Code := 1;  -- WARNING CODE
       work^buf ':=' define^name for 24;
       Error^Text ':=' "WARNING: NO DEFINE FOR " & work^buf for 24 -> @Ptr;
       Error^Text^Len := (@Ptr '-' @Error^Text);
--     Cannot use the below as it can only be the ems logger define we expect
--     in this program, so we have nowhere to log to yet.
--       Call Write^Event^Message( MSGLOGER^EVT^NO^REQUIRED^DEFINE,
--                                 Error^Text, Error^Text^Len, False );
       Return False;
    End
    Else If (Error = 2052) Then Begin
       -- unable to ontain file system buffer space
      Completion^Code := 3;    -- FATAL CODE
      Error^Text ':=' "FATAL: UNABLE TO OBTAIN FILE SYSTEM BUFFER SPACE" -> @Ptr;
      Error^Text^Len := (@Ptr '-' @Error^Text);
      Error := Process_Stop_( !stop me!,1 !both process pairs!,1 !abend!,
                       Completion^Code,,, Error^Text:Error^Text^Len );
    End
    Else Begin
       -- programmer error
      Completion^Code := 3;  -- FATAL ERROR CODE
      Error^Text ':=' "FATAL: INTERNAL PROGRAMMING ERROR:DEFINEINFO" -> @Ptr;
      Error^Text^Len := (@Ptr '-' @Error^Text);
      Error := Process_Stop_( !stop me!,1 !both process pairs!,1 !abend!,
                       Completion^Code,,, Error^Text:Error^Text^Len );
    End;
  End
  -- else define was found
  Else Begin
    If (class^name <> "MAP") Then Begin
      Completion^Code := 3;  -- FATAL CODE
      work^buf ':=' define^name for 24;
      Error^Text ':=' "FATAL: NOT A MAP CLASS DEFINE:" & work^buf for 24 -> @Ptr;
      Error^Text^Len := (@Ptr '-' @Error^Text);
      Error := Process_Stop_( !stop me!,1 !both process pairs!,1 !abend!,
                       Completion^Code,,, Error^Text:Error^Text^Len );
    End;
    -- if OK use the values provided by the caller
    -- The values returned are null terminated.
    O^define^value ':=' value^buf for $MIN(value^len,IO^max^value^len) & 0;
    scan O^define^value Until 0 -> @Ptr;
    IO^max^value^len := @Ptr '-' @O^define^value;
  End;
  Return True;
End;  ! int proc get_map_define_filename

?Page "check^log^files"
!############################################################################
!#                                                                          #
!#  Procedure : check^log^files                                             #
!#                                                                          #
!#  Close any open log file, then attempt to open a logfile for the         #
!#  current days date. If the log file does not exist (error 11 on open)    #
!#  then we create it at that time. This is more efficient than checking    #
!#  to see if the file exists on disk first as the create will still only   #
!#  be required once a day and eliminates a disk check every time we come   #
!#  through this procedure,                                                 #
!#                                                                          #
!#  NEVER CALL WRITE^LOG^MESSAGE from this procedure, as write^log^message  #
!#  will call us if the file is closed or has an i-o error so there would   #
!#  be a possibility of a stack overflow.                                   #
!#                                                                          #
!############################################################################
int proc check^log^files;
begin
   Int    Time^Now[0:6], I, New^File^Created;
   String File^Date^Part[0:5];

   New^File^Created := False;

  !-----------------------------------------------------------------
  ! Get todays date
  !-----------------------------------------------------------------
   Call TIME(Time^Now);
   Call NUMOUT( File^Date^Part[0], (Time^Now[0] - 2000), 10, 2 );
   Call NUMOUT( File^Date^Part[2], Time^Now[1], 10, 2 );
   Call NUMOUT( File^Date^Part[4], Time^Now[2], 10, 2 );
   For I := 0 To 5 Do Begin
      If File^Date^Part[I] = " " Then File^Date^Part[I] ':=' "0";
   End;

  !-----------------------------------------------------------------
  ! build the new log file name
  !-----------------------------------------------------------------
   RSCAN Log^File^Name[Log^File^NameLen-1] UNTIL "." -> @Ptr;
   If $CARRY Then Begin
      Completion^Code := Fatal^Error^Code;
      Error^Text ':=' "FATAL: UNABLE TO WORK OUT NEW LOG FILE NAME" -> @Ptr;
      Error^Text^Len := (@Ptr '-' @Error^Text);
      Call Write^Event^Message( MSGLOGER^EVT^PROGRAMMER^ERROR,
                                Error^Text, Error^Text^Len, True );
      Return False;
   End;
   @Ptr := @Ptr '+' 1;  -- move past the dot.
   Ptr ':=' Log^File^Prefix for 1 & File^Date^Part for 6 -> @Ptr;
   Log^File^NameLen := @Ptr '-' @Log^File^Name;
   Log^File^Name[Log^File^nameLen] := 0;  ! null terminate

  !-----------------------------------------------------------------
  ! Close Current Log File if it is open
  !-----------------------------------------------------------------
   If (Log^File > 0) then begin
      Call FILE_CLOSE_( Log^File );
      If (current^backup^cpu >= 0)       -- A backup process is running
         then Error := FILE_CLOSE_CHKPT_( Log^File );
      Log^File := -2;
      If (current^backup^cpu >= 0)       -- A backup process is running
         then checkpoint^status := CHECKPOINT( , Log^File, 1 );
   end;

  !-----------------------------------------------------------------
  ! Open the log file for todays date now
  !-----------------------------------------------------------------
  Error := File_Open_( Log^File^Name:Log^File^NameLen, Log^File );
  Call Fileinfo( Log^File, Error );
  If (Error = 11) then begin
     ! Create the file if it does not already exist
     Error := FILE_CREATE_( Log^File^Name:Log^File^NameLen,
                            Log^File^NameLen,
                            Log^File^Code,
                            Log^File^Exts[0],
                            Log^File^Exts[1],
                            16,   ! maxextents 16
                            2,    ! entry sequenced
                            ,
                            Log^File^Recsize,
                            Log^File^Blocksize );
     If (Error <> 0) then begin
        Completion^Code := Fatal^Error^Code;
        Error^Text ':=' "FATAL: UNABLE TO CREATE " &
                        Log^File^Name for Log^File^Namelen & ", ERROR nnn" -> @Ptr;
        Call Numout( Ptr[-3], Error, 10, 3 );
        Error^Text^Len := (@Ptr '-' @Error^Text);
        Call Write^Event^Message( MSGLOGER^EVT^FILE^CREATE^ERROR,
                                  Error^Text, Error^Text^Len, True );
        Return False;
     end;
     Error^Text ':=' "INFO: CREATED " & Log^File^Name for Log^File^Namelen -> @Ptr;
     Error^Text^Len := (@Ptr '-' @Error^Text);
     Call Write^Event^Message( MSGLOGER^EVT^FILE^CREATE^OK,
                               Error^Text, Error^Text^Len, False );
     New^File^Created := True;
     Error^Text^Len := 0;
     ! and retry the open on the file just created
     Error := File_Open_( Log^File^Name:Log^File^NameLen, Log^File );
     Call Fileinfo( Log^File, Error );
  End;
  If (Error <> 0) Then Begin
    Completion^Code := Fatal^Error^Code;
    Error^Text ':=' "FATAL: UNABLE TO OPEN " &
                    Log^File^Name for Log^File^Namelen & ", ERROR nnn" -> @Ptr;
    Call Numout( Ptr[-3], Error, 10, 3 );
    Error^Text^Len := (@Ptr '-' @Error^Text);
    Call Write^Event^Message( MSGLOGER^EVT^FILE^OPEN^ERROR,
                              Error^Text, Error^Text^Len, True );
    Return False;
  End;


  If New^File^Created then begin
     Call Setmode( Log^File, 1, Log^File^Security );
     If <> then begin           -- an error, check for it
        Call Fileinfo( Log^File, Error );
        Error^Text ':=' "WARNING: UNABLE TO RESECURE " &
                        Log^File^Name for Log^File^Namelen & ", ERROR nnn" -> @Ptr;
        Call Numout( Ptr[-3], Error, 10, 3 );
        Error^Text^Len := (@Ptr '-' @Error^Text);
        Call Write^Event^Message( MSGLOGER^EVT^SECURE^ERROR,
                                  Error^Text, Error^Text^Len, False );
        -- do NOT return, this is not a fatal error, we can continue on.
        Error^Text^Len := 0;
     end;
  end;

  !-----------------------------------------------------------------
  ! Checkpoint any new logfile we have opened.
  !-----------------------------------------------------------------
  If (current^backup^cpu >= 0) then begin
     checkpoint^status := CHECKPOINT( , Log^File, 1 );   -- the new file handle
     If (Error <> 0) then begin   -- just bounce the backup
        CALL Stop^Backup^Process;
        If NOT Start^Backup^Process then begin end; -- running without backup, thats ok
     end;
     ! recheck if backup is running, we may have stopped it above
     If (current^backup^cpu >= 0) then begin
        Error := FILE_OPEN_CHKPT_( Log^File, checkpoint^status );
        If (Error <> 0) then begin   -- just bounce the backup
           CALL Stop^Backup^Process;
           -- running without a backup
        end;
     end;
  end;

  !-----------------------------------------------------------------
  ! Clean up any old log files lying around.
  !-----------------------------------------------------------------
  Call Clean^Up^Logfiles;

  !-----------------------------------------------------------------
  ! Done
  !-----------------------------------------------------------------
   Return True;
end; ! check^log^files

?Page "Message^Processing^Loop"
!############################################################################
!#                                                                          #
!#  Procedure : Message^Processing^Loop                                     #
!#                                                                          #
!#  This procedure loops reading messages from $RECEIVE and writing them    #
!#  to the log file.                                                        #
!#  If what is deemed to be a command is received then the command handler  #
!#  will be called rather than the message being logged.                    #
!#                                                                          #
!#  NOTE: That this procedure does the checkpoint of the stack-base. This   #
!#        ensured that in a takeover situation this procedure takes         #
!#        control at the stack-base checkpoint state to see what action     #
!#        is required to recover.                                           #
!#        The flag checkpoint^base required will be set whenever a new      #
!#        backup process has been craeted in order to force a new           #
!#        stack-base checkpoint so we can recover from later changes.       #
!#        The flag check^processes^recomended is used after we have had to  #
!#        start a new backup or during a takeover, it is used to indicate   #
!#        our processes should be checked/relocated/switched if necessary.  #
!#                                                                          #
!############################################################################
proc Message^Processing^Loop;
begin
  Int Error;     -- use a local Error rather than the global as we need to know that
                 -- any error set here is from a $receive read and not from any other
                 -- prcuedure that may use the global one.
  String .MsgPtr, .TextEnd;
  String .Formatted^Msg[0:(RCVBUFSIZE-1)+50]; -- allow 50 bytes for user/terminal/pid
  Int    .RcvInfo^Data[0:16], Count^Read;
  String .Senders^Termid[0:29];
  Int    Senders^TermidLen, Process^Access^Id;
  String .sender^nodename[0:7],
         .sender^processname[0:7];
  Int    sender^nodenamelen,
         sender^processnamelen;
  Int    sender^gid, sender^uid, sender^cpu, sender^pin;
  String sender^gid^s[0:2], sender^uid^s[0:2];
  Int    Formatted^Len;
  String .testptr;

  !-----------------------------------------------------------------
  ! Checkpoint our stack here. This is where we wish any takeover to
  ! occur ir required.
  !-----------------------------------------------------------------
  stack^count := 0;
STACK_SET:
  stack^count := stack^count + 1;
  if (current^backup^cpu > -1)
     then checkpoint^status := CHECKPOINT( , stack^count, 1 );
  if (stack^count > 50) then begin
     If (stack^count > 100) then begin
        Error^Text ':=' "STACK CHECKPOINT EXCEEDS 100, DEFINATE LOOP, ENDING" -> @Ptr;
        Error^Text^Len := @Ptr '-' @Error^Text;
        Write^log^Message( Error^Text:Error^Text^Len );
        Call Write^Event^Message( MSGLOGER^EVT^DEFINATE^LOOP,
                                  Error^Text, Error^Text^Len, True );
        Completion^Code := Fatal^Error^Code;
        Return;
     end
     else begin
        Error^Text ':=' "STACK CHECKPOINT EXCEEDS 50, POSSIBLE LOOP, CONTINUING" -> @Ptr;
        Error^Text^Len := @Ptr '-' @Error^Text;
        Write^log^Message( Error^Text:Error^Text^Len );
        Call Write^Event^Message( MSGLOGER^EVT^POSSIBLE^LOOP,
                                  Error^Text, Error^Text^Len, True );
     end;
  end;
  if (current^backup^cpu > -1) then begin
     Checkpoint^Base^Required := FALSE;
     Error^Text ':=' "INFO: STATE CHANGE - CHECKPOINTING STACK BASE" -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^CHECKPOINT^BASE,
                               Error^Text, Error^Text^Len, False );
     checkpoint^status := CHECKPOINT( STACK_BASE );
     if (checkpoint^status.<0:7> <> 0) Then Begin
        Call Handle^Checkpoint^Failure( Checkpoint^Status );
     End;
  End;  ! If current^backup^cpu > 0

  checkpoint^status := 0;  -- MUST RESET THIS HERE

  !-----------------------------------------------------------------
  !  Only the primary process would normally be monitoring CPUs.
  !  (Note: if we do a checkswitch within the code we disable it
  !   for the soon to be backup so it should always only be the
  !   primary doing this).
  !  We will check to see if we are doing so, and if not we will
  !  ask for the CPU up/down messages.
  !-----------------------------------------------------------------
  If (prefered^backup^cpu > -1) then begin  ! Only relevant if running
                                            ! as a nonstop process pair.
     If NOT We^Are^Monitoring^CPUs then begin
        Call MONITORCPUS( %B1111111111111111 );
        We^Are^Monitoring^CPUs := True;
     end;
  end;

  !-----------------------------------------------------------------
  ! Restart point if we are the backup process.
  !-----------------------------------------------------------------
  @MsgPtr := @RCVBuffer '<<' 1;

  !-----------------------------------------------------------------
  ! While there is no $RECEIEVE read error keep reading $receive
  ! and writing the data read to the log file.
  ! Note: any data read from $receive starting with integers -1,-1
  !       will be treated as a command rather than data. This is
  !       really for future use.
  !-----------------------------------------------------------------
  Error := 0;
  While (Error = 0) Do Begin
     -- check this first in case we are switching processes around
     if checkpoint^base^required then begin
        checkpoint^base^required := FALSE;
        GOTO STACK_SET;
     end;
     -- see if there are any checkpoint errors to look into.
     if (checkpoint^status <> 0)  -- Something went wrong with a checkpoint
                                  -- somewhere, sanity check everything.
     then begin
        if (current^backup^cpu > -1)
           then Call Handle^Checkpoint^Failure( checkpoint^status );
     end;
     -- are we required to check what CPUs we are running in ?
     If Check^Processes^Recomended Then Call Check^Processes;

     Count^Read := 0;
     Call READ( Rcv, RcvBuffer, RCVBUFSIZE, Count^Read );
     Call Fileinfo( Rcv, Error );
     if (current^backup^cpu > -1)
        then checkpoint^status := CHECKPOINT( , RcvBuffer, $INT((Count^Read / 2) + 1) );
     If ( (Error = 6) OR            -- system messages
          (RcvBuffer[0] < 0) ) then begin
        If ((RCVBuffer[0] = -5) or (RCVBuffer[0] = -6)) then begin
           -- oops, our backup process has stopped
           If Start^Backup^Process then GOTO STACK_SET;
        end
        -- cpu down system message
        else if (RcvBuffer[0] = -2) then begin
           ! don't care, our next checkpoint request will detect
           ! a problem and start a new backup process.
        end
        -- and we want the cpu up as well, so we can switch our process
        -- pairs about if required.
        else if (RcvBuffer[0] = -3) then begin
           If ( (RcvBuffer[1] = prefered^primary^cpu) OR
                (RcvBuffer[1] = prefered^backup^cpu)
              )
           then begin
              Call Check^Processes;
           end;
        end;
        Error := 0;
     end

     -- can get  a lot of blank lines if logging tacl stuff so
     -- check for data as well as no errors.
     Else If ((Error = 0) AND (Count^Read > 0)) then begin
        If (MsgPtr = "MSGLOGGER-COMMAND ") then begin    -- a command
           Call Process^Command( MsgPtr, Count^Read );
           If shutdown^requested then return;  -- exit out cleanly
        end
        else begin
              -- format the message as <user> <node> <pid> <terminal> <text>
              -- GET THE SENDER PROCESS INFO (TERMINAL/USERID/PROCESSNAME)
              Blank( Senders^Termid, 24 );
              Blank( sender^nodename, 8 );
              Blank( sender^processname, 8 );
              Call FILE_GETRECEIVEINFO_( RcvInfo^Data );
              Error := PROCESS_GETINFO_( RcvInfo^Data[6],,,,,
                                         Senders^Termid:30, Senders^TermidLen,,,
                                         Process^Access^Id );
              -- Check hometerm, if $ZBAT don't want to log line
              scan Senders^Termid until "." -> @testptr;
              if NOT $CARRY then begin
                @testptr := @testptr + 1;
              end
              else begin
                @testptr := @Senders^Termid;
              end;
              If (testptr <> "$ZBAT") then begin
                  sender^gid := Process^Access^Id.<0:7>;
                  sender^uid := Process^Access^Id.<8:15>;
                  call NUMOUT( sender^gid^s, sender^gid, 10, 3 );
                  call NUMOUT( sender^uid^s, sender^uid, 10, 3 );
                  Error := PROCESSHANDLE_DECOMPOSE_( RcvInfo^Data[6],,,,
                                                    sender^nodename:8,sender^nodenamelen,
                                                    sender^processname:8,sender^processnamelen );
                  -- if it's an unnamed process get the cpu and pin.
                  if (sender^processnamelen = 0) then begin
                     Error := PROCESSHANDLE_DECOMPOSE_( RcvInfo^Data[6], sender^cpu, sender^pin );
                     Call NUMOUT( sender^processname, sender^cpu, 10, 3 );
                     sender^processname[3] := ",";
                     Call NUMOUT( sender^processname[4], sender^pin, 10, 3 );
                     sender^processnamelen := 7;
                  end;
                  -- use thefull field length rather than the returned data length to keep
                  -- a fixed output format.
    --            Formatted^Msg ':=' sender^gid^S for 3 & "," &  sender^uid^S for 3 & " " &
    --                               sender^nodename for 5 & " " &
    --                               sender^processname for 8 & " " &
    --                               senders^termid for 24 & " " &
    --                               MsgPtr for Count^Read -> @TextEnd;
                  Formatted^Msg ':=' sender^processname for 5 & " " &
                                     sender^gid^S for 3 & "," &  sender^uid^S for 3 & " " &
                                     MsgPtr for Count^Read -> @TextEnd;
                  Formatted^Len := @TextEnd '-' @Formatted^Msg;
                  Call Write^log^Message( Formatted^Msg:Formatted^Len );
              End; -- If not hometerm = $ZBAT
        end;
     end
     else if (error <> 0) then begin
        Error^Text ':=' "FATAL: FILE ERROR nnn ON $RECEIVE" -> @Ptr;
        Call Numout( Error^Text[18], Error, 10, 3 );
        Completion^Code := Fatal^Error^Code;
        Error^Text^Len := @Ptr '-' @Error^Text;
        Call Write^Event^Message( MSGLOGER^EVT^FILE^IO^ERROR,
                                  Error^Text, Error^Text^Len, True );
        Call Write^Log^Message( Error^Text:Error^Text^Len );
        Return;
     end;
  End;
end; ! message^processing^loop


?Page "Utilities Section : Write^Log^Message"
!############################################################################
!#                                                                          #
!#  Procedure : Write^Log^Message                                           #
!#                                                                          #
!#  Build a current timestamp string and write this along with the          #
!#  message string we are passed to the disk log file.                      #
!#                                                                          #
!#  parameters                                                              #
!#  ==========                                                              #
!#  Name                Function                                            #
!#  ------------------  --------------------------------------------------  #
!#  msg^string          Input                                               #
!#                      The text string to be writen to the log.            #
!#  msgstring^len       Input                                               #
!#                      The length of the text string to write.             #
!#                                                                          #
!############################################################################
INT PROC write^log^message( msg^string:msgstring^len );
  STRING  .msg^string;         -- msg received at end of the wait
  INT     msgstring^len;       -- length of the msg
BEGIN
  INT Time^Now[0:6], I;
  INT .Local^Buffer[0:128];     -- max of 255 (256) bytes, use 255
  String .Local^Buffer^S, .Local^Buffer^End;
  String .Date^Check^String[0:5];

  @Local^Buffer^S := @Local^Buffer '<<' 1;

  !-----------------------------------------------------------------
  ! Make sure there is a log file we can use before proceeding.
  !-----------------------------------------------------------------
  !-----------------------------------------------------------------
  ! Add as much of the message provided to the message buffer.
  !-----------------------------------------------------------------
  Local^Buffer^S ':=' "yy/mm/dd hh:mm:ss " &
              msg^string for $MIN(msgstring^len, 237 ) -> @Local^Buffer^End;

  !-----------------------------------------------------------------
  ! Format the current date and tme into the start of the message
  ! buffer we intent to write out.
  !-----------------------------------------------------------------
  Call TIME(Time^Now);
  Call NUMOUT( Local^Buffer^S[0], (Time^Now[0] - 2000), 10, 2 );
  Call NUMOUT( Local^Buffer^S[3], Time^Now[1], 10, 2 );
  Call NUMOUT( Local^Buffer^S[6], Time^Now[2], 10, 2 );
  Call NUMOUT( Local^Buffer^S[9], Time^Now[3], 10, 2 );
  Call NUMOUT( Local^Buffer^S[12], Time^Now[4], 10, 2 );
  Call NUMOUT( Local^Buffer^S[15], Time^Now[5], 10, 2 );
  For I := 0 To 7 Do Begin
     If Local^Buffer^S[I] = " " Then Local^Buffer^S[I] ':=' "0";
  End;
  For I := 9 To 16 Do Begin
     If Local^Buffer^S[I] = " " Then Local^Buffer^S[I] ':=' "0";
  End;

  !-----------------------------------------------------------------
  ! Check to see if we need to swap log files over.
  !-----------------------------------------------------------------
  Date^Check^String ':=' Local^Buffer^S[0] for 2 &
                         Local^Buffer^S[3] for 2 &
                         Local^Buffer^S[6] for 2;
  RSCAN Log^File^Name[Log^File^NameLen - 1] until "." -> @Ptr;
  If ((Ptr[2] <> Date^Check^String for 6) OR (Log^File < 1)) then begin
     If NOT check^log^files then begin
        -- write a partial message to the EMS log to warn of problems here.
        Error^Text ':=' "WARNING: MESSAGE DISCARDED " & msg^string for $MIN(40,msgstring^len) -> @Ptr;
        Error^Text^Len := @Ptr '-' @Error^Text;
        Call Write^Event^Message( MSGLOGER^EVT^MSG^DISCARD^ERROR,
                                  Error^Text, Error^Text^Len, True );
        -- and don't attempt any more
        Error^Text^Len := 0;
        return False;
     end;
  end;

  !-----------------------------------------------------------------
  ! Write the message out. If the write fails write an ems alert
  ! message and try to reset the log file by opening and closing
  ! it again (check^log^files).
  !-----------------------------------------------------------------
  Call WRITE( Log^File, Local^Buffer, $MIN( (@Local^Buffer^End '-' @Local^Buffer^S), Log^File^Recsize ) );
  Call Fileinfo( Log^File, Error );
  If (Error <> 0) then begin
     Error^Text ':=' "CRITICAL: FILE ERROR nnn ON " & Log^File^Name for Log^File^NameLen & "(FNUM nnn)" -> @Ptr;
     Call Numout( Error^Text[21], Error, 10, 3 );
     Call Numout( Ptr[-4], Log^File, 10, 3 );
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^FILE^IO^ERROR,
                               Error^Text, Error^Text^Len, True );
     Return Check^Log^Files;
  End
  Else Return True;
END; ! write^log^message

?Page "Utilities Section : Clean^Up^Log^Files"
!############################################################################
!#                                                                          #
!#  Procedure : Clean^Up^Logfiles                                           #
!#                                                                          #
!#  Search all the files in out disk subvolume matching out logfile name    #
!#  and delete any which are over the number of days retention we wish      #
!#  to keep.                                                                #
!#                                                                          #
!############################################################################
PROC Clean^Up^Logfiles;
BEGIN
  Int     Searchid;
  String  .SearchPattern[0:65];
  Int     SearchPatternLen;
  String  .FoundName[0:127];
  Int     FoundNameLen;
  Int     Century, Time^Now[0:6];
  String  Date^Part^S[0:5];
  Int     Date^Part^N;
  Int(32) JulianDay^Now, JulianDay^Delete^Before, JulianDay^In^File;
  Int     Y^file, M^file, D^file;  ! years, months, days in file timestamp
  Int     Num^Error, Purge^Error;
  String  Work^S[0:5];
  String  .Subvol^Name[0:65];
  Int     Subvol^NameLen;
  String  .PurgeName[0:127];

  !-----------------------------------------------------------------
  ! find the last date we can keep
  !-----------------------------------------------------------------
  Call TIME(Time^Now);
  Century := (Time^Now[0] / 100) * 100;   ! kill of the year part
  JulianDay^Now := COMPUTEJULIANDAYNO( Time^Now[0], Time^Now[1], Time^Now[2], Error );
  JulianDay^Delete^Before := $DBL(JulianDay^Now - $DBL(Log^File^Days^Kept));
  If ((Error <> 0) OR (JulianDay^Delete^Before < 730365D !aprox year 2001!)) then begin
     -- something horribly wrong.
     Error^Text ':=' "CRITICAL: UNABLE TO CALCULATE JULIANDATE, NO LOGS PURGED" -> @Ptr;
     Error^Text^Len := (@Ptr '-' @Error^Text);
     Call Write^Event^Message( MSGLOGER^EVT^PROGRAMMER^ERROR,
                               Error^Text, Error^Text^Len, True );
     Call Write^Log^Message( Error^Text:Error^Text^Len );
     Error^Text^Len := 0;
     return;
  end;

  !-----------------------------------------------------------------
  ! Build the search pattern based on the logfile currently in use...
  ! ie: $system.tacllog.t010413 will become pattern $system.tacllog.t*
  !-----------------------------------------------------------------
  RSCAN Log^File^Name[Log^File^NameLen-1] UNTIL "." -> @Ptr;
     ! neet to keep the subvol name
  Subvol^NameLen := $MIN(66, (@Ptr '-' @Log^File^Name));
  SubVol^Name ':=' Log^File^Name for Subvol^NameLen;
     ! ptr still set, setup the mask.
  SearchPattern ':=' Log^File^Name for $MIN(64, (@Ptr '-' @Log^File^Name)) &
                     "." & Log^File^Prefix for 1 & "*" -> @Ptr;
  SearchPatternLen := @Ptr '-' @SearchPattern;
  !-----------------------------------------------------------------
  ! Loop while files are able to be found matching the pattern we
  ! are searching for.
  !-----------------------------------------------------------------
  Error := FILENAME_FINDSTART_( Searchid, SearchPattern:SearchPatternLen, 2, -1, -1, 1 !, startname not used! );
  If Not Error
     then Error := FILENAME_FINDNEXT_( Searchid, foundname:128, foundnamelen );
  while not error do
  begin
     -- first ensure its a file in the form <prefix>yymmdd
     Date^Part^S ':=' FoundName[FoundNameLen-6] for 6;
     Call NUMIN( Date^Part^S, Date^Part^N, 10, Num^Error );
     If ((NOT Num^Error) and (Date^Part^N > 10000)) then begin  -- its a number and big enough for a date
        Y^file := $INT(Date^Part^N / 10000);
        Date^Part^N := Date^Part^N - (Y^file * 10000);
        M^File := $INT(Date^Part^N / 100);
        Date^Part^N := Date^Part^N - (M^file * 100);
        D^file := $INT(Date^Part^N);
        Y^File := Y^File + Century;    -- oops, must do this after calculations
        JulianDay^In^File := COMPUTEJULIANDAYNO( Y^file, M^file, D^file, Num^Error );
        If NOT Num^Error then begin  -- we got a legal date from the file, lets check it
           !-------------------------------------------------------
           ! If the filename date was beyond our retention period
           ! lets try to purge the file.
           !-------------------------------------------------------
           If (JulianDay^In^File < JulianDay^Delete^Before) then begin
              PurgeName ':=' Subvol^Name for Subvol^NameLen & "." & FoundName for FoundNameLen -> @Ptr;
              Purge^Error := FILE_PURGE_( PurgeName:(@Ptr '-' @PurgeName) );
              If (Purge^Error = 0) then
              begin
                 Error^Text ':=' "INFO: AUTOMATICALLY PURGED " & FoundName for FoundNameLen -> @Ptr;
                 Error^Text^Len := (@Ptr '-' @Error^Text);
                 Call Write^Event^Message( MSGLOGER^EVT^FILE^PURGE^OK, Error^Text, Error^Text^Len, False );
                 Call Write^Log^Message( Error^Text:Error^Text^Len );
              end
              else begin
                 Error^Text ':=' "CRITICAL: PURGE ERROR nnn ON " & FoundName for FoundNameLen -> @Ptr;
                 Error^Text^Len := (@Ptr '-' @Error^Text);
                 Call Numout( Error^Text[22], Purge^Error, 10, 3 );
                 Call Write^Event^Message( MSGLOGER^EVT^FILE^PURGE^ERROR, Error^Text, Error^Text^Len, True );
                 Call Write^Log^Message( Error^Text:Error^Text^Len );
              end;
           end;
        end;
     end;
     -- repeat the search to find the next matching file.
     Error := FILENAME_FINDNEXT_( Searchid, foundname:128, foundnamelen );
  end;

  !-----------------------------------------------------------------
  ! We must call this to clean up memory buffers that were allocated.
  !-----------------------------------------------------------------
  Error := FILENAME_FINDFINISH_( Searchid );
END; ! Clean^Up^Logfiles

?Page "Show^Configuration"
!############################################################################
!#                                                                          #
!#  Procedure : Show^Configuration                                          #
!#                                                                          #
!#  Write out our current configuration setting to the event collector and  #
!#  the program log file.                                                   #
!#                                                                          #
!############################################################################
Proc Show^Configuration;
Begin
   String .Msg^Text[0:511],
          .Msg^Ptr;
   Int    Msg^Text^Len := 0;

   -- Show the following information
   --    program name           program version
   --    ems collector being used
   --    log file prefix        current log file
   --    prefered primary cpu   current primary cpu
   --    prefered backup cpu    current backup cpu
   --    cpu takeover counters

   -- program name           program version
   Msg^Text ':=' "INFO: PROGRAM FILE " &
                 My^Program^Name for my^Program^NameLen &
                 ", VERSION " & Version^Id for 29 -> @Msg^Ptr;
   Msg^Text^len := (@Msg^Ptr '-' @Msg^Text);
   Call Write^Event^Message( MSGLOGER^EVT^CONFIG^DISPLAY,
                             Msg^Text, Msg^Text^Len, False );
   Call Write^Log^Message( Msg^Text:Msg^Text^Len );

   --    ems collector being used
   Msg^Text ':=' "INFO: EMS COLLECTOR BEING USED " &
                 EMS^File^Name for EMS^File^NameLen -> @Msg^Ptr;
   Msg^Text^len := (@Msg^Ptr '-' @Msg^Text);
   Call Write^Event^Message( MSGLOGER^EVT^CONFIG^DISPLAY,
                             Msg^Text, Msg^Text^Len, False );
   Call Write^Log^Message( Msg^Text:Msg^Text^Len );

   --    log file prefix        current log file
   Msg^Text ':=' "INFO: LOG FILE PREFIX IS '" &
                 Log^File^Prefix for 1 & "', CURRENT LOG FILE " -> @Msg^Ptr;
   If (Log^File > 0)
      then Msg^Ptr ':=' Log^File^Name for Log^File^Namelen -> @Msg^Ptr
      else Msg^Ptr ':=' "*** NOT OPEN ***" -> @Msg^Ptr;
   Msg^Text^len := (@Msg^Ptr '-' @Msg^Text);
   Call Write^Event^Message( MSGLOGER^EVT^CONFIG^DISPLAY,
                             Msg^Text, Msg^Text^Len, False );
   Call Write^Log^Message( Msg^Text:Msg^Text^Len );

   --    prefered primary cpu   current primary cpu
   Msg^Text ':=' "INFO: PREFERED PRIMARY CPU IS nnn, CURRENT PRIMARY CPU IS nnn" -> @Msg^Ptr;
   Call NUMOUT( Msg^Text[30], prefered^primary^cpu, 10, 3 );
   Call NUMOUT( Msg^Ptr[-3], current^primary^cpu, 10, 3 );
   Msg^Text^len := (@Msg^Ptr '-' @Msg^Text);
   Call Write^Event^Message( MSGLOGER^EVT^CONFIG^DISPLAY,
                             Msg^Text, Msg^Text^Len, False );
   Call Write^Log^Message( Msg^Text:Msg^Text^Len );

   --    prefered backup cpu    current backup cpu
   Msg^Text ':=' "INFO: PREFERED BACKUP  CPU IS nnn, CURRENT BACKUP  CPU IS nnn" -> @Msg^Ptr;
   If (prefered^backup^cpu = -1)
      then Msg^Text[30] ':=' "OFF"
      else Call NUMOUT( Msg^Text[30], prefered^backup^cpu, 10, 3 );
   If (current^backup^cpu = -1)
      then Msg^Ptr[-3] ':=' "N/A"
      else Call NUMOUT( Msg^Ptr[-3], current^backup^cpu, 10, 3 );
   Msg^Text^len := (@Msg^Ptr '-' @Msg^Text);
   Call Write^Event^Message( MSGLOGER^EVT^CONFIG^DISPLAY,
                             Msg^Text, Msg^Text^Len, False );
   Call Write^Log^Message( Msg^Text:Msg^Text^Len );

   --    cpu takeover counters
   Msg^Text ':=' "INFO: CURRENT TAKEOVER COUNT nnn, BACKUP DISABLED IF nnn" -> @Msg^Ptr;
   Call NUMOUT( Msg^Text[29], Takeover^Count, 10, 3 );
   Call NUMOUT( Msg^Ptr[-3], MAX_TAKEOVERS, 10, 3 );
   Msg^Text^len := (@Msg^Ptr '-' @Msg^Text);
   Call Write^Event^Message( MSGLOGER^EVT^CONFIG^DISPLAY,
                             Msg^Text, Msg^Text^Len, False );
   Call Write^Log^Message( Msg^Text:Msg^Text^Len );

   --    stack base checkpoint counters
   Msg^Text ':=' "INFO: STACK BASE CHECKPOINTS nnn, BACKUP DISABLED IF 100" -> @Msg^Ptr;
   Call NUMOUT( Msg^Text[29], stack^Count, 10, 3 );
   Msg^Text^len := (@Msg^Ptr '-' @Msg^Text);
   Call Write^Event^Message( MSGLOGER^EVT^CONFIG^DISPLAY,
                             Msg^Text, Msg^Text^Len, False );
   Call Write^Log^Message( Msg^Text:Msg^Text^Len );

   -- done
End; ! Show^Configuration

?Page "Process^Command"
!############################################################################
!#                                                                          #
!#  Procedure : Process^Command                                             #
!#                                                                          #
!#  See if we have received a valid command, and take the appropriate       #
!#  action if so.                                                           #
!#                                                                          #
!#  parameters                                                              #
!#  ==========                                                              #
!#  Name                Function                                            #
!#  ------------------  --------------------------------------------------  #
!#  CommandPtr          Input                                               #
!#                      A pointer to the buffer with the eyecatcher and     #
!#                      command text in it.                                 #
!#  msgstring^len       CmdFullLen                                          #
!#                      The length of the text buffer with the command in   #
!#                      including the eyecatcher length.                    #
!#                                                                          #
!############################################################################
Proc Process^Command( CommandPtr, CmdFullLen );
  String .CommandPtr;
  Int    CmdFullLen;
Begin
  String .LocalPtr;
  Int    CommandLen;
  Int    WorkNum;
  String .WorkPtr;
  String .LocalBuffer[0:19];
  Int    Error;
  Int(32) CPU^Status^List;
  Int     .IPtr;

  Subproc Bad^Command;
  begin
     Error^text ':=' "INFO: ILLEGAL COMMAND ISSUED (COMMAND IGNORED): " & LocalPtr for CommandLen -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Log^Message( Error^Text:Error^Text^Len );
     Call Write^Event^Message( MSGLOGER^EVT^COMMAND^ERROR,
                               Error^Text, Error^Text^Len, False );
  end;

  SubProc CPU^Unavailable;
  begin
     Error^text ':=' "INFO: CPU NOT AVAILABLE (COMMAND IGNORED): " & LocalPtr for CommandLen -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Log^Message( Error^Text:Error^Text^Len );
     Call Write^Event^Message( MSGLOGER^EVT^COMMAND^ERROR,
                               Error^Text, Error^Text^Len, False );
  end;

  -- never assume the user has only one space between the
  -- command eyecatcher and the command, scan to be safe.
  Scan CommandPtr Until " " -> @WorkPtr;
  Scan WorkPtr While " " -> @LocalPtr;
  If $CARRY then begin        -- no command
     LocalBuffer ':=' "NO COMMAND PROVIDED" & 0;
     CommandLen := 19;
     @LocalPtr := @LocalBuffer;
  end
  else begin
    CommandLen := CmdFullLen '-' (@LocalPtr '-' @CommandPtr); -- adjust length to just be the command area
    LocalPtr[CommandLen] := 0;        -- to stop scans
  end;
  Call ShiftString(LocalPtr, CommandLen, 0);  -- upshift it
  Error^text ':=' "INFO: COMMAND RECEIVED = " & LocalPtr for CommandLen -> @Ptr;
  Error^Text^Len := @Ptr '-' @Error^Text;
  Call Write^Log^Message( Error^Text:Error^Text^Len );
  Call Write^Event^Message( MSGLOGER^EVT^COMMAND^LOGGED,
                            Error^Text, Error^Text^Len, False );

  --
  -- If need to shutdown, log lots of info to say its been requested rather
  -- than letting anyone think we shutdown due to a problem.
  --
  If (LocalPtr = "SHUTDOWN") then begin
     Error^Text ':=' "**** MANUAL SHUTDOWN REQUESTED ****" -> @Ptr;
     Call Write^Log^Message( Error^Text:(@Ptr '-' @Error^Text) );
     Error^text ':=' "INFO: SHUTDOWN HAS BEEN REQUESTED, PROGRAM TERMINATING" -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^USER^SHUTDOWN,
                               Error^Text, Error^Text^Len, False );
     Completion^Code := No^Error^Code;
     Error^Text^Len := 0;
     shutdown^requested := true;
  end

  --
  -- If we need to reset stats and check the environment then do this.
  --
  Else If (LocalPtr = "INIT") then begin
     Call Check^log^Files;
     Check^Processes^Recomended := TRUE;
     Takeover^Count := 0;
     Error^text ':=' "INFO: TAKEOVER COUNT RESET TO ZERO" -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^TAKEOVER^RESET,
                               Error^Text, Error^Text^Len, False );
     checkpoint^status := CHECKPOINT( , TakeOver^Count, 1 );
     stack^count := 0;
     Error^text ':=' "INFO: STACK CHECKPOINT COUNT RESET TO ZERO" -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^STACKCOUNT^RESET,
                               Error^Text, Error^Text^Len, False );
     checkpoint^status := CHECKPOINT( , stack^count, 1 );
     Call Show^Configuration;
  end

  --
  -- If we are displaying stats do this.
  --
  Else If ((LocalPtr = "STATUS") OR (LocalPtr = "STATS")) then begin
     Call Show^Configuration;
  end

  --
  -- If we are changing our CPU's then do this
  --
  Else If ((LocalPtr = "BACKUPCPU") OR (LocalPtr = "PRIMARYCPU")) then begin
     Scan LocalPtr Until " " -> @WorkPtr;
     Scan WorkPtr While " " -> @WorkPtr;
     If $CARRY Then Call Bad^Command
     Else Begin
        If ((LocalPtr = "BACKUPCPU") AND (WorkPtr = "STOP")) then begin
           prefered^backup^cpu := -1;
           Call Stop^Backup^Process;
           Return;
        end;
        Call NUMIN( WorkPtr, WorkNum, 10, Error );
        If (Error <> 0) then Call Bad^Command
        else begin
           CPU^Status^List := PROCESSORSTATUS;
           @IPtr := @CPU^Status^List;   -- max configured cpus
           if ((worknum > IPtr) OR (worknum < 0)) then begin
              ! BAD CPU NUMBER
              Call CPU^Unavailable;
              Return;
           end;
           @IPtr := @IPtr + 1;         -- the up/down bits
           If NOT CPU^Available( IPtr, worknum ) then begin
              ! CPU DOWN
              Call CPU^Unavailable;
              Return;
           end;
           If (LocalPtr = "BACKUPCPU") then begin
              -- change where we want the backup to be and let the existing
              -- code handle the change request.
              prefered^backup^cpu := WorkNum;
              checkpoint^status := CHECKPOINT( , prefered^backup^cpu, 1 );
           end
           else If (LocalPtr = "PRIMARYCPU") then begin
              -- must have a backup process available to do this
              If (current^backup^cpu <> -1) then begin
                 -- see if we can get away with just a checkswitch
                 if (WorkNum = current^backup^cpu) then begin -- only a checkswitch needed
                    prefered^backup^cpu := prefered^primary^cpu;
                    prefered^primary^cpu := WorkNum;
                    checkpoint^status := CHECKPOINT( , prefered^backup^cpu, 1 );
                    checkpoint^status := CHECKPOINT( , prefered^primary^cpu, 1 );
                 end
                 -- else we have a lot of fiddling to do, change prefered
                 -- cpu and let the existing code handle the change request.
                 else begin
                    prefered^primary^cpu := WorkNum;
                    checkpoint^status := CHECKPOINT( , prefered^primary^cpu, 1 );
                 end;
              end
              else begin
                 Error^text ':=' "INFO: COMMAND IGNORED (NO BACKUP PROCESS RUNNING): " &
                                 LocalPtr for CommandLen -> @Ptr;
                 Error^Text^Len := @Ptr '-' @Error^Text;
                 Call Write^Log^Message( Error^Text:Error^Text^Len );
                 Call Write^Event^Message( MSGLOGER^EVT^COMMAND^ERROR,
                                           Error^Text, Error^Text^Len, False );
                 Return;  -- can jump out now
              end;
           end
           else return;  -- WHAT ?, should never happen, but skip out if it does
           -- set the process check flag to trigger out process vs cpu location
           -- checks to handle any change requests.
           Check^Processes^Recomended := TRUE;   -- let existing code handle the switching
        end;
     End;
  end

  --
  -- ELSE we dont know what to do with this
  --
  Else Call Bad^Command;
End; ! Process^Command

?Page "Nonstop Section : Start^Backup^Process"
!############################################################################
!#                                                                          #
!#  Procedure : Start^Backup^Process                                        #
!#                                                                          #
!#  If a backup process is required we start the programs backup process.   #
!#                                                                          #
!#  We will try to put the processes in the correct CPUs.                   #
!#    ie: if supposed to be 5/4 and cpu 5 failed then came back the backup  #
!#        will be started in 5 to give a 4/5 group, the check^processes     #
!#        flag will be set and later on in the main loop the procedure to   #
!#        do a checkswitch will be called sp we end up back in the 5/4 set. #
!#  If a required backup cpu is not available we will choose another cpu    #
!#  to use for the backup process. We can switch back when the CPU becomes  #
!#  available again.                                                        #
!#                                                                          #
!############################################################################
INT PROC Start^Backup^Process;
BEGIN
  Int(32) CPU^status^list;
  Int     max^configured^cpus,
          I,
          error^detail,
          My^Info[0:9],
          .IPtr;

  -- are we supposed to have a backup process
  If (prefered^backup^cpu = -1) then begin
     Error^text ':=' "INFO: MSGLOGER CONFIGURED TO RUN WITHOUT A BACKUP" -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^SINGLE^MODE,
                               Error^Text, Error^Text^Len, False );
     Return False;
  end;

  -- if we already have a backup process running then do nothing
  If (current^backup^cpu <> -1)
    then return True;    -- no error, we have a backup

  -- Keep count of takeovers. If we exceed a limit drop out of nonstop
  -- process pair mode. This is to prevent loops from a non-responsive
  -- backup process during testing. In production just compile with
  -- a higher value. Note: an init command can reset it.
  takeover^count := takeover^count + 1;
  if (takeover^count > MAX_TAKEOVERS) then begin
     prefered^backup^cpu := -1;      -- we will no longer use a backup process
     -- log a going from nonstop to single process message
     Error^text ':=' "INFO: MAX TAKEOVERS EXCEEDED, WILL NO LONGER RUN AS A NONSTOP PAIR" -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^MAX^TAKEOVERS,
                               Error^Text, Error^Text^Len, False );
  end;

  -- we had better find out who we are around about here
  My^Info ':=' [-1,-1,-1,-1,-1,-1,-1,-1,-1,-1];
  Error := PROCESS_GETINFO_( My^Info ,
                             My^Process^Name:65, My^Process^NameLen,,,,,,,,,,
                             My^Program^Name:65, My^Program^NameLen );
  -- if we are not a named process we cannot run a backup
  If (My^Process^NameLen < 2) then
  BEGIN
     -- log a process not named message
     Error^text ':=' "INFO: MSGLOGER NOT A NAMED PROCESS, WILL NOT RUN AS A PROCESS PAIR" -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^NOT^NAMED,
                               Error^Text, Error^Text^Len, False );
     Return FALSE;
  END;

  -- If this is the first time through this procedure we will
  -- not have identified what our primary cpu should be. Do so
  -- now.
  If (Prefered^Primary^Cpu = -1) then begin
    Prefered^Primary^CPU := My^Info[2];
  end;
  If (Prefered^Primary^CPU = Prefered^Backup^CPU) Then Begin
     Prefered^Backup^CPU := -1;
     Error^text ':=' "WARNING: PRIMARY AND BACKUP CPUS THE SAME, BACKUP DISABLED" -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^BACKUP^IS^PRIMARY,
                               Error^Text, Error^Text^Len, True );
     Return False;
  End;

  -- Where are we currently running. If we are a backup just taking over
  -- we need to set the current^primary^cpu to ourselves.
  current^primary^cpu := My^Info[2];

  -- find out how many cpus are configured and which ones are up.
  CPU^Status^List := PROCESSORSTATUS;
  @IPtr := @CPU^Status^List;
  max^configured^cpus := IPtr;
  @IPtr := @IPtr + 1;         -- the up/down bits

  -- Ensure the user has not selected a backup cpu outside the
  -- range the operating system has been confogured for.
  If (prefered^backup^cpu > max^configured^cpus)
    then prefered^backup^cpu := max^configured^cpus;
  If (prefered^primary^cpu > max^configured^cpus)
    then prefered^primary^cpu := 0;

  -- Are we running in our prefered primary CPU ?.
  -- If not start our backup process in the preferred primary CPU so
  -- we can switch to it.
  IF (prefered^primary^cpu <> current^primary^cpu) then
  BEGIN
    if CPU^Available( IPtr, prefered^primary^cpu )
      then current^backup^cpu := prefered^primary^cpu;
  END
  ELSE if (CPU^Available( IPtr, prefered^backup^cpu ) AND (prefered^backup^cpu <> current^primary^cpu))
      then current^backup^cpu := prefered^backup^cpu
  ELSE BEGIN
     for I := 0 To (max^configured^cpus - 1) do
     BEGIN
       If (CPU^Available( IPtr, I ) AND (I <> current^primary^cpu))
         then current^backup^cpu := I;
     END;
  END;

  -- If we havn't found a cpu to use as a backup then
  -- we are obviously on a two cpu system where one is down.
  -- We cannot start a backup process.
  If (current^backup^cpu = -1) then
  BEGIN
     -- Log an error message
     Error^text ':=' "CRITICAL: NO CPUS AVAILABLE FOR BACKUP PROCESS TO USE" -> @Ptr;
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^NO^FREE^CPUS,
                               Error^Text, Error^Text^Len, True );
     return False;
  END;

  -- If we get to here then start the backup process.
  Error^Text ':=' "INFO: STARTING BACKUP " &
                  My^Program^Name for My^Program^NameLen &
                  " IN CPU nnn" -> @Ptr;
  Call NUMOUT( Ptr[-3], current^backup^cpu, 10, 3 );
  Error^Text^Len := @Ptr '-' @Error^Text;
  Call Write^Event^Message( MSGLOGER^EVT^BACKUP^INFO,
                            Error^Text, Error^Text^Len, False );
  Error^Text^Len := 0;
  Error := PROCESS_CREATE_(My^Program^Name:My^Program^NameLen,,,,,
                           current^backup^cpu, Backup^Process^Handle,
                           error^detail, 3 !backup process, use my name!,,,,,,,,
                           %B0000000000000010 );
  If (Error <> 0) then begin
     -- note the error is not a guardian error but a newprocess error.
     Error^text ':=' "ERROR: BACKUP PROCESS, PROCESS_CREATE_ ERROR nnn, DETAIL=nnn" -> @Ptr;
     Call NUMOUT( Ptr[-15], Error, 10, 3 );
     Call NUMOUT( Ptr[-3], error^detail, 10, 3 );
     Error^Text^Len := @Ptr '-' @Error^Text;
     Call Write^Event^Message( MSGLOGER^EVT^BACKUP^STARTERR,
                               Error^Text, Error^Text^Len, True );
     current^backup^cpu := -1;  -- we have no backup running at present
     Return False;
  end;

  -- If its started, checkpoint everything important
  -- The $receive file handle, the log handle, all our startup info etc.
  !
  ! files we must checkpoint
  Error := FILE_OPEN_CHKPT_( rcv, checkpoint^status );
  Error := FILE_OPEN_CHKPT_( EMS^File, checkpoint^status );
  If (Log^File > 0)
     then Error := FILE_OPEN_CHKPT_( Log^File, checkpoint^status );
  !
  ! important data areas
  !                     , buffer, wordcount
  checkpoint^status := CHECKPOINT( , rcv, 1 );
  checkpoint^status := CHECKPOINT( , Log^File, 1 );
  checkpoint^status := CHECKPOINT( , EMS^File, 1 );
  checkpoint^status := CHECKPOINT( , EMS^File^Name, 19 );
  checkpoint^status := CHECKPOINT( , EMS^File^Namelen, 1 );
  checkpoint^status := CHECKPOINT( , Log^File^Name, 19 );
  checkpoint^status := CHECKPOINT( , Log^File^Namelen, 1 );
  checkpoint^status := CHECKPOINT( , Log^File^Code, 1 );
  checkpoint^status := CHECKPOINT( , Log^File^Exts, 2 );
  checkpoint^status := CHECKPOINT( , Log^File^Recsize, 1 );
  checkpoint^status := CHECKPOINT( , Log^File^Blocksize, 1 );
  checkpoint^status := CHECKPOINT( , Log^File^Days^Kept, 1 );
  checkpoint^status := CHECKPOINT( , Log^File^Security, 1 );
  checkpoint^status := CHECKPOINT( , Log^File^Prefix, 1 );
  checkpoint^status := CHECKPOINT( , prefered^primary^cpu, 1 );
  checkpoint^status := CHECKPOINT( , prefered^backup^cpu, 1 );
  checkpoint^status := CHECKPOINT( , current^primary^cpu, 1 );
  checkpoint^status := CHECKPOINT( , current^backup^cpu, 1 );
  checkpoint^status := CHECKPOINT( , takeover^count, 1 );
  checkpoint^status := CHECKPOINT( , My^Program^NameLen, 1 );
  checkpoint^status := CHECKPOINT( , My^Program^Name, 33 );

  Error^text ':=' "INFO: STARTED BACKUP IN CPU nn" -> @Ptr;
  Call NUMOUT( Ptr[-2], current^backup^cpu, 10, 2 );
  Error^Text^Len := @Ptr '-' @Error^Text;
  Call Write^Event^Message( MSGLOGER^EVT^STARTED^BACKUP,
                            Error^Text, Error^Text^Len, False );

  checkpoint^base^required := TRUE;  -- MUST checkpoint our stack
  Return True;  -- its up and running
END; ! Start^Backup^Process

?Page "Nonstop Section : Check^Processes"
!############################################################################
!#                                                                          #
!#  Procedure : Check^Processes                                             #
!#                                                                          #
!#  Called when we get a CPU up message to see if we want to be in the      #
!#  CPU thats just returned to life.                                        #
!#                                                                          #
!#  We will if necessary juggle our backup and promary processes about to   #
!#  return to the primary/backup cpus we are supposed to be running in.     #
!#                                                                          #
!############################################################################
INT PROC Check^Processes;
BEGIN
  Int(32) CPU^status^list;
  Int     .IPtr,
          max^configured^cpus,
          I, WorkNum,
          My^Info[0:9];

  -- If theres no backup process wanted we are done ok already.
  If (prefered^backup^cpu = -1)
    then return TRUE;

  -- First see if we have a backup process
  If (current^backup^cpu = -1) then begin
    If NOT Start^Backup^Process then return FALSE;
    ! *** DO NOT do any of the checkswitch code until after we
    !     have returned to our main loop and done a stack checkpoint
    !     or we will start at the backups checkmonitor position.
    !     Just set a flag instead.
    Check^Processes^Recomended := TRUE;
    Return True;
  End;

  If CheckPoint^Base^Required then Return True;  -- DO NOTHING UNTIL BASE IS CHECKPOINTED

  Check^Processes^Recomended := FALSE;      -- we are checking, clear flag

  -- find out how many cpus are configured and which ones are up.
  CPU^Status^List := PROCESSORSTATUS;
  @IPtr := @CPU^Status^List;
  max^configured^cpus := IPtr;
  @IPtr := @IPtr + 1;         -- the up/down bits

  -- -------------------------------------------------------------------
  --       is our primary process running in the correct CPU ?
  -- -------------------------------------------------------------------
  IF (prefered^primary^cpu <> current^primary^cpu) then
  BEGIN
     -- if our backup is in the correct primary cpu we will switch
     if (prefered^primary^cpu = current^backup^cpu) then
     BEGIN
        -- change flags so backup is setup with correct values
        -- for the takeover.
        WorkNum := current^backup^cpu;
        current^backup^cpu  := current^primary^cpu;
        current^primary^cpu := WorkNum;
        Check^processes^Recomended := TRUE;
        checkpoint^status := CHECKPOINT( , current^primary^cpu, 1 );
        checkpoint^status := CHECKPOINT( , current^backup^cpu, 1 );
        checkpoint^status := CHECKPOINT( , Check^Processes^Recomended, 1 );
        -- and switch.
        --   NOTE: CHECKSWITCH switches us (running code) into CHECKMONITOR mode.
        Call MONITORCPUS( %B0000000000000000 );
        We^Are^Monitoring^CPUs := False;
        checkpoint^status := CHECKSWITCH;
     END
     ELSE BEGIN
        -- else move backup process to the correct primary cpu if possible
        If CPU^Available( IPtr, prefered^primary^cpu ) then
        BEGIN
           -- Stop the backup, set the flag to say we want to come back to
           -- this procedure eventually (do NOT start the backup at this point
           -- as we cannot safely get to a safe stackbase checkpoint call yet).
           Call Stop^Backup^Process;
           current^backup^cpu := -1;
           Check^Processes^Recomended := True;
           Return True;
        END
        ELSE BEGIN
          -- else the prefered primary cpu is not available so stay where we are
        END;
     END;
  END;

  -- -------------------------------------------------------------------
  --           is our backup process in the correct CPU ?
  -- -------------------------------------------------------------------
  IF (prefered^backup^cpu <> current^backup^cpu) then
  BEGIN
    If CPU^Available( IPtr, prefered^backup^cpu ) then
    BEGIN
       If (current^primary^cpu <> prefered^backup^cpu) then
       BEGIN
          -- stop and restart our backup process
          CALL Stop^Backup^Process;
          current^backup^cpu := -1;
          checkpoint^status := CHECKPOINT( , current^backup^cpu, 1 );
          If NOT Start^Backup^Process
             then return FALSE;
       END;
    END
    ELSE BEGIN
      -- our prefered cpu is not available, stay where we are
    END;
  END;

  return True;   -- we have done all we can
END; ! Check^Processes

?Page "Nonstop Section : Stop^Backup^Process"
!############################################################################
!#                                                                          #
!#  Procedure : Stop^Backup^Process                                         #
!#                                                                          #
!#  Called to stop the backup process.                                      #
!#                                                                          #
!############################################################################
PROC Stop^Backup^Process;
BEGIN
   INT Error;
   Error := PROCESS_STOP_( , 2 !stop my backup!, 0 !normal stop! );
   Error^text ':=' "INFO: MSGLOGER STOPPED BACKUP PROCESS" -> @Ptr;
   Error^Text^Len := @Ptr '-' @Error^Text;
   Call Write^Event^Message( MSGLOGER^EVT^STOPPED^BACKUP,
                             Error^Text, Error^Text^Len, False );
END;

?Page "Nonstop Section : CPU^Available"
!############################################################################
!#                                                                          #
!#  Procedure : CPU^Available                                               #
!#                                                                          #
!#  Check to see if a CPU is up or down. We return true if it is up, false  #
!#  if it is down.                                                          #
!#                                                                          #
!#  Cannot use the x.<n> checks where n is a variable so a seperate proc    #
!#  has been setup to do this using a switch statement.                     #
!#                                                                          #
!#  parameters                                                              #
!#  ==========                                                              #
!#  Name                Function                                            #
!#  ------------------  --------------------------------------------------  #
!#  IPtr                Input                                               #
!#                      A pointer to the integer containing the up/down     #
!#                      bits from a processorstatus call.                   #
!#  CPU^To^Check        Input                                               #
!#                      The CPU we want to get the state of.                #
!#                                                                          #
!############################################################################
Int PROC CPU^Available( IPtr, CPU^To^Check );
  Int IPtr;
  Int CPU^To^Check;
Begin
   CASE CPU^To^Check OF
   BEGIN
      0 ->         If IPtr.<0>  then Return True;
      1 ->         If IPtr.<1>  then Return True;
      2 ->         If IPtr.<2>  then Return True;
      3 ->         If IPtr.<3>  then Return True;
      4 ->         If IPtr.<4>  then Return True;
      5 ->         If IPtr.<5>  then Return True;
      6 ->         If IPtr.<6>  then Return True;
      7 ->         If IPtr.<7>  then Return True;
      8 ->         If IPtr.<8>  then Return True;
      9 ->         If IPtr.<9>  then Return True;
     10 ->         If IPtr.<10> then Return True;
     11 ->         If IPtr.<11> then Return True;
     12 ->         If IPtr.<12> then Return True;
     13 ->         If IPtr.<13> then Return True;
     14 ->         If IPtr.<14> then Return True;
     15 ->         If IPtr.<15> then Return True;
      Otherwise -> Begin
                    ! Log an event message ?
                    Return False;
                 End;
   END;
End; ! Subproc

?Page "Nonstop Section : Handle^Checkpoint^Failure"
!############################################################################
!#                                                                          #
!#  Procedure : Handle^Checkpoint^Failure                                   #
!#                                                                          #
!#  Called from the main loop if there has been a checkpoint failure for    #
!#  any reason. This procedure checks what the failure was and takes the    #
!#  appropriate actions to resolve the problem.                             #
!#                                                                          #
!#  parameters                                                              #
!#  ==========                                                              #
!#  Name                Function                                            #
!#  ------------------  --------------------------------------------------  #
!#  Checkpoint^Status   Input                                               #
!#                      The integer containing the checkpoint status result #
!#                      from a failed checkpoint request.                   #
!#                                                                          #
!############################################################################
Proc Handle^Checkpoint^Failure( Checkpoint^Status );
   Int Checkpoint^Status;
Begin
   Int Work^Num;

   --
   --                   Takeover from primary !.
   --
   if (checkpoint^status.<0:7> = 2) then begin -- takeover from primary
      --              (3) Primary Called Checkswitch
      If (checkpoint^status.<8:15> = 3) then begin
         -- do not flick primary/backup values around, our
         -- well behaved primary has already adjusted these and
         -- checkpointed the correct values to us.
         Error^text ':=' "INFO: CHECKSWITCH REQUEST, NOW PRIMARY nnn BACKUP nnn" -> @Ptr;
         call NUMOUT( Ptr[-14], current^primary^cpu, 10, 3 );
         call NUMOUT( Ptr[-3], current^backup^cpu, 10, 3 );
         Error^Text^Len := @Ptr '-' @Error^Text;
         Call Write^Event^Message( MSGLOGER^EVT^USER^TAKEOVER,
                                   Error^Text, Error^Text^Len, False );
         -- must have another checkbase checkpoint for new backup
         checkpoint^base^required := TRUE;
      end
      else begin                                    -- primary gone away
         Error^text ':=' "WARNING: PRIMARY PROCESS FAILED, TAKEOVER BY BACKUP" -> @Ptr;
         Error^Text^Len := @Ptr '-' @Error^Text;
         Call Write^Event^Message( MSGLOGER^EVT^SYSTEM^TAKEOVER,
                                   Error^Text, Error^Text^Len, True );
         current^backup^cpu := -1;
         Call Check^Processes;
         -- must have another checkbase checkpoint for new backup
         checkpoint^base^required := TRUE;
      end;
   end ! takeover from primary

   --
   --                  No backup process running.
   --
   else if (checkpoint^status.<0:7> = 1) then begin  -- no backup running
      current^backup^cpu := -1;
      Call Check^Processes;
      -- must have another checkbase checkpoint for new backup
      checkpoint^base^required := TRUE;
   end

   --
   --                     General Failure
   --
   else begin
      Error^text ':=' "FATAL: CHECKPOINT FAILURE CODE nnn, DETAIL nnn" -> @Ptr;
      Work^Num := Checkpoint^Status.<0:7>;
      call NUMOUT( Ptr[31], Work^Num, 10, 3 );
      Work^Num := Checkpoint^Status.<8:15>;
      call NUMOUT( Ptr[43], Work^Num, 10, 3 );
      Error^Text^Len := @Ptr '-' @Error^Text;
      Call Write^Event^Message( MSGLOGER^EVT^CHECKPOINT^FAILED,
                                Error^Text, Error^Text^Len, True );
      Call Stop^Backup^Process;
      prefered^backup^cpu := -1;
   end;
End; ! Handle^Checkpoint^Failure
