



		    heals_collect_data_.pl1         09/27/84  0748.5rew 09/27/84  0744.1      123813



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* This routine copies selected syserr_log messages
   into the Heals log.  Record selection is based upon
   a time range, as well as a data type.
   Coded by A. Downing Feb. 1976.
*/
/* Modified Feb. 1979 by A. Downing in preparation
   of MR7.0; several bug fixes and some code clarification made.
*/
heals_collect_data_: proc (datap, code);
%include heals_arg_info;
%include heals_message;
%include heals_state;
%include syserr_message;
%include iocb;
dcl 1 arg_info like heals_arg_info based (datap);
dcl  datap ptr;
dcl  qip ptr;
dcl 1 query_info aligned,
    2 version fixed bin init (1),
    2 yes_or_no_sw bit (1) unal init ("1"b),		/* Require "yes" or "no" answer. */
    2 suppress_name_sw bit (1) unal init ("0"b),		/* Print name with question. */
    2 status_code fixed bin (35),			/* Set to code of error prompting question. */
    2 query_code fixed bin (35) init (0);
dcl  sysmsgp ptr;
dcl  code fixed bin (35);
dcl  i fixed bin (21);
dcl  log_code fixed bin (35);				/* code for syserr_log_util_ calls. */
dcl  no_of_recs_copied fixed bin (35) init (0);
dcl  answer char (8) init ("");
dcl (error_table_$no_record, error_table_$key_duplication, error_table_$key_order) ext static fixed bin (35);
dcl  error_table_$bad_arg ext static fixed bin (35);
dcl  error_table_$file_busy ext static fixed bin (35);
dcl (error_table_$not_open, error_table_$not_closed, error_table_$not_attached)
     ext static fixed bin (35);
dcl  error_table_$end_of_info ext static fixed bin (35);
dcl  last_msg_tallied fixed bin (35);
dcl  last_msg_tallied_time fixed bin (71);
dcl  m_len fixed bin (21);
dcl  input_record char (2048) init ("");
dcl  output_record char (2048) init ("");
dcl  io_data bit (1) unal defined arg_info.info_selection pos (1);
dcl  mpc_data bit (1) unal defined arg_info.info_selection pos (2);
dcl  cpu_data bit (1) unal defined arg_info.info_selection pos (3);
dcl  mos_edac_data bit (1) unal defined arg_info.info_selection pos (4);
dcl  sorted_io_data bit (1) unal defined arg_info.info_selection pos (5);
dcl  disk_data bit (1) unal defined arg_info.info_selection pos (6);
dcl  bulk_data bit (1) unal defined arg_info.info_selection pos (7);
dcl  command_query_ entry options (variable);
dcl (com_err_, ioa_) entry options (variable);
dcl  hcs_$initiate entry (char (*), char (*), char (*),
     fixed bin (1), fixed bin (2), ptr, fixed bin (35));
dcl  syserr_log_util_$status entry (ptr, fixed bin (35));
dcl  syserr_log_util_$read entry (ptr, fixed bin (21), fixed bin (21), fixed bin (35));
dcl  syserr_log_util_$close entry (fixed bin (35));
dcl  syserr_log_util_$search entry (fixed bin (71), fixed bin (71), fixed bin (35), fixed bin (35));
dcl  syserr_log_util_$open entry (bit (36) aligned, fixed bin (35));
dcl  syserr_log_util_$position entry (fixed bin (24), fixed bin (71), fixed bin (35), fixed bin (35));
dcl  buffering bit (1) aligned init ("0"b);
dcl  first_record bit (1) init ("1"b);
dcl (ioi_type, rcp_type, cpu_type, mos_type, disk_type,
     dn355_type, iom_type, bulk_type) bit (1) aligned;
dcl  keyed_sequential_output fixed bin int static init (9); /* iox value */
dcl  last_message_copied bit (1) init ("0"b) aligned;
dcl (cleanup, record_quota_overflow) condition;
dcl (addr, bin, index, null, reverse, substr) builtin;
dcl  slu_statusp ptr;
dcl 1 slu_status aligned,
    2 version fixed bin;				/* thats it for now */
dcl  open_status bit (36) aligned;
dcl (search_time, rtime) fixed bin (71);
dcl  rseq fixed bin (35);

	arg_info.err_nb = -1;			/* if we abort without satisfaction */
	qip = addr (query_info);
	i = index (reverse (arg_info.heals_log_path_name), ">");
	i = length (arg_info.heals_log_path_name) - i;
	call hcs_$initiate
	  (substr (arg_info.heals_log_path_name, 1, i), "heals_log_info", "",
	  0, 0, heals_state_p, code);
	if heals_state_p = null () then signal cleanup;
	code = 0;
	log_code = 0;
	if arg_info.from_time > arg_info.to_time then do;
	  code = error_table_$bad_arg;
	  call com_err_ (code, "heals_collect_data_", "the time range for data processing is incompatible.");
	  return;
	end;
	slu_statusp = addr (slu_status);
	call syserr_log_util_$status (slu_statusp, log_code);
	if log_code ^= 0 then do;
	  call com_err_ (log_code, "heals_collect_data_", "error while obtaining syserr_log status.");
	  code = error_table_$not_attached;
	  return;
	end;
	syserr_msgp = addr (input_record);
	heals_message_p = addr (output_record);
	on condition (record_quota_overflow) begin;
	  call com_err_ (0, "heals_collect_data_",
	    "There is not enough quota on the directory containing the heals log to permit its extention.");
	  call syserr_log_util_$close (log_code);
	  arg_info.err_nb = -1;
	  go to ret;
	end;

open_syserr_log:
	call syserr_log_util_$open (open_status, log_code);
	if log_code ^= 0 then do;
	  if log_code = error_table_$not_closed then do;
	    call syserr_log_util_$close (log_code);
	    go to open_syserr_log;
	  end;
	  if open_status = "0"b then
	    call com_err_ (log_code, "heals_collect_data_", "error while opening syserr_log");
	  else go to syserr_log_is_open;		/* we have something */
	  go to early_return;
	end;
syserr_log_is_open:
	if substr (open_status, 1, 2) ^= "11"b then
	  call com_err_ (0, "heals_collect_data_",
	  "part of the syserr_log is unavailable, processing will continue with the available part.");
	call syserr_log_util_$search
	  (arg_info.from_time, rtime, rseq, log_code);
	if log_code ^= 0 then do;
	  call com_err_ (log_code, "heals_collect_data_", "could not read syserr_log.");
early_return:
	  arg_info.err_nb = 1;
	  call syserr_log_util_$close (log_code);
	  code = log_code;
	  return;
	end;

	if rseq < heals_state.last_message_seq_num |
	rtime < heals_state.last_message_time then do;
	  query_info.status_code = 0;			/* init */
get_answer: call command_query_ (qip, answer, "heals_collect_data_",
	    "The syserr_log may have been reinitialized,
   do you want to continue copying messages?	");
	  if substr (answer, 1, 3) = "yes" then go to continue_to_copy;
	  else go to early_return;
	end;

	if rseq < heals_state.last_message_seq_num then
	  call ioa_
	  ("the syserr_log may have been reinitialized after seq_num ^d; copying continues.",
	  last_message_seq_num);

continue_to_copy:
	call datap -> arg_info.iocbp -> iocb.open (
	  datap -> arg_info.iocbp, (keyed_sequential_output), "0"b, code);
	if code ^= 0 then
	  if code = error_table_$file_busy then do;
	    call com_err_ (code, "heals_collect_data_", "The permanent heals log is being updated.");
	    call syserr_log_util_$close (log_code);
	    return;
	  end;
	  else do;
	    call syserr_log_util_$close (log_code);
	    return;
	  end;


copy_data: begin;
%include io_syserr_msg;
dcl  message_length fixed bin (21);
dcl  copy_this_one bit (1) aligned;
copy_loop:  do while ("1"b);
	    call syserr_log_util_$read
	      (addr (input_record), size (input_record), message_length, log_code);
	    if log_code ^= 0 then
	      if log_code ^= error_table_$end_of_info then do;
	        call com_err_ (log_code, "heals_collect_data_", "error while reading syserr_log.");
	        call syserr_log_util_$close (code);
	        return;
	      end;
	      else go to finish;
	    else;
	    if syserr_msg.time > arg_info.to_time then go to finish;
	    if syserr_msg.time >= arg_info.from_time then do;
	      copy_this_one, ioi_type, disk_type, rcp_type,
	        bulk_type, mos_type, cpu_type, dn355_type, iom_type = "0"b;
	      if io_data | sorted_io_data then do;
	        if index (syserr_msg.text, "RCP:") > 0 then rcp_type = "1"b;
	        else if index (syserr_msg.text, "dn355:") > 0 then dn355_type = "1"b;
	        else if index (syserr_msg.text, "iom_manager:") > 0 then iom_type = "1"b;
	        else if index (syserr_msg.text, "ioi_") > 0 then ioi_type = "1"b;
	        else if index (syserr_msg.text, "ocdcm_:") > 0 then ioi_type = "1"b;
	        io_msgp = addr (syserr_msg.data (1));
	      end;
	      if cpu_data then
	        if index (syserr_msg.text, "hardware_fault:") > 0 then do;
		cpu_type = "1"b;			/* a cpu record of some sort */
	        end;
	      if mos_edac_data then
	        if index (syserr_msg.text, "mos_memory_check:") > 0 then do;
		mos_type = "1"b;
	        end;
	      if disk_data then
	        if index (syserr_msg.text, "disk_control") > 0 then do;
		disk_type = "1"b;
	        end;
	      if bulk_data then
	        if index (syserr_msg.text, "bulk_store_control:") > 0 then do;
		bulk_type = "1"b;
	        end;

have_rec_type:
	      if first_record then do;
	        first_record = "0"b;
	        buffering = "0"b;
	        last_message_copied = "0"b;

/* initialize this first heals_message for later comparison with syserr_msg values */
	        heals_message.data_size = syserr_msg.data_size;
	        heals_message.text_len = syserr_msg.text_len;
	        unspec (heals_message.rest_of_record) = ""b; /* zero every field out */
	        heals_message.text = "";
	        heals_message.data (*) = ""b;
	        heals_message.tally = 0;
	        m_len = message_length * 4 +4;
	      end;
	      if cpu_type | ioi_type | bulk_type | disk_type | dn355_type | mos_type | iom_type | rcp_type
	      then copy_this_one = "1"b;
	      if copy_this_one then
	        if last_message_copied then do;


/* check for message tallying */
		if syserr_msg.text = heals_message.text then
		  if syserr_msg.data_size = heals_message.data_size then do;
		    if ioi_type then
		      if (substr (unspec (heals_message.data), 1, 30) ||
		      substr (unspec (heals_message.data), 37, 72)) =
		      (substr (unspec (syserr_msg.data), 1, 30) ||
		      substr (unspec (syserr_msg.data), 37, 72)) then do;
		        heals_message.tally =
			heals_message.tally + bin (count, 6, 0) + 1;
		        go to keep_text;
		      end;
		      else;
		    else if unspec (heals_message.data) =
		    unspec (syserr_msg.data) then do;	/* compare octal data for similarity */
		      heals_message.tally = heals_message.tally + 1;
		      go to keep_text;
		    end;
		  end;
		  else;
		else;

/* must not be similar to last record */
		if buffering then call copy_message;	/* write old rec */
		if ioi_type then heals_message.tally =
		  bin (count, 6, 0) + 1;
		else heals_message.tally = 1;
		m_len = message_length * 4 +4;
		heals_message.seq_num = syserr_msg.seq_num;
		heals_message.time = syserr_msg.time;
		heals_message.code = syserr_msg.code;
		heals_message.data_size = syserr_msg.data_size;
		heals_message.text_len = syserr_msg.text_len;
		heals_message.data (*) = syserr_msg.data (*);
		heals_message.text = syserr_msg.text;
keep_text:
		buffering = "1"b;
		last_message_copied = "1"b;
		last_msg_tallied = syserr_msg.seq_num;
		last_msg_tallied_time = syserr_msg.time;
	        end;				/* end of last_message_copied being true */
	        else do;				/* last_message_copied was false */
		if buffering then
		  call copy_message;
		buffering = "1"b;
		heals_message.data_size = syserr_msg.data_size; /* because of refer option */
		heals_message.text_len = syserr_msg.text_len; /* because of refer option */
		heals_message.rest_of_record = syserr_msg;
		m_len = message_length * 4 +4;
		if ioi_type then heals_message.tally = bin (count, 6, 0) + 1;
		else heals_message.tally = 1;
		last_message_copied = "1"b;
	        end;				/* end of last_message_copied being false */
	      else do;				/* copy_this_one is false */
	        last_message_copied = "0"b;
	        last_msg_tallied = syserr_msg.seq_num;
	        last_msg_tallied_time = syserr_msg.time;
	        if buffering then do;
		call copy_message;
		buffering = "0"b;
	        end;
	      end;
	    end;
	  end copy_loop;
	end copy_data;
finish:
	if arg_info.err_nb = 0 then
	  if buffering then
	    call copy_message;
	if no_of_recs_copied > 0 then
	  call ioa_
	  ("^5x^d message^v(s^) copied into:^/^a",
	  no_of_recs_copied, bin (no_of_recs_copied > 1, 1, 0),
	  before (arg_info.heals_log_path_name, " "));
	call datap -> arg_info.iocbp -> iocb.close (
	  datap -> arg_info.iocbp, code);
	call syserr_log_util_$close (code);
	if code ^= 0 then
ret:	  return;
	arg_info.err_nb = 0;			/* indicate satisfactory return */
	return;

/* proc to copy heals messages. */
copy_message: proc;
dcl  based_key char (8) based (addr (heals_message.time));
dcl  key char (256) varying;
	  key = based_key;				/* for seek_key operation */
	  call arg_info.iocbp -> iocb.seek_key
	    (arg_info.iocbp, key, 0, code);
	  if code = error_table_$no_record then do;
	    call arg_info.iocbp -> iocb.write_record (arg_info.iocbp,
	      heals_message_p, m_len, code);
	    if code = 0 then do;
	      no_of_recs_copied = no_of_recs_copied + 1;
	      heals_state.last_message_seq_num = last_msg_tallied;
	      heals_state.last_message_time = last_msg_tallied_time;
	    end;
	    else do;
	      call com_err_
	        (code, "heals_collect_data_",
	        "error writing record ^d into heals_log.", heals_message.seq_num);
copy_error:
	      arg_info.err_nb = -1;
	      go to finish;
	    end;
	  end;
	  else if code ^= error_table_$key_order
	  then do;				/* bad code from seek_key operation above. */
	    call com_err_ (code, "heals_collect_data_", "could not create a key for message ^d.",
	      heals_message.seq_num);
	    go to copy_error;
	  end;
	  heals_message.tally = 0;			/* reset it */
	  if heals_message.data_size > 0 then
	    heals_message.data (*) = "0"b;
	  return;
	end copy_message;
        end heals_collect_data_;




		    heals_cpu_reports_.pl1          09/27/84  0748.5rew 09/27/84  0745.2       60345



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */

/* Coded March 1976 by A. Downing.
   This routine is responsible for printing heals cpu error messages that
   are found in the heals log. */
/* Modified 11-82 by F. W. Martinson to fix bugs in report column alignment
   and pointer register reporting */
heals_cpu_reports_: proc (datap, code);
%include heals_arg_info;
%include syserr_message;
%include heals_message;
%include mc;/*mc for machine conditions.*/
dcl  datap ptr;
dcl  code fixed bin (35);
dcl  bin_clock fixed bin (71) init (clock_ ());
dcl  runtime char (16) init ("");
dcl						/* declare temporary registers */
     index_regs (0:7) bit (36) aligned,			/* actually each index fits in right half */
     exponent_register bit (36) aligned,		/* put in right end of word */
     timer_register bit (36) aligned,			/* put in right end */
     fault_reg bit (36) aligned,
     ralr bit (36) aligned;				/* 3 last bits for ring alarm reg */
dcl  hist_reg (0:127) bit (36) aligned based (hist_reg_ptr);
dcl (i, j) fixed bin;
dcl  hist_reg_ptr ptr init (null ());
dcl 1 arg_info aligned based (datap) like heals_arg_info;
dcl  error_table_$end_of_info ext static fixed bin (35);
dcl  error_table_$long_record ext static fixed bin (35);
dcl  title char (132) varying int static aligned init
    ("^-cpu_error report for Multics system ^a.");
dcl (time1, time2) char (16);
dcl  dummy_p (8) ptr aligned,
     even_word_buf fixed bin (71) aligned dim (8) based;
dcl  buffer char (2048) aligned;
dcl  buf_p ptr init (null ());
dcl  buf_len fixed bin (21);
dcl  act_len fixed bin (21);
dcl  clock_ entry returns (fixed bin (71));
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  com_err_ entry options (variable);
dcl  ioa_$ioa_switch entry options (variable);
dcl  iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35));
dcl  iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl  iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
dcl  iox_$close entry (ptr, fixed bin (35));
dcl  iox_$detach_iocb entry (ptr, fixed bin (35));
dcl  hran_$hranl entry (ptr, ptr, bit (1));
dcl  hran_$hrlgnd entry (ptr);
dcl (addr, addrel, index, null) builtin;
dcl  cleanup condition;
dcl  cpu_fault_count fixed bin (21) init (0);

	call date_time_ (bin_clock, runtime);
	buf_p, heals_message_p = addr (buffer);
	buf_len = length (buffer);
	syserr_msgp = addr (heals_message.rest_of_record);
	arg_info.err_nb = 0;
	on cleanup begin;
	     arg_info.err_nb = -1;
	     call clean_up;
	end;
	if arg_info.report_iocbp = null () then do;
	     arg_info.err_nb = -1;
	     call com_err_ (0, "heals_cpu_reports_",
		"the report stream is not open.");
	     return;
	end;
	call date_time_ ((arg_info.from_time), time1);
	call date_time_ ((arg_info.to_time), time2);
	call ioa_$ioa_switch (arg_info.report_iocbp,
	     "^|CPU_ERROR_REPORT:^8xfrom^x^16a^7xto^x^16a
HEALS RUN OF ^16a ON SYSTEM ^a^3/",
	     time1, time2, runtime, arg_info.system_id);
	do while ("1"b);
	     call iox_$read_record (arg_info.iocbp,
		buf_p, buf_len, act_len, code);
	     if code ^= 0 then
		if code = error_table_$end_of_info then go to copying_done;
		else do;
		     if code = error_table_$long_record then
			arg_info.err_nb = 16;
		     else arg_info.err_nb = -1;
		     call clean_up;
		     return;
		end;
	     else;
	     if heals_message.time > arg_info.to_time then go to copying_done; /* finished */
	     if index (heals_message.text, "hardware_fault:") > 0 then do;
		unspec (addr (dummy_p) -> even_word_buf) = unspec (heals_message.data);
		mcp = addr (heals_message.data (1));
		hist_reg_ptr = addrel (mcp, size (mc)); /* point at history register data */
		if cpu_fault_count = 0 then
		     call hran_$hrlgnd (arg_info.report_iocbp);
		call date_time_ ((heals_message.time), time1);
		call ioa_$ioa_switch (arg_info.report_iocbp,
		     "^|syserr sequence #^d, at ^a;", heals_message.seq_num, time1);
		call ioa_$ioa_switch (arg_info.report_iocbp,
		     "syserr_log text: ^a", heals_message.text);
		call ioa_$ioa_switch (arg_info.report_iocbp,
		     "^/scu_data:^2-^x^2(^4(^w^x^)^/^2-^x^)", mc.scu);
		call ioa_$ioa_switch (arg_info.report_iocbp,
		     "pointer registers:^1-^x^2(^4(^12p^2x^)^/^2-^x^)", dummy_p);

/* copy register data into aligned fields */
		index_regs (*) = ""b;
		exponent_register, timer_register, ralr = ""b;
		substr (index_regs (*), 19, 18) = mc.x (*); /* copy */
		substr (exponent_register, 29, 8) = mc.e; /* copy */
		substr (timer_register, 10, 27) = mc.t; /* copy */
		substr (ralr, 34, 3) = mc.ralr;	/* copy */
		fault_reg = mc.fault_reg;		/* copy */
						/* data copied into aligned fields for ioa_ */

		call ioa_$ioa_switch (arg_info.report_iocbp,
		     "index registers:^1-^x^2(^4(^6w^x^)^/^2-^x^)", index_regs);
		call ioa_$ioa_switch (arg_info.report_iocbp,
		     "^/a: ^w q: ^w  exp: ^3w timer: ^9w ring_alarm: ^1w",
		     mc.a, mc.q, exponent_register, timer_register, ralr);
		call ioa_$ioa_switch (arg_info.report_iocbp,
		     "^/eis_info:^2-^x^2(^4(^w^x^)^/^2-^x^)", mc.eis_info);
		call ioa_$ioa_switch (arg_info.report_iocbp,
		     "fault register:^1-^1x^w", fault_reg);
		call ioa_$ioa_switch (arg_info.report_iocbp, "^/NUM^-OU registers^2-^7xCU registers");
		j = 0;
		do i = 0 by 2 to 30;
		     j = j+1;
		     call ioa_$ioa_switch (arg_info.report_iocbp, "^o^-^w ^w^12x^w ^w",
			j, hist_reg (i), hist_reg (i+1),
			hist_reg (i+32), hist_reg (i+33));
		end;
		call ioa_$ioa_switch (arg_info.report_iocbp, "^/NUM^-DU registers^3-AU registers");
		do i = 64 by 2 to 94;
		     j = j+1;
		     call ioa_$ioa_switch (arg_info.report_iocbp, "^o^-^w ^w^12x^w ^w",
			j-16, hist_reg (i), hist_reg (i+1),
			hist_reg (i+32), hist_reg (i+33));
		end;
		call ioa_$ioa_switch (arg_info.report_iocbp, "");
		call hran_$hranl (hist_reg_ptr, arg_info.report_iocbp, "0"b);
		cpu_fault_count = cpu_fault_count + 1;
	     end;					/* end of copying onc fault record */
	end;					/* end of while loop */
copying_done:
	arg_info.err_nb = 0;
	if cpu_fault_count = 0 then
	     call ioa_$ioa_switch (arg_info.report_iocbp,
	     "^/^-NO CPU FAULTS FOUND DURING SPECIFIED TIME RANGE.");
	call ioa_$ioa_switch (arg_info.report_iocbp,
	     "^/END: CPU_ERROR_REPORT");
	call clean_up;

clean_up:	proc;
	     if arg_info.iocbp ^= null () then
		call iox_$close (arg_info.iocbp, code);
	     return;
	end clean_up;
	return;
     end heals_cpu_reports_;




		    heals_gen_ioerr_log_.pl1        09/27/84  0748.5rew 09/27/84  0744.1      295911



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
heals_gen_ioerr_log_: proc (heals_arg_info_p, heals_ior_args_p, r_code);

/* ******************************************************************************
   *								*
   *  Comments:							*
   *								*
   *	Written by RH Morrison  Nov. 19, 1976	 			*
   *	Last modified by A. Downing 01/14/77
   *								*
   ****************************************************************************** */
/* FF */
/* ********	DECLARATIONS	******** */

/* ****	PROCEDURE ARGUMENTS   **** */
dcl  heals_arg_info_p ptr;
dcl  heals_ior_args_p ptr;
dcl  r_code fixed bin (35);

/* ****	EXTERNAL STATIC	**** */
dcl  error_table_$end_of_info ext static fixed bin (35);

/* ****	ENTRIES		**** */
dcl  ioa_ entry options (variable);
dcl  com_err_ entry options (variable);
dcl  clock_ entry returns (fixed bin (71));
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  cv_oct_ entry (char (*)) returns (fixed bin (35));
dcl  ioa_$rsnnl entry options (variable);
dcl  iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35));
dcl  iox_$close entry (ptr, fixed bin (35));
dcl  iox_$detach_iocb entry (ptr, fixed bin (35));
dcl  iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl  iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
dcl  iox_$write_record entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl  vfile_$vfile_attach entry (ptr, (*) char (*) varying, bit (1) aligned, fixed bin (35));

/* ****	POINTERS		**** */
dcl  flags_p ptr init (null);
dcl  work_p1 ptr init (null);
dcl  outsw_p ptr init (null);
dcl  sortsw_p ptr init (null);
dcl  inbuf_p ptr init (null);
dcl  sort_desc_p (3) ptr init (null, null, null);
dcl  tape_nfo_p ptr init (null);
dcl  sort_data_p ptr init (null);
dcl  syserr_nfo_p ptr init (null);
dcl  dev_data_p ptr init (null);
						/*   Arguments  */
dcl  insw_p ptr init (null);


/* pointers declared in include files:
*/

/* ****	CHARACTER STRING VARIABLES    **** */
dcl  rprt_from_time char (16);
dcl  rprt_to_time char (16);
dcl  work_time char (16);
dcl  ascii_status char (12);
dcl  record_name char (13);
dcl  work_ch1 char (1);
dcl  inbuf char (inbuf_len) aligned;
dcl  ioi_buf char (outbuf_len) aligned;
dcl  bad_rec_buf char (outbuf_len) aligned;
dcl  disk_buf char (outbuf_len) aligned;
dcl  misc_buf char (outbuf_len) aligned;
dcl  pic_w pic "99";
dcl  bad_name char (7);
dcl  dev_nm_chk char (4);
dcl  dev_data_space char (1540);
dcl  n_a char (3) init ("N/A");
dcl  date_time char (16);
dcl  date char (8);
dcl  time char (6);

/*   Arguments  */
dcl  whoami char (20) init ("heals_gen_ioerr_log_");
dcl  version_date char (8) init ("12/15/76");
dcl  vfile_info (1) char (168) varying;

/* ****	ARITHMETIC VARIABLES    **** */
dcl  dev_data_stopper fixed bin based (dev_data_p);
dcl  inbuf_len fixed bin (21) int static init (1024);
dcl  outbuf_len fixed bin (21) int static init (1024);
dcl  stream_in fixed bin init (1);
dcl  stream_out fixed bin init (2);
dcl  seq_in fixed bin init (4);
dcl  seq_out fixed bin init (5);
dcl  status_nb fixed bin (35);
dcl  i_code fixed bin (35);
dcl  nb_ioerr_recs fixed bin;
dcl  ioerr_rec_min_len fixed bin (21);
dcl  dev_data_size fixed bin;
dcl (i, j, k, l) fixed bin;
dcl  ndx fixed bin (24);
dcl  offs_ndx fixed bin;
dcl  ss fixed bin;
dcl  page_nb fixed bin;
dcl  iom_nb_chk fixed bin (3);
dcl  ch_nb_chk fixed bin (6);
dcl  dev_nb_chk fixed bin (6);
dcl  fake_data_size fixed bin;
dcl  save_size fixed bin;

/*   Arguments  */
dcl  code fixed bin (35);
dcl  inrec_len fixed bin (21);
dcl  outrec_len fixed bin (21);

dcl  version_nb fixed bin init (1);
dcl  clock_time fixed bin (71);

/* ****	BIT STRING VARIABLES    **** */
/*   Working  */
dcl  unused bit (1) aligned init ("0"b);
dcl  flags_word bit (36) aligned init ("0"b);
dcl  found bit (1) aligned;
dcl  rec_hdr bit (180) based;

/* ****	ARRAY VARIABLES		**** */
dcl  ntrpt_nm_list (0:7) char (1) aligned init (
     "", "o", "x", "t", "x", "m", "x", "s");

dcl 1 tape_nfo_ar (1:max_iom_nb_a) aligned,
    2 tape_entry (0:max_tape_nb_a) like tape_nfo;

dcl  fake_data (2) bit (36) aligned init (
    (36)"0"b,
    (36)"0"b);


/* ***	BASED VARIABLES   *** */
dcl 1 flags aligned based (flags_p),
    (2 trace bit (1),
    2 db bit (1),
    2 io_error bit (1),
    2 sorted_io_error bit (1),
    2 hdrs bit (1),
    2 msg bit (1),
    2 disk_hold bit (1),
    2 disk_addr bit (1)
     ) unal;

dcl 1 tape_nfo aligned based (tape_nfo_p),
    (2 rsn char (7),
    2 dens char (4),
    2 tracks char (2),
    2 ring char (2))unal;

dcl 1 dev_data aligned based (dev_data_p),
    2 dev_name char (4) aligned,
    2 used bit (1) aligned,
    2 ch_nmbr fixed bin (6) aligned,
    (2 fill1 bit (11),
    2 dev_nmbr fixed bin (6),
    2 fill2 bit (14),
    2 iom_nmbr fixed bin (3)) unal,
    2 saved_data (2) bit (36) aligned;

dcl 1 ch_nfo_ar (1:max_iom_nb_a) aligned based (ch_nfo_ar_p),
    2 ch_entry (0:max_ch_nb_a) like ch_nfo;

/*   Arguments  */
dcl 1 arg_info like heals_arg_info aligned based (heals_arg_info_p);

/* ****	MISC. DECLARATIONS		**** */
dcl (addr, addrel, index, null, search, size, substr, unspec, verify) builtin;
dcl  cleanup condition;
dcl  conversion condition;

/* FF */
/* ****	INCLUDE FILES	**** */
%include heals_arg_info;
%include heals_io_report_args;
%include heals_ioerr_rec;
%include heals_message;
%include io_syserr_msg;
%include iom_stat;
%include iocb;
/* *******	END OF DECLARATIONS	******* */
/* FF */
/* ********	PROCEDURE		******** */

/* ****	Procedure Initialization	**** */

	on cleanup call clean_up;

/*  Init returns.  */
	r_code = 0;

/*  Init pointers.  */
	flags_p = addr (flags_word);
	insw_p = arg_info.iocbp;
	inbuf_p = addr (inbuf);
	outsw_p = ioerr_log_sw_p;
	heals_message_p = addr (inbuf);

/*  Init procedure constants.  */
	ioerr_rec_min_len = size (ioerr_rec) * 4;	/* ioerr_rec is output record */
	dev_data_size = size (dev_data);		/* size of entry for saving binary data */
	fake_data_size = size (fake_data);		/* fake data is used when no real data exists */

/*  Init all else.  */
	code = 0;
	arg_info.err_nb = 0;
	call date_time_ (arg_info.from_time, rprt_from_time); /* args to heals_report */
	call date_time_ (arg_info.to_time, rprt_to_time);
	nb_ioerr_recs = 0;				/* init output record count */

	ioerr_rec_p = addr (bad_rec_buf);		/* init ioerr_rec buffers */
	ioerr_rec.data_size = 0;
	rprt_flags = "0"b;
	ioerr_rec_p = addr (disk_buf);
	ioerr_rec.data_size = 0;
	rprt_flags = "0"b;
	ioerr_rec_p = addr (ioi_buf);
	ioerr_rec.data_size = 0;
	rprt_flags = "0"b;
	ioerr_rec_p = addr (misc_buf);
	ioerr_rec.data_size = 0;
	rprt_flags = "0"b;

	dev_data_p = addr (dev_data_space);		/* init saved data array */
	dev_data_stopper = -1;			/* set stopper in first entry */
	dev_data.used = "0"b;			/* set first entry unused */
	dev_data_p = addrel (dev_data_p, 64*dev_data_size); /* bump pointer to end of dev_data_space */
	dev_data_stopper = -1;			/* set stopper at end of dev_data_space */

	do i = 1 to max_iom_nb_a;			/* init tape_nfo_ar */
	  do j = 0 to max_tape_nb_a;
	    tape_nfo_p = addr (tape_nfo_ar.tape_entry (i, j));
	    tape_nfo = ".";				/* init data */
	  end;
	end;


/* ****	End Procedure Initialization    **** */

/*  Run information.  */
	clock_time = clock_ ();
	call date_time_ (clock_time, date_time);
	date = substr (date_time, 1, 8);
	time = substr (date_time, 11, 6);
	if flags.trace
	| ior_flags.trace
	then call ioa_ ("^a run info: date ^a, time ^a, version ^d of ^a.",
	  whoami, date, time, version_nb, version_date);

/* ****	Build ioerr_rec and write it to heals_ioerr_log.  **** */

/*  Open heals_ioerr_log file (output).  */
	call iox_$open (outsw_p, seq_out, unused, code);
	if code ^= 0 then call proc_err (13);

	on conversion begin;			/* report error on output report */
	  ioerr_rec_p = addr (bad_rec_buf);		/* assign output buffer */
	  msg_len = 72;
	  call ioa_$rsnnl (
	    "HEALS: conversion condition raised while processing this ^a record.",
	    ioerr_rec.msg, i, record_name);
	  msg_len = i;
	  flags.msg = "1"b;
	  rprt_flags.msg = "1"b;
	  call write_ioerr_rec;
	  go to next_log_rec;			/* keep going */
	end;

/*  Read first heals_log record.  */
	call iox_$read_record (insw_p, inbuf_p, inbuf_len, inrec_len, code);
	if code ^= 0
	then if code = error_table_$end_of_info
	  then goto ineof_1;
	  else call proc_err (17);
	goto rec_id;

/* **	Record processing loop.	** */
next_log_rec:
	call iox_$read_record (insw_p, inbuf_p, inbuf_len, inrec_len, code);
	if code ^= 0
	then if code = error_table_$end_of_info		/* normal loop exit, case 1 */
	  then goto ineof_1;
	  else call proc_err (14);

/*  Identify record type.  */
rec_id:
	record_name = "next";			/* reset record name */
	if heals_message.time > arg_info.to_time then goto ineof_1; /* exit, case 2 */
	if substr (heals_message.text, 1, 4) = "RCP:" then goto rcp_rec;
	if substr (heals_message.text, 1, 8) = "ioi_mask" then goto ioi_rec;
	if substr (heals_message.text, 1, 7) = "ocdcm_:" then goto ioi_rec;
	if substr (heals_message.text, 1, 12) = "disk_control" then goto disk_rec;
	if substr (heals_message.text, 1, 4) = "bulk" then goto bulk_rec;
	if substr (heals_message.text, 1, 6) = "dn355:" then goto dn355_rec;
	goto next_log_rec;				/* no record of interest */

/* ****	Process "RCP": records.   * *** */
rcp_rec:
	record_name = "RCP:";
	iom_nb_chk = 1;				/* arbitrary since not included in RCP: records */
	if index (heals_message.text, " tap") > 0 then
	  go to tape_recs;
	goto next_log_rec;				/* all other RCP: records */

tape_recs:
	offs_ndx = index (heals_message.text, " tap") + 6;	/* get  tape number from text */
	dev_nb_chk = bin (substr (heals_message.text, offs_ndx, 2), 6, 0);
	if dev_nb_chk < 0 | dev_nb_chk > max_tape_nb_a	/* within tape_nfo_ar bounds */
	then do; bad_name = "device";			/* nope */
	  goto bad_rcp_rec;
	end;
	tape_nfo_p = addr (tape_nfo_ar.tape_entry (iom_nb_chk, dev_nb_chk)); /* set entry pointer */

	if index (heals_message.text, "Attached tap") ^= 0 then goto attach_rec;
	if index (heals_message.text, "Note (tap") ^= 0 then goto note_rec;
	if index (heals_message.text, "Mount Reel") ^= 0 then goto mount_rec;
	if index (heals_message.text, "Remount Reel") ^= 0 then goto mount_rec;
	goto next_log_rec;				/* all other tape records */

attach_rec:
	tape_nfo = "?";				/* overwrite old values */
	goto next_log_rec;

note_rec:
	ndx = index (heals_message.text, "den=");	/* determine density */
	if ndx ^= 0
	then do; work_ch1 = substr (heals_message.text, ndx + 7, 1);
	  i = verify (work_ch1, "0123456789");
	  if i = 0
	  then tape_nfo.dens = substr (heals_message.text, ndx + 4, 4);
	  else tape_nfo.dens = substr (heals_message.text, ndx + 4, 3);
	end;
	else tape_nfo.dens = "dflt";			/* density not specified */

	if index (heals_message.text, "7track") ^= 0	/* determine number of tracks */
	then tape_nfo.tracks = " 7";
	else if index (heals_message.text, "9track") ^= 0
	then tape_nfo.tracks = " 9";
	else tape_nfo.tracks = "df";			/* tracks not specified */
	goto next_log_rec;

mount_rec:
	if index (heals_message.text, "without") ^= 0	/* determine if write ring */
	then tape_nfo.ring = "no";
	else if index (heals_message.text, "with") ^= 0
	then tape_nfo.ring = "ys";
	else tape_nfo.ring = "df";			/* ring not specified */

	ndx = index (heals_message.text, "Reel") + 5;	/* tape serial number or name */
	offs_ndx = index (substr (heals_message.text, ndx), " ");
	if offs_ndx ^> 1
	then do; bad_name = "text";			/* something is wrong */
	  goto bad_rcp_rec;
	end;
	if offs_ndx > 8
	then tape_nfo.rsn = substr (heals_message.text, ndx, 7);
	else tape_nfo.rsn = substr (heals_message.text, ndx, offs_ndx - 1);

	if tape_nfo.dens = "?" then tape_nfo.dens = "dflt"; /* if no Note recored */
	if tape_nfo.tracks = "?" then tape_nfo.tracks = "df"; /* ditto */
	goto next_log_rec;

bad_rcp_rec:
	ioerr_rec_p = addr (bad_rec_buf);
	ioerr_rec.data_size = 0;			/* force use of fake data */
	call load_sort_data;
	dev_nm_chk = dev_nm;
	call get_iom_ch_nb;
	dev_nb = dev_nb_chk;
	goto bad_rec;


/* ****	Process "ioi_interrupt" records.	**** */
ioi_rec:
	record_name = "ioi_";
	io_msgp = addr (heals_message.data);		/* records have binary data */
	call convert_channame_kludge (io_msg.channel, iom_nb_chk, ch_nb_chk);
	if iom_nb_chk < 1 | iom_nb_chk > max_iom_nb_a	/* within bounds */
	then do; bad_name = "iom";			/* nope */
	  dev_nm_chk = "????";			/* fake it */
	  goto bad_ioi_rec;
	end;
	if ch_nb_chk < 0 | ch_nb_chk > max_ch_nb_a
	then do; bad_name = "channel";
	  dev_nm_chk = "????";
	  goto bad_ioi_rec;
	end;
	if io_msg.time_out
	then dev_nm_chk = "chnl";
	else do;
	  ch_nfo_p = addr (ch_nfo_ar.ch_entry (iom_nb_chk, ch_nb_chk));
	  if heals_message.data_size = 3
	  then dev_nm_chk = devname;
	  else if ch_nfo.i_set
	  then dev_nm_chk = ch_nfo.dev_nam;
	  else do; bad_name = "ch_unkn";		/* usually if system was reconfigured */
	    dev_nm_chk = "????";			/* ^ between time of error and time of HEALS run */
	    goto bad_ioi_rec;
	  end;
	end;
	if substr (dev_nm_chk, 1, 3) = "tap" then do;
	  dev_nb_chk = bin (io_msg.device, 6, 0);
	  if dev_nb_chk < 0 | dev_nb_chk > max_tape_nb_a
	  then do; bad_name = "device";
	    goto bad_ioi_rec;
	  end;
	end;
	ioerr_rec_p = addr (ioi_buf);			/* looks good - assign output buffer */
	call move_syserr_nfo;			/* move info from heals_log record to ioerr_rec */
	call load_sort_data;			/* fill in ioerr_rec.sort_data from binary data */

/* Specific device info.  */

/* Channel timeout. */
	if io_msg.time_out
	then do; dev_nm = "chnl";			/* as good a name as any */
	  dev_model = 9999;				/* dummy model number */
	  ioerr_rec.tape_disk_nfo = "";		/* null tape,disk info fields */
	  tapno_diskad = "timeout";			/* use this column to say what happened */
	  goto write_ioi_rec;
	end;

/* All other devices. */
	dev_nm = dev_nm_chk;
	if ch_nfo.i_set
	then dev_model = ch_nfo.model;
	else dev_model = 9999;
	if substr (dev_nm, 1, 3) = "tap" then
	  goto tape_err;
	if substr (dev_nm, 1, 3) = "prt" then goto ur_err;
	if substr (dev_nm, 1, 3) = "rdr" then goto ur_err;
	if substr (dev_nm, 1, 3) = "pun" then goto ur_err;
	if substr (dev_nm, 1, 3) = "dsk" then goto disk_err;
	if substr (dev_nm, 1, 3) = "opc" then goto ur_err;
	bad_name = "dv_unkn";			/* just in case */
	dev_nm_chk = dev_nm;			/* report what it was */
	goto bad_ioi_rec;

tape_err:
	tape_nfo_p = addr (tape_nfo_ar.tape_entry (iom_nb, dev_nb));
	tapno_diskad = tape_nfo.rsn;			/* retrieve data from RCP: records */
	dens_cyl = tape_nfo.dens;
	tracks_sector = tape_nfo.tracks;
	ring_head = tape_nfo.ring;
	goto write_ioi_rec;

disk_err:
	ioerr_rec.tape_disk_nfo = "";			/* null until more info is logged */
	tapno_diskad = "disk IO";			/* note it is user IO, not disk_control: */
	goto write_ioi_rec;

ur_err:
	ioerr_rec.tape_disk_nfo = "";
	tapno_diskad = n_a;				/* say it is not applicable */
	goto write_ioi_rec;

write_ioi_rec:
	rprt_flags.ioerr = "1"b;
	call write_ioerr_rec;
	goto next_log_rec;

bad_ioi_rec:
	ioerr_rec_p = addr (bad_rec_buf);
	ioerr_rec.data_size = heals_message.data_size;	/* use binary data in ioi_interrupt records */
	call load_sort_data;
	goto bad_rec;

/* ****	Process "disk_control:" records.   * *** */
disk_rec:
	record_name = "disk_control:";
	ioerr_rec_p = addr (disk_buf);
	if index (heals_message.text, "Lost IOM") ^= 0 then goto iom_rec;
	if index (heals_message.text, "Unex") ^= 0 then goto iom_rec;
	if index (heals_message.text, "(iom") ^= 0 then goto disk_stat_rtrn;
	if index (heals_message.text, "detail") ^= 0 then goto disk_detail;
	if index (heals_message.text, "sect=") ^= 0 then goto disk_addr;
	goto next_log_rec;

iom_rec:
	ndx = index (heals_message.text, "iom");
	iom_nb_chk = bin (substr (heals_message.text, ndx + 4, 1)); /* get iom number */
	ndx = index (heals_message.text, "dsk");
	dev_nm_chk = substr (heals_message.text, ndx, 4); /* get device name */
	offs_ndx = index (substr (heals_message.text, ndx + 5), " ");
	if offs_ndx > 1
	then dev_nb_chk = bin (substr (heals_message.text, ndx + 5, offs_ndx - 1)); /* device number */
	else do; dev_nb_chk = 0;			/* something is wrong */
	  goto bad_disk_rec;
	end;
	ndx = index (heals_message.text, "chan");
	offs_ndx = index (substr (heals_message.text, ndx +5), ")");
	if offs_ndx = 2
	then ch_nb_chk = bin (substr (heals_message.text, ndx+5, 1)); /* single digit number */
	else if offs_ndx = 3
	then ch_nb_chk = bin (substr (heals_message.text, ndx+6, 1)) +
	  bin (substr (heals_message.text, ndx+5, 1))*8;	/* change from octal to decimal */
	else goto bad_disk_rec;
	if flags.disk_hold				/* if holding data in buffer */
	then do; call save_data;			/* then save it */
	  flags.disk_hold = "0"b;			/* reset flag */
	end;
	call move_syserr_nfo;			/* build ioerr_rec */
	call load_sort_data;
	iom_nb = iom_nb_chk;
	ch_nb = ch_nb_chk;
	dev_nb = dev_nb_chk;
	dev_nm = dev_nm_chk;
	tape_disk_nfo = "";
	msg_len = 38;
	ndx = index (heals_message.text, "Lost");
	if ndx ^= 0 then ioerr_rec.msg = substr (heals_message.text, ndx, 18);
	else do; ndx = index (heals_message.text, "IOM");
	  if ndx ^= 0 then ioerr_rec.msg = substr (heals_message.text, ndx, 35);
	  else ioerr_rec.msg = "";
	end;
	flags.msg = "1"b;
	rprt_flags.iom_rec = "1"b;			/* set format flag */
	goto write_disk_rec;			/* write the ioerr_rec record */

disk_stat_rtrn:
	if flags.disk_hold
	then call save_data;			/* save the data being held */
	else flags.disk_hold = "1"b;			/* hold the new data */
	call move_syserr_nfo;			/* build ioerr_rec */
	call load_sort_data;
	if heals_message.data_size = 3
	then dev_nm = devname;
	else do; ndx = index (heals_message.text, "dsk");
	  dev_nm = substr (heals_message.text, ndx, 4);
	end;
	if index (heals_message.text, "sect=") = 0
	then tape_disk_nfo = "";
	else do;
	  flags.disk_hold = "0"b;
	  ndx = index (heals_message.text, "sect=");	/* get continuous address */
	  offs_ndx = index (substr (heals_message.text, ndx), ",");
	  if offs_ndx ^> 6 then goto bad_disk_rec;
	  tapno_diskad = substr (heals_message.text, ndx + 5, offs_ndx - 6); /* number in ascii */
	  do while (search (tapno_diskad, " ") > 0);
	    tapno_diskad = "0" || tapno_diskad;		/* Eliminate blanks */
	  end;
	  i = bin (substr (heals_message.text, ndx + 5, offs_ndx - 6)); /* number in binary */

	  ndx = index (heals_message.text, "cyl=");	/* get cylinder number */
	  offs_ndx = index (substr (heals_message.text, ndx), ",");
	  if offs_ndx ^> 5 then goto bad_disk_rec;
	  dens_cyl = substr (heals_message.text, ndx +4, offs_ndx - 5);
	  j = bin (substr (heals_message.text, ndx + 4, offs_ndx - 5));

	  ndx = index (heals_message.text, "hd=");	/* get head number */
	  offs_ndx = index (substr (heals_message.text, ndx), ",");
	  if offs_ndx ^> 4 then goto bad_disk_rec;
	  ring_head = substr (heals_message.text, ndx +3, offs_ndx -4);
	  k = bin (substr (heals_message.text, ndx + 3, offs_ndx -4));

	  l = i - j*760 - k*40;			/* get sector number */
	  pic_w = l;
	  tracks_sector = pic_w;
	end;

	if index (heals_message.text, "detail") = 0
	then rprt_flags.ioerr = "1"b;			/* set the format flag */
	else do;
	  ndx = index (heals_message.text, "status:") + 8; /* get extended status text */
	  msg_len = text_len - ndx +12;
	  ioerr_rec.msg = "extended: (" || substr (heals_message.text, ndx, text_len-ndx) || ")";
						/* reformat it */
	  flags.msg = "1"b;				/* ioerr_rec contains a message */
	  rprt_flags.diskerr = "1"b;			/* report line format */
	end;

	goto write_disk_rec;

disk_detail:
	ndx = index (heals_message.text, "dsk");
	dev_nm_chk = substr (heals_message.text, ndx, 4);
	offs_ndx = index (substr (heals_message.text, ndx + 5), " ");
	if offs_ndx > 1
	then dev_nb_chk = bin (substr (heals_message.text, ndx + 5, offs_ndx - 1));
	else do; dev_nb_chk = 0;			/* something is wrong */
	  goto bad_disk_rec;
	end;
	call move_syserr_nfo;			/* does not change dev_nb, dev_nm, or binary data */
	ioerr_rec.data_size = save_size;		/* restore previous size */
	if dev_nm ^= dev_nm_chk | dev_nb ^= dev_nb_chk | dev_cmnd = "000000"b
	then do;					/* data in buffer not for this device */
	  if flags.disk_hold then call save_data;	/* save the binary data */
	  call retrieve_data;
	  if i_code = 0 then dev_data.used = "0"b;	/* reset so that space can be re-used */
	  call load_sort_data;
	  if i_code ^= 0				/* fake data was used */
	  then do; call get_iom_ch_nb;
	    dev_nb = dev_nb_chk;			/* overwrite fake_data */
	  end;
	  dev_nm = dev_nm_chk;
	end;
	flags.disk_hold = "0"b;			/* reset flag */
	ndx = index (heals_message.text, "status:") + 8;	/* get extended status text */
	msg_len = text_len - ndx +12;
	ioerr_rec.msg = "extended: (" || substr (heals_message.text, ndx, text_len-ndx) || ")";
						/* reformat it */
	flags.msg = "1"b;				/* ioerr_rec contains a message */
	rprt_flags.ext_stat = "1"b;			/* report line format */
	goto write_disk_rec;

disk_addr:
	ndx = index (heals_message.text, "dsk");
	dev_nm_chk = substr (heals_message.text, ndx, 4);
	offs_ndx = index (substr (heals_message.text, ndx + 5), " ");
	if offs_ndx > 1
	then dev_nb_chk = bin (substr (heals_message.text, ndx + 5, offs_ndx - 1));
	else do; dev_nb_chk = 0;			/* something is wrong */
	  goto bad_disk_rec;
	end;
	call move_syserr_nfo;			/* does not change dev_nb, dev_nm, or binary data */
	ioerr_rec.data_size = save_size;		/* restore previous size */
	if dev_nm ^= dev_nm_chk | dev_nb ^= dev_nb_chk | dev_cmnd = "000000"b
	then do;					/* data in buffer not for this device */
	  if flags.disk_hold
	  then do; flags.disk_hold = "0"b;
	    call save_data;
	  end;
	  call retrieve_data;
	  call load_sort_data;
	  if i_code ^= 0				/* fake data was used */
	  then do; call get_iom_ch_nb;
	    dev_nb = dev_nb_chk;			/* overwrite fake_data */
	  end;
	  dev_nm = dev_nm_chk;
	end;
	ndx = index (heals_message.text, "sect=");	/* get continuous address */
	offs_ndx = index (substr (heals_message.text, ndx), ",");
	if offs_ndx ^> 6 then goto bad_disk_rec;
	tapno_diskad = substr (heals_message.text, ndx + 5, offs_ndx - 6);
	do while (search (tapno_diskad, " ") > 0);
	  tapno_diskad = "0" || tapno_diskad;		/* Eliminate blanks */
	end;
	i = bin (substr (heals_message.text, ndx + 5, offs_ndx - 6));

	ndx = index (heals_message.text, "cyl=");	/* get cylinder number */
	offs_ndx = index (substr (heals_message.text, ndx), ",");
	if offs_ndx ^> 5 then goto bad_disk_rec;
	dens_cyl = substr (heals_message.text, ndx +4, offs_ndx - 5);
	j = bin (substr (heals_message.text, ndx + 4, offs_ndx - 5));

	ndx = index (heals_message.text, "hd=");	/* get head number */
	offs_ndx = index (substr (heals_message.text, ndx), ",");
	if offs_ndx ^> 4 then goto bad_disk_rec;
	ring_head = substr (heals_message.text, ndx +3, offs_ndx -4);
	k = bin (substr (heals_message.text, ndx + 3, offs_ndx -4));

	l = i - j*760 - k*40;			/* get sector number */
	pic_w = l;
	tracks_sector = pic_w;
	rprt_flags.disk_addr = "1"b;			/* report line format */
	goto write_disk_rec;

write_disk_rec:
	call write_ioerr_rec;
	goto next_log_rec;

bad_disk_rec:
	ioerr_rec_p = addr (bad_rec_buf);
	bad_name = "text";
	ioerr_rec.data_size = 0;			/* force fake data */
	call load_sort_data;
	call get_iom_ch_nb;
	goto bad_rec;

/* ****	Process miscellaneous record types.	* *** */

bulk_rec:						/* not an IO error, but nowhere else to put it */
	record_name = "bulk";
	ioerr_rec_p = addr (misc_buf);		/* assign output buffer */
	call move_syserr_nfo;
	call load_sort_data;
	dev_nb = bulk_port;				/* port number is  used for device number */
	dev_nm = "bulk";
	ioerr_rec.msg_len = heals_message.text_len;
	ioerr_rec.msg = heals_message.text;		/* print the syserr_log text */
	flags.msg = "1"b;
	rprt_flags.bulk = "1"b;
	call write_ioerr_rec;
	goto next_log_rec;

dn355_rec:
	if index (heals_message.text, "status") = 0 then goto next_log_rec;
	record_name = "dn355";
	ioerr_rec_p = addr (misc_buf);
	call move_syserr_nfo;
	ndx = index (heals_message.text, ":");
	dev_nm = "355" || substr (heals_message.text, ndx +6, 1);
	ioerr_rec.data_size = 2;
	ioerr_rec.data = fake_data;
	ndx = index (heals_message.text, "status");
	ascii_status = substr (heals_message.text, ndx +7, 6)
	  || substr (heals_message.text, ndx +14, 6);
	status_nb = cv_oct_ (ascii_status);
	ioerr_rec.data (2) = unspec (status_nb);
	call load_sort_data;
	dev_nm_chk = dev_nm;
	call get_iom_ch_nb;
	dev_nb = 1;
	ioerr_rec.tape_disk_nfo = "";
	tapno_diskad = n_a;
	rprt_flags.ioerr = "1"b;
	call write_ioerr_rec;
	goto next_log_rec;

bad_rec:
	call move_syserr_nfo;			/* build ioerr_rec */
	if ioerr_rec.data_size = 0
	then ioerr_rec.data_size = save_size;		/* restore previous size */
	dev_nm = dev_nm_chk;
	msg_len = 38;
	if bad_name = "text"			/* something wrong in extracting from text */
	then call ioa_$rsnnl (
	  "HEALS: error in extracting from text",
	  ioerr_rec.msg, i);
	else if bad_name = "ch_unkn" | bad_name = "dv_unkn" /* probably config change */
	then do; if bad_name = "ch_unkn"
	  then bad_name = "channel";
	  else bad_name = "device";
	  call ioa_$rsnnl (
	    "HEALS: ^a not in config_table.",
	    ioerr_rec.msg, i, bad_name);
	end;
	else call ioa_$rsnnl (
	  "HEALS: ^a number is out of range.",
	  ioerr_rec.msg, i, bad_name);		/* out of array bounds */
	msg_len = i;
	flags.msg = "1"b;
	rprt_flags.bad_rec = "1"b;
	call write_ioerr_rec;
	goto next_log_rec;

ineof_1:						/* end of file on heals_log */
	revert conversion;
	if nb_ioerr_recs = 0 then do; ior_flags.no_recs = "1"b; /* possibly there are no error recs */
	end;
	call iox_$close (ioerr_log_sw_p, code);
	if code ^= 0 then call proc_err (7);

/*  Writing of heals_ioerr_log file completed.  */

/* FF  */


	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
	/*									*/
	/* The following procedure is a no-no.  Ideally, there would be a system procedure to do	*/
	/* what it does, or heals should just use the string provided in io_msg.  What it does	*/
	/* is take a string and convert it to iom number and channel number.  If the string is	*/
	/* unconvertible, it sets these values to -1.  It is up to the caller to detect this	*/
	/* problem.								*/
	/*									*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

convert_channame_kludge: proc (chanid, iom, chan);

   dcl chanid char (8) aligned;
   dcl iom fixed bin (3);
   dcl chan fixed bin (6);

     iom = index ("ABCD", substr (chanid, 1, 1));
     if iom < 1 then goto bad_name;
     if verify (rtrim (substr (chanid, 2)), "0123456789") ^= 0 then goto bad_name;
     chan = binary (substr (chanid, 2), 7);
     return;

bad_name:
     iom, chan = -1;				/* assume failure */
     return;

     end convert_channame_kludge;

write_ioerr_rec: proc;
	  if initiate				/* initiate interrupt */
	  then do;				/* get rid of flags */
	    if tapno_diskad = "?" then tapno_diskad = "";
	    if ring_head = "?" then ring_head = "";
	    if dens_cyl = "?" then dens_cyl = "";
	    if tracks_sector = "?" then tracks_sector = "";
	  end;

	  nb_ioerr_recs = nb_ioerr_recs + 1;		/* keep count of records written */
	  outrec_len = ioerr_rec_min_len + ioerr_rec.data_size * 4; /* account for data size */
	  if flags.msg then outrec_len = outrec_len + msg_len; /* account for message length */
	  call iox_$write_record (outsw_p, ioerr_rec_p, outrec_len, code);
	  if code ^= 0 then call proc_err (15);
	  flags.msg = "0"b;				/* reset flags */
	  rprt_flags = "0"b;
	  return;
	end write_ioerr_rec;


	return;

move_syserr_nfo: proc;
	  syserr_nfo_p = addr (ioerr_rec.syserr_nfo);	/* set pointer into current buffer */
	  save_size = ioerr_rec.data_size;		/* save the data size in order to reload it */
	  syserr_nfo_p -> rec_hdr = heals_message_p -> rec_hdr; /* move data from heals_log record */
	  ioerr_rec.msg_len = 0;			/* usually no message in ioerr_rec */
	  if ioerr_rec.data_size ^= 0			/* now equal to heals_message.data_size */
	  then ioerr_rec.data = heals_message.data;	/* move the new data */

	  call date_time_ ((heals_message.time), work_time); /* convert syserr_log time */
	  sort_date = substr (work_time, 1, 8);		/* fill in ioerr_rec.sort_rec */
	  log_time = substr (work_time, 11, 6);
	  return;
	end move_syserr_nfo;

load_sort_data: proc;
	  i_code = 0;
	  if ioerr_rec.data_size = 0			/* if no data */
	  then do; ioerr_rec.data_size = fake_data_size;	/* then fake it */
	    ioerr_rec.data = fake_data;
	    i_code = 1;				/* fake data used  */
	  end;

	  io_msgp = addr (ioerr_rec.data);		/* fill in ioerr_rec.sort_rec */
	  statp = addr (io_msg.status);
	  call convert_channame_kludge (io_msg.channel, iom_nb_chk, ch_nb_chk);
	  iom_nb = iom_nb_chk;
	  ch_nb = ch_nb_chk;
	  dev_nb = bin (io_msg.device);
	  dev_cmnd = io_msg.command;
	  ss = bin (io_msg.level);
	  ntrpt_nm = ntrpt_nm_list (ss);

	  power_off = power;
	  maj_st = "00"b || major;
	  sub_st = sub;
	  ntrpt_no = initiate;			/* initiate interrupt */
	  if initiate then ntrpt_nm = "i";
	  iom_st = channel_stat || central_stat;
	  rec_cnt_res = rcount;
	  return;
	end load_sort_data;

get_iom_ch_nb: proc;				/* get iom and channel number for device name */
	  i_code = 0;
	  found = "0"b;
	  do i = 1 to max_iom_nb_a while (^found);
	    do j = 0 to max_ch_nb_a while (^found);
	      if ch_nfo_ar.ch_entry.dev_nam (i, j) = dev_nm_chk
	      then do;
	        iom_nb = i;
	        ch_nb = j;
	        found = "1"b;
	      end;
	    end;
	  end;

	  if ^found then i_code = 1;			/* did not find entry for device name */
	  return;
	end get_iom_ch_nb;

save_data: proc;					/* save ioerr_rec data for future use */
	  i_code = 0;
	  found = "0"b;
	  if ioerr_rec.data_size = 0			/* should not happen */
	  then do; i_code = 1;
	    return;
	  end;
	  if ioerr_rec.data_size ^= 2 then ioerr_rec.data_size = 2;

/* Search for entry by device address to overwrite unused old data. */
	  dev_data_p = addr (dev_data_space);
	  do while (dev_data_stopper ^= -1 & ^found);
	    if ch_nb = ch_nmbr
	    then if dev_nb = dev_nmbr
	      then if iom_nb = iom_nmbr
	        then do;				/* matched with old entry */
		saved_data = ioerr_rec.data;
		dev_name = dev_nm;
		dev_data.used = "1"b;
		found = "1"b;
	        end;
	    if ^found then dev_data_p = addrel (dev_data_p, dev_data_size); /* to next entry */
	  end;

/* Search for unused entry. */
	  if ^found then do;
	    dev_data_p = addr (dev_data_space);
	    i = 0;				/* initialize count */
	    do while (dev_data_stopper ^= -1 & ^found);
	      i = i +1;				/* count number of entries */
	      if ^dev_data.used then found = "1"b;;	/* found one */
	      if ^found then dev_data_p = addrel (dev_data_p, dev_data_size); /* to next entry */
	    end;					/* didn't find one */
	  end;

	  if ^found then if i <= 64			/* do not go beyond assigned space */
	    then do;
	      work_p1 = addrel (dev_data_p, dev_data_size); /* set stopper in next entry */
	      work_p1 -> dev_data_stopper = -1;
	      found = "1"b;
	    end;
	    else i_code = 1;			/* data not saved  */

	  if found then do;				/* unused or new entry */
	    ch_nmbr = ch_nb;
	    dev_nmbr = dev_nb;
	    iom_nmbr = iom_nb;
	    dev_name = dev_nm;
	    saved_data = ioerr_rec.data;
	    dev_data.used = "1"b;
	  end;
	  return;
	end save_data;

retrieve_data: proc;				/* retrive previously saved data */
	  i_code = 0;
	  dev_data_p = addr (dev_data_space);		/* initialize pointer */
	  found = "0"b;
	  do while (dev_data_stopper ^= -1 & ^found);
	    if dev_nm_chk = dev_name			/* search by device name and number */
	    then if dev_nb_chk = dev_nmbr
	      then do;
	        iom_nb = iom_nmbr;			/* move info to ioerr_rec */
	        ch_nb = ch_nmbr;
	        ioerr_rec.data_size = 2;
	        ioerr_rec.data = saved_data;
	        found = "1"b;
	      end;
	    if ^found then dev_data_p = addrel (dev_data_p, dev_data_size); /* to next entry */
	  end;
	  if ^found then do; i_code = 1;		/* no entry found */
	    ioerr_rec.data_size = 0;			/* set data size to 0 as a flag */
	  end;
	  return;
	end retrieve_data;

/* FF */
proc_err:	proc (proc_err_nb);
dcl  proc_err_nb fixed bin;
	  r_code = code;
	  call com_err_ (code, whoami, "Procedure error number = ^d.", proc_err_nb);
	  call clean_up;
	  goto err_return;
	end proc_err;

clean_up:	proc;
	  if sortsw_p ^= null ()
	  then do; if sortsw_p -> iocb.open_descrip_ptr ^= null ()
	    then call sortsw_p -> iocb.close (sortsw_p, code);
	    if sortsw_p -> iocb.attach_descrip_ptr ^= null ()
	    then call sortsw_p -> iocb.detach_iocb (sortsw_p, code);
	  end;
	  return;
	end clean_up;

err_return: return;


        end heals_gen_ioerr_log_;




		    heals_io_report_gen_.pl1        09/27/84  0748.5rew 09/27/84  0745.2       76743



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
heals_io_report_gen_: proc (heals_arg_info_p, heals_ior_args_p, r_code);

/* ******************************************************************************
   *								*
   *  Comments:							*
   *								*
   *	Written by RH Morrison  Dec. 1, 1976	 			*
   *	Last modified by RH Morrison  01/03/77				*
   *								*
   ****************************************************************************** */

/* FF */
/* ********	DECLARATIONS	******** */

/* ****	PROCEDURE ARGUMENTS   **** */

dcl  heals_arg_info_p ptr;
dcl  heals_ior_args_p ptr;
dcl  r_code fixed bin (35);

/* ****	EXTERNAL STATIC	**** */

dcl  error_table_$end_of_info ext static fixed bin (35);

/* ****	ENTRIES		**** */

dcl  ioa_ entry options (variable);
dcl  ioa_$ioa_switch entry options (variable);
dcl  clock_ entry returns (fixed bin (71));
dcl  com_err_ entry options (variable);
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  iox_$close entry (ptr, fixed bin (35));
dcl  iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl  iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));

/* ****	POINTERS		**** */
dcl  flags_p ptr init (null);
dcl  work_p1 ptr init (null);

/*   Arguments  */
dcl  inbuf_p ptr init (null);
dcl  insw_p ptr init (null);
dcl  outsw_p ptr init (null);

/* Pointers declared elsewhere:
   ior_flags_p
   ior_parms_p
   ch_nfo_p
   ior_avars_p
   ioerr_rec_p
   io_msgp
   statp
   */

/* ****	CHARACTER STRING VARIABLES    **** */
dcl  inbuf char (inbuf_len) aligned;
dcl  rprt_from_time char (16);
dcl  rprt_to_time char (16);
dcl  old_date char (8);
dcl  date char (8);
dcl  time char (6);
dcl  date_time char (16);
dcl  ch_nr pic "99";
dcl  dev_nr pic "99";

/*   Arguments  */
dcl  whoami char (20) init ("heals_io_report_gen_");
dcl  version_date char (8) init ("12/15/76");

/* ****	ARITHMETIC VARIABLES    **** */
dcl  clock_time fixed bin (71);
dcl  line_cnt fixed bin;
dcl  max_line_cnt fixed bin;
dcl  page_nb fixed bin;

/*   Arguments  */
dcl  code fixed bin (35);
dcl  version_nb fixed bin init (1);
dcl  inrec_len fixed bin (21);
dcl  inbuf_len fixed bin (21) int static init (1024);
dcl  seq_in fixed bin int static init (4);

/* ****	BIT STRING VARIABLES    **** */
dcl  flags_word bit (36) aligned;
dcl  eof bit (1) aligned;

/*   Arguments  */
dcl  unused bit (1) aligned int static init ("0"b);

/* ****	BASED VARIABLES   **** */
dcl 1 flags aligned based (flags_p),
    (2 trace bit (1),
    2 db bit (1),
    2 hdrs bit (1),
    2 no_recs bit (1),
    2 fill (1)
     ) unal;

dcl 1 arg_info like heals_arg_info aligned based (heals_arg_info_p);

/* ****	MISC. DECLARATIONS		**** */

dcl (addr, fixed, null, substr) builtin;
dcl  cleanup condition;

/* FF */
/* ****	INCLUDE FILES	**** */
%include heals_arg_info;
%include heals_io_report_args;
%include heals_ioerr_rec;
%include io_syserr_msg;
%include iom_stat;
/* ****	END OF DECLARATIONS   **** */
/* FF */
/* ********	PROCEDURE		******** */

/* ****	Procedure Initialization	**** */

	on cleanup call clean_up;

/*  Init returns.  */
	r_code = 0;
	arg_info.err_nb = 0;

/*  Init pointers.  */
	flags_p = addr (flags_word);
	insw_p = ioerr_log_sw_p;
	outsw_p = arg_info.report_iocbp;
	inbuf_p = addr (inbuf);
	ioerr_rec_p = addr (inbuf);
	io_msgp = addr (ioerr_rec.data);
	statp = addr (io_msg.status);

/*  Init control flags.  */
	flags_word = "0"b;
	flags.hdrs = "1"b;
	flags.no_recs = ior_flags.no_recs;
	eof = "0"b;

/*  Init all else.  */

	code = 0;
	old_date = "";
	page_nb = 0;
	line_cnt = 0;
	max_line_cnt = max_line_cnt_a;
	call date_time_ (arg_info.from_time, rprt_from_time);
	call date_time_ (arg_info.to_time, rprt_to_time);

/* ****	End Procedure Initialization    **** */

/*  Run information.  */
	clock_time = clock_ ();
	call date_time_ (clock_time, date_time);
	date = substr (date_time, 1, 8);
	time = substr (date_time, 11, 6);
	if flags.trace
	| ior_flags.trace
	then call ioa_ ("^a run info: date ^a, time ^a, version ^d of ^a.",
	  whoami, date, time, version_nb, version_date);

/*  Open heals_ioerr_log file and read first record.  */
	if ^flags.no_recs
	then do;
	  call iox_$open (insw_p, seq_in, unused, code);
	  if code ^= 0 then call proc_err (30);
	  call iox_$read_record (insw_p, inbuf_p, inbuf_len, inrec_len, code);
	  if code ^= 0
	  then if code = error_table_$end_of_info
	    then flags.no_recs = "1"b;
	    else call proc_err (35);
	end;

/*  Record processing loop.  */
io_report_line_loop:
	do while (^eof);
	  if flags.hdrs
	  then do; page_nb = page_nb + 1;
	    line_cnt = 5;
	    call ioa_$ioa_switch (outsw_p,
	      "^|IO_ERROR_REPORT:^x^a^xTO^x^a^12xPAGE^x^2d^/",
	      rprt_from_time, rprt_to_time, page_nb);

	    call ioa_$ioa_switch (outsw_p,
	      "S_Y_S_E_R_R_____L_O_G_^3x_____D_E_V_I_C_E_____^3xS_T_A_T_U_S__^3xTLY^3xTAPE_NO^2xSTATUS_RETURN
TIME   NUMBER^3xNAME I-CC-DD CM^3xMJ-SB-I^9xDISK_AD");

	    if flags.no_recs then eof = "1"b;
	  end;

/* Write date line. */
	  if ^eof
	  then do; if sort_date ^= old_date | flags.hdrs	/* write date line after headers */
	    then do; old_date = sort_date;
	      flags.hdrs = "0"b;
	      line_cnt = line_cnt + 4;
	      call ioa_$ioa_switch (outsw_p, "^/^72(_^)^/DATE:^x^a^vxDATE:^x^a^/",
	        sort_date, 44, sort_date);
	    end;

	    ch_nr = fixed (ch_nb);			/* pad one digit numbers on left */
	    dev_nr = fixed (dev_nb);

/*  Write io_error report line.  */
	    line_cnt = line_cnt + 1;

	    if rprt_flags.ioerr
	    then call ioa_$ioa_switch (outsw_p,
	      "^6a^x^6d^3x^4a^x^1d-^2a-^2a^x^2.3b^3x^2.3b-^2.3b-^1a^3x^3d^3x^7a^3x^w",
	      log_time, seq_nb, dev_nm, iom_nb, ch_nr, dev_nr, dev_cmnd, maj_st, sub_st, ntrpt_nm,
	      tally_nb, tapno_diskad, io_msg.status);

	    else if rprt_flags.diskerr
	    then do; call ioa_$ioa_switch (outsw_p,
	        "^6a^x^6d^3x^4a^x^1d-^2a-^2a^x^2.3b^3x^2.3b-^2.3b-^1a^3x^3d^3x^7a^3x^w^/^34x^a",
	        log_time, seq_nb, dev_nm, iom_nb, ch_nr, dev_nr, dev_cmnd, maj_st, sub_st, ntrpt_nm,
	        tally_nb, tapno_diskad, io_msg.status, ioerr_rec.msg);
	      line_cnt = line_cnt + 1;
	    end;

	    else if rprt_flags.disk_addr
	    then call ioa_$ioa_switch (outsw_p,
	      "^6a^x^6d^3x^4a^x^1d-^2a-^2a^x^2.3b^19x^7a",
	      log_time, seq_nb, dev_nm, iom_nb, ch_nr, dev_nr, dev_cmnd, tapno_diskad);

	    else if rprt_flags.ext_stat | rprt_flags.iom_rec
	    then call ioa_$ioa_switch (outsw_p,
	      "^6a^x^6d^3x^4a^x^1d-^2a-^2a^x^2.3b^3x^a",
	      log_time, seq_nb, dev_nm, iom_nb, ch_nr, dev_nr, dev_cmnd, ioerr_rec.msg);

	    else if rprt_flags.msg
	    then call ioa_$ioa_switch (outsw_p, "^a", ioerr_rec.msg);

	    else if rprt_flags.bulk
	    then call ioa_$ioa_switch (outsw_p,
	      "^6a^x^6d^3x^a",
	      log_time, seq_nb, ioerr_rec.msg);

	    else if rprt_flags.bad_rec
	    then call ioa_$ioa_switch (outsw_p,
	      "^6a^x^6d^3x^4a^x^1d-^2a-^2a^6x^a",
	      log_time, seq_nb, dev_nm, iom_nb, ch_nr, dev_nr, ioerr_rec.msg);

/* Read next ioerr_log record. */
	    call iox_$read_record (insw_p, inbuf_p, inbuf_len, inrec_len, code);
	    if code ^= 0
	    then if code = error_table_$end_of_info
	      then eof = "1"b;
	      else call proc_err (32);

/*  Date change.  */
	    if sort_date ^= old_date
	    then if line_cnt > max_line_cnt - 10	/* too near bottom of page */
	      then flags.hdrs = "1"b;			/* so start new page */

	  end;

	  if line_cnt > max_line_cnt
	  then flags.hdrs = "1"b;
	end io_report_line_loop;

/* end of file on heals_ioerr_log */
	if flags.no_recs
	then call ioa_$ioa_switch (outsw_p,
	  "^/^11xThere were no io_errors during the report period.");
	call ioa_$ioa_switch (outsw_p,
	  "^/END: IO_ERROR_REPORT");
	if ^flags.no_recs
	then do; call iox_$close (ioerr_log_sw_p, code);
	  if code ^= 0 then call proc_err (33);
	end;
	return;

/* FF */
proc_err:	proc (proc_err_nb);
dcl  proc_err_nb fixed bin;
	  r_code = code;
	  arg_info.err_nb = proc_err_nb;
	  call com_err_ (code, whoami, "Procedure error number = ^d.", proc_err_nb);
	  call clean_up;
	  goto err_return;
	end proc_err;

clean_up:	proc;
	  call iox_$close (ioerr_log_sw_p, code);
	  return;
	end clean_up;

err_return: return;

        end heals_io_report_gen_;




		    heals_io_reports_.pl1           09/27/84  0748.5rew 09/27/84  0745.2       89199



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
heals_io_reports_: proc (heals_arg_info_p, r_code);	/* (ptr, fixed bin (35)) */

/* ******************************************************************************
   *								*
   *  This procedure processes syserr_log messages for HEALS and generates	*
   *  one or more of the following HEALS reports:				*
   *  	io_error_report						*
   *	sorted_io_error_report					*
   *								*
   *  The procedure reads  heals_log records (which are selected and modified	*
   *  syserr_log records), converts binary data to ascii, processes the data,	*
   *  and writes the processed records to heals_ioerr_log.			*
   *								*
   *  For each report type, the heals_ioerr_log records are read, sorted,	*
   *  summmarized, and the report formatted and written to a print file.	*
   *								*
   *	Written by RH Morrison  Feb. 18, 1976	 			*
   *	Last modified by RH Morrison  01/03/77				*
   *								*
   ****************************************************************************** */

/* FF  */
/* ********	DECLARATIONS	******** */


/* ****	PROCEDURE ARGUMENTS   **** */
dcl  heals_arg_info_p pointer;
dcl  r_code fixed bin (35);


/* ****	EXTERNAL STATIC	**** */
dcl  error_table_$noarg ext static fixed bin (35);


/* ****	ENTRIES		**** */
dcl  ioa_ entry options (variable);
dcl  ioa_$ioa_switch entry options (variable);
dcl  iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35));
dcl  iox_$detach_iocb entry (ptr, fixed bin (35));
dcl  delete_$path entry (char (*), char (*), bit (6), char (*), fixed bin (35));
dcl  iox_$close entry (ptr, fixed bin (35));
dcl  get_pdir_ entry returns (char (168));
dcl  heals_scan_config_ entry (ptr, fixed bin (35));
dcl  heals_gen_ioerr_log_ entry (ptr, ptr, fixed bin (35));
dcl  com_err_ entry options (variable);
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  clock_ entry returns (fixed bin (71));
dcl  heals_io_report_gen_ entry (ptr, ptr, fixed bin (35));
dcl  heals_sorted_report_gen_ entry (ptr, ptr, fixed bin (35));
dcl  heals_media_sort_gen_ entry (ptr, ptr, fixed bin (35));


/* ****	POINTERS		**** */
dcl  flags_p ptr init (null);

/*   Arguments  */
dcl  heals_ior_args_p ptr init (null);
dcl  ch_nfo_ar_p ptr init (null);
dcl  outsw_p ptr init (null);
dcl 1 real_p aligned like ior_ptrs;

/* pointers declared elsewhere:
   heals_arg_info_p
   ior_flags_p
   ior_prms_p
   ch-nfo_ar_p
   ioerr_log_sw_p
   ch_nf_p
*/


/* ****	CONTROL VARIABLES   **** */
/*  Parameters  */
dcl  whoami char (17) int static init ("heals_io_reports_");
dcl  version_date char (8) init ("12/15/76");
dcl  version_nb fixed bin init (2);
dcl  max_iom_nb fixed bin int static init (4);
dcl  max_ch_nb fixed bin int static init (63);
dcl  max_tape_nb fixed bin int static init (16);
dcl  max_line_cnt fixed bin int static init (58);

/*  Flags  */
dcl 1 flags aligned based (flags_p),
    (2 trace bit (1),
    2 db bit (1),
    2 io_error bit (1),
    2 sorted_io_error bit (1),
    2 media_rprt bit (1),
    2 fill bit (1)
     ) unal;

dcl  io_rprt bit (1) unal defined arg_info.info_selection pos (1);
dcl  mpc_data bit (1) unal defined arg_info.info_selection pos (2);
dcl  cpu_data bit (1) unal defined arg_info.info_selection pos (3);
dcl  mos_edac_data bit (1) unal defined arg_info.info_selection pos (4);
dcl  sorted_io_rprt bit (1) unal defined arg_info.info_selection pos (5);
dcl  media_data bit (1) unal defined arg_info.info_selection pos (8);

/*  Arguments  */
dcl 1 real_ior_prms aligned like ior_prms;


/* ****	CHARACTER STRING VARIABLES    **** */
dcl  date char (8);
dcl  time char (6);

/*   Arguments  */
dcl  date_time char (16);
dcl  ioerr_log_sw char (12) int static init ("ioerr_log_sw");


/* ****	ARITHMETIC VARIABLES    **** */
dcl  ch_nr pic "99";
dcl (i, j) fixed bin;

/*   Arguments  */
dcl  code fixed bin (35);
dcl  clock_time fixed bin (71);
dcl 1 real_ior_avars aligned like ior_avars;


/* ****	BIT STRING VARIABLES    **** */
dcl  flags_word bit (36) aligned init ("0"b);

/*   Arguments  */
dcl  dl_sws bit (6) int static init ("100100"b);
dcl  ior_flags_word bit (36) aligned;


/* ****	ARRAY VARIABLES		**** */
dcl 1 ch_nfo_ar (1:max_iom_nb) aligned,
    2 ch_entry (0:max_ch_nb) like ch_nfo;


/* ****	BASED   **** */

/*   Arguments  */
dcl 1 arg_info like heals_arg_info aligned based (heals_arg_info_p);


/* ****	MISC. DECLARATIONS		**** */
dcl (addr, before, null, substr) builtin;
dcl  cleanup condition;

/* FF */

/* ****	INCLUDE FILES	**** */
%include heals_arg_info;
%include heals_io_report_args;
%include iocb;

/* ********	END OF DECLARATIONS 	******** */

/* FF */
/* ********	PROCEDURE		******** */

/* ****	Procedure Initialization	**** */

	on cleanup call clean_up;

/*  Init returns.  */
	r_code = 0;

/*  Init pointers.  */
	flags_p = addr (flags_word);
	heals_ior_args_p = addr (real_p);

/*  Init heals_ior_args pointers.  */
	real_p.ior_flags_p = addr (ior_flags_word);
	real_p.ior_prms_p = addr (real_ior_prms);
	real_p.ch_nfo_ar_p = addr (ch_nfo_ar);
	real_p.ioerr_log_sw_p = null ();
	real_p.ior_avars_p = addr (real_ior_avars);

/*  Init flags.  */
	ior_flags_word = "0"b;
	if io_rprt then flags.io_error = "1"b;		/* flag for io_error_report */
	if sorted_io_rprt then flags.sorted_io_error = "1"b; /* flag for sorted_io_error_report */
	if media_data then flags.media_rprt = "1"b;
	if ^flags.io_error & ^flags.sorted_io_error & ^flags.media_rprt
	then do;					/* then return with error code */
	  arg_info.err_nb = 11;
	  r_code = error_table_$noarg;
	  return;
	end;
	if trace_sw then flags.trace = "1"b;
	else flags.trace = "0"b;
	ior_flags.trace = flags.trace;

/*  Init heals_ior_args parameters.  */
	ior_prms.max_iom_nb_a = max_iom_nb;
	ior_prms.max_ch_nb_a = max_ch_nb;
	ior_prms.max_tape_nb_a = max_tape_nb;
	ior_prms.max_line_cnt_a = max_line_cnt;

/*  Init all else.  */
	arg_info.err_nb = 0;

/* ****	End Procedure Initialization    **** */

/*  Run information.  */
	clock_time = clock_ ();
	call date_time_ (clock_time, date_time);
	date = substr (date_time, 1, 8);
	time = substr (date_time, 11, 6);
	if flags.trace
	then call ioa_ ("^a run info: date ^a, time ^a, version ^d of ^a.",
	  whoami, date, time, version_nb, version_date);

/*  Set iom, channel, and device data.  */
	call heals_scan_config_ (heals_ior_args_p, code);
	if code ^= 0 then call proc_err (19);

/* ****	Generate HEALS io reports.   * *** */

/*  Attach heals_ioerr_log file  */
	call iox_$attach_ioname (ioerr_log_sw, real_p.ioerr_log_sw_p, "vfile_ " ||
	  before (get_pdir_ (), " ") || ">heals_ioerr_log", code);
	if code ^= 0 then call proc_err (12);

	call heals_gen_ioerr_log_ (heals_arg_info_p, heals_ior_args_p, code);
	if code ^= 0 then call proc_err (18);

/*  Set output switch pointer to heals_reports switch pointer.  */
	if arg_info.report_iocbp = null () then call proc_err (21);
	outsw_p = arg_info.report_iocbp;

/*  Print configuration table.  */
	if ^ior_flags.no_recs
	then do;
	  call ioa_$ioa_switch (outsw_p,
	    "^vxCHANNEL ASSIGNMENT TABLE AT TIME OF HEALS RUN
^vxRUN DATE: ^a^vxRUN TIME: ^a,
^vxSYSTEM_ID:^x^13a^2xSITE_ID:^x^a^/",
	    13, 13, date, 1, time,
	    13, arg_info.system_id, arg_info.installation_id);

	  call ioa_$ioa_switch (outsw_p,
	    "^13xIOM^8xCHNL^9xDEVICE^10xMODEL
^13xNUM^9xNUM^11xNAME^9xNUMBER^/");

	  do i = 1 to max_iom_nb;			/* run through ch_nfo_ar */
	    do j = 0 to max_ch_nb;
	      ch_nfo_p = addr (ch_nfo_ar.ch_entry (i, j));
	      if ch_nfo.i_set
	      then do; ch_nr = j;
	        if ch_nfo.model = 9999		/* dummy model number */
	        then call ioa_$ioa_switch (outsw_p,
		"^15x^1d^10x^2a^11x^4a",
		i, ch_nr, ch_nfo.dev_nam);
	        else call ioa_$ioa_switch (outsw_p,
		"^15x^1d^10x^2a^11x^4a^11x^d",
		i, ch_nr, ch_nfo.dev_nam, ch_nfo.model);
	      end;
	    end;
	  end;
	  call ioa_$ioa_switch (outsw_p, "^|");
	end;

/*  Select reports.  */
	if flags.io_error
	then call heals_io_report_gen_ (heals_arg_info_p, heals_ior_args_p, code);
	if code ^= 0 then call proc_err (29);
	if flags.sorted_io_error
	then call heals_sorted_report_gen_ (heals_arg_info_p, heals_ior_args_p, code);
	if code ^= 0 then call proc_err (28);
	if flags.media_rprt
	then call heals_media_sort_gen_ (heals_arg_info_p, heals_ior_args_p, code);
						/*  Clean up and return to heals_report.  */
	call clean_up;
	return;					/* all done, normal return */

/* FF  */
proc_err:	proc (proc_err_nb);
dcl  proc_err_nb fixed bin;
	  r_code = code;				/* return error code */
	  arg_info.err_nb = proc_err_nb;		/* return unique proc_err number */
	  call com_err_ (code, whoami, "Procedure error number = ^d.", proc_err_nb);
	  call clean_up;
	  goto err_return;
	end proc_err;

clean_up:	proc;
	  if code ^= 0 then call iox_$close (arg_info.iocbp, code); /* close heals_log file */
	  if real_p.ioerr_log_sw_p ^= null ()
	  then do; if real_p.ioerr_log_sw_p -> iocb.open_descrip_ptr ^= null ()
	    then call real_p.ioerr_log_sw_p -> iocb.close (real_p.ioerr_log_sw_p, code);
	    if real_p.ioerr_log_sw_p -> iocb.attach_descrip_ptr ^= null ()
	    then call real_p.ioerr_log_sw_p -> iocb.detach_iocb (real_p.ioerr_log_sw_p, code);
	  end;
	  call delete_$path (get_pdir_ (), "heals_ioerr_log", dl_sws, whoami, code);
	  call delete_$path (get_pdir_ (), "heals_sort_log", dl_sws, whoami, code);
	  return;
	end clean_up;

err_return:
	return;

trace: tr: entry;
dcl  trace_sw bit (1) aligned int static init ("0"b);
dcl  trace_state char (3);

	trace_sw = ^trace_sw;
	if trace_sw
	then trace_state = "on";
	else trace_state = "off";
	call ioa_ ("Trace state is ^a.", trace_state);
	return;

        end heals_io_reports_;




		    heals_media_sort_gen_.pl1       09/27/84  0748.5rew 09/27/84  0745.2       98784



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
heals_media_sort_gen_: proc (heals_arg_info_p, heals_ior_args_p, r_code);

/* ******************************************************************************
   *								*
   *  Comments:							*
   *								*
   * 	 Evolved from heals_sorted_report_gen_ by A. R. Downing May 1977	 			*
   *	Last modified by RH Morrison  01/03/77				*
   *								*
   ****************************************************************************** */

/* FF */
/* ********	DECLARATIONS	******** */

/* ****	PROCEDURE ARGUMENTS   **** */

dcl  heals_arg_info_p ptr;
dcl  heals_ior_args_p ptr;
dcl  r_code fixed bin (35);

/* ****	EXTERNAL STATIC	**** */

dcl  error_table_$end_of_info ext static fixed bin (35);

/* ****	ENTRIES		**** */
dcl  sort_ entry ((*)char (*), char (*), (*)ptr, char (*), char (*), float bin (27),
     fixed bin (35));
dcl  clock_ entry returns (fixed bin (71));
dcl  get_pdir_ entry returns (char (168));
dcl  ioa_ entry options (variable);
dcl  ioa_$ioa_switch entry options (variable);
dcl  com_err_ entry options (variable);
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35));
dcl  iox_$detach_iocb entry (ptr, fixed bin (35));
dcl  iox_$close entry (ptr, fixed bin (35));
dcl  iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl  iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));

/* ****	POINTERS		**** */
dcl  flags_p ptr init (null);
dcl  work_p1 ptr init (null);

/*  Arguments  */
dcl  sortsw_p ptr init (null);
dcl  sort_data_p ptr init (null);
dcl  sort_desc_p (3) ptr init (null, null, null);
dcl  inbuf_p ptr init (null);
dcl  insw_p ptr init (null);
dcl  outsw_p ptr init (null);

/* Pointers declared in include files:
   ior_flags_p
   ior_prms_p
   ch_nfo_p
   heals_ior_avars_p
   ioerr_rec_p
   statp
   iocbp
   io_msgp
   */

/* ****	CHARACTER STRING VARIABLES    **** */
dcl  old_name char (4);
dcl  whoami char (24) int static init ("heals_media_sort_gen_");
dcl  inbuf char (inbuf_len) aligned;
dcl  rprt_from_time char (16);
dcl  rprt_to_time char (16);
dcl  old_date char (8);
dcl  date char (8);
dcl  time char (6);
dcl  date_time char (16);
dcl  ch_nr pic "99";
dcl  dev_nr pic "99";

/*  Arguments  */
dcl  version_date char (8) init ("12/15/76");

/* ****	ARITHMETIC VARIABLES    **** */
dcl  clock_time fixed bin (71);
dcl  line_cnt fixed bin;
dcl  max_line_cnt fixed bin;
dcl  page_nb fixed bin;

/*  Arguments  */
dcl  version_nb fixed bin init (1);
dcl  code fixed bin (35);
dcl  inrec_len fixed bin (21);
dcl  inbuf_len fixed bin (21) int static init (1024);
dcl  seq_in fixed bin int static init (4);

/* ****	BIT STRING VARIABLES    **** */
dcl  flags_word bit (36) aligned;
dcl  eof bit (1) aligned;

/*  Arguments  */
dcl  unused bit (1) aligned init ("0"b);

/* ****	BASED VARIABLES		**** */
dcl 1 arg_info like heals_arg_info aligned based (heals_arg_info_p);
dcl 1 flags aligned based (flags_p),
    (2 trace bit (1),
    2 db bit (1),
    2 hdrs bit (1),
    2 no_recs bit (1),
    2 fill bit (1)
     ) unal;

/* ****	SORT DECLARATIONS   **** */
dcl  sort_file_size float bin (27);
dcl  sort_out_file char (168);
dcl  sort_temp_dir char (168);
dcl  sort_user_out_sw char (32);
dcl  sortsw char (6) int static init ("sortsw");
dcl  sort_in_file (1) char (168);
dcl  user_keys_number int static init (3);
dcl 1 keys,
    2 version fixed bin init (1),
    2 number fixed bin,
    2 key_desc (user_keys_number),
      3 datatype char (8),
      3 size fixed bin (24),
      3 word_offset fixed bin (18),
      3 bit_offset fixed bin (6),
      3 desc char (3);

/* ****	MISC. DECLARATIONS		**** */

dcl (addr, addrel, before, fixed, null) builtin;
dcl  cleanup condition;

/* FF */
/* ****	INCLUDE FILES	**** */
%include heals_arg_info;
%include heals_io_report_args;
%include heals_ioerr_rec;
%include io_syserr_msg;
%include iom_stat;
/* ****	END OF DECLARATIONS   **** */
/* FF */
/* ********	PROCEDURE		******** */

/* ****	Procedure Initialization	**** */

	on cleanup call clean_up;

/*  Init returns.  */
	r_code = 0;
	arg_info.err_nb = 0;

/*  Init pointers.  */
	flags_p = addr (flags_word);
	insw_p = ioerr_log_sw_p;
	outsw_p = arg_info.report_iocbp;
	inbuf_p = addr (inbuf);
	ioerr_rec_p = addr (inbuf);
	io_msgp = addr (ioerr_rec.data);
	statp = addr (io_msg.status);

/* Init control flags.  */
	flags_word = "0"b;
	flags.hdrs = "1"b;
	flags.no_recs = ior_flags.no_recs;
	eof = "0"b;

/*  Init all else.  */

	code = 0;
	old_date = "";
	page_nb = 0;
	line_cnt = 0;
	max_line_cnt = max_line_cnt_a;
	call date_time_ (arg_info.from_time, rprt_from_time);
	call date_time_ (arg_info.to_time, rprt_to_time);

/*  Initialize for sort.  */
	sort_in_file = "-if "||before (get_pdir_ (), " ") ||">heals_ioerr_log";
	sort_out_file = "-of " || before (get_pdir_ (), " ") || ">heals_sort_log";
	sort_desc_p (1) = addr (keys);
	sort_desc_p (2) = null;
	sort_desc_p (3) = null;
	sort_file_size = 0;
	sort_temp_dir = "";
	sort_user_out_sw = "";

	keys.number = user_keys_number;

	key_desc.datatype (1) = "char";
	key_desc.size (1) = 8;
	key_desc.word_offset (1) = 0;
	key_desc.bit_offset (1) = 0;
	key_desc.desc (1) = "";

	key_desc.datatype (2) = "char";
	key_desc.size (2) = 7;
	key_desc.word_offset (2) = 8;
	key_desc.bit_offset (2) = 0;
	key_desc.desc (2) = "";


	key_desc.datatype (3) = "bit";
	key_desc.size (3) = 44;
	key_desc.word_offset (3) = 2;
	key_desc.bit_offset (3) = 0;
	key_desc.desc (3) = "";

/* ****	End Procedure Initialization    **** */

/*  Run information.  */
	clock_time = clock_ ();
	call date_time_ (clock_time, date_time);
	date = substr (date_time, 1, 8);
	time = substr (date_time, 11, 6);
	if flags.trace
	| ior_flags.trace
	then call ioa_ ("^a run info: date ^a, time ^a, version ^d of ^a.",
	  whoami, date, time, version_nb, version_date);

/*  Sort heals_ioerr_log for the media_error report.  */
	call sort_ (sort_in_file, sort_out_file, sort_desc_p,
	  sort_temp_dir, "", 0, code);
	if code ^= 0 then call proc_err (45);

/* ****	Write media__error report.   **** */

/*  Attach and open heals_sort_log file.  */
	if ^flags.no_recs
	then do;
	  call iox_$attach_ioname (sortsw, sortsw_p, "vfile_ " || before (
	    get_pdir_ (), " ") || ">heals_sort_log", code);
	  if code ^= 0 then call proc_err (22);
	  call iox_$open (sortsw_p, seq_in, unused, code);
	  if code ^= 0 then call proc_err (40);

/*  Read first record.  */
	  call iox_$read_record (sortsw_p, inbuf_p, inbuf_len, inrec_len, code);
	  if code ^= 0 then if code = error_table_$end_of_info
	    then flags.no_recs = "1"b;
	    else call proc_err (41);
	  old_name = dev_nm;			/* initialize from first record */
	end;

/* Record processing loop. */
media_report_line_loop:
	do while (^eof);
	  if flags.hdrs
	  then do; page_nb = page_nb + 1;
	    line_cnt = 5;
	    call ioa_$ioa_switch (outsw_p,
	      "^|MEDIA_IO_ERROR_REPORT:^x^a^xto^x^a^5xPAGE^x^2d^/",
	      rprt_from_time, rprt_to_time, page_nb);

	    call ioa_$ioa_switch (outsw_p,
	      "_____D_E_V_I_C_E_____^3xS_T_A_T_U_S__^2xTLY^4xTAPE_NO^1xDENS^xRING^1xTRK^4xS_Y_S_E_R_R_____L_O_G_
I-CC-DD NAME CM^3xMJ-SB-I^9xDISK_AD^2xCYL^xHEAD^1xSEC^4xTIME^3xNUMBER");

	    if flags.no_recs then eof = "1"b;
	  end;

/* Write date line. */
	  if ^eof
	  then do; if sort_date ^= old_date | flags.hdrs
	    then do; old_date = sort_date;
	      flags.hdrs = "0"b;
	      line_cnt = line_cnt +4;
	      call ioa_$ioa_switch (outsw_p, "^/^72(_^)^/DATE:^x^a^vxDATE:^x^a^/",
	        sort_date, 44, sort_date);
	    end;

	    ch_nr = fixed (ch_nb);
	    dev_nr = fixed (dev_nb);

/*  Write media_error report line.  */
	    if substr (dev_nm, 1, 3) ^= "tap" &
	    substr (dev_nm, 1, 3) ^= "dsk" then go to read_next_log_rec;
	    line_cnt = line_cnt + 1;

	    if rprt_flags.ioerr
	    then call ioa_$ioa_switch (outsw_p,
	      "^1d-^2a-^2a^x^4a^x^2.3b^3x^2.3b-^2.3b-^1a^2x^3d^4x^7a^1x^4a^3x^2a^2x^2a^4x^6a^x^6d",
	      iom_nb, ch_nr, dev_nr, dev_nm, dev_cmnd, maj_st, sub_st, ntrpt_nm, tally_nb,
	      tapno_diskad, dens_cyl, ring_head, tracks_sector,
	      log_time, seq_nb);

	    else if rprt_flags.diskerr
	    then do; call ioa_$ioa_switch (outsw_p,
	        "^1d-^2a-^2a^x^4a^x^2.3b^3x^2.3b-^2.3b-^1a^2x^3d^4x^7a^1x^4a^3x^2a^2x^2a^4x^6a^x^6d^/^18x^a",
	        iom_nb, ch_nr, dev_nr, dev_nm, dev_cmnd, maj_st, sub_st, ntrpt_nm, tally_nb,
	        tapno_diskad, dens_cyl, ring_head, tracks_sector,
	        log_time, seq_nb, ioerr_rec.msg);
	      line_cnt = line_cnt + 1;
	    end;

	    else if rprt_flags.disk_addr
	    then call ioa_$ioa_switch (outsw_p,
	      "^1d-^2a-^2a^x^4a^x^2.3b^19x^7a^1x^4a^3x^2a^2x^2a^4x^6a^x^6d",
	      iom_nb, ch_nr, dev_nr, dev_nm, dev_cmnd,
	      tapno_diskad, dens_cyl, ring_head, tracks_sector, log_time, seq_nb);

	    else if rprt_flags.ext_stat | rprt_flags.iom_rec
	    then call ioa_$ioa_switch (outsw_p,
	      "^1d-^2a-^2a^x^4a^x^2.3b^3x^38a^3x^6a^x^6d",
	      iom_nb, ch_nr, dev_nr, dev_nm, dev_cmnd, ioerr_rec.msg, log_time, seq_nb);

	    else if rprt_flags.msg
	    then call ioa_$ioa_switch (outsw_p, "^a", ioerr_rec.msg);

	    else if rprt_flags.bulk
	    then call ioa_$ioa_switch (outsw_p,
	      "^8x^50a^x^6a^x^6d",
	      ioerr_rec.msg, log_time, seq_nb);

/*  Read next heals_sort_log record.  */
read_next_log_rec:
	    call iox_$read_record (sortsw_p, inbuf_p, inbuf_len, inrec_len, code);
	    if code ^= 0
	    then if code = error_table_$end_of_info
	      then eof = "1"b;
	      else call proc_err (42);


/*  Date change.  */
	    if sort_date ^= old_date
	    then if line_cnt > max_line_cnt - 10
	      then flags.hdrs = "1"b;
	  end;

	  if line_cnt > max_line_cnt
	  then flags.hdrs = "1"b;
	end media_report_line_loop;

/*  End of file on heals_sort_log.  */
	if flags.no_recs
	then call ioa_$ioa_switch (outsw_p,
	  "^/^11xThere were no io_errors during the report period.");
	call ioa_$ioa_switch (outsw_p,
	  "^/END: MEDIA_IO_ERROR_REPORT");
	if ^flags.no_recs
	then do; call iox_$close (sortsw_p, code);
	  if code ^= 0 then call proc_err (43);
	  call iox_$detach_iocb (sortsw_p, code);
	  if code ^= 0 then call proc_err (27);
	end;
	return;

/* FF */
proc_err:	proc (proc_err_nb);
dcl  proc_err_nb fixed bin;
	  r_code = code;
	  arg_info.err_nb = proc_err_nb;
	  call com_err_ (code, whoami, "Procedure error number = ^d.", proc_err_nb);
	  call clean_up;
	  goto err_return;
	end proc_err;

clean_up:	proc;
	  if sortsw_p ^= null () then do;
	    call iox_$close (sortsw_p, code);
	    call iox_$detach_iocb (sortsw_p, code);
	  end;
	  return;
	end clean_up;

err_return: return;

        end heals_media_sort_gen_;




		    heals_mos_edac_reports_.pl1     12/01/87  0811.5rew 11/30/87  1323.6       83142



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(87-10-21,Martinson), approve(87-10-21,MCR7751),
     audit(87-11-20,Fawcett), install(87-11-30,MR12.2-1006):
     Fix size condition error in heals_report mos_edac_error.
                                                   END HISTORY COMMENTS */


/* heals_mos_edac_reports_ produces the edac error
   report using edit_mos_rscr_ for formating purposes.
   Coded by A. Downing July 1976. */
/* Modified 12/26/76 by A. Downing to change error header. */
/* Modified Feb. 1979 by A. Downing for
   several bug fixes and code cleaning for MR7.0 */

heals_mos_edac_reports_: proc (datap, code);
%include heals_arg_info;
dcl  datap ptr;
dcl 1 arg_info like heals_arg_info aligned based (datap);
dcl  code fixed bin (35);
dcl  act_len fixed bin (21);
dcl  error_table_$end_of_info ext static fixed bin (35);
dcl  error_rate pic "zzzzz9v.99" aligned init (5.0);
dcl  descrip char (100) varying;
dcl  buffer char (2048) aligned;
dcl  buf_p ptr init (null ());
dcl  clock_ entry returns (fixed bin (71));
dcl (ioa_$ioa_switch, com_err_) entry options (variable);
dcl  edit_mos_rscr_ entry (ptr, char (*) varying);
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  hphcs_$set_mos_polling_time entry (fixed bin);
dcl  iox_$close entry (ptr, fixed bin (35));
dcl  iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
dcl (t1, t2, runtime) char (16) init ("");
dcl  bin_clock fixed bin (71) init (clock_ ());
dcl  one_hour fixed bin (71) int static init (3600000000);	/* in micro seconds */
dcl  size condition;
dcl  alloc_count fixed bin init (0);
dcl  msg_count fixed bin (21) init (0);
dcl  first_data_line fixed bin init (7);
dcl  line_count fixed bin init (0);
dcl  max_lines fixed bin init (50);
dcl  polling_interval fixed bin init (0);
dcl  bit_default_polling_interval int static bit(36) init ("101"b);
dcl  default_polling_interval int static fixed bin init (5);
dcl  read_polling_interval bit (1) init ("0"b);
dcl  use_equals bit (1) aligned init ("0"b);
dcl (p, first_info_p, refer_p, thread_end_p) ptr init (null ());
dcl 1 counter_info based (p),
    2 descrip char (40) varying,
    2 time fixed bin (71),
    2 seq_num fixed bin (35),
    2 count fixed bin (35),
    2 error_average fixed dec (8, 2),
    2 next_info_p ptr,
    2 data dim (heals_message.data_size) bit (36) aligned;
dcl  counter_area area (16384);
dcl  cleanup condition;
dcl  area condition;
dcl  linkage_error condition;
dcl (addr, after, before, bin, empty, index, length, null) builtin;

	call date_time_ (bin_clock, runtime);
	call date_time_ ((arg_info.from_time), t1);
	call date_time_ ((arg_info.to_time), t2);
	arg_info.err_nb = -1;
	counter_area = empty ();			/* reset it for allocations */
	buf_p = addr (buffer);
	on cleanup call clean_up;
	on area begin;
dcl  error_table_$noalloc ext static fixed bin (35);
	  call com_err_ (error_table_$noalloc, "heals_mos_edac_reports_",
	    "internal area overflow:
run mos_edac_error report for a shorter time period for complete error listing.");
	  go to done;				/* print what we got anyway */
	end;

	if arg_info.report_iocbp = null () then do;
	  call com_err_ (0, "heals_mos_edac_reports_",
	    "report stream is not open.");
	  arg_info.err_nb = -1;
	  go to done;
	end;
	call iox_$read_record (arg_info.iocbp, addr (buffer), length (buffer), act_len, code);
	if code ^= 0 then
	  if code ^= error_table_$end_of_info then do;
read_error:
	    call com_err_ (code, "heals_mos_edac_reports_", "error reading heals_log.");
	    call clean_up;
	    return;
	  end;
	  else go to done;
	else;
	heals_message_p = addr (buffer);
scan_loop: do while ("1"b);
	  if index (heals_message.text, "mos_memory_check") > 0 |
	  (use_equals & heals_message.text = "=") then
use_message:  do;
	    use_equals = "1"b;			/* still process = records */
	    if index (heals_message.text, "MOS polling") > 0 then do;
	      read_polling_interval = "1"b;		/* we have the interval record */
	      on size begin;
	        call com_err_ (0, "heals_mos_edac_reports_",
		"heals_log message #^d has an invalid time interval value, ^d is assumed.",
		heals_message.seq_num, default_polling_interval);
	        heals_message.data (1) = bit_default_polling_interval;
	        polling_interval = default_polling_interval;
	      end;
(size):	      polling_interval = bin (before (after (heals_message.text, "MOS polling time "), " minutes"));
	      revert size;
	      go to message_used;
	    end;
	    if ^read_polling_interval then do;
	      polling_interval = -1;			/* for reading interval */
	      on linkage_error go to skip_hphcs_call;	/* incase not enough access */
	      call hphcs_$set_mos_polling_time (polling_interval);
skip_hphcs_call:
	      revert linkage_error;			/* reset */
	    end;
	    if polling_interval < 1 then polling_interval = default_polling_interval;
	    p, refer_p = null ();
check_allocations:
	    do p = first_info_p repeat (p -> next_info_p) while (p ^= null ());
	      if heals_message.data (1) = p -> counter_info.data (1) &
	      heals_message.data (2) = p -> counter_info.data (2) then
	        if after (heals_message.text, "mos_memory_check:") = p -> counter_info.descrip then
		if heals_message.time - one_hour <= p -> counter_info.time then do;
		  p -> count =
		    p -> count + heals_message.tally;
		  p -> counter_info.time = heals_message.time;
		  p -> counter_info.seq_num = heals_message.seq_num;
		  p -> error_average = p -> error_average +
		    (polling_interval * heals_message.tally);
		  go to was_allocated;
		end;
	      thread_end_p = p;
	    end;
						/* if we are here, must allocate new counter */
	    allocate counter_info in (counter_area) set (p);
	    if first_info_p = null () then do;
	      first_info_p = p;
	      thread_end_p = p;
	    end;
	    else thread_end_p -> next_info_p = p;	/* link chain */
	    alloc_count = alloc_count + 1;
(stringsize):
	    p -> counter_info.descrip =
	      after (heals_message.text, "mos_memory_check:");
	    p -> counter_info.data = heals_message.data;
	    p -> count = heals_message.tally;
	    p -> counter_info.time = heals_message.time;
	    p -> counter_info.seq_num = heals_message.seq_num;
	    p -> error_average =
	      p -> count * polling_interval;
	    p -> next_info_p = null ();
was_allocated:
message_used:
	  end use_message;
	  else use_equals = "0"b;
	  call iox_$read_record (arg_info.iocbp, addr (buffer), length (buffer), act_len, code);
	  if code ^= 0 then
	    if code ^= error_table_$end_of_info then go to read_error;
	    else go to done;
	  else;
	  if heals_message.time > arg_info.to_time then go to done;
get_record:
end_scan_loop: end scan_loop;
done:
	if alloc_count = 0 then
	  call ioa_$ioa_switch (arg_info.report_iocbp,
	  "^|MOS_EDAC_ERROR_REPORT:^5xfrom^x^16a^5xto^x^16a
HEALS RUN OF ^16a^xON^xSYSTEM^x^a^/
^- There were no mos_edac errors during the report period.",
	  t1, t2, runtime, arg_info.system_id);

	do p = first_info_p repeat (p -> next_info_p) while (p ^= null ());
	  if p -> counter_info.count > 1 then
	    p -> counter_info.error_average =
	    p -> counter_info.error_average / p -> counter_info.count;
	  error_rate = p -> counter_info.error_average;	/* to get as picture */
	  call edit_mos_rscr_ (addr (p -> counter_info.data (1)), descrip);
	  call print_msg;				/* to actually print out the messages */
	end;
	arg_info.err_nb = 0;
	call ioa_$ioa_switch (arg_info.report_iocbp, "^/END: MOS_EDAC_ERROR_REPORT");
	call clean_up;
clean_up:	proc;
	  if arg_info.iocbp ^= null () then
	    call iox_$close (arg_info.iocbp, code);
	  counter_area = empty ();
	  return;
	end clean_up;
	return;
						/*  */
print_msg: proc;					/* procedure to write edac messages to report. */
	  if msg_count = 0 | line_count >= max_lines then do;
	    call ioa_$ioa_switch (arg_info.report_iocbp,
	      "^|MOS_EDAC_ERROR_REPORT:^5xfrom^x^16a^5xto^x^16a
HEALS RUN OF ^16a^xON^xSYSTEM^x^a^/",
	      t1, t2, runtime, arg_info.system_id);
	    call ioa_$ioa_switch (arg_info.report_iocbp,
	      "^7xLAST ERROR^11xTALLY^2xAVERAGE^4xSYSTEM CONTROLLER REGISTER
LOG_NUM^xDATE^8xTIME^11xMINUTES
^36x/ERROR^/");
	    line_count = first_data_line;
	  end;
	  call date_time_ (p -> counter_info.time, t1);
	  call ioa_$ioa_switch (arg_info.report_iocbp,
	    "^x^6d^x^16a^4x^5d^9a^5x^w^x^w",
	    p -> counter_info.seq_num, t1, p -> counter_info.count,
	    error_rate, p -> counter_info.data (1), p -> counter_info.data (2));
	  call ioa_$ioa_switch
	    (arg_info.report_iocbp, "^4x^a^x^a^/",
	    p -> counter_info.descrip, descrip);
	  msg_count = msg_count + 1;
	  line_count = line_count + 3;
	  return;
	end print_msg;

/* 
   include files
*/

%include scr;
%include heals_message;
        end heals_mos_edac_reports_;




		    heals_report.pl1                08/05/87  0756.4r   08/04/87  1540.9      179694



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* heals_report is the command program for
   the generation of heals reports.  Calls are made to specific
   report generators depending upon the requested reports */
/* Coded by A. Downing March 1976,
   modified by A. Downing 10/76 for release mr5.0 */
/* Modified by A. Downing July 1977 for MR6 */

heals_report: hr: proc;
dcl  upper_case char (26) int static init
    ("ABCDEFGHIJKLMNOPQRSTUVWXYZ");
dcl  lower_case char (26) int static init
    ("abcdefghijklmnopqrstuvwxyz");
dcl  numbers char (10) int static init
    ("1234567890");
dcl  other_chars char (21) int static init
    (" ,.<>#;:*+-_/?!$%'()&");
dcl  hcs_$initiate entry (char (*), char (*), char (*),
     fixed bin (1), fixed bin (2), ptr, fixed bin (35));
dcl  heals_io_reports_ entry (ptr, fixed bin (35));
dcl  heals_cpu_reports_ entry (ptr, fixed bin (35));
dcl  heals_mos_edac_reports_ entry (ptr, fixed bin (35));
dcl  iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35));
dcl  iox_$detach_iocb entry (ptr, fixed bin (35));
dcl  iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl  iox_$position entry (ptr, fixed bin, fixed bin (21), fixed bin (35));
dcl  iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
dcl  iox_$close entry (ptr, fixed bin (35));
dcl  expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35));
dcl  delete_$path entry
    (char (*), char (*), bit (6), char (*), fixed bin (35));
dcl  get_pdir_ entry returns (char (168));
dcl  get_wdir_ entry returns (char (168));
dcl  command_query_ entry options (variable);
dcl (com_err_, ioa_) entry options (variable);
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  clock_ entry returns (fixed bin (71));
dcl  convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35));
dcl  convert_date_to_binary_$relative entry (char (*), fixed bin (71), fixed bin (71), fixed bin (35));
dcl  cu_$arg_list_ptr entry returns (ptr);
dcl  cu_$arg_count entry returns (fixed bin);
dcl  report_file char (168) aligned init
    (before (get_wdir_ (), " ") || ">heals_reports");
dcl  buffer char (1024) aligned;
dcl  rec_len fixed bin (21);
dcl (ip, whoptr) ptr init (null ());
dcl  qip ptr;
dcl 1 query_info aligned,
    2 version fixed bin init (1),
    2 yes_or_no_sw bit (1) unal init ("1"b),		/* Require "yes" or "no" answer. */
    2 suppress_name_sw bit (1) unal init ("0"b),		/* Print name with question. */
    2 status_code fixed bin (35),			/* Set to code of error prompting question. */
    2 query_code fixed bin (35) init (0);
dcl  answer char (32) init ("");
dcl  i fixed bin;
dcl  code fixed bin (35);
dcl  log_path char (168) ext static aligned init (">system_control_1>heals_dir>heals_log");
dcl  error_table_$noentry ext static fixed bin (35);
dcl (error_table_$not_attached, error_table_$not_open) ext static fixed bin (35);
dcl  error_table_$not_closed ext static fixed bin (35);
dcl  error_table_$end_of_info ext static fixed bin (35);
dcl  error_table_$badopt ext static fixed bin (35);
dcl  error_table_$noarg ext static fixed bin (35);
dcl  one_day fixed bin (71);
dcl  io_data bit (1) unal defined heals_arg_info.info_selection pos (1);
dcl  mpc_data bit (1) unal defined heals_arg_info.info_selection pos (2);
dcl  cpu_data bit (1) unal defined heals_arg_info.info_selection pos (3);
dcl  mos_edac_data bit (1) unal defined heals_arg_info.info_selection pos (4);
dcl  sorted_io_data bit (1) unal defined heals_arg_info.info_selection pos (5);
dcl  disk_data bit (1) unal defined heals_arg_info.info_selection pos (6);
dcl  bulk_data bit (1) unal defined heals_arg_info.info_selection pos (7);
dcl  media_data bit (1) unal defined heals_arg_info.info_selection pos (8);
dcl (addr, before, null, verify) builtin;
dcl  cleanup condition;
dcl  record_quota_overflow condition;

	if cu_$arg_count () < 1 then do;
	  call com_err_ (error_table_$noarg, "heals_report",
	    "
Usage: heals_report REPORT_NAME -CONTROL_ARGS-");
	  return;
	end;

	code = 0;
	heals_message_p = null ();
	heals_state_p = null ();
	heals_message_p = addr (buffer);
	qip = addr (query_info);
	heals_arg_info.heals_log_path_name = log_path;
	i = index (reverse (heals_log_path_name), ">");
	i = length (heals_log_path_name) - i ;
	call hcs_$initiate
	  (substr (heals_log_path_name, 1, i), "heals_log_info", "", 0, 0, heals_state_p, code);
	if heals_state_p = null () then do;
	  call com_err_ (code, "heals_report", "could not initiate heals_log_info");
	  return;
	end;
	one_day = 24 * 60 * 60 * 1000000;		/* one day of micro-seconds */
	heals_arg_info.iocbp = null ();
	heals_arg_info.report_iocbp = null ();
	heals_arg_info.to_time = clock_ ();
	heals_arg_info.from_time = heals_arg_info.to_time - one_day;
	heals_arg_info.from_seq = 0;
	heals_arg_info.to_seq = heals_state.last_message_seq_num;
	heals_arg_info.info_selection = "0"b;		/* init off */
	err_nb = 0;
	report_name = "";
	call heals_arg_parser_ (cu_$arg_list_ptr (), cu_$arg_count (), code);
	if code = 0 then do;			/* try to generate a report */
	  call hcs_$initiate
	    (">sc1", "whotab", "", 0, 0, whoptr, code);
	  heals_arg_info.system_id =
	    before (whoptr -> whotab.sysid, " ");
	  call hcs_$initiate (">sc1", "installation_parms", "",
	    0, 0, ip, code);
	  heals_arg_info.installation_id =
	    before (ip -> installation_parms.installation_id, " ");
	  if verify (heals_arg_info.installation_id,
	  lower_case || upper_case || numbers || other_chars)
	  > 0 then
	    heals_arg_info.installation_id = "";
	  on cleanup call clean_up;
	  call iox_$attach_ioname
	    ("heals_report_stream", report_iocbp, "vfile_ " ||
	    before (report_file, " ") || " -extend", code);
	  if code ^= 0 then do;
	    call com_err_ (code, "heals_report", "could not attach to the report file.");
	    call clean_up;
	    return;
	  end;
	  else call iox_$open (report_iocbp, 2 /* stream_output */, "0"b, code);
	  if code ^= 0 then do;
	    call com_err_ (code, "heals_report", "could not open the report file.");
	    call clean_up;
	    return;
	  end;
	  call iox_$attach_ioname ("heals_io", heals_arg_info.iocbp,
	    "vfile_ " ||
	    before (heals_arg_info.heals_log_path_name, " "), code);
	  if code ^= 0 then do;
	    call com_err_ (code, "heals_report", "could not attach to ^a.",
	      heals_arg_info.heals_log_path_name);
	    call clean_up;
	    return;
	  end;
	  call iox_$open (heals_arg_info.iocbp, 8 /* keyed_seq in */, "0"b, code);
	  if code ^= 0 then do;
	    call com_err_ (code, "heals_report",
	      "unable to open ^a.", heals_arg_info.heals_log_path_name);
	    call clean_up;
	    return;
	  end;
pos_at_beginning:
	  if ^(io_data | sorted_io_data | media_data | cpu_data | mos_edac_data)
	  then go to done;				/* reports all generated */
	  on record_quota_overflow begin;
	    call com_err_ (0, "heals_report",
	      "There is insufficient quota to produce the specified reports.");
	    call clean_up;
	    go to done;
	  end;
	  if heals_arg_info.iocbp -> iocb.attach_descrip_ptr ^= null () then
	    if heals_arg_info.iocbp -> iocb.open_descrip_ptr = null () then do;
	      call iox_$open (heals_arg_info.iocbp, 8 /* keyed seq in */, "0"b, 0);
	      if code ^= 0 then
	        if code ^= error_table_$not_attached &
	        code ^= error_table_$not_closed then go to pos_error;
	        else;
	      else;
	    end;
	  call iox_$position (heals_arg_info.iocbp, -1, 0, code);
	  call iox_$read_record (heals_arg_info.iocbp,
	    heals_message_p, length (buffer), rec_len, code);
	  if code ^= 0 then do;
pos_error:    call com_err_ (code, "heals_report",
	      "error while positioning to proper record in heals_log.");
	    call clean_up;
	    return;
	  end;
	  do while ((heals_message.time < heals_arg_info.from_time) &
	      (heals_message.time < heals_arg_info.to_time));
	    call iox_$read_record (heals_arg_info.iocbp,
	      heals_message_p, length (buffer), rec_len, code);
	    if code ^= 0 then
	      if code ^= error_table_$end_of_info then go to pos_error;
	      else go to at_proper_record;
	    else;
	  end;					/* end of while loop */
at_proper_record:
	  if heals_message.time ^= heals_arg_info.from_time then do;
	    call iox_$position (heals_arg_info.iocbp, 0, -1, code);
	    if code ^= 0 then go to pos_error;
	  end;
	  if io_data then do;
	    report_name = "io_error";
	    call heals_io_reports_ (addr (heals_arg_info), code);
	    if code ^= 0 then do;			/* something went wrong */
	      call com_err_
	        (code, "heals_report", "abnormal termination of ^a report generator.", report_name);
	      if heals_arg_info.err_nb > 0 then
	        call com_err_ (0, "heals_report",
	        "heals internal error #^d was returned by the ^a report generator,
contact Multics heals programming team for instructions.",
	        heals_arg_info.err_nb, report_name);
	      call clean_up;
	      return;
	    end;
	    if heals_arg_info.err_nb = 0 then
	      call ioa_
	      ("^v(^4xio_error report generated^/^)^v(^4xsorted_io_error report generated^/^)^v(^4xmedia_error report generated^/^)",
	      bin (io_data, 1, 0), bin (sorted_io_data, 1, 0), bin (media_data, 1, 0));
	    else call ioa_ ("^a report's may be incomplete.", report_name);
	    io_data, sorted_io_data, media_data = "0"b;
	    go to pos_at_beginning;
	  end;
	  if sorted_io_data then do;
	    report_name = "sorted_io_error";
	    call heals_io_reports_ (addr (heals_arg_info), code);
	    if code ^= 0 then do;			/* something went wrong */
	      call com_err_
	        (code, "heals_report", "abnormal termination of ^a report generator.", report_name);
	      if heals_arg_info.err_nb > 0 then
	        call com_err_ (0, "heals_report",
	        "heals internal error #^d was returned by the ^a report generator,
contact Multics heals programming team for instructions.",
	        heals_arg_info.err_nb, report_name);
	      call clean_up;
	      return;
	    end;
	    if heals_arg_info.err_nb = 0 then
	      call ioa_
	      ("^v(^4xio_error report generated^/^)^v(^4xsorted_io_error report generated^/^)^v(^4xmedia_error report generated^/^)",
	      bin (io_data, 1, 0), bin (sorted_io_data, 1, 0), bin (media_data, 1, 0));
	    else call ioa_ ("^a report may be incomplete.", report_name);
	    sorted_io_data, media_data = "0"b;		/* report generated */
	    go to pos_at_beginning;
	  end;
	  if media_data then do;
	    report_name = "media_error";
	    call heals_io_reports_ (addr (heals_arg_info), code);
	    if code ^= 0 then do;			/* something went wrong */
	      call com_err_
	        (code, "heals_report", "abnormal termination of ^a report generator.", report_name);
	      if heals_arg_info.err_nb > 0 then
	        call com_err_ (0, "heals_report",
	        "heals internal error #^d was returned by the ^a report generator,
contact Multics heals programming team for instructions.",
	        heals_arg_info.err_nb, report_name);
	      call clean_up;
	      return;
	    end;
	    if heals_arg_info.err_nb = 0 then
	      call ioa_
	      ("^v(^4xio_error report generated^/^)^v(^4xsorted_io_error report generated^/^)^v(^4xmedia_error report generated^/^)",
	      bin (io_data, 1, 0), bin (sorted_io_data, 1, 0), bin (media_data, 1, 0));
	    else call ioa_ ("^a report may be incomplete.", report_name);
	    media_data = "0"b;			/* report generated */
	    go to pos_at_beginning;
	  end;
	  if cpu_data then do;
	    report_name = "cpu_error";
	    call heals_cpu_reports_ (addr (heals_arg_info), code);
	    if code ^= 0 then do;			/* something went wrong */
	      call com_err_
	        (code, "heals_report", "abnormal termination of ^a report generator.", report_name);
	      if heals_arg_info.err_nb > 0 then
	        call com_err_ (0, "heals_report",
	        "heals internal error #^d was returned by the ^a report generator,
contact Multics heals programming team for instructions.",
	        heals_arg_info.err_nb, report_name);
	      call clean_up;
	      return;
	    end;
	    cpu_data = "0"b;			/* report generated */
	    if heals_arg_info.err_nb = 0 then
	      call ioa_ ("^4x^a report generated.", report_name);
	    else call ioa_ ("^a report may be incomplete.", report_name);
	    go to pos_at_beginning;
	  end;
	  if mos_edac_data then do;
	    report_name = "mos_edac_error";
	    call heals_mos_edac_reports_ (addr (heals_arg_info), code);
	    if code ^= 0 then do;			/* something went wrong */
	      call com_err_
	        (code, "heals_report", "abnormal termination of ^a report generator.", report_name);
	      if heals_arg_info.err_nb > 0 then
	        call com_err_ (0, "heals_report",
	        "heals internal error #^d was returned by the ^a report generator,
contact Multics heals programming team for instructions.",
	        heals_arg_info.err_nb, report_name);
	      call clean_up;
	      return;
	    end;
	    mos_edac_data = "0"b;			/* report generated */
	    if heals_arg_info.err_nb = 0 then
	      call ioa_ ("^4x^a report generated.", report_name);
	    else call ioa_ ("^a report may be incomplete.", report_name);
	    go to pos_at_beginning;
	  end;
	  if heals_arg_info.err_nb > 0 then do;		/* heals private error */
	    call com_err_ (0, "heals_report",
	      "heals internal error #^d was returned by the ^a report generator,
contact Multics heals programming team for instructions.",
	      heals_arg_info.err_nb, report_name);
	    go to pos_at_beginning;
	  end;
else done:
	  if heals_arg_info.iocbp ^= null () then do;
	    call iox_$close (heals_arg_info.iocbp, code);
	    call iox_$detach_iocb (heals_arg_info.iocbp, code);
	    heals_arg_info.iocbp = null ();
	  end;
	  if heals_arg_info.report_iocbp ^= null () then do;
	    call iox_$close (heals_arg_info.report_iocbp, code);
	    call iox_$detach_iocb (heals_arg_info.report_iocbp, code);
	    heals_arg_info.report_iocbp = null ();
	  end;
	end;
	else do;
	  call com_err_ (0, "heals_report",
	    "no reports generated");
	  return;
	end;					/* end of argument parsing error */
	return;

/*  */
heals_arg_parser_: proc (ap, ac, code);
dcl  ap ptr;					/* ptr to arg list */
dcl  ac fixed bin;					/* arg count */
dcl  code fixed bin (35);				/* error code */
dcl  from bit (1) init ("0"b);
dcl  arg char (arg_len) based (argp);
dcl  argp ptr;					/* ptr to specific arg */
dcl  arg_len fixed bin;				/* length of specific arg */
dcl  cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr);
dcl  i fixed bin;

	  i = 1;
	  call cu_$arg_ptr_rel (1, argp, arg_len, code, ap);
	  if code ^= 0 then do;
	    call com_err_ (code, "heals_arg_parser_", "could not obtain report name.");
	    return;
	  end;
	  do while (code = 0 & substr (arg, 1, 1) ^= "-");
	    if arg = "io_error" then io_data = "1"b;
	    else if arg = "sorted_io_error" then sorted_io_data = "1"b;
	    else if arg = "media_error" | arg = "media_io_error" then
	      media_data = "1"b;
	    else if arg = "cpu_error" then cpu_data = "1"b;
	    else if arg = "mos_edac_error" then mos_edac_data = "1"b;
	    else if arg = "disk_error" then disk_data = "1"b;
	    else if arg = "bulk_error" then bulk_data = "1"b;
	    else do;
	      call com_err_ (0, "heals_arg_parser_", "report ^a is not available.", arg);
	      code = error_table_$badopt;
	      return;
	    end;
	    i = i + 1;
	    call cu_$arg_ptr_rel (i, argp, arg_len, code, ap);
	  end;
	  if i > 1 then code = 0;
	  do while (i <= ac);
	    call cu_$arg_ptr_rel (i, argp, arg_len, code, ap);
	    if code ^= 0 then do;
	      call com_err_ (code, "heals_arg_parser_", "error while parsing arguments.");
	      return;
	    end;
	    i = i + 1;				/* increment arg index */
	    if arg = "-from" | arg = "-fm" then do;	/* from time */
	      call cu_$arg_ptr_rel (i, argp, arg_len, code, ap);
	      if code ^= 0 then do;
	        call com_err_ (code, "heals_arg_parser_", "could not obtain beginning time.");
	        return;
	      end;
	      i = i + 1;
	      call convert_date_to_binary_ (arg, heals_arg_info.from_time, code);
	      if code ^= 0 then do;
	        call com_err_ (code, "heals_arg_parser_", "error while obtaining beginning time.");
	        return;
	      end;
	      from = "1"b;
	    end;
	    else if arg = "-from_seq" | arg = "-fm_seq" then do; /* from seq */
	      call cu_$arg_ptr_rel (i, argp, arg_len, code, ap);
	      if code ^= 0 then do;
	        call com_err_ (code, "heals_arg_parser_", "could not obtain beginning seq.");
	        return;
	      end;
	      heals_arg_info.from_seq = convert (from_seq, arg);
	      i = i + 1;
	      from = "1"b;
	    end;
	    else if arg = "-to" then do;		/* to time */
	      call cu_$arg_ptr_rel (i, argp, arg_len, code, ap);
	      if code ^= 0 then do;
	        call com_err_ (code, "heals_arg_parser_", "could not obtain termination time.");
	        return;
	      end;
	      i = i + 1;
	      call convert_date_to_binary_ (arg, heals_arg_info.to_time, code);
	      if code ^= 0 then do;
	        call com_err_ (code, "heals_arg_parser_", "error while obtaining termination time.");
	        return;
	      end;
	    end;
	    else if arg = "-to_seq" then do;		/* to seq */
	      call cu_$arg_ptr_rel (i, argp, arg_len, code, ap);
	      if code ^= 0 then do;
	        call com_err_ (code, "heals_arg_parser_", "could not obtain beginning seq.");
	        return;
	      end;
	      heals_arg_info.to_seq = convert (to_seq, arg);
	      i = i + 1;
	    end;
	    else if arg = "-dp" | arg = "-dprint" then do;
						/* for now, do not implement this one */
	      code = error_table_$badopt;
	      call com_err_ (code, "heals_arg_parser_", "^a", arg);
	      return;
	    end;
	    else if arg = "-of" | arg = "-output_file" then do;
	      call cu_$arg_ptr_rel (i, argp, arg_len, code, ap);
	      if code ^= 0 then do;
	        call com_err_ (code, "heals_arg_parser_", "could not obtain report file.");
	        return;
	      end;
	      i = i + 1;
	      call expand_path_ (addr (arg), (arg_len), addr (report_file), null (), code);
	      if code ^= 0 then do;
	        call com_err_ ("heals_arg_partser_", "^a", arg);
	        return;
	      end;
	    end;
	    else if arg = "-a" | arg = "-all" then do;
	      io_data, media_data, sorted_io_data, cpu_data,
	        mos_edac_data = "1"b;
	    end;
	    else do;				/* not a valid control arg */
	      code = error_table_$badopt ;
	      call com_err_ (code, "heals_arg_parser_", "^a", arg);
	      return;
	    end;
	  end;
	  if ^from then
	    heals_arg_info.from_time = heals_arg_info.to_time - one_day;
	  return;
	end heals_arg_parser_;
clean_up:	proc;
	  if report_iocbp ^= null () then do;
	    call iox_$close (report_iocbp, code);
	    call iox_$detach_iocb (report_iocbp, code);
	    report_iocbp = null ();
	  end;
	  if heals_arg_info.iocbp ^= null () then do;
	    call iox_$close (heals_arg_info.iocbp, code);
	    call iox_$detach_iocb (heals_arg_info.iocbp, code);
	    heals_arg_info.iocbp = null ();
	  end;
	  call command_query_ (qip, answer, "heals_report",
	    "The report file may be incomplete due to premature termination,
do you wish to delete it?");
	  if substr (answer, 1, 3) = "yes" then do;
	    call delete_$path (reverse (after (reverse (report_file), ">")),
	      reverse (before (reverse (report_file), ">")),
	      "111111"b, "heals_report", code);
	    if code ^= 0 then
	      if code ^= error_table_$noentry then
	        call com_err_ (code, "heals_report", "Did not delete heals_reports.");
	      else;
	    else;
	  end;
	  return;
	end clean_up;
						/* 
						   include files */
%include heals_arg_info;
%include installation_parms;
%include whotab;
%include heals_message;
%include heals_state;
%include iocb;
        end heals_report;




		    heals_scan_config_.pl1          09/27/84  0748.5rew 09/27/84  0745.3       63090



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
heals_scan_config_: proc (heals_ior_args_p, r_code);

/* ******************************************************************************
   *								*
   *  Comments:							*
   *								*
   *	Written by RH Morrison  Nov. 19, 1976	 			*
   *	Last modified by C. Hornig, October 1982
   *								*
   ****************************************************************************** */

/* FF */
/* ********	DECLARATIONS	******** */

/* ****	PROCEDURE ARGUMENTS   **** */
dcl  heals_ior_args_p ptr;
dcl  r_code fixed bin (35);


/* ****	EXTERNAL STATIC	**** */
dcl  config_deck$ ext;

/* ****	ENTRIES		**** */
dcl  ioa_ entry options (variable);
dcl  clock_ entry returns (fixed bin (71));
dcl  date_time_ entry (fixed bin (71), char (*));

/* ****	POINTERS		**** */
dcl  ch_data_p ptr;					/* Pointer to channel data */
dcl  config_deck_p ptr;				/* Pointer to config deck */
dcl  flags_p ptr init (null);

/* pointers declared elsewhere:
   ior_flags_p
   ior_parms_p
   ior_avars_p
   ch_nfo_p
*/


/* ****	CHARACTER STRING VARIABLES    **** */
dcl  date_time char (16);
dcl  date char (8);
dcl  time char (6);

/*  Arguments  */
dcl  whoami char (18) init ("heals_scan_config_");
dcl  version_date char (8) init ("12/15/76");

/* ****	ARITHMETIC VARIABLES    **** */
dcl  code fixed bin (35);
dcl  deck_stopper fixed bin based (config_deck_p);	/* flag at end of deck */
dcl  ch_data_stop fixed bin based (ch_data_p);		/* flag at end of channel data */
dcl  nb_ch fixed bin (6);
dcl  clock_time fixed bin (71);
dcl (i, j) fixed bin;
dcl  bulk_port fixed bin;

/*  Arguments  */
dcl  version_nb fixed bin init (1);

/* ****	BIT STRING VARIABLES    **** */
dcl  flags_word bit (36) aligned;

/* ****	ARRAY VARIABLES		**** */
dcl  tag_ar (0:8) char (1) init ("", "a", "b", "c", "d", "e", "f", "g", "h");

/* ****	BASED VARIABLES   **** */
dcl 1 flags aligned based (flags_p),
    (2 trace bit (1),
    2 db bit (1),
    2 fill bit (1)
     ) unal;

dcl 1 ch_nfo_ar (1:max_iom_nb_a) aligned based (ch_nfo_ar_p),
    2 ch_entry (0:max_ch_nb_a) like ch_nfo;

/*  Declarations of config deck cards.  */
dcl 1 prph aligned based (config_deck_p),		/* A prph card */
    2 word char (4),				/* The word "prph" */
    2 name char (4),				/* Name of device */
    2 iom fixed bin (3),				/* Iom number */
    2 chan fixed bin (6),				/* Channel number */
    2 model fixed bin,				/* Model number */
    2 nchan fixed bin (6);				/* Number of channels available */

dcl 1 dsk_prph aligned based (config_deck_p),		/* A disk subsystem prph card */
    2 word char (4),
    2 name char (4),
    2 iom fixed bin (3),
    2 chan fixed bin (6),
    2 nchan fixed bin (6),
    2 model fixed bin;

dcl 1 fnp aligned based (config_deck_p),		/* A d355 card */
    2 word char (4),
    2 tag fixed bin,
    2 chan fixed bin (6),
    2 iom fixed bin (3);

dcl 1 bulk_card aligned based (config_deck_p),		/* A bulk store card */
    2 word char (4),
    2 frec fixed bin,
    2 nrec fixed bin,
    2 port fixed bin,
    2 int0 fixed bin;

dcl 1 chan_card aligned based (config_deck_p),		/* A chnl card */
    2 word char (4),
    2 name char (4),
    2 ch_entry like ch_data;

dcl 1 ch_data aligned based (ch_data_p),		/* channel data on a chnl card */
    2 iom fixed bin (3),
    2 chan fixed bin (6),
    2 nchan fixed bin (6);

/* ****	MISC. DECLARATIONS		**** */

dcl (addr, addrel, null, substr) builtin;
dcl  cleanup condition;

/* FF */
/* ****	INCLUDE FILES	**** */
%include heals_io_report_args;
/* ****	END OF DECLARATIONS   **** */
/* FF */
/* ********	PROCEDURE		******** */

/* ****	Procedure Initialization	**** */

	on cleanup call clean_up;

/*  Init returns.  */
	r_code = 0;

/*  Init pointers.  */
	flags_p = addr (flags_word);

/*  Init procedure constants.  */

/* Init control flags.  */
	flags_word = "0"b;

/*  Init all else.  */
	code = 0;

	do i = 1 to max_iom_nb_a;			/* init ch_nfo_ar */
	     do j = 0 to max_ch_nb_a;
		ch_nfo_ar.ch_entry.i_set (i, j) = "0"b; /* if used, set to 1 by scan_config */
	     end;
	end;


/* ****	End Procedure Initialization    **** */

/* Run information.  */
	clock_time = clock_ ();
	call date_time_ (clock_time, date_time);
	date = substr (date_time, 1, 8);
	time = substr (date_time, 11, 6);
	if flags.trace
	| ior_flags.trace
	then call ioa_ ("^a run info: date ^a, time ^a, version ^d of ^a.",
	     whoami, date, time, version_nb, version_date);

/*  Scan the config deck and put peripheral info in ch_nfo_ar.  */

	config_deck_p = addr (config_deck$);		/* Start in beginning */
	do while (deck_stopper ^= -1);		/* And scan til end */
	     if prph.word = "prph"
	     then do; ch_nfo_p = addr (ch_nfo_ar.ch_entry (prph.iom, prph.chan)); /* set pointer to array entry */
		ch_nfo.i_set = "1"b;		/* mark entry as initialized */
		ch_nfo.dev_nam = prph.name;		/* fill in values from config_deck */
		ch_nfo.lchan = prph.chan;
		ch_nfo.uchan = prph.chan;
		if substr (prph.name, 1, 3) = "tap" |
		substr (prph.name, 1, 3) = "dsk" /* multiple channels */ then do;
		     nb_ch = dsk_prph.nchan;
		     ch_nfo.uchan = ch_nfo.lchan + nb_ch -1;
		     ch_nfo.model = dsk_prph.model;
		     if nb_ch >1			/* copy data to other channels */
		     then do i = 1 to nb_ch-1;
			ch_nfo_ar.ch_entry (prph.iom, prph.chan+i) = ch_nfo_ar.ch_entry (prph.iom, prph.chan);
		     end;
		end;
		else ch_nfo.model = prph.model;
		if ch_nfo.model > 9999 then ch_nfo.model = 9999; /* dummy model number */
	     end;
	     else if chan_card.word = "chnl"
	     then do; ch_data_p = addrel (config_deck_p, 2);
		do while (ch_data_stop ^= -1);
		     ch_nfo_p = addr (ch_nfo_ar.ch_entry (ch_data.iom, ch_data.chan));
		     ch_nfo.i_set = "1"b;
		     ch_nfo.dev_nam = chan_card.name;
		     ch_nfo.model = 9999;
		     ch_nfo.lchan = ch_data.chan;
		     ch_nfo.uchan = ch_data.chan + ch_data.nchan -1;
		     if ch_data.nchan > 1
		     then do i = 1 to ch_data.nchan -1;
			ch_nfo_ar.ch_entry (ch_data.iom, ch_data.chan + i)
			     = ch_nfo_ar.ch_entry (ch_data.iom, ch_data.chan);
		     end;
		     ch_data_p = addrel (ch_data_p, 3);
		end;
	     end;
	     else if fnp.word = "d355"		/* datanet */
	     then do; ch_nfo_p = addr (ch_nfo_ar.ch_entry (fnp.iom, fnp.chan));
		ch_nfo.i_set = "1"b;
		if fnp.tag < 0 | fnp.tag > 8 then fnp.tag = 0;
		ch_nfo.dev_nam = "355" || tag_ar (fnp.tag); /* use character tag */
		ch_nfo.lchan = fnp.chan;
		ch_nfo.uchan = fnp.chan;
		ch_nfo.model = 9999;
	     end;
	     else if bulk_card.word = "bulk" then bulk_port = bulk_card.port;

	     config_deck_p = addrel (config_deck_p, 16);	/* To next card */
	end;
	return;

/* FF  */
clean_up:	proc;
	     return;
	end clean_up;

err_return: return;


     end heals_scan_config_;




		    heals_sorted_report_gen_.pl1    09/27/84  0748.5rew 09/27/84  0745.3       99846



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
heals_sorted_report_gen_: proc (heals_arg_info_p, heals_ior_args_p, r_code);

/* ******************************************************************************
   *								*
   *  Comments:							*
   *								*
   *	Written by RH Morrison  Dec. 1, 1976	 			*
   *	Last modified by RH Morrison  01/03/77				*
   *								*
   ****************************************************************************** */

/* FF */
/* ********	DECLARATIONS	******** */

/* ****	PROCEDURE ARGUMENTS   **** */

dcl  heals_arg_info_p ptr;
dcl  heals_ior_args_p ptr;
dcl  r_code fixed bin (35);

/* ****	EXTERNAL STATIC	**** */

dcl  error_table_$end_of_info ext static fixed bin (35);

/* ****	ENTRIES		**** */
dcl  sort_ entry ((*)char (*), char (*), (*)ptr, char (*), char (*), float bin (27),
     fixed bin (35));
dcl  clock_ entry returns (fixed bin (71));
dcl  get_pdir_ entry returns (char (168));
dcl  ioa_ entry options (variable);
dcl  ioa_$ioa_switch entry options (variable);
dcl  com_err_ entry options (variable);
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35));
dcl  iox_$detach_iocb entry (ptr, fixed bin (35));
dcl  iox_$close entry (ptr, fixed bin (35));
dcl  iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl  iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));

/* ****	POINTERS		**** */
dcl  flags_p ptr init (null);
dcl  work_p1 ptr init (null);

/*  Arguments  */
dcl  sortsw_p ptr init (null);
dcl  sort_data_p ptr init (null);
dcl  sort_desc_p (3) ptr init (null, null, null);
dcl  inbuf_p ptr init (null);
dcl  insw_p ptr init (null);
dcl  outsw_p ptr init (null);

/* Pointers declared in include files:
   ior_flags_p
   ior_prms_p
   ch_nfo_p
   heals_ior_avars_p
   ioerr_rec_p
   statp
   iocbp
   io_msgp
   */

/* ****	CHARACTER STRING VARIABLES    **** */
dcl  old_name char (4);
dcl  whoami char (24) int static init ("heals_sorted_report_gen_");
dcl  inbuf char (inbuf_len) aligned;
dcl  rprt_from_time char (16);
dcl  rprt_to_time char (16);
dcl  old_date char (8);
dcl  date char (8);
dcl  time char (6);
dcl  date_time char (16);
dcl  ch_nr pic "99";
dcl  dev_nr pic "99";

/*  Arguments  */
dcl  version_date char (8) init ("12/15/76");

/* ****	ARITHMETIC VARIABLES    **** */
dcl  clock_time fixed bin (71);
dcl  line_cnt fixed bin;
dcl  max_line_cnt fixed bin;
dcl  page_nb fixed bin;

/*  Arguments  */
dcl  version_nb fixed bin init (1);
dcl  code fixed bin (35);
dcl  inrec_len fixed bin (21);
dcl  inbuf_len fixed bin (21) int static init (1024);
dcl  seq_in fixed bin int static init (4);

/* ****	BIT STRING VARIABLES    **** */
dcl  flags_word bit (36) aligned;
dcl  eof bit (1) aligned;

/*  Arguments  */
dcl  unused bit (1) aligned init ("0"b);

/* ****	BASED VARIABLES		**** */
dcl 1 arg_info like heals_arg_info aligned based (heals_arg_info_p);
dcl 1 flags aligned based (flags_p),
   (2 trace bit (1),
    2 db bit (1),
    2 hdrs bit (1),
    2 no_recs bit (1),
    2 fill bit (1)
     ) unal;

/* ****	SORT DECLARATIONS   **** */
dcl  sort_file_size float bin (27);
dcl  sort_out_file char (168);
dcl  sort_temp_dir char (168);
dcl  sort_user_out_sw char (32);
dcl  sortsw char (6) int static init ("sortsw");
dcl  sort_in_file (1) char (168);
dcl  user_keys_number int static init (2);
dcl 1 keys,
    2 version fixed bin init (1),
    2 number fixed bin,
    2 key_desc (user_keys_number),
      3 datatype char (8),
      3 size fixed bin (24),
      3 word_offset fixed bin (18),
      3 bit_offset fixed bin (6),
      3 desc char (3);

/* ****	MISC. DECLARATIONS		**** */

dcl (addr, addrel, before, fixed, null) builtin;
dcl  cleanup condition;

/* FF */
/* ****	INCLUDE FILES	**** */
%include heals_arg_info;
%include heals_io_report_args;
%include heals_ioerr_rec;
%include io_syserr_msg;
%include iom_stat;
%include iocb;
/* ****	END OF DECLARATIONS   **** */
/* FF */
/* ********	PROCEDURE		******** */

/* ****	Procedure Initialization	**** */

	on cleanup call clean_up;

/*  Init returns.  */
	r_code = 0;
	arg_info.err_nb = 0;

/*  Init pointers.  */
	flags_p = addr (flags_word);
	insw_p = ioerr_log_sw_p;
	outsw_p = arg_info.report_iocbp;
	inbuf_p = addr (inbuf);
	ioerr_rec_p = addr (inbuf);
	io_msgp = addr (ioerr_rec.data);
	statp = addr (io_msg.status);

/* Init control flags.  */
	flags_word = "0"b;
	flags.hdrs = "1"b;
	flags.no_recs = ior_flags.no_recs;
	eof = "0"b;

/*  Init all else.  */

	code = 0;
	old_date = "";
	page_nb = 0;
	line_cnt = 0;
	max_line_cnt = max_line_cnt_a;
	call date_time_ (arg_info.from_time, rprt_from_time);
	call date_time_ (arg_info.to_time, rprt_to_time);

/*  Initialize for sort.  */
	sort_in_file = "-if "||before (get_pdir_ (), " ") ||">heals_ioerr_log";
	sort_out_file = "-of " || before (get_pdir_ (), " ") || ">heals_sort_log";
	sort_desc_p (1) = addr (keys);
	sort_desc_p (2) = null;
	sort_desc_p (3) = null;
	sort_file_size = 0;
	sort_temp_dir = "";
	sort_user_out_sw = "";

	keys.number = user_keys_number;

	key_desc.datatype (1) = "char";
	key_desc.size (1) = 8;
	key_desc.word_offset (1) = 0;
	key_desc.bit_offset (1) = 0;
	key_desc.desc (1) = "";

	key_desc.datatype (2) = "bit";
	key_desc.size (2) = 44;
	key_desc.word_offset (2) = 2;
	key_desc.bit_offset (2) = 0;
	key_desc.desc (2) = "";

/* ****	End Procedure Initialization    **** */

/*  Run information.  */
	clock_time = clock_ ();
	call date_time_ (clock_time, date_time);
	date = substr (date_time, 1, 8);
	time = substr (date_time, 11, 6);
	if flags.trace
	| ior_flags.trace
	then call ioa_ ("^a run info: date ^a, time ^a, version ^d of ^a.",
	  whoami, date, time, version_nb, version_date);

/*  Sort heals_ioerr_log for the sorted_io_error report.  */
	call sort_ (sort_in_file, sort_out_file, sort_desc_p,
	  sort_temp_dir, "", 0, code);
	if code ^= 0 then call proc_err (45);

/* ****	Write sorted_io_error report.   **** */

/*  Attach and open heals_sort_log file.  */
	if ^flags.no_recs
	then do;
	  call iox_$attach_ioname (sortsw, sortsw_p, "vfile_ " || before (
	    get_pdir_ (), " ") || ">heals_sort_log", code);
	  if code ^= 0 then call proc_err (22);
	  call iox_$open (sortsw_p, seq_in, unused, code);
	  if code ^= 0 then call proc_err (40);

/*  Read first record.  */
	  call iox_$read_record (sortsw_p, inbuf_p, inbuf_len, inrec_len, code);
	  if code ^= 0 then if code = error_table_$end_of_info
	    then flags.no_recs = "1"b;
	    else call proc_err (41);
	  old_name = dev_nm;			/* initialize from first record */
	end;

/* Record processing loop. */
sorted_report_line_loop:
	do while (^eof);
	  if flags.hdrs
	  then do; page_nb = page_nb + 1;
	    line_cnt = 5;
	    call ioa_$ioa_switch (outsw_p,
	      "^|SORTED_IO_ERROR_REPORT:^x^a^xto^x^a^5xPAGE^x^2d^/",
	      rprt_from_time, rprt_to_time, page_nb);

	    call ioa_$ioa_switch (outsw_p,
	      "_____D_E_V_I_C_E_____^3xS_T_A_T_U_S__^2xTLY^4xTAPE_NO^1xDENS^xRING^1xTRK^4xS_Y_S_E_R_R_____L_O_G_
I-CC-DD NAME CM^3xMJ-SB-I^9xDISK_AD^2xCYL^xHEAD^1xSEC^4xTIME^3xNUMBER");

	    if flags.no_recs then eof = "1"b;
	  end;

/* Write date line. */
	  if ^eof
	  then do; if sort_date ^= old_date | flags.hdrs
	    then do; old_date = sort_date;
	      flags.hdrs = "0"b;
	      line_cnt = line_cnt +4;
	      call ioa_$ioa_switch (outsw_p, "^/^72(_^)^/DATE:^x^a^vxDATE:^x^a^/",
	        sort_date, 44, sort_date);
	    end;

	    ch_nr = fixed (ch_nb);
	    dev_nr = fixed (dev_nb);

/*  Write sorted_io_error report line.  */
	    line_cnt = line_cnt + 1;

	    if rprt_flags.ioerr
	    then call ioa_$ioa_switch (outsw_p,
	      "^1d-^2a-^2a^x^4a^x^2.3b^3x^2.3b-^2.3b-^1a^2x^3d^4x^7a^1x^4a^3x^2a^2x^2a^4x^6a^x^6d",
	      iom_nb, ch_nr, dev_nr, dev_nm, dev_cmnd, maj_st, sub_st, ntrpt_nm, tally_nb,
	      tapno_diskad, dens_cyl, ring_head, tracks_sector,
	      log_time, seq_nb);

	    else if rprt_flags.diskerr
	    then do; call ioa_$ioa_switch (outsw_p,
	        "^1d-^2a-^2a^x^4a^x^2.3b^3x^2.3b-^2.3b-^1a^2x^3d^4x^7a^1x^4a^3x^2a^2x^2a^4x^6a^x^6d^/^18x^a",
	        iom_nb, ch_nr, dev_nr, dev_nm, dev_cmnd, maj_st, sub_st, ntrpt_nm, tally_nb,
	        tapno_diskad, dens_cyl, ring_head, tracks_sector,
	        log_time, seq_nb, ioerr_rec.msg);
	      line_cnt = line_cnt + 1;
	    end;

	    else if rprt_flags.disk_addr
	    then call ioa_$ioa_switch (outsw_p,
	      "^1d-^2a-^2a^x^4a^x^2.3b^19x^7a^1x^4a^3x^2a^2x^2a^4x^6a^x^6d",
	      iom_nb, ch_nr, dev_nr, dev_nm, dev_cmnd,
	      tapno_diskad, dens_cyl, ring_head, tracks_sector, log_time, seq_nb);

	    else if rprt_flags.ext_stat | rprt_flags.iom_rec
	    then call ioa_$ioa_switch (outsw_p,
	      "^1d-^2a-^2a^x^4a^x^2.3b^3x^38a^3x^6a^x^6d",
	      iom_nb, ch_nr, dev_nr, dev_nm, dev_cmnd, ioerr_rec.msg, log_time, seq_nb);

	    else if rprt_flags.msg
	    then call ioa_$ioa_switch (outsw_p, "^a", ioerr_rec.msg);

	    else if rprt_flags.bulk
	    then call ioa_$ioa_switch (outsw_p,
	      "^8x^50a^x^6a^x^6d",
	      ioerr_rec.msg, log_time, seq_nb);

/*  Read next heals_sort_log record.  */
	    call iox_$read_record (sortsw_p, inbuf_p, inbuf_len, inrec_len, code);
	    if code ^= 0
	    then if code = error_table_$end_of_info
	      then eof = "1"b;
	      else call proc_err (42);

/* Write end of dev_nm errors line. */
	    if dev_nm ^= old_name | sort_date ^= old_date
	    then do; line_cnt = line_cnt + 2;
	      if line_cnt > max_line_cnt -4
	      then flags.hdrs = "1"b;
	      call ioa_$ioa_switch (outsw_p,
	        "end: ^a errors^/", old_name);
	      old_name = dev_nm;
	    end;

/*  Date change.  */
	    if sort_date ^= old_date
	    then if line_cnt > max_line_cnt - 10
	      then flags.hdrs = "1"b;
	  end;

	  if line_cnt > max_line_cnt
	  then flags.hdrs = "1"b;
	end sorted_report_line_loop;

/*  End of file on heals_sort_log.  */
	if flags.no_recs
	then call ioa_$ioa_switch (outsw_p,
	  "^/^11xThere were no io_errors during the report period.");
	else call ioa_$ioa_switch (outsw_p,
	  "end: ^a errors", old_name);
	call ioa_$ioa_switch (outsw_p,
	  "^/END: SORTED_IO_ERROR_REPORT");
	if ^flags.no_recs
	then do; call iox_$close (sortsw_p, code);
	  if code ^= 0 then call proc_err (43);
	  call iox_$detach_iocb (sortsw_p, code);
	  if code ^= 0 then call proc_err (27);
	end;
	return;

/* FF */
proc_err:	proc (proc_err_nb);
dcl  proc_err_nb fixed bin;
	  r_code = code;
	  arg_info.err_nb = proc_err_nb;
	  call com_err_ (code, whoami, "Procedure error number = ^d.", proc_err_nb);
	  call clean_up;
	  goto err_return;
	end proc_err;

clean_up:	proc;
	  if sortsw_p ^= null () then do;
	    call iox_$close (sortsw_p, code);
	    call iox_$detach_iocb (sortsw_p, code);
	  end;
	  return;
	end clean_up;

err_return: return;

        end heals_sorted_report_gen_;




		    print_heals_message.pl1         09/27/84  0748.5rew 09/27/84  0745.3       66645



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* Coded by A. Downing July 1976.
   Modified by A. Downing 02/07/77 to report un-implemented arguments.
   print_heals_message is a utility for inspecting and/or modifying messages in
   the perminent heals log */
phm: print_heals_message: proc;
%include heals_arg_info;
%include heals_state;
%include heals_message;
dcl  buffer char (2048) aligned;
dcl  match_sw bit (1) init ("0"b);
dcl  update_sw bit (1) init ("0"b);
dcl  match_string char (64) varying init ("");
dcl  mt fixed bin (71) init (0);
dcl  m_time char (16) init ("");
dcl  sn fixed bin (35) init (0);
dcl (div_part, remainder, skip) fixed bin;
dcl  args fixed bin;
dcl  arg char (arg_len) based (arg_p);
dcl  arg_len fixed bin;
dcl  arg_p ptr init (null ());
dcl  i fixed bin;
dcl  act_len fixed bin (21);
dcl  command char (16) varying init ("");
dcl  code fixed bin (35);
dcl  iocbp ptr init (null ());
dcl  hcs_$initiate entry (char (*), char (*), char (*),
     fixed bin (1), fixed bin (2), ptr, fixed bin (35));
dcl  cu_$arg_count entry returns (fixed bin);
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35));
dcl  read_list_$prompt entry options (variable);
dcl (ioa_, com_err_) entry options (variable);
dcl (iox_$close, iox_$detach_iocb) entry (ptr, fixed bin (35));
dcl  iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
dcl  iox_$delete_record entry (ptr, fixed bin (35));
dcl  iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl  iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35));
dcl  log_path char (168) ext static aligned init (">system_control_1>heals_dir>heals_log"); /* default log */
dcl  error_table_$end_of_info ext static fixed bin (35);
dcl  error_table_$badopt ext static fixed bin (35);
dcl  error_table_$noarg ext static fixed bin (35);
dcl  error_table_$file_busy ext static fixed bin (35);
dcl  cleanup condition;

	heals_log_path_name = log_path;
	i = index (reverse (heals_log_path_name), ">");
	i = length (heals_log_path_name) - i;
	call hcs_$initiate
	  (substr (heals_log_path_name, 1, i),
	  "heals_log_info", "", 0, 0, heals_state_p, code);
	args = cu_$arg_count ();
	if args < 2 then do;
	  call com_err_ (error_table_$noarg, "print_heals_message", "at least two arguments are required.");
	  go to finished;
	end;
	i = 1;
	do while (i <= args);
	  call cu_$arg_ptr (i, arg_p, arg_len, code);
	  if code ^= 0 then do;
	    call com_err_ (code, "print_heals_message");
	    go to finished;
	  end;
	  if arg = "-seq_num" then do;
	    i = i + 1;
	    call cu_$arg_ptr (i, arg_p, arg_len, code);
	    if code ^= 0 then do;
	      call com_err_ (code, "print_heals_message");
	      go to finished;
	    end;
	    sn = convert (sn, arg);
	  end;
	  else if arg = "-match" then do;
	    i = i + 1;
	    call cu_$arg_ptr (i, arg_p, arg_len, code);
	    if code ^= 0 then do;
	      call com_err_ (code, "print_heals_message");
	      go to finished;
	    end;
	    match_string = arg;
	    match_sw = "1"b;
	  end;
	  else if arg = "-time" then do;
	    i = i + 1;
	    call cu_$arg_ptr (i, arg_p, arg_len, code);
	    if code ^= 0 then do;
	      call com_err_ (code, "print_heals_message");
	      go to finished;
	    end;
	    call convert_date_to_binary_ (arg, mt, code);
	    if code ^= 0 then do;
	      call com_err_ (code, "print_heals_message", "error converting message time ^a", arg);
	      go to finished;
	    end;
	  end;
	  else if arg = "-update" then
	    update_sw = "1"b;
	  else do;
	    call com_err_ (error_table_$badopt, "print_heals_message",
	      "^a", arg);
	    go to finished;
	  end;
	  i = i + 1;
	end;					/* end of arg loop */
	heals_message_p = addr (buffer);
	on cleanup call terminate;
	if ^update_sw then
	  call iox_$attach_ioname ("heals_io", iocbp,
	  "vfile_ " || before (heals_log_path_name, " "), code);
	else call iox_$attach_ioname ("heals_io", iocbp,
	  "vfile_ " || before (heals_log_path_name, " ") ||
	  " -extend", code);
	if code ^= 0 then do;
iox_error:
	  call com_err_ (code, "print_heals_message");
	  go to finished;
	end;
	if ^update_sw then
	  call iox_$open (iocbp, 4 /* seq in */, "0"b, code);
	else call iox_$open (iocbp, 10 /* keyed_seq update */, "0"b, code);
	if code ^= 0 then go to iox_error;

	call iox_$read_record (iocbp, heals_message_p, length (buffer), act_len, code);
	if code ^= 0 then do;
read_error:
	  call com_err_ (code, "print_heals_message", "error reading from heals_log.");
	  go to iox_error;
	end;
	call read_log;				/* get started with 1st msg */
read_loop: do while ("1"b);
	  if heals_message.time >= mt then do;
	    do while (heals_message.seq_num < sn);
	      call read_log;
	    end;
	    if match_sw then
	      do while (index (heals_message.text, match_string) = 0);
	      call read_log;
	    end;
	    call date_time_ ((heals_message.time), m_time);
	    call ioa_ ("seq_num ^d at ^a tally of ^d; ^/text: ^a.",
	      heals_message.seq_num, m_time, heals_message.tally, heals_message.text);
	    if update_sw then
command_loop:   do while ("1"b);
	      call get_command;
	      if command = "delete" then do;
	        call iox_$delete_record (iocbp, code);
	        if code ^= 0 then do;
		call com_err_ (code, "print_heals_message",
		  "could not delete the record.");
		go to finished;
	        end;
	      end;
	      else if command = "next" then go to next_msg;
	      else if command = "data" |
	      command = "display_data" then do;
	        div_part = divide (heals_message.data_size, 8, 17, 0);
	        remainder = mod (heals_message.data_size, 8);
	        skip = bin (remainder > 0, 17, 0);
	        call ioa_ (
		"octal data:^v(^/^w ^w ^w ^w ^w ^w ^w ^w^)^v(^/^)^v(^w ^)",
		div_part, skip, remainder, heals_message.data);
	      end;
	      else if command = "quit" |
	      command = "q" |
	      command = "stop" |
	      command = "s" then
	        go to finished;
	    end command_loop;
	  end;
next_msg:
	  call read_log;
	end read_loop;

finished:	call terminate;
	return;

terminate: proc;					/* for preparing to return to command level */
	  if iocbp ^= null () then
	    call iox_$close (iocbp, code);
	  if iocbp ^= null () then
	    call iox_$detach_iocb (iocbp, code);
	  iocbp = null ();
	  return;
	end terminate;

read_log:	proc;					/* for getting heals_log messages */
	  call iox_$read_record (iocbp, heals_message_p, length (buffer), act_len, code);
	  if code ^= 0 then
	    if code ^= error_table_$end_of_info then go to read_error;
	    else go to finished;
	  else;
	  return;
	end read_log;
get_command: proc;

queery:
	  call read_list_$prompt ("enter command	", command);
	  if command ^= "delete" &
	  command ^= "next" &
	  command ^= "data" &
	  command ^= "display_data" &
	  command ^= "quit" &
	  command ^= "q" &
	  command ^= "s" &
	  command ^= "stop" then do;
bad_command:
	    call ioa_ ("^a is not a valid command.", command);
	    go to queery;
	  end;
	  return;
	end get_command;
        end print_heals_message;




		    update_heals_log.pl1            09/27/84  0748.5rew 09/27/84  0745.3       98280



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */

/* update_heals_log copies messages from the syserr_log
   into the heals_log.  Coded by A. Downing 09/76 as part of
   Multics HEALS */
/* Modified by A. Downing March 1978 to
   repair cleanup handling */
/* Modified by A. Downing Dec. 1978 to make several
   minor bug fixes. */
/* Modified by F. W. Martinson 10/82 to correct bugs and add standard
   locking strategy. */
update_heals_log: proc;
%include heals_arg_info;
%include heals_state;
%include heals_message;
dcl  hcs_$make_seg entry (char (*), char (*), char (*),
     fixed bin (5), ptr, fixed bin (35));
dcl  hcs_$status_minf entry
    (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35));
dcl  hcs_$initiate entry (char (*), char (*), char (*),
     fixed bin (1), fixed bin (2), ptr, fixed bin (35));
dcl  convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35));
dcl  clock_ entry returns (fixed bin (71));
dcl  get_pdir_ entry returns (char (168));
dcl  heals_collect_data_ entry (ptr, fixed bin (35));
dcl (com_err_, ioa_) entry options (variable);
dcl (iox_$close, iox_$detach_iocb) entry (ptr, fixed bin (35));
dcl  iox_$position entry (ptr, fixed bin, fixed bin (21), fixed bin (35));
dcl  iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
dcl  iox_$delete_record entry (ptr, fixed bin (35));
dcl  iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl  iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35));
dcl  set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl  set_lock_$unlock entry (bit (36) aligned, fixed bin (35));
dcl  log_path char (168) ext static aligned init (">system_control_1>heals_dir>heals_log"); /* default log */
dcl  error_table_$noentry ext static fixed bin (35);
dcl  error_table_$lock_wait_time_exceeded ext static fixed bin (35);
dcl  error_table_$end_of_info ext static fixed bin (35);
dcl  code fixed bin (35);
dcl  ind fixed bin;
dcl  temp_date_time fixed bin (71);
dcl  one_day fixed bin (71) int static init (86400000000);	/* one day of micro/sec */
dcl  chase fixed bin (1) init (1);
dcl  type fixed bin (2);
dcl  bit_count fixed bin (24);
dcl  save_seq_num fixed bin (35);
dcl  cleanup condition;
dcl  me char (32) varying;
dcl (abs, addr, before, bin, null, verify) builtin;

	me = "update_heals_log";
	heals_arg_info.iocbp = null ();
	heals_arg_info.heals_log_path_name = log_path;
	ind = index (reverse (heals_log_path_name), ">");
	ind = length (heals_log_path_name) - ind ;
	call hcs_$initiate
	     (substr (heals_log_path_name, 1, ind),
	     "heals_log_info", "", 0, 0, heals_state_p, code);
	if heals_state_p = null () then do;
	     call hcs_$make_seg
		(substr (heals_log_path_name, 1, ind),
		"heals_log_info", "", 01010b, heals_state_p, code);
	     if heals_state_p = null () then do;
		call com_err_ (code, me, "could not initiate heals_log_info.");
		return;
	     end;
	end;
	call set_lock_$lock (heals_state.busy, 0, code);
	if code = error_table_$lock_wait_time_exceeded then do;
	     call com_err_ (code, me, "heals log busy");
	     call clean_up;
	     return;
	end;

	on cleanup call clean_up;
	save_seq_num = last_message_seq_num;
	call hcs_$status_minf
	     (substr (heals_log_path_name, 1, ind),
	     substr (heals_log_path_name, ind +2),
	     chase, type, bit_count, code);
	if code = error_table_$noentry |
	type ^= 2 then do;				/* must create */
	     call ioa_ ("^a: Creating heals_log^/^a", me, heals_log_path_name);
	     call iox_$attach_ioname ("heals_io", heals_arg_info.iocbp,
		"vfile_ " || before (heals_log_path_name, " "), code);
	     if code ^= 0 then do;
		call com_err_ (code, me, "could not create ^a.", heals_log_path_name);
		call clean_up;
		return;
	     end;
	end;
	else do;					/* heals log exists ok */
	     call iox_$attach_ioname ("heals_io", heals_arg_info.iocbp,
		"vfile_ " || before (heals_log_path_name, " ") || " -extend", code);
	     if code ^= 0 then do;
		call com_err_ (code, me, "could not attach to heals_io stream.");
		call clean_up;
		return;
	     end;
	end;

	from_time = last_message_time+1;
	to_time = clock_ ();
	info_selection = "0"b;			/* init */
	substr (info_selection, 1, 7) = (7)"1"b;
	call heals_collect_data_ (addr (heals_arg_info), code);
	if heals_arg_info.err_nb ^= 0 | code ^= 0 then do;
	     call com_err_ (code, me, "heals_log could not be completely updated.");
	     call clean_up;
	     return;
	end;
	call ioa_ (
	     "^5x^d message^v(s^) processed,^/^5xsyserr seq_num ^d through^/^5xsyserr seq_num ^d.",
	     abs (last_message_seq_num - save_seq_num), bin (abs (last_message_seq_num - save_seq_num) ^= 1, 17),
	     save_seq_num, last_message_seq_num);

	call clean_up;
	return;
						/*  */
						/* truncate_heals_log truncates messages from the
						   heals_log */
truncate_heals_log: entry;
dcl  reset_last_msg bit (1) init ("0"b);
dcl  no_deleted fixed bin (35) init (0);
dcl  error_table_$badopt ext static fixed bin (35);
dcl  i fixed bin init (1);
dcl  buffer char (2048) aligned;
dcl  length builtin;
dcl  act_len fixed bin (21);
dcl  cu_$arg_count entry returns (fixed bin);
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  arg char (arg_len) based (arg_p);
dcl  arg_len fixed bin;
dcl  arg_p ptr;
	me = "truncate_heals_log";
	heals_arg_info.iocbp = null ();
	heals_arg_info.heals_log_path_name = log_path;
	ind = index (reverse (heals_log_path_name), ">");
	ind = length (heals_log_path_name) - ind ;
	call hcs_$initiate
	     (substr (heals_log_path_name, 1, ind),
	     "heals_log_info", "", 0, 0, heals_state_p, code);
	if heals_state_p = null () then do;
	     call com_err_ (code, me, "could not initiate heals_log_info");
	     return;
	end;

	call set_lock_$lock (heals_state.busy, 0, code);
	if code = error_table_$lock_wait_time_exceeded then do;
	     call com_err_ (code, me, "heals log busy");
	     call clean_up;
	     return;
	end;
	heals_message_p = addr (buffer);
	heals_state.busy = "1"b;
	on cleanup call clean_up;
	to_time = clock_ ();
	from_time = 0;
	if cu_$arg_count () < 1 then do;
	     call com_err_ (0, me, "Usage:
truncate_heals_log -from TIME -to TIME |
truncate_heals_log Ndays");
	     call clean_up;
	     return;
	end;
	else do while (i <= cu_$arg_count ());
	     call cu_$arg_ptr (i, arg_p, arg_len, code);
	     if code ^= 0 then go to arg_error;
	     if arg = "-from" | arg = "-fm" then do;
		i = i + 1;
		call cu_$arg_ptr (i, arg_p, arg_len, code);
		if code ^= 0 then do;
arg_error:	     call com_err_ (code, me, "error while analyzing argument ^d.", i);
		     call clean_up;
		     return;
		end;
		call convert_date_to_binary_ (arg, temp_date_time, code);
		if code ^= 0 then go to arg_error;
		else from_time = temp_date_time;
	     end;
	     else if arg = "-to" then do;
		i = i + 1;
		call cu_$arg_ptr (i, arg_p, arg_len, code);
		if code ^= 0 then go to arg_error;
		call convert_date_to_binary_ (arg, temp_date_time, code);
		if code ^= 0 then go to arg_error;
		else to_time = temp_date_time;
	     end;
	     else if verify (arg, "0123456789") = 0 then do; /* number of days */
		from_time = 0;
		to_time = clock_ () - (bin (arg, 17) * one_day);
	     end;
	     else do;				/* bad_arg */
		call com_err_ (error_table_$badopt, me, "^a.", arg);
		call clean_up;
		return;
	     end;
	     i = i + 1;
	end;					/* end of argument parsing loop */
	call iox_$attach_ioname
	     ("heals_io", iocbp,
	     "vfile_ " || before (heals_log_path_name, " ") || " -extend", code);
	if code ^= 0 then do;
could_not_truncate:
	     call com_err_ (code, me,
		"could not truncate ^a as requested.",
		before (heals_log_path_name, " "));
	     call clean_up;
	     return;
	end;
	call iox_$open (iocbp, 7 /* seq update */, "0"b, code);
	if code ^= 0 then go to could_not_truncate;
	call iox_$read_record (iocbp, heals_message_p, length (buffer), act_len, code);
	if code ^= 0 then do;
	     call com_err_ (code, me, "error while positioning heals_io.");
	     call clean_up;
	     return;
	end;
	do while (code = 0 & heals_message.time < from_time);
	     call iox_$read_record (iocbp, heals_message_p, length (buffer), act_len, code);
	     if code ^= 0 then
		if code ^= error_table_$end_of_info then
		     go to could_not_truncate;
		else call clean_up;
	     return;
	end;
deletion_loop:
	do while (code = 0 & heals_message.time < to_time);
	     if last_message_time = heals_message.time then
		reset_last_msg = "1"b;
	     call iox_$delete_record (iocbp, code);
	     if code = 0 then
		no_deleted = no_deleted + 1;
	     call iox_$read_record (iocbp, heals_message_p,
		length (buffer), act_len, code);
	end;
	if no_deleted > 0 then
	     call ioa_ ("^4x^d record^v(s^) deleted from:^/^a.",
	     no_deleted, bin (no_deleted > 1, 1, 0),
	     before (heals_log_path_name, " "));
	else call ioa_ ("^4xNo records were deleted from:^/^a.",
	     before (heals_log_path_name, " "));
	if reset_last_msg | code = error_table_$end_of_info then do;
	     call iox_$position (iocbp, 1, 0, code);
	     call iox_$position (iocbp, 0, -1, code);
	     if code = error_table_$end_of_info then do;
		last_message_seq_num = 0;
		last_message_time = 0;
	     end;
	     else do;
		call iox_$read_record (iocbp, heals_message_p,
		     length (buffer), act_len, code);
		last_message_seq_num = heals_message.seq_num;
		last_message_time = heals_message.time;
	     end;
	     code = 0;
	     reset_last_msg = "0"b;
	end;
	if code ^= 0 then call com_err_ (me, code);
	call clean_up;
	return;
						/*  */
clean_up:	proc;
	     if iocbp ^= null () then do;
		call iox_$close (iocbp, code);
		call iox_$detach_iocb (iocbp, code);
	     end;
	     call set_lock_$unlock (heals_state.busy, code);
	     return;
	end clean_up;
						/* 
						   The test entry sets the value of log_path to allow the use of
						   several different heals logs.
						   Added Nov. 1976 by A. Downing. */
test:	entry;
dcl  expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35));
	if cu_$arg_count () = 0 then do;
	     log_path = ">system_control_1>heals_dir>heals_log"; /* default value */
	     call ioa_
		("Resetting heals_log path to:^/^168a",
		before (log_path, " "));
	end;
	else do;					/* get path name from argument list */
	     call cu_$arg_ptr (1, arg_p, arg_len, code);
	     call expand_path_ (arg_p, (arg_len), addr (log_path), null (), code);
	     if code ^= 0 then do;
		call com_err_ (code, "update_heals_log", "could not assign log path name ^a", arg);
		return;
	     end;
	     else call ioa_ ("Setting heals_log path to:^/^168a", log_path);
	end;
	return;

     end update_heals_log;



		    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
