



		    daily_log_process.pl1           01/16/85  1233.0rew 01/16/85  1229.4      175365



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


/* format: style4 */
daily_log_process: proc;

/* This program is run once a day to process the log for the preceding day.
   It writes out all log entries on various streams.

   USAGE:

   .	daily_log_process -logname- -(-from date)-

   If the "-from date" option is not given, the program looks for "sys_admin_data" in the current
   working directory, and uses the "log_control" structure there to look for a note which says
   how far daily_log_process got last time. It continues from there.

   Otherwise, the log is scanned for a line beginning with "date" and we go from there.

   Distribution of the output is controlled by the control file, "log_select_file", in the current
   working directory. This file has comment lines beginning with "*", and lines of the form

   .	streamname,S,opcode,text

   streamname	is the name of the stream on which a line will be written.
   S		is the minimum severity which will be considered.
   opcode 	is the operation code (see below)
   text		is optional text which is the operand of opcode.

   Legal opcodes are:
   .	all	selects all lines at this severity
   .	any	selects all lines containing text
   .	begin	selects all lines beginning text
   .	not	inhibits all lines containing text
   .	nbegin	inhibits all lines beginning text
   .	count	counts all lines containing text
   .	bcount	counts all lines beginning text
   .	usage	accumulates totals for network lines
   .	charge	accumulates charges for network lines

   "not" and "nbegin" must precede any selectors they are to inhibit, for a given stream.

   ALL STREAMS MUST BE PRE-ATTACHED.

   At the end of processing, total lines are written. Then, if any lines were selected, a total count is output.

   THVV
*/
/*  Modified October, 1980 by J. N. R. Barnecut to allow 15 extra logs rather than 5. */
/*  Modified September, 1982 by E. N. Kittlitz to increase number of streams, selectors, and check array bounds */

dcl  path char (168) init (">system_control_dir>log");
dcl  dn char (168);
dcl  en char (32);
dcl  c32 char (32);
dcl  p ptr;
dcl  sadp ptr;
dcl  logx fixed bin;
dcl  bcs char (131071) based (p);
dcl  buffer char (120);
dcl  ec fixed bin (35);
dcl  bchr char (al) based (ap);
dcl  testsw bit (1) aligned init ("0"b);
dcl  ap ptr;
dcl  al fixed bin (21);
dcl  sys_log_ptr ptr;
dcl  timestr char (16);
dcl  opword char (8);
dcl  (i, j, k, l, m, n) fixed bin;
dcl  vcs char (64) varying;
dcl  c1 char (1) aligned;
dcl  max_test fixed bin;
dcl  nstreams fixed bin init (0);
dcl  nwrote fixed bin init (0);
dcl  nscan fixed bin init (0);
dcl  xj fixed bin;
dcl  icount fixed bin (24);
dcl  pl fixed bin init (23);
dcl  an fixed bin init (1);

/* declarations for "usage" and "charge",  "extra_log", and "-from" logic EWM 103072 */

dcl  extra_log_index fixed bin init (0);		/* how many extra levels of logs are there ? */
dcl  extra_log_ptrs (15) ptr;				/* ptrs to up to 15 extra logs */

dcl  (charge_count, charge_seconds, usage_count, usage_seconds,
     usage_dempages, usage_prepages) fixed bin init (0);
dcl  (curidx, incr, len) fixed bin;
dcl  (minutes, seconds, dempages, prepages) fixed bin (35);

dcl  limit_sw bit (1) init (""b);			/* =1 if "-from" option is used */
dcl  limit_time fixed bin (71);			/* = earliest time for retrieval if "-from" option is used */
dcl  linep ptr;

dcl  dec_string char (12) var;

dcl  1 based_line aligned based (linep),
       2 part1 char (curidx - 1) unaligned,
       2 part2 char (117 - curidx) unaligned;

dcl  NL char (1) aligned int static init ("
");

dcl  1 temp_str (500) aligned,
       2 cs char (64) unal,
       2 opcode fixed bin,
       2 tot fixed bin,
       2 streamno fixed bin,
       2 tsvty fixed bin,
       2 tlth fixed bin;

dcl  1 streams (50) aligned,
       2 stream char (32) unal,
       2 odate char (8),
       2 inhib fixed bin,
       2 lastline fixed bin,
       2 linecount fixed bin;

dcl  format char (14) aligned int static init ("^4d ^16a ^d ^a");

dcl  (addr, null, hbound, index, length, max, mod, divide, substr) builtin;
dcl  cleanup condition;

dcl  convert_binary_integer_$decimal_string entry (fixed bin (35), char (12) var);
dcl  convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35));
dcl  get_wdir_ entry () returns (char (168));
dcl  initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));
dcl  terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35));
dcl  com_err_ entry options (variable);
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
dcl  expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
dcl  ioa_ entry () options (variable);
dcl  ioa_$ioa_stream entry () options (variable);

/* ======================================================= */

/* Internal procedure to write a line on a stream if not there already. */

wout: proc (sx, lx);
dcl  (sx, lx) fixed bin;
dcl  tdate char (16) aligned;
	if lastline (sx) = lx then return;
	if inhib (sx) = lx then return;
	tdate = timestr;
	if substr (timestr, 1, 8) = odate (sx) then substr (tdate, 1, 8) = "";
	else odate (sx) = tdate;
	call ioa_$ioa_stream (stream (sx), format, lx, tdate, sys_log_file.svty (lx),
	     sys_log_file.line (lx));
	lastline (sx) = lx;
	nwrote = nwrote + 1;
	linecount (sx) = linecount (sx) + 1;
     end wout;

/* ------------------------------------------------------- */

/* First read in control file */

	p, sadp, sys_log_ptr = null;
	on cleanup call clean_up;
	call initiate_file_ (get_wdir_ (), "log_select_file", R_ACCESS, p, icount, ec);
	if p = null then do;
	     call com_err_ (ec, "daily_log_process", "control file missing - log_select_file");
	     return;
	end;
	icount = divide (icount, 9, 17, 0);
	j = 1;
	do k = 1 repeat i + k while (k < icount);
	     i = index (substr (bcs, k), NL);
	     buffer = substr (bcs, k, i - 1);
	     if substr (buffer, 1, 1) = "*" then go to incrs;
	     m = index (buffer, ",");
	     c32 = substr (buffer, 1, m - 1);
	     do l = 1 to nstreams;
		if c32 = stream (l) then go to fstr;
	     end;
	     if nstreams >= hbound (streams, 1) then do;
		call com_err_ (0, "daily_log_process", "The limit of ^d streams has been exceeded.", hbound (streams, 1));
		go to punt;
	     end;
	     l, nstreams = nstreams + 1;
	     linecount (l), inhib (l), lastline (l) = 0;
	     stream (l) = c32;
	     odate (l) = "";
fstr:	     streamno (j) = l;
	     c1 = substr (buffer, m + 1, 1);
	     if c1 = "2" then tsvty (j) = 2;
	     else if c1 = "1" then tsvty (j) = 1;
	     else tsvty (j) = 0;
	     buffer = substr (buffer, m + 3);
	     n = index (buffer, ",");
	     if n = 0 then n = i - m - 2;
	     opword = substr (buffer, 1, n - 1);
	     if opword = "all" then opcode (j) = 1;
	     else if opword = "any" then opcode (j) = 2;
	     else if opword = "begin" then opcode (j) = 3;
	     else if opword = "not" then opcode (j) = 4;
	     else if opword = "nbegin" then opcode (j) = 5;
	     else if opword = "count" then opcode (j) = 6;
	     else if opword = "bcount" then opcode (j) = 7;
	     else if opword = "usage" then opcode (j) = 8;
	     else if opword = "charge" then opcode (j) = 9;
	     else do;
		call com_err_ (0, "daily_log_process", "Illegal opcode ^a", opword);
		go to incrs;
	     end;
	     tot (j) = 0;
	     cs (j) = substr (buffer, n + 1);
	     tlth (j) = i - m - 3 - n;
	     if j >= hbound (temp_str, 1) then do;
		call com_err_ (0, "daily_log_process", "The limit of ^d selectors has been exceeded.", hbound (temp_str, 1));
		go to punt;
	     end;
	     j = j + 1;
incrs:	end;
	max_test = j - 1;
	call ioa_ ("daily_log_process: ^d streams, ^d selectors", nstreams, max_test);
	if max_test = 0 then return;

/* process arguments */

	an = 1;
	j = 0;					/* switch for dispatching on "-from" code */
arglp:	call cu_$arg_ptr (an, ap, al, ec);
	if ec ^= 0 then go to endarg;

	if j = 1 then do;				/* process limit argument following "-from" */
	     j = 0;
	     limit_sw = "1"b;
	     call convert_date_to_binary_ (bchr, limit_time, ec);
	     if ec ^= 0 then goto badarg;
	end;
	else if bchr = "-from" then j = 1;
	else do;
	     path = bchr;
	     pl = al;
	end;

nxtarg:	an = an + 1;
	go to arglp;

endarg:	call expand_pathname_ (path, dn, en, ec);
	if ec ^= 0 then do;
er:	     call com_err_ (ec, "daily_log_process", path);
	     return;
	end;

	if ^limit_sw then do;
	     call initiate_file_ (get_wdir_ (), "sys_admin_data", R_ACCESS, sadp, (0), ec);
	     if sadp = null then go to er;
	     do logx = 1 to sys_admin_data.n_logs;
		if sys_admin_data.log_id (logx) = en then do;
		     go to initiate_logs;
		end;
	     end;
	end;

initiate_logs: call initiate_file_ (dn, en, R_ACCESS, sys_log_ptr, (0), ec);
	if sys_log_ptr = null then
	     if extra_log_index = 0 then go to er;	/* we didn't find the primary log. Real bad */
	     else do;				/* it's the previous log not found. switch to primary */
		call com_err_ (ec, "daily_log_process", "old log ^a not found", en);
		sys_log_ptr = extra_log_ptrs (extra_log_index); /* restore the previous log */
		extra_log_index = extra_log_index - 1;	/* Back down to next log */
		curidx = 1;			/* If we wanted previous log, we want first entry of this log */
		go to dolog;
	     end;

	if extra_log_index = hbound (extra_log_ptrs, 1) then goto find_start_index; /* Limit the search for previous logs */

	if ^limit_sw then
	     if logx <= sys_admin_data.n_logs then
		if log_control.last_entry (logx) ^= 0 then
		     if sys_log_file.time (log_control.last_entry (logx)) = log_control.last_entry_date (logx) then do;
			curidx = log_control.last_entry (logx); /* pick up where we left off */
			go to dolog;
		     end;
		     else ;
		else ;				/* Log point is invalid. */
	     else ;				/* Log name not registered. */
	else if sys_log_file.time (1) > limit_time then ; /* "limit_sw" is on, and whole log is after. */
	else go to find_start_index;			/* .. some of log is before limit. no need secondary. */

	if sys_log_file.lls = "" then goto find_start_index; /* no previous log */
	if sys_log_file.lls < "" then goto find_start_index; /* no previous log */

initiate_next_log: extra_log_index = extra_log_index + 1;
	extra_log_ptrs (extra_log_index) = sys_log_ptr;
	en = "log.-." || sys_log_file.lls;
	goto initiate_logs;				/* to init the previous one */

/**/
/* Following code implements a logarithmic search to find the starting point based upon a lower
   time bound. Upper bound k is always a permissible starting point except at the start when it is
   out of bounds. Lower bound j is not necessarily a permissible starting point.  We stop
   when j is out of bounds (failure) or j = k (success) */

find_start_index: if ^limit_sw then do;			/* start is based on last entry processed */
	     curidx = 1;				/* But we don't know where to start. */
	     goto dolog;
	end;

	j = 1;					/* lower bound for logarithmic search */
	k = sys_log_file.count + 1;			/* initial upper bound is out of bounds */

get_check_index: curidx = divide (k + j, 2, 17, 0);
	if sys_log_file.array (curidx).time < limit_time then do; /* This is below lower bound */
	     j = curidx + 1;
	     if j > sys_log_file.count then
		if extra_log_index = 0 then goto time_err; /* User specified time not in data base */
		else goto finish_log;		/* Will process the next log */
	end;

	else k = curidx;				/* It's OK, therefore it becomes new upper bound */

	if j = k then do;				/* We've limited it down */
	     curidx = j;
	     goto dolog;
	end;

	goto get_check_index;			/* To do another iteration */

/**/
/* Following code is the processing loop on log entries.
   Each line is checked against all selectors to see if it should be written. */

dolog:	icount = sys_log_file.count;			/* Dont do any item twice. */
	do i = curidx to icount;
	     nscan = nscan + 1;
	     call date_time_ (sys_log_file.time (i), timestr);
	     do j = 1 to max_test;
		if sys_log_file.svty (i) < tsvty (j) then go to skiptst;
		if tlth (j) > 0 then vcs = substr (cs (j), 1, tlth (j));
		else vcs = "";
		xj = streamno (j);
		if opcode (j) = 1 then call wout (xj, i);
		else if opcode (j) = 5 then do;
		     if substr (sys_log_file.line (i), 1, tlth (j)) = vcs then inhib (xj) = i;
		end;
		else if opcode (j) = 4 then do;
		     if index (sys_log_file.line (i), vcs) ^= 0 then inhib (xj) = i;
		end;
		else if opcode (j) = 2 then do;
		     if index (sys_log_file.line (i), vcs) ^= 0 then call wout (xj, i);
		end;
		else if opcode (j) = 3 then do;
		     if substr (sys_log_file.line (i), 1, tlth (j)) = vcs then call wout (xj, i);
		end;
		else if opcode (j) = 6 then do;	/* count */
		     if index (sys_log_file.line (i), vcs) ^= 0 then tot (j) = tot (j) + 1;
		end;
		else if opcode (j) = 7 then do;	/* bcount */
		     if substr (sys_log_file.line (i), 1, tlth (j)) = vcs then tot (j) = tot (j) + 1;
		end;
		else if opcode (j) = 8 then do;	/* usage */
		     if index (sys_log_file.line (i), vcs) ^= 0 then goto DECODE_USAGE_VALS;
		end;
		else if opcode (j) = 9 then do;	/* charge */
		     if index (sys_log_file.line (i), vcs) ^= 0 then goto DECODE_CHARGES;
		end;
skiptst:	     end;
endlp:	end;
finish_log: if ^limit_sw then
	     if logx <= sys_admin_data.n_logs then do;
		log_control.last_entry (logx) = icount;
		log_control.last_entry_date (logx) = sys_log_file.time (icount);
	     end;

	call terminate_file_ (sys_log_ptr, 0, TERM_FILE_TERM, ec);
	if extra_log_index > 0 then do;
	     sys_log_ptr = extra_log_ptrs (extra_log_index);
	     extra_log_index = extra_log_index - 1;
	     curidx = 1;				/* start at first point of next log */
	     go to dolog;
	end;

	if ^limit_sw then call terminate_file_ (sadp, 0, TERM_FILE_TERM, ec);
	call ioa_ ("daily_log_process: scanned ^d, wrote ^d", nscan, nwrote);

	do j = 1 to max_test;			/* now put out stiff for counters */
	     if opcode (j) = 6 then do;
		opword = "matching";
		go to ct2;
	     end;
	     else if opcode (j) = 7 then do;
		opword = "starting";
ct2:		xj = streamno (j);
		if linecount (xj) = 0 then if tot (j) = 0 then go to ct3;
		call ioa_$ioa_stream (stream (xj), "^/^-^6d lines ^a ""^a""",
		     tot (j), opword, substr (cs (j), 1, tlth (j)));
	     end;

	     else if opcode (j) = 8 then do;		/* usage */
		if usage_count = 0 then goto ct3;
		xj = streamno (j);
		call ioa_$ioa_stream (stream (xj),
		     "^/^6d lines ""^a"", total cpusec = ^d^/average usage per line: cpusec = ^d, pages = ^d+^d",
		     usage_count, substr (cs (j), 1, tlth (j)), usage_seconds, divide (usage_seconds, usage_count, 17, 0),
		     divide (usage_prepages, usage_count, 17, 0), divide (usage_dempages, usage_count, 17, 0));
	     end;

	     else if opcode (j) = 9 then do;		/* charge */
		if charge_count = 0 then goto ct3;
		xj = streamno (j);
		seconds = divide (charge_seconds, charge_count, 17, 0);
		call ioa_$ioa_stream (stream (xj),
		     "^/^6d lines ""^a"", total charged cpusec = ^d^/average charge per line = ^d:^2d",
		     charge_count, substr (cs (j), 1, tlth (j)), charge_seconds, divide (seconds, 60, 17, 0),
		     mod (seconds, 60));
		if usage_count = 0 then goto ct3;
		seconds = divide (charge_seconds * 100, usage_seconds, 17, 0); /* get ratio x 100 */
		call convert_binary_integer_$decimal_string (seconds, dec_string);
		len = length (dec_string);
		if len < 2 then do;
		     dec_string = "  " || dec_string;
		     len = len + 2;
		end;
		call ioa_$ioa_stream (stream (xj), "^/(charge cpu seconds)/(usage cpu seconds) ratio = ^a.^a",
		     substr (dec_string, 1, len - 2) /* integer part */, substr (dec_string, len - 1, 2) /* fraction part */);
	     end;

ct3:	end;

	do xj = 1 to nstreams;			/* now put out line totals */
	     if linecount (xj) > 0 then
		call ioa_$ioa_stream (stream (xj), "^/Total of ^d lines", linecount (xj));
	end;

punt:	call clean_up;
	return;

badarg:	call com_err_ (ec, "daily_log_process", "Bad argument ^a", bchr);
	return;

time_err: call com_err_ (0, "daily_log_process", "Time specified later than within logs");
	return;

/**/
/* CODE TO PROCESS "usage" and "charge" orders follows */

DECODE_USAGE_VALS:
	linep = addr (sys_log_file.line (i));
	len, incr = 0;

decode_useconds: curidx = index (sys_log_file.line (i), "=") + 1;
	if curidx < 2 then goto line_format_error;
	len = index (based_line.part2, ",") - 1;
	if len < 1 then goto line_format_error;
	seconds = cv_dec_check_ (substr (sys_log_file.line (i), curidx, len), ec);
	if ec ^= 0 then goto conversion_error;

decode_prepages:
	incr = index (based_line.part2, "=") + 1;
	if incr < 2 then goto line_format_error;
	curidx = curidx + incr;
	len = index (based_line.part2, "+") - 1;
	if len < 1 then goto line_format_error;
	prepages = cv_dec_check_ (substr (sys_log_file.line (i), curidx, len), ec);
	if ec ^= 0 then goto conversion_error;

decode_dempages:
	curidx = curidx + len + 1;
	dempages = cv_dec_check_ ((based_line.part2), ec);
	if ec ^= 0 then goto conversion_error;

update_usage_totals: usage_count = usage_count + 1;
	usage_seconds = usage_seconds + seconds;
	usage_prepages = usage_prepages + prepages;
	usage_dempages = usage_dempages + dempages;

	goto skiptst;				/* to process the next line */


DECODE_CHARGES:
	linep = addr (sys_log_file.line (i));
	len, incr = 0;

decode_minutes: curidx = index (sys_log_file.line (i), ":") - 1;
	if curidx < 2 then goto line_format_error;
	do incr = curidx to 1 by -1;
	     if substr (sys_log_file.line (i), incr, 1) = " " then goto decode_minutes1;
	end;
	goto line_format_error;			/* we never found the beginning */

decode_minutes1: len = curidx - incr;
	minutes = cv_dec_check_ (substr (sys_log_file.line (i), incr + 1, len), ec);
	if ec ^= 0 then goto conversion_error;

decode_cseconds: curidx = curidx + 2;
	len = 2;					/* seconds field has two digits */
	seconds = cv_dec_check_ (substr (sys_log_file.line (i), curidx, len), ec);
	if ec ^= 0 then goto conversion_error;

update_charge_totals: charge_count = charge_count + 1;
	charge_seconds = charge_seconds + minutes * 60 + seconds;

	goto skiptst;				/* to process the next line */

conversion_error: call com_err_ (0, "daily_log_process",
	     "conversion_error in char ^d of: ""^a""", ec, substr (sys_log_file.line (i), curidx, len));

line_format_error: call com_err_ (0, "daily_log_process",
	     "format_error in line ^d. Line = ^/^a^/curidx = ^d, len = ^d, incr = ^d",
	     i, sys_log_file.line (i), curidx, len, incr);

	goto skiptst;				/* to process the next line */


clean_up: proc;
	if sys_log_ptr ^= null then
	     call terminate_file_ (sys_log_ptr, 0, TERM_FILE_TERM, (0));
	if p ^= null then
	     call terminate_file_ (p, 0, TERM_FILE_TERM, (0));
	if sadp ^= null then
	     call terminate_file_ (sadp, 0, TERM_FILE_TERM, (0));
     end;
%page;
%include access_mode_values;
%page;
%include syslog;
%page;
%include sys_admin_data;
%page;
%include terminate_file;

     end daily_log_process;




		    monitor_log.pl1                 01/16/85  1233.0rew 01/16/85  1229.9      223866



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



/* monitor_log.pl1 --  program to monitor and print on
   the users terminal  doings in a standard system log */
/* format: style2 */
monitor_log:
     procedure options (variable);

/* Various times in 1981, Benson I. Margulies */
/* honi soit qui mal y pense */

/* faults and such fixed BIM 11/82 */

%include syslog;
%page;
%include monitor_log_info_;


	declare cv_dec_check_	 entry (character (*), fixed bin (35)) returns (fixed bin (35));
	declare continue_to_signal_	 entry (fixed binary (35));
	declare convert_ipc_code_	 entry (fixed bin (35));
	declare com_err_		 entry options (variable);
	declare cu_$arg_count	 entry (fixed bin, fixed bin (35));
	declare cu_$arg_ptr		 entry (fixed bin, pointer, fixed bin (21), fixed bin (35));
	declare cu_$cp		 entry (pointer, fixed bin (21), fixed bin (35));
	declare expand_pathname_	 entry (character (*), character (*), character (*), fixed bin (35));
	declare (get_temp_segment_, release_temp_segment_)
				 entry (character (*), pointer, fixed bin (35));
	declare (
	        hcs_$set_ips_mask,
	        hcs_$reset_ips_mask
	        )			 entry (bit (36) aligned, bit (36) aligned);
	declare ioa_		 entry options (variable);
	declare monitor_log_util_$wakeup_handler
				 entry;
	declare monitor_log_util_$initiate_path
				 entry (char (*), char (*), char (*), ptr, fixed bin (35));
	declare monitor_log_util_$initiate_log
				 entry (ptr, fixed bin (35));
	declare monitor_log_util_$check_log_switch
				 entry (pointer) returns (bit (2) aligned);
	declare requote_string_	 entry (char (*)) returns (char (*));
	declare term_$single_refname	 entry (char (*), fixed bin (35));
	declare timer_manager_$alarm_call
				 entry (fixed bin (71), bit (2), entry);
	declare timer_manager_$reset_alarm_call
				 entry (entry);
	declare unique_chars_	 entry (bit (*)) returns (char (15));

	declare nargs		 fixed bin;
	declare old_logp		 pointer;
	declare emtp		 pointer;
	declare sys_log_ptr		 pointer;
	declare severity		 fixed binary;

	declare 1 toggles		 aligned,
		2 action_options	 aligned,
		  3 (have_print, have_off, have_time, have_match, have_exclude, remove_match, remove_exclude,
		       have_call, have_severity, have_no_severity)
				 bit (1) unaligned,
		  3 pad		 bit (24) unaligned,
		2 state_flags	 aligned,
		  3 (have_log, all_logs, have_this_log, match, have_numbered_log, have_path)
				 bit (1) unaligned,
		  3 pad		 bit (30) unaligned;

	declare log_number		 fixed bin;
	declare saved_ips_mask	 bit (36) aligned;
	declare time		 fixed bin (71);
	declare log_d		 character (168);
	declare log_e		 character (32);
	declare command		 character (512) aligned;
	declare current_argument	 fixed bin;
	declare ap		 pointer,
	        al		 fixed bin (21),
	        argument		 character (al) based (ap);
	declare i			 fixed bin;

	declare 1 em		 aligned based (emtp),
		2 current		 fixed bin,
		2 matches		 fixed bin,
		2 excludes	 fixed bin,
		2 entries		 (1024) aligned,
		  3 match		 bit (1),
		  3 string	 character (128) varying;

	declare (
	        error_table_$namedup,
	        error_table_$segknown,
	        error_table_$noentry,
	        error_table_$noarg,
	        error_table_$badopt,
	        error_table_$name_not_found,
	        error_table_$bad_conversion,
	        error_table_$inconsistent,
	        error_table_$too_many_args,
	        error_table_$too_many_names,
	        error_table_$action_not_performed
	        )			 ext static fixed bin (35);

	declare code		 fixed bin (35);
	declare any_other		 condition;
	declare cleanup		 condition;
	declare fixedoverflow	 condition;
	declare ME		 character (11) init ("monitor_log") int static options (constant);

	declare (codeptr, substr, null, length, string, index, search, after, before, rtrim)
				 builtin;


	emtp = null ();
	call cu_$arg_count (nargs, code);
	if code ^= 0
	then do;					/* we dont make a very useful af */
		call com_err_ (code, ME);
		return;
	     end;
	if nargs = 0
	then do;
		call com_err_ (0, ME, "Usage: monitor_log {log_path} -control_args");
		return;
	     end;
	emtp = null ();
	current_argument = 0;
	string (toggles) = ""b;			/* clear state and options */
	do while (current_argument < nargs);

	     call get_next_argument;
	     if index (argument, "-") ^= 1
	     then do;				/* noncontrol argument ==> must be logname  */
		     if have_log
		     then do;
two_logs:
			     call com_err_ (error_table_$too_many_names, ME,
				"^[Only one log name may be given.^;A log name may not be given with -all.^]",
				^all_logs);
			     goto RETURN;
			end;
		     call expand_pathname_ (argument, log_d, log_e, code);
		     if code ^= 0
		     then do;
			     call com_err_ (code, ME, "^a.", argument);
			     goto RETURN;
			end;
		     have_log = "1"b;
		     have_path = (search (argument, "<>") ^= 0);
		end;
	     else if argument = "-number" | argument = "-nb"
	     then do;
		     if have_log
		     then goto two_logs;
		     have_log, have_numbered_log = "1"b;
		     if current_argument = nargs
		     then do;
			     call com_err_ (error_table_$noarg, ME, "No log number giver with -number.");
			     return;
			end;
		     call get_next_argument;
		     log_number = cv_dec_check_ (argument, code);
		     if code ^= 0
		     then do;
			     if code > length (argument)
			     then call com_err_ (code, ME, "Could not convert ^a to a log number.", argument);
			     else call com_err_ (error_table_$bad_conversion, ME,
				     "Error converting ^a to a log number, character ^a in error.", argument,
				     substr (argument, code, 1));
			end;
		end;

	     else if argument = "-a" | argument = "-all"
	     then do;
		     if have_log
		     then do;
			     call com_err_ (error_table_$inconsistent, ME, "-all may not be given with a log name.")
				;
			     goto RETURN;
			end;
		     all_logs = "1"b;
		end;
	     else if argument = "-print" | argument = "-pr"
	     then do;
		     have_print = "1"b;
		end;

	     else if argument = "-no_print" | argument = "-no_pr"
	     then do;
		     have_print = "0"b;
		end;

	     else if argument = "-time" | argument = "-tm"
	     then do;
		     if current_argument = nargs
		     then do;			/* theres no time there */
NO_TIME:
			     call com_err_ (error_table_$noarg, ME, "A time must be specified for -time.");
			     goto RETURN;
			end;
		     call get_next_argument;
		     if index (argument, "-") = 1
		     then goto NO_TIME;		/* kludgily prevent negatives */
		     time = cv_dec_check_ (argument, code);
		     if code ^= 0
		     then do;
			     if code < length (argument)
			     then call com_err_ (error_table_$bad_conversion, ME, "Error at character ^a of ^a.",
				     substr (argument, code, 1), argument);
			     else call com_err_ (code, ME, "Could not convert ^a to a time.", argument);
			     goto RETURN;
			end;
		     have_time = "1"b;
		end;

	     else if argument = "-off"		/* there is no -no_off. -off is too "dangerous". We could have -on 
				    but that would be confusing with -time or -print */
	     then do;
		     if have_off
		     then do;
			     call com_err_ (error_table_$too_many_args, ME, "-off may only be given once.");
			     go to RETURN;
			end;
		     have_off = "1"b;
		end;
	     else if argument = "-no_severity" | argument = "-no_sv"
	     then do;
		     if have_no_severity
		     then do;
			     call com_err_ (error_table_$too_many_args, ME, "-no_severity may only be given once.");
			     go to RETURN;
			end;
		     have_no_severity = "1"b;
		     if have_severity
		     then
incon_severity:
			do;
			     call com_err_ (error_table_$inconsistent, ME,
				"Both -severity and -no_severity were given.");
			     go to RETURN;
			end;

		end;
	     else if argument = "-severity" | argument = "-sv"
	     then do;
		     if have_no_severity
		     then go to incon_severity;
		     if current_argument = nargs
		     then do;
			     call com_err_ (error_table_$noarg, ME, "No severity given with -severity.");
			     go to RETURN;
			end;
		     call get_next_argument;
		     severity = cv_dec_check_ (argument, code);
		     if code ^= 0
		     then do;
			     if index (argument, "-") = 1
			     then call com_err_ (error_table_$noarg, ME,
				     "No severity given with -severity. Control argument ^a found instead.",
				     argument);
			     else if code < length (argument)
			     then call com_err_ (error_table_$bad_conversion, ME,
				     "Could not convert ^a to a severity. Error at character ^a.", argument,
				     substr (argument, code, 1));
			     else call com_err_ (error_table_$badopt, ME, "Bad severity ^a.", argument);
			     go to RETURN;
			end;
		     have_severity = "1"b;
		end;

	     else if argument = "-call"
	     then do;
		     if current_argument = nargs
		     then do;
			     call com_err_ (error_table_$noarg, ME, "No command to call was given.");
			     return;
			end;
		     call get_next_argument;
		     command = argument;
		     have_call = "1"b;
		end;

	     else if argument = "-exclude" | argument = "-ex" | argument = "-match"
	     then do;
		     if (emtp = null ())		/* no temp yet */
		     then do;
			     on cleanup call release_temp_segment_ (ME, emtp, code);
			     call get_temp_segment_ (ME, emtp, code);
			     if code ^= 0
			     then do;
				     call com_err_ (code, ME, "no temp segs??");
				     return;
				end;
			     em.matches, em.excludes, em.current = 0;
			end;
		     state_flags.match = (argument = "-match");
		     if current_argument = nargs
		     then do;
NO_STRING:
			     call com_err_ (error_table_$noarg, ME, "No ^[match^;exclude^] string given.",
				state_flags.match);
			     goto RETURN;
			end;
		     call get_next_argument;
		     if index (argument, "-") = 1
		     then goto NO_STRING;		/* have to have a string */
		     if (^state_flags.match & remove_exclude) | (state_flags.match & remove_match)
		     then do;
BAD_MEXC:
			     call com_err_ (error_table_$inconsistent, ME,
				"Can't both remove and create exclusions or matches.");
			     goto RETURN;
			end;
		     em.current = em.current + 1;
		     em.entries.string (em.current) = argument;
		     em.entries.match (em.current) = state_flags.match;
		     if state_flags.match
		     then do;
			     em.matches = em.matches + 1;
			     have_match = "1"b;	/* at least one */
			end;
		     else do;
			     em.excludes = em.excludes + 1;
			     have_exclude = "1"b;
			end;
		end;
	     else if argument = "-remove_exclude" | argument = "-rmex"
	     then do;
		     if have_exclude
		     then goto BAD_MEXC;
		     remove_exclude = "1"b;
		end;
	     else if argument = "-remove_match" | argument = "-rm_match"
	     then do;
		     if have_match
		     then goto BAD_MEXC;
		     remove_match = "1"b;
		end;
	     else do;
		     call com_err_ (error_table_$badopt, ME, "^a", argument);
		     goto RETURN;
		end;
	end;


/* Here ends the lexical phase (sic) aka the argument parsing loop. On to the syntactic
   analyzer, to verify that all the arguments really make sense */


/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
/*									*/
/* First check. If -all is specified, there must be something to do to them all.	*/
/*									*/
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

	if all_logs & (string (action_options) = ""b)
	then do;					/* -all must specify existing log op, not addition of new log */
		call com_err_ (error_table_$inconsistent, ME, "-all is meaningless without a log operation.");
		goto RETURN;
	     end;


/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
/*									*/
/* Second check. There must be some log spec. Or -time, which applies to all logs. */
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

	if ^(all_logs | have_log | have_time | have_print)
	then do;
		call com_err_ (error_table_$noarg, ME, "No log name supplied.");
		goto RETURN;
	     end;

	if ^have_log & ^have_time & have_print & ^have_off
	then all_logs = "1"b;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
/*									*/
/* Okay, they pass. We have some log to work on and something to do to it. Let us begin.	*/
/*									*/
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

	if have_time
	then do;
		monitor_log_invocations_.interval = time;
		if monitor_log_invocations_.active
		then do;
			call timer_manager_$reset_alarm_call (monitor_log_util_$wakeup_handler);
			call timer_manager_$alarm_call (monitor_log_invocations_.interval, "11"b,
			     monitor_log_util_$wakeup_handler);
		     end;
	     end;
	if have_print
	then do;
		call ioa_ ("The wakeup interval is ^d second^[s^].", monitor_log_invocations_.interval,
		     (monitor_log_invocations_.interval ^= 1));
	     end;

	if ^(have_log | all_logs)
	then return;				/* thats all */

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
/*									*/
/* From now on, the flag have_log is uninteresting. All_logs tells whether a particular	*/
/* log is under examination, and we have already reported an error if we had neither	*/
/* a log not -all.								*/
/*									*/
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */


	if ^all_logs				/* find the one specified log, to see if we are making a new one */
	then do;
		if have_numbered_log
		then call find_numbered_log (log_number, code);
		else call find_log (have_path, code);
		have_this_log = (code = 0);		/* was it already active? */

		if ^have_this_log & have_numbered_log	/* if it was not, and was identified by number, we are stuck */
		then do;
			call com_err_ (error_table_$inconsistent, ME, "Log number ^d is not active.", log_number);
			go to RETURN;
		     end;

		if ^have_this_log & ^have_print & ^have_off
						/* all the other actions are also creation params */
		then do;
			call new_log;
			go to RETURN;
		     end;
		else do;				/* just one log to be tweaked */
			if ^have_this_log
			then do;
				call com_err_ (error_table_$name_not_found, ME, "No monitor set on the log ^a.",
				     log_e);
				return;
			     end;
			call process_a_log;
			go to RETURN;
		     end;
	     end;
	else do;					/* all_logs */
		if monitor_log_invocations_.lastp = monitor_log_invocations_.firstp
		then do;
			mlip = monitor_log_invocations_.firstp;
			if mlip = null
			then do;
				if ^(have_print & ^have_off)
				then call com_err_ (error_table_$name_not_found, ME, "There are no active logs.");
				go to RETURN;
			     end;
			call process_a_log;
			go to RETURN;
		     end;
		else
loop_down_logs:
		     begin;
			declare next_info_pointer	 pointer;

			do mlip = monitor_log_invocations_.firstp repeat (next_info_pointer)
			     while (mlip ^= null ());
			     next_info_pointer = monitor_log_info.forwardp;
			     call process_a_log;
			end;
		     end loop_down_logs;
		go to RETURN;
	     end;

process_a_log:
     procedure;

	call process_match_exclude;

	if have_print
	then do;
		call ioa_ ("Log # ^i: ^a>^a: ^d entries;^[ Severity >= ^d^;^s^]^[ Calling ^a.^]", monitor_log_info.id,
		     monitor_log_info.log_dir, monitor_log_info.log_entryname, monitor_log_info.last_count,
		     monitor_log_info.filter_severity, monitor_log_info.severity, monitor_log_info.call,
		     requote_string_ (rtrim (monitor_log_info.command_to_call)));
		if monitor_log_info.matches
		then call ioa_ ("^2xmatches:^(^5x""^a""^)", lm_match_array);
		if monitor_log_info.excludes
		then call ioa_ ("^2xexcludes:^(^5x""^a""^)", lm_exclude_array);
	     end;

	if have_call
	then do;
		monitor_log_info.call = (command ^= "");
		monitor_log_info.command_to_call = rtrim (command);
	     end;

	if have_severity
	then do;
		monitor_log_info.filter_severity = "1"b;
		monitor_log_info.severity = severity;
	     end;

	if have_no_severity
	then monitor_log_info.filter_severity = "0"b;

	if have_off
	then
remove_log:
	     begin options (non_quick);
		saved_ips_mask = ""b;

		call term_$single_refname (monitor_log_info.special_refname, (0));
		on any_other call cease_monitoring_immediately;

		monitor_log_info.log_entryname = "";	/* signal to monitor_log_util_$wakeup_handler that entry is defunct */
		call hcs_$set_ips_mask (""b, saved_ips_mask);
		on fixedoverflow
		     begin;
			monitor_log_invocations_.change_pclock = 0;
			go to SET_PCLOCK;
		     end;
		monitor_log_invocations_.change_pclock = monitor_log_invocations_.change_pclock + 1;
SET_PCLOCK:
		if monitor_log_info.backp ^= null ()
		then do;
			monitor_log_info.backp -> monitor_log_info.forwardp = monitor_log_info.forwardp;
						/* unlace */
		     end;
		else do;
			monitor_log_invocations_.firstp = monitor_log_info.forwardp;
						/* if backp was null, WE were first */
		     end;
		if monitor_log_info.forwardp ^= null
		then do;
			monitor_log_info.forwardp -> monitor_log_info.backp = monitor_log_info.backp;
		     end;
		else do;
			monitor_log_invocations_.lastp = monitor_log_info.backp;
						/* if forwardp is null WE are last */
		     end;
		free monitor_log_info;
		if monitor_log_invocations_.lastp = null () & monitor_log_invocations_.firstp = null ()
		then do;
			call timer_manager_$reset_alarm_call (monitor_log_util_$wakeup_handler);
			monitor_log_invocations_.id_pclock = 0;
						/* no more logs, we can reset */
			monitor_log_invocations_.active = "0"b;
		     end;

		call hcs_$reset_ips_mask (saved_ips_mask, saved_ips_mask);
		revert any_other;
	     end remove_log;
     end process_a_log;



process_match_exclude:
     procedure;

	declare (i, cm, ce)		 fixed bin;

	if (have_match | have_exclude)
	then do;
		if em.matches > 0
		then do;
			if monitor_log_info.matches
			then free lm_match_array;
			monitor_log_info.n_matches = em.matches;
			allocate lm_match_array;
			monitor_log_info.matches = "1"b;
		     end;
		if em.excludes > 0
		then do;
			if monitor_log_info.excludes
			then free lm_exclude_array;
			monitor_log_info.n_excludes = em.excludes;
			allocate lm_exclude_array;
			monitor_log_info.excludes = "1"b;
		     end;
		cm, ce = 0;
		do i = 1 to em.current;
		     if em.entries (i).match
		     then do;
			     cm = cm + 1;
			     lm_match_array (cm) = em.entries.string (i);
			end;
		     else do;
			     ce = ce + 1;
			     lm_exclude_array (ce) = em.entries.string (i);
			end;
		end;
		call release_temp_segment_ (ME, emtp, code);
		emtp = null ();
	     end;
	if remove_exclude & monitor_log_info.excludes
	then do;
		monitor_log_info.excludes = ""b;
		free lm_exclude_array;
	     end;
	if remove_match & monitor_log_info.matches
	then do;
		monitor_log_info.matches = ""b;
		free lm_match_array;
	     end;

     end process_match_exclude;



find_log:
     procedure (path_switch, code);

/*
If the user specified a pathname we must decide if it is the same log
as one we have. To do this we cannot just try to initiate, because a switch
of segments might have happened. So if a path (as opposed to an entryname)
has been given, we must run check_log_switch over each log so that the
errors from refname$$initiate will be useful. We use the refname instead
of a null refname to avoid the need to be always adding and removing spurious
null refnames.
*/

	declare path_switch		 bit (1);
	declare code		 fixed bin (35);
	declare got_it		 bit (1);
	declare the_logp		 pointer;
	declare numbered		 bit (1);
	declare number		 fixed bin;
	declare a_number		 fixed bin;

	numbered = ""b;
	go to common;

find_numbered_log:
     entry (a_number, code);
	number = a_number;
	numbered = "1"b;

common:
	got_it = ""b;
	code = 0;
	the_logp = null;
	do mlip = monitor_log_invocations_.firstp repeat (monitor_log_info.forwardp) while (^got_it & mlip ^= null ());
	     if /* tree */ numbered
	     then if monitor_log_info.id = number
		then got_it = "1"b;
		else ;
	     else if path_switch
		then if check_refname (log_d, log_e)
		     then got_it = "1"b;
		     else ;
		else if monitor_log_info.log_entryname = log_e
		     then got_it = "1"b;

	     if got_it
	     then the_logp = mlip;			/* save it */
	end;
	if ^got_it
	then code = error_table_$noentry;
	mlip = the_logp;
	return;					/* mlip will be correct */
     end find_log;



get_next_argument:
     procedure;

	current_argument = current_argument + 1;
	call cu_$arg_ptr (current_argument, ap, al, code);
	if code ^= 0
	then do;
		call com_err_ (code, ME, "Looking for argument # ^d.", current_argument);
		goto RETURN;
	     end;
	return;
     end;
RETURN:
	if emtp ^= null ()
	then call release_temp_segment_ (ME, emtp, code);
	return;



cease_monitoring_immediately:
     procedure;

	call timer_manager_$reset_alarm_call (monitor_log_util_$wakeup_handler);
	monitor_log_invocations_.firstp, monitor_log_invocations_.lastp = null ();
	monitor_log_invocations_.active = "0"b;
	if saved_ips_mask ^= ""b
	then call hcs_$reset_ips_mask (saved_ips_mask, saved_ips_mask);
	call com_err_ (0, ME, "Internal inconsistency detected. All monitors removed.");

	go to RETURN;

     end cease_monitoring_immediately;


new_log:
     procedure options (non_quick);			/* it sets a handler */

	mlip = null ();
	on cleanup
	     begin;
		if mlip ^= null ()
		then free monitor_log_info;
	     end;
	saved_ips_mask = ""b;

	allocate monitor_log_info;
	monitor_log_info.sentinel = monitor_log_sentinel_v1;
	monitor_log_info.log_dir = log_d;
	monitor_log_info.log_entryname = log_e;
	monitor_log_info.exclude_p, monitor_log_info.match_p = null ();
	monitor_log_info.special_refname = unique_chars_ (""b);
	call monitor_log_util_$initiate_log (mlip, code);
	if monitor_log_info.logp = null ()
	then do;
		free monitor_log_info;
		call com_err_ (code, ME, "^a>^a", log_d, log_e);
		goto RETURN;
	     end;

	monitor_log_invocations_.id_pclock = monitor_log_invocations_.id_pclock + 1;
	monitor_log_info.id = monitor_log_invocations_.id_pclock;
	monitor_log_info.call = have_call;
	if have_call
	then monitor_log_info.command_to_call = command;
	else monitor_log_info.command_to_call = "";
	call process_match_exclude;			/* this is complex */
	monitor_log_info.last_count = monitor_log_info.logp -> sys_log_file.count;
	on any_other
	     begin;
		if saved_ips_mask = ""b
		then call continue_to_signal_ (0);
		else do;
			call cease_monitoring_immediately;
			call hcs_$reset_ips_mask (saved_ips_mask, ""b);
			call continue_to_signal_ (0);
		     end;
	     end;

	call hcs_$set_ips_mask (""b, saved_ips_mask);
	on fixedoverflow
	     begin;
		monitor_log_invocations_.change_pclock = 0;
		go to SET_PCLOCK;
	     end;
	monitor_log_invocations_.change_pclock = monitor_log_invocations_.change_pclock + 1;

SET_PCLOCK:
	revert fixedoverflow;
	monitor_log_info.forwardp = null ();
	monitor_log_info.backp = monitor_log_invocations_.lastp;
	if monitor_log_invocations_.lastp ^= null ()
	then /* first entry */
	     monitor_log_invocations_.lastp -> monitor_log_info.forwardp = mlip;
	else monitor_log_invocations_.firstp, monitor_log_invocations_.lastp = mlip;
	monitor_log_invocations_.lastp = mlip;
	call hcs_$reset_ips_mask (saved_ips_mask, saved_ips_mask);
	revert any_other;
	if ^monitor_log_invocations_.active
	then do;
		call timer_manager_$alarm_call (monitor_log_invocations_.interval, "11"b,
		     monitor_log_util_$wakeup_handler);
		monitor_log_invocations_.active = "1"b;
	     end;
     end new_log;

check_refname:
     procedure (dir, entryname) returns (bit (1) aligned);
	declare (dir, entryname)	 character (*);
	declare cls_result		 bit (2) aligned;
	declare temp_log_ptr	 pointer;
	declare code		 fixed bin (35);

	call monitor_log_util_$initiate_path (dir, entryname, monitor_log_info.special_refname, temp_log_ptr, code);
	if code = 0
	then return ("0"b);				/* this is impossible. It would imply that the refname had gone away. */

	else if code = error_table_$segknown		/* this is the right log */
	then return ("1"b);
	else if code = error_table_$namedup		/* refname on another seg, check switch justincase */
	then do;
		if monitor_log_util_$check_log_switch (mlip) = LOG_SWITCHED
						/* well, perhaps it is the correct log */
		then if temp_log_ptr = monitor_log_info.logp
		     then return ("1"b);		/* same thing */
		     else return ("0"b);
		else return ("0"b);
	     end;
	else return ("0"b);

     end check_refname;
     end monitor_log;




		    monitor_log_util_.pl1           01/16/85  1233.0r w 01/16/85  1229.9       78597



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


/* monitor_log_util_ -- actual examiner of the logs, separated out for efficiency */
/* format: style2 */

monitor_log_util_:
     procedure;

/* Coded 1981 March 4 Benson I. Margulies */
/* bugs in log switching addresed BIM 11/82 */

%page;
%include monitor_log_info_;
%page;
%include syslog;
%page;

	declare cu_$cp		 entry (ptr, fixed bin (21), fixed bin (35));
	declare hcs_$initiate	 entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr,
				 fixed bin (35));
	declare hcs_$terminate_name	 entry (char (*), fixed bin (35));
	declare hcs_$status_minf	 entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24),
				 fixed bin (35));
	declare ioa_$rsnpnnl	 entry options (variable);
	declare iox_$control	 entry (ptr, char (*), ptr, fixed bin (35));
	declare ioa_		 entry () options (variable);
	declare requote_string_	 entry (char (*)) returns (char (*));
	declare timer_manager_$alarm_call
				 entry (fixed bin (71), bit (2), entry);

	declare (
	        error_table_$namedup,
	        error_table_$segknown
	        )			 external static fixed bin (35);
	declare iox_$user_io	 pointer external static;

	declare saved_pclock	 fixed bin (35);
	declare code		 fixed bin (35);
	declare sys_log_ptr		 pointer;

	declare cleanup		 condition;
	declare any_other		 condition;
	declare seg_fault_error	 condition;
	declare out_of_bounds	 condition;

	declare (
	        (Log_pointer, Info_pointer)
				 pointer,
	        (Dir_name, Entryname, Refname)
				 character (*),
	        Code		 fixed binary (35)
	        )			 parameter;


wakeup_handler:
     entry;					/* gets timer_manager_ wakeups */
	on any_other system;			/* isolate from things further up */

	on cleanup call reset;			/* dont lose wakeup */
	on seg_fault_error,				/* moved or deleted */
	     out_of_bounds /* something else went awry */
	     begin;
		declare log_state		 bit (2);
		log_state = check_log_switch ();
		if log_state = LOG_SWITCHED
		then go to RECONSIDER_LOG;
		else go to SKIP_LOG;		/* maybe it will be in a better state next tick */
	     end;

/* Try to be robust across changes made by a call handler */

RESTART_CHECK:					/* come here if a -call disturbs the threads */
	do mlip = monitor_log_invocations_.firstp repeat (monitor_log_info.forwardp) while (mlip ^= null ());

RECONSIDER_LOG:
	     saved_pclock = monitor_log_invocations_.change_pclock;
	     if monitor_log_info.log_entryname ^= ""	/* not deleted */
	     then do;
		     sys_log_ptr = monitor_log_info.logp;

/* first print for the simple case, which is just new messages in the existing log.	*/

		     if sys_log_file.count > monitor_log_info.last_count
		     then call printup;

/* next check for a switch in the log segments.					*/

		     else if sys_log_file.count = monitor_log_info.last_count & sys_log_file.count >= sys_log_file.max
		     then if check_log_switch () = LOG_SWITCHED
			then call printup;		/* try again */
		end;
SKIP_LOG:
	     if monitor_log_invocations_.change_pclock ^= saved_pclock
	     then go to RESTART_CHECK;

	end;
	call reset;
	return;

reset:
     procedure;

	if monitor_log_invocations_.firstp ^= null ()
	then call timer_manager_$alarm_call (monitor_log_invocations_.interval, "11"b, wakeup_handler);
     end reset;

printup:
     procedure;

	declare im		 fixed bin;
	declare printit		 bit (1);
	declare last_message_we_see	 fixed bin;
	declare message_length	 fixed bin (21);
	declare command		 character (512) aligned;
	declare i			 fixed bin;

	last_message_we_see = sys_log_file.count;
	do i = monitor_log_info.last_count + 1 to last_message_we_see;

	     printit = "0"b;			/* assume we will not print */

	     if monitor_log_info.matches
	     then do im = 1 to monitor_log_info.n_matches;/* any match will do */
		     printit = printit | (index (sys_log_file.array (i).line, lm_match_array (im)) > 0);
		end;
	     else printit = "1"b;			/* unless there are no match requirements, in which case we assume we do */

	     if monitor_log_info.filter_severity
	     then printit = printit & (sys_log_file.array (i).svty >= monitor_log_info.severity);

	     if monitor_log_info.excludes
	     then do im = 1 to monitor_log_info.n_excludes;
						/* any serve to exclude */
		     printit = printit & ^(index (sys_log_file.array (i).line, lm_exclude_array (im)) > 0);
		end;
	     if printit
	     then do;
		     if monitor_log_info.call
		     then do;
			     call ioa_$rsnpnnl ("^a ^a ^d ^d ^a", command, message_length,
				rtrim (monitor_log_info.command_to_call), monitor_log_info.log_entryname, i,
				sys_log_file.array (i).svty,
				requote_string_ (rtrim (sys_log_file.array (i).line)));

			     call cu_$cp (addr (command), message_length, (0));
			end;
		     else do;
			     call ioa_ ("^a ^d ^d ^a", monitor_log_info.log_entryname, i,
				sys_log_file.array (i).svty, sys_log_file.array (i).line);
			end;
		end;
	end;
	monitor_log_info.last_count = last_message_we_see;
	call iox_$control (iox_$user_io, "start", null (), code);
	return;
     end printup;



refname$$initiate:
     procedure (log_ptr, code);
	declare log_ptr		 pointer;
	declare code		 fixed bin (35);
	declare (dir, entryname, refname)
				 character (*);
	declare temp_code		 fixed bin (35);

	call hcs_$initiate (monitor_log_info.log_dir, monitor_log_info.log_entryname, monitor_log_info.special_refname,
	     0, 1, log_ptr, code);
	return;

refname$$initiate_path:
     entry (dir, entryname, refname, log_ptr, code);

	call hcs_$initiate (dir, entryname, refname, (0), (1), log_ptr, code);
	return;

refname$$terminate:
     entry ();

	call hcs_$terminate_name (monitor_log_info.special_refname, temp_code);
	return;
     end refname$$initiate;


check_log_switch:
     procedure returns (bit (2) aligned);
	declare temp_logp		 pointer;

/* if a switch has completed, then the special refname will be stuck
   on the old segment, which will have a new name. If the switch is
   only partway done, the rename will have happened but the new segment
   will not yet exist. If this program detects the rename, then it terminates
   the special refname. If it then finds that the new segment is not 
   available yet, it does not bother to try to put the refname back on
   the renamed segment. So the next time we look at this log, we will try
   to initiate with the refname, the initiate call will return segknown
   or no error. The only remaining difficulty is that we may wind up 
   terminating the renamed segment altogether. To prevent this a status_minf
   call is made before the reference name is terminated. */

	call refname$$initiate (temp_logp, code);

	if (code = 0)				/* this is impossible unless there was an error of some kind */
	then do;
		call refname$$terminate;
		return (NO_SUCH_LOG);
	     end;
	else if (code = error_table_$segknown)
	then do;					/* seg at this path has this refname */
		return (NO_LOG_SWITCH);		/* so there was no turnover */
	     end;

	else if code = error_table_$namedup
	then do;					/* seg at another pathname has this refname */
						/* so a rename has happened */
						/* insure that the new one is there */
		call hcs_$status_minf (monitor_log_info.log_dir, monitor_log_info.log_entryname, (0), (0), (0), code);
		if code ^= 0
		then return (NO_LOG_SWITCH);		/* not yet ... window we cannot close */
		call refname$$terminate;
		call refname$$initiate (temp_logp, code);

		if monitor_log_info.logp = null ()	/* we could call sub_err_, but */
		then do;
			return (NO_LOG_SWITCH);
		     end;
		monitor_log_info.logp = temp_logp;
		monitor_log_info.last_count = 0;
		sys_log_ptr = monitor_log_info.logp;    /* new log */
		return (LOG_SWITCHED);
	     end;
	return (NO_LOG_SWITCH);			/* some other error from initiate */
     end check_log_switch;

initiate_log:
     entry (Info_pointer, Code);
	Code = 0;
	mlip = Info_pointer;
	call refname$$initiate (monitor_log_info.logp, Code);
	return;

initiate_path:
     entry (Dir_name, Entryname, Refname, Log_pointer, Code);

	call refname$$initiate_path (Dir_name, Entryname, Refname, Log_pointer, Code);
	return;

monitor_log_util_$check_log_switch:
     entry (Info_pointer) returns (bit (2) aligned);

	mlip = Info_pointer;
	return (check_log_switch ());
     end monitor_log_util_;




		    print_log.pl1                   01/16/85  1233.0rew 01/16/85  1229.9      131274



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

print_log: proc;

/* PRINT_LOG - print the answering service logs
   THVV */
/* args changed 7/76 THVV */
/* Modified March 1979 by T. Casey to add ability to automatically chase backpointers to previous logs. */

dcl  path char (168) aligned init (">system_control_1>log"),
     dn char (168) aligned,
     en char (32) aligned,
     print_count fixed bin init (0),
     shx fixed bin,
     nsharg fixed bin init (0),
     searcharg (32) char (64) varying,
     nexclarg fixed bin init (0),
     exclarg (32) char (64) varying,
     ioa_ entry options (variable),
     hcs_$initiate entry (char (*)aligned, char (*) aligned, char (*) aligned, fixed bin (1),
     fixed bin (2), ptr, fixed bin (35)),
     hcs_$terminate_noname entry (ptr, fixed bin (35)),
     expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35)),
     ec fixed bin (35),
     cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)),
     cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)),
     convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35)),
     xtime fixed bin (71),
     start_time fixed bin (71) initial (0),
     end_time fixed bin (71) init			/* This date is 12/31/99 2359. */
    (1011000110010110011001001110100110111010100100000000b), /* .. if Multics last this long we will have to fix */
     bchr char (al) based (ap) unaligned,
     hdsw bit (1) aligned init ("1"b),
     negative bit (1) init ("0"b),
     ap ptr,
     al fixed bin,
     date_time_ entry (fixed bin (71), char (*) aligned),
     sys_log_ptr ptr,
     com_err_ entry options (variable),
     timestr char (16) aligned,
     odate char (8) aligned init (" "),
     istart fixed bin init (1),
     i fixed bin,
     ss fixed bin init (0),
     pl fixed bin init (23),
     an fixed bin init (1);


dcl  log_ptrs (200) ptr;				/* should never need to look at more than 200 previous logs */
dcl  history (200) bit (1) unaligned;
dcl  xlls (200) char (12);
dcl  n_logs fixed bin init (0);			/* how many of the above pointers are valid */
dcl  log_no fixed bin;				/* which one are we printing now */
dcl  first_msg_found bit (1) aligned;			/* to tell when we have looked back far enough */
dcl  pathsw bit (1) aligned init (""b);			/* on if log pathname given */
dcl  sysdir char (168) init (">sc1");
dcl  log_name char (32) init ("log");
dcl  history_dir char (168) init (">udd>SysAdmin>admin>history");
dcl  iend fixed bin init (0);				/* number of last message, if -to N given */
dcl  convert_date_to_binary_$relative entry (char (*), fixed bin (71), fixed bin (71), fixed bin (35));
dcl  prev_arg char (32);				/* saved previous argument, for error messages */
dcl  me char (9) int static options (constant) init ("print_log");
dcl  fb71 fixed bin (71);
dcl  for_time_string char (32) init ("");
dcl  error_table_$noentry ext fixed bin (35);
dcl  n_msgs fixed bin init (0);
dcl  error_table_$badopt ext fixed bin (35);

dcl (abs, addr, hbound, index, null, rtrim, substr) builtin;

dcl  cleanup condition;

%include syslog;

/* ======================================================= */

	history (1) = ""b;
	an = 1;
arglp:	call cu_$arg_ptr (an, ap, al, ec);
	if ec ^= 0 then go to endarg;
	if bchr = "-a" | bchr = "-all" then ss = 0;	/* obsolete */
	else if bchr = "-n" then ss = 1;		/* obsolete */
	else if bchr = "-e" then ss = 2;		/* obsolete */
	else if bchr = "-severity" | bchr = "-sv" then do;
	     call get_next_arg;
	     ss = cv_dec_check_ (bchr, ec);
	     if ec ^= 0 then do;
		call com_err_ (0, "print_log", "Illegal -severity: ^a", bchr);
		return;
	     end;
	end;
	else if bchr = "-nhdr" | bchr = "-no_header" | bchr = "-nhe" then hdsw = "0"b;
	else if (bchr = "-word" | bchr = "-match") then do;
	     call get_next_arg;
ml1:	     nsharg = nsharg + 1;
	     if nsharg <= hbound (searcharg, 1) then searcharg (nsharg) = bchr;
	     else call com_err_ (0, "print_log", "-match arg ^a ignored - limit ^d", bchr, hbound (searcharg, 1));
	     an = an + 1;
	     call cu_$arg_ptr (an, ap, al, ec);
	     if ec = 0 then if substr (bchr, 1, 1) ^= "-" then go to ml1;
	     go to arglp;
	end;
	else if (bchr = "-ex" | bchr = "-exclude") then do;
	     call get_next_arg;
ml2:	     nexclarg = nexclarg + 1;
	     if nexclarg <= hbound (exclarg, 1) then exclarg (nexclarg) = bchr;
	     else call com_err_ (0, "print_log", "-exclude arg ^a ignored - limit ^d", bchr, hbound (exclarg, 1));
	     an = an + 1;
	     call cu_$arg_ptr (an, ap, al, ec);
	     if ec = 0 then if substr (bchr, 1, 1) ^= "-" then go to ml2;
	     go to arglp;
	end;
	else if bchr = "-tm" | bchr = "-time" | bchr = "-date" | bchr = "-dt" then do;
	     call get_next_arg;
	     call convert_date_to_binary_ (bchr, start_time, ec);
	     if ec ^= 0 then go to arg_err;
	end;
	else if bchr = "-to" then do;
	     call get_next_arg;
	     call convert_date_to_binary_ (bchr, xtime, ec);
	     if ec = 0 then end_time = xtime;
	     else do;
		iend = cv_dec_check_ (bchr, ec);
		if ec ^= 0 then go to date_dec_err;
	     end;
	end;
	else if bchr = "-from" | bchr = "-fm" then do;
	     call get_next_arg;
	     call convert_date_to_binary_ (bchr, xtime, ec);
	     if ec = 0 then start_time = xtime;
	     else do;				/* Not a date, see if number */
		i = cv_dec_check_ (bchr, ec);
		if ec ^= 0 then goto date_dec_err;
		else istart = i;
	     end;
	end;
	else if bchr = "-last" then do;
	     call get_next_arg;
	     i = cv_dec_check_ (bchr, ec);
	     if ec ^= 0 then goto dec_err;
	     else istart = -i;
	end;
	else if bchr = "-for" | bchr = "-next" then do;
	     call get_next_arg;
	     print_count = cv_dec_check_ (bchr, ec);
	     if ec ^= 0 then do;			/* must be a date-time */
		print_count = 0;
		for_time_string = bchr;		/* it is a relative date-time - e.g., "1hour" */
	     end;					/* so wait 'til we know the first message's date-time,
						   before converting the relative date-time */
	end;
	else if bchr = "-sysdir" then do;
	     call get_next_arg;
	     sysdir = bchr;
	end;
	else if bchr = "-history_dir" then do;
	     call get_next_arg;
	     history_dir = bchr;
	end;
	else if bchr = "-log" | bchr = "-log_name" | bchr = "-et" | bchr = "-entry" then do;
	     call get_next_arg;
	     log_name = bchr;
	end;
	else if substr (bchr, 1, 1) = "-" then do;
	     i = cv_dec_check_ (bchr, ec);		/* check for negative number */
	     if ec = 0 then do;
		istart = i;
		goto nxtarg;
	     end;

	     call com_err_ (error_table_$badopt, "print_log", "^a", bchr);
						/* if it's not a negative number, it must be an error */
	     return;
	end;
	else do;					/* obsolete */
	     i = cv_dec_check_ (bchr, ec);
	     if ec = 0 then do;
		istart = i;
		go to nxtarg;
	     end;
	     path = bchr;
	     pl = al;
	     pathsw = "1"b;
	     call expand_path_ (addr (path), pl, addr (dn), addr (en), ec);
	     if ec ^= 0 then goto arg_err;
	end;
nxtarg:	an = an + 1;
	go to arglp;

endarg:

/* Find first message to be printed. Might have to chase backpointers to previous logs.
   Only chase backpointers when log pathname not given.
   If -from DATE given and DATE is before first date in current log, or
   -last N given and there are less than N messages in logs initiated so far,
   then look in previous logs to find first message. */


	if ^pathsw then do;				/* if path not given, start with current log */
	     dn = sysdir;
	     en = log_name;
	end;

	on cleanup call terminate_logs;		/* set up cleanup handler before initiating logs */

	first_msg_found = ""b;
	do while (^first_msg_found);			/* keep looking 'til we find it */

	     if n_logs ^< hbound (log_ptrs, 1) then do;	/* if too many logs initiated */
		call com_err_ (0, me, "Limit of ^d previous logs exceeded.", hbound (log_ptrs, 1));
		first_msg_found = "1"b;		/* pretend we found it, and print what we have */
	     end;

	     else do;				/* initiate another log, and look at it */
		log_ptrs (n_logs+1) = null;		/* in case of cleanup */
		n_logs = n_logs + 1;
try_initiate:
		call hcs_$initiate (dn, en, "", 0, 1, log_ptrs (n_logs), ec);
		if log_ptrs (n_logs) = null then do;	/* if initiate failed */
		     if ec = error_table_$noentry & n_logs > 1 then do; /* previous log not there */
			if n_logs >= 2 & dn = sysdir then do; /*  previous log not in sysdir */
			     dn = history_dir;	/* it was probably moved to history directory */
			     goto try_initiate;	/* so much for gotoless programming */
			end;

			else do;			/* logs not saved that far back */
			     if n_logs = 2 then	/* immediately previous log not found */
				call com_err_ (0, me, "Previous ^a not found in ^a", en, dn);
			     else do;		/* some logs found, but not back far enough */
				if istart ^< 0 then do; /* if -last N not given, -from DATE must have been */
				     call date_time_ (time (1), timestr);
				     call com_err_ (0, me, "Saved logs go back only to ^a.", timestr);
				end;
				else call com_err_ (0, me, "Saved logs contain only the last ^d messages.", n_msgs);
			     end;
			     first_msg_found = "1"b;	/* stop looking, and print what we have */
			     n_logs = n_logs - 1;	/* don't try to print the one that wasn't there */
			end;

		     end;				/* end previous log not there */

		     else do;			/* real error */
			call com_err_ (ec, me, "^a>^a", dn, en);
			goto cleanup_and_return;
		     end;
		end;				/* end initiate failed */

		else if n_logs > 1 then do;		/* save info for printing log pathname in heading */
		     if dn = history_dir then history (n_logs) = "1"b;
		     xlls (n_logs) = lls;
		end;

		sys_log_ptr = log_ptrs (n_logs);	/* set pointer that log structure is based on */

/* See if this log contains the starting message that we want */

		n_msgs = n_msgs + count;		/* total messages in all initiated logs */

		if ^pathsw			/* if log pathname not given */
		& (start_time > 0 & start_time < time (1) /* and -from DATE given and DATE isn't in this log */
		| istart < 0 & abs (istart) > n_msgs	/* or -last N given and logs don't have N messages yet */
		| count = 0)			/* or log is empty (just contains name of previous one) */
		then en = rtrim (log_name) || ".-." || rtrim (lls); /* then construct entry name of previous log,
						   and look for it by staying in the loop */

		else first_msg_found = "1"b;		/* else first msg is in this log so stop looking */
	     end;					/* end log_ptrs array not full */
	end;					/* end do while ^first_msg_found */

/* We've found the log containing the first message. Now find the index of the message */

	if istart < 0 then				/* if -last N given */
	     istart = n_msgs + istart + 1;		/* equivalent to n_msgs - N + 1 */
	if istart < 1 then istart = 1;		/* if we don't have N messages, start with first one */

	if start_time > 0 then			/* if -from DATE given */
	     do istart = istart to count		/* scan log */
	     while (time (istart) < start_time); end;	/* for first message at or after that date-time */

/* Now see if -for TIME was given. If so, compute end time relative to start time */

	if for_time_string ^= "" then do;		/* if -for TIME was given */
	     if start_time > 0 then			/* if -from DATE was given */
		fb71 = start_time;			/* use that time */
	     else fb71 = time (istart);		/* otherwise use time of starting message */
	     call convert_date_to_binary_$relative (for_time_string, end_time, fb71, ec);
	     if ec ^= 0 then do;
		call com_err_ (ec, me, "^a", for_time_string);
		goto cleanup_and_return;
	     end;
	end;

/* Now print the log(s) */

	do log_no = n_logs to 1 by -1;

	     sys_log_ptr = log_ptrs (log_no);		/* copy pointer to log to be printed */

	     call date_time_ (ttime, timestr);
	     if hdsw then do;
		if ^pathsw then do;			/* unless path arg given, construct path to print in heading */
		     if history (log_no) then dn = history_dir;
		     else dn = sysdir;
		     if log_no = 1 then en = log_name;
		     else en = rtrim (log_name) || ".-." || rtrim (xlls (log_no));
		end;
		call ioa_ ("^/""^a>^a"" - ^d entries, last ^a^/", dn, en, count, timestr);
	     end;

	     do i = istart to count;

		if time (i) > end_time then go to endlp1;
		if svty (i) < ss then go to endlp;
		do shx = 1 to nsharg while (index (line (i), searcharg (shx)) = 0); end;
		if nsharg > 0 & shx > nsharg then go to endlp; /* If all fail skip */
		do shx = 1 to nexclarg while (index (line (i), exclarg (shx)) = 0); end;
		if nexclarg > 0 & shx <= nexclarg then go to endlp; /* If any found skip */

		call date_time_ (time (i), timestr);
		if substr (timestr, 1, 8) = odate then substr (timestr, 1, 8) = " ";
		else odate = substr (timestr, 1, 8);
		call ioa_ ("^4d ^16a ^d ^a", i, timestr, svty (i), line (i));
		print_count = print_count - 1;
		if print_count = 0 then go to endlp1;
		if iend > 0 & i = iend then goto endlp1;
endlp:	     end;

	     istart = 1;				/* start at beginning of next log */
	end;					/* end loop thru several logs */

endlp1:	call ioa_ ("");
cleanup_and_return:
	call terminate_logs;
	return;

arg_err:	call com_err_ (ec, me, "^a", bchr);
	return;

date_dec_err: call com_err_ (0, me, "Argument after ^a not date or decimal number: ^a", prev_arg, bchr);
	return;

dec_err:	call com_err_ (0, me, "Invalid decimal number (digit ^d): ^a", ec, bchr);
	return;

noarg_err: call com_err_ (ec, me, "after ""^a""", prev_arg);
	return;

/* ********** INTERNAL PROCEDURES ********** */

get_next_arg: proc;

	     prev_arg = bchr;			/* save current argument, for possible error message */
	     an = an + 1;				/* increment argument index */
	     call cu_$arg_ptr (an, ap, al, ec);
	     if ec ^= 0 then goto noarg_err;
	     return;

	end get_next_arg;

/* ********** ********** */

terminate_logs: proc;

dcl  i fixed bin;

	     do i = 1 to n_logs;
		call hcs_$terminate_noname (log_ptrs (i), (0));
	     end;
	     return;

	end terminate_logs;

     end print_log;




		    write_log_.pl1                  01/16/85  1233.0rew 01/16/85  1229.9       31680



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


write_log_: proc (dtime, xsv, lin);

/* WRITE_LOG_ - add an entry to a system control log file.

   THVV */

dcl  dtime fixed bin (71),
     xsv fixed bin,
     lin char (*);

dcl  logptr ptr int static init (null);			/* ptr to standard log. */
dcl  dn char (64) aligned int static init (">system_control_1");

dcl  hcs_$terminate_noname entry (ptr, fixed bin);
dcl  hcs_$make_seg entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (5), ptr, fixed bin);
dcl  copy_acl_ entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (1), fixed bin);
dcl  hcs_$chname_seg entry (ptr, char (*) aligned, char (*) aligned, fixed bin);
dcl  date_time_ entry (fixed bin (71), char (*) aligned);
dcl  ioa_$rsnnl entry options (variable);

dcl  en char (32) aligned;
dcl  sys_log_ptr ptr;
dcl  filesw bit (1) aligned;
dcl  xlls char (32) aligned init ("");
dcl  ec fixed bin;
dcl  i fixed bin;
dcl  timestr char (16) aligned;
dcl  on char (32) aligned;

dcl (null, substr) builtin;

%include syslog;

/* -------------------------------------------------------- */

	en = "log";				/* Default name. */
	sys_log_ptr = logptr;			/* .. dft ptr */
	filesw = "0"b;
	go to join;

/* Entry point used if writing to other than default log file. */

write_log_file: entry (dtime, xsv, lin, sname, logp);

dcl  sname char (*),				/* Name of log file to write. */
     logp ptr;					/* ptr to log */

	sys_log_ptr = logp;				/* Copy args */
	en = sname;				/* .. */
	filesw = "1"b;

join:	if sys_log_ptr = null then do;		/* Do we know where file is? */
refind:	     call hcs_$make_seg (dn, en, "", 1011b, sys_log_ptr, ec);
	     if sys_log_ptr = null then return;		/* can't happen */
	     if filesw then logp = sys_log_ptr;		/* Found new log maybe */
	     else logptr = sys_log_ptr;		/* Anyway, make avail for next time. */
	     if sys_log_file.max = 0 then do;		/* new segment? */
		sys_log_file.max = 2047;		/* 64K segment */
		sys_log_file.lls = xlls;		/* save name of old one */
		call copy_acl_ (dn, on, dn, en, ("0"b), (0));
	     end;
	end;

	if sys_log_file.count >= sys_log_file.max then do;
	     call date_time_ (dtime, timestr);
	     xlls = substr (timestr, 11, 4) || "-" || substr (timestr, 1, 5);
	     call ioa_$rsnnl ("^a.-.^a", on, i, en, xlls); /* Make name for old log. */
	     call hcs_$chname_seg (sys_log_ptr, en, on, ec);
	     if ec ^= 0 then return;			/* can't happen */
	     call hcs_$terminate_noname (sys_log_ptr, ec);
	     go to refind;				/* now make new segment */
	end;

	sys_log_file.count = sys_log_file.count + 1;	/* increase count */
	sys_log_file.ttime = dtime;			/* set last-time-logged */
	i = sys_log_file.count;			/* get into XR */
	sys_log_file.array (i).time = dtime;		/* set time of message */
	sys_log_file.array (i).svty = xsv;		/* ... severity */
	sys_log_file.array (i).line = lin;		/* ... formatted line */

	return;

/* Entry point for testing. */

write_log_test: entry (xdir);

dcl  xdir char (*);

	dn = xdir;

     end write_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
