



		    channel_comm_meters.pl1         10/25/89  1156.0r w 10/25/89  1005.1      102807



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* format: style4,delnl,insnl,^ifthendo */
channel_comm_meters:
     procedure;

/* Command to print meters on one or more communications channels (specified by
   a single starname). It calls comm_meters_ to get the information, and the
   appropriate multiplexer-specific entries to display it.
*/

/* Written April 1981 by Robert Coren */
/* Modified July 1981 by Robert Coren to handle sub_error_ */

/* AUTOMATIC */

dcl  brief bit (1);
dcl  error bit (1);
dcl  summary bit (1);
dcl  since_boot bit (1);
dcl  boot_spec bit (1);
dcl  dial_spec bit (1);
dcl  chan_spec bit (1);
dcl  i fixed bin;
dcl  code fixed bin (35);
dcl  ctl_arg char (16);
dcl  nargs fixed bin;
dcl  argl fixed bin (21);
dcl  argp pointer;
dcl  chan_star_name (1) char (32);			/* comm_meters_ requires an array */
dcl  areap pointer;
dcl  n_channels fixed bin;
dcl  orig_meterp pointer;
dcl  display_flags bit (36) aligned;
dcl  beginning fixed bin (71);			/* time from which meters are measured */
dcl  seconds fixed bin (71);
dcl  all_time fixed bin (71);				/* time since beginning */
dcl  time_string char (9);
dcl  chanx fixed bin;
dcl  name char (32);
dcl  entry_var entry options (variable) variable;
dcl  total_errors fixed bin;
dcl  user_name char (22);
dcl  user_proj char (9);
dcl  input_chars fixed bin (35);
dcl  output_chars fixed bin (35);
dcl  cps fixed bin;

dcl  1 auto_summary aligned like channel_summary;


/* BASED */

dcl  arg char (argl) based (argp);


/* ENTRIES */

dcl  cu_$arg_count entry (fixed bin, fixed bin (35));
dcl  ioa_ entry () options (variable);
dcl  com_err_ entry () options (variable);
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
dcl  get_system_free_area_ entry () returns (ptr);
dcl  get_userid_ entry (bit (36) aligned, char (*), char (*), fixed bin, fixed bin, fixed bin (35));
dcl  system_info_$timeup entry (fixed bin (71));
dcl  comm_meters_ entry ((*) char (32), fixed bin, pointer, fixed bin, pointer, fixed bin (35));
dcl  comm_meters_$free entry (pointer, pointer, fixed bin (35));
dcl  comm_meters_$get_mpx_entry entry (char (*), fixed bin) returns (entry);
dcl  meter_format_$time entry (fixed bin (71)) returns (char (10));
dcl  meter_format_$quotient entry (fixed bin (71), fixed bin (71), char (*)) returns (char (12) varying);
dcl  find_condition_info_ entry (ptr, ptr, fixed bin (35));
dcl  continue_to_signal_ entry (fixed bin (35));


/* EXTERNAL STATIC */

dcl  (
     error_table_$noarg,
     error_table_$badopt,
     error_table_$inconsistent,
     error_table_$bigarg,
     error_table_$no_channel_meters,
     error_table_$no_operation
     ) fixed bin (35) external static;


/* INTERNAL STATIC */

dcl  CMD_NAME char (19) internal static options (constant) init ("channel_comm_meters");


/* BUILTINS & CONDITIONS */

dcl  sub_error_ condition;

dcl  (substr, divide, clock, null, addr, unspec) builtin;

%include channel_meters;
%page;
%include channel_summary;
%page;
%include multiplexer_types;
%page;
%include condition_info;
%page;
%include sub_error_info;
%page;
%include condition_info_header;
%page;
%include comm_meters_error_info;

	call cu_$arg_count (nargs, code);
	if code ^= 0
	then do;
	     call com_err_ (code, CMD_NAME);
	     return;
	end;

	if nargs = 0
	then do;
	     call com_err_ (error_table_$noarg, CMD_NAME,
		"^/Usage: channel_comm_meters channel_name {-brief} {-error} {-summary} {-since_bootload | -since_dialup}"
		);
	     return;
	end;

	brief, error, summary, since_boot, boot_spec, dial_spec, chan_spec = "0"b;

	do i = 1 to nargs;				/* parse the arguments */
	     call cu_$arg_ptr (i, argp, argl, code);
	     if substr (arg, 1, 1) = "-"		/* control arg */
	     then do;
		ctl_arg = substr (arg, 2);

		if ctl_arg = "brief" | ctl_arg = "bf"
		then brief = "1"b;

		else if ctl_arg = "error"
		then error = "1"b;

		else if ctl_arg = "summary" | ctl_arg = "sum"
		then summary = "1"b;

		else if ctl_arg = "since_bootload" | ctl_arg = "boot"
		then do;
		     boot_spec = "1"b;
		     since_boot = "1"b;
		end;

		else if ctl_arg = "since_dialup" | ctl_arg = "dial"
		then do;
		     dial_spec = "1"b;
		     since_boot = "0"b;
		end;

		else do;
		     call com_err_ (error_table_$badopt, CMD_NAME, arg);
		     return;
		end;
	     end;

	     else do;
		if chan_spec			/* already gave a channel name */
		then do;
		     call com_err_ (error_table_$inconsistent, CMD_NAME,
			"Only one channel starname may be specified.");
		     return;
		end;

		if argl > 32			/* too big to be a channel name */
		then do;
		     call com_err_ (error_table_$bigarg, CMD_NAME, "^a. Channel name must not exceed 32 characters.",
			arg);
		     return;
		end;

		chan_spec = "1"b;
		chan_star_name (1) = arg;
	     end;
	end;

/* Now check for unacceptable combinations */

	if (brief | error) & summary
	then do;
	     call com_err_ (error_table_$inconsistent, CMD_NAME,
		"-summary may not be specified with either -brief or -error.");
	     return;
	end;

	if boot_spec & dial_spec
	then do;
	     call com_err_ (error_table_$inconsistent, CMD_NAME,
		"only one of -since_bootload and -since_dialup may be specified.");
	     return;
	end;


/* handler for sub_error_ */

	on sub_error_
	     begin;

dcl  pass_on bit (1);
dcl  1 auto_cond_info aligned like condition_info;

		pass_on = "0"b;
		condition_info_ptr = addr (auto_cond_info);
		call find_condition_info_ (null (), condition_info_ptr, code);
		if code ^= 0			/* rather unlikely */
		then pass_on = "1"b;		/* but we'll let someone else worry about it */

		else if condition_info.info_ptr = null () | condition_info.condition_name ^= "sub_error_"
						/* we're not about to deal with this */
		then pass_on = "1"b;

		else do;
		     sub_error_info_ptr = condition_info.info_ptr;
		     if sub_error_info.name ^= "comm_meters_"
						/* not someone we know */
		     then pass_on = "1"b;

		     else if sub_error_info.info_ptr = null ()
						/* simple enough */
		     then go to report_it;

		     comm_meters_errp = sub_error_info.info_ptr;
		     if comm_meters_error_info.version ^= COMM_METERS_ERR_V1
		     then pass_on = "1"b;

		     else do;
			if ^comm_meters_error_info.starname_matched
			then go to report_it;
			if sub_error_info.status_code ^= error_table_$no_channel_meters
						/* this is not worth reporting */
			     | ^comm_meters_error_info.more_than_one_match
						/* unless there's only one channel anyway */
			then do;

report_it:
			     call com_err_ (sub_error_info.status_code, CMD_NAME, sub_error_info.info_string);
			end;
		     end;
		end;

		if pass_on
		then call continue_to_signal_ (code);
	     end;

/* Now start to do some work */

	areap = get_system_free_area_ ();
	call comm_meters_ (chan_star_name, CHANNEL_METERS_VERSION_1, areap, n_channels, chan_meterp, code);
	if code ^= 0
	then return;				/* comm_meters_ calls sub_err_, which should explain everything */

	orig_meterp = chan_meterp;			/* save this for later freeing */
	display_flags = brief || error || summary || since_boot || (32)"0"b;

	call system_info_$timeup (beginning);
	all_time = clock () - beginning;
	call ioa_ ("Total metering time ^a", meter_format_$time (all_time));

	if summary				/* print header */
	then call ioa_ ("^/cps^7tcpsi^14tcpso^20tiotxXsbepQqa^34terr^39tABE^44tname^60tuser^/");

	do chanx = 1 to n_channels;
	     name = channel_meters.channel_name;
	     if ^summary
	     then do;
		call ioa_ ("^/^a^/", name);

		entry_var = comm_meters_$get_mpx_entry ("display_mpx", channel_meters.multiplexer_type);
		call entry_var (name, null (), chan_meterp, display_flags, code);
		if code ^= 0 & code ^= error_table_$no_operation
						/* don't fuss if entry simply not supplied */
		then call com_err_ (code, CMD_NAME, "No multiplexer meters for ^a (multiplexer type ^a)", name,
			mpx_types (channel_meters.multiplexer_type));

		if channel_meters.parent_type > 0	/* not level-1 mpx */
		then do;
		     entry_var = comm_meters_$get_mpx_entry ("display_subchan", channel_meters.parent_type);
		     call entry_var (name, null (), chan_meterp, display_flags, code);
		     if code ^= 0 & code ^= error_table_$no_operation
						/* as above */
		     then call com_err_ (code, CMD_NAME, "No subchannel meters for ^a (parent type ^a)", name,
			     mpx_types (channel_meters.parent_type));
		end;
	     end;

	     else do;				/* get summary information and print it ourselves */
		unspec (auto_summary) = "0"b;
		auto_summary.version = CHANNEL_SUMMARY_VERSION_1;

		entry_var = comm_meters_$get_mpx_entry ("mpx_summary", channel_meters.multiplexer_type);
		call entry_var (chan_meterp, since_boot, addr (auto_summary), code);

		total_errors = auto_summary.error_count;/* save this */
		auto_summary.error_count = 0;		/* parent may update this */

		if channel_meters.parent_type > 0
		then do;
		     entry_var = comm_meters_$get_mpx_entry ("subchan_summary", channel_meters.parent_type);
		     call entry_var (chan_meterp, since_boot, addr (auto_summary), code);
		     total_errors = total_errors + auto_summary.error_count;
		end;

		if since_boot
		then do;
		     input_chars = channel_meters.cumulative.unconverted_input_chars;
		     output_chars = channel_meters.cumulative.converted_output_chars;
		     seconds = divide (all_time, 1000000, 71, 0);
		end;

		else do;
		     input_chars =
			channel_meters.cumulative.unconverted_input_chars
			- channel_meters.saved.unconverted_input_chars;
		     output_chars =
			channel_meters.cumulative.converted_output_chars
			- channel_meters.saved.converted_output_chars;
		     seconds = divide (auto_summary.time_since_dial, 1000000, 71, 0);
		end;

		if auto_summary.user_process = "0"b
		then user_name = "";
		else call get_userid_ (auto_summary.user_process, user_name, user_proj, (0), (0), code);

		if auto_summary.synchronous
		then cps = divide (auto_summary.baud_rate, 8, 17, 0);
		else cps = divide (auto_summary.baud_rate, 10, 17, 0);

		call ioa_ (
		     "^3d^6t^a^13t^a^20t^[i^;^x^]^[o^;^x^]^[t^;^x^]^[x^;^x^]^[X^;^x^]^[s^;^x^]^[b^;^x^]^[e^;^x^]^[p^;^x^]^[Q^;^x^]^[q^;^x^]^[a^;^x^]^33t^4d^39t^[s^;a^]^[B^;^x^]^[E^;^x^]^44t^a^60t^a"
		     , cps, meter_format_$quotient ((input_chars), seconds, "^5.2f"),
		     meter_format_$quotient ((output_chars), seconds, "^5.2f"), auto_summary.invalid_input,
		     auto_summary.output_re_xmit, auto_summary.timeout, auto_summary.pre_exhaust,
		     auto_summary.exhaust, auto_summary.xte, auto_summary.bell_quit, auto_summary.echo_overflow,
		     auto_summary.parity, auto_summary.ssqo, auto_summary.hsqo, auto_summary.alloc_failure,
		     total_errors, auto_summary.synchronous, auto_summary.breakall, auto_summary.echoplex, name,
		     user_name);
	     end;

	     chan_meterp = channel_meters.next_channelp;
	end;

	call comm_meters_$free (areap, orig_meterp, code);
	if code ^= 0
	then call com_err_ (code, CMD_NAME, "While freeing channel meters.");

	return;
     end channel_comm_meters;




		    comm_meters_.pl1                10/25/89  1156.0r w 10/25/89  1005.1      121410



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* format: style4,delnl,insnl,^ifthendo */
comm_meters_:
     proc (a_chan_names, a_version, a_area_ptr, a_n_channels, a_chan_meterp, a_code);

/* Subroutine for use by comm. channel metering commands. It takes a list of channel names,
   any or all of which may be starnames, and returns metering information for the specified
   channels. The comm_meters_$free entry frees the structures allocated by the main entry.
   This subroutine requires the aid of some multiplexer-specific entries to allocate and free structures
   whose formats are known only to the multiplexer involved. These entries have names of the form
   MPX_meters_$allocate_mpx, MPX_meters_$allocate_subchan, MPX_meters_$free_mpx,
   and MPX_meters_$free_subchan, where MPX is the name of the relevant multiplexer type.
*/

/* Written February 1981 by Robert S. Coren */
/* Modified July 1981 by Robert S. Coren to supply some info with call to sub_err_ */


/* PARAMETERS */

dcl  a_chan_names (*) char (*) parameter;		/* channel names for which to meter */
dcl  a_version fixed bin parameter;			/* version of structure to be allocated */
dcl  a_area_ptr pointer parameter;			/* pointer to area in which to do allocation */
dcl  a_entry_type char (*);				/* name of multiplexer-specific entry */
dcl  a_mpx_type fixed bin;				/* multiplexer type for get_mpx_entry entry */
dcl  a_n_channels fixed bin parameter;			/* number of channels matching a_chan_	names (OUTPUT) */
dcl  a_chan_meterp pointer parameter;			/* pointer to list of metering structures allocated (OUTPUT) */
dcl  a_code fixed bin (35);				/* status code (OUTPUT) */


/* AUTOMATIC */

dcl  chan_meter_areap ptr;
dcl  n_channels fixed bin;
dcl  code fixed bin (35);
dcl  last_chanp pointer;
dcl  names_areap ptr;
dcl  i fixed bin;
dcl  chanx fixed bin;
dcl  mpx_type fixed bin;
dcl  chan_name char (32);
dcl  name_matched bit (1);

dcl  1 meter_info aligned like get_comm_meters_info;

dcl  1 auto_logical_meters aligned like logical_chan_meters;


/* BASED */

dcl  names_area area (256) based (names_areap);
dcl  chan_meter_area area (256) based (chan_meter_areap);


/* ENTRIES */

dcl  get_system_free_area_ entry (pointer);
dcl  metering_gate_$comm_chan_star_list entry (char (*), fixed bin, ptr, ptr, fixed bin (35));
dcl  metering_gate_$get_comm_meters entry (char (*), ptr, fixed bin (35));
dcl  phcs_$get_comm_meters entry (char (*), ptr, fixed bin (35));
dcl  entry_var entry options (variable) variable;
dcl  sub_err_ entry options (variable);


/* EXTERNAL STATIC */

dcl  error_table_$noalloc fixed bin (35) external static;
dcl  error_table_$no_operation fixed bin (35) external static;
dcl  error_table_$unimplemented_version fixed bin (35) external static;


/* BUILTINS & CONDITIONS */

dcl  (addr, hbound, null) builtin;
dcl  (area, cleanup, linkage_error) condition;

	if a_version ^= CHANNEL_METERS_VERSION_1
	then do;
	     a_code = error_table_$unimplemented_version;
	     return;
	end;

	chan_meter_areap = a_area_ptr;
	n_channels = 0;
	last_chanp = null;
	chan_star_list_ptr = null;

	on cleanup call cleanup_proc;
	on area
	     begin;
		call cleanup_proc;
		a_code = error_table_$noalloc;
		go to exit;
	     end;

	call get_system_free_area_ (names_areap);
	name_matched = "0"b;

	do i = 1 to hbound (a_chan_names, 1);
	     call metering_gate_$comm_chan_star_list (a_chan_names (i), CHAN_STAR_INFO_VERSION_1, names_areap,
		chan_star_list_ptr, code);
	     if code ^= 0
	     then do;
		call report_error (a_chan_names (i));
		a_code = code;
		call cleanup_proc;
		return;
	     end;

	     name_matched = "1"b;
	     n_channels = n_channels + chan_star_info.n_channels;
	     do chanx = 1 to chan_star_info.n_channels;
		mpx_type = chan_star_info.chan_entry (chanx).mpx_type;
		chan_name = chan_star_info.chan_entry (chanx).name;
		allocate channel_meters in (chan_meter_area) set (chan_meterp);
		if last_chanp = null		/* this is first one in list */
		then a_chan_meterp = chan_meterp;	/* have to tell caller where to start */
		else last_chanp -> channel_meters.next_channelp = chan_meterp;
						/* else chain it on to previous */

		channel_meters.version = a_version;
		channel_meters.next_channelp = null;
		channel_meters.multiplexer_type = mpx_type;
		channel_meters.line_type = chan_star_info.chan_entry (chanx).line_type;
		channel_meters.parent_type = chan_star_info.chan_entry (chanx).parent_type;
		channel_meters.channel_name = chan_name;

		meter_info.version = GET_COMM_METERS_INFO_VERSION_1;
		meter_info.logical_chan_ptr = addr (auto_logical_meters);
		entry_var = get_entry ("allocate_mpx", mpx_type);
						/* returns iox_$err_no_operation if there isn't one */
		call entry_var (chan_meter_areap, meter_info.subchan_ptr, code);
		if code ^= 0
		then do;
		     if code ^= error_table_$no_operation
		     then call report_error (chan_name);
		     meter_info.subchan_ptr = null;
		end;

		if channel_meters.parent_type >= 0
		then do;
		     entry_var = get_entry ("allocate_subchan", channel_meters.parent_type);
		     call entry_var (chan_meter_areap, meter_info.parent_ptr, code);
		     if code ^= 0
		     then do;
			if code ^= error_table_$no_operation
			then call report_error (chan_name);
			meter_info.parent_ptr = null;
		     end;
		end;
		else meter_info.parent_ptr = null;

		channel_meters.mpx_specific_meterp = meter_info.subchan_ptr;
		channel_meters.parent_meterp = meter_info.parent_ptr;

/* now get the actual meters out of ring 0 */

		on linkage_error
		     begin;			/* we're going to try phcs_ first */
			revert linkage_error;
			call metering_gate_$get_comm_meters (chan_name, addr (meter_info), code);
			go to proceed;
		     end;

		call phcs_$get_comm_meters (chan_name, addr (meter_info), code);
		revert linkage_error;

proceed:
		if code ^= 0
		then do;
		     call report_error (chan_name);
		     free channel_meters in (chan_meter_area);
						/* skip this one */
		     if last_chanp ^= null
		     then last_chanp -> channel_meters.next_channelp = null;
						/* wipe out forward pointer to it */
		     n_channels = n_channels - 1;	/* don't count it */
		end;

		else do;
		     last_chanp = chan_meterp;	/* this one is last now */

/* now copy them into the structure */

		     channel_meters.cumulative.unconverted_input_chars = auto_logical_meters.current_meters.in_bytes;
		     channel_meters.cumulative.converted_output_chars = auto_logical_meters.current_meters.out_bytes;
		     channel_meters.cumulative.read_calls = auto_logical_meters.current_meters.in.calls;
		     channel_meters.cumulative.read_call_time = auto_logical_meters.current_meters.in.call_time;
		     channel_meters.cumulative.write_calls = auto_logical_meters.current_meters.out.calls;
		     channel_meters.cumulative.write_call_time = auto_logical_meters.current_meters.out.call_time;
		     channel_meters.cumulative.control_calls = auto_logical_meters.current_meters.control.calls;
		     channel_meters.cumulative.control_call_time =
			auto_logical_meters.current_meters.control.call_time;
		     channel_meters.cumulative.software_interrupts =
			auto_logical_meters.current_meters.in.interrupts
			+ auto_logical_meters.current_meters.out.interrupts
			+ auto_logical_meters.current_meters.control.interrupts;
		     channel_meters.cumulative.interrupt_time =
			auto_logical_meters.current_meters.in.interrupt_time
			+ auto_logical_meters.current_meters.out.interrupt_time
			+ auto_logical_meters.current_meters.control.interrupt_time;

		     channel_meters.saved.unconverted_input_chars = auto_logical_meters.saved_meters.in_bytes;
		     channel_meters.saved.converted_output_chars = auto_logical_meters.saved_meters.out_bytes;
		     channel_meters.saved.read_calls = auto_logical_meters.saved_meters.in.calls;
		     channel_meters.saved.read_call_time = auto_logical_meters.saved_meters.in.call_time;
		     channel_meters.saved.write_calls = auto_logical_meters.saved_meters.out.calls;
		     channel_meters.saved.write_call_time = auto_logical_meters.saved_meters.out.call_time;
		     channel_meters.saved.control_calls = auto_logical_meters.saved_meters.control.calls;
		     channel_meters.saved.control_call_time = auto_logical_meters.saved_meters.control.call_time;
		     channel_meters.saved.software_interrupts =
			auto_logical_meters.saved_meters.in.interrupts
			+ auto_logical_meters.saved_meters.out.interrupts
			+ auto_logical_meters.saved_meters.control.interrupts;
		     channel_meters.saved.interrupt_time =
			auto_logical_meters.saved_meters.in.interrupt_time
			+ auto_logical_meters.saved_meters.out.interrupt_time
			+ auto_logical_meters.saved_meters.control.interrupt_time;
		end;
	     end;					/* done with that channel */
	     free chan_star_info in (names_area);	/* done with that starname */
	     chan_star_list_ptr = null;		/* in case of cleanup */
	end;					/* done processing all names */

	if n_channels <= 0
	then a_code = code;
	else a_code = 0;

	a_n_channels = n_channels;
exit:
	return;


free:
     entry (a_area_ptr, a_chan_meterp, a_code);

/* this entry frees metering structure allocated by main entry */

	chan_meter_areap = a_area_ptr;
	call free_all (a_chan_meterp);		/* internal subroutine does all the work */
	a_code = code;
	return;



get_mpx_entry:
     entry (a_entry_type, a_mpx_type) returns (entry);

/* this is an entry to allow external access to the get_entry procedure */

	return (get_entry (a_entry_type, a_mpx_type));

/* CLEANUP_PROC -- called for cleanup condition or if subroutine aborts */

cleanup_proc:
     procedure;

	if chan_star_list_ptr ^= null
	then free chan_star_info in (names_area);
	if last_chanp ^= null
	then call free_all (a_chan_meterp);
	return;
     end cleanup_proc;

/* FREE_ALL -- frees metering structures. Multiplexer-specific entries are called to free stuff allocated by corresponding entries */

free_all:
     procedure (a_list_meterp);

dcl  a_list_meterp ptr;
dcl  next_chanp ptr;

	chan_meterp = a_list_meterp;
	do while (chan_meterp ^= null);
	     if channel_meters.mpx_specific_meterp ^= null
	     then do;
		entry_var = get_entry ("free_mpx", channel_meters.multiplexer_type);
		call entry_var (channel_meters.mpx_specific_meterp, code);
		if code ^= 0
		then call sub_err_ (code, "comm_meters_$free", "c", null, 0, "Couldn't free
meters for ^a subchannel.", mpx_types (channel_meters.multiplexer_type));
	     end;

	     if channel_meters.parent_meterp ^= null
	     then do;
		entry_var = get_entry ("free_subchan", channel_meters.parent_type);
		call entry_var (channel_meters.parent_meterp, code);
		if code ^= 0
		then call sub_err_ (code, "comm_meters_$free", "c", null, 0,
			"Couldn't free meters for ^a multiplexer.", mpx_types (channel_meters.parent_type));
	     end;

	     code = 0;
	     next_chanp = channel_meters.next_channelp;
	     free channel_meters in (chan_meter_area);
	     chan_meterp = next_chanp;		/* on to the next */
	end;
	return;
     end free_all;

/* GET_ENTRY -- given a multiplexer type and an entrypoint name, returns the entry.
   If there is no corresponding entry, returns iox_$err_no_operation, so result can
   always be called and will do something comprehensible.
*/

get_entry:
     procedure (a_entry_type, a_mpx_type) returns (entry);

dcl  a_entry_type char (*);
dcl  a_mpx_type fixed bin;

dcl  segname char (32);
dcl  entname char (32);
dcl  entry_ptr pointer;
dcl  entry_result entry variable;
dcl  code fixed bin (35);

dcl  cu_$make_entry_value entry (pointer, entry);
dcl  hcs_$make_ptr entry (pointer, char (*), char (*), pointer, fixed bin (35));

dcl  iox_$err_no_operation entry options (variable);

dcl  rtrim builtin;

	segname = rtrim (mpx_types (a_mpx_type)) || "_meters_";
	entname = a_entry_type;

	call hcs_$make_ptr (null, segname, entname, entry_ptr, code);
	if entry_ptr = null
	then return (iox_$err_no_operation);

	call cu_$make_entry_value (entry_ptr, entry_result);
	return (entry_result);
     end get_entry;

/* REPORT_ERROR -- internal procedure to call sub_err_ with a channel name */

report_error:
     procedure (err_name);

dcl  err_name char (*);
dcl  1 auto_meters_error_info aligned like comm_meters_error_info;

	comm_meters_errp = addr (auto_meters_error_info);
	comm_meters_error_info.version = COMM_METERS_ERR_V1;
	comm_meters_error_info.chan_name = err_name;
	comm_meters_error_info.more_than_one_starname = (hbound (a_chan_names, 1) > 1);
	if name_matched
	then do;
	     comm_meters_error_info.starname_matched = "1"b;
	     comm_meters_error_info.more_than_one_match = (n_channels > 1);
	end;
	else comm_meters_error_info.starname_matched, comm_meters_error_info.more_than_one_match = "0"b;

	call sub_err_ (code, "comm_meters_", "c", comm_meters_errp, 0, "Processing channel name ^a", err_name);
	return;
     end report_error;

%include multiplexer_types;
%page;
%include chan_star_info;
%page;
%include get_comm_meters_info;
%page;
%include channel_meters;
%page;
%include lct;
%page;
%include comm_meters_error_info;

     end comm_meters_;




		    display_fnp_idle.pl1            11/15/82  1813.1rew 11/15/82  1449.1      249138



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* format: style4,delnl,insnl,^ifthendo */
display_fnp_idle:
     procedure;

/* This command displays the data accumulated in segments by meter_fnp_idle. The
   information is displayed either in summary form or as a histogram over a specified
   time interval. */

/* Written January 1982 by Robert S. Coren */
/* Modified March 1981 by Robert S. Coren to fix entry-counting bugs */


/* AUTOMATIC */

dcl  dirname char (168);
dcl  hist bit (1);
dcl  summary bit (1);
dcl  from_time fixed bin (71);
dcl  to_time fixed bin (71);
dcl  minutes fixed bin;
dcl  line_length fixed bin;
dcl  code fixed bin (35);
dcl  fnp_names (8) char (1);
dcl  fnps (8) bit (1);				/* indicates whether an FNP is to be included */
dcl  fnpx fixed bin;
dcl  nargs fixed bin;
dcl  iarg fixed bin;
dcl  fnp_no fixed bin;
dcl  areap pointer;
dcl  earliest_of_all fixed bin (71);
dcl  latest_of_all fixed bin (71);
dcl  fnp_name char (1);
dcl  i fixed bin;
dcl  ok bit (1);
dcl  starname char (32);
dcl  entryx fixed bin;
dcl  earliest_found bit (1);
dcl  latest_found bit (1);
dcl  segx fixed bin;
dcl  entname char (32);
dcl  last_segx fixed bin;
dcl  last_start fixed bin (71);
dcl  last_finish fixed bin (71);
dcl  last_entry fixed bin;
dcl  last_time_in_seg fixed bin (71);
dcl  last_entry_in_seg fixed bin;
dcl  opening_time fixed bin (71);
dcl  closing_time fixed bin (71);
dcl  time_to_stop fixed bin (71);
dcl  total_entries fixed bin;
dcl  beginning_found bit (1);
dcl  prev_fnp_idle_datap pointer;
dcl  first_segx fixed bin;
dcl  first_entry fixed bin;
dcl  first_idle_count fixed bin (35);
dcl  first_sample_count fixed bin (35);
dcl  last_idle_count fixed bin (35);
dcl  last_sample_count fixed bin (35);
dcl  latest_beginning fixed bin (71);
dcl  min_sample fixed bin (35);
dcl  minimum_time fixed bin (71);
dcl  start_of_minimum_average fixed bin (71);
dcl  min_idle fixed bin (35);
dcl  min_idle_time fixed bin (71);
dcl  total_samples fixed bin (35);
dcl  absolute_max fixed bin (35);
dcl  overall_average float bin;
dcl  start_time_string char (24);
dcl  end_time_string char (24);
dcl  start_string char (16);
dcl  end_string char (16);
dcl  average_sample fixed bin (35);
dcl  minimum_average float bin;
dcl  min_start_string char (24);
dcl  min_end_string char (24);
dcl  min_idle_string char (24);
dcl  hist_interval fixed bin (71);
dcl  total_intervals fixed bin;
dcl  no_of_fnps fixed bin;
dcl  minimum_idle fixed bin;
dcl  fnp_id fixed bin;
dcl  next_time fixed bin (71);
dcl  valuex fixed bin;
dcl  residual bit (1);
dcl  entries_per_interval fixed bin;
dcl  last_interval_start fixed bin;
dcl  max_idle fixed bin (35);
dcl  next_entryx fixed bin;
dcl  latest_time fixed bin (71);
dcl  last_origin pointer;
dcl  end_of_last pointer;
dcl  last_interval fixed bin (71);
dcl  remaining_entries fixed bin;
dcl  scale_marks fixed bin;
dcl  top_of_scale fixed bin;
dcl  hist_width fixed bin;
dcl  cols_per_pct float bin;
dcl  space fixed bin;
dcl  ioa_str char (32);
dcl  ioa_strl fixed bin;
dcl  any bit (1);
dcl  prev_date char (8);
dcl  cur_time fixed bin (71);
dcl  suppressed (8) fixed bin;
dcl  line fixed bin;
dcl  cells fixed bin;
dcl  last_had_data bit (1);
dcl  output_line char (120);
dcl  dt_string char (24);
dcl  cur_column fixed bin;
dcl  already fixed bin;
dcl  new fixed bin;

dcl  1 output (8) aligned,
       2 column fixed bin,
       2 name char (1);

dcl  1 fnp_info_array (8) aligned like fnp_histogram_info;

dcl  names_array_ptr pointer;
dcl  seg_array_ptr pointer;
dcl  seg_count fixed bin;
dcl  idle_value_ptr pointer;
dcl  infop pointer;


/* ARGUMENT PARSING */

dcl  argp pointer;
dcl  argl fixed bin (21);
dcl  arg char (argl) based (argp);


/* BASED */

dcl  the_area area (261120) based (areap);

dcl  1 auto_area_info aligned like area_info;

dcl  1 names_array aligned based (names_array_ptr),	/* used in call to sort_intems_ */
       2 n_names,
       2 name_ptr (star_entry_count refer (names_array.n_names)) pointer unaligned;

dcl  1 seg_array aligned based (seg_array_ptr),
       2 no_of_segs fixed bin,
       2 pad bit (36),
       2 segptr (seg_count refer (seg_array.no_of_segs)) pointer;

dcl  idle_values (total_intervals, no_of_fnps) fixed bin based (idle_value_ptr);

dcl  1 fnp_histogram_info aligned based (infop),
       2 seg_array_ptr pointer,			/* points to array of pointers to segments containing data for this FNP */
       2 total_segs fixed bin,
       2 first_seg_of_interest fixed bin,		/* index in seg_array of earliest segment we will use */
       2 last_seg_of_interest fixed bin;

dcl  based_entname char (32) based;


/* ENTRIES */

dcl  define_area_ entry (ptr, fixed bin (35));
dcl  release_area_ entry (ptr);
dcl  get_wdir_ entry returns (char (168));
dcl  cu_$arg_count entry (fixed bin, fixed bin (35));
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
dcl  com_err_ entry () options (variable);
dcl  com_err_$suppress_name entry () options (variable);
dcl  parse_fnp_name_ entry (char (*), fixed bin);
dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
dcl  get_system_free_area_ entry () returns (ptr);
dcl  expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
dcl  hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35));
dcl  hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
dcl  pathname_ entry (char (*), char (*)) returns (char (168));
dcl  sort_items_$char entry (ptr, fixed bin (24));
dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  ioa_ entry () options (variable);
dcl  ioa_$rsnnl entry options (variable);
dcl  get_line_length_$switch entry (ptr, fixed bin (35)) returns (fixed bin);


/* EXTERNAL STATIC */

dcl  (
     error_table_$inconsistent,
     error_table_$noarg,
     error_table_$badopt,
     error_table_$nomatch
     ) fixed bin (35) external static;

dcl  sys_info$max_seg_size fixed bin (19) external static;

/* INTERNAL STATIC */

dcl  COMMAND_NAME char (16) internal static options (constant) init ("display_fnp_idle");
dcl  PERCENTS (10) fixed bin internal static options (constant) init (10, 20, 30, 40, 50, 60, 70, 80, 90, 100);


/* BUILTINS, CONDITIONS, ETC. */

dcl  cleanup condition;

dcl  (addr, substr, sum, divide, null, max, float, fixed, empty, index) builtin;

	dirname = get_wdir_ ();
	hist, summary = "0"b;
	from_time, to_time = 0;
	minutes = 0;
	line_length = 0;
	fnp_names (*) = " ";
	fnps (*) = "0"b;
	fnpx = 0;

	call cu_$arg_count (nargs, code);
	if code ^= 0
	then do;
	     call com_err_ (code, COMMAND_NAME);
	     return;
	end;

	if nargs = 0
	then do;
	     call com_err_$suppress_name (0, COMMAND_NAME,
		"Usage: display_fnp_idle -summary | -histogram {fnp_names} {-control_args}");
	     return;
	end;

	do iarg = 1 to nargs;
	     call cu_$arg_ptr (iarg, argp, argl, code);
	     if code ^= 0
	     then do;
		call com_err_ (code, COMMAND_NAME);
		return;
	     end;

	     if substr (arg, 1, 1) ^= "-"		/* not a control arg, must be an FNP name */
	     then do;
		call parse_fnp_name_ (arg, fnp_no);
		if fnp_no < 0
		then do;
		     call com_err_ (0, COMMAND_NAME, "^a is not a valid FNP name.", arg);
		     return;
		end;

		if fnps (fnp_no)
		then do;
		     call com_err_ (error_table_$inconsistent, COMMAND_NAME, "FNP ^a specified more than once.", arg);
		     return;
		end;

		fnps (fnp_no) = "1"b;
		fnpx = fnpx + 1;
		fnp_names (fnpx) = arg;
	     end;

	     else do;
		if arg = "-histogram" | arg = "-hist"
		then if summary
		     then go to BOTH;
		     else hist = "1"b;

		else if arg = "-summary" | arg = "-sum"
		then if hist
		     then do;
BOTH:
			call com_err_ (error_table_$inconsistent, COMMAND_NAME,
			     "Cannot specify both -histogram and -summary");
			return;
		     end;

		     else summary = "1"b;

		else if arg = "-from" | arg = "-fm"
		then from_time = get_time (arg);

		else if arg = "-to"
		then to_time = get_time (arg);

		else if arg = "-interval"
		then minutes = get_numeric_arg (arg);

		else if arg = "-line_length" | arg = "-ll"
		then do;
		     line_length = get_numeric_arg (arg);
		     if line_length < 38
		     then do;
			call com_err_ (0, COMMAND_NAME,
			     "Specified line length of ^d is less than allowable minimum of 38.", line_length);
			return;
		     end;
		end;

		else if arg = "-directory" | arg = "-dr"
		then do;
		     iarg = iarg + 1;
		     call cu_$arg_ptr (iarg, argp, argl, code);
		     if code ^= 0
		     then do;
NO_DIR:
			call com_err_ (code, COMMAND_NAME, "No directory pathname specified.");
			return;
		     end;

		     if substr (arg, 1, 1) = "-"
		     then go to NO_DIR;

		     call expand_pathname_ (arg, dirname, entname, code);
		     if code ^= 0
		     then do;
			call com_err_ (code, COMMAND_NAME, arg);
			return;
		     end;

		     dirname = pathname_ (dirname, entname);
		end;

		else do;
		     call com_err_ (error_table_$badopt, COMMAND_NAME, arg);
		     return;
		end;
	     end;
	end;

	if ^(hist | summary)
	then do;
	     call com_err_ (error_table_$noarg, COMMAND_NAME, "one of -histogram or -summary must be specified.");
	     return;
	end;

	if to_time ^= 0
	then if to_time <= from_time
	     then do;
		call com_err_ (error_table_$inconsistent, COMMAND_NAME,
		     "Time specified by -to is not later than time specified by -from");
		return;
	     end;

	if ^hist
	then if minutes ^= 0 | line_length ^= 0
	     then call com_err_ (0, COMMAND_NAME,
		     "-interval and/or -line_length was specified without -histogram, and will be ignored.");

	if fnpx = 0				/* no FNPs specified, so do them all */
	then fnps (*) = "1"b;

	idle_value_ptr = null ();
	earliest_of_all, latest_of_all = 0;
	star_entry_ptr, star_names_ptr, names_array_ptr = null ();


	area_infop = addr (auto_area_info);
	area_info.version = area_info_version_1;
	string (area_info.control) = "0"b;
	area_info.owner = COMMAND_NAME;
	area_info.size = sys_info$max_seg_size;
	area_info.areap = null ();

	call define_area_ (area_infop, code);
	if code ^= 0
	then do;
	     call com_err_ (code, COMMAND_NAME, "Could not define area.");
	     return;
	end;
	areap = area_info.areap;
	the_area = empty ();

	fnp_info_array (*).seg_array_ptr = null ();
	on cleanup call clean_up_everything;

	do i = 1 to 8;
	     if fnps (i)
	     then do;
		infop = addr (fnp_info_array (i));
		fnp_name = substr ("abcdefgh", i, 1);
		ok = "0"b;
		seg_array_ptr = null ();
		starname = "fnp_idle_data." || fnp_name || ".**";
		call hcs_$star_ (dirname, starname, star_BRANCHES_ONLY, areap, star_entry_count, star_entry_ptr,
		     star_names_ptr, code);

		if code = error_table_$nomatch
		then go to NO_DATA;

		if code ^= 0
		then call com_err_ (code, COMMAND_NAME, starname);

		else do;
		     allocate names_array in (the_area) set (names_array_ptr);
		     do entryx = 1 to star_entry_count;
			names_array.name_ptr (entryx) = addr (star_names (star_entries (entryx).nindex));
		     end;

		     call sort_items_$char (names_array_ptr, 32);
		     fnp_histogram_info.total_segs = star_entry_count;
		     seg_count = star_entry_count;
		     allocate seg_array in (the_area) set (seg_array_ptr);
		     fnp_histogram_info.seg_array_ptr = seg_array_ptr;
		     earliest_found, latest_found = "0"b;
		     do segx = 1 to seg_count while (^latest_found);
			entname = names_array.name_ptr (segx) -> based_entname;
			call hcs_$initiate (dirname, entname, "", 0, 1, seg_array.segptr (segx), code);

			if seg_array.segptr (segx) = null ()
			then call com_err_ (code, COMMAND_NAME, "Could not initiate ^a",
				pathname_ (dirname, entname));

			else do;
			     fnp_idle_data_ptr = seg_array.segptr (segx);
			     if to_time ^= 0
			     then if fnp_idle_data.time_started > to_time
				then do;
				     call hcs_$terminate_noname (fnp_idle_data_ptr, (0));
				     seg_array.segptr (segx) = null ();
				     latest_found = "1"b;
				     go to NEXT_SEG;
				end;

			     if ^earliest_found
			     then do;
				if from_time ^= 0
				then if fnp_idle_data.time_started <= from_time
				     then if fnp_idle_data.last_time <= from_time
					then do;
					     call hcs_$terminate_noname (fnp_idle_data_ptr, (0));
					     seg_array.segptr (segx) = null ();
					     go to NEXT_SEG;
					end;

				fnp_histogram_info.first_seg_of_interest = segx;
				earliest_found = "1"b;
				if earliest_of_all = 0 | fnp_idle_data.time_started < earliest_of_all
				then earliest_of_all = fnp_idle_data.time_started;
			     end;

			     last_segx = segx;
			     last_start = fnp_idle_data.time_started;
			     last_finish = fnp_idle_data.last_time;
			     if to_time ^= 0
			     then if last_finish >= to_time
				then latest_found = "1"b;
			end;
NEXT_SEG:
		     end;

		     if ^earliest_found
		     then go to NO_DATA;

		     ok = "1"b;
		     latest_of_all = max (latest_of_all, to_time, last_finish);
		     fnp_histogram_info.last_seg_of_interest = last_segx;

		     if summary
		     then do;			/* we can deal with this right now and be done with it */
			fnp_idle_data_ptr = seg_array.segptr (last_segx);
			if to_time = 0 | fnp_idle_data.last_time <= to_time
			then do;
			     last_entry = fnp_idle_data.entries_used;
			     closing_time = fnp_idle_data.last_time;
			end;

			else do;
			     last_entry =
				fnp_idle_data.entries_used
				-
				divide (fnp_idle_data.last_time - to_time, fnp_idle_data.sample_interval, 17, 0);
			     closing_time = to_time;
			end;

			total_entries = last_entry;
			beginning_found = "0"b;
			first_segx, segx = last_segx;
			first_entry = 0;
			last_idle_count = fnp_idle_data.entries (last_entry).idle_count;
			last_sample_count = fnp_idle_data.entries (last_entry).sample_count;
			min_sample = fnp_idle_data.minimum_delta_idle;
			minimum_time = fnp_idle_data.time_of_minimum_average;
			min_idle = fnp_idle_data.minimum_idle_count;
			min_idle_time = fnp_idle_data.time_of_minimum_sample;

			do while (^beginning_found);
			     if from_time = 0 | fnp_idle_data.time_started > from_time
			     then do;
				latest_beginning = fnp_idle_data.time_started;
				do segx = segx - 1 to 1 by -1 while (seg_array.segptr (segx) = null ());
				end;
				if segx < 1
				then beginning_found = "1"b;
				else do;
				     prev_fnp_idle_datap = fnp_idle_data_ptr;
						/* in case we have to go back to it */
				     fnp_idle_data_ptr = seg_array.segptr (segx);
				     if latest_beginning - fnp_idle_data.last_time
					> fnp_idle_data.sample_interval + 30000000
						/* 30-second fudge factor */
				     then do;
					beginning_found = "1"b;
					fnp_idle_data_ptr = prev_fnp_idle_datap;
						/* back to other segment */
				     end;

				     else do;
					total_entries = total_entries + fnp_idle_data.entries_used;
					if fnp_idle_data.minimum_delta_idle < min_sample
					     & fnp_idle_data.time_of_minimum_average >= from_time
					then do;
					     min_sample = fnp_idle_data.minimum_delta_idle;
					     minimum_time = fnp_idle_data.time_of_minimum_average;
					end;

					if fnp_idle_data.minimum_idle_count < min_idle
					     & fnp_idle_data.time_of_minimum_sample >= from_time
					then do;
					     min_idle = fnp_idle_data.minimum_idle_count;
					     min_idle_time = fnp_idle_data.time_of_minimum_sample;
					end;
				     end;
				end;
			     end;

			     else do;
				beginning_found = "1"b;
				first_entry =
				     divide (from_time - fnp_idle_data.time_started,
				     fnp_idle_data.sample_interval, 17, 0);
				total_entries = total_entries - first_entry;
			     end;
			end;

			first_entry = first_entry + 1;
			if total_entries <= 1 | last_entry ^> first_entry
			then go to NO_DATA;

			opening_time = max (from_time, fnp_idle_data.time_started);
			first_idle_count = fnp_idle_data.entries (first_entry).idle_count;
			first_sample_count = fnp_idle_data.entries (first_entry).sample_count;
			start_of_minimum_average = minimum_time - fnp_idle_data.sample_interval;
			total_samples = last_sample_count - first_sample_count;
			absolute_max = total_samples * fnp_idle_data.maximum_idle_count;
			overall_average = 100 * float (last_idle_count - first_idle_count) / float (absolute_max);

			call date_time_ (opening_time, start_time_string);
			call date_time_ (closing_time, end_time_string);
			start_string = substr (start_time_string, 1, 16);
			if substr (end_time_string, 1, 8) = substr (start_time_string, 1, 8)
			then end_string = substr (end_time_string, 11, 6);
			else end_string = substr (end_time_string, 1, 16);

			call ioa_ ("^/FNP ^a idle time from ^a to ^a: ^.1f%", fnp_name, start_string, end_string,
			     overall_average);

			if start_of_minimum_average >= opening_time & minimum_time <= closing_time
			then do;
			     average_sample = divide (total_samples, total_entries - 1, 35, 0);
			     minimum_average =
				100 * float (min_sample)
				/ float (average_sample * fnp_idle_data.maximum_idle_count);
			     call date_time_ (start_of_minimum_average, min_start_string);
			     call date_time_ (minimum_time, min_end_string);
			     call ioa_ ("Busiest sample interval:^/^a to ^a: ^.1f% idle",
				substr (min_start_string, 1, 16), substr (min_end_string, 11, 6), minimum_average)
				;
			end;

			if min_idle_time >= opening_time & min_idle_time <= closing_time
			then do;
			     call date_time_ (min_idle_time, min_idle_string);
			     call ioa_ ("Busiest single sample: ^a: ^.1f% idle", substr (min_idle_string, 1, 16),
				100 * float (min_idle) / float (fnp_idle_data.maximum_idle_count));
			end;
		     end;

		     if ^ok
		     then do;
NO_DATA:
			if fnpx ^= 0
			then call com_err_$suppress_name (0, COMMAND_NAME, "no data available for FNP ^a", fnp_name)
				;
			if seg_array_ptr ^= null ()
			then call free_segs;
			fnps (i) = "0"b;
		     end;

		     if star_names_ptr ^= null ()
		     then do;
			free star_names;
			star_names_ptr = null ();
		     end;

		     if star_entry_ptr ^= null ()
		     then do;
			free star_entries;
			star_entry_ptr = null ();
		     end;

		     if names_array_ptr ^= null ()
		     then do;
			free names_array;
			names_array_ptr = null ();
		     end;
		end;
	     end;
	end;

	if hist
	then do;
	     if minutes = 0
	     then minutes = 15;			/* default */
	     hist_interval = 60000000 * minutes;	/* convert to microseconds */

	     if earliest_of_all < from_time
	     then earliest_of_all = from_time;
	     if to_time ^= 0
	     then if latest_of_all > to_time
		then latest_of_all = to_time;

	     total_intervals = divide (latest_of_all - earliest_of_all, hist_interval, 17, 0);
	     no_of_fnps = 0;
	     do i = 1 to 8;
		if fnps (i)
		then no_of_fnps = no_of_fnps + 1;
	     end;
	     if no_of_fnps = 0
	     then go to ALL_DONE;

	     allocate idle_values in (the_area) set (idle_value_ptr);
	     idle_values (*, *) = -1;			/* initialize to value indicating no data */
	     fnpx = 0;
	     minimum_idle = 100;

	     do fnp_id = 1 to 8;
		if fnps (fnp_id)
		then do;
		     fnpx = fnpx + 1;
		     fnp_names (fnpx) = substr ("ABCDEFGH", fnp_id, 1);
		     infop = addr (fnp_info_array (fnp_id));
		     seg_array_ptr = fnp_histogram_info.seg_array_ptr;
		     next_time = earliest_of_all;
		     valuex = 1;
		     residual = "0"b;

		     do segx = fnp_histogram_info.first_seg_of_interest
			to fnp_histogram_info.last_seg_of_interest while (next_time < latest_of_all);
			fnp_idle_data_ptr = seg_array.segptr (segx);
			if fnp_idle_data_ptr = null ()
			then go to SCAN_NEXT_SEG;

			if fnp_idle_data.last_time < next_time
			then go to SCAN_NEXT_SEG;

			entries_per_interval = divide (hist_interval, fnp_idle_data.sample_interval, 17, 0);
			if entries_per_interval = 0	/* data is too sparse */
			then go to SCAN_NEXT_SEG;

			last_time_in_seg = fnp_idle_data.last_time;
			last_entry_in_seg = fnp_idle_data.entries_used;
			max_idle = fnp_idle_data.maximum_idle_count;
			if residual
			then do;
			     if fnp_idle_data.sample_interval = last_interval
				& fnp_idle_data.time_started - latest_time <= last_interval + 30000000
						/* 30-second fudge factor */
				& fnp_idle_data.time_started > latest_time
			     then call store_value (last_origin,
				     addr (fnp_idle_data.entries (entries_per_interval - remaining_entries + 1)));
			     else call store_value (last_origin, end_of_last);
			     next_time = next_time + hist_interval;
			     residual = "0"b;
			end;

			if fnp_idle_data.time_started > next_time
			then do;			/* we have to skip some */
			     valuex =
				valuex + divide (fnp_idle_data.time_started - next_time, hist_interval, 17, 0);
			     next_time = fnp_idle_data.time_started;
			     first_entry = 1;
			end;

			else first_entry =
				divide (next_time - fnp_idle_data.time_started, fnp_idle_data.sample_interval, 17,
				0) + 1;
			last_interval_start = last_entry_in_seg - entries_per_interval + 1;
			time_to_stop = min (last_time_in_seg, latest_of_all);

			do entryx = first_entry to last_interval_start by entries_per_interval
			     while (next_time < time_to_stop);
			     next_entryx = entryx + entries_per_interval;
			     if next_entryx <= last_entry_in_seg
			     then call store_value (addr (fnp_idle_data.entries (entryx)),
				addr (fnp_idle_data.entries (next_entryx)));
			     next_time = next_time + hist_interval;
			end;

			if entryx < last_entry_in_seg & next_time < latest_of_all
			then do;
			     residual = "1"b;
			     latest_time = last_time_in_seg;
			     last_origin = addr (fnp_idle_data.entries (entryx));
			     end_of_last = addr (fnp_idle_data.entries (last_entry_in_seg));
			     last_interval = fnp_idle_data.sample_interval;
			     remaining_entries = last_entry_in_seg - entryx + 1;
			end;
SCAN_NEXT_SEG:
		     end;
		end;
	     end;

/* now format it */

	     if line_length = 0
	     then do;
		line_length = get_line_length_$switch (null (), code);
		if code ^= 0
		then line_length = 80;
	     end;

	     scale_marks = max (10 - divide (minimum_idle, 10, 17, 0), 5);
	     top_of_scale = 10 * scale_marks;
	     hist_width = min (100, line_length - 17);
	     hist_width = hist_width - mod (hist_width, scale_marks);
	     cols_per_pct = float (hist_width) / float (top_of_scale);

	     space = divide (hist_width, scale_marks, 17, 0);
	     call ioa_$rsnnl ("^^9x%busy^^2x0^^^d(^^^dd^^)", ioa_str, ioa_strl, scale_marks, space);
	     call ioa_ (substr (ioa_str, 1, ioa_strl), PERCENTS);
	     call ioa_$rsnnl ("^^16x|^^^d(^^^dx|^^)", ioa_str, ioa_strl, scale_marks, space - 1);
	     call ioa_ (substr (ioa_str, 1, ioa_strl));

	     any = "0"b;
	     prev_date = " ";
	     cur_time = earliest_of_all;
	     suppressed (*) = 0;

	     do line = 1 to total_intervals;
		cells = 0;
		do fnp_no = 1 to no_of_fnps;
		     if idle_values (line, fnp_no) ^= -1
		     then do;
			cells = cells + 1;
			output.column (cells) = 17 + fixed (cols_per_pct * (100 - idle_values (line, fnp_no)));
			output.name (cells) = fnp_names (fnp_no);
		     end;
		end;

		if cells = 0
		then if any
		     then if last_had_data
			then do;
			     call ioa_ ("^16(-^)");
			     last_had_data = "0"b;
			end;
			else ;
		     else ;

		else do;
		     any = "1"b;
		     last_had_data = "1"b;
		     output_line = " ";
		     call date_time_ (cur_time, dt_string);
		     if substr (dt_string, 1, 8) ^= prev_date
		     then prev_date, substr (output_line, 1, 8) = substr (dt_string, 1, 8);
		     substr (output_line, 10, 5) = substr (dt_string, 11, 5);

		     do i = 1 to cells;
			cur_column = output (i).column;
			if substr (output_line, cur_column, 1) = " "
			then substr (output_line, cur_column, 1) = output (i).name;
			else do;
			     already = index ("ABCDEFGH", substr (output_line, cur_column, 1));
			     new = index ("ABCDEFGH", output (i).name);
			     if suppressed (already) >= suppressed (new)
			     then suppressed (new) = suppressed (new) + 1;
			     else do;
				substr (output_line, cur_column, 1) = output (i).name;
				suppressed (already) = suppressed (already) + 1;
			     end;
			end;
		     end;

		     call ioa_ (output_line);
		end;

		cur_time = cur_time + hist_interval;
	     end;
	end;

ALL_DONE:
	call clean_up_everything;
EXIT:
	return;

get_numeric_arg:
     procedure (name) returns (fixed bin);

dcl  name char (*);
dcl  result fixed bin;

	iarg = iarg + 1;
	call cu_$arg_ptr (iarg, argp, argl, code);
	if code ^= 0
	then do;
NO_NUMERIC_ARG:
	     call com_err_ (code, COMMAND_NAME, "No value specified for ^a.", name);
	     go to EXIT;
	end;

	else if substr (arg, 1, 1) = "-"
	then do;
	     code = error_table_$noarg;
	     go to NO_NUMERIC_ARG;
	end;

	result = cv_dec_check_ (arg, code);
	if code ^= 0
	then do;
	     call com_err_ (0, COMMAND_NAME, "^a is not a valid value for ^a.", arg, name);
	     go to EXIT;
	end;

	return (result);
     end get_numeric_arg;

get_time:
     procedure (arg_name) returns (fixed bin (71));

dcl  arg_name char (*);
dcl  time fixed bin (71);
dcl  convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35));

	iarg = iarg + 1;
	call cu_$arg_ptr (iarg, argp, argl, code);
	if code ^= 0
	then do;
	     call com_err_ (code, COMMAND_NAME, "No value supplied for ^a", arg_name);
	     go to EXIT;
	end;

	call convert_date_to_binary_ (arg, time, code);
	if code ^= 0
	then do;
	     call com_err_ (code, COMMAND_NAME, """^a"" is not a valid time.", arg);
	     go to EXIT;
	end;

	else return (time);

     end get_time;

store_value:
     procedure (first_entryp, last_entryp);

dcl  first_entryp pointer;
dcl  last_entryp pointer;

dcl  delta_sample fixed bin (35);
dcl  max_possible fixed bin (35);
dcl  value fixed bin;

	delta_sample = last_entryp -> fnp_idle_entry.sample_count - first_entryp -> fnp_idle_entry.sample_count;
	max_possible = delta_sample * max_idle;
	value =
	     divide (100 * (last_entryp -> fnp_idle_entry.idle_count - first_entryp -> fnp_idle_entry.idle_count),
	     max_possible, 17, 0);
	idle_values (valuex, fnpx) = value;
	if value < minimum_idle
	then minimum_idle = value;
	valuex = valuex + 1;
	return;

     end store_value;

clean_up_everything:
     procedure;

dcl  infox fixed bin;

	do infox = 1 to 8;
	     if fnps (infox)
	     then do;
		infop = addr (fnp_info_array (infox));
		seg_array_ptr = fnp_histogram_info.seg_array_ptr;
		if seg_array_ptr ^= null ()
		then call free_segs;
	     end;
	end;

	if idle_value_ptr ^= null ()
	then free idle_values;

	if star_names_ptr ^= null ()
	then free star_names;

	if star_entry_ptr ^= null ()
	then free star_entries;

	if names_array_ptr ^= null ()
	then free names_array;

	idle_value_ptr, star_entry_ptr, star_names_ptr, names_array_ptr = null ();
	call release_area_ (areap);
	return;

     end clean_up_everything;

free_segs:
     procedure;

	do segx = 1 to seg_array.no_of_segs;
	     if seg_array.segptr (segx) ^= null ()
	     then call hcs_$terminate_noname (seg_array.segptr (segx), (0));
	end;
	free seg_array_ptr -> seg_array;
	seg_array_ptr, fnp_histogram_info.seg_array_ptr = null ();
	return;

     end free_segs;

%include fnp_idle_data;
%page;
%include star_structures;
%page;
%include area_info;

     end display_fnp_idle;




		    fnp_throughput.pl1              10/25/89  1156.0r w 10/25/89  1005.1       65826



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* format: style4,delnl,insnl,^ifthendo */
fnp_throughput:
     procedure;

/* Command to report throughput statistics for one FNP or all FNPs */
/* Usage: fnp_throughput {fnp_name | * {-report_reset}} | {-reset} */

/* written September 1981 by Robert Coren */

/* AUTOMATIC */

dcl  nargs fixed bin;
dcl  code fixed bin (35);
dcl  chan_name char (1);
dcl  report bit (1);
dcl  reset bit (1);
dcl  iarg fixed bin;
dcl  fnp_no fixed bin;
dcl  reported bit (1);
dcl  time_now fixed bin (71);
dcl  areap ptr;
dcl  star_name (1) char (1);
dcl  n_channels fixed bin;
dcl  orig_chan_meterp ptr;
dcl  chanx fixed bin;
dcl  time_from fixed bin (71);
dcl  time_interval fixed bin (71);
dcl  cur_input_chars fixed bin (35);
dcl  cur_output_chars fixed bin (35);

dcl  1 fnp_stats aligned,
       2 input_chars fixed bin (35),
       2 output_chars fixed bin (35);

dcl  argp ptr;
dcl  argl fixed bin (21);
dcl  arg char (argl) based (argp);


/* ENTRIES */

dcl  cu_$arg_count entry (fixed bin, fixed bin (35));
dcl  com_err_ entry () options (variable);
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
dcl  parse_fnp_name_ entry (char (*), fixed bin);
dcl  get_system_free_area_ entry () returns (ptr);
dcl  comm_meters_ entry ((*) char (*), fixed bin, ptr, fixed bin, ptr, fixed bin (35));
dcl  comm_meters_$free entry (ptr, ptr, fixed bin (35));
dcl  system_info_$timeup entry (fixed bin (71));
dcl  ioa_ entry () options (variable);
dcl  meter_format_$picture entry (fixed bin (35), fixed bin) returns (char (15) var);
dcl  meter_format_$time entry (fixed bin (71)) returns (char (10));


/* EXTERNAL STATIC */

dcl  (
     error_table_$wrong_no_of_args,
     error_table_$badopt,
     error_table_$noarg,
     error_table_$inconsistent,
     error_table_$no_channel_meters
     ) fixed bin (35) external static;


/* INTERNAL STATIC */

dcl  CMD_NAME char (14) internal static options (constant) init ("fnp_throughput");

dcl  first_time bit (1) internal static init ("1"b);
dcl  earliest_time fixed bin (71) internal static;

dcl  1 prev_fnp_stats (8) aligned internal static like fnp_stats;


/* BUILTIN FUNCTIONS */

dcl  (substr, clock, max, divide) builtin;

	call cu_$arg_count (nargs, code);
	if code ^= 0
	then do;
	     call com_err_ (code, CMD_NAME);
	     return;
	end;

	if nargs < 1 | nargs > 2
	then do;
	     call com_err_ (error_table_$wrong_no_of_args, CMD_NAME,
		"^/Usage: ^a channel_name {-report_reset} | {-reset}", CMD_NAME);
	     return;
	end;

	chan_name = " ";
	report = "1"b;
	reset = "0"b;
	do iarg = 1 to nargs;
	     call cu_$arg_ptr (iarg, argp, argl, code);
	     if substr (arg, 1, 1) = "-"
	     then do;
		if arg = "-reset" | arg = "-rs"
		then do;
		     report = "0"b;
		     reset = "1"b;
		end;

		else if arg = "-report_reset" | arg = "-rr"
		then report, reset = "1"b;

		else do;
		     call com_err_ (error_table_$badopt, CMD_NAME, arg);
		     return;
		end;
	     end;

	     else do;
		if chan_name ^= " "
		then do;
		     call com_err_ (0, CMD_NAME, "More than one FNP name specified.");
		     return;
		end;

		if arg = "*"
		then ;
		else do;
		     call parse_fnp_name_ (arg, fnp_no);
		     if fnp_no = -1
		     then do;
			call com_err_ (0, CMD_NAME, "^a is not a valid FNP name.", arg);
			return;
		     end;
		end;

		chan_name = arg;
	     end;
	end;

	if chan_name = " "
	then if report
	     then do;				/* didn't tell us who to get */
		call com_err_ (error_table_$noarg, CMD_NAME, "No FNP name supplied.");
		return;
	     end;
	     else ;

	else if ^report
	then do;
	     call com_err_ (error_table_$inconsistent, CMD_NAME, "Cannot specify FNP name and -reset.");
	     return;
	end;

/* Arguments all parsed, now do the real work */

	reported = "0"b;
	if first_time
	then do;
	     prev_fnp_stats (*) = 0;
	     call system_info_$timeup (earliest_time);
	     first_time = "0"b;
	end;

	time_now = clock ();
	call ioa_ ("Total metering time ^a", meter_format_$time (time_now - earliest_time));

	if reset
	then star_name (1) = "*";			/* need statistics on everyone to reset */
	else star_name (1) = chan_name;

	areap = get_system_free_area_ ();
	call comm_meters_ (star_name, CHANNEL_METERS_VERSION_1, areap, n_channels, chan_meterp, code);
	if code ^= 0				/* comm_meters_ calls sub_err_, so don't sweat it */
	then return;

	orig_chan_meterp = chan_meterp;		/* we'll need this later for freeing */
	do chanx = 1 to n_channels;
	     if channel_meters.multiplexer_type = MCS_MPX /* only ones we're interested in */
	     then do;
		call parse_fnp_name_ ((channel_meters.channel_name), fnp_no);
						/* find out which one this is */
		if fnp_no > 0			/* it would be awfully surprising if it weren't */
		then do;
		     fnp_meterp = channel_meters.mpx_specific_meterp;
		     fnp_stats.input_chars = channel_meters.cumulative.unconverted_input_chars;
		     fnp_stats.output_chars = channel_meters.cumulative.converted_output_chars;

		     if report			/* not just -reset */
		     then if chan_name = "*"		/* we want them all */
			     | chan_name = channel_meters.channel_name
						/* or anyway we want this one */
			then do;
			     if ^reported
			     then do;
				call ioa_ ("^35tinput^10xoutput");
				reported = "1"b;
			     end;

			     time_from = max (earliest_time, fnp_meters.from_fnp.time_booted);
			     time_interval = divide (time_now - time_from, 1000000, 71, 0);
			     cur_input_chars = fnp_stats.input_chars - prev_fnp_stats (fnp_no).input_chars;
			     cur_output_chars = fnp_stats.output_chars - prev_fnp_stats (fnp_no).output_chars;

			     call ioa_ ("^/FNP ^a -- up ^[for ^a^;time not available^]",
				channel_meters.channel_name, fnp_meters.from_fnp.time_booted ^= 0,
				meter_format_$time (time_now - fnp_meters.from_fnp.time_booted));
			     call ioa_ ("Characters transmitted^29t^a^44t^a",
				meter_format_$picture (cur_input_chars, 11),
				meter_format_$picture (cur_output_chars, 11));
			     call ioa_ ("Characters per second^29t^a^44t^a",
				meter_format_$picture (divide (cur_input_chars, time_interval, 35, 0), 11),
				meter_format_$picture (divide (cur_output_chars, time_interval, 35, 0), 11));
			end;

		     if reset
		     then prev_fnp_stats (fnp_no) = fnp_stats;
		end;
	     end;

	     chan_meterp = channel_meters.next_channelp;	/* on to next channel */
	end;

	call comm_meters_$free (areap, orig_chan_meterp, code);
	if code ^= 0				/* unlikely, but we should check */
	then call com_err_ (code, CMD_NAME, "From comm_meters_$free");

	if report & ^reported			/* wanted some display and didn't get it */
	then call com_err_ (error_table_$no_channel_meters, CMD_NAME, chan_name);

	if reset
	then earliest_time = time_now;

	return;

%include channel_meters;
%page;
%include fnp_meters;
%page;
%include multiplexer_types;

     end fnp_throughput;




		    hasp_dump_.pl1                  07/20/88  1256.8r w 07/19/88  1537.3      157572



/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */

/* Interpret a HASP multiplexer database:  called from tty_dump and tty_analyze */

/* Created:  November 1979 by G. Palter */
/* Modified: December 1980 by G. Palter as part of "loopback bug" fix */
/* Modified: 30 March 1981 by G. Palter to add last_loopback_bcb to HMD */
/* Modified: 16 April 1981 by G. Palter to interpret rts_mode flag in HMD */
/* Modified: July 1981 by G. Palter to support SIGNON processing and metering */
/* Modified: 20 August 1981 by G. Palter to correct bugs in displaying minor-state and loopback stacks */
/* Modified: 29 December 1981 by G. Palter to let the analyze entry print the buffer chain and to properly order calls to
      the analyzer's check_used procedure which writes into its arguments */
/* Modified: 5 January 1982 by G. Palter to not display the HMD when displaying the HSTE of a single subchannel */


hasp_dump_:
     procedure (P_ttybp, P_ttyap, P_hmd_ptr, P_subchannel_idx, P_brief_sw);


/* Parameters */

dcl  P_ttybp pointer parameter;			/* -> tty_buf segment */
dcl  P_ttyap pointer parameter;			/* -> tty_area segment */

dcl  P_hmd_ptr pointer parameter;			/* hasp_dump_:  -> HASP multiplexer data */
dcl  P_subchannel_idx fixed binary parameter;		/* hasp_dump_:  index of sub-channel to dump (-1 for all) */
dcl  P_brief_sw bit (1) parameter;			/* hasp_dump_:  ON => brief output format */

dcl  P_devx fixed binary parameter;			/* hasp_analyze_:  LCT index of HASP multiplexer channel */
dcl  P_check_used entry variable parameter;		/* hasp_analyze_:  tracks space used in tty_buf */
dcl  P_long_sw bit (1) parameter;			/* hasp_analyze_:  ON => long output format */


/* Local copies of parameters */

dcl  subchannel_idx fixed binary;
dcl  brief_sw bit (1);

dcl  devx fixed binary;
dcl  check_used entry () options (variable) variable;


/* Remaining declarations */

dcl  analyze_entry bit (1) aligned;			/* ON => hasp_analyze_; OFF => hasp_dump_ */

dcl  idx fixed binary;

dcl (ioa_, ioa_$nnl) entry () options (variable);
dcl  tty_dump$print_chain entry (pointer, character (*), fixed binary (18), bit (1));

dcl (addr, binary, currentsize, null, pointer, rel, unspec) builtin;
%page;
/* Dump a HASP multiplexer database and sub-channels (if requested) */

/* hasp_dump_:
     entry (P_ttybp, P_ttyap, P_hmd_ptr, P_subchannel_idx, P_brief_sw); */

	analyze_entry = "0"b;

	ttybp = P_ttybp;				/* copy parameters */
	hmd_ptr = P_hmd_ptr;
	subchannel_idx = P_subchannel_idx;
	brief_sw = P_brief_sw;

	if (subchannel_idx = -1) | (subchannel_idx = 0) then
	     call dump_multiplexer_data ();		/* global data only */
	else call dump_subchannel_data (subchannel_idx);	/* data about one subchannel */

	return;



/* Analyze a HASP multiplexer database and all sub-channels */

hasp_analyze_:
     entry (P_ttybp, P_ttyap, P_devx, P_check_used, P_long_sw);

	analyze_entry = "1"b;

	ttybp = P_ttybp;				/* copy parameters */
	devx = P_devx;
	check_used = P_check_used;
	brief_sw = ^P_long_sw;			/* dump entry works the other way */

	lctp = pointer (ttybp, rel (tty_buf.lct_ptr));
	lctep = addr (lct.lcte_array (devx));
	hmd_ptr = pointer (ttybp, rel (lcte.data_base_ptr));

	call dump_multiplexer_data ();

	do subchannel_idx = 1 to hmd.n_subchannels;
	     call dump_subchannel_data (subchannel_idx);
	end;

	call trace_buffer_chain (binary (rel (hmd.output_chain_ptr), 18, 0));
	call trace_buffer_chain (binary (rel (hmd.input.first_bufferp), 18, 0));
	call trace_buffer_chain (binary (rel (hmd.loopback.first_bufferp), 18, 0));
	call trace_buffer_chain (binary (rel (hmd.output_block.first_bufferp), 18, 0));

	do idx = 1 to hmd.n_subchannels;
	     hste_ptr = addr (hmd.subchannels (idx));
	     call trace_buffer_chain (binary (rel (hste.input.first_bufferp), 18, 0));
	     call trace_buffer_chain (binary (rel (hste.loopback.first_bufferp), 18, 0));
	     call trace_buffer_chain (binary (rel (hste.output.first_bufferp), 18, 0));
	end;

	call check_used (hmd_ptr, currentsize (hmd));

	return;
%page;
/* Dump the multiplexer's database (and the requested sub-channels also) */

dump_multiplexer_data:
	procedure ();

	     call ioa_ ("^/HMD at ^o; channel ^a; devx ^o", binary (rel (hmd_ptr), 18, 0), hmd.name, hmd.devx);
	
	     call ioa_ ("configuration:^/^3xtype = ^[workstation^;host^]; max_block_size = ^d", (hmd.type + 1),
			hmd.max_block_size);
	     if ^brief_sw then do;			/* only in long mode, please... */
		call ioa_ ("^3xmax_device_input_records = ^d; max_device_output_records = ^d",
			 hmd.max_device_input_records, hmd.max_device_output_records);
		call ioa_ ("^3xic_timeout = ^d; receive_timeout = ^d; transmit_timeout = ^d",
			 hmd.ic_timeout, hmd.receive_timeout, hmd.transmit_timeout);
	     end;
	     call ioa_ ("^3xflags:^[ suspend_all_mode^]^[ signon_mode^]^[ multileave_mode^]^[ trace_mode^]^[ rts_mode^]",
			hmd.suspend_all_mode, hmd.signon_mode, hmd.multileave_mode, hmd.trace_mode, hmd.rts_mode);

	     if ^brief_sw then			/* keep it short when requested */
		call ioa_ ("loader_process = ^.3b; loader_event = ^.3b", hmd.loader_process_id, unspec (hmd.loader_event_channel));

	     call ioa_ ("state = ^[down^;loading^;loaded^;started^]; minor_state = ^[send-signon^;wait-signon-response^;normal^;send-sync^;loopback^;reprocess^;send-bad-bcb^;hangup^]",
			hmd.state, hmd.minor_state);

	     call ioa_ ("foreign_block_count = ^d; foreign_fcs_bytes = ^6.3b; local_block_count = ^d; local_fcs_bytes = ^6.3b",
			hmd.foreign_block_count, unspec (hmd.foreign_fcs_bytes),
			hmd.local_block_count, unspec (hmd.local_fcs_bytes));

	     call ioa_ ("subchannels_for_output.first = ^d; subchannels_for_output.last = ^d",
			hmd.subchannels_for_output.first, hmd.subchannels_for_output.last);

	     if hmd.output_chain_ptr ^= null () then
		call ioa_ ("output_chain_ptr = ^p", hmd.output_chain_ptr);

	     if hmd.input.first_bufferp ^= null () then
		call ioa_ ("input.first_bufferp = ^p; input.last_bufferp = ^p", hmd.input.first_bufferp, hmd.input.last_bufferp);

	     if hmd.loopback.first_bufferp ^= null () then
		call ioa_ ("loopback.first_bufferp = ^p; loopback.last_bufferp = ^p", hmd.loopback.first_bufferp, hmd.loopback.last_bufferp);

	     if hmd.output_block.first_bufferp ^= null () then
		call ioa_ ("output_block.subchannel_idx = ^d, output_block.tally = ^d; output_block.first_bufferp = ^p; output_block.last_bufferp = ^p",
			     hmd.output_block.subchannel_idx, hmd.output_block.tally,
			     hmd.output_block.first_bufferp, hmd.output_block.last_bufferp);

	     call ioa_ ("signon_data = ^[none^s^;^p^]; minor_state_stack = ^[none^s^;^p^]; loopback_block_chain_stack = ^[none^s^;^p^]; last_loopback_bcb = ^3.3b",
		      (hmd.signon_data_ptr = null ()), hmd.signon_data_ptr,
		      (hmd.minor_state_stack = null ()), hmd.minor_state_stack,
		      (hmd.loopback_block_chain_stack = null ()), hmd.loopback_block_chain_stack,
		      unspec (hmd.last_loopback_bcb));

	     call ioa_ ("input_wabs (0:8) =^9(^[ on^; off^]^)", hmd.input_wabs (*));
	     call ioa_ ("output_wabs (0:8) =^9(^[ on^; off^]^)", hmd.output_wabs (*));
	     call ioa_ ("send_rts (0:8) = ^9(^[ on^; off^]^)", hmd.send_rts (*));
	     call ioa_ ("send_rts_ack (0:8) =^9(^[ on^; off^]^)", hmd.send_rts_ack (*));

	     call ioa_$nnl ("flags:^[ suspend_all_output^]^[ suspend_all_input^]^[ send_output^]^[ input_available^]^[ output_in_progress^]^[ first_foreign_block^]^[ reset_local_block_count^]",
			hmd.suspend_all_output, hmd.suspend_all_input, hmd.send_output, hmd.flags.input_available,
			hmd.output_in_progress, hmd.first_foreign_block, hmd.reset_local_block_count);

	     call ioa_ ("^[ retry_transmit_output^]^[ retry_process_output^]^[ retry_process_loopback_records^]^[ retry_process_input^]",
		      retry_transmit_output, hmd.retry_process_output, hmd.retry_process_loopback_records,
		      hmd.retry_process_input);

	     call ioa_ ("console_hste_idx = ^d; n_subchannels = ^d", hmd.console_hste_idx, hmd.n_subchannels);

	     if hmd.output_chain_ptr ^= null () then
		call tty_dump$print_chain (ttybp, "Output-chain", binary (rel (hmd.output_chain_ptr), 18, 0), brief_sw);

	     if hmd.input.first_bufferp ^= null () then
		call tty_dump$print_chain (ttybp, "Input-chain", binary (rel (hmd.input.first_bufferp), 18, 0), brief_sw);

	     if hmd.loopback.first_bufferp ^= null () then
		call tty_dump$print_chain (ttybp, "Loopback-chain", binary (rel (hmd.loopback.first_bufferp), 18, 0), brief_sw);

	     if hmd.output_block.first_bufferp ^= null () then
		call tty_dump$print_chain (ttybp, "Output-block", binary (rel (hmd.output_block.first_bufferp), 18, 0), brief_sw);

	     if ^brief_sw then			/* keep it short */
		call dump_multiplexer_meters ();

	     if hmd.signon_data_ptr ^= null () then
		call dump_signon_data ();

	     if hmd.minor_state_stack ^= null () then
		call dump_minor_state_stack ();

	     if hmd.loopback_block_chain_stack ^= null () then
		call dump_loopback_block_chain_stack ();

	     return;

	end dump_multiplexer_data;
%page;
/* Print the database for an individual HASP sub-channel */

dump_subchannel_data:
	procedure (P_subchannel_idx);

dcl  P_subchannel_idx fixed binary parameter;

	     hste_ptr = addr (hmd.subchannels (P_subchannel_idx));

	     call ioa_ ("^/HSTE at ^o; channel ^a.^a; devx ^o", binary (rel (hste_ptr), 18, 0), hmd.name, hste.name, hste.devx);

	     call ioa_ ("subchannel_idx = ^d; device_type = ^[console^;reader^;printer^;punch^]; direction = ^[i/o^;input^;output^]",
			hste.subchannel_idx, hste.device_type, (hste.direction + 1));

	     call ioa_ ("rcb = ^3.3b; device_wab_idx = ^d", unspec (hste.rcb), hste.device_wab_idx);

	     call ioa_ ("state = ^[hungup^;listening^;dialed^]; minor_state = ^[normal^;send-rts^;wait-rts-ack^]; next_subchannel_for_output = ^d",
			hste.state, hste.minor_state, hste.next_subchannel_for_output);

	     if hste.input.first_bufferp ^= null () then
		call ioa_ ("input.n_records = ^d; input.first_bufferp = ^p; input.last_bufferp = ^p",
			     hste.input.n_records, hste.input.first_bufferp, hste.input.last_bufferp);

	     if hste.loopback.first_bufferp ^= null () then
		call ioa_ ("loopback.n_records = ^d; loopback.first_bufferp = ^p; loopback.last_bufferp = ^p",
			     hste.loopback.n_records, hste.loopback.first_bufferp, hste.loopback.last_bufferp);

	     if hste.output.first_bufferp ^= null () then
		call ioa_ ("output.first_bufferp = ^p; output.last_bufferp = ^p", hste.output.first_bufferp,
			     hste.output.last_bufferp);

	     call ioa_ ("flags:^[ requested_input^]^[ input_available^]^[ holding_output^]",
			hste.requested_input, hste.input_available, hste.holding_output);

	     if ^brief_sw then			/* keep it short */
		call dump_subchannel_meters ();

	     if hste.input.first_bufferp ^= null () then
		call tty_dump$print_chain (ttybp, "Input-chain", binary (rel (hste.input.first_bufferp), 18, 0), brief_sw);

	     if hste.loopback.first_bufferp ^= null () then
		call tty_dump$print_chain (ttybp, "Loopback-chain", binary (rel (hste.loopback.first_bufferp), 18, 0), brief_sw);

	     if hste.output.first_bufferp ^= null () then
		call tty_dump$print_chain (ttybp, "Output-chain", binary (rel (hste.output.first_bufferp), 18, 0), brief_sw);

	     return;

	end dump_subchannel_data;
%page;
/* Dump the multiplexer channel's metering data */

dump_multiplexer_meters:
	procedure ();

	     call ioa_ ("meters:^/^3xtime_mpx_booted = ^.3b; time_meters_copied = ^.3b; saved_meters_ptr = ^p",
		      unspec (hmd.time_mpx_booted), unspec (hmd.time_meters_copied), hmd.saved_meters_ptr);

	     call ioa_ ("^3xn_local_wab_set = ^d; n_input_blocks = ^d; n_input_records = ^d; n_duplicate_input_blocks = ^d",
		      hmd.n_local_wab_set, hmd.n_input_blocks, hmd.n_input_records, hmd.n_duplicate_input_blocks);

	     call ioa_ ("^3xn_foreign_wab_set = ^d; n_output_blocks = ^d; n_output_records = ^d",
		      hmd.n_foreign_wab_set, hmd.n_output_blocks, hmd.n_output_records);

	     call ioa_ ("^3xn_wraparounds = ^d; n_wraparound_blocks = ^d", hmd.n_wraparounds, hmd.n_wraparound_blocks);

	     return;

	end dump_multiplexer_meters;
%page;
/* Dump the meters associated with a subchannel */

dump_subchannel_meters:
	procedure ();

	     call ioa_ ("meters: saved_meters_ptr = ^p", hste.saved_meters_ptr);

	     call ioa_ ("^3xn_local_wab_set = ^d; n_input_records = ^d; n_input_eof_records = ^d",
		      hste.device_n_local_wab_set, hste.device_n_input_records, hste.device_n_input_eof_records);

	     call ioa_ ("^3xn_foreign_wab_set = ^d; n_output_records = ^d; n_output_eof_records = ^d",
		      hste.device_n_foreign_wab_set, hste.device_n_output_records, hste.device_n_output_eof_records);

	     return;

	end dump_subchannel_meters;
%page;
/* Dump the SIGNON data associated with this multiplexer */

dump_signon_data:
	procedure ();

	     hsd_ptr = pointer (ttybp, rel (hmd.signon_data_ptr));

	     if ^brief_sw then			/* keep it short */
		call ioa_ ("SIGNON data at ^o:^/^3xsignon_record_process = ^.3b; signon_record_event = ^.3b",
			 binary (rel (hsd_ptr), 18, 0), hmd_signon_data.processid,
			 unspec (hmd_signon_data.event_channel));

	     if analyze_entry then
		call check_used (hsd_ptr, currentsize (hmd_signon_data));

	     return;				/* don't bother to dump the actual record */

	end dump_signon_data;
%page;
/* Dump the minor state stack */

dump_minor_state_stack:
	procedure ();

dcl  next_msse_ptr pointer;

	     do msse_ptr = pointer (ttybp, rel (hmd.minor_state_stack))
		         repeat (next_msse_ptr) while (msse_ptr ^= null ());
		call dump_msse ();
		if (msse.previous = null ()) then
		     next_msse_ptr = null ();
		else next_msse_ptr = pointer (ttybp, rel (msse.previous));
	     end;

	     return;



/* Dump a single entry on the minor state stack */

dump_msse:     procedure ();

dcl  idx fixed binary;

		call ioa_ ("^/MSSE at ^o; ^[previous = ^p^;last entry^s^]; minor_state = ^[send-signon^;wait-signon-response^;normal^;send-sync^;loopback^;reprocess^;send-bad-bcb^;hangup^]",
			 binary (rel (msse_ptr), 18, 0), (msse.previous ^= null ()), msse.previous, msse.minor_state);

		do idx = 1 to hmd.n_subchannels;
		     if msse.subchannels(idx).loopback.first_bufferp ^= null () then do;
			call ioa_ ("^3xSubchannel ^d; loopback.n_records = ^d; loopback.first_bufferp = ^p; loopback.last_bufferp = ^d",
				 idx, msse.subchannels(idx).loopback.n_records,
				 msse.subchannels(idx).loopback.first_bufferp,
				 msse.subchannels(idx).loopback.last_bufferp);
			call tty_dump$print_chain (ttybp, "Saved loopback records",
					       binary (rel (msse.subchannels(idx).loopback.first_bufferp),
						     18, 0),
					       brief_sw);
			if analyze_entry then
			     call trace_buffer_chain (binary (rel (msse.subchannels(idx).loopback.first_bufferp),
						        18, 0));
		     end;
		end;

		if analyze_entry then
		     call check_used (msse_ptr, currentsize (msse));

		return;

	     end dump_msse;

	end dump_minor_state_stack;
%page;
/* Dump the loopback block chain stack */

dump_loopback_block_chain_stack:
	procedure ();

dcl  next_lbcse_ptr pointer;

	     do lbcse_ptr = pointer (ttybp, rel (hmd.loopback_block_chain_stack))
			repeat (next_lbcse_ptr) while (lbcse_ptr ^= null ());
		call dump_lbcse ();
		if (lbcse.previous = null ()) then
		     next_lbcse_ptr = null ();
		else next_lbcse_ptr = pointer (ttybp, rel (lbcse.previous));
	     end;

	     return;



/* Dump a single entry on the stack */

dump_lbcse:    procedure ();

		call ioa_ ("^/LBCSE at ^o; ^[previous = ^p^;last entry^s^]; first_bufferp = ^p; last_bufferp = ^p",
			 binary (rel (lbcse_ptr), 18, 0), (lbcse.previous ^= null ()), lbcse.previous,
			 lbcse.loopback.first_bufferp, lbcse.loopback.last_bufferp);

		if lbcse.loopback.first_bufferp ^= null () then do;
		     call tty_dump$print_chain (ttybp, "Saved loopback block chain",
					  binary (rel (lbcse.loopback.first_bufferp), 18, 0), brief_sw);
		     if analyze_entry then
			call trace_buffer_chain (binary (rel (lbcse.loopback.first_bufferp), 18, 0));
		end;

		if analyze_entry then
		     call check_used (lbcse_ptr, currentsize (lbcse));

		return;

	     end dump_lbcse;

	end dump_loopback_block_chain_stack;
%page;
/* Trace a chain and buffers and account for the space used */

trace_buffer_chain:
	procedure (P_chain_offset);

dcl  P_chain_offset fixed binary (18) parameter;

dcl  offset fixed binary (18);

	     offset = P_chain_offset;

	     do while (offset ^= 0);
		if (offset < binary (tty_buf.borig, 18, 0)) then
		     return;			/* invalid buffer chain */
		blockp = pointer (ttybp, offset);
		offset = buffer.next;		/* following call smashes buffer's contents */
		call check_used (blockp, (16 * (binary (buffer.size_code) + 1)));
	     end;

	     return;

	end trace_buffer_chain;
%page;
%include hasp_mpx_data;
%page;
%include hasp_load_data;
%page;
%include hasp_mpx_meters;
%page;
%include hasp_subchannel_meters;
%page;
%include mcs_interrupt_info;
%page;
%include tty_buf;
%page;
%include lct;
%page;
%include tty_buffer_block;

     end hasp_dump_;




		    hasp_meters_.pl1                10/25/89  1156.0r w 10/25/89  1005.1      132498



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1981 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* Interpret and otherwise manipulate the meters maintained by the HASP multiplexer for the major channel and its
   sub-channels */

/* Created:  July 1981 by G. Palter */


hasp_meters_:
     procedure ();

	return;				/* not an entrypoint */


/* Parameters */

dcl  P_code fixed binary (35) parameter;

dcl  P_meters_ptr pointer parameter;			/* allocate_*, free_*: -> the structure allocated/freed */

dcl  P_area_ptr pointer parameter;			/* allocate_*: -> the area to use */

dcl  P_channel_name character (*) parameter;		/* display_*, *_summary: the channel in question */
dcl  P_channel_meters_ptr pointer parameter;		/* display_*, *_summary: -> the metering data for the channel */

dcl  P_iocb_ptr pointer parameter;			/* display_*: the I/O switch to write results */
dcl  P_flags bit (36) aligned parameter;		/* display_*: controls format/content of the display */

dcl  P_since_bootload bit (1) parameter;		/* *_summary: ON => give results since bootload */
dcl  P_summary_ptr pointer parameter;			/* *_summary: -> summary of channels meters */


/* Local copies of parameters */

dcl  the_area area based (the_area_ptr);
dcl  the_area_ptr pointer;

dcl  output_switch pointer;

dcl  metering_flags bit (36) aligned;

dcl  since_bootload bit (1) aligned;


/* Remaining declarations */

dcl 1 mpx aligned,					/* meters for a HASP multiplexer */
      2 metering_time fixed binary (71),		/* amount of time metered */
      2 idle_interval fixed binary,			/* # of seconds for each idle loop */
      2 fnp_meters,					/* meters extracted from the FNP */
        3 input_naks fixed binary (35),
        3 output_naks fixed binary (35),
        3 input_timeouts fixed binary (35),
        3 output_timeouts fixed binary (35),
        3 idle_counter fixed binary (35),		/* # of times through the idle loop */
        3 dia_busy_counter fixed binary (35),		/* # of NAKs of input messages because DIA hadn't ... */
      2 meters like hasp_mpx_meters;			/* ... finished sending the prvious message to Multics */

dcl 1 subchannel aligned,				/* meters for a HASP multiplexer sub-channel */
      2 input bit (1) aligned,			/* ON => sub-channel is an input (or input/output) device */
      2 output bit (1) aligned,			/* ON => sub-channel is an output (or input/output) device */
      2 meters like hasp_subchannel_meters;

dcl  parent_is_fnp bit (1) aligned;
dcl  errors_only bit (1) aligned;

dcl  ONE_SECOND fixed binary (71) static options (constant) initial (1000000);

dcl  error_table_$noalloc fixed binary (35) external;

dcl  iox_$user_output pointer external;

dcl  ioa_$ioa_switch entry () options (variable);
dcl  meter_format_$picture entry (fixed binary (35), fixed binary) returns (character (15) varying);
dcl  meter_format_$quotient entry (fixed binary (71), fixed binary (71), character (*)) returns (character (12) varying);

dcl  area condition;

dcl (addr, max, null) builtin;

/*  */

/* Allocate the metering structure for a HASP multiplexer channel */

allocate_mpx:
     entry (P_area_ptr, P_meters_ptr, P_code);

	the_area_ptr = P_area_ptr;
	P_code = 0;				/* assume success */

	on condition (area)
	     begin;				/* in case there's no room in the area */
		P_code = error_table_$noalloc;
		go to RETURN_FROM_ALLOCATE_MPX;
	     end;

	allocate hasp_mpx_meters_data in (the_area) set (hmmd_ptr);
	hasp_mpx_meters_data.version = HASP_MPX_METERS_DATA_VERSION_1;

	P_meters_ptr = hmmd_ptr;

RETURN_FROM_ALLOCATE_MPX:
	return;



/* Free the above structure */

free_mpx:
     entry (P_meters_ptr, P_code);

	free P_meters_ptr -> hasp_mpx_meters_data;

	P_meters_ptr = null ();			/* be nice */
	P_code = 0;				/* always works */

	return;

/*  */

/* Allocate the metering structure for a HASP multiplexer channel */

allocate_subchan:
     entry (P_area_ptr, P_meters_ptr, P_code);

	the_area_ptr = P_area_ptr;
	P_code = 0;				/* assume success */

	on condition (area)
	     begin;				/* in case there's no room in the area */
		P_code = error_table_$noalloc;
		go to RETURN_FROM_ALLOCATE_SUBCHAN;
	     end;

	allocate hasp_subchannel_meters_data in (the_area) set (hsmd_ptr);
	hasp_subchannel_meters_data.version = HASP_SUBCHANNEL_METERS_DATA_VERSION_1;

	P_meters_ptr = hsmd_ptr;

RETURN_FROM_ALLOCATE_SUBCHAN:
	return;



/* Free the above structure */

free_subchan:
     entry (P_meters_ptr, P_code);

	free P_meters_ptr -> hasp_subchannel_meters_data;

	P_meters_ptr = null ();			/* be nice */
	P_code = 0;				/* always works */

	return;

/*  */

/* Display the meters accumulated for a HASP multiplexer channel */

display_mpx:
     entry (P_channel_name, P_iocb_ptr, P_channel_meters_ptr, P_flags, P_code);

	if P_iocb_ptr ^= null () then			/* check for default */
	     output_switch = P_iocb_ptr;
	else output_switch = iox_$user_output;

	chan_meterp = P_channel_meters_ptr;
	metering_flags = P_flags;

	P_code = 0;				/* always succeeds */

	if metering_flags & DISPLAY_MPX_SUMMARY then	/* not handled here: let caller do it */
	     return;

	if metering_flags & DISPLAY_MPX_BRIEF then	/* no brief meters for this multiplexer yet */
	     return;

	errors_only = ((metering_flags & DISPLAY_MPX_ERROR) = DISPLAY_MPX_ERROR);

	since_bootload = ((metering_flags & DISPLAY_MPX_SINCE_BOOT) = DISPLAY_MPX_SINCE_BOOT);

	call get_multiplexer_meters ();


	if parent_is_fnp & ^errors_only then		/* make an estimate of how much the line is idling ... */
	     call ioa_$ioa_switch (output_switch, "Idle time^21t^a%",
			       meter_format_$quotient ((100 * ONE_SECOND * mpx.idle_interval * mpx.idle_counter),
						 mpx.metering_time, "^6.2f"));

	call ioa_$ioa_switch (output_switch, "^34tInput^52tOutput");

	if parent_is_fnp then do;			/* can report about NAKs and timeouts */
	     call ioa_$ioa_switch (output_switch, "Blocks NAKed^28t^a^8x^a", meter_format_$picture (mpx.input_naks, 11),
			       meter_format_$picture (mpx.output_naks, 11));
	     call ioa_$ioa_switch (output_switch, "Transmission timeouts^28t^a^8x^a",
			       meter_format_$picture (mpx.input_timeouts, 11),
			       meter_format_$picture (mpx.output_timeouts, 11));
	     if ^errors_only then			/* tell user about DIA being busy ... */
		call ioa_$ioa_switch (output_switch, "NAKs for DIA backlog^28t^a^55tN/A",
				  meter_format_$picture (mpx.dia_busy_counter, 11));
	end;


	if ^errors_only then do;			/* remaining meters are all non-error meters */

	     call ioa_$ioa_switch (output_switch, "All transmission suspended^28t^a^8x^a",
			       meter_format_$picture (mpx.n_local_wab_set, 11),
			       meter_format_$picture (mpx.n_foreign_wab_set, 11));
	     call ioa_$ioa_switch (output_switch, "Blocks transmitted^28t^a^8x^a",
			       meter_format_$picture (mpx.n_input_blocks, 11),
			       meter_format_$picture (mpx.n_output_blocks, 11));
	     call ioa_$ioa_switch (output_switch, "Records transmitted^28t^a^8x^a",
			       meter_format_$picture (mpx.n_input_records, 11),
			       meter_format_$picture (mpx.n_output_records, 11));
	     call ioa_$ioa_switch (output_switch, "^3xAverage records per block^31t^a^8x^a",
			       meter_format_$quotient ((mpx.n_input_records), (mpx.n_input_blocks), "^11.2f"),
			       meter_format_$quotient ((mpx.n_output_records), (mpx.n_output_blocks), "^11.2f"));

	     call ioa_$ioa_switch (output_switch, "");

	     call ioa_$ioa_switch (output_switch, "Duplicate input blocks^28t^a",
			       meter_format_$picture (mpx.n_duplicate_input_blocks, 11));

	     call ioa_$ioa_switch (output_switch, "Output reprocessing^28t^a",
			       meter_format_$picture (mpx.n_wraparounds, 11));
	     call ioa_$ioa_switch (output_switch, "^3xBlocks reprocessed^28t^a",
			       meter_format_$picture (mpx.n_wraparound_blocks, 11));
	end;

	return;

/*  */

/* Provide the values for a HASP multiplxer channel used by channel_comm_meters -summary */

mpx_summary:
     entry (P_channel_meters_ptr, P_since_bootload, P_summary_ptr, P_code);

	chan_meterp = P_channel_meters_ptr;
	since_bootload = P_since_bootload;
	summary_ptr = P_summary_ptr;

	P_code = 0;				/* always succeeds */

	call get_multiplexer_meters ();

	if parent_is_fnp then			/* all errors are detected by the FNP */
	     channel_summary.error_count = mpx.input_naks + mpx.output_naks + mpx.input_timeouts + mpx.output_timeouts;
	else channel_summary.error_count = 0;

	return;

/*  */

/* Display the meters accumulated for a HASP multiplexer sub-channel */

display_subchan:
     entry (P_channel_name, P_iocb_ptr, P_channel_meters_ptr, P_flags, P_code);
	if P_iocb_ptr ^= null () then			/* check for default */
	     output_switch = P_iocb_ptr;
	else output_switch = iox_$user_output;

	chan_meterp = P_channel_meters_ptr;
	metering_flags = P_flags;

	P_code = 0;				/* always succeeds */

	if metering_flags & DISPLAY_MPX_SUMMARY then	/* not handled here: let caller do it */
	     return;

	if metering_flags & DISPLAY_MPX_BRIEF then	/* no brief meters for this multiplexer yet */
	     return;

	if metering_flags & DISPLAY_MPX_ERROR then	/* no error data at the sub-channel level */
	     return;

	since_bootload = ((metering_flags & DISPLAY_MPX_SINCE_BOOT) = DISPLAY_MPX_SINCE_BOOT);

	call get_subchannel_meters ();

	call ioa_$ioa_switch (output_switch, "^/^34tInput^52tOutput");

	call ioa_$ioa_switch (output_switch, "Transmission suspended^28t^[^a^;^36tN/A^s^]^8x^[^a^;^55tN/A^s^]",
			  subchannel.input, meter_format_$picture (subchannel.device_n_local_wab_set, 11),
			  subchannel.output, meter_format_$picture (subchannel.device_n_foreign_wab_set, 11));

	call ioa_$ioa_switch (output_switch, "Files transmitted^28t^[^a^;^36tN/A^s^]^8x^[^a^;^55tN/A^s^]",
			  subchannel.input, meter_format_$picture (subchannel.device_n_input_eof_records, 11),
			  subchannel.output, meter_format_$picture (subchannel.device_n_output_eof_records, 11));

	call ioa_$ioa_switch (output_switch, "Records transmitted^28t^[^a^;^36tN/A^s^]^8x^[^a^;^55tN/A^s^]",
			  subchannel.input, meter_format_$picture (subchannel.device_n_input_records, 11),
			  subchannel.output, meter_format_$picture (subchannel.device_n_output_records, 11));

	call ioa_$ioa_switch (output_switch, "^3xAverage records per file^31t^[^a^;^36tN/A^3x^s^]^8x^[^a^;^55tN/A^s^]",
			  subchannel.input, meter_format_$quotient ((subchannel.device_n_input_records),
							    max (1, subchannel.device_n_input_eof_records),
							    "^11.2f"),
			  subchannel.output, meter_format_$quotient ((subchannel.device_n_output_records),
							     max (1, subchannel.device_n_output_eof_records),
							     "^11.2f"));

	return;

/*  */

/* Provide the values for a HASP multiplxer sub-channel used by channel_comm_meters -summary */

subchan_summary:
     entry (P_channel_meters_ptr, P_since_bootload, P_summary_ptr, P_code);

	summary_ptr = P_summary_ptr;

	channel_summary.error_count = 0;		/* no errors occur at the sub-channel level */

	P_code = 0;				/* always succeeds */

	return;

/*  */

/* Extract the meters for the multiplexer channel */

get_multiplexer_meters:
	procedure ();

dcl 1 total_fnp_meters aligned like mpx.fnp_meters;
dcl 1 saved_fnp_meters aligned like mpx.fnp_meters;

dcl 1 real_total_fnp_meters aligned based (addr (fnp_chan_meter_struc.current_meters)) like fnp_sync_meters;
dcl 1 real_saved_fnp_meters aligned based (addr (fnp_chan_meter_struc.saved_meters)) like fnp_sync_meters;

	     hmmd_ptr = channel_meters.mpx_specific_meterp;

	     if (channel_meters.parent_type = MCS_MPX)
	     then do;				/* a real HASP channel */
		parent_is_fnp = "1"b;
		fnp_chan_meterp = channel_meters.parent_meterp;
		total_fnp_meters.input_naks = real_total_fnp_meters.counters (1);
		total_fnp_meters.input_timeouts = real_total_fnp_meters.counters (3);
		total_fnp_meters.output_naks = real_total_fnp_meters.counters (2);
		total_fnp_meters.output_timeouts = real_total_fnp_meters.counters (4);
		total_fnp_meters.idle_counter = real_total_fnp_meters.counters (5);
		total_fnp_meters.dia_busy_counter = real_total_fnp_meters.counters (6);
		saved_fnp_meters.input_naks = real_saved_fnp_meters.counters (1);
		saved_fnp_meters.input_timeouts = real_saved_fnp_meters.counters (3);
		saved_fnp_meters.output_naks = real_saved_fnp_meters.counters (2);
		saved_fnp_meters.output_timeouts = real_saved_fnp_meters.counters (4);
		saved_fnp_meters.idle_counter = real_saved_fnp_meters.counters (5);
		saved_fnp_meters.dia_busy_counter = real_saved_fnp_meters.counters (6);
	     end;
	     else do;
		parent_is_fnp = "0"b;
		total_fnp_meters, saved_fnp_meters = 0;
	     end;

	     mpx.idle_interval = hasp_mpx_meters_data.idle_interval;

	     if hasp_mpx_meters_data.time_meters_copied = 0 then	/* kludge: I'm not sure when copies happen */
		hasp_mpx_meters_data.time_meters_copied = hasp_mpx_meters_data.time_mpx_booted;

	     if since_bootload
	     then do;				/* report data since the multiplexer came up */
		mpx.metering_time = clock () - hasp_mpx_meters_data.time_mpx_booted;
		mpx.fnp_meters = total_fnp_meters;
		mpx.meters = hasp_mpx_meters_data.current_meters;
	     end;

	     else do;				/* since last dialup */
		mpx.metering_time = clock () - hasp_mpx_meters_data.time_meters_copied;
		mpx.fnp_meters = total_fnp_meters - saved_fnp_meters;
		mpx.meters = hasp_mpx_meters_data.current_meters - hasp_mpx_meters_data.saved_meters;
	     end;

	     return;

	end get_multiplexer_meters;

/*  */

/* Extract the meters for a sub-channel of the multiplexer */

get_subchannel_meters:
	procedure ();

	     hsmd_ptr = channel_meters.parent_meterp;

	     subchannel.input = hasp_subchannel_meters_data.report_input_meters;
	     subchannel.output = hasp_subchannel_meters_data.report_output_meters;

	     if since_bootload then			/* since the multiplexer came up, please */
		subchannel.meters = hasp_subchannel_meters_data.current_meters;
	     else subchannel.meters = hasp_subchannel_meters_data.current_meters - hasp_subchannel_meters_data.saved_meters;

	     return;

	end get_subchannel_meters;

/*  */

%include channel_meters;

%include comm_meters_disp_flags;
%page;
%include multiplexer_types;
%page;
%include hasp_mpx_meters;
%page;
%include hasp_subchannel_meters;
%page;
%include fnp_channel_meters;
%page;
%include channel_summary;

     end hasp_meters_;




		    ibm3270_dump_.pl1               01/02/85  2134.1r w 01/02/85  1518.9       60498



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* IBM3270_DUMP_ - Used by tty_dump for 3270 channels */
/* Written May 1979 by Larry Johnson */

ibm3270_dump_: proc (arg_ttybp, arg_ttyap, arg_mdp, arg_subchan, arg_brief_sw);

/* Arguments */

dcl  arg_ttybp ptr;
dcl  arg_ttyap ptr;
dcl  arg_mdp ptr;
dcl  arg_subchan fixed bin;
dcl  arg_brief_sw bit (1);

/* Automatic */

dcl  i fixed bin;
dcl  last_i fixed bin;
dcl  subchan fixed bin;
dcl  quit_key char (3);
dcl  formfeed_key char (5);

/* External */

dcl (ioa_, ioa_$nnl) entry options (variable);

dcl (addr, bin, null, rel, unspec) builtin;


/* Start of tty_dump code */

	ttybp = arg_ttybp;
	mdp = arg_mdp;
	subchan = arg_subchan;

	call ioa_ ("^/MPX DATA at ^o for ^a (devx ^o)", bin (rel (mdp)), md.name, md.devx);
	call ioa_ ("Boot process ^.3b, channel ^.3b", md.processid, unspec (md.event_channel));
	call ioa_ ("Controller addr ^d, poll ^.3b, select ^.3b, general poll ^.3b", md.controller_address,
	     unspec (md.controller_poll_address), unspec (md.controller_select_address),
	     unspec (md.general_poll_address));
	call ioa_ ("line type ^d, baud ^d, buf size ^d, buffer pad ^d", md.line_type, md.baud_rate,
	     md.max_buf_size, md.buffer_pad);
	if md.quit_key = md.pa1 then quit_key = "pa1";
	else if md.quit_key = md.pa2 then quit_key = "pa2";
	else if md.quit_key = md.pa3 then quit_key = "pa3";
	else quit_key = "?";
	if md.formfeed_key = md.pa1 then formfeed_key = "pa1";
	else if md.formfeed_key = md.pa2 then formfeed_key = "pa2";
	else if md.formfeed_key = md.pa3 then formfeed_key = "pa3";
	else if md.formfeed_key = md.clear then formfeed_key = "clear";
	else formfeed_key = "?";
	call ioa_ ("quit key is ""^a"", formfeed key is ""^a"".", quit_key, formfeed_key);
	call ioa_ (" ADDR   SUBCHAN");
	do i = 0 to 31;
	     if md.chan_map (i) = -1 then call ioa_ ("^4d^-NONE   (input recieved)", i);
	     else if md.chan_map (i) > 0 then call ioa_ ("^4d^-^d", i, md.chan_map (i));
	end;
	call ioa_ ("Last poll ^.3b, last select ^.3b", unspec (md.last_poll_address), unspec (md.last_select_address));
	call ioa_$nnl ("Current write channel: ^d", md.cur_write_chan);
	if md.write_chain_ptr = null () then call ioa_ ("");
	else call ioa_ (" write chain at ^o", bin (rel (md.write_chain_ptr)));
	if md.input_chain_ptr ^= null () then
	     call ioa_ ("input chain at ^o, length ^d", bin (rel (md.input_chain_ptr)), md.input_count);
	call ioa_ ("Flags:^[ ascii^]^[ debug^]^[ loading^]^[ loaded^]^[ started^]^[ poll_in_progress^]^[ output_in_progress^]^[ message_in_progress^]^[ eot_sent^]^[ send_output^]^[ allow_raw3270^]^[ allow_copy^]",
	     md.ascii, md.debug, md.loading, md.loaded, md.started, md.poll_in_progress, md.output_in_progress,
	     md.message_in_progress, md.eot_sent, md.send_output, md.allow_raw3270, md.allow_copy);

	if md.first_write_chan = 0 then last_i = 0;
	else do;
	     call ioa_$nnl ("Write queue:");
	     do i = md.first_write_chan repeat (mde.next_write_chan) while (i ^= 0);
		mdep = addr (md.mde_entry (i));
		call ioa_$nnl (" ^d", i);
		last_i = i;
	     end;
	     call ioa_ ("");
	end;
	if last_i ^= md.last_write_chan then
	     call ioa_ ("Last write chan invalid: is ^d, should be ^d", md.last_write_chan, last_i);

	if md.first_poll_chan = 0 then last_i = 0;
	else do;
	     call ioa_$nnl ("Poll queue:");
	     do i = md.first_poll_chan repeat (mde.next_poll_chan) while (i ^= 0);
		mdep = addr (md.mde_entry (i));
		call ioa_$nnl (" ^d", i);
		last_i = i;
	     end;
	     call ioa_ ("");
	end;
	if last_i ^= md.last_poll_chan then
	     call ioa_ ("Last poll chan invalid: is ^d, should be ^d", md.last_poll_chan, last_i);

	if md.first_control_chan = 0 then last_i = 0;
	else do;
	     call ioa_$nnl ("Control queue:");
	     do i = md.first_control_chan repeat (mde.next_control_chan) while (i ^= 0);
		mdep = addr (md.mde_entry (i));
		call ioa_$nnl (" ^d", i);
		last_i = i;
	     end;
	     call ioa_ ("");
	end;
	if last_i ^= md.last_control_chan then
	     call ioa_ ("Last control chan invalid: is ^d, should be ^d", md.last_control_chan, last_i);

	if unspec (md.error_stat) ^= "0"b then do;
	     call ioa_ ("Error statistics:");
	     if md.poll_failed ^= 0 then call ioa_ (" poll failures: ^d", md.poll_failed);
	     if md.bad_output ^= 0 then call ioa_ (" bad output: ^d", md.bad_output);
	     if md.write_eot ^= 0 then call ioa_ (" write eot: ^d", md.write_eot);
	     if md.write_abort ^= 0 then call ioa_ (" write abort: ^d", md.write_abort);
	     if md.select_failed ^= 0 then call ioa_ (" select failures: ^d", md.select_failed);
	     if md.wack_select ^= 0 then call ioa_ (" wack select: ^d", md.wack_select);
	     if md.nak_output ^= 0 then call ioa_ (" nak output: ^d", md.nak_output);
	     if md.input_reject ^= 0 then call ioa_ (" input reject: ^d", md.input_reject);
	     if md.needs_space ^= 0 then call ioa_ (" space needed: ^d", md.needs_space);
	     if md.space_available ^= 0 then call ioa_ (" space available: ^d", md.space_available);
	     if md.write_format_error ^= 0 then call ioa_ (" write format errors: ^d", md.write_format_error);
	end;

	if subchan = -1 then do subchan = 1 to md.nchan;
	     call print_mde;
	end;
	else call print_mde;
	call ioa_ ("");
	return;

print_mde:
	proc;

	     mdep = addr (md.mde_entry (subchan));
	     call ioa_ ("^/Subchan ^a.^a (devx ^o) address ^.3b", md.name, mde.name, mde.devx, unspec (mde.device_address));
	     call ioa_ ("screen size ^d, line size ^d, position ^d", mde.screen_size, mde.line_size, mde.position);
	     if mde.write_chain_ptr ^= null () then call ioa_ ("write chain at ^o", bin (rel (mde.write_chain_ptr)));
	     call ioa_ ("Flags:^[ listen^]^[ dialed^]^[ printer^]^[ hndlquit^]^[ waiting_for_ready^]^[ erase_req^]^[ sound_alarm^]^[ control_queued^]^[ end_of_page^]^[ keyboard_restore^]^[ rawo^]^[ rawi^]^[ raw3270^]^[ raw3270_in_effect^]^[ write_queued^]",
		mde.listen, mde.dialed, mde.printer, mde.hndlquit, mde.waiting_for_ready, mde.erase_req, mde.sound_alarm, mde.control_queued, mde.end_of_page, mde.keyboard_restore, mde.rawo, mde.rawi, mde.raw3270, mde.raw3270_in_effect, mde.write_queued);
	     return;

	end print_mde;

%include tty_buf;

%include ibm3270_mpx_data;
%include ibm3270_meters;
     end ibm3270_dump_;




		    ibm3270_meters_.pl1             10/25/89  1156.0r w 10/25/89  1005.2       83835



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* format: style4,delnl,insnl,^ifthendo */
ibm3270_meters_:
     procedure;

/* This subroutine contains entries for allocating, freeing, and displaying
   meters for an IBM3270-type multiplexer. Only the _mpx entries are provided,
   since the ibm3270 multiplexer does not maintain meters on behalf of its
   subchannels.
*/

/* Written June 1981 by Robert Coren */

/* PARAMETERS */

dcl  a_area_ptr ptr;
dcl  a_meterp ptr;
dcl  a_code fixed bin (35);
dcl  a_chan_name char (*);
dcl  a_iocbp ptr;
dcl  a_chan_meterp ptr;
dcl  a_flags bit (36) aligned;
dcl  a_since_boot bit (1);
dcl  a_summary_ptr ptr;


/* AUTOMATIC */

dcl  areap ptr;
dcl  code fixed bin (35);
dcl  iocbp ptr;
dcl  flags bit (36) aligned;
dcl  brief bit (1);
dcl  error bit (1);
dcl  since_boot bit (1);
dcl  parent_fnp bit (1);
dcl  ibm3270_meterp ptr;
dcl  current_meterp ptr;
dcl  saved_meterp ptr;
dcl  current_fnp_meterp ptr;
dcl  saved_fnp_meterp ptr;

dcl  poll_failed fixed bin (35);
dcl  select_failed fixed bin (35);
dcl  bad_output fixed bin (35);
dcl  bad_input fixed bin (35);
dcl  bad_device fixed bin (35);
dcl  write_format_error fixed bin (35);
dcl  input_naks fixed bin (35);
dcl  output_naks fixed bin (35);
dcl  timeouts fixed bin (35);
dcl  wack_received fixed bin (35);
dcl  sent_too_many_naks fixed bin (35);
dcl  recd_too_many_naks fixed bin (35);
dcl  eot_no_resp fixed bin (35);

dcl  total_poll_failed fixed bin (35);
dcl  total_select_failed fixed bin (35);
dcl  total_bad_output fixed bin (35);
dcl  total_bad_input fixed bin (35);
dcl  total_bad_device fixed bin (35);
dcl  total_write_format_error fixed bin (35);
dcl  total_input_naks fixed bin (35);
dcl  total_output_naks fixed bin (35);
dcl  total_timeouts fixed bin (35);
dcl  total_wack_received fixed bin (35);
dcl  total_sent_too_many_naks fixed bin (35);
dcl  total_recd_too_many_naks fixed bin (35);
dcl  total_eot_no_resp fixed bin (35);


/* BASED */

dcl  m_area area (100) based (areap);


/* EXTERNAL STATIC */

dcl  error_table_$noalloc external static fixed bin (35);
dcl  iox_$user_output external static ptr;


/* ENTRIES */

dcl  ioa_$ioa_switch entry options (variable);
dcl  meter_format_$picture entry (fixed bin (35), fixed bin) returns (char (15) varying);


/* CONDITIONS & BUILTINS */

dcl  area condition;
dcl  (addr, null) builtin;

allocate_mpx:
     entry (a_area_ptr, a_meterp, a_code);

	areap = a_area_ptr;
	a_code = 0;

	on area
	     begin;
		a_code = error_table_$noalloc;
		go to exit;
	     end;

	allocate ibm3270_meter_struc in (m_area) set (a_meterp);
	a_meterp -> ibm3270_meter_struc.version = IBM3270_METERS_VERSION_1;
exit:
	return;


free_mpx:
     entry (a_meterp, a_code);

	free a_meterp -> ibm3270_meter_struc;
	a_code = 0;
	return;

display_mpx:
     entry (a_chan_name, a_iocbp, a_chan_meterp, a_flags, a_code);

	iocbp = a_iocbp;
	if iocbp = null ()
	then iocbp = iox_$user_output;

	chan_meterp = a_chan_meterp;
	flags = a_flags;
	a_code = 0;

	if flags & DISPLAY_MPX_SUMMARY		/* we don't handle this */
	then return;

	if flags & DISPLAY_MPX_BRIEF
	then brief = "1"b;
	else brief = "0"b;

	if flags & DISPLAY_MPX_ERROR
	then error = "1"b;
	if flags & DISPLAY_MPX_SINCE_BOOT
	then since_boot = "1"b;
	else since_boot = "0"b;

	if brief
	then return;				/* no "brief" meters from this multiplexer */

	call set_values;

	call ioa_$ioa_switch (iocbp, "^/Poll failures^32t^a", meter_format_$picture (poll_failed, 7));
	call ioa_$ioa_switch (iocbp, "Select failures^32t^a", meter_format_$picture (select_failed, 7));

	if parent_fnp
	then do;
	     call ioa_$ioa_switch (iocbp, "Invalid input messages^28t^a", meter_format_$picture (input_naks, 11));
	     call ioa_$ioa_switch (iocbp, "NAK for output messages^28t^a", meter_format_$picture (output_naks, 11));
	     call ioa_$ioa_switch (iocbp, "FNP rejected output^28t^a", meter_format_$picture (bad_output, 11));
	     call ioa_$ioa_switch (iocbp, "Response timeouts^28t^a", meter_format_$picture (timeouts, 11));
	     call ioa_$ioa_switch (iocbp, "WACKs received^28t^a", meter_format_$picture (wack_received, 11));
	     call ioa_$ioa_switch (iocbp, "Invalid input limit exceeded^32t^a",
		meter_format_$picture (sent_too_many_naks, 7));
	     call ioa_$ioa_switch (iocbp, "Received NAK limit exceeded^32t^a",
		meter_format_$picture (recd_too_many_naks, 7));
	     call ioa_$ioa_switch (iocbp, "FNP sent EOT^32t^a", meter_format_$picture (eot_no_resp, 7));
	end;

	call ioa_$ioa_switch (iocbp, "Incorrect output format^32t^a", meter_format_$picture (write_format_error, 7));
	call ioa_$ioa_switch (iocbp, "Unrecognized input^32t^a", meter_format_$picture (bad_input, 7));
	call ioa_$ioa_switch (iocbp, "Unrecognized device^32t^a", meter_format_$picture (bad_device, 7));

	return;

mpx_summary:
     entry (a_chan_meterp, a_since_boot, a_summary_ptr, a_code);

/* entry to fill in values used by channel_comm_meters -summary */

	a_code = 0;
	chan_meterp = a_chan_meterp;
	summary_ptr = a_summary_ptr;
	since_boot = a_since_boot;
	call set_values;

	channel_summary.error_count = poll_failed + select_failed + bad_input + bad_device;
	if parent_fnp
	then channel_summary.error_count = channel_summary.error_count + input_naks + output_naks + eot_no_resp;

	return;

set_values:
     procedure;

/* internal procedure to set metering values (either cumulative or since load */

	ibm3270_meterp = channel_meters.mpx_specific_meterp;
	if channel_meters.parent_type = MCS_MPX		/* if parent is an FNP */
	then do;					/* then we know something about the next level of metering */
	     fnp_chan_meterp = channel_meters.parent_meterp;
	     current_fnp_meterp = addr (fnp_chan_meter_struc.current_meters);
	     saved_fnp_meterp = addr (fnp_chan_meter_struc.saved_meters);
	     parent_fnp = "1"b;
	end;

	else parent_fnp = "0"b;

	current_meterp = addr (ibm3270_meterp -> ibm3270_meter_struc.current_meters);
	saved_meterp = addr (ibm3270_meterp -> ibm3270_meter_struc.saved_meters);

	total_poll_failed = current_meterp -> ibm3270_meters.poll_failed;
	total_bad_output = current_meterp -> ibm3270_meters.bad_output;
	total_select_failed = current_meterp -> ibm3270_meters.select_failed;
	total_write_format_error = current_meterp -> ibm3270_meters.write_format_error;
	total_bad_input = current_meterp -> ibm3270_meters.bad_input;
	total_bad_device = current_meterp -> ibm3270_meters.bad_device;

	if parent_fnp
	then do;
	     total_input_naks = current_fnp_meterp -> fnp_sync_meters.counters (1);
	     total_output_naks = current_fnp_meterp -> fnp_sync_meters.counters (2);
	     total_timeouts = current_fnp_meterp -> fnp_sync_meters.counters (3);
	     total_sent_too_many_naks = current_fnp_meterp -> fnp_sync_meters.counters (4);
	     total_wack_received = current_fnp_meterp -> fnp_sync_meters.counters (5);
	     total_recd_too_many_naks = current_fnp_meterp -> fnp_sync_meters.counters (6);
	     total_eot_no_resp = current_fnp_meterp -> fnp_sync_meters.counters (7);
	end;

	if since_boot
	then do;
	     poll_failed = total_poll_failed;
	     bad_output = total_bad_output;
	     select_failed = total_select_failed;
	     write_format_error = total_write_format_error;
	     bad_input = total_bad_input;
	     bad_device = total_bad_device;

	     if parent_fnp
	     then do;
		input_naks = total_input_naks;
		output_naks = total_output_naks;
		timeouts = total_timeouts;
		sent_too_many_naks = total_sent_too_many_naks;
		wack_received = total_wack_received;
		recd_too_many_naks = total_recd_too_many_naks;
		eot_no_resp = total_eot_no_resp;
	     end;
	end;

	else do;
	     poll_failed = total_poll_failed - saved_meterp -> ibm3270_meters.poll_failed;
	     bad_output = total_bad_output - saved_meterp -> ibm3270_meters.bad_output;
	     select_failed = total_select_failed - saved_meterp -> ibm3270_meters.select_failed;
	     write_format_error = total_write_format_error - saved_meterp -> ibm3270_meters.write_format_error;
	     bad_input = total_bad_input - saved_meterp -> ibm3270_meters.bad_input;
	     bad_device = total_bad_device - saved_meterp -> ibm3270_meters.bad_device;

	     if parent_fnp
	     then do;
		input_naks = total_input_naks - saved_fnp_meterp -> fnp_sync_meters.counters (1);
		output_naks = total_output_naks - saved_fnp_meterp -> fnp_sync_meters.counters (2);
		timeouts = total_timeouts - saved_fnp_meterp -> fnp_sync_meters.counters (3);
		sent_too_many_naks = total_sent_too_many_naks - saved_fnp_meterp -> fnp_sync_meters.counters (4);
		wack_received = total_wack_received - saved_fnp_meterp -> fnp_sync_meters.counters (5);
		recd_too_many_naks = total_recd_too_many_naks - saved_fnp_meterp -> fnp_sync_meters.counters (6);
		eot_no_resp = total_eot_no_resp - saved_fnp_meterp -> fnp_sync_meters.counters (7);
	     end;
	end;
     end set_values;

%include multiplexer_types;
%page;
%include ibm3270_meters;
%page;
%include comm_meters_disp_flags;
%page;
%include channel_meters;
%page;
%include fnp_channel_meters;
%page;
%include channel_summary;

     end ibm3270_meters_;




		    lap_dump_.pl1                   08/08/88  1522.2rew 08/08/88  1400.0       30771



/****^  **************************************************************
        *                                                            *
        * Copyright, (C) Honeywell Bull Inc., 1988                   *
        *                                                            *
        * Copyright, (C) Massachusetts Institute of Technology, 1983 *
        *                                                            *
        ************************************************************** */

/* format: style4,delnl,insnl,ifthenstmt,indnoniterend */

lap_dump_:
     procedure (P_ttybp, P_areap, P_lap_data_ptr, P_subchannel, P_brief);

/* Created 1983 February by Olin Sibert to support LAP multiplexers. */

/****^  HISTORY COMMENTS:
  1) change(88-07-07,Beattie), approve(88-06-27,MCR7926),
     audit(88-07-22,Brunelle), install(88-08-08,MR12.2-1082):
     Prepared for installation.
                                                   END HISTORY COMMENTS */

	lap_data_ptr = P_lap_data_ptr;

	call ioa_ ("LAP channel ^a, devx ^d (subchannel devx ^d)", lap_data.name, lap_data.devx, lap_data.subchannel);
	call ioa_ ("State is ^[hungup^;listening^;active^]. Flags: ^[send_output ^]^[started ^]", (lap_data.state + 1),
	     lap_data.send_output, lap_data.simplex_started);
	call ioa_ ("Activate order: ^24.3b", unspec (lap_data.activate_order));
	call ioa_ ("Dialup info:    ^24.3b", unspec (lap_data.dialup_info));
	call ioa_ ("SC dialup info: ^24.3b", unspec (lap_data.sc_dialup_info));
	call ioa_ ("Max frame size: ^d chars.  ^[No frame pending.^;Pending frame:^]", lap_data.max_frame_size,
	     (lap_data.frame_start = null ()));
	if (lap_data.frame_start ^= null ()) then do;
	     call ioa_ ("Frame at ^p is ^d chars^[ ready for sending^]:", lap_data.frame_start, lap_data.frame_size,
		lap_data.frame_ready);
	     call tty_dump$print_chain (P_ttybp, "", binary (rel (lap_data.frame_start), 18), (P_brief));
	     end;

	call ioa_ ("");

	return;
%page;
lap_analyze_:
     entry (P_ttybp, P_areap, P_devx, P_check_used, P_long);

	lctp = pointer (P_ttybp, rel (P_ttybp -> tty_buf.lct_ptr));
	lctep = addr (lct.lcte_array (P_devx));
	lap_data_ptr = pointer (P_ttybp, rel (lcte.data_base_ptr));

	call lap_dump_ (P_ttybp, P_areap, lap_data_ptr, -1, (^P_long));

	if (lap_data.frame_start ^= null ()) then do;
	     buffer_offset = binary (rel (lap_data.frame_start), 18);
	     do while ((buffer_offset ^= 0) & (buffer_offset < 261120));
		blockp = pointer (P_ttybp, buffer_offset);
		buffer_offset = buffer.next;
		call P_check_used (blockp, (16 * (1 + binary (buffer.size_code, 3))));
	     end;
	     end;

	call P_check_used (lap_data_ptr, size (lap_data));

	return;
%page;
dcl  P_ttybp pointer parameter;
dcl  P_areap pointer parameter;
dcl  P_lap_data_ptr pointer parameter;
dcl  P_subchannel fixed bin parameter;
dcl  P_brief bit (1) aligned parameter;
dcl  P_devx fixed bin parameter;
dcl  P_check_used entry (pointer, fixed bin) parameter;
dcl  P_long bit (1) aligned parameter;

dcl  buffer_offset fixed bin (18);

dcl  ioa_ entry () options (variable);
dcl  tty_dump$print_chain entry (ptr, char (*), fixed bin, bit (1));

dcl  (addr, binary, null, pointer, rel, size, unspec) builtin;
%page;
%include lap_simplex_data;
%page;
%include lap_line_info;
%page;
%include mcs_interrupt_info;
%page;
%include tty_buf;
%page;
%include lct;
%page;
%include tty_buffer_block;

     end lap_dump_;




		    mcs_meters_.pl1                 08/05/87  0757.9r   08/04/87  1540.7      232542



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* format: style4,delnl,insnl,^ifthendo */
mcs_meters_:
     procedure;

/* This procedure contains entries to allocate and free metering structures, and
   to display meters, for MCS FNPs and their subchannels.
*/

/* Written February 1981 by Robert Coren */
/* Modified May 1981 by Robert Coren for new iom_data format */
/* Modified August 1981 by Robert Coren to add buffer preallocation information. */
/* Modified September 1981 by Robert Coren to add fnp-wide throughput statistics
   and to suppress mpx meters kept in FNP if all 0 */

	return;					/* main entry should never be called */

/* PARAMETERS */

dcl  a_area_ptr pointer;				/* pointer to area in which to perform allocations */
dcl  a_meterp pointer;				/* pointer to structure to be allocated/freed (OUTPUT for alloc, INPUT for free */
dcl  a_chan_name char (32);				/* for display entries */
dcl  a_iocbp pointer;				/* likewise */
dcl  a_chan_meterp pointer;				/* likewise, pointer to channel meters structure */
dcl  a_flags bit (36) aligned;			/* likewise */
dcl  a_since_boot bit (1);				/* for summary entry */
dcl  a_summary_ptr pointer;				/* likewise, structure to be filled in */
dcl  a_code fixed bin (35);				/* status code (OUTPUT) */

/* AUTOMATIC */

dcl  areap pointer;
dcl  code fixed bin (35);
dcl  iocbp pointer;
dcl  flags bit (36) aligned;
dcl  brief bit (1);
dcl  error bit (1);
dcl  since_boot bit (1);
dcl  synchronous bit (1);
dcl  multiplexed bit (1);
dcl  pool fixed bin (35);
dcl  avg_space_available fixed bin (35);
dcl  fnp_meters_available bit (1);
dcl  time_up fixed bin (71);
dcl  input_chars fixed bin (35);
dcl  output_chars fixed bin (35);
dcl  meter_time fixed bin (71);
dcl  char_time char (10);
dcl  cur_ptrs (2) pointer;
dcl  prev_ptrs (2) pointer;
dcl  cpu_time fixed bin (71);
dcl  n_interrupts fixed bin (35);
dcl  interrupt_time fixed bin (71);
dcl  iom_data_len fixed bin (19);
dcl  iomx fixed bin;
dcl  current_meterp pointer;
dcl  saved_meterp pointer;
dcl  max_possible_idle_count fixed bin (35);
dcl  total_dia_q_len fixed bin (35);
dcl  total_dia_q_updates fixed bin (35);
dcl  total_pending_status fixed bin (35);
dcl  total_status_updates fixed bin (35);
dcl  total_output_overlaps fixed bin (35);
dcl  total_parity_errors fixed bin (35);
dcl  total_ssqo fixed bin (35);
dcl  total_hsqo fixed bin (35);
dcl  total_alloc_failures fixed bin (35);
dcl  total_input_messages fixed bin (35);
dcl  total_input_length fixed bin (35);
dcl  total_output_messages fixed bin (35);
dcl  total_output_length fixed bin (35);
dcl  total_pre_exhaust fixed bin (35);
dcl  total_exhaust fixed bin (35);
dcl  total_echo_overflows fixed bin (35);
dcl  total_xte fixed bin (35);
dcl  total_bell_quits fixed bin (35);
dcl  total_counters (8) fixed bin (35);

dcl  dia_q_len fixed bin (35);
dcl  dia_q_updates fixed bin (35);
dcl  pending_status fixed bin (35);
dcl  status_updates fixed bin (35);
dcl  output_overlaps fixed bin (35);
dcl  parity_errors fixed bin (35);
dcl  ssqo fixed bin (35);
dcl  hsqo fixed bin (35);
dcl  alloc_failures fixed bin (35);
dcl  input_messages fixed bin (35);
dcl  input_length fixed bin (35);
dcl  output_messages fixed bin (35);
dcl  output_length fixed bin (35);
dcl  pre_exhaust fixed bin (35);
dcl  exhaust fixed bin (35);
dcl  echo_overflows fixed bin (35);
dcl  xte fixed bin (35);
dcl  bell_quits fixed bin (35);
dcl  counters (8) fixed bin (35);



/* BASED */

dcl  m_area area (256) based (areap);
dcl  based_time fixed bin (71) based;


/* ENTRIES */

dcl  ioa_$ioa_switch entry options (variable);
dcl  meter_format_$time entry (fixed bin (71)) returns (char (10));
dcl  meter_format_$picture entry (fixed bin (35), fixed bin) returns (char (15) varying);
dcl  meter_format_$quotient entry (fixed bin (71), fixed bin (71), char (*)) returns (char (12) varying);
dcl  metering_util_$define_regions entry options (variable);
dcl  metering_util_$fill_buffers entry (fixed bin, fixed bin (71), char (10), (*) pointer, (*) pointer, fixed bin (35));
dcl  ring_zero_peek_$get_max_length entry (char (*), fixed bin (19), fixed bin (35));


/* EXTERNAL STATIC */

dcl  iox_$user_output pointer external static;
dcl  error_table_$noalloc fixed bin (35) external static;


/* INTERNAL STATIC */

dcl  defined bit (1) internal static init ("0"b);		/* indicates whether metering_util_$define_regions has been called */
dcl  mu_index fixed bin internal static;


/* CONDITIONS AND BUILTINS */

dcl  area condition;
dcl  (clock, divide, bin, size, null, hbound, addr, unspec) builtin;

allocate_subchan:
     entry (a_area_ptr, a_meterp, a_code);

/* entry to allocate a fnp_channel_meters structure */

	areap = a_area_ptr;
	a_code = 0;
	on area
	     begin;
		a_code = error_table_$noalloc;
		go to exit;
	     end;

	allocate fnp_chan_meter_struc in (m_area) set (a_meterp);
	a_meterp -> fnp_chan_meter_struc.version = FNP_CHANNEL_METERS_VERSION_1;

exit:
	return;


allocate_mpx:
     entry (a_area_ptr, a_meterp, a_code);

/* entry to allocate a fnp_meters structure */

	areap = a_area_ptr;
	a_code = 0;
	on area
	     begin;
		a_code = error_table_$noalloc;
		go to exit;
	     end;


	allocate fnp_meters in (m_area) set (a_meterp);
	a_meterp -> fnp_meters.version = FNP_METERS_VERSION_2;

	return;




free_subchan:
     entry (a_meterp, a_code);

/* entry to free the fnp_channel_meters structure */

	fnp_chan_meterp = a_meterp;
	free fnp_chan_meter_struc;
	a_code = 0;
	return;



free_mpx:
     entry (a_meterp, a_code);

/* entry to free the fnp_meters structure */

	fnp_meterp = a_meterp;
	free fnp_meters;
	a_code = 0;
	return;

display_mpx:
     entry (a_chan_name, a_iocbp, a_chan_meterp, a_flags, a_code);

/* entry to display meters for a whole FNP */

	call setup_display;

	fnp_meterp = channel_meters.mpx_specific_meterp;
	fnp_meters_available = (unspec (fnp_meters.from_fnp) ^= "0"b);
	time_up = clock () - fnp_meters.from_fnp.time_booted;
	input_chars = channel_meters.cumulative.unconverted_input_chars;
	output_chars = channel_meters.cumulative.converted_output_chars;

	if ^error
	then do;
	     if fnp_meters_available
	     then do;
		if ^brief
		then call ioa_$ioa_switch (iocbp, "FNP has been up for^35t^a", meter_format_$time (time_up));

		call ioa_$ioa_switch (iocbp, "Number of channels configured^35t^6d", fnp_meters.n_channels);
		call ioa_$ioa_switch (iocbp, "Average number dialed up^38t^a",
		     meter_format_$quotient ((fnp_meters.from_fnp.channels_dialed_cum),
		     (fnp_meters.from_fnp.channels_dialed_updates), "^5.1f"));

		max_possible_idle_count = fnp_meters.from_fnp.max_idle_count * fnp_meters.from_fnp.idle_count_updates;

		call ioa_$ioa_switch (iocbp, "FNP idle^39t^a%",
		     meter_format_$quotient (100 * fnp_meters.from_fnp.total_idle_count, (max_possible_idle_count),
		     "^4.1f"));
		call ioa_$ioa_switch (iocbp, "Idle at peak load^39t^a%",
		     meter_format_$quotient (100 * fnp_meters.from_fnp.min_idle_count, (fnp_meters.from_fnp.max_idle_count),
		     "^4.1f"));
	     end;

	     call ioa_$ioa_switch (iocbp, "^/^37tInput^52tOutput");
	     call ioa_$ioa_switch (iocbp, "Characters transmitted^30t^a^46t^a", meter_format_$picture (input_chars, 11),
		meter_format_$picture (output_chars, 11));
	     call ioa_$ioa_switch (iocbp, "Characters per second^30t^a^46t^a^/",
		meter_format_$picture (divide (1000000 * input_chars, time_up, 35, 0), 11),
		meter_format_$picture (divide (1000000 * output_chars, time_up, 35, 0), 11));
	end;

	if ^brief & fnp_meters_available
	then do;
	     call ioa_$ioa_switch (iocbp, "Abnormal DIA status ^35t^a",
		meter_format_$picture ((fnp_meters.from_fnp.abnormal_dia_status), 6));
	     call ioa_$ioa_switch (iocbp, "Memory EDAC errors^35t^a",
		meter_format_$picture (fnp_meters.from_fnp.memory_parity_errors, 6));
	end;

	if ^error
	then call ioa_$ioa_switch (iocbp, "^/Memory size^38t^3dK", divide (fnp_meters.fnp_mem_size, 1024, 17, 0));

	if fnp_meters_available
	then do;
	     if ^error
	     then do;
		pool = fnp_meters.from_fnp.buffer_pool;
		call ioa_$ioa_switch (iocbp, "Total available buffer pool^35t^a words",
		     meter_format_$picture (pool, 6));

		avg_space_available =
		     divide (fnp_meters.from_fnp.space_available_cum, fnp_meters.from_fnp.space_available_updates, 35,
		     0);
		call ioa_$ioa_switch (iocbp, "Avg. amount of free space^35t^a words",
		     meter_format_$picture (avg_space_available, 6));
		call ioa_$ioa_switch (iocbp, "Average % of buffer pool available^38t^a",
		     meter_format_$quotient (100 * avg_space_available, (pool), "^5.1f"));
		call ioa_$ioa_switch (iocbp, "Number of buffer allocations^32t^a",
		     meter_format_$picture (fnp_meters.from_fnp.buffer_allocations, 9));
		call ioa_$ioa_switch (iocbp, "Number of buffers preallocated^32t^a (^a% of allocations)",
		     meter_format_$picture (fnp_meters.from_fnp.buffers_preallocated, 9),
		     meter_format_$quotient (100 * fnp_meters.from_fnp.buffers_preallocated,
		     (fnp_meters.from_fnp.buffer_allocations), "^5.1f"));
		call ioa_$ioa_switch (iocbp, "Used preallocated buffer^32t^a",
		     meter_format_$picture (fnp_meters.from_fnp.used_preallocated_buffer, 9));
	     end;

	     call ioa_$ioa_switch (iocbp, "No preallocated buffer available^35t^a",
		meter_format_$picture (fnp_meters.from_fnp.no_preallocated_available, 6));
	     call ioa_$ioa_switch (iocbp, "Buffer allocation failures^35t^a",
		meter_format_$picture ((fnp_meters.from_fnp.space_alloc_failures), 6));
	end;

	if ^brief
	then do;
	     call ioa_$ioa_switch (iocbp, "Output restricted by space^35t^a",
		meter_format_$picture ((fnp_meters.fnp_space_restricted_output), 6));

	     if ^error
	     then do;
		if ^defined			/* if we've never gotten this info before */
		then do;
		     call ring_zero_peek_$get_max_length ("iom_data", iom_data_len, code);
		     call metering_util_$define_regions (mu_index, code, "tc_data", "processor_time", 2, "iom_data",
			0, iom_data_len);
		     if code = 0
		     then defined = "1"b;
		end;

		call metering_util_$fill_buffers (mu_index, meter_time, char_time, cur_ptrs, prev_ptrs, code);
		if code = 0
		then cpu_time = cur_ptrs (1) -> based_time;
		else cpu_time = 0;			/* an unlikely screwup -- metering_util_ would call sub_err_ */

/* now get the interupt traffic information for the IOM channel the FNP is on */

		n_interrupts, interrupt_time = 0;
		iom_data_ptr = cur_ptrs (2);
		iomx = iom_data.per_iom (fnp_meters.iom_number).chantab (fnp_meters.iom_chan_no);
		if iomx ^= 0			/* it had better not be */
		then do;
		     n_interrupts = iom_data.per_device (iomx).interrupts;
		     interrupt_time = iom_data.per_device (iomx).interrupt_time;
		end;

		call ioa_$ioa_switch (iocbp, "^/Number of interrupts from this FNP^38t^a",
		     meter_format_$picture (n_interrupts, 11));
		call ioa_$ioa_switch (iocbp, "Avg. time/interrupt (ms)^38t^a",
		     meter_format_$quotient (interrupt_time, 1000 * n_interrupts, "^6.1f"));
		call ioa_$ioa_switch (iocbp, "% of total CPU time^38t^a",
		     meter_format_$quotient (100 * interrupt_time, cpu_time, "^6.1f"));

		call ioa_$ioa_switch (iocbp, "^/Mailbox transactions:^/^3xInput data^36t^a",
		     meter_format_$picture (fnp_meters.input_data_transactions, 10));

		call ioa_$ioa_switch (iocbp, "^3xOutput data^36t^a",
		     meter_format_$picture (fnp_meters.output_data_transactions, 10));

		call ioa_$ioa_switch (iocbp, "^3xInput control^36t^a",
		     meter_format_$picture (fnp_meters.input_control_transactions, 10));

		call ioa_$ioa_switch (iocbp, "^3xOutput control^36t^a",
		     meter_format_$picture (fnp_meters.output_control_transactions, 10));

		call ioa_$ioa_switch (iocbp, "^60(-^)^/^3xTotal^36t^a",
		     meter_format_$picture (fnp_meters.input_data_transactions + fnp_meters.output_data_transactions
		     + fnp_meters.input_control_transactions + fnp_meters.output_control_transactions, 10));

		if fnp_meters_available
		then call ioa_$ioa_switch (iocbp, "^/Average inbound mailboxes in use^39t^a",
			meter_format_$quotient ((fnp_meters.from_fnp.input_mbx_in_use_cum),
			(fnp_meters.from_fnp.input_mbx_updates), "^4.1f"));

		call ioa_$ioa_switch (iocbp, "Average outbound mailboxes in use^39t^a",
		     meter_format_$quotient ((fnp_meters.output_mbx_in_use_cum), (fnp_meters.output_mbx_updates),
		     "^4.1f"));

		call ioa_$ioa_switch (iocbp, "Maximum outbound mailboxes in use^39t^2d",
		     fnp_meters.max_output_mbx_in_use);
	     end;

	     call ioa_$ioa_switch (iocbp, "No outbound mailbox available^36t^a",
		meter_format_$picture (fnp_meters.output_mbx_unavailable, 5));

	     call ioa_$ioa_switch (iocbp, "Input rejects^36t^a", meter_format_$picture ((fnp_meters.input_rejects), 5));
	     call ioa_$ioa_switch (iocbp, "% of input transactions rejected^38t^a",
		meter_format_$quotient (100 * fnp_meters.input_rejects, (fnp_meters.input_data_transactions), "^5.2f")
		);
	end;
	return;

display_subchan:
     entry (a_chan_name, a_iocbp, a_chan_meterp, a_flags, a_code);

/* entry to display meters kept by an FNP for one of its subchannels */

	call setup_display;
	if flags & DISPLAY_MPX_SINCE_BOOT
	then since_boot = "1"b;
	else since_boot = "0"b;

	call set_subchan_values;

	if synchronous
	then do;
	     if ^error
	     then do;
		call ioa_$ioa_switch (iocbp, "^/^34tinput^45toutput");
		call ioa_$ioa_switch (iocbp, "Messages transmitted^28t^a^40t^a",
		     meter_format_$picture (input_messages, 11), meter_format_$picture (output_messages, 11));
		call ioa_$ioa_switch (iocbp, "Minimum message length^34t^a^46t^a",
		     meter_format_$picture ((current_meterp -> fnp_sync_meters.input.min_length), 5),
		     meter_format_$picture ((current_meterp -> fnp_sync_meters.output.min_length), 5));
		call ioa_$ioa_switch (iocbp, "Maximum message length^32t^a^44t^a",
		     meter_format_$picture ((current_meterp -> fnp_sync_meters.input.max_length), 7),
		     meter_format_$picture ((current_meterp -> fnp_sync_meters.output.max_length), 7));
		call ioa_$ioa_switch (iocbp, "Average message length^32t^a^44t^a",
		     meter_format_$quotient ((input_length), (input_messages), "^9.2f"),
		     meter_format_$quotient ((output_length), (output_messages), "^9.2f"));
	     end;

	     if ^multiplexed
	     then do;
		call ioa_$ioa_switch (iocbp, "Invalid input messages^28t^a (^a% of messages)",
		     meter_format_$picture (counters (1), 11),
		     meter_format_$quotient (counters (1) * 100, (input_messages), "^.2f"));
		call ioa_$ioa_switch (iocbp, "Rejected output messages^28t^a (^a% of messages)",
		     meter_format_$picture (counters (2), 11),
		     meter_format_$quotient (counters (2) * 100, (output_messages), "^.2f"));
		call ioa_$ioa_switch (iocbp, "Timeouts^28t^a", meter_format_$picture (counters (3), 11));

		if ^brief
		then do;
		     if channel_meters.line_type = LINE_G115
		     then do;
			call ioa_$ioa_switch (iocbp, "Input busy^30t^a", meter_format_$picture (counters (4), 9));
			call ioa_$ioa_switch (iocbp, "Output retries exceeded limit^32t^a",
			     meter_format_$picture (counters (5), 7));
			call ioa_$ioa_switch (iocbp, "No SOH or ETX in message^32t^a",
			     meter_format_$picture (counters (6), 7));
			call ioa_$ioa_switch (iocbp, "Output message too long^32t^a",
			     meter_format_$picture (counters (7), 7));
			call ioa_$ioa_switch (iocbp, "Failure to build message^32t^a",
			     meter_format_$picture (counters (8), 7));
		     end;

		     else if channel_meters.line_type = LINE_BSC
		     then do;
			if ^error
			then do;
			     call ioa_$ioa_switch (iocbp, "WACKs sent^30t^a",
				meter_format_$picture (counters (4), 9));
			     call ioa_$ioa_switch (iocbp, "WACKs received^30t^a",
				meter_format_$picture (counters (5), 9));
			end;

			call ioa_$ioa_switch (iocbp, "Output retries exceeded limit^32t^a",
			     meter_format_$picture (counters (6), 7));
			call ioa_$ioa_switch (iocbp, "Unrecognized or missing response^30t^a",
			     meter_format_$picture (counters (7), 9));
			call ioa_$ioa_switch (iocbp, "Line bid failed^32t^a",
			     meter_format_$picture (counters (8), 7));
		     end;
		end;
	     end;
	end;

	if channel_meters.line_type = LINE_X25LAP
	then do;
	     call ioa_$ioa_switch (iocbp, "^/Frames dumped:^32t^a", meter_format_$picture (counters (3), 7));
	     call ioa_$ioa_switch (iocbp, "Frames retransmitted:^32t^a", meter_format_$picture (counters (1), 7));
	     call ioa_$ioa_switch (iocbp, "Receiver reset request:^32t^a", meter_format_$picture (counters (4), 7));
	     call ioa_$ioa_switch (iocbp, "Transmitter reset:^32t^a", meter_format_$picture (counters (2), 7));
	     call ioa_$ioa_switch (iocbp, "Frame check errors:^32t^a", meter_format_$picture (counters (5), 7));
	     call ioa_$ioa_switch (iocbp, "Frame aborts received:^32t^a", meter_format_$picture (counters (6), 7));
	end;

	if ^error & ^brief
	then do;
	     call ioa_$ioa_switch (iocbp, "^/Output overlaps in FNP^33t^a", meter_format_$picture (output_overlaps, 7));
	     call ioa_$ioa_switch (iocbp, "Average length of DIA request queue^36t^a",
		meter_format_$quotient ((dia_q_len), (dia_q_updates), "^4.1f"));
	end;

	if brief
	then return;				/* everything else is ^brief */
	else call ioa_$ioa_switch (iocbp, "");

	call ioa_$ioa_switch (iocbp, "Exhaust status^31t^a", meter_format_$picture (exhaust, 9));
	call ioa_$ioa_switch (iocbp, "Software transfer timing error^31t^a", meter_format_$picture (xte, 9));

	if ^synchronous
	then do;
	     if ^error
	     then call ioa_$ioa_switch (iocbp, "Pre-exhaust status^31t^a", meter_format_$picture (pre_exhaust, 9));

	     call ioa_$ioa_switch (iocbp, "Bell/quits^31t^a", meter_format_$picture (bell_quits, 9));
	     call ioa_$ioa_switch (iocbp, "Echo buffer overflows^31t^a", meter_format_$picture (echo_overflows, 9));
	end;

	call ioa_$ioa_switch (iocbp, "Parity errors^31t^a^/", meter_format_$picture (parity_errors, 9));

	if ^error
	then call ioa_$ioa_switch (iocbp, "Avg. number of pending status events^38t^a",
		meter_format_$quotient ((pending_status), (status_updates), "^4.1f"));
	call ioa_$ioa_switch (iocbp, "Software status queue overflows^34t^a", meter_format_$picture (ssqo, 6));
	call ioa_$ioa_switch (iocbp, "Hardware status queue overflows^34t^a", meter_format_$picture (hsqo, 6));
	call ioa_$ioa_switch (iocbp, "Input buffer allocation failures^34t^a",
	     meter_format_$picture (alloc_failures, 6));

	return;

subchan_summary:
     entry (a_chan_meterp, a_since_boot, a_summary_ptr, a_code);

/* entry to fill in values used by channel_comm_meters -summary */

	a_code = 0;
	chan_meterp = a_chan_meterp;
	summary_ptr = a_summary_ptr;
	since_boot = a_since_boot;
	call set_subchan_values;
	channel_summary.error_count = 0;

	if ^synchronous
	then do;
	     channel_summary.pre_exhaust = (pre_exhaust ^= 0);
	     channel_summary.bell_quit = (bell_quits ^= 0);
	     channel_summary.echo_overflow = (echo_overflows ^= 0);
	     channel_summary.error_count = exhaust + xte + bell_quits + echo_overflows;
	end;

	else do;
	     channel_summary.invalid_input = (counters (1) ^= 0);
	     channel_summary.output_re_xmit = (counters (2) ^= 0);
	     channel_summary.timeout = (counters (3) ^= 0);
	     if ^multiplexed
	     then channel_summary.error_count = sum (counters);
	end;

	channel_summary.exhaust = (exhaust ^= 0);
	channel_summary.xte = (xte ^= 0);
	channel_summary.parity = (parity_errors ^= 0);
	channel_summary.ssqo = (ssqo ^= 0);
	channel_summary.hsqo = (hsqo ^= 0);
	channel_summary.alloc_failure = (alloc_failures ^= 0);
	channel_summary.synchronous = synchronous;
	channel_summary.error_count = channel_summary.error_count + parity_errors + ssqo + hsqo + alloc_failures;

	return;

set_subchan_values:
     procedure;

/* internal procedure to set values for use by display_subchan and subchan_summary */

dcl  i fixed bin;

	multiplexed = (channel_meters.multiplexer_type ^= 0);
	fnp_chan_meterp = channel_meters.parent_meterp;
	synchronous = fnp_chan_meter_struc.synchronous;
	current_meterp = addr (fnp_chan_meter_struc.current_meters);

/* get total values from current meters */

	total_dia_q_len = current_meterp -> fnp_channel_meters.dia_request_q_len;
	total_dia_q_updates = current_meterp -> fnp_channel_meters.dia_rql_updates;
	total_pending_status = current_meterp -> fnp_channel_meters.pending_status;
	total_status_updates = current_meterp -> fnp_channel_meters.pending_status_updates;
	total_output_overlaps = current_meterp -> fnp_channel_meters.output_overlaps;
	total_parity_errors = current_meterp -> fnp_channel_meters.parity_errors;
	total_ssqo = current_meterp -> fnp_channel_meters.software_status_overflows;
	total_hsqo = current_meterp -> fnp_channel_meters.hardware_status_overflows;
	total_alloc_failures = current_meterp -> fnp_channel_meters.input_alloc_failures;
	total_exhaust = current_meterp -> fnp_channel_meters.exhaust;
	total_xte = current_meterp -> fnp_channel_meters.software_xte;

	if synchronous
	then do;
	     total_input_messages = current_meterp -> fnp_sync_meters.input.message_count;
	     total_input_length = current_meterp -> fnp_sync_meters.input.cum_length;
	     total_output_messages = current_meterp -> fnp_sync_meters.output.message_count;
	     total_output_length = current_meterp -> fnp_sync_meters.output.cum_length;
	     do i = 1 to hbound (current_meterp -> fnp_sync_meters.counters, 1);
		total_counters (i) = current_meterp -> fnp_sync_meters.counters (i);
	     end;
	end;

	else do;
	     total_pre_exhaust = current_meterp -> fnp_async_meters.pre_exhaust;
	     total_echo_overflows = current_meterp -> fnp_async_meters.echo_buf_overflow;
	     total_bell_quits = current_meterp -> fnp_async_meters.bell_quits;
	end;

	if since_boot
	then do;					/* totals are values to use */
	     dia_q_len = total_dia_q_len;
	     dia_q_updates = total_dia_q_updates;
	     pending_status = total_pending_status;
	     status_updates = total_status_updates;
	     output_overlaps = total_output_overlaps;
	     parity_errors = total_parity_errors;
	     ssqo = total_ssqo;
	     hsqo = total_hsqo;
	     alloc_failures = total_alloc_failures;
	     exhaust = total_exhaust;
	     xte = total_xte;

	     if synchronous
	     then do;
		input_messages = total_input_messages;
		input_length = total_input_length;
		output_messages = total_output_messages;
		output_length = total_output_length;
		do i = 1 to hbound (current_meterp -> fnp_sync_meters.counters, 1);
		     counters (i) = total_counters (i);
		end;
	     end;

	     else do;
		pre_exhaust = total_pre_exhaust;
		echo_overflows = total_echo_overflows;
		bell_quits = total_bell_quits;
	     end;
	end;

	else do;					/* have to subtract saved values */
	     saved_meterp = addr (fnp_chan_meter_struc.saved_meters);
	     dia_q_len = total_dia_q_len - saved_meterp -> fnp_channel_meters.dia_request_q_len;
	     dia_q_updates = total_dia_q_updates - saved_meterp -> fnp_channel_meters.dia_rql_updates;
	     pending_status = total_pending_status - saved_meterp -> fnp_channel_meters.pending_status;
	     status_updates = total_status_updates - saved_meterp -> fnp_channel_meters.pending_status_updates;
	     output_overlaps = total_output_overlaps - saved_meterp -> fnp_channel_meters.output_overlaps;
	     parity_errors = total_parity_errors - saved_meterp -> fnp_channel_meters.parity_errors;
	     ssqo = total_ssqo - saved_meterp -> fnp_channel_meters.software_status_overflows;
	     hsqo = total_hsqo - saved_meterp -> fnp_channel_meters.hardware_status_overflows;
	     alloc_failures = total_alloc_failures - saved_meterp -> fnp_channel_meters.input_alloc_failures;
	     exhaust = total_exhaust - saved_meterp -> fnp_channel_meters.exhaust;
	     xte = total_xte - saved_meterp -> fnp_channel_meters.software_xte;

	     if synchronous
	     then do;
		input_messages = total_input_messages - saved_meterp -> fnp_sync_meters.input.message_count;
		input_length = total_input_length - saved_meterp -> fnp_sync_meters.input.cum_length;
		output_messages = total_output_messages - saved_meterp -> fnp_sync_meters.output.message_count;
		output_length = total_output_length - saved_meterp -> fnp_sync_meters.output.cum_length;
		do i = 1 to hbound (saved_meterp -> fnp_sync_meters.counters, 1);
		     counters (i) = total_counters (i) - saved_meterp -> fnp_sync_meters.counters (i);
		end;
	     end;

	     else do;
		pre_exhaust = total_pre_exhaust - saved_meterp -> fnp_async_meters.pre_exhaust;
		echo_overflows = total_echo_overflows - saved_meterp -> fnp_async_meters.echo_buf_overflow;
		bell_quits = total_bell_quits - saved_meterp -> fnp_async_meters.bell_quits;
	     end;
	end;

	return;
     end set_subchan_values;

setup_display:
     procedure;

/* internal procedure to set up local variables for display entries */

	iocbp = a_iocbp;
	if iocbp = null ()
	then iocbp = iox_$user_output;

	chan_meterp = a_chan_meterp;
	flags = a_flags;
	a_code = 0;

	if flags & DISPLAY_MPX_SUMMARY		/* we don't handle this */
	then return;

	if flags & DISPLAY_MPX_BRIEF
	then brief = "1"b;
	else brief = "0"b;

	if flags & DISPLAY_MPX_ERROR
	then error = "1"b;
	else error = "0"b;
	return;

     end setup_display;

%include fnp_meters;
%page;
%include fnp_channel_meters;
%page;
%include channel_meters;
%page;
%include comm_meters_disp_flags;
%page;
%include line_types;
%page;
%include iom_data;
%page;
%include channel_summary;
     end mcs_meters_;




		    meter_fnp_idle.pl1              04/09/85  1715.2r w 04/08/85  1134.0      148905



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* format: style4,delnl,insnl,^ifthendo */
meter_fnp_idle:
     procedure;

/* This command causes the process to wake up at specified intervals and record the specified FNP's idle time
   for the most recent interval. This data is stored away in a segment where the display_fnp_idle
   command can find it. If the FNP crashes and reloads while the command is runninmg, a new data
   segment is started.
*/

/* Coded January 1982 by Robert Coren */
/* Modified March 1982 by Robert Coren to correct time slippage. */

dcl  fnp_name char (1);
dcl  minutes fixed bin;
dcl  stop bit (1);
dcl  non_stop bit (1);
dcl  dirname char (168);
dcl  entryname char (32);
dcl  code fixed bin (35);
dcl  nargs fixed bin;
dcl  iarg fixed bin;
dcl  infop pointer;
dcl  fnp_no fixed bin;
dcl  event_message fixed bin (71);
dcl  comm_meters_chan_name (1) char (1);
dcl  areap pointer;
dcl  meter_time fixed bin (71);
dcl  next_entry fixed bin;
dcl  idle_count fixed bin (35);
dcl  idle_updates fixed bin (35);
dcl  delta_idle fixed bin (35);

dcl  argp pointer;
dcl  argl fixed bin (21);
dcl  arg char (argl) based (argp);

dcl  cu_$arg_count entry (fixed bin, fixed bin (35));
dcl  com_err_ entry () options (variable);
dcl  com_err_$suppress_name entry () options (variable);
dcl  continue_to_signal_ entry (fixed bin (35));
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin);
dcl  find_condition_info_ entry (ptr, ptr, fixed bin (35));
dcl  expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
dcl  pathname_ entry (char (*), char (*)) returns (char (168));
dcl  get_process_id_ entry returns (bit (36));
dcl  parse_fnp_name_ entry (char (*), fixed bin);
dcl  ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35));
dcl  convert_ipc_code_ entry (fixed bin (35));
dcl  ipc_$decl_ev_call_chn entry (fixed bin (71), ptr, ptr, fixed bin, fixed bin (35));
dcl  hcs_$wakeup entry (bit (*), fixed bin (71), fixed bin (71), fixed bin (35));
dcl  get_system_free_area_ entry () returns (ptr);
dcl  comm_meters_ entry ((*) char (*), fixed bin, ptr, fixed bin, ptr, fixed bin (35));
dcl  comm_meters_$free entry (ptr, ptr, fixed bin (35));
dcl  timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71));

dcl  (
     error_table_$action_not_performed,
     error_table_$inconsistent,
     error_table_$too_many_args,
     error_table_$noarg,
     error_table_$badopt
     ) fixed bin (35) external static;

dcl  COMMAND_NAME char (14) internal static options (constant) init ("meter_fnp_idle");

dcl  static_dirname char (168) internal static;

dcl  1 meter_fnp_idle_info_array (8) internal static aligned like meter_fnp_idle_info;

dcl  1 meter_fnp_idle_info aligned based (infop),
       2 event_channel_name fixed bin (71),
       2 next_cycle_sched fixed bin (71),
       2 interval fixed bin (71),
       2 data_seg_ptr pointer,
       2 fnp_name char (1),
       2 minutes fixed bin,
       2 flags,
         3 running bit (1) unaligned,
         3 suspended bit (1) unaligned,
         3 stop_requested bit (1) unaligned,
         3 pad bit (33) unaligned;

dcl  (cleanup, sub_error_) condition;

	fnp_name = "";
	minutes = 0;
	dirname = "";
	stop, non_stop = "0"b;

	call cu_$arg_count (nargs, code);
	if code ^= 0
	then do;
	     call com_err_ (code, COMMAND_NAME);
	     return;
	end;

	if nargs = 0
	then do;
	     call com_err_$suppress_name (0, COMMAND_NAME, "Usage: meter_fnp_idle fnp_name {-stop | -interval MINUTES}")
		;
	     return;
	end;

	do iarg = 1 to nargs;
	     call cu_$arg_ptr (iarg, argp, argl, code);
	     if code ^= 0
	     then do;
		call com_err_ (code, COMMAND_NAME);
		return;
	     end;

	     if substr (arg, 1, 1) ^= "-"
	     then do;				/* not a control arg, must be FNP name */
		call parse_fnp_name_ (arg, fnp_no);
		if fnp_no < 0
		then do;
		     call com_err_ (0, COMMAND_NAME, "^a is not a valid FNP name.", arg);
		     return;
		end;
		else if fnp_name ^= ""
		then do;
		     call com_err_ (error_table_$inconsistent, COMMAND_NAME,
			"More than one FNP name specified: ^a and ^a", fnp_name, arg);
		     return;
		end;
		fnp_name = arg;
	     end;

	     else if arg = "-stop" | arg = "-sp"
	     then if non_stop
		then do;
STOP_ERROR:
		     call com_err_ (error_table_$inconsistent, COMMAND_NAME,
			"-stop cannot be specified with any other control argument.");
		     return;
		end;
		else stop = "1"b;

	     else if stop
	     then go to STOP_ERROR;
	     else do;
		non_stop = "1"b;

		if arg = "-directory" | arg = "-dr"
		then do;
		     iarg = iarg + 1;
		     call cu_$arg_ptr (iarg, argp, argl, code);
		     if code ^= 0
		     then do;
NO_DIR:
			call com_err_ (code, COMMAND_NAME, "No directory pathname specified.");
			return;
		     end;

		     if substr (arg, 1, 1) = "-"
		     then do;
			code = error_table_$noarg;
			go to NO_DIR;
		     end;

		     call expand_pathname_ (arg, dirname, entryname, code);
		     if code ^= 0
		     then do;
			call com_err_ (code, COMMAND_NAME, arg);
			return;
		     end;

		     dirname = pathname_ (dirname, entryname);
		end;

		else if arg = "-interval"
		then do;
		     if minutes ^= 0
		     then do;
			call com_err_ (error_table_$inconsistent, COMMAND_NAME, "More than one interval specified.")
			     ;
			return;
		     end;
		     iarg = iarg + 1;
		     call cu_$arg_ptr (iarg, argp, argl, code);
		     if code ^= 0
		     then do;
NO_INTERVAL:
			call com_err_ (code, COMMAND_NAME, "Interval value not supplied.");
			return;
		     end;

		     if substr (arg, 1, 1) = "-"
		     then do;
			code = error_table_$noarg;
			go to NO_INTERVAL;
		     end;

		     minutes = cv_dec_check_ (arg, code);
		     if code ^= 0
		     then do;
			call com_err_ (0, COMMAND_NAME, "^a is not a valid interval specification.", arg);
			return;
		     end;
		end;

		else do;
		     call com_err_ (error_table_$badopt, COMMAND_NAME, arg);
		     return;
		end;
	     end;
	end;

	if fnp_name = ""
	then do;
	     call com_err_ (error_table_$noarg, COMMAND_NAME, "No FNP name specified.");
	     return;
	end;

	static_dirname = dirname;

	infop = addr (meter_fnp_idle_info_array (fnp_no));
	if stop
	then do;
	     if ^meter_fnp_idle_info.running
	     then call com_err_ (0, COMMAND_NAME, "This process is not metering FNP ^a.", fnp_name);
	     else meter_fnp_idle_info.stop_requested = "1"b;
	     return;
	end;

	if meter_fnp_idle_info.running
	then do;
	     call com_err_ (error_table_$action_not_performed, COMMAND_NAME, "This process is already metering FNP ^a.",
		fnp_name);
	     return;
	end;

	if minutes = 0
	then minutes = 1;				/* default to one minute interval */

	meter_fnp_idle_info.minutes = minutes;		/* for forming pathname */
	meter_fnp_idle_info.next_cycle_sched = 0;
	meter_fnp_idle_info.interval = 60000000 * minutes;/* convert to microseconds */
	meter_fnp_idle_info.data_seg_ptr = null ();
	meter_fnp_idle_info.fnp_name = fnp_name;
	string (meter_fnp_idle_info.flags) = "0"b;

	call ipc_$create_ev_chn (meter_fnp_idle_info.event_channel_name, code);
	if code ^= 0
	then do;
	     call convert_ipc_code_ (code);
	     call com_err_ (code, COMMAND_NAME, "Unable to create event channel.");
	     return;
	end;

	call ipc_$decl_ev_call_chn (meter_fnp_idle_info.event_channel_name, codeptr (idle_wakeup), infop, 30, code);
	if code ^= 0
	then do;
	     call convert_ipc_code_ (code);
	     call com_err_ (code, COMMAND_NAME, "Unable to set up event call channel.");
	     return;
	end;

	event_message = fnp_no;
	meter_fnp_idle_info.running = "1"b;
	call hcs_$wakeup (get_process_id_ (), meter_fnp_idle_info.event_channel_name, event_message, code);
	if code ^= 0
	then do;
	     call convert_ipc_code_ (code);
	     call com_err_ (code, COMMAND_NAME, "Unable to send initial wakeup.");
	end;

	return;

idle_wakeup:
     entry (arg_event_call_info_ptr);

/* this entry, which reschedules itself for the next metering interval, does all the real work */

dcl  arg_event_call_info_ptr pointer;

	event_call_info_ptr = arg_event_call_info_ptr;
	infop = event_call_info.data_ptr;
	if event_call_info.channel_id ^= meter_fnp_idle_info.event_channel_name
	then return;				/* not the right wakeup */

	meter_time = clock ();
	if meter_fnp_idle_info.next_cycle_sched = 0
	then meter_fnp_idle_info.next_cycle_sched = meter_time;
	meter_fnp_idle_info.next_cycle_sched = meter_fnp_idle_info.next_cycle_sched + meter_fnp_idle_info.interval;

	if meter_fnp_idle_info.stop_requested
	then do;					/* finished with this one */
	     call wrapup_data_segment;
	     meter_fnp_idle_info.stop_requested, meter_fnp_idle_info.running = "0"b;
	     return;
	end;

	on sub_error_
	     begin;

/* this is here because comm_meters_ calls sub_err_ in case of problems. Since it also
   returns a useful error code if called with a single channel name, this handler doesn't have to explain anything */

dcl  code fixed bin (35);
dcl  pass_on bit (1);
dcl  1 auto_cond_info aligned like condition_info;

		pass_on = "0"b;
		condition_info_ptr = addr (auto_cond_info);
		call find_condition_info_ (null (), condition_info_ptr, code);
		if code ^= 0			/* rather unlikely */
		then pass_on = "1"b;		/* but we'll let someone else worry about it */

		else if condition_info.info_ptr = null () | condition_info.condition_name ^= "sub_error_"
						/* we're not about to deal with this */
		then pass_on = "1"b;

		else do;
		     sub_error_info_ptr = condition_info.info_ptr;
		     if sub_error_info.name ^= "comm_meters_"
						/* not someone we know */
		     then pass_on = "1"b;
		end;

		if pass_on
		then call continue_to_signal_ (code);
	     end;

	comm_meters_chan_name (1) = meter_fnp_idle_info.fnp_name;
	areap = get_system_free_area_ ();

	call comm_meters_ (comm_meters_chan_name, CHANNEL_METERS_VERSION_1, areap, (0), chan_meterp, code);

	if code = 0				/* we got meters */
	then do;
	     on cleanup call comm_meters_$free (areap, chan_meterp, (0));
	     fnp_meterp = channel_meters.mpx_specific_meterp;
	     if unspec (fnp_meters.from_fnp) = "0"b
	     then call wrapup_data_segment;		/* oops, nothing useful */
	     else do;
		fnp_idle_data_ptr = meter_fnp_idle_info.data_seg_ptr;
		if fnp_idle_data_ptr = null ()
		then do;				/* no segment active at the moment */
		     call setup_data_segment (code);	/* so start one */
		     if code ^= 0
		     then do;
			meter_fnp_idle_info.running = "1"b;
			return;			/* we couldn't, forget it */
		     end;
		end;

		if fnp_idle_data.entries_used >= fnp_idle_data.max_entries
						/* we've filled this one */
		then do;
		     call wrapup_data_segment;
		     call setup_data_segment (code);	/* start a new one */
		     if code ^= 0
		     then do;
			meter_fnp_idle_info.running = "0"b;
			return;
		     end;
		end;

		next_entry = fnp_idle_data.entries_used + 1;
		idle_count = fnp_meters.from_fnp.total_idle_count;
		idle_updates = fnp_meters.from_fnp.idle_count_updates;
		delta_idle = idle_count - fnp_idle_data.latest_idle_count;

		fnp_idle_data.entries (next_entry).idle_count = idle_count;
		fnp_idle_data.entries (next_entry).sample_count = idle_updates;
		fnp_idle_data.maximum_idle_count = fnp_meters.from_fnp.max_idle_count;

		if fnp_idle_data.minimum_idle_count = 0
		     | fnp_meters.from_fnp.min_idle_count < fnp_idle_data.minimum_idle_count
		then do;
		     fnp_idle_data.minimum_idle_count = fnp_meters.from_fnp.min_idle_count;
		     fnp_idle_data.time_of_minimum_sample = meter_time;
		end;

		if fnp_idle_data.minimum_delta_idle = 0 | delta_idle < fnp_idle_data.minimum_delta_idle
		then do;
		     fnp_idle_data.minimum_delta_idle = delta_idle;
		     fnp_idle_data.time_of_minimum_average = meter_time;
		end;

		fnp_idle_data.latest_idle_count = idle_count;
		fnp_idle_data.latest_sample_count = idle_updates;
		fnp_idle_data.entries_used = next_entry;
		fnp_idle_data.last_time = meter_time;

		call comm_meters_$free (areap, chan_meterp, code);
		revert cleanup;
	     end;
	end;

	else call wrapup_data_segment;

	call timer_manager_$alarm_wakeup (meter_fnp_idle_info.next_cycle_sched, "00"b,
	     meter_fnp_idle_info.event_channel_name);
	return;

setup_data_segment:
     procedure (a_code);

/* This subroutine creates and initializes a data segment for storing the meters accumulated consecutively for
   a single FNP. The entryname of the segment is fnp_idle_data.FNPNAME.YYMMDD.HHMMSS.INTERVAL,
   which makes them easy to sort. */

dcl  a_code fixed bin (35);

dcl  dirname char (168);
dcl  entryname char (32);
dcl  month fixed bin;
dcl  day fixed bin;
dcl  year fixed bin;
dcl  hour fixed bin;
dcl  minute fixed bin;
dcl  second fixed bin;
dcl  pic_month pic "99";
dcl  pic_day pic "99";
dcl  pic_year pic "99";
dcl  pic_hour pic "99";
dcl  pic_minute pic "99";
dcl  pic_second pic "99";
dcl  code fixed bin (35);

dcl  decode_clock_value_$date_time
	entry (fixed bin (71), fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (71),
	fixed bin, char (3), fixed bin (35));
dcl  ioa_$rsnnl entry () options (variable);
dcl  get_wdir_ entry () returns (char (168));
dcl  hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
dcl  hcs_$truncate_seg entry (ptr, fixed bin (19), fixed bin (35));
dcl  hcs_$set_max_length_seg entry (ptr, fixed bin (19), fixed bin (35));
dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  error_table_$namedup fixed bin (35) external static;

	if static_dirname = ""
	then dirname = get_wdir_ ();
	else dirname = static_dirname;

	call decode_clock_value_$date_time (meter_time, month, day, year, hour, minute, second, (0), (0), (""), (0));
	pic_month = month;
	pic_day = day;
	pic_year = mod (year, 100);
	pic_hour = hour;
	pic_minute = minute;
	pic_second = second;

	call ioa_$rsnnl ("fnp_idle_data.^a.^a^a^a.^a^a^a.^d", entryname, (0), meter_fnp_idle_info.fnp_name, pic_year,
	     pic_month, pic_day, pic_hour, pic_minute, pic_second, meter_fnp_idle_info.minutes);

	call hcs_$make_seg (dirname, entryname, "", RW_ACCESS_BIN, fnp_idle_data_ptr, code);
	if fnp_idle_data_ptr = null ()
	then do;
	     call com_err_ (code, COMMAND_NAME, "Could not create ^a", pathname_ (dirname, entryname));
	     a_code = code;
	     return;
	end;

	if code = error_table_$namedup
	then do;
	     call com_err_ (code, COMMAND_NAME, "^a exists. FNP ^a is already being metered.",
		pathname_ (dirname, entryname), meter_fnp_idle_info.fnp_name);
	     a_code = code;
	     call hcs_$terminate_noname (fnp_idle_data_ptr, code);
	     fnp_idle_data_ptr = null ();
	     return;
	end;

	call hcs_$set_max_length_seg (fnp_idle_data_ptr, 65536, code);
	if code ^= 0
	then do;
	     call com_err_ (code, COMMAND_NAME, "Could not set max. length of ^a", pathname_ (dirname, entryname));
	     a_code = code;
	     call hcs_$terminate_noname (fnp_idle_data_ptr, code);
	     return;
	end;

	fnp_idle_data.version = FNP_IDLE_DATA_VERSION_1;
	fnp_idle_data.time_started = meter_time;
	fnp_idle_data.sample_interval = meter_fnp_idle_info.interval;
	fnp_idle_data.max_entries =
	     divide (65536 - bin (rel (addr (fnp_idle_data.entries (1))), 18),
	     size (fnp_idle_data_ptr -> fnp_idle_entry), 17, 0);
	meter_fnp_idle_info.data_seg_ptr = fnp_idle_data_ptr;
	meter_fnp_idle_info.suspended = "0"b;
	meter_fnp_idle_info.running = "1"b;
	a_code = 0;
	return;

     end setup_data_segment;

wrapup_data_segment:
     procedure;

dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  code fixed bin (35);

	call hcs_$terminate_noname (meter_fnp_idle_info.data_seg_ptr, code);
	meter_fnp_idle_info.data_seg_ptr = null ();
	if ^meter_fnp_idle_info.stop_requested
	then meter_fnp_idle_info.suspended = "1"b;
	return;
     end wrapup_data_segment;

%include fnp_idle_data;
%page;
%include access_mode_values;
%page;
%include sub_error_info;
%page;
%include condition_info;
%page;
%include condition_info_header;
%page;
%include channel_meters;
%page;
%include fnp_meters;
%page;
%include event_call_info;

     end meter_fnp_idle;




		    meter_format_.pl1               11/15/82  1813.1rew 11/15/82  1459.8       24822



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* format: style4,delnl,insnl,^ifthendo */
meter_format_:
     procedure;

/* collection of routines to return nicely formatted numbers for metering commands */

/* PARAMETERS */

dcl  number fixed bin (35);
dcl  width fixed bin;
dcl  dividend fixed bin (71);
dcl  divisor fixed bin (71);
dcl  format char (*);
dcl  interval fixed bin (71);

/* AUTOMATIC */

dcl  picture pic "zzz,zzz,zzz,zz9";
dcl  result char (15) varying;
dcl  qresult float bin (27);
dcl  retval char (12) varying;
dcl  hours pic "zzz9";
dcl  minutes pic "99";
dcl  seconds pic "99";
dcl  all_seconds fixed bin (35);


/* ENTRIES */

dcl  ioa_$rsnnl entry options (variable);


/* BUILTINS & CONDITIONS */

dcl  (size, zerodivide) condition;

dcl  (divide, ltrim, copy, max, length, float) builtin;

picture:
     entry (number, width) returns (char (15) varying);

/* a function that, given a fixed bin number, returns it with commas, right-justified in a field of a given width */

	picture = number;				/* this does the magic conversion */
	result = ltrim (picture);			/* get rid of leading blanks */
						/* and then restore the right number of them */
	return (copy (" ", max (0, width - length (result))) || result);

quotient:
     entry (dividend, divisor, format) returns (char (12) varying);

/* a function that divides 2 fixed bins to get a floating result, and then returns it formatted as specified.
   Returns a nice character string in case of division by 0. */

	on zerodivide go to quotient_error;

	qresult = float (dividend) / float (divisor);
	call ioa_$rsnnl (format, retval, (0), qresult);
	return (retval);

quotient_error:
	return ("No data.");

time:
     entry (interval) returns (char (10));

/* a function that, given a time interval in microseconds, returns it in character
   string form as hours:minutes:seconds */

	on size go to time_error;
	all_seconds = divide (interval, 1000000, 35, 0);	/* elapsed time in seconds */
	hours = divide (all_seconds, 3600, 35, 0);
	minutes = divide (all_seconds, 60, 35, 0) - 60 * hours;
						/* residual minutes */
	seconds = all_seconds - 3600 * hours - 60 * minutes; /* residual seconds */
	return (hours || ":" || minutes || ":" || seconds);

time_error:
	return ("No data.");

     end meter_format_;




		    sty_dump_.pl1                   09/21/83  1223.9rew 09/21/83  1222.9       20952



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */
/* format: style4,delnl,insnl,ifthenstmt,indnoniterend */
sty_dump_:
     procedure (Ttybp, Areap, Dp, Sc, Brief);

/* Debugging display for STY channels. */
/* Written July 1981 by C. Hornig */
/* Modified April 1983 by Robert Coren to print access class if present */

dcl  (Ttybp, Areap, Dp) ptr parameter;
dcl  Sc fixed bin parameter;
dcl  Brief bit (1) aligned parameter;

dcl  convert_authorization_$to_string entry (bit (72) aligned, char (*), fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  mode_string_$get entry (ptr, char (*), fixed bin (35));
dcl  tty_dump$print_chain entry (ptr, char (*), fixed bin, bit (1));

dcl  her_sc fixed bin;
dcl  code fixed bin (35);
dcl  modes char (512);
dcl  access_class_string char (864);

dcl  (pointer, rel) builtin;
%page;
	sty_mpx_data_ptr = pointer (Areap, rel (Dp));

	if Sc > 0 then do;
	     pdep = addr (sty_mpx_data.pdes (Sc));
	     her_sc = 1 + mod (Sc - 1 + sty_mpx_data.n_pairs, sty_mpx_data.n_channels);
	     call ioa_ ("^d(^o) -> ^d(^o): ^d words^[ listening^]^[ wru^]^[ eop^]^[ notify_modes^]^[ output_ready^]",
		Sc, pde.devx, her_sc, sty_mpx_data.pdes (her_sc).devx, pde.words, pde.flags.listen, pde.flags.wru,
		pde.flags.end_of_page, pde.flags.notify_modes, pde.flags.output_ready);
	     if pde.mode_ptr ^= null () then do;
		call mode_string_$get (pointer (Areap, rel (pde.mode_ptr)), modes, code);
		if code ^= 0 then modes = "???";
		call ioa_ ("^-modes: ^a", modes);
		end;

	     if pde.access_class_set then do;
		call convert_authorization_$to_string (pde.access_class, access_class_string, code);
		if code ^= 0
		then call ioa_ ("^-access class: ^b3", pde.access_class);
		else call ioa_ ("^-access class: ^a", access_class_string);
		end;

	     call tty_dump$print_chain (Ttybp, "", (pde.head), (Brief));
	     end;

	else do;
	     call ioa_ ("STY MPX devx ^o, ^d channels.", sty_mpx_data.devx, sty_mpx_data.n_channels);
	     end;

	return;
%page;
%include sty_mpx_data;
%include mode_string_info;

     end sty_dump_;




		    system_comm_meters.pl1          10/25/89  1156.0r w 10/25/89  1005.2      200385



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* format: style4,delnl,insnl,^ifthendo */
system_comm_meters:
tty_meters:
     procedure;

/* This is a command to output statistics describing the performance and general
   behavior of the ring-0 communications software.

   Usage: system_comm_meters {-reset | -report_reset}
*/

/* Written March 1981 by Robert Coren */
/* Modified December 1984 by Robert Coren to remove tty_area from metering region (it wasn't used) */

/* AUTOMATIC */

dcl  code fixed bin (35);
dcl  reset bit (1);
dcl  report bit (1);
dcl  char_time char (10);				/* metering time formatted by metering_util_ */
dcl  meter_time fixed bin (71);
dcl  cur_ptrs (2) ptr;
dcl  prev_ptrs (2) ptr;
dcl  total_timep ptr;
dcl  old_ttybp ptr;					/* pointer to older copy of tty_buf */
dcl  old_total_timep ptr;

dcl  in_interrupts fixed bin (35);
dcl  out_interrupts fixed bin (35);
dcl  control_interrupts fixed bin (35);
dcl  in_interrupt_time fixed bin (71);
dcl  out_interrupt_time fixed bin (71);
dcl  control_interrupt_time fixed bin (71);
dcl  read_calls fixed bin (35);
dcl  write_calls fixed bin (35);
dcl  read_time fixed bin (71);
dcl  write_time fixed bin (71);
dcl  in_bytes fixed bin (35);				/* characters in through channel_manager */
dcl  in_messages fixed bin (35);			/* input interrupts through channel manager */
dcl  out_bytes fixed bin (35);
dcl  out_messages fixed bin (35);

dcl  mpx_channels fixed bin;
dcl  devx fixed bin;
dcl  cpu_time fixed bin (71);

dcl  in_before_conv fixed bin (35);
dcl  out_before_conv fixed bin (35);
dcl  in_after_conv fixed bin (35);
dcl  out_after_conv fixed bin (35);
dcl  preconverted fixed bin (35);
dcl  net_read_calls fixed bin (35);
dcl  net_write_calls fixed bin (35);
dcl  net_read_time fixed bin (71);
dcl  net_write_time fixed bin (71);
dcl  net_input_ints fixed bin (35);
dcl  net_output_ints fixed bin (35);
dcl  net_control_ints fixed bin (35);
dcl  net_in_int_time fixed bin (71);
dcl  net_out_int_time fixed bin (71);
dcl  net_control_int_time fixed bin (71);

dcl  pool_size fixed bin (35);
dcl  avg_input_space fixed bin;
dcl  avg_output_space fixed bin;
dcl  avg_control_space fixed bin;
dcl  alloc_calls fixed bin (35);
dcl  free_calls fixed bin (35);
dcl  alloc_time fixed bin (71);
dcl  free_time fixed bin (71);

dcl  ttyb_loop_locks fixed bin (35);
dcl  ttyb_loop_lock_time fixed bin (71);
dcl  alloc_failures fixed bin (35);

dcl  tty_lock_calls fixed bin (35);
dcl  tty_lock_waits fixed bin (35);
dcl  queued_ints fixed bin (35);
dcl  found_lock_locked fixed bin (35);
dcl  echoed_by_r0 fixed bin (35);
dcl  echoed_by_fnp fixed bin (35);

dcl  in_restarts fixed bin (35);
dcl  out_restarts fixed bin (35);
dcl  out_overflows fixed bin (35);

dcl  nargs fixed bin;
dcl  argp ptr;
dcl  argl fixed bin (21);
dcl  arg char (argl) based (argp);


/* BASED */

dcl  time fixed bin (71) based;			/* CPU time from tc_data */


/* INTERNAL STATIC */

dcl  first_time bit (1) int static init ("1"b);		/* indicates first call in this process */
dcl  tty_buf_len fixed bin (19) int static;
dcl  tty_area_len fixed bin (19) int static;
dcl  mu_index fixed bin int static;			/* unique index used by metering_util_ */

/* The following are copies of previous values of the above, set at "reset" time,
   and used for calculating increments over the metering interval */

dcl  old_in_interrupts fixed bin (35) int static init (0);
dcl  old_out_interrupts fixed bin (35) int static init (0);
dcl  old_control_interrupts fixed bin (35) int static init (0);
dcl  old_in_interrupt_time fixed bin (71) int static init (0);
dcl  old_out_interrupt_time fixed bin (71) int static init (0);
dcl  old_control_interrupt_time fixed bin (71) int static init (0);
dcl  old_read_calls fixed bin (35) int static init (0);
dcl  old_write_calls fixed bin (35) int static init (0);
dcl  old_read_time fixed bin (71) int static init (0);
dcl  old_write_time fixed bin (71) int static init (0);
dcl  old_in_bytes fixed bin (35) int static init (0);
dcl  old_in_messages fixed bin (35) int static init (0);
dcl  old_out_bytes fixed bin (35) int static init (0);
dcl  old_out_messages fixed bin (35) int static init (0);

dcl  CMD_NAME char (18) int static options (constant) init ("system_comm_meters");


/* ENTRIES */

dcl  ring_zero_peek_$get_max_length entry (char (*), fixed bin (19), fixed bin (35));
dcl  meter_format_$picture entry (fixed bin (35), fixed bin) returns (char (15) varying);
dcl  meter_format_$quotient entry (fixed bin (71), fixed bin (71), char (*)) returns (char (12) varying);
dcl  metering_util_$define_regions entry options (variable);
dcl  metering_util_$fill_buffers entry (fixed bin, fixed bin (71), char (*), (*) ptr, (*) ptr, fixed bin (35));
dcl  metering_util_$reset entry (fixed bin, fixed bin (35));
dcl  com_err_ entry () options (variable);
dcl  ioa_ entry () options (variable);
dcl  ioa_$rsnnl entry () options (variable);
dcl  cu_$arg_count entry (fixed bin, fixed bin (35));
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));


/* EXTERNAL STATIC */


dcl  (
     error_table_$wrong_no_of_args,
     error_table_$badopt
     ) fixed bin (35) external static;


/* BUILTINS */

dcl  (addrel, rel, addr, divide, bin, currentsize, float, ltrim, copy, length) builtin;

	call cu_$arg_count (nargs, code);
	if code ^= 0
	then do;
	     call com_err_ (code, CMD_NAME, "From cu_$arg_count");
	     return;
	end;

	if nargs = 0
	then do;
	     reset = "0"b;
	     report = "1"b;
	end;

	else do;
	     if nargs ^= 1				/* only 1 is allowed */
	     then do;
		call com_err_ (error_table_$wrong_no_of_args, CMD_NAME,
		     "^/Usage: system_comm_meters {-reset | -report_reset}");
		return;
	     end;

	     call cu_$arg_ptr (1, argp, argl, code);
	     if arg = "-reset" | arg = "-rs"
	     then do;
		reset = "1"b;
		report = "0"b;
	     end;

	     else if arg = "-report_reset" | arg = "-rr"
	     then do;
		reset = "1"b;
		report = "1"b;
	     end;

	     else do;
		call com_err_ (error_table_$badopt, CMD_NAME, arg);
		return;
	     end;
	end;

	if first_time				/* have we initialized already? */
	then do;					/* if not, do it now */
	     call ring_zero_peek_$get_max_length ("tty_buf", tty_buf_len, code);

	     if code = 0
	     then call ring_zero_peek_$get_max_length ("tty_area", tty_area_len, code);

	     if code ^= 0
	     then do;
		call com_err_ (code, CMD_NAME, "From ring_zero_peek_$get_max_length");
		return;
	     end;

	     call metering_util_$define_regions (mu_index, code, "tty_buf", 0, tty_buf_len,
		"tc_data", "processor_time", 2);
	     if code ^= 0
	     then do;
		call com_err_ (code, CMD_NAME, "From metering_util_$define_regions");
		return;
	     end;

	     first_time = "0"b;			/* we're initialized now */
	end;

/* We have to calculate certain things in any case, to report them and/or to
   update the "old" values in case of reset */

	call metering_util_$fill_buffers (mu_index, meter_time, char_time, cur_ptrs, prev_ptrs, code);

	if code ^= 0
	then do;
	     call com_err_ (code, CMD_NAME, "From metering_util_$fill_buffers");
	     return;
	end;

	call ioa_ ("^/Total metering time ^a", char_time);

	ttybp = cur_ptrs (1);
	total_timep = cur_ptrs (2);

	old_ttybp = prev_ptrs (1);
	old_total_timep = prev_ptrs (2);

	in_interrupts, out_interrupts, control_interrupts, in_interrupt_time, out_interrupt_time,
	     control_interrupt_time, read_calls, write_calls, read_time, write_time, in_bytes, in_messages, out_bytes,
	     out_messages = 0;

/* thumb through LCT to sum statistics over all channels */

	lctp = addrel (ttybp, rel (tty_buf.lct_ptr));
	mpx_channels = 0;

	do devx = 1 to lct.max_no_lctes;
	     lctep = addr (lct.lcte_array (devx));
	     if lcte.entry_in_use
	     then do;
		in_interrupts = in_interrupts + lcte.in.interrupts;
		out_interrupts = out_interrupts + lcte.out.interrupts;
		control_interrupts = control_interrupts + lcte.control.interrupts;

		if lcte.major_channel_devx ^= 0	/* if there's a parent */
		then if addr (lct.lcte_array (lcte.major_channel_devx)) -> lcte.major_channel_devx = 0
						/* who is a top-level multiplexer */
		     then do;			/* only count interrupt time for these to avoid duplication */
			in_interrupt_time = in_interrupt_time + lcte.in.interrupt_time;
			out_interrupt_time = out_interrupt_time + lcte.out.interrupt_time;
			control_interrupt_time = control_interrupt_time + lcte.control.interrupt_time;
		     end;

		if lcte.channel_type = TTY_MPX	/* get some additional stuff for non-multiplexed channels */
		then do;
		     in_bytes = in_bytes + lcte.in_bytes;
		     in_messages = in_messages + lcte.in.interrupts;
		     out_bytes = out_bytes + lcte.out_bytes;
		     out_messages = out_messages + lcte.out.calls;
		end;

		else mpx_channels = mpx_channels + 1;	/* this is a multiplexed channel, count it */
	     end;
	end;

	read_calls = tty_buf.read_calls;
	write_calls = tty_buf.write_calls;
	read_time = tty_buf.read_time;
	write_time = tty_buf.write_time;

	if report					/* If user wanted to know anything */
	then do;
	     cpu_time = total_timep -> time - old_total_timep -> time;

	     call ioa_ ("^/THROUGHPUT^/^30tbefore conversion^50tafter conversion^68tratio");
	     in_before_conv = tty_buf.nrawread - old_ttybp -> tty_buf.nrawread;
	     in_after_conv = tty_buf.ninchars - old_ttybp -> tty_buf.ninchars;

	     call ioa_ ("Total characters input^30t^a^50t^a^68t^a", meter_format_$picture (in_before_conv, 13),
		meter_format_$picture (in_after_conv, 13),
		meter_format_$quotient ((in_after_conv), (in_before_conv), "^5.2f"));

	     out_before_conv = tty_buf.noutchars - old_ttybp -> tty_buf.noutchars;
	     out_after_conv = tty_buf.nrawwrite - old_ttybp -> tty_buf.nrawwrite;

	     call ioa_ ("Total characters output^30t^a^50t^a^68t^a", meter_format_$picture (out_before_conv, 13),
		meter_format_$picture (out_after_conv, 13),
		meter_format_$quotient ((out_after_conv), (out_before_conv), "^5.2f"));

	     call ioa_ ("Average length of input^34t^a characters",
		meter_format_$quotient (in_bytes - old_in_bytes, in_messages - old_in_messages, "^5.1f"));

	     call ioa_ ("Average length of output^34t^a characters",
		meter_format_$quotient (out_bytes - old_out_bytes, out_messages - old_out_messages, "^5.1f"));

	     preconverted = tty_buf.preconverted - old_ttybp -> tty_buf.preconverted;
	     call ioa_ ("Input characters preconverted^30t^a (^a% of total)", meter_format_$picture (preconverted, 13),
		meter_format_$quotient (100 * preconverted, (in_before_conv), "^.1f"));

	     net_read_calls = read_calls - old_read_calls;
	     net_write_calls = write_calls - old_write_calls;
	     net_read_time = divide (read_time - old_read_time, 1000, 35, 0);
	     net_write_time = divide (write_time - old_write_time, 1000, 35, 0);

	     call ioa_ ("^/^30tread^50twrite");
	     call ioa_ ("Number of calls^27t^a^47t^a", meter_format_$picture (net_read_calls, 11),
		meter_format_$picture (net_write_calls, 11));
	     call ioa_ ("Average time per call^27t^a msec.^50t^a msec.",
		meter_format_$quotient (net_read_time, (net_read_calls), "^5.2f"),
		meter_format_$quotient (net_write_time, (net_write_calls), "^5.2f"));

	     call ioa_ ("Average chars. processed^29t^a^49t^a",
		meter_format_$quotient ((in_before_conv), (net_read_calls), "^5.1f"),
		meter_format_$quotient ((out_before_conv), (net_write_calls), "^5.1f"));
	     call ioa_ ("Average chars. per msec.^29t^a^49t^a",
		meter_format_$quotient ((in_before_conv), net_read_time, "^5.1f"),
		meter_format_$quotient ((out_before_conv), net_write_time, "^5.1f"));

	     call ioa_ ("^2/CHANNEL INTERRUPTS^/^27tinput^42toutput^57tother^72ttotal");

	     net_input_ints = in_interrupts - old_in_interrupts;
	     net_output_ints = out_interrupts - old_out_interrupts;
	     net_control_ints = control_interrupts - old_control_interrupts;
	     net_in_int_time = divide (in_interrupt_time - old_in_interrupt_time, 1000, 35, 0);
	     net_out_int_time = divide (out_interrupt_time - old_out_interrupt_time, 1000, 35, 0);
	     net_control_int_time = divide (control_interrupt_time - old_control_interrupt_time, 1000, 35, 0);

	     call ioa_ ("software ""interrupts""^25t^a^40t^a^55t^a^69t^a", meter_format_$picture (net_input_ints, 8),
		meter_format_$picture (net_output_ints, 8), meter_format_$picture (net_control_ints, 8),
		meter_format_$picture (net_input_ints + net_output_ints + net_control_ints, 9));

	     call ioa_ ("average time (msec.)^25t^a^40t^a^55t^a^70t^a",
		meter_format_$quotient (net_in_int_time, (net_input_ints), "^6.2f"),
		meter_format_$quotient (net_out_int_time, (net_output_ints), "^6.2f"),
		meter_format_$quotient (net_control_int_time, (net_control_ints), "^6.2f"),
		meter_format_$quotient (net_in_int_time + net_out_int_time + net_control_int_time,
		net_input_ints + net_output_ints + net_control_ints, "^6.2f"));

	     call ioa_ ("^2/TTY_BUF SPACE MANAGEMENT^/");

	     pool_size = tty_buf_len - (bin (rel (addr (tty_buf.free_space))) - bin (rel (ttybp))) - currentsize (lct);

	     call ioa_ ("Total size of buffer pool ^30t^a words", meter_format_$picture (pool_size, 7));
	     call ioa_ ("Number of channels configured^30t^7d^/Number of multiplexed channels^30t^7d", lct.max_no_lctes,
		mpx_channels);

	     if tty_buf.input_space_updates = old_ttybp -> tty_buf.input_space_updates
	     then avg_input_space = divide (tty_buf.cumulative_input_space, tty_buf.input_space_updates, 35, 0);
	     else avg_input_space =
		     divide (tty_buf.cumulative_input_space - old_ttybp -> tty_buf.cumulative_input_space,
		     tty_buf.input_space_updates - old_ttybp -> tty_buf.input_space_updates, 35, 0);

	     if tty_buf.output_space_updates = old_ttybp -> tty_buf.output_space_updates
	     then avg_output_space = divide (tty_buf.cumulative_output_space, tty_buf.output_space_updates, 35, 0);
	     else avg_output_space =
		     divide (tty_buf.cumulative_output_space - old_ttybp -> tty_buf.cumulative_output_space,
		     tty_buf.output_space_updates - old_ttybp -> tty_buf.output_space_updates, 35, 0);

	     if tty_buf.control_space_updates = old_ttybp -> tty_buf.control_space_updates
	     then avg_control_space = divide (tty_buf.cumulative_control_space, tty_buf.control_space_updates, 35, 0);
	     else avg_control_space =
		     divide (tty_buf.cumulative_control_space - old_ttybp -> tty_buf.cumulative_control_space,
		     tty_buf.control_space_updates - old_ttybp -> tty_buf.control_space_updates, 35, 0);

	     call ioa_ ("^/% of buffer pool in use^30tcurrent^42taverage");

	     call ioa_ ("^4tinput^32t^4.1f^44t^4.1f", 1e2 * float (tty_buf.current_input_space) / float (pool_size),
		1e2 * float (avg_input_space) / float (pool_size));
	     call ioa_ ("^4toutput^32t^4.1f^44t^4.1f", 1e2 * float (tty_buf.current_output_space) / float (pool_size),
		1e2 * float (avg_output_space) / float (pool_size));
	     call ioa_ ("^4tcontrol structures^32t^4.1f^44t^4.1f",
		1e2 * float (tty_buf.current_control_space) / float (pool_size),
		1e2 * float (avg_control_space) / float (pool_size));

	     call ioa_ ("^4t^44(-^)");
	     call ioa_ ("^4ttotal^32t^4.1f^44t^4.1f",
		1e2
		* float (tty_buf.current_input_space + tty_buf.current_output_space + tty_buf.current_control_space)
		/ float (pool_size),
		1e2 * float (avg_input_space + avg_output_space + avg_control_space) / float (pool_size));

	     call ioa_ ("^/Smallest amount of free space ever^32t^a words (^d% of buffer pool)",
		meter_format_$picture ((tty_buf.minimum_free_space), 6),
		divide (100 * tty_buf.minimum_free_space, pool_size, 17, 0));

	     alloc_calls = tty_buf.alloc_calls - old_ttybp -> tty_buf.alloc_calls;
	     free_calls = tty_buf.free_calls - old_ttybp -> tty_buf.free_calls;
	     alloc_time = tty_buf.alloc_time - old_ttybp -> tty_buf.alloc_time;
	     free_time = tty_buf.free_time - old_ttybp -> tty_buf.free_time;
	     alloc_failures = tty_buf.alloc_failures - old_ttybp -> tty_buf.alloc_failures;
	     ttyb_loop_locks = tty_buf.space_lock_wait_count - old_ttybp -> tty_buf.space_lock_wait_count;
	     ttyb_loop_lock_time = tty_buf.space_lock_wait_time - old_ttybp -> tty_buf.space_lock_wait_time;

	     call ioa_ ("^/^27tallocate^44tfree^61ttotal");
	     call ioa_ ("Number of calls^26t^a^43t^a^60t^a", meter_format_$picture (alloc_calls, 11),
		meter_format_$picture (free_calls, 11), meter_format_$picture (alloc_calls + free_calls, 11));

	     call ioa_ ("Average time per call (msec.)^31t^a^48t^a^65t^a",
		meter_format_$quotient ((alloc_time), 1000 * alloc_calls, "^4.1f"),
		meter_format_$quotient ((free_time), 1000 * free_calls, "^4.1f"),
		meter_format_$quotient (alloc_time + free_time, 1000 * (alloc_calls + free_calls), "^4.1f"));

	     call ioa_ ("% of total CPU^31t^4.1f^48t^4.1f^65t^4.1f", 1e2 * float (alloc_time) / float (cpu_time),
		1e2 * float (free_time) / float (cpu_time), 1e2 * float (alloc_time + free_time) / float (cpu_time));

	     call ioa_ ("Calls requiring loop on tty_buf lock^41t^a^52t(^a% of total)",
		meter_format_$picture (ttyb_loop_locks, 10),
		meter_format_$quotient (100 * ttyb_loop_locks, alloc_calls + free_calls, "^.2f"));

	     call ioa_ ("average time spent looping on lock^41t^a msec.^52t(^.2f% of total CPU)",
		meter_format_$quotient (divide (ttyb_loop_lock_time, 1000, 35, 0), (ttyb_loop_locks), "^.2f"),
		1e2 * float (ttyb_loop_lock_time) / float (cpu_time));

	     call ioa_ ("Number of allocation failures^41t^a^52t(^a% of attempts)",
		meter_format_$picture (alloc_failures, 10),
		meter_format_$quotient (100 * alloc_failures, (alloc_calls), "^.2f"));

	     tty_lock_calls = tty_buf.tty_lock_calls - old_ttybp -> tty_buf.tty_lock_calls;
	     tty_lock_waits = tty_buf.found_channel_locked - old_ttybp -> tty_buf.found_channel_locked;
	     queued_ints = tty_buf.n_queued_interrupts - old_ttybp -> tty_buf.n_queued_interrupts;
	     found_lock_locked = tty_lock_waits + queued_ints;

	     call ioa_ ("^2/CHANNEL LOCK CONTENTION^2/Number of calls to tty_lock^45t^a",
		meter_format_$picture (tty_lock_calls, 11));
	     if tty_lock_calls > 0
	     then do;
		call ioa_ ("Times channel lock found locked^45t^a (^d% of attempts)",
		     meter_format_$picture (found_lock_locked, 11),
		     divide (100 * found_lock_locked, tty_lock_calls, 17, 0));
		call ioa_ ("Average time spent waiting for lock^45t^a msec.",
		     meter_format_$quotient (tty_buf.total_wait_time - old_ttybp -> tty_buf.total_wait_time,
		     1000 * tty_lock_waits, "^.2f"));
		call ioa_ ("Maximum time spent waiting for lock^45t^.2f msec.", 1e-3 * float (tty_buf.max_wait_time));
	     end;

	     if net_input_ints + net_output_ints + net_control_ints > 0
	     then call ioa_ ("Interrupts queued because channel locked^45t^a (^.1f% of interrupts)",
		     meter_format_$picture (queued_ints, 11),
		     1e2 * float (queued_ints) / float (net_input_ints + net_output_ints + net_control_ints));

	     echoed_by_r0 = tty_buf.echo_neg_r0_chars - old_ttybp -> tty_buf.echo_neg_r0_chars;
	     echoed_by_fnp = tty_buf.echo_neg_mux_chars - old_ttybp -> tty_buf.echo_neg_mux_chars;

	     call ioa_ ("^2/ECHO NEGOTIATION^2/Average time of transaction^40t^a msec.",
		meter_format_$quotient (tty_buf.echo_neg_time - old_ttybp -> tty_buf.echo_neg_time,
		1000 * (tty_buf.echo_neg_interrupts - old_ttybp -> tty_buf.echo_neg_interrupts), "^.1f"));
	     if in_before_conv > 0
	     then do;
		call ioa_ ("Chars. echoed by supervisor^37t^a (^5.2f% of input chars)",
		     meter_format_$picture (echoed_by_r0, 11), 1e2 * float (echoed_by_r0) / float (in_before_conv));
		call ioa_ ("Chars. echoed by FNPs^37t^a (^5.2f% of input chars)",
		     meter_format_$picture (echoed_by_fnp, 11), 1e2 * float (echoed_by_fnp) / float (in_before_conv));
	     end;

	     in_restarts = tty_buf.input_restart - old_ttybp -> tty_buf.input_restart;
	     out_restarts = tty_buf.output_restart - old_ttybp -> tty_buf.output_restart;
	     out_overflows = tty_buf.output_buffer_overflow - old_ttybp -> tty_buf.output_buffer_overflow;

	     call ioa_ ("^2/ABNORMAL EVENTS^2/Input restarts^30t^a (^a% of read calls)",
		meter_format_$picture (in_restarts, 10),
		meter_format_$quotient (100 * in_restarts, (net_read_calls), "^.2f"));
	     call ioa_ ("Output restarts^30t^a (^a% of write calls)", meter_format_$picture (out_restarts, 10),
		meter_format_$quotient (100 * out_restarts, (net_write_calls), "^.2f"));
	     call ioa_ ("Output space overflows^30t^a (^a% of write calls)", meter_format_$picture (out_overflows, 10),
		meter_format_$quotient (100 * out_overflows, (net_write_calls), "^.2f"));
	     call ioa_ ("""needs_space"" calls^30t^a",
		meter_format_$picture (tty_buf.space_needed_calls - old_ttybp -> tty_buf.space_needed_calls, 10));

	     call ioa_ ("");			/* put out an extra blank line at end */
	end;					/* of reporting output */

	if reset
	then do;
	     call metering_util_$reset (mu_index, code);	/* this does most of the work */

	     if code ^= 0
	     then call com_err_ (code, CMD_NAME, "From metering_util_$reset");

	     else do;				/* copy all the hard-to-calculate stuff */
		old_in_interrupts = in_interrupts;
		old_in_interrupt_time = in_interrupt_time;
		old_out_interrupts = out_interrupts;
		old_out_interrupt_time = out_interrupt_time;
		old_control_interrupts = control_interrupts;
		old_control_interrupt_time = control_interrupt_time;
		old_read_calls = read_calls;
		old_read_time = read_time;
		old_write_calls = write_calls;
		old_write_time = write_time;
		old_in_bytes = in_bytes;
		old_out_bytes = out_bytes;
		old_in_messages = in_messages;
		old_out_messages = out_messages;
	     end;
	end;					/* of resetting code */
	return;					/* done! */

%include tty_buf;
%include lct;
%include wtcb;
%include tcb;
%include multiplexer_types;

     end system_comm_meters;




		    tty_analyze.pl1                 10/25/89  1156.0r w 10/25/89  1000.0      187407



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */

/* format: style4,delnl,insnl,^ifthendo */

/* Procedure to analyze contents of tty_buf which has been extracted from a dump */

/* Revised Oct. 1978 by Robert Coren for multiplexed channels */
/* Revised Feb. 1980 by Robert Coren to start with any level-1 multiplexer and
   to use copy_erf_seg_ instead of the extract command */
/* Modified: 19 December 1981 by G. Palter to add formatting control arguments */
/* Modified: 7 Sept 1984 by C Spitzer. correct format for call to dump_segment_ */
/* Modified September 1984 by Robert Coren to use include file for delay queue entries */
/* Modified: October 1984 by Greg Texada for new calling sequence for copy_erf_seg_	*/
/* Modified December 1984 by Robert Coren to report line_status_disabled flag */


/****^  HISTORY COMMENTS:
  1) change(88-06-24,Parisek), approve(88-06-24,MCR7928),
     audit(88-07-08,Beattie), install(88-07-19,MR12.2-1061):
     Added support of the UNCP multiplexer.  UNCP_MPX treated like MCS_MPX.
                                                   END HISTORY COMMENTS */


tty_analyze:
     procedure options (variable, separate_static);

dcl  ttybuf_size fixed bin (19) unsigned;
dcl  used_pattern bit (18) aligned int static options (constant) init ("111000111000111000"b);
dcl  (i, buf, devx) fixed bin;
dcl  flagarray char (200) varying;
dcl  tty_areap ptr;
dcl  chanx fixed bin;
dcl  copy_pcb_ap ptr;
dcl  chan_name char (32);
dcl  analyze_entry_name char (32);
dcl  erfno char (32);
dcl  code fixed bin (35);
dcl  longsw bit (1);
dcl  q_count fixed bin;
dcl  q_last fixed bin;
dcl  q_off fixed bin;
dcl  q_ptr ptr;
dcl  block_orig fixed bin;
dcl  input_cnt fixed bin;
dcl  output_cnt fixed bin;

dcl  1 ds_format aligned,				/* dump_segment_ control word */
       2 (address, offset, short, bcd, ascii, long, ebcdic9, ebcdic8, four_bit, hex8, hex9) bit (1) unaligned,
       2 mbz bit (25) unaligned;

dcl  q_entry_overlay (size (fnp_queue_entry)) bit (36) aligned based;

dcl  1 used_block aligned based,
       2 used_marker bit (18) unal,			/* filled in with used_pattern after checking */
       2 next fixed bin (18) unsigned unal;		/* offset of next unused place */

dcl  argp pointer;
dcl  arg char (argl) based (argp);
dcl  argl fixed bin (21);
dcl  n_arguments fixed binary;

dcl  DCW_LIST_SIZE fixed bin int static options (constant) init (16);
dcl  prog_name char (11) int static options (constant) init ("tty_analyze");
dcl  temp_segs (3) ptr int static;
dcl  have_segs bit (1) int static init ("0"b);

dcl  (addr, addrel, bin, fixed, hbound, index, length, mod, null, pointer, ptr, rel, rtrim, size, string, substr) builtin;

dcl  (
     error_table_$badopt,
     error_table_$too_many_args
     ) fixed binary (35) external;

dcl  ioa_ entry () options (variable);
dcl  (
     com_err_,
     com_err_$suppress_name
     ) entry () options (variable);
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
dcl  cu_$arg_count entry (fixed bin, fixed bin (35));
dcl  cv_entry_ entry (char (*), ptr, fixed bin (35)) returns (entry);
dcl  analyze_entry entry (ptr, ptr, fixed bin, entry, bit (1)) variable;
dcl  get_temp_segments_ entry (char (*), (*) pointer, fixed bin (35));
dcl  copy_erf_seg_$name entry (char (*), char (*), pointer, fixed bin (19) unsigned, fixed bin (35));
dcl  match_star_name_ entry (char (*), char (*), fixed bin (35));
dcl  tty_dump$print_chain entry (pointer, character (*), fixed binary, bit (1));
dcl  tty_dump$set_static_for_analyze entry (fixed binary (19) unsigned, 1 aligned like ds_format);

/**/

	call cu_$arg_count (n_arguments, code);
	if code ^= 0
	then do;
	     call com_err_ (code, prog_name);
	     return;
	end;

	if n_arguments = 0
	then do;
USAGE:
	     call com_err_$suppress_name (0, prog_name, "Usage:  ^a erf_number {-control_args}", prog_name);
	     return;
	end;

	erfno = "-1";				/* no ERF yet */
	longsw = "0"b;
	string (ds_format) = ""b;			/* defaults to no interpretation */

	do i = 1 to n_arguments;

	     call cu_$arg_ptr (i, argp, argl, code);
	     if code ^= 0
	     then do;
		call com_err_ (code, prog_name, "Fetching argument #^d.", i);
		return;
	     end;

	     if arg = "-long" | arg = "-lg"
	     then longsw = "1"b;

	     else if arg = "-brief" | arg = "-bf"
	     then longsw = "0"b;

	     else if arg = "-character" | arg = "-ch" | arg = "-ascii"
	     then do;
		longsw, ds_format.ascii = "1"b;	/* implies -long */
		ds_format.ebcdic8, ds_format.ebcdic9 = "0"b;
	     end;

	     else if arg = "-ebcdic8"
	     then do;
		longsw, ds_format.ebcdic8 = "1"b;
		ds_format.ascii, ds_format.ebcdic9 = "0"b;
	     end;

	     else if arg = "-ebcdic9"
	     then do;
		longsw, ds_format.ebcdic9 = "1"b;
		ds_format.ascii, ds_format.ebcdic8 = "0"b;
	     end;

	     else if arg = "-octal"
	     then do;
		longsw = "1"b;			/* implies -long */
		ds_format.hex8, ds_format.hex9 = "0"b;
	     end;

	     else if arg = "-hex8"
	     then do;
		longsw, ds_format.hex8 = "1"b;
		ds_format.hex9 = "0"b;
	     end;

	     else if arg = "-hex9"
	     then do;
		longsw, ds_format.hex9 = "1"b;
		ds_format.hex8 = "0"b;
	     end;

	     else if index (arg, "-") = 1
	     then do;
		call com_err_ (error_table_$badopt, prog_name, """^a""", arg);
		return;
	     end;

	     else do;				/* must be the ERF number */
		if erfno ^= "-1"
		then do;
		     call com_err_ (error_table_$too_many_args, prog_name, "Only one ERF number may be supplied. ^a",
			arg);
		     return;
		end;
		erfno = arg;
	     end;
	end;

	if erfno = "-1"				/* a dump must be supplied */
	then go to USAGE;

	if ds_format.ascii | ds_format.ebcdic8 | ds_format.ebcdic9
	then ds_format.long = "0"b;			/* if interpreting only four words per line */
	else ds_format.long = "1"b;			/* otherwise, eight will fit */

	if ^have_segs
	then do;
	     call get_temp_segments_ (prog_name, temp_segs, code);
	     if code ^= 0
	     then do;
		call com_err_ (code, prog_name, "Getting temporary segments.");
		return;
	     end;
	     have_segs = "1"b;
	end;

	ttybp = temp_segs (1);
	infop = temp_segs (2);
	tty_areap = temp_segs (3);

	call copy_erf_seg_$name (erfno, "tty_buf", ttybp, ttybuf_size, code);
	if code ^= 0
	then go to bad_copy;

	call copy_erf_seg_$name (erfno, "dn355_data", infop, (0), code);
	if code ^= 0
	then go to bad_copy;

	call copy_erf_seg_$name (erfno, "tty_area", tty_areap, (0), code);
	if code ^= 0
	then do;
bad_copy:
	     call com_err_ (code, prog_name, "Could not copy data from ERF ^a", erfno);
	     return;
	end;

	call tty_dump$set_static_for_analyze (ttybuf_size, ds_format);

	call ioa_ ("Begin analysis of ERF ^a", erfno);
	call ioa_ ("^/^/Header Values:^/^-bleft ^d, free ^o", bleft, fixed (free, 18));


/* Find all physical FNP channels; for each one, analyze it and all its subchannels */

	lctp = ptr (ttybp, rel (tty_buf.lct_ptr));
	lcntp = ptr (tty_areap, rel (lct.lcnt_ptr));

	do i = 1 to lct.max_no_lctes;
	     lctep = addr (lcte_array (i));
	     if lcte.entry_in_use
	     then if lcte.major_channel_devx = 0
		then call walk_channel_tree (i, lcnt.names (i));
						/* track down all the subchannels */
	end;

	do i = 1 to lct.max_no_lctes;			/* track down all unmarked LCTEs */
	     lctep = addr (lcte_array (i));
	     if substr (lcte.lock, 1, 18) ^= used_pattern
	     then do;
		if lcte.entry_in_use		/* this shouldn't have happened */
		then call ioa_ ("^/LCTE at ^o marked in use, but has not been processed^/", bin (rel (lctep)));
		call check_used (lctep, size (lcte));	/* mark it now in any case */
	     end;
	end;

	call check_used (lctp, bin (rel (addr (lct.lcte_array (1)))) - bin (rel (lctp)));
						/* mark lct header */


	call ioa_ ("^3/Begin free chain trace");

	buf = fixed (free, 18);			/* get free pointer */
	if buf = 0
	then if bleft ^= 0
	     then do;				/* error */

		call ioa_ ("^2/FREE = 0 BUT BLEFT ^= 0");
		go to check_unstrung_buffers;		/* can't check free chain obviously */
	     end;

	if buf = 0
	then go to check_unstrung_buffers;		/* nothing more to check */

	do while (buf ^= 0);
	     free_blockp = addrel (ttybp, buf);		/* make pointer to next buffer */
	     call ioa_ ("^o (^o words)", buf, free_block.size);
	     buf = bin (free_block.next);		/* get addr of next buffer */
	     call check_used (free_blockp, free_block.size);
						/* check if buffer used - set it used */
	     if buf ^= 0
	     then if buf < fixed (borig, 18)
		then do;				/* bad buffer addr */

bad_free_chain:
		     call ioa_ ("^2/BAD BUFFER ADDR IN FREE CHAIN ^o -> ^o^2/", fixed (rel (blockp), 18), buf);
		     go to check_unstrung_buffers;
		end;

	     if buf > ttybuf_size
	     then go to bad_free_chain;		/* out of bounds addr - stop free chain search */
	     bleft = bleft - free_block.size;		/* decrement count of free buffers */
	end;

	if bleft ^= 0
	then					/* bleft is screwed up */
	     call ioa_ ("^2/BLEFT NOT EXHAUSTED (= ^o) AT END OF FREE CHAIN TRACE^2/", bleft);

check_unstrung_buffers:
	call ioa_ ("^/Begin unthreaded space check");	/* see if any buffers not marked with used patern */

	blockp = ptr (ttybp, borig);			/* get ptr to first buffer */
	do while (bin (rel (blockp)) < ttybuf_size);
	     if blockp -> used_block.used_marker ^= used_pattern
	     then do;
		block_orig = bin (rel (blockp));
		do while (blockp -> used_block.used_marker ^= used_pattern & bin (rel (blockp)) < ttybuf_size);
		     blockp = addrel (blockp, 2);
		end;
		call ioa_ ("^o (^o words)", block_orig, bin (rel (blockp)) - block_orig);
	     end;

	     else blockp = ptr (ttybp, blockp -> used_block.next);
	end;

	return;

/**/

walk_channel_tree:
     proc (a_devx, a_chan_name);

/* internal procedure (called recursively) to find all subchannels of a
   *  given channel, print each one's LCT entry, and call the special-purpose entry to
   *  print its data bases
*/

dcl  a_devx fixed bin;
dcl  a_chan_name char (*);
dcl  chan_name char (32);
dcl  star_name char (32);
dcl  local_lctep ptr;				/* copy of lctep for this procedure */
dcl  i fixed bin;
dcl  code fixed bin (35);

	devx = a_devx;
	chan_name = a_chan_name;
	lctep, local_lctep = addr (lct.lcte_array (devx));
	if lcte.entry_in_use & lcte.initialized
	then do;					/* only if there's anything to look at */
	     if lcte.queue_head
	     then call print_channel_queue;

	     if lcte.channel_type = TTY_MPX
	     then call analyze_wtcb (devx);		/* this is the end of the chain */
	     else if lcte.channel_type = MCS_MPX | lcte.channel_type = UNCP_MPX then do;
		if lcte.channel_type = UNCP_MPX then
		     call ioa_ ("^/multiplexer type: ^a", mpx_types (lcte.channel_type));		    
		call analyze_fnp;
	     end;
	     else do;
		call ioa_ ("^/multiplexer type: ^a", mpx_types (lcte.channel_type));
		call mpx_analyze_entry;

		star_name = rtrim (chan_name) || ".*";	/* now hunt for subnames */
		do i = 1 to lct.max_no_lctes;
		     call match_star_name_ (lcnt.names (i), star_name, code);
		     if code = 0			/* this is one */
		     then if lct.lcte_array (i).entry_in_use
			then do;
			     call ioa_ ("^/Subchannel: ^a, devx ^o", lcnt.names (i), i);
			     call walk_channel_tree (i, lcnt.names (i));
			end;
		end;
	     end;
	end;

	call check_used (local_lctep, size (lcte));
	return;
     end walk_channel_tree;

/**/

analyze_fnp:
     proc;

dcl  subchan_lctep ptr;

	fnpp = ptr (infop, rel (lcte.data_base_ptr));
	if fnp_info.no_of_channels > 0
	then do;
	     n_pcbs = fnp_info.no_of_channels;
	     copy_pcb_ap = ptr (ttybp, rel (fnp_info.pcb_array_ptr));
	     do chanx = 1 to n_pcbs;
		pcbp = addr (copy_pcb_ap -> pcb_array (chanx));
		devx = pcb.devx;
		chan_name = lcnt.names (devx);
		subchan_lctep = addr (lct.lcte_array (devx));

		call ioa_ ("^2/Physical channel ^a, ^d baud, devx ^o, pcb ^o, lcte ^o, line type ^a", chan_name,
		     pcb.baud_rate, devx, bin (rel (pcbp)), bin (rel (subchan_lctep)), line_types (pcb.line_type));
		call ioa_ (
		     "flags: ^[listen ^;^]^[dialed ^;^]^[send_output ^;^]^[high_speed ^;^]^[sync_line ^;^]^[end_frame ^;^]^[hndlquit ^;^]^[output_mbx_pending ^;^]^[copied_meters_ready ^;^]^[get_meters_waiting ^;^]^[tandd_attached ^;^]"
		     , pcb.listen, pcb.dialed, pcb.send_output, pcb.high_speed, pcb.sync_line, pcb.end_frame,
		     pcb.hndlquit, pcb.output_mbx_pending, pcb.copied_meters_ready, pcb.get_meters_waiting,
		     pcb.tandd_attached);

		input_cnt = subchan_lctep -> lcte.input_words;
		output_cnt = subchan_lctep -> lcte.output_words;

		if pcb.write_first >= bin (borig, 18)
		then do;				/* trace write chain */
		     call ioa_ ("Write chain trace");
		     call buffer_trace ((pcb.write_first), "WRITE_FIRST");
						/* trace write chain */
		end;

		call walk_channel_tree (devx, chan_name);
						/* do its subchannels now */
		if output_cnt ^= 0
		then				/* output count is goofed up */
		     call ioa_ ("^2/OUTPUT COUNT RESIDUAL (^d) DOESN'T AGREE WITH BUFFER CHAIN TRACE^2/", output_cnt);
		if input_cnt ^= 0
		then				/* input count is goofed up */
		     call ioa_ ("^2/INPUT COUNT RESIDUAL (^d) DOESN'T AGREE WITH BUFFER CHAIN TRACE^2/", input_cnt);

		call check_used (pcbp, size (pcb));
	     end;

	     call check_used (ptr (ttybp, rel (fnp_info.dcw_list_array_ptr)), 8 * DCW_LIST_SIZE);
						/* mark the DCW list area */
	end;

	if fnp_info.running
	then do;
	     if fnp_info.cur_ptr ^= 0			/* if there's a delay queue */
	     then do;
		q_count = fnp_info.count;
		q_off = fnp_info.cur_ptr;
		q_last = fnp_info.last_ptr;

		call ioa_ ("^3/Delay queue for FNP ^a", fnp_info.fnp_tag);
		do while (q_off ^= 0);
		     q_ptr = ptr (ttybp, q_off);
		     call ioa_ ("^o", q_off);
		     if longsw
		     then call ioa_ ("^(^8(^w ^)^/^)", q_ptr -> q_entry_overlay);
		     call check_used (q_ptr, size (fnp_queue_entry));
		     q_off = q_ptr -> fnp_queue_entry.next;
		     q_count = q_count - 1;
		end;

		if bin (rel (q_ptr), 18) ^= q_last
		then call ioa_ ("last_ptr (^o) does not point to last queue block (^o)", q_last,
			bin (rel (q_ptr), 18));

		if q_count ^= 0
		then call ioa_ ("^d queue entries unaccounted for", q_count);
	     end;

	end;
	return;
     end analyze_fnp;

/**/

analyze_wtcb:
     proc (a_devx);

/* subroutine to interpret the contents of a wtcb */

dcl  a_devx fixed bin;

	if bin (rel (lcte.data_base_ptr), 18) < bin (borig, 18)
	then return;
	wtcbp = ptr (ttybp, rel (lcte.data_base_ptr));
	flagarray = "";				/* make a string listing all flags that are on */
	if wtcb.flags.listen
	then flagarray = flagarray || "listen,";
	if wtcb.flags.dialed
	then flagarray = flagarray || "dialed,";
	if wtcb.flags.send_output
	then flagarray = flagarray || "send_output,";
	if wtcb.flags.qenable
	then flagarray = flagarray || "qenable,";
	if wtcb.flags.qflag
	then flagarray = flagarray || "qflag,";
	if wtcb.flags.end_frame
	then flagarray = flagarray || "end_frame,";
	if wtcb.flags.notify_reqd
	then flagarray = flagarray || "notify_reqd,";
	if wtcb.flags.work_reqd
	then flagarray = flagarray || "work_reqd,";
	if wtcb.flags.dialing
	then flagarray = flagarray || "dialing,";
	if wtcb.flags.dial_status_valid
	then flagarray = flagarray || "dial_status,";
	if wtcb.flags.line_status_present
	then flagarray = flagarray || "line_status,";
	if wtcb.flags.wru
	then flagarray = flagarray || "wru,";
	if wtcb.flags.hndlquit
	then flagarray = flagarray || "hndlquit,";
	if wtcb.flags.count_lines
	then flagarray = flagarray || "count_lines,";
	if wtcb.flags.sync_line
	then flagarray = flagarray || "sync_line,";
	if wtcb.flags.breakall
	then flagarray = flagarray || "breakall,";
	if wtcb.flags.scroll
	then flagarray = flagarray || "scroll,";
	if wtcb.flags.negotiating_echo
	then flagarray = flagarray || "negotiating_echo,";
	if wtcb.flags.wake_tbl
	then flagarray = flagarray || "wake_tbl,";
	if wtcb.flags.allow_wakeup
	then flagarray = flagarray || "allow_wakeup,";
	if wtcb.flags.receive_mode_device
	then flagarray = flagarray || "receive_mode_device,";
	if length (flagarray) > 0
	then substr (flagarray, length (flagarray), 1) = " ";

	call ioa_ ("wtcb at ^o^/flags: ^a", bin (rel (wtcbp)), flagarray);

	call ioa_ ("more_flags: ^[line_status_disabled^;^]", wtcb.line_status_disabled);

	if wtcb.wflag
	then call ioa_ ("blocked for output");
	if wtcb.rflag
	then call ioa_ ("blocked for input");

	if wtcb.fblock ^= 0
	then do;
	     call ioa_ ("Read chain trace");
	     call buffer_trace ((wtcb.fblock), "FBLOCK"); /* go trace read chain */
	end;

	if wtcb.write_first ^= 0
	then do;
	     call ioa_ ("Write chain trace");
	     call buffer_trace ((wtcb.write_first), "WRITE_FIRST");
	end;

	if wtcb.echdp ^= "0"b
	then call check_used (ptr (ttybp, wtcb.echdp), size (echo_data));

	if wtcb.waketp ^= "0"b
	then call check_used (ptr (ttybp, wtcb.waketp), size (wakeup_table));

	call check_used (wtcbp, size (wtcb));
	return;
     end analyze_wtcb;

/**/

mpx_analyze_entry:
     proc;

/* procedure to find and call entry for analyzing a particular channel type */

	analyze_entry_name = rtrim (mpx_types (lcte.channel_type)) || "_analyze_";
	analyze_entry = cv_entry_ (analyze_entry_name, null (), code);
	if code ^= 0
	then call com_err_ (code, "tty_analyze", "Cannot get pointer to ^a", analyze_entry_name);
	else call analyze_entry (ttybp, tty_areap, devx, check_used, longsw);
	return;
     end mpx_analyze_entry;


print_channel_queue:
     proc;

dcl  next_queue bit (18);
dcl  queue_ptr ptr;
dcl  interrupt fixed bin;

dcl  1 channel_q aligned based (queue_ptr),
       2 next bit (18) unal,
       2 pad bit (18) unal,
       2 int_type fixed bin,
       2 data (2) fixed bin;

dcl  interrupt_name (12) char (16) int static options (constant)
	init ("DIALUP", "HANGUP", "CRASH", "SEND_OUTPUT", "INPUT_AVAILABLE", "ACCEPT_INPUT", "INPUT_REJECTED", "QUIT",
	"LINE_STATUS", "DIAL_STATUS", "WRU_TIMEOUT", "SPACE_AVAILABLE");


	call ioa_ ("^/channel queue:");
	next_queue = lcte.queue_head;

	do while (next_queue ^= "0"b);
	     queue_ptr = ptr (ttybp, next_queue);
	     interrupt = channel_q.int_type;
	     call ioa_ ("^-^6o^3x^[^a^s^;^s^d^]^13o^13o", bin (next_queue),
		(interrupt > 0 & interrupt <= hbound (interrupt_name, 1)), interrupt_name (interrupt), interrupt,
		channel_q.data);
	     next_queue = channel_q.next;
	     call check_used (queue_ptr, size (channel_q));
	end;

	if rel (queue_ptr) ^= lcte.queue_tail
	then call ioa_ ("End of queue (^o) differs from lcte.queue_tail (^o)", bin (rel (queue_ptr)),
		bin (lcte.queue_tail));

	return;
     end print_channel_queue;

/**/

buffer_trace:
     proc (buf_offset, name);

/*	Subroutine to trace a buffer chain.			*/

dcl  buf_offset fixed bin;
dcl  name char (*);

dcl  buf_size fixed bin;

	call tty_dump$print_chain (ttybp, name, buf_offset, ^longsw);

	do while (buf_offset ^= 0);
	     if buf_offset < bin (tty_buf.borig, 18)
	     then do;
		call ioa_ ("^2/^a (^o^) < borig^2/", name, buf_offset);
		return;
	     end;

	     if buf_offset > ttybuf_size
	     then do;
		call ioa_ ("^2/^a (^o) > tty_buf size", name, buf_offset);
		return;
	     end;

	     blockp = pointer (ttybp, buf_offset);
	     buf_size = 16 * (bin (buffer.size_code, 3) + 1);
	     if name = "FBLOCK"
	     then input_cnt = input_cnt - buf_size;
	     else output_cnt = output_cnt - buf_size;

	     buf_offset = buffer.next;
	     call check_used (blockp, buf_size);
	end;

	return;
     end buffer_trace;


/*	Subroutine to see if buffer has used pattern in it - if not mark it used */

check_used:
     proc (buffp, nwords);

dcl  buffp pointer;
dcl  nwords fixed bin;

	if buffp -> used_block.used_marker = used_pattern
	then					/* opps - already marked used */
	     call ioa_ ("^2/BUFFER ^o ALREADY USED BY SOMEONE ELSE", fixed (rel (buffp), 18));
	buffp -> used_block.used_marker = used_pattern;	/* mark buffer used */
	buffp -> used_block.next = bin (rel (buffp)) + nwords + mod (nwords, 2);
	return;
     end check_used;

/**/

%include tty_buf;
%include dn355_data;
%include dn355_mailbox;
%include tty_buffer_block;
%include pcb;
%include fnp_queue_entry;
%include lct;
%include wtcb;
%include line_types;
%include multiplexer_types;
%include mailbox_ops;
%include mcs_echo_neg_sys;
%include set_wakeup_table_info;

     end tty_analyze;




		    tty_dump.pl1                    10/25/89  1156.0r w 10/25/89  1000.0      258210



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */

/* format: style4,delnl,insnl,^ifthendo */

/* To dump info about a communications channel */

/* Modified: December 1984 by Robert Coren to report line_status_disabled flag */
/* Modified: October 1984 by Greg Texada to use new calling sequence to copy_erf_seg_			*/
/* Modified: 7 Sept 1984 by C Spitzer. correct format for call to dump_segment_ */
/* Modified: 16 August 1983 by Robert Coren to print a message if the channel is not up, and
   not to fault if the database pointer is 0. */
/* Modified: 5 January 1982 by G. Palter to allow the channel name to be a starname */
/* Modified: 29 December 1981 by G. Palter to use dump_segment_, accept format control arguments (-ascii, -ebcdic9), and
   add an entrypoint for tty_analyze to set static needed to allow multiplexer analyzers call print_chain */
/* Modified: November 1981 by E. N. Kittlitz for user_table_entry conversion */
/* Modified: 12 November 1980 by G. Palter to support can_type */
/* Modified January 1980 by C. Hornig for MCM tracing */
/* modified 10/20/78 by Robert Coren to work on dumps as well as live systems */
/* largely rewritten 10/16/78 by Robert S. Coren for new formats associated with demultiplexing */
/* modified 3/10/78 by Robert S. Coren for variable-size buffers */
/* modified 5/3/77 by J. Stern to introduce WTCBs and TCBs */

/****^  HISTORY COMMENTS:
  1) change(86-04-23,Coren), approve(86-04-23,MCR7300),
     audit(86-05-19,Beattie), install(86-07-08,MR12.0-1089):
     To know about 256-bit echo break tables.
  2) change(87-04-26,GDixon), approve(87-07-13,MCR7741),
     audit(87-07-24,Hartogs), install(87-08-04,MR12.1-1055):
     Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1
  3) change(87-07-24,GDixon), approve(87-07-24,MCR7741),
     audit(87-07-24,Hartogs), install(87-08-04,MR12.1-1055):
      A) Correct several stringsize conditions.
  4) change(88-06-24,Parisek), approve(88-06-24,MCR7928),
     audit(88-07-08,Beattie), install(88-07-19,MR12.2-1061):
     Added support of the UNCP multiplexer.  UNCP_MPX treated like MCS_MPX.
                                                   END HISTORY COMMENTS */

%page;
tty_dump:
td:
     procedure options (separate_static, variable);

dcl  name char (32);
dcl  (i, tablex, idx, devx, childs_devx, subchan) fixed bin;
dcl  code fixed bin (35);
dcl  last_erf char (32) int static init ("-1");
dcl  have_segs bit aligned static init ("0"b);
dcl  temp_segs (3) pointer static init ((3) null ());
dcl  ttyb_len fixed bin (19) unsigned int static init (0);
dcl  n_args fixed bin;
dcl  iarg fixed bin;
dcl  argp ptr;
dcl  argl fixed bin;
dcl  arg char (argl) based (argp);
dcl  erfno char (32);
dcl  areap ptr;
dcl  found bit (1);
dcl  (brief_sw, all_sw, subchan_sw, saved_subchan_sw, lcte_sw) bit (1);
dcl  person char (24);
dcl  project char (12);
dcl  group_id char (32);
dcl  short_message char (8) aligned;
dcl  long_message char (100) aligned;
dcl  print_entry entry (ptr, ptr, ptr, fixed bin, bit (1)) variable;
dcl  system_area area based (get_system_free_area_ ());

dcl  1 ds_format aligned internal static,		/* dump_segment_ control word */
       2 (address, offset, short, bcd, ascii, long, ebcdic9, ebcdic8, four_bit, hex8, hex9) bit (1) unaligned;

dcl  1 flags (lct.max_no_lctes) aligned based (flags_ptr),
       2 printed_lcte bit (1) unaligned,
       2 printed_subchan bit (1) unaligned,
       2 printed_major bit (1) unaligned,
       2 pad bit (35) unaligned;
dcl  flags_ptr pointer;

dcl  prog_name char (8) int static options (constant) init ("tty_dump");

dcl  (
     error_table_$badopt,
     error_table_$inconsistent,
     error_table_$noarg,
     error_table_$nomatch,
     error_table_$too_many_args
     ) external fixed binary (35);

dcl  iox_$user_output pointer external;

dcl  (addr, bin, codeptr, fixed, hbound, index, lbound, length, 
      null, pointer, ptr, rel, rtrim, string, substr, unspec) builtin;

dcl  cu_$arg_count entry (fixed bin, fixed bin (35));
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  cv_entry_ entry (char (*), ptr, fixed bin (35)) returns (entry);
dcl  copy_erf_seg_$name entry (char (*), char (*), ptr, fixed bin (19) uns, fixed bin (35));
dcl  dump_segment_ entry (ptr, ptr, fixed bin, fixed bin (18), fixed bin (18), bit (*));
dcl  get_system_free_area_ entry () returns (pointer);
dcl  get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35));
dcl  release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35));
dcl  hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
dcl  hcs_$terminate_noname entry (pointer, fixed binary (35));
dcl  (
     com_err_,
     com_err_$suppress_name,
     ioa_
     ) entry () options (variable);
dcl  get_userid_ entry (bit (36) aligned, char (*), char (*), fixed bin, fixed bin, fixed bin (35));
dcl  check_star_name_$entry entry (char (*), fixed bin (35));
dcl  match_star_name_ entry (char (*), char (*), fixed bin (35));
dcl  convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned);

dcl  cleanup condition;

/**/

	call cu_$arg_count (n_args, code);
	if code ^= 0
	then do;					/* doesn't work as an active function */
	     call com_err_ (code, prog_name);
	     return;
	end;

	if n_args < 1
	then do;					/* should be at least 1 arg */
	     call com_err_$suppress_name (0, prog_name, "Usage:  ^a channel_name {-control_args}", prog_name);
	     return;
	end;

	brief_sw, all_sw, subchan_sw, lcte_sw = "0"b;
	string (ds_format) = ""b;			/* default is -octal */
	erfno = "-1";
	name, group_id = "";			/* so we can tell after if arguments were supplied */
	do iarg = 1 to n_args;
	     call cu_$arg_ptr (iarg, argp, argl, code);
	     if code ^= 0
	     then do;
CANT_GET_ARGUMENT:
		call com_err_ (code, prog_name, "Fetching argument #^d", iarg);
		return;
	     end;

	     if arg = "-dump" | arg = "-erf"
	     then do;				/* wants to look at a dump */
		if erfno ^= "-1"
		then do;				/* but already said so */
		     call com_err_ (error_table_$too_many_args, prog_name,
			"More than one ERF number given. ^a and ^a", erfno, arg);
		     return;
		end;
		iarg = iarg + 1;			/* next arg should be ERF number */
		if iarg > n_args
		then do;
		     call com_err_ (error_table_$noarg, prog_name, "ERF number after ""^a"".", arg);
		     return;
		end;
		call cu_$arg_ptr (iarg, argp, argl, code);
		if code ^= 0
		then go to CANT_GET_ARGUMENT;
		erfno = arg;

	     end;

	     else if arg = "-user"
	     then do;
		if group_id ^= ""
		then do;
		     call com_err_ (error_table_$too_many_args, prog_name,
			"More than one use of ""-user"". ""^a"" and ""^a""", group_id, arg);
		     return;
		end;
		iarg = iarg + 1;
		if iarg > n_args
		then do;
		     call com_err_ (error_table_$noarg, prog_name, "User name after ""^a"".", arg);
		     return;
		end;
		call cu_$arg_ptr (iarg, argp, argl, code);
		if code ^= 0
		then go to CANT_GET_ARGUMENT;
		group_id = arg;
		if index (group_id, ".") = 0
		then group_id = rtrim (group_id) || ".*";
		call check_star_name_$entry (group_id, code);
		if (code ^= 0) & (code ^= 1) & (code ^= 2)
		then do;				/* invalid starname */
		     call com_err_ (code, prog_name, "^a", arg);
		     return;
		end;
	     end;

	     else if arg = "-bf" | arg = "-brief"
	     then brief_sw = "1"b;

	     else if arg = "-long" | arg = "-lg"
	     then brief_sw = "0"b;

	     else if arg = "-all" | arg = "-a"
	     then all_sw = "1"b;

	     else if arg = "-subchan" | arg = "-sbc" | arg = "-sc"
	     then subchan_sw = "1"b;

	     else if arg = "-lcte"
	     then lcte_sw = "1"b;

	     else if arg = "-character" | arg = "-ch" | arg = "-ascii"
	     then do;
		ds_format.ascii = "1"b;		/* implies -long */
		brief_sw, ds_format.ebcdic8, ds_format.ebcdic9 = "0"b;
	     end;

	     else if arg = "-ebcdic8"
	     then do;
		ds_format.ebcdic8 = "1"b;
		brief_sw, ds_format.ascii, ds_format.ebcdic9 = "0"b;
	     end;

	     else if arg = "-ebcdic9"
	     then do;
		ds_format.ebcdic9 = "1"b;
		brief_sw, ds_format.ascii, ds_format.ebcdic8 = "0"b;
	     end;

	     else if arg = "-octal"			/* implies -long */
	     then brief_sw, ds_format.hex8, ds_format.hex9 = "0"b;

	     else if arg = "-hex8"
	     then do;
		ds_format.hex8 = "1"b;
		brief_sw, ds_format.hex9 = "0"b;
	     end;

	     else if arg = "-hex9"
	     then do;
		ds_format.hex9 = "1"b;
		brief_sw, ds_format.hex8 = "0"b;
	     end;

	     else if index (arg, "-") = 1
	     then do;
		call com_err_ (error_table_$badopt, prog_name, "^a", arg);
		return;
	     end;

	     else if name ^= ""			/* already specified name */
	     then do;
		call com_err_ (error_table_$too_many_args, prog_name,
		     "More than one channel name given. ""^a"" and ""^a""", name, arg);
		return;
	     end;

	     else do;				/* not control argument, must be channel name */
		name = arg;
		call check_star_name_$entry (name, code);
		if (code ^= 0) & (code ^= 1) & (code ^= 2)
		then do;				/* illegal starname */
		     call com_err_ (code, prog_name, "^a", arg);
		     return;
		end;
	     end;
	end;

	if (group_id = "") & (name = "")
	then do;					/* never specified channel name at all */
	     call com_err_ (error_table_$noarg, prog_name, "No channel name suppplied.");
	     return;
	end;

	if group_id ^= ""
	then do;
	     if name ^= ""
	     then do;
		call com_err_ (error_table_$inconsistent, prog_name, "Channel name (""^a"") and ""-user ^a"".", name,
		     group_id);
		return;
	     end;
	     if erfno ^= "-1"
	     then do;
		call com_err_ (error_table_$inconsistent, prog_name, """-user"" and ""-erf""");
		return;
	     end;
	end;

	if ds_format.ascii | ds_format.ebcdic8 | ds_format.ebcdic9
	then ds_format.long = "0"b;			/* if interpreting only four words per line */
	else ds_format.long = "1"b;			/* otherwise, eight will fit */

	flags_ptr, ansp, cdtp = null ();		/* for cleanup handler */

	on condition (cleanup)
	     begin;
	     if flags_ptr ^= null ()
	     then free flags in (system_area);
	     if ansp ^= null ()
	     then call hcs_$terminate_noname (ansp, (0));
	     if cdtp ^= null ()
	     then call hcs_$terminate_noname (cdtp, (0));
	end;

	if ^have_segs
	then do;					/* get some temp segs */
	     call get_temp_segments_ (prog_name, temp_segs, code);
	     if code ^= 0
	     then do;
		call com_err_ (code, prog_name, "Getting temporary segments.");
		return;
	     end;
	     have_segs = "1"b;
	end;
	ttybp = temp_segs (1);
	areap = temp_segs (2);
	infop = temp_segs (3);

	if erfno = "-1" | last_erf ^= erfno
	then do;					/* copy data if necessary */
	     call copy_erf_seg_$name (erfno, "tty_area", areap, (0), code);
	     if code ^= 0
	     then goto bad_copy;
	     call copy_erf_seg_$name (erfno, "tty_buf", ttybp, ttyb_len, code);
	     if code ^= 0
	     then goto bad_copy;
	     call copy_erf_seg_$name (erfno, "dn355_data", infop, (0), code);
	     if code ^= 0
	     then do;
bad_copy:
		call com_err_ (code, prog_name, "Unable to copy information.");
		return;
	     end;
	     last_erf = erfno;
	end;

	lctp = ptr (ttybp, rel (tty_buf.lct_ptr));
	lcntp = ptr (areap, rel (lct.lcnt_ptr));

	allocate flags in (system_area) set (flags_ptr);
	unspec (flags) = ""b;


/* Search the logical channel name table for matching channels */

	if name ^= ""
	then do;
	     found = "0"b;
	     do tablex = 1 to lct.max_no_lctes;
		call match_star_name_ (lcnt.names (tablex), name, code);
		if code = 0
		then if lct.lcte_array (tablex).entry_in_use
		     then do;
			found = "1"b;
			devx = tablex;
			saved_subchan_sw = subchan_sw;
			call print_info;
			subchan_sw = saved_subchan_sw;
		     end;
	     end;
	     if ^found
	     then call com_err_ (error_table_$nomatch, prog_name, "^a in the LCT", name);
	end;

	if group_id ^= ""
	then do;
	     call hcs_$initiate (">system_control_dir", "cdt", "", 0, 0, cdtp, code);
	     if cdtp = null ()
	     then do;
		call com_err_ (code, prog_name, "Unable to initiate CDT.");
		goto RETURN_FROM_TTY_DUMP;
	     end;
	     call hcs_$initiate (">system_control_dir", "answer_table", "", 0, 0, ansp, code);
	     if ansp = null ()
	     then do;
		call com_err_ (code, prog_name, "Unable to initiate answer table..");
		goto RETURN_FROM_TTY_DUMP;
	     end;

	     do tablex = 1 to cdt.current_size;
		cdtep = addr (cdt.cdt_entry (tablex));
		if cdte.state = TTY_DIALED
		then do;
		     if cdte.process ^= null ()
		     then do;
			utep = pointer (ansp, rel (cdte.process));
			person = ute.person;
			project = ute.project;
		     end;
		     else do;
			call get_userid_ (cdte.dialed_to_procid, person, project, 0, 0, code);
			if code ^= 0
			then person, project = "";
		     end;
		     call match_star_name_ (rtrim (person) || "." || rtrim (project), group_id, code);
		     if code = 0
		     then do;
			devx = cdte.twx;
			saved_subchan_sw = subchan_sw;
			call print_info;
			subchan_sw = saved_subchan_sw;
		     end;
		end;
	     end;
	end;

RETURN_FROM_TTY_DUMP:
	if flags_ptr ^= null ()
	then free flags in (system_area);

	if ansp ^= null ()
	then call hcs_$terminate_noname (ansp, (0));

	if cdtp ^= null ()
	then call hcs_$terminate_noname (cdtp, (0));

	if erfno = "-1"
	then do;					/* nothing useful in them now */
	     have_segs = "0"b;
	     call release_temp_segments_ (prog_name, temp_segs, code);
	end;

	return;

/**/

/* Print all information for a channel */

print_info:
     procedure ();

	lctep = addr (lct.lcte_array (devx));
	subchan = -1;				/* if starting chan is multiplexed, print all subchans */

	do while (devx ^= 0);
	     if ^subchan_sw
	     then do;
		if lcte_sw
		then call print_lcte;
		call find_entry_type;
	     end;
	     childs_devx = devx;
	     subchan = lcte.subchannel;
	     devx = lcte.major_channel_devx;		/* go up one level */
	     if devx ^= 0
	     then lctep = addr (lct.lcte_array (devx));	/* get new LCTE pointer */
	     if ^all_sw & ^subchan_sw
	     then devx = 0;
	     subchan_sw = "0"b;
	end;

	return;

     end print_info;

/**/

/* Finds the appropriate procedure to print data about a channel and invokes it */

find_entry_type:
     procedure ();

dcl  print_entry_name char (32);			/* name of the procedure that prints contents of a data base */

	if lcte.channel_type < lbound (mpx_types, 1) | lcte.channel_type > hbound (mpx_types, 1)
	then do;
	     call com_err_ (0, prog_name, "Invalid channel type for channel ^a (devx = ^d).  ^d", lcnt.names (devx),
		devx, lcte.channel_type);
	     go to RETURN_FROM_TTY_DUMP;
	end;

	if (subchan = -1) & flags (devx).printed_major	/* do not make the same call more than once */
	then return;
	if (subchan ^= -1)
	then if flags (childs_devx).printed_subchan
	     then return;

	if lcte.data_base_ptr = null | rel (lcte.data_base_ptr) = "0"b
	then do;
	     call ioa_ ("No data base for ^a .", lcnt.names (devx));
	     return;
	end;

	if lcte.channel_type = 0
	then call print_wtcb;

	else if lcte.channel_type = MCS_MPX | lcte.channel_type = UNCP_MPX
	then call print_pcb;

	else do;
	     print_entry_name = rtrim (mpx_types (lcte.channel_type)) || "_dump_";
	     print_entry = cv_entry_ (print_entry_name, codeptr (tty_dump), code);
	     if code ^= 0
	     then call com_err_ (code, prog_name, "Cannot get pointer to ^a", print_entry_name);
	     else call print_entry (ttybp, areap, ptr (ttybp, rel (lcte.data_base_ptr)), subchan, brief_sw);
	end;

	if subchan = -1
	then flags (devx).printed_major = "1"b;
	else flags (childs_devx).printed_subchan = "1"b;

	return;

     end find_entry_type;

/**/

/* Prints contents of an LCTE */

print_lcte:
     procedure ();

	if flags (devx).printed_lcte			/* only once per call, please */
	then return;

	call ioa_ ("^/LCTE at ^o, channel ^a, devx ^o", bin (rel (lctep)), lcnt.names (devx), devx);
	call ioa_ (
	     "channel type: ^a (^d)^/flags: ^[in_use ^]^[initialized ^]^[notify_reqd ^]^[locked_for_interrupt ^]^[space_needed ^]^[special_lock ^]^/physical channel devx ^o, major channel devx ^o, subchannel ^o"
	     , mpx_types (lcte.channel_type), lcte.channel_type, lcte.entry_in_use, lcte.initialized, lcte.notify_reqd,
	     lcte.locked_for_interrupt, lcte.space_needed, lcte.special_lock, lcte.physical_channel_devx,
	     lcte.major_channel_devx, lcte.subchannel);

	call ioa_ ("^[queue_head ^o, queue_tail ^o^/^;^2s^]input_words ^d, output_words ^d", lcte.queue_head ^= ""b,
	     bin (lcte.queue_head), bin (lcte.queue_tail), lcte.input_words, lcte.output_words);

	if lcte.data_base_ptr = null
	then call ioa_ ("No data base allocated.");
	else call ioa_ ("data base at ^o", bin (rel (lcte.data_base_ptr)));

	flags (devx).printed_lcte = "1"b;

	return;

     end print_lcte;

/**/

/* Displays the contents of the WTCB */

print_wtcb:
     procedure ();

dcl  two_words (2) fixed bin (35) based;
dcl  break_table_words (WORDS_IN_ECHO_BREAK_TABLE) bit (36) aligned based;
dcl  mode char (256);
dcl  flag_array char (128) varying;
dcl  mode_bits bit (36) aligned;
dcl  tablep ptr;
dcl  1 table_arrays aligned based (tablep),
       2 table (6) fixed bin (17) unal,
       2 default_table (6) fixed bin (17) unal;

dcl  table_names (6) char (18) int static options (constant)
	init ("input_translation", "output_translation", "input_conversion", "output_conversion", "special", "delay");

	wtcbp = ptr (ttybp, rel (lcte.data_base_ptr));

	call ioa_ ("^/WTCB at ^o, channel ^a, devx ^o^/line type = ^a, baud rate = ^d", bin (rel (wtcbp)),
	     lcnt.names (devx), devx, line_types (wtcb.line_type), wtcb.baud_rate);

	flag_array = "";				/* init flag string */

	if wtcb.flags.listen
	then flag_array = flag_array || "listen,";
	if wtcb.flags.dialed
	then flag_array = flag_array || "dialed,";
	if wtcb.flags.send_output
	then flag_array = flag_array || "send_output,";
	if wtcb.flags.qenable
	then flag_array = flag_array || "qenable,";
	if wtcb.flags.qflag
	then flag_array = flag_array || "qflag,";
	if wtcb.flags.end_frame
	then flag_array = flag_array || "end_frame,";
	if wtcb.flags.notify_reqd
	then flag_array = flag_array || "notify_reqd,";
	if wtcb.flags.work_reqd
	then flag_array = flag_array || "work_reqd,";
	if wtcb.flags.dialing
	then flag_array = flag_array || "dialing,";
	if wtcb.flags.dial_status_valid
	then flag_array = flag_array || "dial_status,";
	if wtcb.flags.line_status_present
	then flag_array = flag_array || "line_status,";
	if wtcb.flags.input_available
	then flag_array = flag_array || "input_available,";
	if wtcb.flags.tcb_initialized
	then flag_array = flag_array || "tcb_initialized,";
	if wtcb.flags.hndlquit
	then flag_array = flag_array || "hndlquit,";
	if wtcb.flags.count_lines
	then flag_array = flag_array || "count_lines,";
	if wtcb.flags.sync_line
	then flag_array = flag_array || "sync_line,";
	if wtcb.flags.breakall
	then flag_array = flag_array || "breakall,";
	if wtcb.flags.negotiating_echo
	then flag_array = flag_array || "negotiating_echo,";
	if wtcb.flags.wake_tbl
	then flag_array = flag_array || "wake_tbl,";
	if wtcb.flags.allow_wakeup
	then flag_array = flag_array || "allow_wakeup,";
	if wtcb.flags.receive_mode_device
	then flag_array = flag_array || "receive_mode_device,";
	if wtcb.flags.mark_set
	then flag_array = flag_array || "mark_set,";
	if wtcb.flags.masked
	then flag_array = flag_array || "masked,";

	if length (flag_array) ^= 0
	then substr (flag_array, length (flag_array), 1) = " ";
						/* zap last comma */

	call ioa_ ("flags:  ^a", flag_array);

	call ioa_ ("more_flags: ^[line_status_disabled^;^]", wtcb.line_status_disabled);

	if wtcb.uproc ^= ""b
	then do;
	     call get_userid_ ((wtcb.uproc), person, project, 0, 0, code);
	     if code = 0
	     then call ioa_ ("User name = ^a.^a", person, project);
	end;

	call ioa_ ("hevent = ^w ^w, event = ^w ^w", addr (wtcb.hevent) -> two_words, addr (wtcb.event) -> two_words);

	if wtcb.wflag
	then call ioa_ ("process blocked on output");
	if wtcb.rflag
	then call ioa_ ("process blocked on input");
	if wtcb.wru
	then call ioa_ ("reading answerback");

	call ioa_ (
	     "^[dial_status_code = ^o^/^;^s^]fblock = ^o, lblock = ^o, fchar = ^o^/at line ^d, column ^d, white_col = ^d^/^d read-ahead messages^/write_first = ^o, write_last = ^o^/maximum buffer size = ^d, buffer pad = ^d"
	     , wtcb.dial_status_valid, wtcb.dial_status_code, wtcb.fblock, wtcb.lblock, wtcb.fchar, wtcb.actline,
	     wtcb.actcol, wtcb.white_col, wtcb.nramsgs, wtcb.write_first, wtcb.write_last, wtcb.max_buf_size,
	     wtcb.buffer_pad);

	if wtcb.error_code ^= 0
	then do;
	     call convert_status_code_ (wtcb.error_code, short_message, long_message);
	     call ioa_ ("error code = ^w (^a)", wtcb.error_code, long_message);
	end;

	call ioa_ ("^[echo negotiation data at ^o^/^;^s^]^[wakeup table at ^o^/^;^s^]^[prompt string: ^va^;^]",
	     (wtcb.echdp ^= "0"b), wtcb.echdp, (wtcb.waketp ^= "0"b), wtcb.waketp, (wtcb.prompt_len > 0),
	     wtcb.prompt_len, substr (wtcb.prompt, 1, wtcb.prompt_len));

	call ioa_ ("line delimiter = ""^a""", wtcb.line_delimiter);

	if wtcb.devx ^= devx
	then call ioa_ ("wtcb.devx = ^o (differs from index in LCT)", wtcb.devx);

	if ^wtcb.flags.tcb_initialized		/* if a control block */
	then return;

	tcbp = ptr (areap, rel (wtcb.tcb_ptr));
	call ioa_ ("^/TCB at ^o", bin (rel (tcbp)));

	call ioa_ ("terminal type = ^a, old type = ^d", tcb.terminal_type, tcb.old_type);

	mode = "";				/* init mode string */
	idx = 1;

	mode_bits = string (tcb.modes);
	do i = 1 to n_modes;			/* get all the mode bits */
	     if substr (mode_bits, i, 1)
	     then do;
		substr (mode, idx) = modestr (i);
		idx = index (mode, " ") + 1;		/* replace first blank with comma */
		substr (mode, idx - 1, 1) = ",";
	     end;
	end;

	if (tcb.can_type < lbound (CAN_TYPE_NAMES, 1)) | (tcb.can_type > hbound (CAN_TYPE_NAMES, 1))
	then substr (mode, idx) = "can_type=unknown";
	else substr (mode, idx) = CAN_TYPE_NAMES (tcb.can_type);

	call ioa_ ("modes:  ^a", mode);

	call ioa_ (
	     "flags: ^[breakall_enabled ^;^]^[dont_count_next ^;^]^[keyboard_locking ^;^]^[no_printer_off ^;^]^[break_char_pending ^;^]^[uproc_attached ^;^]^[block_acknowledge ^;^]"
	     , tcb.breakall_enabled, tcb.dont_count_next, tcb.keyboard_locking, tcb.no_printer_off,
	     tcb.break_char_pending, tcb.uproc_attached, tcb.block_acknowledge);
	call ioa_ (
	     "shift state = ^b (^[none^;lower^;upper^;unknown^]) ll = ^d, pl = ^d^/answerback id = ^a^/erase ^a, kill ^a, frame_begin ^a, frame_end ^a^/input message size ^d characters"
	     , tcb.actshift, bin (tcb.actshift) + 1, tcb.colmax, tcb.linemax, tcb.id, tcb.erase, tcb.kill,
	     tcb.frame_begin, tcb.frame_end, tcb.input_msg_size);

	if tcb.input_suspend_seq.count > 0
	then call ioa_ ("input_suspend: ^a", substr (tcb.input_suspend_seq.chars, 1, tcb.input_suspend_seq.count));

	if tcb.input_resume_seq.count > 0
	then call ioa_ ("input_resume: ^a", substr (tcb.input_resume_seq.chars, 1, tcb.input_resume_seq.count));

	if tcb.output_suspend_etb_seq.count > 0
	then call ioa_ ("output_^[end_of_block^;suspend^]: ^a", tcb.block_acknowledge,
		substr (tcb.output_suspend_etb_seq.chars, 1, tcb.output_suspend_etb_seq.count));

	if tcb.output_resume_ack_seq.count > 0
	then call ioa_ ("output_^[acknowledge^;resume^]: ^a", tcb.block_acknowledge,
		substr (tcb.output_resume_ack_seq.chars, 1, tcb.output_resume_ack_seq.count));

	if tcb.max_output_block ^= 0
	then call ioa_ ("maximum output block size = ^d characters", tcb.max_output_block);

	tablep = addr (tcb.tables);
	do i = 1 to 6;
	     call ioa_ ("^a ^o ^[default ^o;^s^]", table_names (i), table_arrays.table (i),
		table_arrays.default_table (i));
	end;

	if wtcb.echdp ^= "000000"b3
	then do;
	     echo_datap = ptr (wtcbp, wtcb.echdp);
	     call ioa_ ("^/Echo Negotiation Data at ^o:^/", bin (rel (echo_datap)));
	     call ioa_ ("Line length left = ^d, ^d chars r0 echoed.", echo_data.horiz_room_left, echo_data.chars_echoed)
		;
	     call ioa_ ("Flags:^[ synchronized^]^[ mux_will_echnego^]^[ esps^] ^[ start_wait^]^[ stop_wait^]",
		echo_data.synchronized, echo_data.mux_will_echnego, echo_data.echo_start_pending_sndopt,
		echo_data.awaiting_start_sync, echo_data.awaiting_stop_sync);
	     call ioa_ ("Mux sync ctr = ^d dec, ^o octal.", echo_data.sync_ctr, echo_data.sync_ctr);
	     call ioa_ ("Break table^( ^w^)^/", addr (echo_data.break) -> break_table_words);
	end;
	call ptchain ("read", (wtcb.fblock));		/* print read chain */
	call ptchain ("WTCB write", (wtcb.write_first));

	return;

     end print_wtcb;

/**/

/* Displays the contents of a PCB */

print_pcb:
     procedure ();

dcl  dn355_no fixed bin;
dcl  line_no bit (12);

	dn355_no = index ("abcdefgh", substr (lcnt.names (devx), 1, 1));
	fnpp = addr (datanet_info.per_datanet (dn355_no));
	n_pcbs = fnp_info.no_of_channels;

	if subchan < 0
	then do;
	     call ioa_ ("FNP ^a: ^d subchannels.", fnp_info.fnp_tag, n_pcbs);
	end;

	else do;
	     pcbp = addr (ptr (ttybp, rel (fnp_info.pcb_array_ptr)) -> pcb_array (subchan));
	     line_no = "00"b || string (pcb.line_number);
	     call ioa_ (
		"^/PCB at ^o, channel ^a, devx ^o^/line number ^4.3b, logical subchannel ^o^/write_first ^o, write_last ^o, write_cnt ^d^/baud rate ^d, line type ^a, max_buf_size ^d"
		, bin (rel (pcbp)), lcnt.names (pcb.devx), pcb.devx, line_no, pcb.subchan, pcb.write_first,
		pcb.write_last, pcb.write_cnt, pcb.baud_rate, line_types (pcb.line_type), pcb.max_buf_size);
	     call ioa_ (
		"flags: ^[listen ^;^]^[dialed ^;^]^[send_output ^;^]^[high_speed ^;^]^[sync_line ^;^]^[end_frame ^;^]^[hndlquit ^;^]^[breakall_enabled ^;^]^[output_mbx_pending ^;^]^[copied_meters_ready ^;^]^[get_meters_waiting ^;^]^[tandd_attached ^;^]"
		, pcb.listen, pcb.dialed, pcb.send_output, pcb.high_speed, pcb.sync_line, pcb.end_frame, pcb.hndlquit,
		pcb.breakall_enabled, pcb.output_mbx_pending, pcb.copied_meters_ready, pcb.get_meters_waiting,
		pcb.tandd_attached);
	     call ptchain ("PCB write", (pcb.write_first));
	end;

	return;

     end print_pcb;

/**/

/* Prints a buffer chain optionally calling dump_segment_ to display the contents */

ptchain:
     proc (chname, chst);

dcl  or fixed bin (18),
     chst fixed bin,
     chname char (*);
dcl  bsize fixed bin (18);

	or = fixed (chst, 18);
	if or = 0					/* if no chain */
	then return;

	call ioa_ ("^a", chname);			/* print header */
	do while (or ^= 0);				/* loop through chain */
	     if or < bin (tty_buf.borig, 18) | or > ttyb_len
	     then do;
		call ioa_ ("bad block offset: ^6o", or);
		return;
	     end;

	     blockp = ptr (ttybp, or);
	     bsize = (bin (buffer.size_code, 3) + 1) * 16;
	     call ioa_ ("^6o   size = ^d, tally = ^d, flags:^[ eop^]^[ conv^]^[ break^]", or, bsize,
		bin (buffer.tally, 9), buffer.end_of_page, buffer.converted, buffer.break);
	     if ^brief_sw
	     then call dump_segment_ (iox_$user_output, blockp, 0, or, bsize, string (ds_format));
	     or = buffer.next;
	end;

	return;

     end ptchain;



/* Special entry called by multiplexer dump routines to print a buffer chain */

print_chain:
     entry (pm_ttybp, pm_chname, pm_chst, pm_brief_sw);

dcl  pm_ttybp ptr;
dcl  pm_chname char (*);
dcl  pm_chst fixed bin;
dcl  pm_brief_sw bit (1);

	ttybp = pm_ttybp;
	brief_sw = pm_brief_sw;
	call ptchain (pm_chname, pm_chst);
	return;



/* Called by tty_analyze to allow multiplexer analyzer entries to call print_chain properly */

set_static_for_analyze:
     entry (pm_tty_buf_len, pm_ds_format);

dcl  pm_tty_buf_len fixed binary (19) unsigned parameter;
dcl  1 pm_ds_format aligned parameter like ds_format;

	ttyb_len = pm_tty_buf_len;
	ds_format = pm_ds_format;
	return;

 %include answer_table;
 %include author_dcl;
 %include cdt;
 %include dialup_values;
 %include dn355_data;
 %include lct;
 %include line_types;
 %include mcs_echo_neg_sys;
 %include multiplexer_types;
 %include pcb;
 %include tcb;
 %include tty_buf;
 %include tty_buffer_block;
 %include tty_can_types;
 %include tty_mode_names;
 %include user_attributes;
 %include user_table_entry;
 %include user_table_header;
 %include wtcb;

     end tty_dump;




		    tty_meters_.pl1                 11/15/82  1813.1rew 11/15/82  1449.2       93726



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* format: style4,delnl,insnl,^ifthendo */
tty_meters_:
     procedure;

/* This procedure contains entries to allocate and free metering structures, and display meters,
   for tty-type (non-multiplexed) channels. Only the _mpx entries are needed; a tty channel
   can never be a parent.
*/

/* Written February 1981 by Robert Coren */

	return;					/* main entry should never be called */

/* PARAMETERS */

dcl  a_area_ptr pointer;				/* pointer to area in which to perform allocations */
dcl  a_tty_meterp pointer;				/* pointer to structure to be allocated/freed (OUTPUT for alloc, INPUT for free */
dcl  a_chan_name char (*);				/* name of channel for display_mpx entry */
dcl  a_iocbp pointer;				/* pointer to IOCB for display_mpx */
dcl  a_chan_meterp pointer;				/* pointer to channel_meters structure, for display_mpx */
dcl  a_flags bit (36) aligned;			/* indicates what options were specified */
dcl  a_since_boot bit (1);				/* indicates -since_bootload specified  (summary entry) */
dcl  a_summary_ptr pointer;				/* pointer to structure used by summary entry */
dcl  a_code fixed bin (35);				/* status code (OUTPUT) */

/* AUTOMATIC */

dcl  areap pointer;
dcl  code fixed bin (35);
dcl  chan_name char (32);
dcl  iocbp pointer;
dcl  flags bit (36) aligned;
dcl  brief bit (1);
dcl  since_boot bit (1);
dcl  total_in_before_conv fixed bin (35);
dcl  total_in_after_conv fixed bin (35);
dcl  total_out_before_conv fixed bin (35);
dcl  total_out_after_conv fixed bin (35);
dcl  total_read_calls fixed bin (35);
dcl  total_write_calls fixed bin (35);
dcl  total_control_calls fixed bin (35);
dcl  total_read_time fixed bin (71);
dcl  total_write_time fixed bin (71);
dcl  total_control_time fixed bin (71);
dcl  total_ints fixed bin (35);
dcl  total_int_time fixed bin (71);
dcl  in_before_conv fixed bin (35);
dcl  in_after_conv fixed bin (35);
dcl  out_before_conv fixed bin (35);
dcl  out_after_conv fixed bin (35);
dcl  read_calls fixed bin (35);
dcl  write_calls fixed bin (35);
dcl  control_calls fixed bin (35);
dcl  read_time fixed bin (71);
dcl  write_time fixed bin (71);
dcl  control_time fixed bin (71);
dcl  interrupts fixed bin (35);
dcl  int_time fixed bin (71);
dcl  start_time fixed bin (71);
dcl  elapsed_time fixed bin (71);


/* BASED */

dcl  m_area area (256) based (areap);


/* ENTRIES */

dcl  ioa_$ioa_switch entry options (variable);
dcl  system_info_$timeup entry (fixed bin (71));
dcl  meter_format_$picture entry (fixed bin (35), fixed bin) returns (char (15) varying);
dcl  meter_format_$quotient entry (fixed bin (71), fixed bin (71), char (*)) returns (char (12) varying);


/* EXTERNAL STATIC */

dcl  error_table_$noalloc fixed bin (35) external static;
dcl  iox_$user_output pointer external static;


/* CONDITIONS */

dcl  area condition;

allocate_mpx:
     entry (a_area_ptr, a_tty_meterp, a_code);

/* entry to allocate a tty_channel_meters structure */

	areap = a_area_ptr;
	a_code = 0;
	on area
	     begin;
		a_code = error_table_$noalloc;
		go to exit;
	     end;

	allocate tty_channel_meters in (m_area) set (a_tty_meterp);
	a_tty_meterp -> tty_channel_meters.version = TTY_CHANNEL_METERS_VERSION_1;

exit:
	return;



free_mpx:
     entry (a_tty_meterp, a_code);

/* entry to free the tty_meters structure */

	tty_meterp = a_tty_meterp;
	free tty_channel_meters;
	a_code = 0;
	return;

display_mpx:
     entry (a_chan_name, a_iocbp, a_chan_meterp, a_flags, a_code);

	chan_name = a_chan_name;
	iocbp = a_iocbp;
	if iocbp = null ()
	then iocbp = iox_$user_output;
	chan_meterp = a_chan_meterp;
	flags = a_flags;
	a_code = 0;

	tty_meterp = channel_meters.mpx_specific_meterp;

	if flags & DISPLAY_MPX_SUMMARY		/* this routine doesn't do anything for summary */
	then return;

	if flags & DISPLAY_MPX_ERROR			/* this routine doesn't display any error conditions */
	then return;

	brief = flags & DISPLAY_MPX_BRIEF;
	total_in_before_conv = channel_meters.cumulative.unconverted_input_chars;
	total_in_after_conv = tty_channel_meters.current_meters.read_chars;
	total_out_before_conv = tty_channel_meters.current_meters.write_chars;
	total_out_after_conv = channel_meters.cumulative.converted_output_chars;
	total_read_calls = tty_channel_meters.current_meters.read_calls;
	total_write_calls = tty_channel_meters.current_meters.write_calls;
	total_control_calls = channel_meters.cumulative.control_calls;
	total_read_time = tty_channel_meters.current_meters.read_time;
	total_write_time = tty_channel_meters.current_meters.write_time;
	total_control_time = channel_meters.cumulative.control_call_time;
	total_ints = channel_meters.cumulative.software_interrupts;
	total_int_time = channel_meters.cumulative.interrupt_time;

	if flags & DISPLAY_MPX_SINCE_BOOT
	then do;					/* totals are the numbers we want */
	     in_before_conv = total_in_before_conv;
	     in_after_conv = total_in_after_conv;
	     out_before_conv = total_out_before_conv;
	     out_after_conv = total_out_after_conv;
	     read_calls = total_read_calls;
	     write_calls = total_write_calls;
	     control_calls = total_control_calls;
	     read_time = total_read_time;
	     write_time = total_write_time;
	     control_time = total_control_time;
	     interrupts = total_ints;
	     int_time = total_int_time;
	     call system_info_$timeup (start_time);
	end;

	else do;
	     in_before_conv = total_in_before_conv - channel_meters.saved.unconverted_input_chars;
	     in_after_conv = total_in_after_conv - tty_channel_meters.saved_meters.read_chars;
	     out_before_conv = total_out_before_conv - tty_channel_meters.saved_meters.write_chars;
	     out_after_conv = total_out_after_conv - channel_meters.saved.converted_output_chars;
	     read_calls = total_read_calls - tty_channel_meters.saved_meters.read_calls;
	     write_calls = total_write_calls - tty_channel_meters.saved_meters.write_calls;
	     control_calls = total_control_calls - channel_meters.saved.control_calls;
	     read_time = total_read_time - tty_channel_meters.saved_meters.read_time;
	     write_time = total_write_time - tty_channel_meters.saved_meters.write_time;
	     control_time = total_control_time - channel_meters.saved.control_call_time;
	     interrupts = total_ints - channel_meters.saved.software_interrupts;
	     int_time = total_int_time - channel_meters.saved.interrupt_time;
	     start_time = tty_channel_meters.last_dialed_time;
	end;

	elapsed_time = clock () - start_time;

	call ioa_$ioa_switch (iocbp, "^25tbefore conversion^45tafter conversion^64tratio");
	call ioa_$ioa_switch (iocbp, "Total characters input^25t^a^45t^a^65t^a",
	     meter_format_$picture (in_before_conv, 9), meter_format_$picture (in_after_conv, 9),
	     meter_format_$quotient ((in_after_conv), (in_before_conv), "^.2f"));

	call ioa_$ioa_switch (iocbp, "Total characters output^25t^a^45t^a^65t^a",
	     meter_format_$picture (out_before_conv, 9), meter_format_$picture (out_after_conv, 9),
	     meter_format_$quotient ((out_after_conv), (out_before_conv), "^.2f"));

	call ioa_$ioa_switch (iocbp, "Average length of input^29t^a^49t^a",
	     meter_format_$quotient ((in_before_conv), (read_calls), "^5.1f"),
	     meter_format_$quotient ((in_after_conv), (read_calls), "^5.1f"));

	call ioa_$ioa_switch (iocbp, "Average length of output^29t^a^49t^a",
	     meter_format_$quotient ((out_before_conv), (write_calls), "^5.1f"),
	     meter_format_$quotient ((out_after_conv), (write_calls), "^5.1f"));

	if ^brief
	then do;
	     call ioa_$ioa_switch (iocbp, "^/^34tread^45twrite^56tcontrol^64ttotal");
	     call ioa_$ioa_switch (iocbp, "Number of calls^34t^a^45t^a^56t^a^65t^a",
		meter_format_$picture (read_calls, 5), meter_format_$picture (write_calls, 5),
		meter_format_$picture (control_calls, 5),
		meter_format_$picture (read_calls + write_calls + control_calls, 5));

	     call ioa_$ioa_switch (iocbp, "Average time per call (msec.)^35t^a^46t^a^57t^a^66t^a",
		meter_format_$quotient (read_time, 1000 * read_calls, "^4.1f"),
		meter_format_$quotient (write_time, 1000 * write_calls, "^4.1f"),
		meter_format_$quotient (control_time, 1000 * control_calls, "^4.1f"),
		meter_format_$quotient (read_time + write_time + control_time,
		1000 * (read_calls + write_calls + control_calls), "^4.1f"));

	     call ioa_$ioa_switch (iocbp, "Average chars. processed per call^34t^a^45t^a",
		meter_format_$quotient ((in_before_conv), (read_calls), "^5.1f"),
		meter_format_$quotient ((out_before_conv), (write_calls), "^5.1f"));

	     call ioa_$ioa_switch (iocbp, "Number of software interrupts^34t^a", meter_format_$picture (interrupts, 9));

	     call ioa_$ioa_switch (iocbp, "Average time per interrupt (msec.)^35t^a^/",
		meter_format_$quotient (int_time, 1000 * interrupts, "^4.1f"));
	end;

	call ioa_$ioa_switch (iocbp, "^/^34tinput^45toutput");

	call ioa_$ioa_switch (iocbp, "Effective speed (cps)^34t^a^45t^a",
	     meter_format_$quotient (1000000 * in_before_conv, elapsed_time, "^7.1f"),
	     meter_format_$quotient (1000000 * out_before_conv, elapsed_time, "^7.1f"));

	return;

mpx_summary:
     entry (a_chan_meterp, a_since_boot, a_summary_ptr, a_code);

/* entry to fill in structure used by channel_comm_meters -summary */

	a_code = 0;				/* no errors are possible */
	summary_ptr = a_summary_ptr;
	chan_meterp = a_chan_meterp;
	since_boot = a_since_boot;
	tty_meterp = channel_meters.mpx_specific_meterp;

	channel_summary.baud_rate = tty_channel_meters.baud_rate;
	channel_summary.user_process = tty_channel_meters.user_process;
	if tty_channel_meters.last_dialed_time ^= 0
	then channel_summary.time_since_dial = clock () - tty_channel_meters.last_dialed_time;
	channel_summary.breakall = tty_channel_meters.breakall;
	channel_summary.echoplex = tty_channel_meters.echoplex;
	return;

%include tty_channel_meters;
%page;
%include tcb;
%page;
%include channel_meters;
%page;
%include comm_meters_disp_flags;
%page;
%include channel_summary;
     end tty_meters_;




		    vip7760_dump_.pl1               07/20/88  1256.8r w 07/19/88  1537.4       55215



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


vip7760_dump_:
     proc (pm_ttybp, pm_ttyap, pm_pvmdp, pm_subchan, pm_brief_sw);

/* Called by tty_dump and tty_analyze to interpret a polled vip multiplexer data base */
/* Coded 1/4/79 by J. Stern */
/* Modified 5/1/79 by J. Stern to add vip7760_analyze_ entry */


/* Parameters */

	dcl     pm_brief_sw		 bit (1);		/* ON for brief output format */
	dcl     pm_check_used_proc	 entry variable;	/* entry called to tally tty_buf space used */
	dcl     pm_devx		 fixed bin;	/* device index of multiplexer channel */
	dcl     pm_long_sw		 bit (1);		/* ON for long output format */
	dcl     pm_pvmdp		 ptr;		/* ptr to polled vip multiplexer data base */
	dcl     pm_subchan		 fixed bin;	/* subchannel number */
	dcl     pm_ttyap		 ptr;		/* ptr to tty_area segment */
	dcl     pm_ttybp		 ptr;		/* ptr to tty_buf segment */


/* Automatic */

	dcl     brief_sw		 bit (1);
	dcl     check_used_proc	 entry (ptr, fixed bin) variable;
	dcl     devx		 fixed bin;
	dcl     subchan		 fixed bin;


/* Builtins */

	dcl     (addr, bin, ptr, rel, size, null, unspec)
				 builtin;


/* Entries */

	dcl     ioa_		 entry options (variable);
	dcl     tty_dump$print_chain	 entry (ptr, char (*), fixed bin, bit (1));

%include polled_vip_mpx_data;


%include polled_vip_mpx_meters;


%include pvip_subchan_meters;

%include tty_buf;

%include lct;

%include tty_buffer_block;

	ttybp = pm_ttybp;
	pvmdp = pm_pvmdp;
	subchan = pm_subchan;
	brief_sw = pm_brief_sw;

/* Print major channel data */

	call ioa_ ("^/PVMD at ^o, channel ^a, devx ^o", bin (rel (pvmdp), 18), pvmd.name, pvmd.devx);
	call ioa_ ("nchan = ^d, nstation = ^d, station_mask = ^w", pvmd.nchan, pvmd.nstation, unspec (pvmd.station_mask));
	if pvmd.cur_nstation ^= pvmd.nstation
	then call ioa_ ("cur_nstation = ^d, cur_station_mask = ^w", pvmd.cur_nstation, unspec (pvmd.cur_station_mask));
	call ioa_ ("load_proc_id = ^.3b, load_ev_chan = ^.3b", pvmd.load_proc_id, unspec (pvmd.load_ev_chan));
	call ioa_ ("pause_time = ^d, max_text_len = ^d, max_message_len = ^d,  quit = ^a, formfeed = ^a", pvmd.pause_time, pvmd.max_text_len,
	     pvmd.max_message_len, pvmd.quit, pvmd.formfeed);
	call ioa_
	     (
	     "flags: ^[ send_output^]^[ mpx_started^]^[ mpx_loading^]^[ mpx_loaded^]^[ polling_started^]^[ controller_poll^]^[ partial_frame^]^[ crlf_echo^]^[ omit_nl^]^[ omit_ff^]^[ gcos_break^]^[ etb_mode^]"
	     , pvmd.send_output, pvmd.mpx_started, pvmd.mpx_loading, pvmd.mpx_loaded, pvmd.polling_started,
	     pvmd.controller_poll, pvmd.partial_frame, pvmd.crlf_echo, pvmd.omit_nl, pvmd.omit_ff, pvmd.gcos_break,
	     pvmd.etb_mode);

	if pvmd.writep ^= null
	then call ioa_ ("writep = ^p", pvmd.writep);
	if pvmd.write_chan ^= 0
	then call ioa_ ("write_chan = ^d", pvmd.write_chan);

	if pvmd.writep ^= null
	then call tty_dump$print_chain (ttybp, "WRITE_CHAIN", bin (rel (pvmd.writep)), brief_sw);

/* Print subchannel data */

	if subchan = -1				/* means we should dump all subchans */
	then do subchan = 1 to pvmd.nchan;
		call print_subchan;
	     end;
	else call print_subchan;

	return;

print_subchan:
     proc;

	dcl     i			 fixed bin;

	pvstep = addr (pvmd.subchan_table (subchan));
	call ioa_ ("^/PVSTE at ^o, channel ^a.^a, devx ^o, subchan ^o, station_addr ^o", bin (rel (pvstep), 18), pvmd.name,
	     pvste.name, pvste.devx, subchan, pvste.station_addr);

	if pvste.printer
	then i = pvmd.station_to_subchan (pvste.station_addr).printer;
	else i = pvmd.station_to_subchan (pvste.station_addr).display;
	if i ^= subchan
	then call ioa_ ("ERROR: ^[printer^;display^] station ^d maps to subchan ^d", pvste.printer, pvste.station_addr, i);

	call ioa_ ("flags: ^[ printer^]^[ hold_output^]^[ eop^]^[ hndlquit^]^[ listen^]^[ dialed^]^[ slave^]",
	     pvste.printer, pvste.hold_output, pvste.eop, pvste.hndlquit, pvste.listen, pvste.dialed, pvste.slave);
	;
	if pvste.printer
	then call ioa_ ("baud_rate = ^d", pvste.baud_rate);

	if pvste.pgofs + pvste.writes ^= 0
	then call ioa_ ("pgofs = ^d, writes = ^d", pvste.pgofs, pvste.writes);
	if pvste.naks ^= 0
	then call ioa_ ("naks = ^d", pvste.naks);

	if pvste.write_chain ^= 0			/* there's a write chain to print */
	then call tty_dump$print_chain (ttybp, "WRITE CHAIN", (pvste.write_chain), brief_sw);

     end;

vip7760_analyze_:
     entry (pm_ttybp, pm_ttyap, pm_devx, pm_check_used_proc, pm_long_sw);

	ttybp = pm_ttybp;
	devx = pm_devx;
	check_used_proc = pm_check_used_proc;
	brief_sw = ^pm_long_sw;

/* get ptr to polled vip multiplexer data base for specified devx */

	lctp = ptr (ttybp, rel (tty_buf.lct_ptr));
	lctep = addr (lct.lcte_array (devx));
	pvmdp = ptr (ttybp, rel (lcte.data_base_ptr));

/* display data base contents */

	call vip7760_dump_ (ttybp, pm_ttyap, pvmdp, -1, brief_sw);

/* account for all tty_buf space used by multiplexer */

	pvmd_nchan = pvmd.nchan;
	call check_used_proc (pvmdp, size (pvmd));
	call trace_chain (bin (rel (pvmd.writep)));

	do subchan = 1 to pvmd.nchan;			/* examine all subchans */
	     pvstep = addr (pvmd.subchan_table (subchan));
	     call trace_chain ((pvste.write_chain));
	end;

	return;

/* subroutine to trace a buffer chain and account for space used */

trace_chain:
     proc (chain_offset);

	dcl     chain_offset	 fixed bin (18);
	dcl     buf_offset		 fixed bin (18);


	buf_offset = chain_offset;
	do while (buf_offset ^= 0);
	     if buf_offset < bin (tty_buf.borig, 18)
	     then return;				/* give up on bad chain */

	     blockp = ptr (ttybp, buf_offset);
	     buf_offset = buffer.next;
	     call check_used_proc (blockp, 16 * (bin (buffer.size_code, 3) + 1));
	end;

     end;


     end;						/* vip7760_dump_ */




		    vip7760_meters_.pl1             10/25/89  1156.0r w 10/25/89  1005.2      106011



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* format: style4,delnl,insnl,^ifthendo */
vip7760_meters_:
     proc;

/* This subroutine contains entries for allocating, freeing, and displaying
   meters for a polled VIP multiplexer and its subchannels.
*/

/* Written June 1981 by Robert Coren */

/* PARAMETERS */

dcl  a_area_ptr ptr;
dcl  a_meterp ptr;
dcl  a_code fixed bin (35);
dcl  a_chan_name char (*);
dcl  a_iocbp ptr;
dcl  a_chan_meterp ptr;
dcl  a_flags bit (36) aligned;
dcl  a_since_boot bit (1);
dcl  a_summary_ptr ptr;


/* AUTOMATIC */

dcl  areap ptr;
dcl  code fixed bin (35);
dcl  iocbp ptr;
dcl  flags bit (36) aligned;
dcl  brief bit (1);
dcl  error bit (1);
dcl  since_boot bit (1);
dcl  printer bit (1);
dcl  parent_fnp bit (1);
dcl  pvip_meterp ptr;
dcl  current_meterp ptr;
dcl  saved_meterp ptr;
dcl  current_fnp_meterp ptr;
dcl  saved_fnp_meterp ptr;

dcl  input_naks fixed bin (35);
dcl  output_naks fixed bin (35);
dcl  timeouts fixed bin (35);
dcl  timeout_limit fixed bin (35);
dcl  inc_frame fixed bin (35);
dcl  input_frames_lost fixed bin (35);
dcl  output_frames_lost fixed bin (35);
dcl  bad_output_frames fixed bin (35);
dcl  output_timeouts fixed bin (35);
dcl  printer_naks fixed bin (35);
dcl  discarded_printer_frames fixed bin (35);
dcl  display_pgofs fixed bin (35);
dcl  pgof_limit_reached fixed bin (35);

dcl  total_input_naks fixed bin (35);
dcl  total_output_naks fixed bin (35);
dcl  total_timeouts fixed bin (35);
dcl  total_timeout_limit fixed bin (35);
dcl  total_inc_frame fixed bin (35);
dcl  total_input_frames_lost fixed bin (35);
dcl  total_output_frames_lost fixed bin (35);
dcl  total_bad_output_frames fixed bin (35);
dcl  total_output_timeouts fixed bin (35);
dcl  total_printer_naks fixed bin (35);
dcl  total_discarded_printer_frames fixed bin (35);
dcl  total_display_pgofs fixed bin (35);
dcl  total_pgof_limit_reached fixed bin (35);


/* BASED */

dcl  m_area area (100) based (areap);


/* EXTERNAL STATIC */

dcl  error_table_$noalloc external static fixed bin (35);
dcl  iox_$user_output external static ptr;


/* ENTRIES */

dcl  ioa_$ioa_switch entry options (variable);
dcl  meter_format_$picture entry (fixed bin (35), fixed bin) returns (char (15) varying);


/* CONDITIONS & BUILTINS */

dcl  area condition;
dcl  (addr, null) builtin;

allocate_mpx:
     entry (a_area_ptr, a_meterp, a_code);

	areap = a_area_ptr;
	a_code = 0;

	on area
	     begin;
		a_code = error_table_$noalloc;
		go to exit;
	     end;

	allocate pvip_mpx_meter_struc in (m_area) set (a_meterp);
	a_meterp -> pvip_mpx_meter_struc.version = PVIP_MPX_METERS_VERSION_1;
exit:
	return;


free_subchan:
     entry (a_meterp, a_code);

	free a_meterp -> pvip_subchan_meter_struc;
	a_code = 0;
	return;

allocate_subchan:
     entry (a_area_ptr, a_meterp, a_code);

	areap = a_area_ptr;
	a_code = 0;

	on area
	     begin;
		a_code = error_table_$noalloc;
		go to exit;
	     end;

	allocate pvip_subchan_meter_struc in (m_area) set (a_meterp);
	a_meterp -> pvip_subchan_meter_struc.version = PVIP_SUBCHAN_METERS_VERSION_1;

	return;


free_mpx:
     entry (a_meterp, a_code);

	free a_meterp -> pvip_mpx_meter_struc;
	a_code = 0;
	return;

display_mpx:
     entry (a_chan_name, a_iocbp, a_chan_meterp, a_flags, a_code);

	iocbp = a_iocbp;
	if iocbp = null ()
	then iocbp = iox_$user_output;

	chan_meterp = a_chan_meterp;
	flags = a_flags;
	a_code = 0;

	if flags & DISPLAY_MPX_SUMMARY		/* we don't handle this */
	then return;

	if flags & DISPLAY_MPX_BRIEF
	then brief = "1"b;
	else brief = "0"b;

	if flags & DISPLAY_MPX_ERROR
	then error = "1"b;
	if flags & DISPLAY_MPX_SINCE_BOOT
	then since_boot = "1"b;
	else since_boot = "0"b;

	if brief
	then return;				/* no "brief" meters from this multiplexer */

	call set_mpx_values;

	if parent_fnp
	then do;
	     call ioa_$ioa_switch (iocbp, "Invalid input messages^28t^a", meter_format_$picture (input_naks, 11));
	     call ioa_$ioa_switch (iocbp, "NAK for output messages^28t^a", meter_format_$picture (output_naks, 11));
	     if ^error
	     then do;
		call ioa_$ioa_switch (iocbp, "Response timeouts^28t^a", meter_format_$picture (timeouts, 11));
		call ioa_$ioa_switch (iocbp, "Incomplete frame from host^28t^a",
		     meter_format_$picture (inc_frame, 11));
	     end;
	end;

	call ioa_$ioa_switch (iocbp, "No response after 3 tries^30t^a", meter_format_$picture (timeout_limit, 9));
	call ioa_$ioa_switch (iocbp, "Lost input frames^30t^a", meter_format_$picture (input_frames_lost, 9));
	call ioa_$ioa_switch (iocbp, "Lost output frames^30t^a", meter_format_$picture (output_frames_lost, 9));
	call ioa_$ioa_switch (iocbp, "Bad output frame format^28t^a", meter_format_$picture (bad_output_frames, 7));
	call ioa_$ioa_switch (iocbp, "Output frame not completed in time^28t^a",
	     meter_format_$picture (output_timeouts, 7));

	return;

display_subchan:
     entry (a_chan_name, a_iocbp, a_chan_meterp, a_flags, a_code);

	iocbp = a_iocbp;
	if iocbp = null ()
	then iocbp = iox_$user_output;

	chan_meterp = a_chan_meterp;
	flags = a_flags;
	a_code = 0;

	if flags & DISPLAY_MPX_SUMMARY		/* we don't handle this */
	then return;

	if flags & DISPLAY_MPX_BRIEF
	then brief = "1"b;
	else brief = "0"b;

	if flags & DISPLAY_MPX_ERROR
	then error = "1"b;
	if flags & DISPLAY_MPX_SINCE_BOOT
	then since_boot = "1"b;
	else since_boot = "0"b;

	if brief
	then return;				/* no "brief" meters from this multiplexer */

	call set_subchan_values;

	if printer
	then do;
	     call ioa_$ioa_switch (iocbp, "NAK from printer^28t^a", meter_format_$picture (printer_naks, 11));
	     call ioa_$ioa_switch (iocbp, "Discarded printer frames^28t^a",
		meter_format_$picture (discarded_printer_frames, 11));
	end;

	else do;
	     if ^error
	     then call ioa_$ioa_switch (iocbp, "Page overflows^28t^a", meter_format_$picture (display_pgofs, 11));
	     call ioa_$ioa_switch (iocbp, "Exceeded page overflow limit^32t^a",
		meter_format_$picture (pgof_limit_reached, 7));
	end;

	return;

mpx_summary:
     entry (a_chan_meterp, a_since_boot, a_summary_ptr, a_code);

/* entry to fill in values used by channel_comm_meters -summary */

	a_code = 0;
	chan_meterp = a_chan_meterp;
	summary_ptr = a_summary_ptr;
	since_boot = a_since_boot;
	call set_mpx_values;

	channel_summary.error_count = timeout_limit;
	if parent_fnp
	then channel_summary.error_count = channel_summary.error_count + input_naks + output_naks;

	return;

subchan_summary:
     entry (a_chan_meterp, a_since_boot, a_summary_ptr, a_code);

/* entry to fill in values used by channel_comm_meters -summary */

	a_code = 0;
	chan_meterp = a_chan_meterp;
	summary_ptr = a_summary_ptr;
	since_boot = a_since_boot;

	call set_subchan_values;
	if printer
	then channel_summary.error_count = printer_naks;
	else channel_summary.error_count = 0;
	return;

set_mpx_values:
     procedure;

/* internal procedure to set metering values (either cumulative or since load)
   for multiplexer channel */

	pvip_meterp = channel_meters.mpx_specific_meterp;
	if channel_meters.parent_type = MCS_MPX		/* if parent is an FNP */
	then do;					/* then we know something about the next level of metering */
	     fnp_chan_meterp = channel_meters.parent_meterp;
	     current_fnp_meterp = addr (fnp_chan_meter_struc.current_meters);
	     saved_fnp_meterp = addr (fnp_chan_meter_struc.saved_meters);
	     parent_fnp = "1"b;
	end;

	else parent_fnp = "0"b;

	current_meterp = addr (pvip_meterp -> pvip_mpx_meter_struc.current_meters);
	saved_meterp = addr (pvip_meterp -> pvip_mpx_meter_struc.saved_meters);

	total_timeout_limit = current_meterp -> pvip_mpx_meters.input_timeouts;
	total_input_frames_lost = current_meterp -> pvip_mpx_meters.input_frames_lost;
	total_output_frames_lost = current_meterp -> pvip_mpx_meters.output_frames_lost;
	total_bad_output_frames = current_meterp -> pvip_mpx_meters.bad_output_frames;
	total_output_timeouts = current_meterp -> pvip_mpx_meters.output_timeouts;

	if parent_fnp
	then do;
	     total_input_naks = current_fnp_meterp -> fnp_sync_meters.counters (1);
	     total_output_naks = current_fnp_meterp -> fnp_sync_meters.counters (2);
	     total_timeouts = current_fnp_meterp -> fnp_sync_meters.counters (3);
	     total_inc_frame = current_fnp_meterp -> fnp_sync_meters.counters (4);
	end;

	if since_boot
	then do;
	     timeout_limit = total_timeout_limit;
	     input_frames_lost = total_input_frames_lost;
	     output_frames_lost = total_output_frames_lost;
	     bad_output_frames = total_bad_output_frames;
	     output_timeouts = total_output_timeouts;

	     if parent_fnp
	     then do;
		input_naks = total_input_naks;
		output_naks = total_output_naks;
		timeouts = total_timeouts;
		inc_frame = total_inc_frame;
	     end;
	end;

	else do;
	     timeout_limit = total_timeout_limit - saved_meterp -> pvip_mpx_meters.input_timeouts;
	     input_frames_lost = total_input_frames_lost - saved_meterp -> pvip_mpx_meters.input_frames_lost;
	     output_frames_lost = total_output_frames_lost - saved_meterp -> pvip_mpx_meters.output_frames_lost;
	     bad_output_frames = total_bad_output_frames - saved_meterp -> pvip_mpx_meters.bad_output_frames;
	     output_timeouts = total_output_timeouts - saved_meterp -> pvip_mpx_meters.output_timeouts;

	     if parent_fnp
	     then do;
		input_naks = total_input_naks - saved_fnp_meterp -> fnp_sync_meters.counters (1);
		output_naks = total_output_naks - saved_fnp_meterp -> fnp_sync_meters.counters (2);
		timeouts = total_timeouts - saved_fnp_meterp -> fnp_sync_meters.counters (3);
		inc_frame = total_inc_frame - saved_fnp_meterp -> fnp_sync_meters.counters (4);
	     end;
	end;
     end set_mpx_values;

set_subchan_values:
     procedure;

/* internal procedure to set metering values (either cumulative or since dialup)
   for subchannel */

	pvip_meterp = channel_meters.parent_meterp;
	current_meterp = addr (pvip_meterp -> pvip_subchan_meter_struc.current_meters);
	saved_meterp = addr (pvip_meterp -> pvip_subchan_meter_struc.saved_meters);
	printer = pvip_meterp -> pvip_subchan_meter_struc.printer;

	if printer
	then do;
	     total_printer_naks = current_meterp -> pvip_subchan_meters.printer_naks;
	     total_discarded_printer_frames = current_meterp -> pvip_subchan_meters.discarded_printer_frame;
	end;

	else do;
	     total_display_pgofs = current_meterp -> pvip_subchan_meters.display_pgofs;
	     total_pgof_limit_reached = current_meterp -> pvip_subchan_meters.pgof_limit_reached;
	end;

	if since_boot
	then if printer
	     then do;
		printer_naks = total_printer_naks;
		discarded_printer_frames = total_discarded_printer_frames;
	     end;

	     else do;
		display_pgofs = total_display_pgofs;
		pgof_limit_reached = total_pgof_limit_reached;
	     end;

	else if printer
	then do;
	     printer_naks = total_printer_naks - saved_meterp -> pvip_subchan_meters.printer_naks;
	     discarded_printer_frames = total_discarded_printer_frames - saved_meterp -> pvip_subchan_meters.discarded_printer_frame;
	end;

	else do;
	     display_pgofs = total_display_pgofs - saved_meterp -> pvip_subchan_meters.display_pgofs;
	     pgof_limit_reached = total_pgof_limit_reached - saved_meterp -> pvip_subchan_meters.pgof_limit_reached;
	end;
     end set_subchan_values;

%include channel_meters;
%page;
%include multiplexer_types;
%page;
%include polled_vip_mpx_meters;
%page;
%include pvip_subchan_meters;
%page;
%include fnp_channel_meters;
%page;
%include comm_meters_disp_flags;
%page;
%include channel_summary;
     end vip7760_meters_;




		    x25_analyze_.pl1                10/25/89  1156.0r w 10/25/89  1003.8       21789



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */

/* subroutine called by tty_analyze for X.25 multiplexers  */
/* Written sometime-or-other by Charles Hornig */
/* Modified July 1983 by Robert Coren to make print_chain subroutine check for
   null chain pointer. */

/* format: style4,delnl,insnl,tree,ifthenstmt,indnoniterend */
x25_analyze_:
     procedure (Ttybp, Areap, Devx, Check_used, Long);

dcl  (Ttybp, Areap) ptr parameter;
dcl  Devx fixed bin parameter;
dcl  Check_used entry (ptr, fixed bin) parameter;
dcl  Long bit (1) aligned parameter;

dcl  x25_dump_ entry (ptr, ptr, ptr, fixed bin, bit (1) aligned);

dcl  i fixed bin;

dcl  (addr, binary, currentsize, pointer, rel) builtin;
%page;
	x25_data_ptr =
	     pointer (Ttybp,
	     rel (addr (pointer (Ttybp, rel (Ttybp -> tty_buf.lct_ptr)) -> lct.lcte_array (Devx)) -> lcte.data_base_ptr)
	     );

	call x25_dump_ (Ttybp, Areap, x25_data_ptr, -1, ^Long);
	call trace_chain (x25_data.write_head);
	do i = 1 to x25_data.n_sc;
	     call x25_dump_ (Ttybp, Areap, x25_data_ptr, i, ^Long);
	end;
	do i = 1 to x25_data.n_sc;
	     call trace_chain (x25_data.sc (i).write_head);
	end;
	if x25_data.lc_ptr ^= null () then do;
	     x25_data.lc_ptr = ptr (Ttybp, rel (x25_data.lc_ptr));
	     call Check_used (x25_data.lc_ptr, currentsize (x25_lces));
	     end;
	call Check_used (x25_data_ptr, currentsize (x25_data));
	return;

/* * * * * * * * * TRACE_CHAIN * * * * * * * * * * */

trace_chain:
     procedure (Chain);
dcl  Chain ptr parameter;
dcl  buf_offset fixed bin (18);

	if Chain = null () then return;
	buf_offset = binary (rel (Chain), 18);
	do while ((buf_offset ^= 0) & (buf_offset < 261120));
	     blockp = pointer (Ttybp, buf_offset);
	     buf_offset = buffer.next;
	     call Check_used (blockp, 16 * (binary (buffer.size_code, 3) + 1));
	end;
	return;
     end trace_chain;
%page;
%include x25_data;
%include tty_buf;
%include lct;
%include tty_buffer_block;

     end x25_analyze_;




		    x25_dump_.pl1                   10/25/89  1156.0rew 10/25/89  1000.0       40464



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1989   *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */




/****^  HISTORY COMMENTS:
  1) change(89-10-04,Parisek), approve(89-10-04,MCR8110),
     audit(89-10-09,Farley), install(89-10-25,MR12.3-1100):
     Added display of the "packet_trace_sw" flag for x25 devices.
                                                   END HISTORY COMMENTS */


/* format: style4,delnl,insnl,ifthenstmt,indnoniterend */

/* modified by Robert Coren, July 1983, for long packet threshold */
/* Modified by R.J.C. Kissel, October 1984, for breakall_idle_timer. */

x25_dump_:
     procedure (Ttybp, Areap, Dp, Sc, Brief);

dcl  (Ttybp, Areap, Dp) ptr parameter;
dcl  Sc fixed bin parameter;
dcl  Brief bit (1) aligned parameter;

dcl  ioa_ entry () options (variable);
dcl  ioa_$nnl entry () options (variable);
dcl  tty_dump$print_chain entry (ptr, char (*), fixed bin, bit (1));

dcl  x25_state_names (5) char (32) static options (constant)
	init ("p1(READY)", "p2(DTE WAITING)", "p41(FLOW CONTROL READY)", "p6(DTE CLEAR REQUEST)",
	"p42(DTE RESET REQUEST)");

dcl  i fixed bin;

dcl  (addr, binary, hbound, mod, null, ptr, rel, unspec) builtin;
%page;
	x25_data_ptr = Dp;
	x25_data.lc_ptr = ptr (Ttybp, rel (x25_data.lc_ptr));

	if Sc > 0 then do;
	     xscep = addr (x25_data.sc (Sc));
	     call ioa_ (
		"X.25 SC ^d ^a devx ^o^[(^a)^;^s^]: ^[HUNGUP^;LISTENING^;DIALING^;DIALED^]^[ output_ready^]^[ eop^]^[ wru^]^[ need_ftd^]^[ long_packet^]^[ rawi^]^[ echoplex^]^[ breakall^]^[ iflow^]^[ oflow^]^[ hndlquit^]^[ polite^]^[ lfecho^]^[ 8bit^]^9(^s^)"
		, Sc, xsce.name, xsce.devx, (xsce.service ^= ""), xsce.service, xsce.state + 1,
		xsce.flags.output_ready, xsce.flags.end_of_page, xsce.flags.wru_done, xsce.flags.need_ftd,
		xsce.flags.long_packet_pending, xsce.mode);
	     if xsce.lcx > 0 then do;
		xlcep = addr (x25_lces.lc (xsce.lcx));
		call ioa_ (" LC ^d: state=^a,max_packet_size=^d,window used=^d/^d", xsce.lcx,
		     x25_state_names (xlce.state), xlce.max_packet_size,
		     mod (xlce.next_send_seq - xlce.next_ack_seq, x25_data.seq_mod), xlce.max_window_size);
		call ioa_ (
		     "^-^[iti ^]^[int_issued ^]^[rnr_sent ^]^[rnr_received ^]^[iti_break ^]^[baud=^d ^;^s^]^[originate ^]"
		     , xlce.iti_call, xlce.int_issued, xlce.flags.rnr_sent, xlce.rnr_received, xlce.iti_break,
		     (xlce.baud_rate ^= 0), xlce.baud_rate, xlce.flags.originate);
		call ioa_ ("^-^[ address=^a^;^s^]^[ call data=^a^;^s^]", (xlce.his_address ^= ""), xlce.his_address,
		     (xlce.call_data ^= ""), xlce.call_data);
		if unspec (xlce.iti_params) ^= ""b then do;
		     call ioa_$nnl ("^-PAR");
		     do i = 1 to hbound (xlce.iti_params, 1);
			if xlce.iti_params (i) > 0 then call ioa_$nnl ("  ^d:^d", i, xlce.iti_params (i));
		     end;
		     call ioa_ ("");
		     end;
		if xsce.write_head ^= null () then do;
		     call ioa_$nnl ("write chain:");
		     call tty_dump$print_chain (Ttybp, "", binary (rel (xsce.write_head), 18), (Brief));
		     end;
		end;
	     end;
	else do;
	     call ioa_ (
		"X.25 devx ^o, ^d lc, ^d sc, ^[HUNGUP^;LISTENING^;RESTARTING^;ACTIVE^] flags: ^[started^]^[ send_output^]^[ bypass_restart^]^[ no_d^]^[ packet_tracing^]"
		, x25_data.devx, x25_data.n_lc, x25_data.n_sc, 1 + x25_data.state, x25_data.flags.mpx_started,
		x25_data.flags.send_output, x25_data.flags.bypass_restart, x25_data.flags.no_d, x25_data.flags.packet_trace_sw);
	     call ioa_ ("  packet_threshold=^d  breakall_idle_timer=^d^[  address=^a^;^s^]^[  network=^a^;^s^]",
		x25_data.long_packet_size, x25_data.breakall_idle_timer, (x25_data.my_address ^= ""),
		x25_data.my_address, (x25_data.net_type ^= ""), x25_data.net_type);
	     if x25_data.write_head ^= null () then do;
		call ioa_ ("  write chain:");
		call tty_dump$print_chain (Ttybp, "", binary (rel (x25_data.write_head), 18), (Brief));
		end;
	     end;

	return;
%page;
%include x25_data;

     end x25_dump_;



		    bull_copyright_notice.txt       08/30/05  1008.4r   08/30/05  1007.3    00020025

                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for 
managing computer hardware properly and for executing programs. Many subsequent operating systems
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by Bull HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved
