{ *************************************************************************** } MODULE mod_mpool_server ; { Created 11-JUL-1989 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE } { Modified 12-JUL-1991 add mpool server job logfile } { Modified 23-OCT-1991 add message for cross system monitoring } { and identification of calling user and process } { Modified 20-APR-1992 add message for cross system monitoring } { Modified 3-NOV-1992 add message for foreign scalers } { Modified 18-FEB-1993 use new exception handler routines and flush_to_file } { *************************************************************************** } INCLUDE mod_common_global_flags, mod_handle_console, mod_handle_logfile, mod_handle_tracing, mod_handle_shared_area, $MUTEX, {from ELN$:RTLOBJECT.OLB } TARGET, {From ITC Package D0$ITC:ELN_ITC.OLB} CONNECT, {ITC} WAIT, {ITC} GET, {ITC} MESSAGE_XFER, {ITC} GLOBAL ; {ITC} { *************************************************************************** } IMPORT framework_state_type, {from module MOD_COMMON_GLOBAL_FLAGS } find_console_lock, {from module MOD_HANDLE_CONSOLE } init_logfile, {from module MOD_HANDLE_LOGFILE } trace_info, ON, {from module MOD_HANDLE_TRACING } trace_error, {from module MOD_HANDLE_TRACING } handle_trc_sta, {from module MOD_HANDLE_TRACING } {handle_trc_inf,} {from module MOD_HANDLE_TRACING } handle_trc_err, {from module MOD_HANDLE_TRACING } handle_trc_sys, {from module MOD_HANDLE_TRACING } inline_time_now, {from module MOD_HANDLE_TRACING } init_flush_to_logfile, {from module MOD_HANDLE_TRACING } set_trc_exc_mode, {from module MOD_HANDLE_TRACING } handle_exception, {from module MOD_HANDLE_TRACING } find_area_lock, {from module MOD_HANDLE_SHARED_AREA } AREA_LOCK_VARIABLE, {from module $MUTEX } ELN$LOCK_AREA, {from module $MUTEX } ELN$UNLOCK_AREA, {from module $MUTEX } ITC_Target_ON, {from ITC module TARGET } ITC_Declare_Connect_Event, {from ITC module CONNECT } ITC_Declare_Receive_Event, {from ITC module CONNECT } ITC_Wait_Any, {from ITC module WAIT } ITC_GetPID, {from ITC module GET } ITC_Get_Net_Number, {from ITC module GET } ITC_Get_Node, {from ITC module GET } ITC_Find_Activity, {from ITC module MESSAGE_XFER } ITC_Read, {from ITC module MESSAGE_XFER } ITC_Write, {from ITC module MESSAGE_XFER } channel_range, {from ITC module GLOBAL } ITC_K_Message, {from ITC module GLOBAL } ITC_K_Establish, ITC_K_Broken, {from ITC module GLOBAL } ITC__No_Activity, {from ITC module GLOBAL } ITC__Success ; {from ITC module GLOBAL } { *************************************************************************** } { *************************************************************************** } %INCLUDE 'SITE_DEPENDENT.CST/LIST' CONST one_second = - 10000000 ; TYPE bit = [BIT(1)] 0..1 ; byte = [BYTE] 0..255 ; word = [WORD] 0..65535 ; %INCLUDE 'TABLE_ENUM.TYP/LIST' %INCLUDE 'TABLE_CBUS_REG.TYP/LIST' %INCLUDE 'TABLE_SPEC_TRIG.TYP/LIST' %INCLUDE 'TABLE_GEO_SECT.TYP/LIST' %INCLUDE 'TABLE_CALTRG_TOWER.TYP/LIST' %INCLUDE 'TABLE_DBLOCK_967.TYP/LIST' %INCLUDE 'MPOOL_DATA.TYP/LIST' VAR chan : channel_range ; tag : string(8) := 'MON/SRV%' ; New_Connection : EVENT ; New_Message : EVENT ; mpool_obj : AREA ; mpool_rec :^monitoring_data ; { p_general :^general_section ; 19-APR-1991 packed into other messages } p_strg_gsect :^sptrg_gsect_section ; p_dblock :^data_block_section ; p_trgtwr :^trig_tower_section ; p_refset :^refset_section ; p_gl_thrsh :^global_threshold_section ; p_xsysmon :^xsysmon_section ; p_per_bunch :^per_bunch_section ; p_foreign :^foreign_section ; t_strg_gsect : LARGE_INTEGER := 0 ; t_dblock : LARGE_INTEGER := 0 ; t_trgtwr : LARGE_INTEGER := 0 ; t_refset : LARGE_INTEGER := 0 ; t_gl_thrsh : LARGE_INTEGER := 0 ; t_xsysmon : LARGE_INTEGER := 0 ; t_per_bunch : LARGE_INTEGER := 0 ; t_foreign : LARGE_INTEGER := 0 ; while_in_general : VARYING_STRING(8) := '' ; request : mon_request ; message_cnt : ARRAY [1..20] OF INTEGER ; {The dimension of message_cnt must} {be .GE. than the constant } {Def_Max_Message_Size from } {[.ITC.INC]ITC_CONFIG.INC } SS$_INTOVF :[VALUE,EXTERNAL] INTEGER ; { *************************************************************************** } { *************************************************************************** } PROGRAM mpool_server ( INPUT, OUTPUT ) ; TYPE time_large_integer = {64 bit} PACKED RECORD tenth_of_us : 0..1048575 ; {20 bits = 1024 * 1024 } tenth_of_s : [POS(20)] 0..1048575 ; {20 bits} msb : [POS(40)] 0..16777215 ; {24 bits } END ; VAR pool_sta : INTEGER ; ch_sta : INTEGER ; activity : INTEGER ; stop : BOOLEAN ; result : INTEGER ; status : INTEGER ; server_logfile : VARYING_STRING(50) ; start_time : STRING(17) ; close_log_interval : time_large_integer ; BEGIN WAIT_ANY ( TIME := 60 * one_second ) ; {wait 1mn before starting} find_console_lock ( CALLER := 'MPOOL_SERVER' ) ; start_time := inline_time_now ; server_logfile := logfile_directory + 'MPOOL_SERVER_' + SUBSTR(start_time,1,2) + SUBSTR(start_time,4,3) + SUBSTR(start_time,10,2) + '.LOG' ; trace_info.console := ON ; trace_info.logfile := ON ; trace_error.console := ON ; trace_error.logfile := ON ; init_logfile ( NAME := server_logfile, STATUS := status ) ; init_flush_to_logfile ; { NEW( p_general ) ; p_general^ := ZERO ; 19-APR-1991 } NEW( p_strg_gsect ) ; p_strg_gsect^ := ZERO ; NEW( p_dblock ) ; p_dblock^ := ZERO ; NEW( p_trgtwr ) ; p_trgtwr^ := ZERO ; NEW( p_refset ) ; p_refset^ := ZERO ; NEW( p_gl_thrsh ) ; p_gl_thrsh^ := ZERO ; NEW( p_xsysmon ) ; p_xsysmon^ := ZERO ; NEW( p_per_bunch ) ; p_per_bunch^ := ZERO ; NEW( p_foreign ) ; p_foreign^ := ZERO ; message_cnt := ZERO ; find_area_lock ( CALLER := 'MPOOL_SERVER', AREA_NAME := mpool_area_name, AREA_OBJECT := mpool_obj, AREA_POINTER := mpool_rec, AREA_SIZE := SIZE(mpool_rec^), STATUS := pool_sta ) ; IF ( pool_sta <> 1 ) THEN BEGIN handle_trc_sta ( TAG := tag+'mpool_lock%', STATUS := pool_sta ) ; GOTO quit_mpool_server ; END ; ESTABLISH ( exchand_apll_read_mpool ) ; { * * * * * temporary kludge * * * * } { mpool_server_itc_channel_name = 'REM_MPOOL' ; in SITE_DEPENDENT.CST } { ch_sta := ITC_Target_ON ( mpool_server_itc_channel_name ) ; } ch_sta := ITC_Target_ON ( 'TEMP_MPOOL' ) ; { * * * * * temporary kludge * * * * } IF ( ch_sta <> ITC__Success ) THEN BEGIN handle_trc_sta ( TAG := tag+'target_on%', STATUS := ch_sta ) ; GOTO quit_mpool_server ; END ; ch_sta := ITC_Declare_Connect_Event ( New_Connection ) ; IF ( ch_sta <> ITC__Success ) THEN BEGIN handle_trc_sta ( TAG := tag+'decl_con%', STATUS := ch_sta ) ; GOTO quit_mpool_server ; END ; ch_sta := ITC_Declare_Receive_Event ( New_Message ) ; IF ( ch_sta <> ITC__Success ) THEN BEGIN handle_trc_sta ( TAG := tag+'decl_rcv%', STATUS := ch_sta ) ; GOTO quit_mpool_server ; END ; stop := FALSE ; {create the concurrent process closing logfile } close_log_interval.tenth_of_us := 0 ; close_log_interval.tenth_of_s := 10 * 900 ; { 15 mn = 900 s } close_log_interval.msb := 0 ; REPEAT ch_sta := ITC_Wait_Any ( Result, New_Connection, New_Message ) ; IF ( ch_sta <> ITC__Success ) THEN BEGIN handle_trc_sta ( TAG := tag+'wait_ch%', STATUS := ch_sta ) ; GOTO quit_mpool_server ; END ; WHILE ( ITC_Find_Activity ( chan, activity ) <> ITC__No_Activity ) DO IF ( activity = ITC_K_Message ) THEN service_request ( stop ) ELSE IF ( activity = ITC_K_Establish ) THEN service_connect ELSE IF ( activity = ITC_K_Broken ) THEN service_disconnect ELSE handle_trc_err ( TAG := tag, MESSAGE := 'Unexpected ITC activity type = ' + CONVERT(STRING,activity) ) ; UNTIL ( stop ) ; quit_mpool_server : cleanup ; END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE cleanup ; BEGIN { DISPOSE( p_general ) ; 19-APR-1991 } DISPOSE( p_strg_gsect ) ; DISPOSE( p_dblock ) ; DISPOSE( p_trgtwr ) ; DISPOSE( p_refset ) ; DISPOSE( p_gl_thrsh ) ; DISPOSE( p_xsysmon ) ; DISPOSE( p_per_bunch ) ; DISPOSE( p_foreign ) ; END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE service_request ( VAR stop : BOOLEAN ) ; VAR ch_sta : INTEGER ; ref_typ : threshold_reference_set_type ; ref_num : threshold_reference_set_number ; BEGIN CLEAR_EVENT ( New_Message ) ; message_cnt[chan] := message_cnt[chan] + 1 ; ch_sta := receive_request ; IF ( ch_sta <> ITC__Success ) THEN GOTO quit_service_request ; {test of TRGMON recovery of message loss} { CASE ( message_cnt[chan] MOD 13 ) OF { 2: GOTO quit_service_request ; { 6: GOTO quit_service_request ; { 7: GOTO quit_service_request ; { 10: GOTO quit_service_request ; { 11: GOTO quit_service_request ; { 12: GOTO quit_service_request ; { END ; } IF ( request.data_option::STRING(4) = 'STOP' ) THEN BEGIN stop := TRUE ; handle_trc_sys ( TAG := tag, MESSAGE := ' MPool Server asked to Exit ' ) ; GOTO quit_service_request ; END ; inline_lock_mpool ; { read_mpool_general ( BASE_ADDRESS := p_general ) ; 19-APR-1991 } CASE request.data_option OF MP_sptrg_gsect : read_mpool_st_gs ( BASE_ADDRESS := p_strg_gsect ) ; MP_datablock : read_mpool_dblock ( BASE_ADDRESS := p_dblock ) ; MP_trgtwr : read_mpool_trgtwr ( BASE_ADDRESS := p_trgtwr ) ; MP_refset : read_mpool_refset ( BASE_ADDRESS := p_refset ) ; MP_gl_thrsh : read_mpool_gl_thrsh ( BASE_ADDRESS := p_gl_thrsh ) ; MP_xsysmon : read_xsysmon ( BASE_ADDRESS := p_xsysmon ) ; MP_per_bunch : read_per_bunch ( BASE_ADDRESS := p_per_bunch ) ; MP_foreign : read_foreign ( BASE_ADDRESS := p_foreign ) ; END ; inline_unlock_mpool ; { 19-APR-1991 general is appended to other sections to only answer 1 message } { ch_sta := send_data ( p_general^::STRING(SIZE(general_section)) ) ; } { IF ( ch_sta <> ITC__Success ) THEN GOTO quit_service_request ; } CASE request.data_option OF MP_sptrg_gsect : ch_sta := send_data ( p_strg_gsect^::STRING(SIZE(sptrg_gsect_section)) ) ; MP_datablock : ch_sta := send_data ( p_dblock^::STRING(SIZE(data_block_section)) ) ; MP_trgtwr : ch_sta := send_data ( p_trgtwr^::STRING(SIZE(trig_tower_section)) ) ; MP_refset : BEGIN ch_sta := send_data ( p_refset^.status::STRING(SIZE(refset_status)) ) ; IF ( ch_sta <> ITC__Success ) THEN GOTO quit_service_request ; FOR ref_typ := EMEt_ref TO TOTEt_ref DO FOR ref_num := ref_0 TO ref_3 DO BEGIN WAIT_ANY ( TIME := (one_second DIV 5) ) ; ch_sta := send_data ( p_refset^.pattern[ref_typ,ref_num] ::STRING(SIZE(refset_pattern)) ) ; IF ( ch_sta <> ITC__Success ) THEN GOTO quit_service_request ; END ; WAIT_ANY ( TIME := (one_second DIV 5) ) ; ch_sta := send_data ( p_refset^.LT_pattern ::STRING(8*SIZE(LT_refset_pattern)) ) ; IF ( ch_sta <> ITC__Success ) THEN GOTO quit_service_request ; END ; MP_gl_thrsh : ch_sta := send_data (p_gl_thrsh^::STRING(SIZE(global_threshold_section))); MP_xsysmon : ch_sta := send_data (p_xsysmon^::STRING(SIZE(xsysmon_section))); MP_per_bunch : ch_sta := send_data (p_per_bunch^::STRING(SIZE(per_bunch_section))); MP_foreign : ch_sta := send_data (p_foreign^::STRING(SIZE(foreign_section))); OTHERWISE handle_trc_err ( TAG := tag, MESSAGE := ' Unexpected data option = ' + CONVERT(STRING,request.data_option::INTEGER) ) ; END ; quit_service_request : END ; { *************************************************************************** } PROCEDURE service_connect ; VAR ch_sta : INTEGER ; pid : INTEGER ; node_name : STRING(6) ; node_number : word ; node_area : word ; node_subn : word ; BEGIN CLEAR_EVENT ( New_Connection ) ; message_cnt[chan] := 0 ; ch_sta := ITC_GetPID ( chan, pid ) ; ch_sta := ITC_Get_Net_Number ( chan, node_number ) ; ch_sta := ITC_Get_Node ( chan, node_name ) ; node_area := node_number DIV 1024 ; node_subn := node_number MOD 1024 ; handle_trc_sys ( TAG := tag, MESSAGE := ' Channel #' + CONVERT(STRING,chan) + ' Connected to node ' + node_name + '(' + CONVERT(STRING,node_number) + '=' + CONVERT(STRING,node_area) + '.' + CONVERT(STRING,node_subn) + ') PID: ' + HEX(pid,8,8) ) ; END; { *************************************************************************** } { *************************************************************************** } PROCEDURE service_disconnect ; BEGIN handle_trc_sys ( TAG := tag, MESSAGE := ' Channel #' + CONVERT(STRING,chan) + ' Disconnected after generating ' + CONVERT(STRING,message_cnt[chan]) + ' messages' ) ; END; { *************************************************************************** } { *************************************************************************** } FUNCTION receive_request : INTEGER ; VAR ch_sta : INTEGER ; msglen : INTEGER ; BEGIN ch_sta := ITC_Read ( chan, request::STRING(SIZE(mon_request)), msglen ) ; IF ( message_cnt[chan] = 1 ) THEN handle_trc_sys ( TAG := tag, MESSAGE := ' Channel #' + CONVERT(STRING,chan) + ' is user ' + request.user_name + ' from process ' + request.proc_name ) ; { handle_trc_inf ( TAG := tag, { MESSAGE := ' receive ' { + CONVERT(STRING,msglen) { + ' bytes =' { + ' ' + CONVERT(STRING,request.data_option) { + ' ' + CONVERT(STRING,request.user_data[1]) { + ' ' + CONVERT(STRING,request.user_data[2]) { + ' ' + CONVERT(STRING,request.user_data[3]) ) ; } IF ( ch_sta <> ITC__Success ) THEN BEGIN handle_trc_sta ( TAG := tag+'read%', STATUS := ch_sta ) ; handle_trc_err ( TAG := tag+'read%', MESSAGE := ' For Channel #' + CONVERT(STRING,chan) + ' Length = ' + CONVERT(STRING,msglen) + ' Request =' + ' ' + CONVERT(STRING,request.data_option) + ' ' + CONVERT(STRING,request.user_data[1]) + ' ' + CONVERT(STRING,request.user_data[2]) + ' ' + CONVERT(STRING,request.user_data[3]) ) ; END ; receive_request := ch_sta ; END; { *************************************************************************** } { *************************************************************************** } FUNCTION send_data ( msg : STRING() ) : INTEGER ; VAR ch_sta : INTEGER ; BEGIN { WAIT_ANY ( TIME := 10 * one_second ) ; } ch_sta := ITC_write ( chan, msg ) ; { handle_trc_inf ( TAG := tag, MESSAGE := ' sent ' { + CONVERT(STRING,length) { + ' bytes' ) ; } IF ( ch_sta <> ITC__Success ) THEN BEGIN handle_trc_sta ( TAG := tag+'write%', STATUS := ch_sta ) ; handle_trc_err ( TAG := tag+'write%', MESSAGE := ' For Channel #' + CONVERT(STRING,chan) + ' Request =' + ' ' + CONVERT(STRING,request.data_option) + ' ' + CONVERT(STRING,request.user_data[1]) + ' ' + CONVERT(STRING,request.user_data[2]) + ' ' + CONVERT(STRING,request.user_data[3]) ) ; END ; send_data := ch_sta ; END; { *************************************************************************** } { *************************************************************************** } FUNCTION exchand_apll_read_mpool OF TYPE EXCEPTION_HANDLER ; BEGIN set_trc_exc_mode ( TRUE ) ; IF ( signal_args.name = SS$_INTOVF ) {integer overflow} THEN BEGIN handle_trc_sys ( TAG := 'MPL/EXC%', MESSAGE := ' Skip Exception INTOVF for Chan #' + CONVERT(STRING,chan) + ' request ' + CONVERT(STRING,request.Data_option) + while_in_general ) ; exchand_apll_read_mpool := TRUE ; END ELSE exchand_apll_read_mpool := handle_exception ( TAG := 'MPL/EXC%', EXC_CODE := signal_args.name ) ; set_trc_exc_mode ( FALSE ) ; END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE read_mpool_st_gs ( base_address :^sptrg_gsect_section ) ; VAR sptrgnum : INTEGER ; vetonum : INTEGER ; gsectnum : INTEGER ; temp_by_long : large_int_by_long ; BEGIN IF ( mpool_rec^.current.time = t_strg_gsect ) THEN GOTO quit_apll_read_mpool ; FOR sptrgnum := firstsptrg TO lastsptrg DO BEGIN base_address^.sptrgprog[sptrgnum] := mpool_rec^.sptrg[sptrgnum] ; temp_by_long::LARGE_INTEGER := mpool_rec^.current.sptrgcnt[sptrgnum].stfired::LARGE_INTEGER ; base_address^.sptrgcnt[sptrgnum].stfired := temp_by_long.long[0] ; temp_by_long::LARGE_INTEGER := mpool_rec^.current.sptrgcnt[sptrgnum].stenbld::LARGE_INTEGER ; base_address^.sptrgcnt[sptrgnum].stenbld := temp_by_long.long[0] ; base_address^.sptrgcnt[sptrgnum].aofired := mpool_rec^.current.sptrgcnt[sptrgnum].aofired ; base_address^.sptrgincr[sptrgnum].stfired := mpool_rec^.current.sptrgcnt[sptrgnum].stfired::LARGE_INTEGER - mpool_rec^.previous.sptrgcnt[sptrgnum].stfired::LARGE_INTEGER ; base_address^.sptrgincr[sptrgnum].stenbld := mpool_rec^.current.sptrgcnt[sptrgnum].stenbld::LARGE_INTEGER - mpool_rec^.previous.sptrgcnt[sptrgnum].stenbld::LARGE_INTEGER ; base_address^.sptrgincr[sptrgnum].aofired := mpool_rec^.current.sptrgcnt[sptrgnum].aofired - mpool_rec^.previous.sptrgcnt[sptrgnum].aofired ; FOR vetonum := 0 TO 6 DO base_address^.sptrgcnt[sptrgnum].stvetos[vetonum] := mpool_rec^.current.sptrgcnt[sptrgnum].stvetos[vetonum] ; FOR vetonum := 0 TO 6 DO base_address^.sptrgincr[sptrgnum].stvetos[vetonum] := mpool_rec^.current.sptrgcnt[sptrgnum].stvetos[vetonum] - mpool_rec^.previous.sptrgcnt[sptrgnum].stvetos[vetonum] ; base_address^.sptrgcnt[sptrgnum].L15.st_confirm := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_confirm ; base_address^.sptrgcnt[sptrgnum].L15.st_Reject := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_Reject ; base_address^.sptrgcnt[sptrgnum].L15.st_Cycle := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_Cycle ; base_address^.sptrgcnt[sptrgnum].L15.st_Skip := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_Skip ; base_address^.sptrgcnt[sptrgnum].L15.st_DeadX := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_DeadX ; base_address^.sptrgcnt[sptrgnum].L15.st_TimeOut := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_TimeOut ; base_address^.sptrgincr[sptrgnum].L15.st_confirm := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_confirm - mpool_rec^.previous.sptrgcnt[sptrgnum].L15.st_confirm ; base_address^.sptrgincr[sptrgnum].L15.st_Reject := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_Reject - mpool_rec^.previous.sptrgcnt[sptrgnum].L15.st_Reject ; base_address^.sptrgincr[sptrgnum].L15.st_Cycle := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_Cycle - mpool_rec^.previous.sptrgcnt[sptrgnum].L15.st_Cycle ; base_address^.sptrgincr[sptrgnum].L15.st_Skip := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_Skip - mpool_rec^.previous.sptrgcnt[sptrgnum].L15.st_Skip ; base_address^.sptrgincr[sptrgnum].L15.st_DeadX := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_DeadX - mpool_rec^.previous.sptrgcnt[sptrgnum].L15.st_DeadX ; base_address^.sptrgincr[sptrgnum].L15.st_TimeOut := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_TimeOut - mpool_rec^.previous.sptrgcnt[sptrgnum].L15.st_TimeOut ; END ; FOR gsectnum := firstgeosec TO lastgeosec DO BEGIN base_address^.gsectprog[gsectnum] := mpool_rec^.gsect[gsectnum]::INTEGER ; base_address^.gsectcnt.stdgt[gsectnum] := mpool_rec^.current.strtdigtz[gsectnum] ; base_address^.gsectcnt.busy[gsectnum] := mpool_rec^.current.fendbusy[gsectnum] ; base_address^.gsectincr.stdgt[gsectnum] := mpool_rec^.current.strtdigtz[gsectnum] - mpool_rec^.previous.strtdigtz[gsectnum] ; base_address^.gsectincr.busy[gsectnum] := mpool_rec^.current.fendbusy[gsectnum] - mpool_rec^.previous.fendbusy[gsectnum] ; END ; read_mpool_general ( BASE_ADDRESS := ADDRESS ( base_address^.general ) ) ; t_strg_gsect := mpool_rec^.current.time ; quit_apll_read_mpool : END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE read_mpool_general ( base_address :^general_section ) ; TYPE int_2_and_30_bits = [LONG] PACKED RECORD low_30_bits : 0..1073741823 ; high_2_bits : [BIT(2)] 0..3 ; END ; VAR temp_current : int_2_and_30_bits ; temp_previous : int_2_and_30_bits ; BEGIN while_in_general := '/general' ; base_address^.delta_time::INTEGER := {changed from INT to REAL 10-AUG-1994} mpool_rec^.current.time - mpool_rec^.previous.time ; base_address^.delta_time := CONVERT(REAL, base_address^.delta_time::INTEGER ); base_address^.delta_beam_crossing := mpool_rec^.current.BeamXCnt::LARGE_INTEGER - mpool_rec^.previous.BeamXCnt::LARGE_INTEGER ; temp_current::INTEGER := mpool_rec^.current.vetoxcnt ; temp_previous::INTEGER := mpool_rec^.previous.vetoxcnt ; IF ( temp_current.high_2_bits <> temp_previous.high_2_bits ) THEN BEGIN temp_current.high_2_bits := 1 ; temp_previous.high_2_bits := 0 ; END ; base_address^.delta_veto_crossing := temp_current::INTEGER - temp_previous::INTEGER ; base_address^.delta_global_fired := mpool_rec^.current.StDigCnt::LARGE_INTEGER - mpool_rec^.previous.StDigCnt::LARGE_INTEGER ; base_address^.delta_event_transfer := mpool_rec^.current.TransfCnt::LARGE_INTEGER - mpool_rec^.previous.TransfCnt::LARGE_INTEGER ; base_address^.delta_level_0 := mpool_rec^.current.lv0cnt::LARGE_INTEGER - mpool_rec^.previous.lv0cnt::LARGE_INTEGER ; base_address^.framework_status := mpool_rec^.status::INTEGER ; base_address^.trouble_warning_bits := mpool_rec^.twb::INTEGER ; base_address^.delta_68kstate_dbbbusy := mpool_rec^.current.DBB_busy::LARGE_INTEGER - mpool_rec^.previous.DBB_busy::LARGE_INTEGER ; base_address^.delta_68kstate_waitsvrd := mpool_rec^.current.Vtrans_idle::LARGE_INTEGER - mpool_rec^.previous.Vtrans_idle::LARGE_INTEGER ; base_address^.delta_68kstate_run68k := mpool_rec^.current.Vtrans_prepare::LARGE_INTEGER - mpool_rec^.previous.Vtrans_prepare::LARGE_INTEGER ; base_address^.delta_68kstate_searchvbd := mpool_rec^.current.Vtrans_wait_VBD::LARGE_INTEGER - mpool_rec^.previous.Vtrans_wait_VBD::LARGE_INTEGER ; base_address^.delta_68kstate_rundma := mpool_rec^.current.Vtrans_wait_DMA::LARGE_INTEGER - mpool_rec^.previous.Vtrans_wait_DMA::LARGE_INTEGER ; base_address^.delta_68kstate_none := mpool_rec^.current.Vtrans_display::LARGE_INTEGER - mpool_rec^.previous.Vtrans_display::LARGE_INTEGER ; base_address^.delta_l15_potential := mpool_rec^.current.L15_Potential::LARGE_INTEGER - mpool_rec^.previous.L15_Potential::LARGE_INTEGER ; base_address^.delta_l15_cycle := mpool_rec^.current.L15_Cycle::LARGE_INTEGER - mpool_rec^.previous.L15_Cycle::LARGE_INTEGER ; base_address^.delta_l15_pass := mpool_rec^.current.L15_Accept::LARGE_INTEGER - mpool_rec^.previous.L15_Accept::LARGE_INTEGER ; base_address^.delta_l15_reject := mpool_rec^.current.L15_Reject::LARGE_INTEGER - mpool_rec^.previous.L15_Reject::LARGE_INTEGER ; base_address^.delta_l15_skip := mpool_rec^.current.L15_Skip::LARGE_INTEGER - mpool_rec^.previous.L15_Skip::LARGE_INTEGER ; base_address^.delta_l15_timeout := mpool_rec^.current.L15_Timeout::LARGE_INTEGER - mpool_rec^.previous.L15_Timeout::LARGE_INTEGER ; base_address^.delta_l15_dead_crossing := mpool_rec^.current.L15_DeadX::LARGE_INTEGER - mpool_rec^.previous.L15_DeadX::LARGE_INTEGER ; base_address^.veto_crossing_count := mpool_rec^.current.vetoxcnt ; while_in_general := '' ; END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE read_mpool_dblock ( base_address :^data_block_section ) ; BEGIN IF ( mpool_rec^.current.time = t_dblock ) THEN GOTO quit_apll_read_mpool ; base_address^.dblock := mpool_rec^.dblock ; read_mpool_general ( BASE_ADDRESS := ADDRESS ( base_address^.general ) ) ; t_dblock := mpool_rec^.current.time ; quit_apll_read_mpool : END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE read_mpool_trgtwr ( base_address :^trig_tower_section ) ; BEGIN IF ( mpool_rec^.current.time = t_trgtwr ) THEN GOTO quit_apll_read_mpool ; base_address^.twr := mpool_rec^.twr ; read_mpool_general ( BASE_ADDRESS := ADDRESS(base_address^.general) ) ; t_trgtwr := mpool_rec^.current.time ; quit_apll_read_mpool : END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE read_mpool_refset ( base_address :^refset_section ) ; { * * * * * temporary kludge * * * * } VAR temp_address : ^refset_section ; BEGIN IF ( mpool_rec^.current.time = t_refset ) THEN GOTO quit_apll_read_mpool ; { * * * * * temporary kludge * * * * } base_address^.status.refset := mpool_rec^.refset.status.refset ; read_mpool_general ( BASE_ADDRESS := ADDRESS(base_address^.status.general) ) ; { * * * * * temporary kludge * * * * } temp_address := ADDRESS( mpool_rec^.refset ) ; temp_address::INTEGER := temp_address::INTEGER - 4 ; base_address^.pattern := temp_address^.pattern ; base_address^.lt_pattern := temp_address^.lt_pattern ; { * * * * * temporary kludge * * * * } t_refset := mpool_rec^.current.time ; quit_apll_read_mpool : END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE read_mpool_gl_thrsh ( base_address :^global_threshold_section ) ; { * * * * * temporary kludge * * * * } VAR temp_address : ^global_threshold_section ; BEGIN IF ( mpool_rec^.current.time = t_gl_thrsh ) THEN GOTO quit_apll_read_mpool ; { * * * * * temporary kludge * * * * } temp_address := ADDRESS( mpool_rec^.thresh ) ; temp_address::INTEGER := temp_address::INTEGER - 4 ; base_address^ := temp_address^ ; { * * * * * temporary kludge * * * * } read_mpool_general ( BASE_ADDRESS := ADDRESS(base_address^.general) ) ; t_gl_thrsh := mpool_rec^.current.time ; quit_apll_read_mpool : END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE read_xsysmon ( base_address :^xsysmon_section ) ; TYPE split_dbsc_30_10 = PACKED RECORD low_30 : [POS( 0)] 0..1073741823 ; {30 bits} high_10 : [POS(30)] 0..1023 ; {10 bits} rest : [POS(40)] 0..16777215 ; {24 bits} END ; VAR sptrgnum : INTEGER ; temp : split_dbsc_30_10 ; BEGIN IF ( mpool_rec^.current.time = t_xsysmon ) THEN GOTO quit_apll_read_mpool ; base_address^.command_id := request.user_data[1] ; base_address^.message_id := request.user_data[2] ; base_address^.priority := request.user_data[3] ; base_address^.status := mpool_rec^.status ; temp := mpool_rec^.current.beamxcnt::split_dbsc_30_10 ; base_address^.beam_x_g := temp.high_10 ; base_address^.beam_x_u := temp.low_30 ; base_address^.beam_x_sbsc := mpool_rec^.current.vetoxcnt ; FOR sptrgnum := 0 TO 31 DO BEGIN base_address^.prescale[sptrgnum] := mpool_rec^.sptrg[sptrgnum].prscratio ; temp := mpool_rec^.current.sptrgcnt[sptrgnum].stfired::split_dbsc_30_10 ; base_address^.st_fired_g[sptrgnum] := temp.high_10 ; base_address^.st_fired_u[sptrgnum] := temp.low_30 ; temp := mpool_rec^.current.sptrgcnt[sptrgnum].stenbld::split_dbsc_30_10 ; base_address^.st_expos_g[sptrgnum] := temp.high_10 ; base_address^.st_expos_u[sptrgnum] := temp.low_30 ; base_address^.st_andor[sptrgnum] := mpool_rec^.current.sptrgcnt[sptrgnum].aofired ; base_address^.st_vetos[sptrgnum] := mpool_rec^.current.sptrgcnt[sptrgnum].stvetos ; END ; temp := mpool_rec^.current.lv0cnt::split_dbsc_30_10 ; base_address^.l0_good_g := temp.high_10 ; base_address^.l0_good_u := temp.low_30 ; temp := mpool_rec^.current.stdigcnt::split_dbsc_30_10 ; base_address^.l1_fired_g := temp.high_10 ; base_address^.l1_fired_u := temp.low_30 ; temp := mpool_rec^.current.transfcnt::split_dbsc_30_10 ; base_address^.l1_trnsf_g := temp.high_10 ; base_address^.l1_trnsf_u := temp.low_30 ; temp := mpool_rec^.current.L15_Cycle::split_dbsc_30_10 ; base_address^.l15_cycle_g := temp.high_10 ; base_address^.l15_cycle_u := temp.low_30 ; temp := mpool_rec^.current.L15_DeadX::split_dbsc_30_10 ; base_address^.l15_deadX_g := temp.high_10 ; base_address^.l15_deadX_u := temp.low_30 ; FOR sptrgnum := 0 TO 15 DO BEGIN base_address^.stl15_input[sptrgnum] := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_Cycle ; base_address^.stl15_reject[sptrgnum] := mpool_rec^.current.sptrgcnt[sptrgnum].L15.st_Reject ; END ; t_xsysmon := mpool_rec^.current.time ; quit_apll_read_mpool : END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE read_per_bunch ( base_address :^per_bunch_section ) ; VAR bunch : INTEGER ; BEGIN IF ( mpool_rec^.current.time = t_per_bunch ) THEN GOTO quit_apll_read_mpool ; FOR bunch := 1 TO 6 DO BEGIN base_address^.L1_fired[bunch] := mpool_rec^.current.L1_per_bunch[bunch]::LARGE_INTEGER - mpool_rec^.previous.L1_per_bunch[bunch]::LARGE_INTEGER ; base_address^.Fast_L0_good[bunch] := mpool_rec^.current.L0_per_bunch[bunch]::LARGE_INTEGER - mpool_rec^.previous.L0_per_bunch[bunch]::LARGE_INTEGER ; base_address^.Live_Crossing[bunch] := mpool_rec^.current.foreign.per_bunch[bunch,liveX]::LARGE_INTEGER - mpool_rec^.previous.foreign.per_bunch[bunch,liveX]::LARGE_INTEGER ; base_address^.LiveX_Fast_L0_Good[bunch] := mpool_rec^.current. foreign.per_bunch[bunch,liveX_FL0_G]::LARGE_INTEGER - mpool_rec^.previous.foreign.per_bunch[bunch,liveX_FL0_G]::LARGE_INTEGER ; base_address^.LiveX_L0_Single[bunch] := mpool_rec^.current.foreign.per_bunch[bunch,liveX_L0_S]::LARGE_INTEGER - mpool_rec^.previous.foreign.per_bunch[bunch,liveX_L0_S]::LARGE_INTEGER ; base_address^.LiveX_L0_Sgl_Ctr[bunch] := mpool_rec^.current.foreign.per_bunch[bunch,liveX_L0_SC]::LARGE_INTEGER - mpool_rec^.previous.foreign.per_bunch[bunch,liveX_L0_SC]::LARGE_INTEGER ; END ; read_mpool_general ( BASE_ADDRESS := ADDRESS(base_address^.general) ) ; t_per_bunch := mpool_rec^.current.time ; quit_apll_read_mpool : END ; { *************************************************************************** } { *************************************************************************** } PROCEDURE read_foreign ( base_address :^foreign_section ) ; VAR scalernum : INTEGER ; BEGIN IF ( mpool_rec^.current.time = t_foreign ) THEN GOTO quit_apll_read_mpool ; { The foreign scalers are recorded in } { descending order, cf. MPOOL_DATA.TYP } { | } FOR scalernum := 1 TO 44 { V } DO base_address^.Foreign_Scaler[45-scalernum] := mpool_rec^.current.foreign.scaler[scalernum]::LARGE_INTEGER - mpool_rec^.previous.foreign.scaler[scalernum]::LARGE_INTEGER ; read_mpool_general ( BASE_ADDRESS := ADDRESS(base_address^.general) ) ; t_foreign := mpool_rec^.current.time ; quit_apll_read_mpool : END ; { *************************************************************************** } { *************************************************************************** } [INLINE] PROCEDURE inline_lock_mpool ; BEGIN ELN$LOCK_AREA ( mpool_obj, mpool_rec^.lock ) ; END ; { *************************************************************************** } [INLINE] PROCEDURE inline_unlock_mpool ; BEGIN ELN$UNLOCK_AREA ( mpool_obj, mpool_rec^.lock ) ; END ; { *************************************************************************** } { *************************************************************************** } END.