{ *************************************************************************** }
MODULE mod_coor_global_execute ;
{  Created  28-APR-1989 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE   }
{ *************************************************************************** }
INCLUDE
  mod_common_global_flags,
  mod_common_parse,
  mod_common_soft_conn,
  mod_def_physics_tables,
  mod_handle_tracing,
  mod_handle_mail,
  mod_io_allocation_handling,
  mod_handle_ZRL,
  mod_handle_l15ct,
  mod_init_cbus_cards,
  mod_init_sptrg,
  mod_init_geosec,
  mod_init_globals,
  mod_init_trgtwr,
  mod_init_thresholds,
  mod_init_auxi,
  mod_handle_begin_end_run,
  mod_parse_global,
  mod_parse_detail,
  mod_common_hard_io,                 {from the TRICS hardware IO library     }
  mod_tcs_io_comint_handling,         {from the TRICS hardware IO library     }
  mod_tcs_io_drv11j_handling ;        {from the TRICS hardware IO library     }
{ *************************************************************************** }
EXPORT

  coor_initialize,   {PROCEDURE initialize framework (e.g.after power off)    }
  coor_stop,         {PROCEDURE release all specific triggers                 }
  coor_pause,        {PROCEDURE force data block builder full line            }
  coor_resume,       {PROCEDURE release data block builder full line          }
  coor_l1_obey_l15,  {PROCEDURE make L1 framework obey L1.5 framework control }
  coor_l1_ignore_l15,{PROCEDURE make L1 framework ignore L1.5 framework       }
  coor_wrt_host_file,{PROCEDURE initiate write begin/end run file             }
  coor_wrt_synchro,  {PROCEDURE verify write begin/end run completed          }
  coor_load_acqbandw;{PROCEDURE load use of acquisition bandwidth for autotune}
{ *************************************************************************** }
IMPORT

  framework_state,                    {from module MOD_COMMON_GLOBAL_FLAGS    }
  running, paused,                    {from module MOD_COMMON_GLOBAL_FLAGS    }
  L1_obey_L15,                        {from module MOD_COMMON_GLOBAL_FLAGS    }
  status_type,                        {from module MOD_COMMON_GLOBAL_FLAGS    }
 {ok, already_done,}io_failure,       {from module MOD_COMMON_GLOBAL_FLAGS    }
  boot_directory_name,                {from module MOD_COMMON_GLOBAL_FLAGS    }

  parse_status,                       {from module MOD_COMMON_PARSE           }
  parse_failure,                      {from module MOD_COMMON_PARSE           }
  Parse_asserted, Parse_no_par_found, {from module MOD_COMMON_PARSE           }
  parsed_command, command_count,      {from module MOD_COMMON_PARSE           }

  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_sys,                     {from module MOD_HANDLE_TRACING         }
  handle_trc_err,                     {from module MOD_HANDLE_TRACING         }

  reqstmsg,replymsg,                  {From module MOD_COMMON_SOFT_CONN       }
  con_served,                         {from module MOD_COMMON_SOFT_CONN       }

  send_mail,                          {from module MOD_MAILER                 }

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

  targ_acqbandw,                      {from module MOD_DEF_PHYSICS_TABLES     }

  reset_ZRL_and_DRV11Js,              {from module MOD_HANDLE_ZRL             }

  Init_L15CT_Progr,                   {from module MOD_HANDLE_L15CT           }

  init_cbus_cards,                    {from module MOD_INIT_CBUS_CARDS        }
                       
  init_all_geosec,                    {from module MOD_INIT_GEOSEC            }
  restore_all_geosec,                 {from module MOD_INIT_GEOSEC            }

  init_all_sptrg,                     {from module MOD_INIT_SPTRG             }
  restore_all_sptrg,                  {from module MOD_INIT_SPTRG             }

  init_all_trgtwr,                    {from module MOD_INIT_TRGTWR            } 
  init_all_LgTile,                    {from module MOD_INIT_TRGTWR            } 
  restore_all_trgtwr,                 {from module MOD_INIT_TRGTWR            } 
  restore_all_LgTile,                 {from module MOD_INIT_TRGTWR            } 

  load_tree_corrections,              {from module MOD_INIT_THRESHOLDS        }
  load_momentum_lookup,               {from module MOD_INIT_THRESHOLDS        }
  init_all_thresholds,                {from module MOD_INIT_THRESHOLDS        }
  restore_all_thresholds,             {from module MOD_INIT_THRESHOLDS        }
  
  init_auxi,                          {from module MOD_INIT_AUXI              }

  init_global_scalers,                {from module MOD_INIT_GLOBALS           }

  initiate_write_host_file,           {from module MOD_HANDLE_BEGIN_END_RUN   }
  synchronize_wrt_host,               {from module MOD_HANDLE_BEGIN_END_RUN   }
  begin_end_run_phases, collect_data, open_file, write_file, close_file, done,

  true_length,                        {from module MOD_PARSE_GLOBAL           }

  bad_format, bad_param, bad_failure, {from module MOD_PARSE_DETAIL           }
  inline_check_command_count,         {from module MOD_PARSE_DETAIL           }
  inline_check_object_in_range,       {from module MOD_PARSE_DETAIL           }
  inline_check_object_has_no_item,    {from module MOD_PARSE_DETAIL           }
  inline_check_object_asserted,       {from module MOD_PARSE_DETAIL           }

  cbus_param_list,                    {from module MOD_COMMON_HARD_IO         }
 {PORTA, PORTB,}PORTC,{PORTD,}        {from module MOD_COMMON_HARD_IO         }
  reg_drv11j_pilot,                   {from module MOD_COMMON_HARD_IO         }

  proced_tcs_reset_comint,            {from module MOD_TCS_IO_COMINT_HANDLING }
  proced_tcs_pause,                   {from module MOD_TCS_IO_COMINT_HANDLING }
  proced_tcs_resume,                  {from module MOD_TCS_IO_COMINT_HANDLING }
  proced_tcs_disable_db_builder,      {from module MOD_TCS_IO_COMINT_HANDLING }
  proced_tcs_release_dbbuilder,       {from module MOD_TCS_IO_COMINT_HANDLING }

  proced_tcs_enb_int ;                {from module MOD_TCS_IO_DRV11J_HANDLING }

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

  %INCLUDE 'SITE_DEPENDENT.CST/LIST'

VAR   

  tag             : VARYING_STRING(8) := 'PRS/CHK%' ;

{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE coor_initialize ( restore : BOOLEAN := FALSE ) ;

VAR

  status : status_type ;
  inipar :^cbus_param_list ; 
  tagext : VARYING_STRING(8) ;

BEGIN

  inline_check_command_count ( TOTAL := 0 ) ;
  IF ( parse_status = parse_failure ) THEN GOTO quit_initialize ;

  IF ( restore = TRUE ) 
  THEN BEGIN 
    tagext := 'restore%' ;
    handle_trc_sys ( TAG := tag, 
                 MESSAGE := ' COOR Restoring Trigger Programming' ) ;
    send_mail (  SUBJECT := ' COOR Restoring Trigger Programming' ) ;
  END 
  ELSE BEGIN
    tagext := 'COORini%' ;
    handle_trc_sys ( TAG := tag, 
                 MESSAGE := ' COOR Initializing Trigger' ) ;
     send_mail ( SUBJECT := ' COOR Initializing Trigger' ) ;
  END ;

  NEW ( inipar ) ;

  framework_state := paused ; {the system is not running, there is no need }
                              {to reset comint if no data blocks are coming}

 {steal the allocation if necessary }
  deallocate_trigger ( TAGEXT := tagext ) ;
  allocate_trigger ( TAGEXT := tagext, CALLER_ID := inipar ) ;

 {reset pQBA and PVBA devices, re-program DRV11Js, reload VME mapping params }
  reset_ZRL_and_DRV11Js ;

  proced_tcs_pause ( status ) ;
  IF ( status = io_failure ) THEN bad_failure ;

  proced_tcs_disable_db_builder ;
  proced_tcs_reset_comint ;

  init_cbus_cards ( STATUS := status, TAGEXT := tagext, INIPAR := inipar ) ;
    IF ( status = io_failure ) THEN bad_failure ;

  IF ( restore = TRUE ) 
  THEN BEGIN 

    restore_all_sptrg ( STATUS := status, TAGEXT := tagext, INIPAR := inipar ) ;
    IF ( status = io_failure ) THEN bad_failure ;

    restore_all_geosec ( STATUS := status, TAGEXT := tagext, INIPAR := inipar ) ;
    IF ( status = io_failure ) THEN bad_failure ;

    restore_all_trgtwr ( STATUS := status, TAGEXT := tagext, INIPAR := inipar ) ;
    IF ( status = io_failure ) THEN bad_failure ;

    restore_all_LgTile ( STATUS := status, TAGEXT := tagext, INIPAR := inipar ) ;
    IF ( status = io_failure ) THEN bad_failure ;

    restore_all_thresholds ( STATUS := status, TAGEXT := tagext, INIPAR := inipar ) ;
    IF ( status = io_failure ) THEN bad_failure ;

  END 
  ELSE BEGIN

    Init_L15CT_Progr ;

    L1_Obey_l15 := FALSE ;

    init_all_sptrg ( STATUS := status, TAGEXT := tagext, INIPAR := inipar ) ;
    IF ( status = io_failure ) THEN bad_failure ;

    init_all_geosec ( STATUS := status, TAGEXT := tagext, INIPAR := inipar ) ;
    IF ( status = io_failure ) THEN bad_failure ;

    init_all_trgtwr ( STATUS := status, TAGEXT := tagext, INIPAR := inipar ) ;
    IF ( status = io_failure ) THEN bad_failure ;

    init_all_LgTile ( STATUS := status, TAGEXT := tagext, INIPAR := inipar ) ;
    IF ( status = io_failure ) THEN bad_failure ;

    init_all_thresholds ( STATUS := status, TAGEXT := tagext, INIPAR := inipar ) ;
    IF ( status = io_failure ) THEN bad_failure ;

  END ;

  load_momentum_lookup ( STATUS := status, TAGEXT := tagext, INIPAR := inipar ) ;
  IF ( status = io_failure ) THEN bad_failure ;

  load_tree_corrections ( STATUS := status, TAGEXT := tagext, INIPAR := inipar ) ;
  IF ( status = io_failure ) THEN bad_failure ;

  init_global_scalers ( STATUS := status, TAGEXT := tagext , INIPAR := inipar );
  IF ( status = io_failure ) THEN bad_failure ;

  DISPOSE ( inipar ) ;
  deallocate_trigger ( TAGEXT := tagext ) ;

  init_auxi ( FILENAME := boot_directory_name + aux_init_filename, 
                STATUS := status, 
                TAGEXT := tagext ) ;
    IF ( status = io_failure ) THEN bad_failure ;

  init_auxi ( FILENAME := boot_directory_name + aux_init_L15CT_filename, 
                STATUS := status, 
                TAGEXT := tagext ) ;
    IF ( status = io_failure ) THEN bad_failure ;
  
  { Synchronize Double Buffering }
  synch_double_buffer ( STATUS := status, TAGEXT := tagext ) ; 
    IF ( status = io_failure ) THEN bad_failure ; 

  { force re-enable device interrupts from the watch double buffer circuitry}
  IF ( watch_dbl_buff_ok = TRUE ) 
  THEN proced_tcs_enb_int ( reg_drv11j_pilot, PortC ) ;  
 
  {restore obeying L1.5 framework if necessary}
  IF ( L1_Obey_l15 = TRUE ) THEN coor_l1_obey_l15 ;

  proced_tcs_release_dbbuilder ;

  framework_state := running ;

  IF ( replymsg[con_served]^.replystat <> '      OK' ) 
  THEN BEGIN 
    handle_trc_sys ( TAG := tag, 
                 MESSAGE := ' Problem with Initialization, BAD sent to COOR' ) ;
    send_mail (  ADDRESS := mail_alert_1 + mail_alert_2 + mail_alert_3,
                 SUBJECT := ' Problem with Initialization, BAD sent to COOR' ) ;
  END ;

quit_initialize:
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE synch_double_buffer ( tagext : VARYING_STRING(16) := '' ;
                            VAR status :[OPTIONAL] status_type ) ; 
EXTERNAL ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE coor_stop ;

BEGIN

  inline_check_command_count ( TOTAL := 0 ) ;
  IF ( parse_status = parse_failure ) THEN GOTO quit_stop ;

  handle_trc_sys ( TAG := tag, 
               MESSAGE := ' COOR Stopping ' ) ;

  proced_tcs_pause ;
  framework_state := paused ;
  init_all_sptrg ;
  proced_tcs_resume ;
  framework_state := running ;

quit_stop :
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE coor_pause ;
VAR status : status_type ;
BEGIN

  inline_check_command_count ( TOTAL := 0 ) ;
  IF ( parse_status = parse_failure ) THEN GOTO quit_pause ;

  handle_trc_sys ( TAG := tag,
               MESSAGE := ' COOR Forces Framework Pause ' ) ;

  proced_tcs_pause ( status ) ;
  IF ( status = io_failure ) THEN bad_failure ;

  framework_state := paused ;

quit_pause:
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE coor_resume ;

BEGIN

  inline_check_command_count ( TOTAL := 0 ) ;
  IF ( parse_status = parse_failure ) THEN GOTO quit_resume ;

  handle_trc_sys ( TAG := tag,
               MESSAGE := ' COOR Lets Framework Resume ' ) ;

  proced_tcs_resume ;

  framework_state := running ;

quit_resume:
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE coor_l1_obey_l15 ;

BEGIN

  handle_trc_sys ( TAG := tag,
               MESSAGE := ' COOR Lets Level 1 Framework'
                        + ' Obey Level 1.5 Framewok ' ) ;

  proced_tcs_pause ;

  init_auxi ( FILENAME := boot_directory_name + l1_obey_l15_file ) ;

  IF ( framework_state = running ) THEN proced_tcs_resume ;

  L1_Obey_l15 := TRUE ;

END ;
{ *************************************************************************** }
PROCEDURE coor_l1_ignore_l15 ;

BEGIN

  handle_trc_sys ( TAG := tag,
               MESSAGE := ' COOR Lets Level 1 Framework'
                        + ' Ignore Level 1.5 Framewok ' ) ;

  proced_tcs_pause ;

  init_auxi ( FILENAME := boot_directory_name + l1_ignore_l15_file ) ;

  IF ( framework_state = running ) THEN proced_tcs_resume ;

  L1_Obey_l15 := FALSE ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE coor_wrt_host_file ( name : VARYING_STRING(12) ;
                           rcp_type : VARYING_STRING(12) ) ;

VAR 
  COMMAND    : INTEGER ;
  success    : BOOLEAN ;
  filename   : VARYING_STRING(80) ;
  length     : INTEGER ;
  first_char_at : INTEGER ;

BEGIN

  IF ( framework_state <> paused ) 
  THEN BEGIN 
    handle_trc_err ( TAG := tag,
                 MESSAGE := ' Framework must be Paused to Write '
                          + name + ' file ' ) ;
    replymsg[con_served]^.replystat := '     BAD' ;
    replymsg[con_served]^.replysupl := 'RUNGOING' ;
    GOTO quit_wrt_host_file ;
  END ;

  command := 1 ; { for use by bad_param, bad_failure }

  length := true_length( ADDRESS(reqstmsg[con_served]^.itemlist) ) ;

  IF ( length = 0 ) 
  THEN BEGIN
    handle_trc_err ( TAG := tag,
                 MESSAGE := ' Missing '
                          + name + ' File Name Argument ' ) ;
    bad_param ( COMMAND := command ) ;
    GOTO quit_wrt_host_file ;
  END ;

  filename := SUBSTR ( reqstmsg[con_served]^.itemlist, 1, length ) ;

  first_char_at := FIND_NONMEMBER ( filename, [' '] ) ;
  IF ( first_char_at <> 1 ) 
  THEN BEGIN
    length := length - first_char_at + 1 ;
    filename := SUBSTR ( filename, first_char_at, length ) ;
  END ;

  initiate_write_host_file ( FILENAME := filename, 
                                 NAME := name,
                             RCP_TYPE := rcp_type,
                              SUCCESS := success ) ;

  IF ( success = TRUE ) 
  THEN BEGIN
    replymsg[con_served]^.replystat := '      OK' ;
    replymsg[con_served]^.replysupl := 'INITIATE' ;
  END 
  ELSE BEGIN
    handle_trc_err ( TAG := tag,
                 MESSAGE := ' Error Initiating Write '
                          + name + ' file ' ) ;
    bad_failure ( COMMAND := command ) ;
  END ;

quit_wrt_host_file:
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE coor_wrt_synchro ;
VAR
  phase          : begin_end_run_phases ;            
  status         : INTEGER ;            
  decoded_status : VARYING_STRING(255) ;
  timeout        : BOOLEAN ;
  length         : INTEGER ;
  phase_string   : STRING(8) ;

BEGIN

  inline_check_command_count ( TOTAL := 0 ) ;
  IF ( parse_status = parse_failure ) THEN GOTO quit_synchro ;

  synchronize_wrt_host ( PHASE := phase,
                        STATUS := status,
                       DECODED := decoded_status,
                       TIMEOUT := timeout ) ;
                       
  IF ( timeout = TRUE ) 
  THEN BEGIN
    replymsg[con_served]^.replystat   := '     BAD' ;
    replymsg[con_served]^.replysupl   := ' TIMEOUT' ;
  END 
  ELSE IF ( phase <> done ) 
  THEN BEGIN
    replymsg[con_served]^.replystat   := '     BAD' ;
    CASE phase OF 
      collect_data  : replymsg[con_served]^.replysupl   := '    DATA' ;
      open_file     : replymsg[con_served]^.replysupl   := '    OPEN' ;
      write_file    : replymsg[con_served]^.replysupl   := '   WRITE' ;
      close_file    : replymsg[con_served]^.replysupl   := '   CLOSE' ;
    END ;    
    replymsg[con_served]^.replystring := decoded_status ;
  END ;    

quit_synchro:
END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE coor_load_acqbandw ;

BEGIN

  inline_check_command_count ( TOTAL := 1 ) ;
  inline_check_object_in_range ( COMMAND := 1, LOW := 1, HIGH := 100 ) ;
  inline_check_object_asserted ( COMMAND := 1 ) ;
  inline_check_object_has_no_item ( COMMAND := 1 ) ;

  IF ( parse_status = parse_failure ) THEN GOTO quit_laod_acqbandw ;

  IF ( inline_tracing(trace_info) <> 0 )
  THEN handle_trc_inf ( TAG := tag,
                    MESSAGE := ' COOR Specifies Acquisition Bandwidth '
                             + ' Used for Autotune to be ' 
                             + CONVERT(STRING,parsed_command^[1].objid)
                             + '%' ) ;

  targ_acqbandw := parsed_command^[1].objid ;

quit_laod_acqbandw :
END ;
{ *************************************************************************** }
{ *************************************************************************** }
END .