{ *************************************************************************** }
MODULE mod_handle_dble_buff ;
{  Created   27-SEP-1989  MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE }
{ *************************************************************************** }
INCLUDE
  mod_common_global_flags,
  mod_handle_tracing,
  mod_common_hard_io,                 {from the TRICS hardware IO library     }
  mod_tcs_io_drv11j_handling,
  mod_tcs_io_comint_handling,
  mod_io_allocation_handling,
  $KERNEL ;                           {from ELN$:RTLOBJECT.OLB                }
{ *************************************************************************** }
EXPORT
  proc_watch_dbl_buff,  {PROCESS watching double buffering synchronization    }
  synch_double_buffer,  {PROCEDURE reset comint card, synchro double buffer   }
  init_watch_dble_buff ;{PROCEDURE start process for double buffering synch   }
{ *************************************************************************** }
IMPORT
  status_type,                        {from module MOD_COMMON_GLOBAL_FLAGS    }
  ok,{already_done,}io_failure,       {from module MOD_COMMON_GLOBAL_FLAGS    }

  handle_trc_sta,                     {from module MOD_HANDLE_TRACING         }
  handle_trc_sys,                     {from module MOD_HANDLE_TRACING         }
  handle_trc_inf,                     {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         }

  dev_drv11j_pilot,                   {from module MOD_COMMON_HARD_IO         }
 {PORTA, PORTB,}PORTC,{PORTD,}        {from module MOD_COMMON_HARD_IO         }
  comint_stat,                        {from module MOD_COMMON_HARD_IO         }
  reg_drv11j_pilot,                   {from module MOD_COMMON_HARD_IO         }

  proced_tcs_enb_int,                 {from module MOD_TCS_IO_DRV11J_HANDLING }

  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_read_status,             {from module MOD_TCS_IO_COMINT_HANDLING }
  proced_tcs_toggle_buffer,           {from module MOD_TCS_IO_COMINT_HANDLING }

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

  KER$NAME_OBJECT ;                   {from module $KERNEL                    }

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

  %INCLUDE 'SITE_DEPENDENT.CST/LIST'

VAR

  tag : VARYING_STRING(8) := 'DBL/BUF%' ;
  proc_watch_dbl_buff : PROCESS ;
  name_watch_dbl_buff : NAME ;

{ *************************************************************************** }
{ *************************************************************************** }
PROCEDURE   init_watch_dble_buff ;

VAR  status : INTEGER ;

BEGIN

  CREATE_PROCESS ( proc_watch_dbl_buff,
                   block_watch_double_buffering,
                   STATUS := status ) ;
  handle_trc_sta ( TAG := 'CRE/PRC%watch_db%', STATUS := status ) ;

  KER$NAME_OBJECT( name_watch_dbl_buff,
                  'WATCH DBL BUF',
                   proc_watch_dbl_buff, 
                   STATUS := status ) ;
  handle_trc_sta ( TAG := 'NAM/PRC%watch_db%', STATUS := status ) ;

{ raise the priority of the process to correct the overwriting problem ASAP }
  SET_PROCESS_PRIORITY ( proc_watch_dbl_buff, 
                         7, 
                         STATUS := status );
  handle_trc_sta ( TAG := 'SET/PIO%watch_db%', STATUS := status ) ;

END ;
{ *************************************************************************** }
{ *************************************************************************** }
PROCESS_BLOCK block_watch_double_buffering ;

VAR  

  stawai : INTEGER ;
  status : status_type ;
  tagext : VARYING_STRING(8) := 'intrpt%' ;

BEGIN                   

  handle_trc_sys ( TAG := tag + tagext, 
               MESSAGE := ' Start Watching Double Buffering'
                          + ' Synchronization ' ) ;

  ESTABLISH ( exchand_watch_dbl_buff ) ;

REPEAT

  proced_tcs_enb_int ( reg_drv11j_pilot, PortC ) ;  

  synch_double_buffer ( STATUS := status, TAGEXT := tagext ) ;

  IF ( status = io_failure ) 
  THEN BEGIN
    handle_trc_sys ( TAG := tag + tagext, 
                 MESSAGE := ' Suspend Watching Double Buffering'
                          + ' Synchronization ' ) ;
    wait_any ( time := - 50000000 ) ;
  END ;
  
  handle_trc_sys ( TAG := tag + tagext, 
               MESSAGE := ' Restart Watching Double Buffering'
                          + ' Synchronization ' ) ;

  WAIT_ANY ( dev_drv11j_pilot[PortC], STATUS := stawai ) ;
  IF ( stawai <> 1 ) 
  THEN handle_trc_sta ( TAG := tag, STATUS := stawai ) ;

UNTIL FALSE ; { forever }

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

{*** this declaration is also repeated as EXTERNAL in mod_tst_init        *** }
{***                                           and in mod_coor_global_execute }
{*** remember to propagate any change                                     *** }

VAR

  comint_status : comint_stat ;

BEGIN
  
  IF PRESENT(status) THEN status := ok ;

  {deallocate trigger IO that might belong to another process}
  deallocate_trigger ( TAGEXT := tag+tagext, 
                       REPORT := FALSE ) ;
  {allocate trigger IO to prevent other processes from doing programmed IO}
  allocate_trigger (   TAGEXT := tag+tagext, 
                    CALLER_ID := ADDRESS(comint_status), 
                       REPORT := FALSE);

  {allow the data blocks currently queued-up to complete}
  proced_tcs_pause ;
  proced_tcs_reset_comint ;

  proced_tcs_read_status ( reg_drv11j_pilot, COMINT_STATUS := comint_status ) ;

  IF ( comint_status.bufrab <> comint_status.bufwab ) 
  THEN proced_tcs_toggle_buffer ;

  handle_trc_sys ( TAG := tag + tagext, 
               MESSAGE := ' TRICS has Re-Synchronized Double Buffering ' ) ;

  proced_tcs_read_status ( reg_drv11j_pilot, COMINT_STATUS := comint_status ) ;
  proced_tcs_resume ;

  deallocate_trigger ( TAGEXT := tag+tagext, 
                       REPORT := FALSE ) ;

  IF ( comint_status.bufrab <> comint_status.bufwab ) 
  THEN BEGIN
    IF PRESENT(status) THEN status := io_failure ;
    handle_trc_err ( TAG := tag + tagext, 
                 MESSAGE := ' Failure Synchronizing Double Buffer ' ) ;
  END
  ELSE BEGIN
    handle_trc_inf ( TAG := tag + tagext, 
                 MESSAGE := ' Success Synchronizing Double Buffer ' ) ;
  END ;

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

BEGIN
  set_trc_exc_mode ( TRUE ) ;

  deallocate_trigger ;

  exchand_watch_dbl_buff := handle_exception ( TAG := 'DBL/EXC%', 
                                          EXC_CODE := signal_args.name ) ;
  set_trc_exc_mode ( FALSE ) ;
END ;
{ *************************************************************************** }
{ *************************************************************************** }
END.