



		    log_data_.cds                   11/11/89  1057.9r w 11/11/89  0801.8       19251



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Bull Inc., 1987                *
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   *                                                         *
   *********************************************************** */
log_data_:
     procedure ();

/* *	LOG_DATA_
   *
   *	Constants concerning new-format logs, and, in particular, the names and
   *	directories for the new-format syserr log.
   *
   *	Modification history:
   *	84-10-30, W. Olin Sibert: Converted from ALM
   */

declare 1 log_data			aligned automatic,
	2 default_log_size		fixed bin		init (51200),
          2 new_message_flag            bit (36) aligned    init ("777111555333"b3),
          2 complete_message_flag       bit (36) aligned    init ("666000444222"b3),
          2 deleted_message_flag        bit (36) aligned    init ("111777333555"b3),
	2 max_text_lth		fixed bin (21)	init (16000),
	2 max_data_size		fixed bin (18)	init (16000),

	2 syserr_log_name		char (32)		init ("syserr_log"),
	2 syserr_log_empty_name	char (32)		init ("syserr_log.empty"),
	2 syserr_log_dir		char (168)	init (">system_library_1"),
	2 syserr_log_history_dir	char (168)	init (">system_control_1>syserr_log"),
	2 syserr_log_partition	char (4)		init ("log"),
	2 syserr_log_daemon		char (32)		init ("SyserrLogger.SysDaemon.z");


declare 1 cds_info aligned like cds_args;
declare	code fixed bin (35);

declare	com_err_ entry options (variable);
declare	create_data_segment_ entry (pointer, fixed bin (35));

/* */

	unspec (cds_info) = ""b;
	cds_info.sections (1).p = addr (log_data);
	cds_info.sections (1).len = size (log_data);
	cds_info.sections (1).struct_name = "log_data";
	cds_info.seg_name = "log_data_";
	cds_info.switches.have_text = "1"b;

	call create_data_segment_ (addr (cds_info), code);

	if (code ^= 0) then
	     call com_err_ (code, cds_info.seg_name, "Cannot create CDS segment.");

	return;

%page; %include cds_args;

	end log_data_;




		    log_initialize_.pl1             11/11/89  1057.9r w 11/11/89  0801.8       33318



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
log_initialize_:
     procedure (P_old_log_ptr, P_new_log_ptr, P_log_size, P_prev_dname, P_code);

/* *	This procedure initializes a new log segment, either cleaning out
   *	the header entirely, or copying all pertinent information from the
   *	header of a previous log. If P_old_log_ptr is null, the P_prev_dname
   *	is ignored.
   *
   *	Written 84-05-05, W. Olin Sibert
   */

declare	P_old_log_ptr pointer parameter;
declare	P_new_log_ptr pointer parameter;
declare	P_log_size fixed bin (18) parameter;
declare	P_prev_dname char (*) parameter;
declare	P_code fixed bin (35) parameter;

declare	old_log_ptr pointer;
declare	new_log_ptr pointer;
declare	log_size fixed bin (18);
declare	code fixed bin (35);
declare	last_message fixed bin (35);

declare	error_table_$log_segment_damaged fixed bin (35) external static;

declare	log_segment_$initialize_sequence entry (pointer, fixed bin (35), fixed bin (35));
declare	log_segment_$last_message_info entry (pointer, fixed bin (35), fixed bin (18), fixed bin (35));
declare	log_segment_$place_in_service entry (pointer, fixed bin (35));
declare	log_segment_$remove_from_service entry (pointer, fixed bin (35));

declare  (clock, null, size, unspec) builtin;

/* */

	old_log_ptr = P_old_log_ptr;
	new_log_ptr = P_new_log_ptr;
	log_size = P_log_size;

	if (old_log_ptr = null ()) then
	     call initialize_new_log ();
	else call copy_old_log ();

	call log_segment_$place_in_service (new_log_ptr, (0)); /* Had better work.... */

	P_code = code;
	return;



initialize_new_log:
     procedure ();

	code = 0;
	log_segment_ptr = new_log_ptr;

	unspec (log_segment.header) = ""b;

	log_segment.max_size = log_size - size (log_segment_header);

/* All sys logs start with message 100000, to make output formatting more pleasant */

	call log_segment_$initialize_sequence (log_segment_ptr, 999999, (0));

	log_segment.previous_log_dir = "";		/* Since there was no old log */
	log_segment.time_created = clock ();		/* Record time of creation */
	log_segment.version = LOG_SEGMENT_VERSION_1;

	return;
	end initialize_new_log;

/* */

copy_old_log:
     procedure ();

	code = 0;
	log_segment_ptr = null ();			/* Since we don't use it here */

	if (old_log_ptr -> log_segment.version ^= LOG_SEGMENT_VERSION_1) then do;
	     code = error_table_$log_segment_damaged;
	     return;
	     end;

	unspec (new_log_ptr -> log_segment.header) = ""b;

	new_log_ptr -> log_segment.max_size = log_size - size (log_segment_header);

	call log_segment_$remove_from_service (old_log_ptr, (0));
	call log_segment_$last_message_info (old_log_ptr, last_message, (0), (0));
	call log_segment_$initialize_sequence (new_log_ptr, last_message, (0));

	new_log_ptr -> log_segment.previous_log_dir = P_prev_dname;

	new_log_ptr -> log_segment.listener = old_log_ptr -> log_segment.listener;
	new_log_ptr -> log_segment.last_wakeup_time = old_log_ptr -> log_segment.last_wakeup_time;
	new_log_ptr -> log_segment.wakeup_delta = old_log_ptr -> log_segment.wakeup_delta;

	new_log_ptr -> log_segment.time_created = clock ();	/* Record when this happened */
	new_log_ptr -> log_segment.version = LOG_SEGMENT_VERSION_1;

	return;
	end copy_old_log;

%page; %include log_segment;

	end log_initialize_;




		    log_name_.pl1                   11/11/89  1057.9r w 11/11/89  0801.8       39906



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
log_name_:
     procedure ();

/* *	LOG_NAME_
   *
   *	This procedure deals with log segment names and the date/time suffix.
   *	The log_name_$name entrypoint, given a clock reading and a name,
   *	returns the name with the appropriate suffix.  The log_name_$time
   *	entrypoint, given a suffixed name, returns the time stamp by converting
   *	it back from GMT. These names have a fixed format, and all the log_read_
   *	code depends on that format.
   *
   *	Modification history:
   *	84-06-01, W. Olin Sibert: Initial coding
   *	84-10-16, WOS: Added log_name_$starname
   *	84-10-30, WOS: Converted to use date_time_$format
   */

declare	P_ename char (*) parameter;
declare	P_time fixed bin (71) parameter;

declare	code fixed bin (35);
declare	name_lth fixed bin;
declare	return_str char (32);

declare 1 suffix_rep	unaligned automatic,
	2 period_1	char (1),
	2 yc		pic "9999",
	2 my		pic "99",
	2 dm		pic "99",
	2 period_2	char (1),
	2 Hd		pic "99",
	2 MH		pic "99",
	2 SM		pic "99";

declare 1 suffix_time	aligned like time_value automatic;
declare	suffix_clock fixed bin (71);

declare	error_table_$bigarg fixed bin (35) external static;
declare	error_table_$improper_data_format fixed bin (35) external static;
declare	error_table_$smallarg fixed bin (35) external static;

declare	date_time_$format entry (char (*), fixed bin (71), char (*), char (*)) returns (char (250) varying);
declare	date_time_$to_clock entry (pointer, fixed bin (71), fixed bin (35));
declare	sub_err_ entry options (variable);

declare	WHOAMI char (32) internal static options (constant) init ("log_name_");
declare	PERIOD char (1) internal static options (constant) init (".");
declare	GMT char (3) internal static options (constant) init ("gmt");

declare	conversion condition;

declare  (addr, length, null, rtrim, string, substr, unspec) builtin;

/* */

log_name_$name:
     entry (P_ename, P_time) returns (char (32));

	call check_ename ();

	substr (return_str, 1, name_lth) = substr (P_ename, 1, name_lth);
	substr (return_str, name_lth + 1) = date_time_$format (".^9999yc^my^dm.^Hd^MH^SM", P_time, GMT, "");
	return (return_str);



log_name_$starname:
     entry (P_ename) returns (char (32));

	call check_ename ();

	return_str = substr (P_ename, 1, name_lth) || ".????????.??????";
	return (return_str);

/* */

log_name_$time:
     entry (P_ename) returns (fixed bin (71));

	name_lth = length (rtrim (P_ename));
	code = error_table_$improper_data_format;	/* For sub_err_ calls */
	if (name_lth <= length (string (suffix_rep))) then goto INVALID_SUFFIX;

	string (suffix_rep) = substr (P_ename, 1 + name_lth - length (string (suffix_rep)));

	if ((suffix_rep.period_1) ^= PERIOD) then goto INVALID_SUFFIX;
	if ((suffix_rep.period_2) ^= PERIOD) then goto INVALID_SUFFIX;

	on condition (conversion) goto INVALID_SUFFIX;

	unspec (suffix_time) = ""b;
	suffix_time.version = Vtime_value_3;
	suffix_time.za = GMT;

	suffix_time.yc = suffix_rep.yc;		/* Convert the character fields for consumption */
	suffix_time.my = suffix_rep.my;		/* by date_time_$to_clock. */
	suffix_time.dm = suffix_rep.dm;
	suffix_time.Hd = suffix_rep.Hd;
	suffix_time.MH = suffix_rep.MH;
	suffix_time.SM = suffix_rep.SM;

	call date_time_$to_clock (addr (suffix_time), suffix_clock, code);

	if (code ^= 0) then do;
INVALID_SUFFIX:
	     call sub_err_ (code, WHOAMI, ACTION_CANT_RESTART, null (), "",
		"Cannot convert suffix of ""^a"" to time value.", P_ename);
	     end;

	return (suffix_clock);

/* */

check_ename:
     procedure ();

	name_lth = length (rtrim (P_ename));
	if ((name_lth + length (string (suffix_rep))) > 32) then
	     code = error_table_$bigarg;
	else if (name_lth = 0) then
	     code = error_table_$smallarg;
	else return;

	call sub_err_ (code, WHOAMI, ACTION_CANT_RESTART, null (), "",
	     "Cannot add YYYYMMDD.HHMMSS suffix to ""^a"".", P_ename);

	end check_ename;

%page; %include sub_err_flags;
%page; %include time_value;

	end log_name_;




		    log_position_.pl1               11/11/89  1057.9rew 11/11/89  0801.9      134505



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

/* format: style4 */

log_position_:
     procedure ();

/* *	LOG_POSITION_
   *
   *	Primitives for motion within a log segment.  This includes moving
   *	forward and backward by a single message, and also positioning, by
   *	time or sequence number, within a single log segment.
   *
   *	84-08-17, WOS: Initial coding.
   *	85-03-25, EJ Sharpe: msgs with zero length text are now valid
*/

declare  P_log_segment_ptr pointer parameter;		/* Input: Log segment being positioned within */
declare  P_log_message_ptr pointer parameter;		/* Input/Output: Message in log */
declare  P_log_damage bit (1) aligned parameter;		/* Output: Whether we had to search for message boundaries */
declare  P_message_time fixed bin (71) parameter;		/* Input: Time to start searching for message */
declare  P_message_sequence fixed bin (35) parameter;	/* Input: Sequence number to search for */
declare  P_sequence_direction bit (1) aligned parameter;	/* Input: Sequence number to search for */

declare  last_message_offset fixed bin (18);		/* Global variables, all initialized by the */
declare  last_message_sequence fixed bin (35);		/* set_log_ptr internal procedure. */
declare  time_now fixed bin (71);
declare  log_damage bit (1) aligned;

declare  log_segment_$last_message_info entry (pointer, fixed bin (35), fixed bin (18), fixed bin (35));

declare  log_data_$complete_message_flag bit (36) aligned external static;

declare  SEQUENCE_SLOP init (5) fixed bin (35) internal static options (constant);
declare  TIME_SLOP init (15000) fixed bin (71) internal static options (constant);

declare  OLDEST_TIME init (2015000000000000) fixed bin (71) internal static options (constant); /* 1965-01-01 */
declare  ONE_MONTH init (2592000000000) fixed bin (71) internal static options (constant);

declare  (addr, addrel, clock, currentsize, null, pointer, wordno) builtin;

/**/

/* NEXT_MESSAGE -- Move on to the next message in the log segment. If we're not
   looking at a message already, find the first one. */

log_position_$next_message:
     entry (P_log_segment_ptr, P_log_message_ptr, P_log_damage);

	call set_log_ptr ();			/* Sets log_segment_ptr and log_damaged */
	log_message_ptr = P_log_message_ptr;

	if (log_message_ptr = null ()) then
	     log_message_ptr = addr (log_segment.data);
	else log_message_ptr = addrel (log_message_ptr, currentsize (log_message));

	call find_next_valid_message ();

	call set_message_ptr ();			/* Sets log_message_ptr and P_log_damage as needed */
	return;

/**/

/* PREV_MESSAGE -- Move on to the previous message in the log segment. If we're not
   looking at a message already, position to the last one in the segment. */

log_position_$prev_message:
     entry (P_log_segment_ptr, P_log_message_ptr, P_log_damage);

	call set_log_ptr ();			/* Sets log_segment_ptr and log_damaged */
	log_message_ptr = P_log_message_ptr;

	if (log_message_ptr = null ()) then
	     log_message_ptr = pointer (log_segment_ptr, last_message_offset);
	else log_message_ptr = addrel (log_message_ptr, -1);

/* We can't detect damage while doing the search in this direction, unfortunately, since
   we don't have sentinels at message ends. Instead, we just search backwards, hoping to
   encounter a message start sentinel somewhere */

	do while (^likely_message ());
	     log_message_ptr = addrel (log_message_ptr, -1);
	end;

	call set_message_ptr ();			/* Sets log_message_ptr and P_log_damage as needed */
	return;

/**/

/* All these searching entrypoints just do a linear search of the log segment,
   which, while slow, is at least simple to understand. A binary search can be
   added later. */



log_position_$find_time:
     entry (P_log_segment_ptr, P_message_time, P_sequence_direction, P_log_message_ptr, P_log_damage);

	call set_log_ptr ();			/* Sets log_segment_ptr and log_damaged */

	call time_search (P_message_time, P_sequence_direction);

	call set_message_ptr ();			/* Sets log_message_ptr and P_log_damage as needed */
	return;



log_position_$find_sequence:
     entry (P_log_segment_ptr, P_message_sequence, P_sequence_direction, P_log_message_ptr, P_log_damage);

	call set_log_ptr ();			/* Sets log_segment_ptr and log_damaged */

	call sequence_search (P_message_sequence, P_sequence_direction);

	call set_message_ptr ();			/* Sets log_message_ptr and P_log_damage as needed */
	return;

/**/

set_log_ptr:
     procedure ();

/* This routine sets some global variables used for damage detection, and must
   be called by all entrypoints before any work is done. */

	log_segment_ptr = P_log_segment_ptr;
	log_damage = "0"b;
	time_now = clock ();
	call log_segment_$last_message_info (log_segment_ptr, last_message_sequence, last_message_offset, (0));

	return;
     end set_log_ptr;




set_message_ptr:
     procedure ();

/* This routine is used to set the output message pointer, and the damage flag
   if necessary, and must be called by all entrypoints before returning. */

	P_log_message_ptr = log_message_ptr;
	if log_damage then				/* Set the output flag only if new damage found */
	     P_log_damage = "1"b;

	return;
     end set_message_ptr;

/**/

sequence_search:
     procedure (P_sequence, P_after_sw);

/* This procedure searches for a message given its sequence number. It and time_search
   are essentially identical, differing only in the declarations and names of variables.
   They both perform a linear search of the log segment, stopping when an exact match,
   or the closest "nearby" inexact match, is found. */


declare  P_sequence fixed bin (35) parameter;
declare  P_after_sw bit (1) aligned parameter;

declare  wanted_sequence fixed bin (35);
declare  after_sw bit (1) aligned;
declare  closest_message pointer;
declare  sequence_difference fixed bin (35);
declare  sequence_delta fixed bin (35);
declare  search_tries fixed bin;
declare  this_sequence fixed bin (35);


	wanted_sequence = P_sequence;
	after_sw = P_after_sw;

	if ^after_sw then				/* Return oldest message even if way later */
	     if ((wanted_sequence + SEQUENCE_SLOP) < log_segment.first_sequence) then do;
		log_message_ptr = null ();		/* for this_or_greater case */
		return;				/* Otherwise, return null (as here) */
	     end;

	if after_sw then				/* Return latest message even if way before */
	     if ((wanted_sequence - SEQUENCE_SLOP) > log_segment.last_sequence) then do;
		log_message_ptr = null ();		/* for this_or_before case */
		return;				/* Otherwise, return null (as here) */
	     end;

	log_message_ptr = addr (log_segment.data);	/* Note that a null return will cause the following */
	call find_next_valid_message ();		/* loop to be ignored, as it should be. */

	sequence_delta = 1f8;			/* Very large number */
	closest_message = log_message_ptr;
	if after_sw then				/* Number of extra messages we will check to find a close one */
	     search_tries = SEQUENCE_SLOP;		/* Larger in "at or before" mode because the target is */
	else search_tries = SEQUENCE_SLOP * 2;		/* approached from below (see explanation below) */

	do while ((log_message_ptr ^= null ()) & (search_tries > 0));
	     this_sequence = log_message.sequence;

/* If an exact match is found, return immediately, regardless. */

	     if (this_sequence = wanted_sequence) then return;

	     if after_sw then
		sequence_difference = this_sequence - wanted_sequence;
	     else sequence_difference = wanted_sequence - this_sequence;

/* If we are looking for "at or after", sequence_difference will be positive as soon as
   we encounter a message after the desired number, and contrariwise in "at or before"
   mode.	Once that happens, we start looking for the closest "nearby" message, but no
   more that SEQUENCE_SLOP times.  In "at or before" mode, sequence_difference will be
   positive at least until we find the desired message, and smaller than SEQUENCE_SLOP
   all the while we're near but below, which is why we give it twice SEQUENCE_SLOP
   chances to find the nearest.  */

	     if (sequence_difference > 0) then
		if (sequence_difference < sequence_delta) then do;
		     closest_message = log_message_ptr;
		     sequence_delta = sequence_difference;
		end;

	     if (sequence_delta < SEQUENCE_SLOP) then
		search_tries = search_tries - 1;

	     log_message_ptr = addrel (log_message_ptr, currentsize (log_message));
	     call find_next_valid_message ();
	end;

	log_message_ptr = closest_message;
	return;

     end sequence_search;

/**/

time_search:
     procedure (P_time, P_after_sw);

declare  P_time fixed bin (71) parameter;
declare  P_after_sw bit (1) aligned parameter;

declare  wanted_time fixed bin (71);
declare  after_sw bit (1) aligned;
declare  closest_message pointer;
declare  time_difference fixed bin (71);
declare  time_delta fixed bin (71);
declare  search_tries fixed bin;
declare  this_time fixed bin (71);


	wanted_time = P_time;
	after_sw = P_after_sw;

	if ^after_sw then				/* Return oldest message even if way later */
	     if ((wanted_time + TIME_SLOP) < log_segment.first_time) then do;
		log_message_ptr = null ();		/* for this_or_greater case */
		return;				/* Otherwise, return null (as here) */
	     end;

	if after_sw then				/* Return latest message even if way before */
	     if ((wanted_time - TIME_SLOP) > log_segment.last_time) then do;
		log_message_ptr = null ();		/* for this_or_before case */
		return;				/* Otherwise, return null (as here) */
	     end;

	log_message_ptr = addr (log_segment.data);	/* Note that a null return will cause the following */
	call find_next_valid_message ();		/* loop to be ignored, as it should be. */

	time_delta = 1f70b;				/* Very large number */
	closest_message = log_message_ptr;
	if after_sw then				/* Number of extra messages we check to find a close one */
	     search_tries = SEQUENCE_SLOP;		/* Larger in "at or before" mode because the target is */
	else search_tries = SEQUENCE_SLOP * 2;		/* approached from below (see explanation below) */

	do while ((log_message_ptr ^= null ()) & (search_tries > 0));
	     this_time = log_message.time;

/* If an exact match is found, return immediately, regardless. */

	     if (this_time = wanted_time) then return;

	     if after_sw then
		time_difference = this_time - wanted_time;
	     else time_difference = wanted_time - this_time;

/* If we are looking for "at or after", time_difference will be positive as soon as
   we encounter a message after the desired number, and contrariwise in "at or before"
   mode.	Once that happens, we start looking for the closest "nearby" message, but no
   more that SEQUENCE_SLOP times.  In "at or before" mode, time_difference will be
   positive at least until we find the desired message, and smaller than TIME_SLOP
   all the while we're near but below, which is why we give it twice SEQUENCE_SLOP
   chances to find the nearest.  */

	     if (time_difference > 0) then
		if (time_difference < time_delta) then do;
		     closest_message = log_message_ptr;
		     time_delta = time_difference;
		end;

	     if (time_delta < TIME_SLOP) then
		search_tries = search_tries - 1;

	     log_message_ptr = addrel (log_message_ptr, currentsize (log_message));
	     call find_next_valid_message ();
	end;

	log_message_ptr = closest_message;
	return;

     end time_search;

/**/

find_next_valid_message:
     procedure ();

/* This procedure simply sets log_message_ptr to a valid message. If it
   already points to a valid message, it remains unchanged; otherwise, it is
   advanced, one word at a time, until it either points to a valid message,
   or is set to null, indicating that there are no valid messages.  The global
   log_damage flag is set to indicate that log_message_ptr started out
   pointing to an invalid message.

   If this program (log_position_) ever learns to do searches by a binary
   positioning mechanism, another version of find_next_valid message will be
   required, since the first attempt to find a message after a binary probe
   will likely not find a valid message, and a search will almost always be
   necessary. */


	do while (^likely_message ());
	     log_damage = "1"b;			/* Let our caller know that we had to search */
	     log_message_ptr = addrel (log_message_ptr, 1);
	end;

	return;
     end find_next_valid_message;

/**/

likely_message:
     procedure () returns (bit (1) aligned);

declare  message_offset fixed bin (18);
declare  message_time fixed bin (71);

/* This procedure inspects a possible log message to see whether it appears
   to be a completed message. If any of the tests fail, it will return "0"b. */

/* Null pointer is a flag meaning "log contents exhausted"; it's checked here
   to make the do while (likely_message) loops easier to code */

	if (log_message_ptr = null ()) then return ("1"b);

/* We have to detect running over the bounds first, before checking the message
   contents, in order to avoid running outside the bounds of the data area.
   Fortunately, these checks should be reasonably quick. */

	message_offset = wordno (log_message_ptr);
	if (message_offset < wordno (addr (log_segment.data))) then do;
	     log_message_ptr = null ();		/* Can only happen searching backwards (or from caller's */
	     return ("1"b);				/* error)-- means we've run out going back, which is */
	end;					/* signalled by the null message pointer */

	if (message_offset > last_message_offset) then do;
	     log_message_ptr = null ();		/* Similarly, we've run out looking forward. Give up */
	     return ("1"b);
	end;

	if (log_message.sentinel ^= log_data_$complete_message_flag) then /* Bad sentinel, means not a message or an */
	     return ("0"b);				/* unfinished message. Try again. */

	message_time = log_message.time;
	if (message_time < OLDEST_TIME) then		/* No messages from before 1965, thank you */
	     return ("0"b);
	if (message_time > (time_now + ONE_MONTH)) then	/* Allow some slop for jumping clocks */
	     return ("0"b);

	if (log_message.text_lth < 0) then		/* Must at least have *some* text, */
	     return ("0"b);
	if (log_message.data_lth < 0) then		/* but not necessarily any data */
	     return ("0"b);
	if (log_message.data_class_lth < 0) then
	     return ("0"b);

	if ((currentsize (log_message) + message_offset - 1) > last_message_offset) then
	     return ("0"b);				/* Bogus lengths in message, it would appear */

	return ("1"b);				/* It's passed all the syntactic tests */
     end likely_message;

%page; %include log_message;
%page; %include log_segment;

     end log_position_;




		    log_segment_.pl1                11/11/89  1057.9r w 11/11/89  0800.0      166518



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
log_segment_:
     procedure ();

/* *	LOG_SEGMENT_
   *
   *	This procedure is the lowest level of the new logging mechanism.
   *	It is responsible for the creation of messages within a single
   *	log segment. If the segment becomes full, or is damaged, log_segment_
   *	returns an appropriate error code, and its caller must take appropriate
   *	action.  This procedure can be called from any ring, in any environment.
   *	This is the only procedure that can intepret the allocation information
   *	in the log segment header; other procedures must call this one to
   *	create messages, take the segment in and out of service, etc.
   *
   *	Modification history:
   *	1984-05-04, W. Olin Sibert, after the style of Benson's log_prim_
   *	1984-12-21, WOS: Changed to make data class 16 chars as it should be
   */

declare	P_log_segment_ptr pointer parameter;
declare	P_text_lth fixed bin parameter;
declare	P_data_lth fixed bin parameter;
declare	P_data_class char (16) varying parameter;
declare	P_message_number fixed bin (35) parameter;
declare	P_last_offset fixed bin (18) parameter;
declare	P_log_message_ptr pointer parameter;
declare	P_service_bit bit (1) aligned parameter;
declare	P_code fixed bin (35) parameter;

declare	message_size fixed bin (18);
declare	message_number fixed bin (35);

declare 1 sequence_info aligned automatic,
	2 pad bit (17) unaligned,
	2 number fixed bin (35) unaligned,		/* NOTE: This value spans a word boundary */
	2 in_service bit (1) unaligned,
	2 words_used fixed bin (18) unsigned unaligned;

declare	error_table_$action_not_performed fixed bin (35) external static;
declare	error_table_$bigarg fixed bin (35) external static;
declare	error_table_$log_out_of_service fixed bin (35) external static;
declare	error_table_$log_segment_damaged fixed bin (35) external static;
declare	error_table_$log_segment_full fixed bin (35) external static;

declare   log_data_$new_message_flag bit (36) aligned external static;
declare   log_data_$complete_message_flag bit (36) aligned external static;

declare  (addr, length, null, size, stacq, unspec, wordno) builtin;

/* */

MAIN_RETURN:
	return;					/* Only exit from this subroutine */



finished:
     procedure (P_return_code);

declare	P_return_code fixed bin (35) parameter;


	P_code = P_return_code;

	goto MAIN_RETURN;

	end finished;

/* */

log_segment_$create_message_number:
     entry (P_log_segment_ptr, P_text_lth, P_data_lth, P_data_class, P_message_number, P_log_message_ptr, P_code);

/* This entry reserves space for a message in the log segment, assigns
   the next sequence number to it, and returns a pointer to the message
   which will be filled in by the caller. It is only used for things
   like copying selected messages from one log segment to another. */

	message_number = P_message_number;
	goto CREATE_MESSAGE_COMMON;


log_segment_$create_message:
     entry (P_log_segment_ptr, P_text_lth, P_data_lth, P_data_class, P_log_message_ptr, P_code);

/* This entry reserves space for a message in the log segment, assigns
   the next sequence number to it, and returns a pointer to the message
   which will be filled in by the caller. This is the usual way of
   creating log messages. */

	message_number = -1;			/* We assign it ourselves */


CREATE_MESSAGE_COMMON:
	log_message_text_lth = P_text_lth;
	log_message_data_class_lth = length (P_data_class);
	log_message_data_lth = P_data_lth;
	P_log_message_ptr = null ();

	call copy_log_segment_ptr ();			/* Copy parameter and check header */

	message_size = size (log_message);

	if (message_size > log_segment.max_size) then	/* Too big ever to be allocated. This is a fatal */
	     call finished (error_table_$bigarg);	/* error; our caller shouldn't ever do this. */

	do while (^allocate_message ());		/* Make space for the message and assign its number; this */
	     end;					/* returns with log_message_ptr and message_number set */

          unspec (log_message.header) = ""b;                /* Initialize it (header only, because of refer extents) */
	log_message.text_lth = log_message_text_lth;  /* Copy in vital information */

	if (log_message_data_lth ^= 0) then do;
	     log_message.data_lth = log_message_data_lth;  /* These values must not be changed */
	     log_message.data_class_lth = log_message_data_class_lth;
	     log_message.data_class = P_data_class;
	     end;

	log_message.sequence = message_number;
          log_message.sentinel = log_data_$new_message_flag; /* Mark it as incomplete, but with correct size info */

	P_log_message_ptr = log_message_ptr;	/* All done */
	call finished (0);

/* */

log_segment_$finish_message:
     entry (P_log_segment_ptr, P_log_message_ptr, P_code);

/* This entry just pops in the appropriate sentinel for a completed message
   and updates discretionary values in the header */

	call copy_log_segment_ptr_no_check ();		/* It's OK to FINISH a message in an out-of-service log */

	log_message_ptr = P_log_message_ptr;

          if (log_message.sentinel ^= log_data_$new_message_flag) then
               call finished (error_table_$log_segment_damaged);
          if (log_message.time = 0) then
               call finished (error_table_$log_segment_damaged);

	call update_header_limits ();

          log_message.sentinel = log_data_$complete_message_flag;

	call finished (0);

/* */

log_segment_$initialize_sequence:
     entry (P_log_segment_ptr, P_message_number, P_code);

/* This is called only by log_initialize_, which has not finished setting up
   the log header at this point, so we can't call copy_log_segment_ptr. */


	log_segment_ptr = P_log_segment_ptr;

	unspec (sequence_info) = ""b;
	sequence_info.number = P_message_number;
	unspec (log_segment.alloc_info) = unspec (sequence_info);

	call finished (0);



log_segment_$last_message_info:
     entry (P_log_segment_ptr, P_message_number, P_last_offset, P_code);

/* This is used primarily by log_position_, to find out what's really 
   in the log before it goes to validate messages. */


	call copy_log_segment_ptr_no_check ();

	unspec (sequence_info) = unspec (log_segment.alloc_info);
	P_message_number = sequence_info.number;
	P_last_offset = wordno (addr (log_segment.data (sequence_info.words_used)));

	call finished (0);


/* */

log_segment_$place_in_service:
     entry (P_log_segment_ptr, P_code);

	call copy_log_segment_ptr_no_check ();
	call set_service_bit ("1"b);

	call finished (0);



log_segment_$remove_from_service:
     entry (P_log_segment_ptr, P_code);

	call copy_log_segment_ptr_no_check ();
	call set_service_bit ("0"b);

	call finished (0);



log_segment_$get_service_bit:
     entry (P_log_segment_ptr, P_service_bit, P_code);

	call copy_log_segment_ptr_no_check ();

	unspec (sequence_info) = unspec (log_segment.alloc_info);

	P_service_bit = sequence_info.in_service;

	call finished (0);

/* */

/* *	The procedure on the next page performs the complicated STACQ hack
   *	for assigning storage. Basically, the idea is to assign storage AND
   *	increment the sequence number in one simple operation. This is done
   *	by having a single word that is shared: 18 bits for the low end of
   *	the sequence number, and 18 bits for the number of words used in the
   *	data area. The upper 18 bits of the fixed bin (35) sequence number
   *	are in the previous word.  See the declaration of sequence_info, at
   *	the front, for details.
   *
   *	The sequence_info in the log header always contains the last sequence
   *	number already used, and the number of words already used. The number
   *	of words already used is, of course, the offset (from the beginning of
   *	the data area) of the next word to be used; the sequence number is the
   *	sequence number of the previous message.
   *
   *	This procedure works by picking up the current contents of the two-word
   *	alloc_info structure in the log header, updating it to include the new
   *	message number and the new number of words used, and trying to STACQ the
   *	second word back into the header. Only the second word is of interest for
   *	this operation, because it is the only one that is modified except when
   *	the sequence numbers cross a 256K boundary. When that happens, the first
   *	word must be updated as well. This happens so rarely that there cannot be
   *	a mis-sequencing, since the only time that word is updated is when it is
   *	actually being changed.
   *
   *	This strategy *could* fail for the create_message_number entrypoint,
   *	in which our caller supplies the new sequence number, but even that is
   *	very unlikely, and, in any case, that entrypoint should only be used by
   *	a process that is sure it is the only writer to the log segment in
   *	question; this is true for the applications where it is used, such as
   *	copying syserr messages from one place to another and trimming and
   *	consolidating log segments.
   *
   *	The strategy used here uses four temporary copies of the two-word
   *	alloc_info structure, two each in two different formats: one format for
   *	doing the arithmetic, the other for doing the STACQ. This is done for
   *	code clarity; because the temporaries can be manipulated with LDAQ/STAQ,
   *	this scheme is as efficient as using based overlays.
   */

/* */

allocate_message:
     procedure () returns (bit (1) aligned);

declare	temp fixed bin (71);			/* Forces doubleword alignment for the four temp */
						/* values, so they can be unspec'd with ldaq/staq */
declare 1 old_sequence_info aligned like sequence_info automatic;
declare 1 new_sequence_info aligned like sequence_info automatic;
declare 1 old_alloc_info aligned like log_segment_header.alloc_info automatic;
declare 1 new_alloc_info aligned like log_segment_header.alloc_info automatic;


	unspec (old_sequence_info) = unspec (log_segment.alloc_info);	/* Get the current values */
	unspec (new_sequence_info) = unspec (old_sequence_info);	/* Make a copy which will be incremented */

	if ((old_sequence_info.words_used + message_size) > log_segment.max_size) then
	     call finished (error_table_$log_segment_full);    /* No room left. This check must be made each time through */

	new_sequence_info.words_used = new_sequence_info.words_used + message_size; /* Reserve space */

	if (message_number < 0) then			/* We assign (increment) this one ourselves */
	     new_sequence_info.number = new_sequence_info.number + 1;
	else new_sequence_info.number = message_number;	/* Otherwise, use the caller's idea */

	unspec (old_alloc_info) = unspec (old_sequence_info); /* Copy back into format used for STACQ */
	unspec (new_alloc_info) = unspec (new_sequence_info);

	if ^stacq (log_segment.alloc_info.word_2, new_alloc_info.word_2, old_alloc_info.word_2)
	     then return ("0"b);			/* Allocation failed, make our caller retry */

	if (old_alloc_info.word_1 ^= new_alloc_info.word_1) then	/* Update first word only if it changes, */
	     log_segment.alloc_info.word_1 = new_alloc_info.word_1;	/* thus avoiding sequencing race */

	log_message_ptr = addr (log_segment.data (1 + old_sequence_info.words_used));
	if (message_number < 0) then			/* Tell our caller where it is, and what  */
	     message_number = new_sequence_info.number;	/* its number is, if he doesn't know already */

	return ("1"b);

	end allocate_message;

/* */

update_header_limits:
     procedure ();

declare	new_time fixed bin (71);
declare	new_sequence fixed bin (35);
declare	test_time fixed bin (71);
declare	test_sequence fixed bin (35);
declare	replaced bit (1) aligned;


	new_time = log_message.time;		/* Copy these for efficiency */
	new_sequence = log_message.sequence;	/* and to get them properly aligned */

	replaced = "0"b;				/* IF (first_time = 0) then SET first_time */
	do while (^replaced);			/* IF (new_time < first_time) then SET first_time */
	     test_time = log_segment.first_time;
	     if (test_time = 0) then
		call replace_time (log_segment.first_time);
	     else if (new_time < test_time) then
		call replace_time (log_segment.first_time);
	     else replaced = "1"b;
	     end;

	replaced = "0"b;				/* IF (new_time > last_time) then SET last_time */
	do while (^replaced);			/* Also catches IF (last_time = 0) automatically */
	     test_time = log_segment.last_time;
	     if (new_time > test_time) then
		call replace_time (log_segment.last_time);
	     else replaced = "1"b;
	     end;

	replaced = "0"b;				/* IF (first_sequence = 0) then SET first_sequence */
	do while (^replaced);			/* IF (new_sequence < first_sequence) then SET first_sequence */
	     test_sequence = log_segment.first_sequence;
	     if (test_sequence = 0) then
		call replace_sequence (log_segment.first_sequence);
	     else if (new_sequence < test_sequence) then
		call replace_sequence (log_segment.first_sequence);
	     else replaced = "1"b;
	     end;

	replaced = "0"b;				/* IF (new_sequence > last_sequence) then SET last_sequence */
	do while (^replaced);			/* Also catches IF (last_sequence = 0) automatically */
	     test_sequence = log_segment.last_sequence;
	     if (new_sequence > test_sequence) then
		call replace_sequence (log_segment.last_sequence);
	     else replaced = "1"b;
	     end;

	return;

/* */

/* *	This procedure is an attempt at a two-word STACQ. It cannot always
   *	work, but it should usually succeed, for extremely large values of
   *	usually.
   *
   *	The window is only ten microseconds long, or thereabouts, and it can
   *	onle be exploited every 20 hours or so, as the upper word of the clock
   *	is turning over. So, in order for this to fail, there would have to
   *	be two processes, less than ten microseconds apart, attempting to
   *	update the header of the log segment.
   *
   *	While this, in itself, is not terribly unlikely (occurring, perhaps,
   *	one out of every 10,000 update attempts), the failure will only occur
   *	if this already unlikely circumstance happens to fall within the
   *	once-a-day window, itself representing a roughly one in 6,000,000,000
   *	chance. So, we can, with considerable justification, dismiss this as a
   *	vanishingly small possibility. And, even if it does happen, the damage
   *	will very likely be benign.  */

replace_time:
     procedure (P_time);

declare	P_time fixed bin (71) parameter;

declare	time_words_ptr pointer;
declare 1 time_words aligned based (time_words_ptr),
	2 word_1 bit (36) aligned,
	2 word_2 bit (36) aligned;

declare 1 test_words aligned like time_words automatic;
declare 1 new_words aligned like time_words automatic;


	unspec (test_words) = unspec (test_time);
	unspec (new_words) = unspec (new_time);
	time_words_ptr = addr (P_time);

	replaced = stacq (time_words.word_2, new_words.word_2, test_words.word_2);

	if ^replaced then return;

	if (test_words.word_1 ^= new_words.word_1) then	/* If the upper word changed, too, just set it */
	     time_words.word_1 = new_words.word_1;	/* and hope for the best. */

	return;
	end replace_time;

/* */

/* This is much simpler, since it replaces only one word at a time. */

replace_sequence:
     procedure (P_sequence);

declare	P_sequence fixed bin (35) parameter;

declare	number_word_ptr pointer;
declare	number_word bit (36) aligned based (number_word_ptr);
declare	test_word bit (36) aligned;
declare	new_word bit (36) aligned;


	unspec (test_word) = unspec (test_sequence);
	unspec (new_word) = unspec (new_sequence);
	number_word_ptr = addr (P_sequence);

	replaced = stacq (number_word, new_word, test_word);

	return;
	end replace_sequence;

	end update_header_limits;

/* */

set_service_bit:
     procedure (P_bit);

declare	P_bit bit (1) aligned parameter;

declare	temp fixed bin (71);			/* Forces doubleword alignment for the four temp */
						/* values, so they can be unspec'd with ldaq/staq */
declare 1 old_sequence_info aligned like sequence_info automatic;
declare 1 new_sequence_info aligned like sequence_info automatic;
declare 1 old_alloc_info aligned like log_segment_header.alloc_info automatic;
declare 1 new_alloc_info aligned like log_segment_header.alloc_info automatic;

/* This has to do similar things to the allocate_message procedure (see the
   comment there for details. However, since it never changes the upper word,
   and doesn't care about running out of space, its processing loop is much
   simpler. It never returns normally, but always exits by calling "finished",
   either indicating success (meaning that it was this process, and no other,
   that changed the state of the service bit, or returning action_not_performed
   indicating that someone else did it. */


	do while ("1"b);				/* Keep trying until we succeed */
	     unspec (old_sequence_info) = unspec (log_segment.alloc_info);
	     unspec (new_sequence_info) = unspec (old_sequence_info);

	     if (P_bit = old_sequence_info.in_service) then
		call finished (error_table_$action_not_performed);

	     new_sequence_info.in_service = P_bit;
	     unspec (old_alloc_info) = unspec (old_sequence_info);
	     unspec (new_alloc_info) = unspec (new_sequence_info);

	     if stacq (log_segment.alloc_info.word_2, new_alloc_info.word_2, old_alloc_info.word_2) then
		return;				/* Return only when successful */
	     end;

	end set_service_bit;

/* */

copy_log_segment_ptr:
     procedure ();

	log_segment_ptr = P_log_segment_ptr;
	log_message_ptr = null ();

	if (log_segment.version ^= LOG_SEGMENT_VERSION_1) then call finished (error_table_$log_segment_damaged);

	unspec (sequence_info) = unspec (log_segment.alloc_info);
	if ^sequence_info.in_service then call finished (error_table_$log_out_of_service);

	return;
	end copy_log_segment_ptr;



copy_log_segment_ptr_no_check:
     procedure ();

/* As above, but doesn't check in-service flag */


	log_segment_ptr = P_log_segment_ptr;
	log_message_ptr = null ();

	if (log_segment.version ^= LOG_SEGMENT_VERSION_1) then call finished (error_table_$log_segment_damaged);

	return;
	end copy_log_segment_ptr_no_check;

%page; %include log_segment;
%page; %include log_message;

	end log_segment_;




		    log_wakeup_.pl1                 11/11/89  1057.9rew 11/11/89  0801.9      119097



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



/****^  HISTORY COMMENTS:
  1) change(85-12-20,EJSharpe), approve(86-02-20,MCR7334),
     audit(86-02-26,Kissel), install(86-04-23,MR12.0-1044):
     set bootload time, ignore duplicate entries
                                                   END HISTORY COMMENTS */


/* format: off */

log_wakeup_:
     procedure ();

/* *	LOG_WAKEUP_
   *
   *	This procedure manages the sending of wakeups when messages are
   *	placed in a log. There is a table of listening processes in the
   *	header of each log segment, and these processes are all sent
   *	wakeups when this procedure is called. The table of processes
   *	is limited in size; there may only be 25 (or some such small
   *	number (see log_segment_info.incl.pl1 for the exact count) processes
   *	listening at a time, but this hardly seems like an unreasonable
   *	limitation.
   *
   *	If a process is found to have expired when an attempt is made
   *	to awaken it, it is automatically removed from the list.
   *	Entries in the list are made by STACQ'ing process IDs into
   *	apparently empty slots, making the mechanism lockless.
   *
   *	This program assumes that the segment it is adding entries to
   *	is the one currently in use for writing.  It checks the in_service
   *	flag explicitly when registering and de-registering listeners,
   *	but NOT when sending wakeups, the assumption being that if a
   *	message was added to the segment, the processes listed in that
   *	segment should be the ones notified.
   *
   *	Written 84-05-04, W. Olin Sibert
   */

declare	P_log_segment_ptr pointer parameter;
declare	P_log_message_ptr pointer parameter;
declare	P_process_id bit (36) aligned parameter;
declare	P_event_channel fixed bin (71) parameter;
declare	P_code fixed bin (35) parameter;

declare	code fixed bin (35);

declare	error_table_$itt_overflow fixed bin (35) external static;
declare	error_table_$log_out_of_service fixed bin (35) external static;
declare	error_table_$log_segment_damaged fixed bin (35) external static;
declare	error_table_$log_wakeup_table_full fixed bin (35) external static;
declare	error_table_$wakeup_denied fixed bin (35) external static;

declare	sys_info$time_of_bootload fixed bin (71) external static;

declare	get_ring_ entry () returns (fixed bin (3));
declare	hcs_$validate_processid entry (bit (36) aligned, fixed bin (35));
declare	hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
declare	log_segment_$get_service_bit entry (pointer, bit (1) aligned, fixed bin (35));
declare	pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
declare	tc_util$validate_processid entry (bit (36) aligned, fixed bin (35));

declare	PROCESS_ID_FLAG bit (36) aligned internal static options (constant) init ("400000000000"b3);
declare	PROCESS_ID_MASK bit (36) aligned internal static options (constant) init ("377777777777"b3);

declare  (binary, bit, hbound, rel, stacq, substr, unspec) builtin;

/* */

finished:						/* All-purpose exitl we always leave through here */
     procedure (P_status_code);

declare	P_status_code fixed bin (35) parameter;


	P_code = P_status_code;
	goto MAIN_RETURN;

	end finished;



MAIN_RETURN:					/* This is the only return statement in the main procedure */
	return;



log_wakeup_$send_wakeups:
     entry (P_log_segment_ptr, P_log_message_ptr, P_code);

	call copy_log_segment_ptr ();			/* DON'T call check_in_service for this; the caller has */
	call send_wakeups ();			/* (presumably) already dealt with that possibility */
	call finished (0);

/* */

log_wakeup_$register:
     entry (P_log_segment_ptr, P_process_id, P_event_channel, P_code);

	call copy_log_segment_ptr ();
	call check_in_service ();
	call register_listener ();
	call check_in_service ();
	call finished (0);



log_wakeup_$deregister:
     entry (P_log_segment_ptr, P_process_id, P_event_channel, P_code);

	call copy_log_segment_ptr ();
	call check_in_service ();
	call deregister_listener ();
	call check_in_service ();
	call finished (0);



log_wakeup_$discard_all:
     entry (P_log_segment_ptr, P_code);

	call copy_log_segment_ptr ();
	call check_in_service ();
	call clear_listener_info ();
	call check_in_service ();
	call finished (0);

/* */
send_wakeups:
     procedure ();

/* This procedure delivers the wakeups to every listening process. If a process
   turns out to be defunct, it is removed from the list, but no error is indicated
   to anyone. */

declare	slot_idx fixed bin;
declare	process_id bit (36) aligned;
declare	event_channel fixed bin (71);
declare	ring_zero bit (1) aligned;
declare	event_message fixed bin (71);


	if ^log_segment.listeners_registered then		/* A flag kept for efficiency reasons */
	     return;

	log_message_ptr = P_log_message_ptr;	/* Parameter imported from external procedure */
	unspec (event_message) = bit (binary (log_message.sequence, 36)) || "000000"b3 || rel (log_message_ptr);
						/* Message is sequence number and location */
	ring_zero = (get_ring_ () = 0);		/* If we can, call pxss directly */

	do slot_idx = 1 to hbound (log_segment.listener, 1);
	     process_id = log_segment.listener.process_id (slot_idx);
	     event_channel = log_segment.listener.event_channel (slot_idx);
	     if (process_id = ""b) then		/* See that somebody's there, and that the slot is */
		goto WAKEUP_NEXT_CUSTOMER;		/* properly filled in (filling flag is off) */
	     if (substr (process_id, 1, 1)) then
		goto WAKEUP_NEXT_CUSTOMER;

	     if ring_zero then
		call pxss$ring_0_wakeup (process_id, event_channel, event_message, code);
	     else call hcs_$wakeup (process_id, event_channel, event_message, code);

	     if (code = 0) then ;			/* Success, or some error codes, leave the target there */
	     else if (code = error_table_$itt_overflow) then ; /* for others to try awakening. */
	     else if (code = error_table_$wakeup_denied) then ; /* Remaining codes (indicating failure) are: */
	     else call clear_slot (slot_idx);		/* process_stopped, process_unknown, bad_arg */

WAKEUP_NEXT_CUSTOMER:
	     end;

	return;
	end send_wakeups;

/* */

register_listener:
     procedure ();


	if (try_to_register ()) then			/* Try it outright the first time. */
	     return;				/* Just return if it works */

	call reclaim_dead_listeners ();		/* If that fails, pick out any losers and try again */

	if (try_to_register ()) then			/* If it works a second time, we must have picked */
	     return;				/* up after some deaders */

	call finished (error_table_$log_wakeup_table_full);    /* Otherwise, give up (do a goto out of here) */

	end register_listener;

/* */

try_to_register:
     procedure () returns (bit (1) aligned);

declare	event_channel fixed bin (71);
declare	process_id bit (36) aligned;
declare	flagged_process_id bit (36) aligned;
declare	slot_idx fixed bin;
declare	ignore_bit bit (1) aligned;


/* This procedure returns "1"b if it successfully registered a process, and
   "0"b if it finds the table is full.	The algorithm works as follows:

   The process table is searched for a presently empty slot (process_id is
   zero when empty). Once one is found, the target process_id is installed,
   but with the upper bit set to tell the wakeup procedure, ignore this
   entry until it's properly filled in. Once it's properly filled in, that
   upper bit is turned off.
   */

	process_id = P_process_id;			/* P_process_id and P_event_channel parameters are */
	event_channel = P_event_channel;		/* imported from the external procedure */
	flagged_process_id = process_id | PROCESS_ID_FLAG;

	log_segment.listeners_registered = "1"b;		/* Flag it as having listeners (flag is for efficiency) */

RETRY_REGISTER:
	do slot_idx = 1 to hbound (log_segment.listener, 1);
	     if (log_segment.listener.process_id (slot_idx) = process_id) then
		if (log_segment.listener.event_channel (slot_idx) = event_channel) then
		     return ("1"b);			/* procID/ev_chn should only appear once */

	     if (log_segment.listener.process_id (slot_idx) = ""b) then do; /* A candidate */
		if ^stacq (log_segment.listener.process_id (slot_idx), flagged_process_id, ""b) then
		     goto RETRY_REGISTER;		/* But someone else got him first */

		log_segment.listener.event_channel (slot_idx) = event_channel;

		ignore_bit = stacq (log_segment.listener.process_id (slot_idx), process_id, flagged_process_id);
		return ("1"b);			/* Flag it as valid, and return, successful */
		end;
	     end;

	return ("0"b);

	end try_to_register;

/* */

reclaim_dead_listeners:
     procedure ();

declare	slot_idx fixed bin;
declare	process_id bit (36) aligned;
declare	ring_zero bit (1) aligned;

/* This procedure attempts to reclaim slots in use by expired processes.
   It just goes through and checks all the process-ids in the slots, reclaiming
   dead ones. It is only used when a new listener is being added and there are
   no slots already available; normally, dead processes will be detected in the
   course of sending wakeups, and their slots reclaimed automatically. */

/* Note that listeners from the previous bootload (by definition dead) have
   already been "reclaimed" by the check in copy_log_segment_ptr, which cleans
   them all out the first time it runs in a different bootload. */


	ring_zero = (get_ring_ () = 0);

	do slot_idx = 1 to hbound (log_segment.listener, 1);
	     process_id = log_segment.listener.process_id (slot_idx) & PROCESS_ID_MASK;
	     if (process_id ^= ""b) then do;		/* A possibly valid process-id is here */
		if ring_zero then
		     call tc_util$validate_processid (process_id, code);
		else call hcs_$validate_processid (process_id, code);

		if (code ^= 0) then			/* Not one of ours, Jack */
		     call clear_slot (slot_idx);
		end;
	     end;

	return;
	end reclaim_dead_listeners;

/* */

deregister_listener:
     procedure ();

declare	slot_idx fixed bin;
declare	process_id bit (36) aligned;
declare	test_process_id bit (36) aligned;
declare	event_channel fixed bin (71);


	process_id = P_process_id;			/* P_process_id and P_event_channel parameters are */
	event_channel = P_event_channel;		/* imported from the external procedure */

	do slot_idx = 1 to hbound (log_segment.listener, 1);
	     test_process_id = log_segment.listener.process_id (slot_idx) & PROCESS_ID_MASK;
	     if (process_id = test_process_id) then
		if (log_segment.listener.event_channel (slot_idx) = event_channel) then
		     call clear_slot (slot_idx);
	     end;

	return;
	end deregister_listener;

/* */

clear_slot:
     procedure (P_slot_idx);

declare	P_slot_idx fixed bin parameter;

declare	process_id bit (36) aligned;


/* Shouldn't need this silly loop, but may as well have it anyway */

	process_id = log_segment.listener.process_id (P_slot_idx);
	do while (^stacq (log_segment.listener.process_id (P_slot_idx), ""b, process_id));
	     process_id = log_segment.listener.process_id (P_slot_idx);
	     end;

	return;
	end clear_slot;



clear_listener_info:
     procedure ();

/* This procedure clears out all the wakeup info in the log, wholesale */

	log_segment.listeners_registered = "0"b;		/* Turn off wakeups first */

	unspec (log_segment.listener) = ""b;		/* Then just clear them all out */

	log_segment.listener_bootload_time = sys_info$time_of_bootload;
						/* and set the bootload time */

	return;
	end clear_listener_info;

/* */

copy_log_segment_ptr:
     procedure ();

	log_segment_ptr = P_log_segment_ptr;

	if (log_segment.version ^= LOG_SEGMENT_VERSION_1) then
	     call finished (error_table_$log_segment_damaged);

/* NOTE: This check for listeners belonging to the current bootload imposes the
   requirement that a process calling ANY log_wakeup_ entrypoint must have write
   access to the log segment, because it might make this check and want to clear
   out the old listener info.	 This is not an onerous requirement, because only
   the wakeup entrypoint could conceivably work without write access, but it
   is only called if the process has already just written a message (for which,
   of course, write access was already required). */

	if (log_segment.listener_bootload_time ^= sys_info$time_of_bootload) then /* bootload; if not, they're all */
	     call clear_listener_info ();		/* dead, and we should dispose of them before doing anything */
						/* else with the listener info. */
	return;
	end copy_log_segment_ptr;



check_in_service:
     procedure ();

declare	service_bit bit (1) aligned;


	call log_segment_$get_service_bit (log_segment_ptr, service_bit, code);
	if (code ^= 0) then
	     call finished (code);
	if ^service_bit then
	     call finished (error_table_$log_out_of_service);

	return;
	end check_in_service;

%page; %include log_segment;
%page; %include log_message;

	end log_wakeup_;






		    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
