{ *************************************************************************** }
MODULE mod_handle_remcons ;
{ *************************************************************************** }
INCLUDE 
  ELNCON, 
  mod_common_global_flags,
  $KERNELMSG,                                      { from ELN$:RTLOBJECT.OLB  }
  $KERNEL ;                                        { from ELN$:RTLOBJECT.OLB  }
{ *************************************************************************** }
EXPORT
  send_remcons,            {AREA      signals a new message to send           }
  remcons_ready,           {AREA      signals the process is ready for new msg}
  init_remcons,            {PROCEDURE initiate a remote console               }
  stop_remcons ;           {PROCEDURE stop the   remote console               }
{ *************************************************************************** }
IMPORT  
  status_type,  ok, already_done, io_failure,{wrong_mode, not_found,}
                                      {from module MOD_COMMON_GLOBAL_FLAGS    }
  console_synch,                      {from module MOD_COMMON_GLOBAL_FLAGS    }

  ELN_ACCON, ELN_DISCON,              {from module ELNCON                     }
  ELN_SNDNEW,{ELN_GETNEW,}            {from module ELNCON                     }

  KER$_DEBUG_SIGNAL,                  {from module $KERNELMSG                 }
  KER$_COUNT_OVERFLOW,                {from module $KERNELMSG                 }

  KER$NAME_OBJECT ;                   {from module $KERNEL                    }

{ *************************************************************************** }
{ *************************************************************************** }

  %INCLUDE 'SITE_DEPENDENT.CST/LIST'

VAR
  rem_cons_name    : STRING(8) := remote_cons_elncon_channel_name ;
  send_remcons     : AREA ;
  remcons_ready    : AREA ;
  proc_remcons     : PROCESS ;
  name_remcons_proc: NAME ;
  rem_cons_chan    : INTEGER := 21 ;
  no_name          : BOOLEAN := FALSE ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE init_remcons ( VAR status : [OPTIONAL] status_type ) ;

VAR 
  inistat : INTEGER ;                              {general use status buffer}
  elncon_port    : PORT;
BEGIN

  TRANSLATE_NAME ( elncon_port, remote_cons_elncon_channel_name,
                   NAME$LOCAL, STATUS := inistat ) ;
  IF ( inistat = 1 ) 
  THEN BEGIN
    IF PRESENT(status) THEN status := already_done ;
  END 
  ELSE BEGIN

    CREATE_PROCESS ( proc_remcons, block_remcons_server, 
                     STATUS := inistat );
    IF ( inistat = 1 ) 
    THEN BEGIN
      IF PRESENT(status) THEN status := ok ;
      KER$NAME_OBJECT ( name_remcons_proc, 'REMCONS SERVER', proc_remcons, 
                        STATUS := inistat ) ;
      IF ( inistat <> 1 ) 
      THEN handle_trc_sta ( TAG := 'NAM/PRC%remcons%', STATUS := inistat ) ;
      WAIT_ANY ( TIME := - 50000000 ) ;
  
      { crank up the priority of the process so that it immediately sends  }
      { the message to the remote console, even if other subprocesses      }
      { are ready to compute                                               }
      SET_PROCESS_PRIORITY ( proc_remcons, 7, STATUS := inistat );
      handle_trc_sta ( TAG := 'SET/PIO%remcons%', STATUS := inistat ) ;

      { redirect_console := TRUE ; }{ done by the independent process } 
    END 
    ELSE BEGIN
      IF PRESENT(status) THEN status := io_failure ;
      handle_trc_sta ( TAG := 'ACC/CON%remcons%', STATUS := inistat ) ;
      console_synch^.redirect_console := FALSE ;
    END ;
  END ;

END ;
{ *************************************************************************** }
PROCEDURE handle_trc_sta ( status : INTEGER ; 
                              tag : VARYING_STRING(32) := 'SYS/STA%' ;
                      VAR decoded :[OPTIONAL] VARYING_STRING(255) ) ;
EXTERNAL ;
PROCEDURE handle_trc_err ( message : STRING(<n>) ;
                               tag : VARYING_STRING(32) := '' ) ;
EXTERNAL ;
PROCEDURE handle_trc_exc ( message : VARYING_STRING(255) := '' ;
                               tag : VARYING_STRING(32) := '' ) ;
EXTERNAL ;
PROCEDURE set_trc_exc_mode ( exc_mode : BOOLEAN ;
                               tagext : VARYING_STRING(16) := '' ) ;
EXTERNAL ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCESS_BLOCK block_remcons_server ;
CONST 
  one_second = -10000000 ;
  forever = FALSE ;
VAR   
  status, result : INTEGER ;
BEGIN

  ESTABLISH ( exchand_remcons ) ;

  status:= ELN_ACCON ( rem_cons_name, rem_cons_chan ) ;

  IF ( status <> 1 ) 
  THEN BEGIN
    console_synch^.redirect_console := FALSE ;
    handle_trc_sta ( TAG := 'ACC/CON%remcons%', STATUS := status ) ;
    GOTO quit_remcons_server ;
  END 
  ELSE BEGIN
    console_synch^.redirect_console := TRUE ; 
  END ;

  console_synch^.remcons_message := '                ' 
                                  + 'Remote Console Connected to TRICS V' 
                                  + version_number ;
REPEAT

  status:= ELN_SNDNEW ( rem_cons_chan, console_synch^.remcons_message, no_name);

  IF ( status <> 1 ) 
  THEN BEGIN
    console_synch^.redirect_console := FALSE ;
    handle_trc_sta ( TAG := 'SND/NEW%remcons%', STATUS := status ) ;
    GOTO quit_remcons_server ;
  END ;

  SIGNAL   ( remcons_ready, STATUS := status ) ;
  IF ( status <> 1 )
  THEN IF ( status <> KER$_COUNT_OVERFLOW ) {happens when remcons is restarted}
  THEN BEGIN
    console_synch^.redirect_console := FALSE ;
    handle_trc_sta ( TAG := 'SIG/ARE%remcons%', STATUS := status ) ;
    raise_exception ( KER$_DEBUG_SIGNAL ) ; {get debugger to investigate }
  END ;

 wait_for_message_to_service :
  WAIT_ANY ( send_remcons, TIME := 60 * one_second, 
             STATUS := status, RESULT := result ) ;

  IF ( status <> 1 )
  THEN BEGIN
    console_synch^.redirect_console := FALSE ;
    handle_trc_sta ( TAG := 'WAI/ARE%remcons%', STATUS := status ) ;
    raise_exception ( KER$_DEBUG_SIGNAL ) ; {get debugger to investigate }
  END 

  ELSE IF ( result = 0 ) 
  THEN BEGIN
    IF ( console_synch^.redirect_console = FALSE ) 
    THEN BEGIN
      console_synch^.redirect_console := TRUE ;
      handle_trc_exc ( TAG := 'WAI/RCS%', 
                   MESSAGE := ' Remote Console was Bypassed, Resuming Service');
      set_trc_exc_mode ( FALSE ) ;
    END ;
    GOTO wait_for_message_to_service 
  END ;

UNTIL ( forever ) ;

quit_remcons_server :

  status := ELN_DISCON ( rem_cons_chan ) ;
  DELETE ( name_remcons_proc,         STATUS := status  ) ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE stop_remcons ;

VAR 
  status : INTEGER ;                              {general use status buffer}
  elncon_port    : PORT;
BEGIN

  console_synch^.redirect_console := FALSE ;

  SIGNAL ( proc_remcons,              STATUS := status ) ;

  TRANSLATE_NAME ( elncon_port, remote_cons_elncon_channel_name,
                   NAME$LOCAL, STATUS := status ) ;
  IF ( status = 1 ) 
  THEN status := ELN_DISCON ( rem_cons_chan ) ;

  DELETE ( name_remcons_proc,         STATUS := status  ) ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
FUNCTION exchand_remcons OF TYPE EXCEPTION_HANDLER ;

BEGIN


  {save a record of what happened before exiting}
  set_trc_exc_mode ( TRUE ) ;
  handle_trc_sta ( TAG := 'RCS/EXC%remcons%', STATUS := signal_args.name ) ;
  handle_trc_exc ( TAG := 'RCS/EXC%remcons%', MESSAGE := 'Quitting' ) ;
  set_trc_exc_mode ( FALSE ) ;
  exchand_remcons := FALSE ;
  EXIT ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
END .