{ *************************************************************************** }
MODULE mod_handle_begin_end_run ;
{  Created  23-MAR-1992 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE   }
{ *************************************************************************** }
INCLUDE
  mod_common_global_flags,
  mod_common_soft_conn, 
  mod_handle_console,
  mod_def_hardware_tables,
  mod_def_physics_tables,
  mod_handle_tracing,
  mod_handle_scalers,
  mod_io_allocation_handling,
  mod_init_auxi,
  mod_common_hard_io,                 {from the TRICS hardware IO library     }
  $KERNEL ;                                        { from ELN$:RTLOBJECT.OLB  }
{ *************************************************************************** }
EXPORT
  begin_end_run_phases,         {Enumerated TYPE for processing phases        }
  init_begin_end_run,           {PROCEDURE initialize and create task         }
  initiate_write_host_file,     {PROCEDURE initiate write begin/end run file  }
  synchronize_wrt_host,         {PROCEDURE verify completion of previous req. }
  create_begin_end_run,         {PROCEDURE create task                        }
  delete_begin_end_run,         {PROCEDURE delete task                        }
  add_beg_end_run_dbsc,         {PROCEDURE add DBSC entry read at beg/end run }
  add_beg_end_run_sbsc,         {PROCEDURE add SBSC entry read at beg/end run }
  show_beg_end_run_entries ;    {PROCEDURE dump content of beg/end run list   }

{ *************************************************************************** }
IMPORT

  get_host_address,                   {from module MOD_COMMON_GLOBAL_FLAGS    }
  status_type,                        {from module MOD_COMMON_GLOBAL_FLAGS    }
  ok, error_found, io_failure,        {from module MOD_COMMON_GLOBAL_FLAGS    }
  boot_directory_name,                {from module MOD_COMMON_GLOBAL_FLAGS    }

  disp_not_busy,                      {from module MOD_COMMON_SOFT_CONN       }

  lock_console,                       {from module MOD_HANDLE_CONSOLE         }
  unlock_console,                     {from module MOD_HANDLE_CONSOLE         }

  inline_time_now,                    {from module MOD_HANDLE_TRACING         }
 { trace_info,{trace_warn, trace_error,{from module MOD_HANDLE_TRACING         }
 { inline_tracing,                     {from module MOD_HANDLE_TRACING         }
  handle_trc_inf                      {from module MOD_HANDLE_TRACING         }
  handle_trc_sta,                     {from module MOD_HANDLE_TRACING         }
  handle_trc_sys,                     {from module MOD_HANDLE_TRACING         }
  handle_trc_err,                     {from module MOD_HANDLE_TRACING         }
  handle_exception,                   {from module MOD_HANDLE_TRACING         }
  set_trc_exc_mode,                   {from module MOD_HANDLE_TRACING         }

  cbus_register,                      {from module MOD_DEF_HARDWARE_TABLES    }
  dbsc_foreign_card,                  {from module MOD_DEF_HARDWARE_TABLES    }
  sbsc_card,                          {from module MOD_DEF_HARDWARE_TABLES    }
  sbscdis,                            {from module MOD_DEF_HARDWARE_TABLES    }
  sptrg_per_fstd, st_0_3, st_28_31,   {from module MOD_DEF_HARDWARE_TABLES    }

  sptrg,                              {from module MOD_DEF_PHYSICS_TABLES     }

  load_sbscalers,                     {from module MOD_HANDLE_SCALERS         }
  read_sbscalers,                     {from module MOD_HANDLE_SCALERS         }
  read_dbscaler,                      {from module MOD_HANDLE_SCALERS         }

  allocate_trigger,                   {from module MOD_IO_ALLOCATION_HADLLING }
  deallocate_trigger,                 {from module MOD_IO_ALLOCATION_HADLLING }

  cbus_param_list,                    {from module MOD_COMMON_HARD_IO         }

  init_auxi,                          {from module MOD_INIT_AUXI              }

  KER$NAME_OBJECT ;                   {from module $KERNEL                    }
{ *************************************************************************** }
CONST 

  ten_seconds = - 100000000 ;

  %INCLUDE 'SITE_DEPENDENT.CST/LIST'

  max_dbsc  = 175 ;
  max_sbsc  = 25 ;
  max_entry = 200 ;

TYPE

  byte = [BYTE]   0..255   ;

  %INCLUDE 'TABLE_BEGIN_END_RUN.TYP/LIST'

  large_int_24_10_30 = 
  PACKED RECORD
    low_30   : [POS( 0)] 0..1073741823 ;
    high_10  : [POS(30)] 0..1023 ;
    spare_24 : [POS(40)] 0..16777216 ;
  END ;

  int_2_30 = [LONG]
  PACKED RECORD
    low_30   : [POS( 0)] 0..1073741823 ;
    high_2   : [POS(30)] 0..3 ;
  END ;

  array_0_31_int_2_30 = ARRAY [0..31] OF int_2_30 ;

  array_0_31_integer  = ARRAY [0..31] OF INTEGER ;


VAR   

  tag                       : VARYING_STRING(8) := 'BER/TSK%' ;
  tagext                    : STRING(5) := 'bert%' ;
  host_name                 : VARYING_STRING(10) ;

  begin_end_run_request     : write_host_transaction_data ;

  proc_begin_end_run        : PROCESS; 
  name_begin_end_run        : NAME; 
  param                     :^cbus_param_list ;

  begin_end_run_is_idle     : SEMAPHORE ;
  start_new_begin_end_run   : SEMAPHORE ;

  begin_end_run_exists      : BOOLEAN := FALSE ;

  begin_run_file            : TEXT ;

  entry_list                : ARRAY [1..max_entry] OF ^begin_end_run_entry ;
  dbsc_data                 : ARRAY [1..max_dbsc]  OF ^large_int_24_10_30 ;
  sbsc_data                 : ARRAY [1..max_sbsc]  OF ^array_0_31_int_2_30 ;
  dbsc_count                : INTEGER := 0 ;
  sbsc_count                : INTEGER := 0 ;
  entry_count               : INTEGER := 0 ;

  sbsc_veto_data            : ARRAY [st_0_3..st_28_31] OF array_0_31_int_2_30 ;

{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE initiate_write_host_file ( filename : VARYING_STRING(80) ;
                                         name : VARYING_STRING(12) ;
                                     rcp_type : VARYING_STRING(12) ;
                                  VAR success :[OPTIONAL] BOOLEAN ) ;
VAR
  status : INTEGER ;                      
  result : INTEGER ;
BEGIN
  
  IF PRESENT(success) THEN success := TRUE ;

  {make sure the task is ready to take a new request                    ***** }
  WAIT_ANY ( begin_end_run_is_idle, TIME := ten_seconds, 
             STATUS := status, RESULT := result ) ;

  IF ( status <> 1 ) 
  THEN BEGIN
    handle_trc_sta ( TAG := 'WAI/BER%', STATUS := status ) ;
    IF PRESENT(success) THEN success := FALSE ;
    GOTO quit_wrt_host_file ;
  END
  ELSE IF ( result = 0 ) 
  THEN BEGIN
    handle_trc_err ( TAG := 'WAI/BER%', 
                 MESSAGE := ' Wait for Write Begin/End Run Task Timeout ' ) ;
    IF PRESENT(success) THEN success := FALSE ;
    GOTO quit_wrt_host_file ;
  END ;

  begin_end_run_request.file_name := filename ;
  begin_end_run_request.file_type := rcp_type ;

  handle_trc_inf ( TAG := tag, 
               MESSAGE := ' Initiate Write '
                        + name + ' File' ) ;

  {signal that there is a new message to service                        ***** }
  SIGNAL (start_new_begin_end_run) ;

quit_wrt_host_file:
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE synchronize_wrt_host ( VAR phase :[OPTIONAL] begin_end_run_phases ;
                                VAR status :[OPTIONAL] INTEGER ; 
                               VAR decoded :[OPTIONAL] VARYING_STRING(255) ; 
                               VAR timeout :[OPTIONAL] BOOLEAN ) ;
VAR
  wait_status : INTEGER ;                      
  wait_result : INTEGER ;

BEGIN

  IF PRESENT(timeout) THEN timeout := FALSE ;

  handle_trc_inf ( TAG := tag, 
               MESSAGE := ' Synchronize with '
                        + begin_end_run_request.file_type 
                        + ' File: ' 
                        + begin_end_run_request.file_name ) ;

  {see if the task is done with the last request                        ***** }
  WAIT_ANY ( begin_end_run_is_idle, TIME := ten_seconds, 
             STATUS := wait_status, RESULT := wait_result ) ;

  IF PRESENT( phase   ) THEN phase   := begin_end_run_request.processing_phase ;
  IF PRESENT( status  ) THEN status  := begin_end_run_request.status ;
  IF PRESENT( decoded ) THEN decoded := begin_end_run_request.decoded_status ;

  IF ( wait_status <> 1 ) 
  THEN BEGIN {this case shouldn't happen, e.g. bad semaphore object}
    handle_trc_sta ( TAG := 'WAI/BER%', STATUS := wait_status ) ;
    IF PRESENT(timeout) THEN timeout := TRUE ;
  END

  ELSE IF ( wait_result = 0 ) 
  THEN BEGIN
    handle_trc_err ( TAG := 'WAI/BER%', 
                 MESSAGE := ' Wait for Write Begin/End Run Task Timeout ' ) ;
    handle_trc_err ( TAG := tag, 
                 MESSAGE := ' phase=' + CONVERT(STRING,phase)
                          + ' status=' + CONVERT(STRING,status) 
                          + ':' + decoded ) ;
    IF PRESENT(timeout) THEN timeout := TRUE ;
  END 

  ELSE BEGIN
  {signal the semaphore to be available for next transaction             ***** }
    SIGNAL ( begin_end_run_is_idle ) ;
  END ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCESS_BLOCK   block_begin_end_run ;
    
    {************************************************************************ }
    {* the code for the exc.handler function must appear "inside"           * }
    {* the procedure to allow the use of a GOTO statement in excep. handler * }
    {************************************************************************ }
    {*} FUNCTION exchand_begin_end_run OF TYPE EXCEPTION_HANDLER ;
    {*} 
    {*} BEGIN
    {*}   set_trc_exc_mode ( TRUE ) ;
    {*} 
    {*}   begin_end_run_request.status := signal_args.name ;
    {*}   
    {*}   handle_trc_sys ( TAG := 'BER/EXC%', 
    {*}                MESSAGE := ' Error during '
    {*}                         + begin_end_run_request.file_type 
    {*}                         + ' File, during phase ' 
    {*}                         + CONVERT(STRING,begin_end_run_request.processing_phase) ) ;
    {*} 
    {*}   exchand_begin_end_run :=
    {*}      handle_exception ( TAG := 'BER/EXC%', 
    {*}                    EXC_CODE := begin_end_run_request.status,
    {*}                     DECODED := begin_end_run_request.decoded_status ) ;
    {*} 
    {*}   set_trc_exc_mode ( FALSE ) ;
    {*}   GOTO get_ready_for_next_request ;
    {*}
    {*} END ;
    {************************************************************************ }

VAR status : INTEGER ;
BEGIN

  {define an exception handler for this process block                    **** }
  ESTABLISH ( exchand_begin_end_run ) ;

  {start an infinite loop                                                **** }
  get_ready_for_next_request:

    {advertise that the message has been serviced                        **** }
    SIGNAL (begin_end_run_is_idle, STATUS := status ) ;
    IF ( status <> 1 ) 
    THEN handle_trc_sta ( TAG := tag+'ber_idle%', STATUS := status ) ;

    {wait for a new message to service                                   **** }
    WAIT_ANY (start_new_begin_end_run, STATUS := status ) ;
    IF ( status <> 1 ) 
    THEN handle_trc_sta ( TAG := tag+'ber_start%', STATUS := status ) ;

    {write the file                                                     ***** }
    begin_end_run ;

  {infinite loop return                                                  **** }
  GOTO get_ready_for_next_request ;

END; {end of process_block}
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE begin_end_run ;
VAR

 status         : status_type ;
 filename       : STRING(132) ;

BEGIN

  begin_end_run_request.status          := 1 ;
  begin_end_run_request.decoded_status  := '' ;

  handle_trc_sys ( TAG := tag, 
               MESSAGE := ' '
                        + begin_end_run_request.file_type 
                        + ' File: ' 
                        + begin_end_run_request.file_name ) ;

  filename := host_name 
            + '"TRGUSER TRGGER"::' 
            + begin_end_run_request.file_name ;

  begin_end_run_request.processing_phase := collect_data ;

 {steal the IO allocation if necessary }
  deallocate_trigger ( TAGEXT := tagext ) ;

 { *** update double buffer, prepare for reading DBSC cards *** }
 { for flexibility we use a message command file (init_auxi),   }
 { but first grab the dispatcher-not-busy semaphore             }
 { to prevent mutual data corruption with dispatcher            }
  WAIT_ANY (disp_not_busy) ;
  init_auxi ( TAGEXT := tagext,
            FILENAME := boot_directory_name + force_update_file,
              STATUS := status ) ;
  SIGNAL (disp_not_busy) ;

  IF ( status = io_failure ) 
  THEN BEGIN
    begin_end_run_request.status           := 0 ;
    begin_end_run_request.decoded_status   := CONVERT(STRING,status) 
                                            + ' during ' + force_update_file ;
    GOTO quit_begin_end_run ;
  END ;

  allocate_trigger   ( TAGEXT := tagext, CALLER_ID := param ) ;
  collect_begin_end_run ;
  deallocate_trigger ( TAGEXT := tagext ) ;

  IF ( begin_end_run_request.status <> 1 ) THEN GOTO quit_begin_end_run ;

  handle_trc_inf ( TAG := tag, 
               MESSAGE := ' Done Collecting ' 
                        + begin_end_run_request.file_type 
                        + ' Data, Now Opening File' ) ;
  
  begin_end_run_request.processing_phase := open_file ;
  OPEN ( begin_run_file, 
                  FILE_NAME := filename,
                    HISTORY := HISTORY$NEW,      
              ACCESS_METHOD := ACCESS$SEQUENTIAL,
           CARRIAGE_CONTROL := CARRIAGE$LIST,    
                DISPOSITION := DISPOSITION$SAVE, 
                    SHARING := SHARE$READONLY,   
                     APPEND := TRUE,
                  BUFFERING := TRUE, 
                 BUFFERSIZE := 4096,
                 CONTIGUOUS := FALSE,
                 EXTENDSIZE := 10,
                   FILESIZE := 10,
                   TRUNCATE := TRUE ) ;

  handle_trc_sys ( TAG := tag, 
               MESSAGE := ' ' + begin_end_run_request.file_type 
                        + ' File Opened' ) ;

  begin_end_run_request.processing_phase := write_file ;
  write_begin_end_run ;

  begin_end_run_request.processing_phase := close_file ;
  CLOSE ( begin_run_file ) ;
  

  begin_end_run_request.processing_phase := done ;
quit_begin_end_run:
  handle_trc_sys ( TAG := tag, 
               MESSAGE := ' Done with '
                        + begin_end_run_request.file_type 
                        + ' File' ) ;

END ;
{ ************************************************************************* }
{ ************************************************************************* }
PROCEDURE collect_begin_end_run ;
VAR
  st_fd         : sptrg_per_fstd ;
  status        : status_type ;
  entry_num     : INTEGER ;
  dbsc_pointer  :^dbsc_foreign_card ; 
  channel       : INTEGER ;
  reg_pointer   :^cbus_register ; 
  data_index    : INTEGER ;
  sbsc_pointer  :^sbsc_card ;
BEGIN

 { *** latch all SBSC cards *** }
  load_sbscalers ( IOPAR := param, STATUS := status ) ;
  IF ( status = io_failure ) 
  THEN BEGIN
    begin_end_run_request.status           := 0 ;
    begin_end_run_request.decoded_status   := CONVERT(STRING,status) ;
    GOTO end_collect_data ;
  END ;

  FOR st_fd := st_0_3 TO st_28_31
  DO read_sbscalers ( TAGEXT := 'bert%',
                        CARD := ADDRESS(sbscdis[st_fd]),
                    REGISTER := ADDRESS(sbscdis[st_fd].datareg),
                      LOADED := TRUE, 
                     SCALERS := ADDRESS(sbsc_veto_data[st_fd]::array_0_31_integer), 
                       IOPAR := param ) ;

  FOR entry_num := 1 TO entry_count
  DO CASE entry_list[entry_num]^.entry_type OF 

    ber_dbsc : 
    BEGIN
  
      dbsc_pointer   := entry_list[entry_num]^.dbsc_card ;
      channel        := entry_list[entry_num]^.channel ;
      reg_pointer    := ADDRESS(dbsc_pointer^.scaler_resetreg[channel]) ;
      data_index     := entry_list[entry_num]^.data_index ;  
      read_dbscaler ( TAGEXT := tagext,
                        CARD := dbsc_pointer,
                    REGISTER := reg_pointer, 
                      SCALER := dbsc_data[data_index]^::LARGE_INTEGER,
                       IOPAR := param ) ;
    END ;
    ber_sbsc : 
    BEGIN
  
      sbsc_pointer   := entry_list[entry_num]^.sbsc_card ;
      reg_pointer    := ADDRESS(sbsc_pointer^.datareg) ;
      data_index     := entry_list[entry_num]^.data_index ;  
      read_sbscalers ( TAGEXT := tagext,
                         CARD := sbsc_pointer,
                     REGISTER := reg_pointer, 
                      SCALERS := ADDRESS(sbsc_data[data_index]^::array_0_31_integer),
                        IOPAR := param ) ;
    END ;

  END ;

end_collect_data:
END ;
{ ************************************************************************* }
{ ************************************************************************* }
PROCEDURE write_begin_end_run ;

VAR
  time_now      : STRING(23) ;
  entry_num     : INTEGER ;
  data_index    : INTEGER ;
  entry_name    : STRING(32) ;
  scalernum     : INTEGER ;
  sptrgnum      : INTEGER ;
  scalerarray   :^array_0_31_int_2_30 ;
  from_chan     : INTEGER ;
  to_chan       : INTEGER ;
BEGIN

  time_now := inline_time_now ;

  WRITELN ( begin_run_file, '\START     D0TCC_' + begin_end_run_request.file_type ) ;
{ WRITELN ( begin_run_file, '\SIZE        116        57' ) ;}
  WRITELN ( begin_run_file, '!------------------------------------------------------------------------------' ) ;
  WRITELN ( begin_run_file, '!   Name:       ' + begin_end_run_request.file_name ) ;
  WRITELN ( begin_run_file, '!------------------------------------------------------------------------------' ) ;
  WRITELN ( begin_run_file, '!   Purpose:    Recording of all the LEVEL 1 Scalers at begin or end of run.' ) ;
  WRITELN ( begin_run_file, '!------------------------------------------------------------------------------' ) ;
  WRITELN ( begin_run_file, '!   Created:    ' + SUBSTR(time_now, 1,17) + '  by D0TCC::' ) ;
  WRITELN ( begin_run_file, '!   Version:    TRICS V' + version_number ) ;
  WRITELN ( begin_run_file, '!------------------------------------------------------------------------------' ) ;
  WRITELN ( begin_run_file, '! - All level 1 scalers are either 32 or 40 bit unsigned integers.' ) ;
  WRITELN ( begin_run_file, '! - In this file, each scaler is represented by a set of 2 integers ' ) ;
  WRITELN ( begin_run_file, '!   that FORTRAN can store in two 32 bit signed integers.' ) ;
  WRITELN ( begin_run_file, '! - The second integer of each set represents the lower 30 bits of the scaler,' ) ;
  WRITELN ( begin_run_file, '!   the first integer of each set represents the remaining upper 2 or 10 bits.' ) ;
  WRITELN ( begin_run_file, '! - A typical entry looks like:  xxxx   yyyyyyyyyy' ) ;
  WRITELN ( begin_run_file, '!   with 0 < xxxx < 1,023 and 0 < yyyyyyyyyy < 1,073,741,823' ) ;
  WRITELN ( begin_run_file, '!   The scaler count represented is : xxxx * 2^30 + yyyyyyyyyy' ) ;
  WRITELN ( begin_run_file, '!------------------------------------------------------------------------------' ) ;
  WRITELN ( begin_run_file, '\ARRAY ' + begin_end_run_request.file_type + '_DATE ' ) ;
  WRITELN ( begin_run_file, '  ''' + SUBSTR(time_now, 1,11) + '''' ) ;
  WRITELN ( begin_run_file, '\END' ) ;
  WRITELN ( begin_run_file, '\ARRAY ' + begin_end_run_request.file_type + '_TIME ' ) ;
  WRITELN ( begin_run_file, '  ''' + SUBSTR(time_now,13,11) + '''' ) ;

  entry_name := '' ;
  
  FOR entry_num := 1 TO entry_count
  DO CASE entry_list[entry_num]^.entry_type OF 
    ber_dbsc : 
    BEGIN
  
      IF ( entry_name <> entry_list[entry_num]^.RCP_name )
      THEN BEGIN 
        WRITELN ( begin_run_file, '\END' ) ;
        entry_name := entry_list[entry_num]^.RCP_name ;
        WRITELN ( begin_run_file, '\ARRAY ' + entry_name + ' ! (10+30) bits' ) ;
      END ;

      data_index := entry_list[entry_num]^.data_index ;  
      WRITELN ( begin_run_file, CONVERT(STRING(6),dbsc_data[data_index]^.high_10) 
                              + CONVERT(STRING(13),dbsc_data[data_index]^.low_30) ) ;
    END ;
    ber_sbsc : 
    BEGIN
  
      WRITELN ( begin_run_file, '\END' ) ;
      entry_name  := entry_list[entry_num]^.RCP_name ;
      WRITELN ( begin_run_file, '\ARRAY ' + entry_name + ' ! (2+30) bits' ) ;

      data_index  := entry_list[entry_num]^.data_index ;  
      scalerarray := sbsc_data[data_index] ;
      from_chan   := entry_list[entry_num]^.from_chan ;
      to_chan     := entry_list[entry_num]^.to_chan ;

      IF ( from_chan <= to_chan ) 
      THEN FOR scalernum := from_chan TO to_chan 
      DO WRITELN ( begin_run_file, CONVERT(STRING(6),scalerarray^[scalernum].high_2) 
                                 + CONVERT(STRING(13),scalerarray^[scalernum].low_30) ) 
      ELSE FOR scalernum := to_chan DOWNTO from_chan 
      DO WRITELN ( begin_run_file, CONVERT(STRING(6),scalerarray^[scalernum].high_2) 
                                 + CONVERT(STRING(13),scalerarray^[scalernum].low_30) ) ;

    END ;
  END ;

  WRITELN ( begin_run_file, '\END' ) ;
  WRITELN ( begin_run_file, '\ARRAY  SPTRG_PRESC_VETO_COUNT          ! 32 Scaler * (2+30) bits' ) ;
  write_sptrg_sbsc_vetos ( vetonum := 0 ) ;
  WRITELN ( begin_run_file, '\END' ) ;
  WRITELN ( begin_run_file, '\ARRAY  SPTRG_L2_VETO_COUNT             ! 32 Scaler * (2+30) bits' ) ;
  write_sptrg_sbsc_vetos ( vetonum := 2 ) ;
  WRITELN ( begin_run_file, '\END' ) ;
  WRITELN ( begin_run_file, '\ARRAY  SPTRG_ACQ_VETO_COUNT            ! 32 Scaler * (2+30) bits' ) ;
  write_sptrg_sbsc_vetos ( vetonum := 3 ) ;
  WRITELN ( begin_run_file, '\END' ) ;
  WRITELN ( begin_run_file, '\ARRAY  SPTRG_AUX_VETO_COUNT            ! 32 Scaler * (2+30) bits' ) ;
  write_sptrg_sbsc_vetos ( vetonum := 4 ) ;
  WRITELN ( begin_run_file, '\END' ) ;
  WRITELN ( begin_run_file, '\ARRAY  SPTRG_COOR_DISABLE_COUNT        ! 32 Scaler * (2+30) bits' ) ;
  write_sptrg_sbsc_vetos ( vetonum := 5 ) ;
  WRITELN ( begin_run_file, '\END' ) ;
  WRITELN ( begin_run_file, '\ARRAY  SPTRG_AUTODIS_VETO_COUNT        ! 32 Scaler * (2+30) bits' ) ;
  write_sptrg_sbsc_vetos ( vetonum := 6 ) ;
  WRITELN ( begin_run_file, '\END' ) ;
  WRITELN ( begin_run_file, '\ARRAY  SPTRG_BEAMX_INDICATOR_COUNT     ! 32 Scaler * (2+30) bits' ) ;
  write_sptrg_sbsc_vetos ( vetonum := 7 ) ;
  WRITELN ( begin_run_file, '\END' ) ;

  WRITELN ( begin_run_file, '\ARRAY  SPTRG_PRESCALER_RATIO  ! 32 ratios (up to 24 bits each) ' ) ;
  FOR sptrgnum := 0 TO 31
  DO WRITELN ( begin_run_file, CONVERT(STRING(9),sptrg[sptrgnum]^.prscratio) ) ;
  WRITELN ( begin_run_file, '\END' ) ;
  
  WRITELN ( begin_run_file, '\STOP' ) ;

END ;
{ ************************************************************************* }
[INLINE] PROCEDURE write_sptrg_sbsc_vetos ( vetonum : INTEGER ) ;
VAR
  st_fd         : sptrg_per_fstd ;
  relst         : INTEGER ;
  scalernum     : INTEGER ;
BEGIN

  FOR st_fd := st_0_3 TO st_28_31
  DO FOR relst := 0 TO 3
  DO BEGIN 
    scalernum := 31 - 8 * relst - vetonum ;
    WRITELN ( begin_run_file, CONVERT(STRING(6),sbsc_veto_data[st_fd,scalernum].high_2) 
                            + CONVERT(STRING(13),sbsc_veto_data[st_fd,scalernum].low_30) ) ;
  END ;

END ;
{ ************************************************************************* }
PROCEDURE init_begin_end_run ;

VAR 
 status : INTEGER;                         {general use status buffer}

BEGIN

  host_name := get_host_address ;

  CREATE_SEMAPHORE ( begin_end_run_is_idle, 0, 1, STATUS := status ) ;
  handle_trc_sta ( TAG := 'CRE/SEM%' + tagext, STATUS := status ) ;

  CREATE_SEMAPHORE ( start_new_begin_end_run, 0, 1, STATUS := status ) ;
  handle_trc_sta ( TAG := 'CRE/SEM%' + tagext, STATUS := status ) ;

{ allocate memory for IO arguments                                      ***** }
  NEW ( param ) ;

  begin_end_run_request.file_name        := '' ;
  begin_end_run_request.file_type        := '' ;
  begin_end_run_request.processing_phase := done ;
  begin_end_run_request.status           := 1 ;
  begin_end_run_request.decoded_status   := '' ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE create_begin_end_run ( VAR status :[OPTIONAL] status_type ) ;

VAR 
  eln_status      : INTEGER;                         {general use status buffer}
  data_base_error : BOOLEAN ;
  check_entry   : INTEGER ;
  scan_entry    : INTEGER ;
  dbsc_pointer  :^dbsc_foreign_card ; 
  channel       : INTEGER ;
  from_chan     : INTEGER ;
  to_chan       : INTEGER ;
  data_index    : INTEGER ;
  sbsc_pointer  :^sbsc_card ;
BEGIN

  IF PRESENT(status) THEN status := ok ;

  IF ( begin_end_run_exists = TRUE ) 
  THEN BEGIN
    handle_trc_sys ( TAG := tag, 
                 MESSAGE := ' Begin/End Run Task Already Active' ) ;
    GOTO end_create_bert ;
  END ;

  data_base_error := FALSE ;

  FOR check_entry := 1 TO entry_count
  DO CASE entry_list[check_entry]^.entry_type OF 

    ber_dbsc : 
    BEGIN
  
      dbsc_pointer   := entry_list[check_entry]^.dbsc_card ;
      channel        := entry_list[check_entry]^.channel ;
      data_index     := entry_list[check_entry]^.data_index ;  

      IF ( ( channel > 3 ) OR ( channel < 0 ) )
      THEN BEGIN
        handle_trc_err ( TAG := tag, 
                     MESSAGE := ' Corrupted Channel number in DBSC Beg/End Run Entry '
                              + '#' + CONVERT(STRING(3),check_entry) ) ; 
        data_base_error := TRUE ;
      END ;
      

      FOR scan_entry := 1 TO check_entry-1
      DO CASE entry_list[scan_entry]^.entry_type OF 
        ber_dbsc : 
        BEGIN

          IF ( ( dbsc_pointer = entry_list[scan_entry]^.dbsc_card ) 
           AND ( channel      = entry_list[scan_entry]^.channel ) ) 
          THEN BEGIN
            handle_trc_err ( TAG := tag, 
                         MESSAGE := ' Duplicate DBSC Beg/End Run Entries '
                                  + '#' + CONVERT(STRING(3),check_entry) 
                                  + '/' + CONVERT(STRING(3),scan_entry) ) ; 
            data_base_error := TRUE ;
          END ;

          IF ( data_index < entry_list[scan_entry]^.data_index ) 
          THEN BEGIN
            handle_trc_err ( TAG := tag, 
                         MESSAGE := ' Corrupted Beg/End Run Entries '
                                  + '#' + CONVERT(STRING(3),check_entry) 
                                  + '/' + CONVERT(STRING(3),scan_entry) ) ; 
            data_base_error := TRUE ;
          END ;

        END ;
        ber_sbsc : 
        BEGIN

          IF ( dbsc_pointer = entry_list[scan_entry]^.dbsc_card ) 
          THEN BEGIN
            handle_trc_err ( TAG := tag, 
                         MESSAGE := ' Corrupted Beg/End Run Entries '
                                  + '#' + CONVERT(STRING(3),check_entry) 
                                  + '/' + CONVERT(STRING(3),scan_entry) ) ; 
            data_base_error := TRUE ;
          END ;

        END ;
      END ;
    END ;
    ber_sbsc : 
    BEGIN
  
      sbsc_pointer   := entry_list[check_entry]^.sbsc_card ;
      data_index     := entry_list[check_entry]^.data_index ;  
      from_chan      := entry_list[check_entry]^.from_chan ;
      to_chan        := entry_list[check_entry]^.to_chan ;

      IF ( ( from_chan > 31 ) OR ( from_chan < 0 ) 
        OR ( to_chan   > 31 ) OR ( to_chan   < 0 ) )
      THEN BEGIN
        handle_trc_err ( TAG := tag, 
                     MESSAGE := ' Corrupted Channel number in SBSC Beg/End Run Entry '
                              + '#' + CONVERT(STRING(3),check_entry) ) ; 
        data_base_error := TRUE ;
      END ;

      FOR scan_entry := 1 TO check_entry-1
      DO CASE entry_list[scan_entry]^.entry_type OF 
        ber_dbsc : 
        BEGIN

          IF ( sbsc_pointer = entry_list[scan_entry]^.sbsc_card ) 
          THEN BEGIN
            handle_trc_err ( TAG := tag, 
                         MESSAGE := ' Corrupted Beg/End Run Entries '
                                  + '#' + CONVERT(STRING(3),check_entry) 
                                  + '/' + CONVERT(STRING(3),scan_entry) ) ; 
            data_base_error := TRUE ;
          END ;
        END ;
        ber_sbsc : 
        BEGIN

          IF ( ( sbsc_pointer = entry_list[scan_entry]^.sbsc_card ) 
           AND ( from_chan    = entry_list[scan_entry]^.from_chan ) 
           AND ( to_chan      = entry_list[scan_entry]^.to_chan ) )
          THEN BEGIN
            handle_trc_err ( TAG := tag, 
                         MESSAGE := ' Duplicate SBSC Beg/End Run Entries '
                                  + '#' + CONVERT(STRING(3),check_entry) 
                                  + '/' + CONVERT(STRING(3),scan_entry) ) ; 
            data_base_error := TRUE ;
          END ;

          IF ( data_index < entry_list[scan_entry]^.data_index ) 
          THEN BEGIN
            handle_trc_err ( TAG := tag, 
                         MESSAGE := ' Corrupted Beg/End Run Entries '
                                  + '#' + CONVERT(STRING(3),check_entry) 
                                  + '/' + CONVERT(STRING(3),scan_entry) ) ; 
            data_base_error := TRUE ;
          END ;
       END ;

     END ;

    END ;

    OTHERWISE BEGIN
      handle_trc_err ( TAG := tag, 
                   MESSAGE := ' Beg/End Run Database Corrupted Entry #' 
                            + '/' + CONVERT(STRING(3),check_entry) ) ; 
      data_base_error := TRUE ;
    END ;
  END ;

  IF ( data_base_error = TRUE ) 
  THEN BEGIN
    handle_trc_err ( TAG := tag, 
                 MESSAGE := ' Error in Beg/End Run Database, Task NOT Created' ) ; 
    IF PRESENT(status) THEN status := error_found ;
    GOTO end_create_bert ;
  END ;

  handle_trc_sys ( TAG := tag, 
               MESSAGE := ' Create Task Write Begin/End Run File' ) ;

  CREATE_PROCESS ( proc_begin_end_run, block_begin_end_run, STATUS := eln_status );
  handle_trc_sta ( TAG := 'CRE/PRC%' + tagext,  STATUS := eln_status ) ;
 
  KER$NAME_OBJECT ( name_begin_end_run, 'BEG/END_RUN', proc_begin_end_run, 
                  STATUS := eln_status ) ;
  handle_trc_sta ( TAG := 'NAM/PRC%' + tagext, STATUS := eln_status ) ;

{ raise the priority of the process to write the begin/end run file ASAP }
  SET_PROCESS_PRIORITY ( proc_begin_end_run, 7, STATUS := eln_status );
  handle_trc_sta ( TAG := 'SET/PIO%' + tagext, STATUS := eln_status ) ;

  begin_end_run_exists := TRUE ;


end_create_bert:
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE delete_begin_end_run ;

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

  handle_trc_sys ( TAG := tag, 
               MESSAGE := ' Delete Task Write Begin/End Run File' ) ;

  lock_console ;
  SIGNAL ( proc_begin_end_run, STATUS := status ) ;
  unlock_console ;
  handle_trc_sta ( TAG := 'SIG/PRC%' + tagext, STATUS := status ) ;

  DELETE ( name_begin_end_run, STATUS := status );
  handle_trc_sta ( TAG := 'DEL/NAM%' + tagext, STATUS := status ) ;

{ release memory for IO arguments                                      ***** }
  DISPOSE ( param ) ;

  begin_end_run_exists := FALSE ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE add_beg_end_run_dbsc ( entry_name : STRING(32) ; 
                                       card :^dbsc_foreign_card ; 
                                    channel : INTEGER ; 
                                 VAR status :[OPTIONAL] status_type ) ;
VAR
  step_status : status_type ;

BEGIN

  step_status := ok ;

  IF ( dbsc_count = max_dbsc ) 
  THEN BEGIN 
    step_status := error_found ;
    handle_trc_err ( TAG := tag, 
                 MESSAGE := ' Too many Begin/End Run DBSC entries defined ' ) ;
    GOTO quit_add_dbsc ;
  END ;

  IF ( entry_count = max_entry ) 
  THEN BEGIN 
    step_status := error_found ;
    handle_trc_err ( TAG := tag, 
                 MESSAGE := ' Too many Begin/End Run total entries defined ' ) ;
    GOTO quit_add_dbsc ;
  END ;

  IF ( entry_name = ' ' ) 
  THEN BEGIN 
    step_status := error_found ;
    handle_trc_err ( TAG := tag, 
                 MESSAGE := ' No name defined for Begin/End Run DBSC entry ' ) ;
    GOTO quit_add_dbsc ;
  END ;

  handle_trc_inf ( TAG := tag, 
               MESSAGE := ' Adding Begin/End Run DBSC entry ' + entry_name ) ;

  dbsc_count  := dbsc_count  + 1 ;
  entry_count := entry_count + 1 ;

  NEW ( dbsc_data[dbsc_count] ) ;
  NEW ( entry_list[entry_count] ) ;

  entry_list[entry_count]^.entry_type := ber_dbsc ;
  entry_list[entry_count]^.RCP_name   := entry_name ;
  entry_list[entry_count]^.data_index := dbsc_count ;
  entry_list[entry_count]^.dbsc_card  := card ;
  entry_list[entry_count]^.channel    := channel ;

quit_add_dbsc:
  IF PRESENT(status) THEN status := step_status ;
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE add_beg_end_run_sbsc ( entry_name : STRING(32) ; 
                                       card : ^sbsc_card ;
                                  from_chan : INTEGER ;
                                    to_chan : INTEGER ;
                                 VAR status :[OPTIONAL] status_type ) ;
VAR
  step_status : status_type ;

BEGIN

  step_status := ok ;

  IF ( sbsc_count = max_sbsc ) 
  THEN BEGIN 
    step_status := error_found ;
    handle_trc_err ( TAG := tag, 
                 MESSAGE := ' Too many Begin/End Run SBSC entries defined ' ) ;
    GOTO quit_add_sbsc ;
  END ;

  IF ( entry_count = max_entry ) 
  THEN BEGIN 
    step_status := error_found ;
    handle_trc_err ( TAG := tag, 
                 MESSAGE := ' Too many Begin/End Run total entries defined ' ) ;
    GOTO quit_add_sbsc ;
  END ;

  IF ( entry_name = ' ' ) 
  THEN BEGIN 
    step_status := error_found ;
    handle_trc_err ( TAG := tag, 
                 MESSAGE := ' No name defined for Begin/End Run entry ' ) ;
    GOTO quit_add_sbsc ;
  END ;

  handle_trc_inf ( TAG := tag, 
               MESSAGE := ' Adding Begin/End Run SBSC entry ' + entry_name ) ;

  sbsc_count  := sbsc_count  + 1 ;
  entry_count := entry_count + 1 ;

  NEW ( sbsc_data[sbsc_count] ) ;
  NEW ( entry_list[entry_count] ) ;

  entry_list[entry_count]^.entry_type := ber_sbsc ;
  entry_list[entry_count]^.RCP_name   := entry_name ;
  entry_list[entry_count]^.data_index := sbsc_count ;
  entry_list[entry_count]^.sbsc_card  := card ;
  entry_list[entry_count]^.from_chan  := from_chan ;
  entry_list[entry_count]^.to_chan    := to_chan ;

quit_add_sbsc:
  IF PRESENT(status) THEN status := step_status ;
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE show_beg_end_run_entries ;
VAR 
  entry_num     : INTEGER ;
  dbsc_pointer  :^dbsc_foreign_card ; 
  channel       : INTEGER ;
  from_chan     : INTEGER ;
  to_chan       : INTEGER ;
  reg_pointer   :^cbus_register ; 
  data_index    : INTEGER ;
  sbsc_pointer  :^sbsc_card ;
BEGIN

  handle_trc_sys ( TAG := tag, 
               MESSAGE := ' Begin Beg/End Run List has ' 
                        + CONVERT(STRING,entry_count) 
                        + ' entries = '
                        + CONVERT(STRING,dbsc_count) 
                        + ' DBSC + '
                        + CONVERT(STRING,sbsc_count) 
                        + ' SBSC ' ) ; 

  FOR entry_num := 1 TO entry_count
  DO CASE entry_list[entry_num]^.entry_type OF 

    ber_dbsc : 
    BEGIN
  
      dbsc_pointer   := entry_list[entry_num]^.dbsc_card ;
      channel        := entry_list[entry_num]^.channel ;
      reg_pointer    := ADDRESS(dbsc_pointer^.scaler_resetreg[channel]) ;
      data_index     := entry_list[entry_num]^.data_index ;  

      handle_trc_inf ( TAG := tag, 
                   MESSAGE := ' DBSC Entry ' 
                            + '#' + CONVERT(STRING(3),entry_num) 
                            + '/' + CONVERT(STRING(3),data_index) 
                            + ' ' + entry_list[entry_num]^.RCP_name
                            + '@ ' +  CONVERT(STRING,dbsc_pointer^.cbus)
                            + '/'  + CONVERT(STRING,dbsc_pointer^.mba)
                            + '/'  + CONVERT(STRING,dbsc_pointer^.ca) 
                            + ' ch#' + CONVERT(STRING,channel) );

    END ;
    ber_sbsc : 
    BEGIN
  
      sbsc_pointer   := entry_list[entry_num]^.sbsc_card ;
      from_chan      := entry_list[entry_num]^.from_chan ;
      to_chan        := entry_list[entry_num]^.to_chan ;
      data_index     := entry_list[entry_num]^.data_index ;  
      handle_trc_inf ( TAG := tag, 
                   MESSAGE := ' SBSC Entry ' 
                            + '#' + CONVERT(STRING(3),entry_num) 
                            + '/' + CONVERT(STRING(3),data_index) 
                            + ' ' + entry_list[entry_num]^.RCP_name
                            + '@ ' +  CONVERT(STRING,dbsc_pointer^.cbus)
                            + '/'  + CONVERT(STRING,dbsc_pointer^.mba)
                            + '/'  + CONVERT(STRING,dbsc_pointer^.ca) 
                            + ' ch#' + CONVERT(STRING,from_chan) 
                            + '/' + CONVERT(STRING,to_chan) );

    END ;

    OTHERWISE handle_trc_err ( TAG := tag, 
                          MESSAGE := ' Beg/End Run Database Illegal Entry #' 
                                    + '/' + CONVERT(STRING(3),entry_num) 
                                    + ' code ' + CONVERT(
                                       STRING,
                                       ORD(entry_list[entry_num]^.entry_type) ) ) ; 
  END ;

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