log_create_.pl1 11/11/89 1059.9r w 11/11/89 0802.0 72108 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ log_create_: procedure (); /* * LOG_CREATE_ * * This procedure is used primarily to create log segments. It is the * major maintainer of the log_segment_info structure, and therefore * also has an entrypoint for filling in such a structure. * * Modification history: * 1984-06-02, W. Olin Sibert: Initial coding * 1984-12-20, WOS: Added mode values to segment_info structure * 1984-12-21, WOS: Changed to give better message for link entries * 1984-12-27, Keith Loepere: Modified for version 2 create_branch_info */ declare P_log_segment_info_ptr pointer parameter; declare P_old_log_ptr pointer parameter; declare P_new_log_ptr pointer parameter; declare P_log_dname char (*) parameter; declare P_log_ename char (*) parameter; declare P_code fixed bin (35) parameter; declare code fixed bin (35); declare old_log_dname char (168); declare error_table_$link fixed bin (35) external static; declare error_table_$namedup fixed bin (35) external static; declare get_system_free_area_ entry () returns (pointer); declare get_group_id_$tag_star entry () returns (char (32)); declare hcs_$create_branch_ entry (char (*), char (*), pointer, fixed bin (35)); declare hcs_$fs_get_path_name entry (pointer, char (*), fixed bin, char (*), fixed bin (35)); declare hcs_$get_max_length_seg entry (pointer, fixed bin (19), fixed bin (35)); declare hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), pointer, fixed bin (35)); declare hcs_$list_acl entry (char (*), char (*), pointer, pointer, pointer, fixed bin, fixed bin (35)); declare hcs_$replace_acl entry (char (*), char (*), pointer, fixed bin, bit (1) aligned, fixed bin (35)); declare hcs_$set_max_length entry (char (*), char (*), fixed bin (19), fixed bin (35)); declare hcs_$status_for_backup entry (char (*), char (*), pointer, fixed bin (35)); declare hcs_$status_long entry (char (*), char (*), fixed bin (1), pointer, pointer, fixed bin (35)); declare hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); declare log_initialize_ entry (pointer, pointer, fixed bin (19), char (*), fixed bin (35)); declare (addr, null, substr, unspec) builtin; /* */ /* This entrypoint just fills in a log_segment_info structure to describe the segment specified. This is used wby log_write_. */ log_create_$get_info: entry (P_log_segment_info_ptr, P_old_log_ptr, P_code); log_segment_info_ptr = P_log_segment_info_ptr; call get_log_status (P_old_log_ptr); call finished (0); /* This entrypoint is used to create a brand new log segment, for which there is no existing segment to copy. The caller must have completely filled in the log_segment_info structure before calling this entrypoint. */ log_create_$new_segment: entry (P_log_segment_info_ptr, P_new_log_ptr, P_code); log_segment_info_ptr = P_log_segment_info_ptr; call make_log_segment (null (), "", P_new_log_ptr); call finished (0); /* */ /* This entrypoint is used to duplicate an existing log segment. It copies all the attributes of the old segment onto the new one. The dname and ename are separately supplied for the new log, since of course we don't want to end up tryng to create the same segment over again. */ log_create_$duplicate_segment: entry (P_log_segment_info_ptr, P_log_dname, P_log_ename, P_old_log_ptr, P_new_log_ptr, P_code); log_segment_info_ptr = P_log_segment_info_ptr; call get_log_status (P_old_log_ptr); /* Now, extract the old pathname and insert the new one */ old_log_dname = log_segment_info.dname; log_segment_info.dname = P_log_dname; log_segment_info.ename = P_log_ename; call make_log_segment (P_old_log_ptr, old_log_dname, P_new_log_ptr); call finished (0); /* */ get_log_status: procedure (P_log_ptr); declare P_log_ptr pointer parameter; declare log_dname char (168); declare log_ename char (32); declare log_max_lth fixed bin (19); declare 1 sfb aligned like status_for_backup automatic; declare 1 status aligned like status_branch automatic; call hcs_$fs_get_path_name (P_log_ptr, log_dname, (0), log_ename, code); call check_code (); sfb.version = status_for_backup_version_2; call hcs_$status_for_backup (log_dname, log_ename, addr (sfb), code); call check_code (); call hcs_$status_long (log_dname, log_ename, 1, addr (status), null (), code); call check_code (); call hcs_$list_acl (log_dname, log_ename, (get_system_free_area_ ()), log_segment_info.acl_ptr, null (), log_segment_info.acl_count, code); call check_code (); call hcs_$get_max_length_seg (P_log_ptr, log_max_lth, code); call check_code (); log_segment_info.rings (*) = status.ring_brackets (*); log_segment_info.max_length = log_max_lth; /* Not sfb.max_length, which is always 261120 */ log_segment_info.multi_class = sfb.multiple_class; log_segment_info.access_class = sfb.access_class; /* NOTE: This depends on the format of the old 5-bit mode values, usually seen as fixed bin (5) values. */ log_segment_info.effective_mode = substr (status.mode, 2, 3); log_segment_info.dname = log_dname; log_segment_info.ename = log_ename; return; end get_log_status; /* */ make_log_segment: procedure (P_old_log_ptr, P_old_log_dname, P_new_log_ptr); declare P_old_log_ptr pointer parameter; declare P_old_log_dname char (168) parameter; declare P_new_log_ptr pointer parameter; declare log_ptr pointer; declare entry_type fixed bin (2); declare 1 cbi aligned like create_branch_info automatic; P_new_log_ptr = null (); unspec (cbi) = ""b; cbi.mode = RW_ACCESS; cbi.bitcnt = 36 * log_segment_info.max_length; cbi.access_class = log_segment_info.access_class; cbi.priv_upgrade_sw = log_segment_info.multi_class; cbi.rings (*) = log_segment_info.rings (*); cbi.userid = get_group_id_$tag_star (); cbi.version = create_branch_version_2; call hcs_$create_branch_ (log_segment_info.dname, log_segment_info.ename, addr (cbi), code); if (code = error_table_$namedup) then do; /* Special-case error message for links */ entry_type = -1; /* Initialize in case status_minf fails */ call hcs_$status_minf (log_segment_info.dname, log_segment_info.ename, 0, entry_type, (0), (0)); if (entry_type = 0) then /* Link type */ code = error_table_$link; end; call check_code (); call hcs_$set_max_length (log_segment_info.dname, log_segment_info.ename, log_segment_info.max_length, (0)); if (log_segment_info.acl_ptr ^= null ()) & (log_segment_info.acl_count ^= 0) then call hcs_$replace_acl (log_segment_info.dname, log_segment_info.ename, log_segment_info.acl_ptr, log_segment_info.acl_count, "0"b, (0)); call hcs_$initiate (log_segment_info.dname, log_segment_info.ename, "", 0, 0, log_ptr, code); if (log_ptr ^= null ()) then code = 0; call check_code (); call log_initialize_ (P_old_log_ptr, log_ptr, log_segment_info.max_length, P_old_log_dname, code); call check_code (); P_new_log_ptr = log_ptr; return; end make_log_segment; /* */ check_code: procedure (); if (code = 0) then return; call finished (code); end check_code; finished: procedure (P_return_code); declare P_return_code fixed bin (35) parameter; P_code = P_return_code; goto MAIN_RETURN; end finished; MAIN_RETURN: return; %page; %include log_write_data; %page; %include status_for_backup; %page; %include status_structures; %page; %include create_branch_info; %page; %include access_mode_values; end log_create_;  log_initiate_.pl1 11/11/89 1059.9r w 11/11/89 0802.0 30951 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ log_initiate_: procedure (P_dname, P_ename, P_max_tries, P_log_segment_ptr, P_code); /* * LOG_INITIATE_ * * This procedure is the user-ring log initiation procedure. It * attempts to initiate the log segment, and sleeps for a second * if it can't do it, or if the log segment appears to be * uninitialized. The one-second wait is repeated P_max_tries * times, at which point it gives up. * * Modification history: * 1984-05-04, W. Olin Sibert: after Benson's log_mgr_ * 1984-12-21, WOS: Changed to return pointer when log not initilized */ declare P_dname char (*) parameter; declare P_ename char (*) parameter; declare P_max_tries fixed bin parameter; declare P_log_segment_ptr pointer parameter; declare P_code fixed bin (35) parameter; declare retry_count fixed bin; declare code fixed bin (35); declare error_table_$log_uninitialized fixed bin (35) external static; declare hcs_$terminate_noname entry (pointer, fixed bin (35)); declare initiate_file_ entry (char (*), char (*), bit (*), pointer, fixed bin (24), fixed bin (35)); declare timer_manager_$sleep entry (fixed bin (71), bit (2)); declare RELATIVE_MICROSECONDS bit (2) internal static options (constant) init ("10"b); declare ONE_QUARTER_SECOND fixed bin (71) internal static options (constant) init (250000); declare cleanup condition; declare null builtin; /* */ log_segment_ptr = null (); P_log_segment_ptr = null (); on condition (cleanup) begin; /* The cleanup handler is particularly important because */ if (log_segment_ptr ^= null ()) then /* this procedure can wait for a long time */ call hcs_$terminate_noname (log_segment_ptr, (0)); end; call initiate_file_ (P_dname, P_ename, R_ACCESS, log_segment_ptr, (0), code); if (code ^= 0) then call finished (code); /* Now we waits for the log segment header to be initialized. If log_initiate_ gets called at all, the assumption is that some other process has already initialized, or is initializing, the log segment, and all we must do is wait a bit. If we have to initialize it ourselves, we would have called log_create_, instead. */ do retry_count = 1 to P_max_tries; if (log_segment.version = LOG_SEGMENT_VERSION_1) then do; P_log_segment_ptr = log_segment_ptr; call finished (0); end; if (retry_count < P_max_tries) then /* Don't wait if we won't have another chance */ call timer_manager_$sleep (ONE_QUARTER_SECOND, RELATIVE_MICROSECONDS); end; /* It didn't get initialized in time. Terminate it, and give up. */ P_log_segment_ptr = log_segment_ptr; call finished (error_table_$log_uninitialized); /* */ finished: procedure (P_return_code); declare P_return_code fixed bin (35) parameter; P_code = P_return_code; goto MAIN_RETURN; end finished; MAIN_RETURN: /* Only exit from this program */ return; %page; %include access_mode_values; %page; %include log_segment; end log_initiate_;  log_list_history_.pl1 11/11/89 1059.9r 11/11/89 0800.0 151371 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* format: style4 */ log_list_history_: procedure (); /* * LOG_LIST_HISTORY_ * * This procedure is responsible for allocating and filling in a log_read_data * structure containing the pathnames of all the logs it can find in the chain * of history begun in the first log. All the logs from each separate directory * in the history are sorted in chronological order (by name), and space is * left at the beginning of the log_read_data array for the initial log * (or logs). This procedure is a utility, used only by log_read_$open. * * It has one minor problem: it cannot handle the case of looping history * directories, where log_A points to log_B which points back to log_A. * There are various ways in which this could be remedied, and one should * be chosen eventually. Log unique-id comparison is probably the best * choice, but, as such, should include the initial log(s), and therefore * must be handled outside this procedure. * * 84-05-04, W. Olin Sibert: In celebration of recursion * 84-08-25, WOS: Added $single_dir entrypoint for log_write_ migration * 84-10-16, WOS: Converted to use log_name_$starname * 1984-12-15, BIM: version sentinel in log_read_data_. * 85-03-03, EJ Sharpe: Changed single_dir entry to return log_read_data structure, added format, * added single_dir_oldest_and_newest to replace old functionality of single_dir, */ declare P_first_log_ptr pointer parameter; declare P_log_name char (*) parameter; declare P_initial_count fixed bin parameter; declare P_log_read_data_ptr pointer parameter; declare P_log_dname char (*) parameter; declare P_oldest_log_name char (*) parameter; declare P_newest_log_name char (*) parameter; declare P_log_count fixed bin parameter; declare P_code fixed bin (35) parameter; declare code fixed bin (35); declare system_area_ptr pointer; declare system_area area based (system_area_ptr); declare total_segment_count fixed bin; declare last_segment_entered fixed bin; declare log_starname char (32); declare first_log_ptr pointer; declare first_dname char (168); declare first_uid bit (36) aligned; declare error_table_$nomatch fixed bin (35) external static; declare absolute_pathname_ entry (char (*), char (*), fixed bin (35)); declare get_system_free_area_ entry () returns (pointer); declare hcs_$get_uid_file entry (char (*), char (*), bit (36) aligned, fixed bin (35)); declare hcs_$star_ entry (char (*), char (*), fixed bin (2), pointer, fixed bin, pointer, pointer, fixed bin (35)); declare log_initiate_ entry (char (*), char (*), fixed bin, pointer, fixed bin (35)); declare log_name_$starname entry (char (*)) returns (char (32)); declare log_name_$time entry (char (*)) returns (fixed bin (71)); declare sort_items_$general entry (pointer, entry); declare cleanup condition; declare (addr, null, sum) builtin; %page; log_list_history_$all: entry (P_first_log_ptr, P_log_name, P_initial_count, P_log_read_data_ptr); total_segment_count = P_initial_count; /* Enough to start with-- as many as our caller has */ first_log_ptr = P_first_log_ptr; /* Starname matches LogName.YYYYMMDD.HHMMSS */ log_starname = log_name_$starname (P_log_name); system_area_ptr = get_system_free_area_ (); /* See if the first log we got points back to anything at all. If it doesn't, then we just allocate a small return structure and return. Otherwise, we start by listing the first history directory, and begin recursing. One of those recursive calls will give up and allocate the return structure, so by the time the call to list_log_directory returns, all will be ready and filled in. */ if ^get_dname_and_uid (first_log_ptr, first_dname, first_uid) then call allocate_read_data (); else call list_log_directory (first_dname, first_uid, "1"b); P_log_read_data_ptr = log_read_data_ptr; /* Return the structure we allocated */ return; %page; log_list_history_$single_dir: entry (P_log_dname, P_log_name, P_log_read_data_ptr, P_code); /* This entrypoint returns a log_read_data structure with information about only the logs in a single history directory. */ first_dname = P_log_dname; log_starname = log_name_$starname (P_log_name); total_segment_count = 0; log_read_data_ptr = null (); system_area_ptr = get_system_free_area_ (); on condition (cleanup) begin; if (log_read_data_ptr ^= null ()) then free log_read_data_ptr -> log_read_data in (system_area); end; call hcs_$get_uid_file (first_dname, "", first_uid, code); /* We need this value as a parameter, and, in */ if (code ^= 0) then do; /* any case, this is a good place to fail if noentry */ P_code = code; return; end; call list_log_directory (first_dname, first_uid, "0"b); /* Just this directory, please */ P_log_read_data_ptr = log_read_data_ptr; P_code = 0; return; %page; log_list_history_$single_dir_oldest_and_newest: entry (P_log_dname, P_log_name, P_oldest_log_name, P_newest_log_name, P_log_count, P_code); /* This entrypoint is used (by log_write_$open_for_migrate) to determine the names of the oldest and newest log segments in a particular log directory. Rather than listing the entire history, only a single directory is listed. */ first_dname = P_log_dname; log_starname = log_name_$starname (P_log_name); P_oldest_log_name = ""; P_newest_log_name = ""; P_log_count = 0; total_segment_count = 0; /* We started with none, after all */ log_read_data_ptr = null (); system_area_ptr = get_system_free_area_ (); on condition (cleanup) begin; /* Always free log_read_data, since it is not retained */ if (log_read_data_ptr ^= null ()) then /* outside the invocation of this program */ free log_read_data_ptr -> log_read_data in (system_area); end; call hcs_$get_uid_file (first_dname, "", first_uid, code); /* We need this value as a parameter, and, in */ if (code ^= 0) then do; /* any case, this is a good place to fail if noentry */ P_code = code; return; end; call list_log_directory (first_dname, first_uid, "0"b); /* Just this directory, please */ if (log_read_data.n_segments > 0) then do; P_newest_log_name = log_read_data.ename (1); P_oldest_log_name = log_read_data.ename (log_read_data.n_segments); end; P_log_count = log_read_data.n_segments; if (log_read_data.n_segments = 0) then P_code = error_table_$nomatch; else P_code = 0; free log_read_data_ptr -> log_read_data in (system_area); return; /* All done for $single_dir */ %page; get_dname_and_uid: procedure (P_log_segment_ptr, P_dname, P_uid) returns (bit (1) aligned); declare P_log_segment_ptr pointer parameter; declare P_dname char (*) parameter; declare P_uid bit (36) aligned parameter; declare code fixed bin (35); /* This procedure extracts the directory name and directory UID for the pathname recorded in the previous log information in the supplied log. If any error occurs, it just gives up, terminating the search at that point. */ if (P_log_segment_ptr = null ()) then return ("0"b); if (P_log_segment_ptr -> log_segment.previous_log_dir = "") then return ("0"b); call absolute_pathname_ (P_log_segment_ptr -> log_segment.previous_log_dir, P_dname, code); if (code ^= 0) then return ("0"b); call hcs_$get_uid_file (P_dname, "", P_uid, code); if (code ^= 0) then return ("0"b); return ("1"b); end get_dname_and_uid; allocate_read_data: procedure (); log_read_data_n_segments = total_segment_count; last_segment_entered = total_segment_count + 1; /* Because there are none at all in the array, yet */ allocate log_read_data in (system_area) set (log_read_data_ptr); log_read_data.header.sentinel = LOG_READ_DATA_VERSION_SENTINEL; log_read_data.n_segments = total_segment_count; return; end allocate_read_data; %page; /* * This textbook example of recursion is used to find all the log segments * in whatever set of directories they may have been migrated to. It is * called by the main "open" routine to list the directory that the newest * log points back to, and it goes back from there. After it lists a * directory, it examines the oldest log segment in that directory, and * sees where it points for its "previous" log. If the directory thus * indicated is different, it calls list_log_directory recursively, and * does it all over again. * * Once it runs out of directories, or if it encounters any error listing * or examining directory contents, it allocated log_read_data and starts * filling it in, from the bottom (oldest) up. * * The process is controlled by two global variables: total_segment_count * and last_segment_entered, which keep track of the total size of the * structure, and of which entries have been filled in already. After the * initial call to list_log_directory returns, the remaining (first) entry * in log_read_data is filled in from the parameter we received. The log * starname is also global, since all historical logs must have the same * format for their names. * * NOTE: Despite the names, it's list_this_directory, not list_log_directory, * that actually calls hcs_$star_. This procedure just collects the results. */ list_log_directory: procedure (P_dname, P_uid, P_keep_looking); declare P_dname char (*) parameter; /* Directory to list */ declare P_uid bit (36) aligned parameter; /* Used to check equality of directories */ declare P_keep_looking bit (1) aligned parameter; /* Keep looking for the next older directory */ declare sort_pointers_ptr pointer; declare 1 sort_pointers aligned based (sort_pointers_ptr), 2 n_entries fixed bin, 2 ptr (star_entry_count refer (sort_pointers.n_entries)) pointer unaligned; declare code fixed bin (35); /* Local copy */ declare segment_count fixed bin; declare 1 one_star_entry aligned like star_entries based; declare entry_idx fixed bin; declare last_log_name char (32); declare last_log_ptr pointer; declare older_dname char (168); declare older_uid bit (36) aligned; declare segment_idx fixed bin; %page; star_entry_ptr = null (); /* Initialize for cleanup handler */ star_names_ptr = null (); /* Initialize for cleanup handler */ sort_pointers_ptr = null (); /* Initialize for cleanup handler */ last_log_ptr = null (); /* Initialize for filling into log_read_data */ segment_count = 0; /* Initialize for filling-in loop */ on condition (cleanup) begin; call free_star_entries (); end; /* Now, we list the contents of the directory. It's the job of list_this_directory to test P_keep_looking-- if we aren't supposed to keep looking, it gives up without looking in the oldest log segment for another directory to list. Otherwise, it looks there and returns "1"b if there's anything worth looking at. */ if (list_this_directory ()) then call list_log_directory (older_dname, older_uid, P_keep_looking); else call allocate_read_data (); /* Once the directory is listed, fill in all the segments from our list. This loop will be ignored if there was nothing listed by the earlier call to list_directory, so there are no problems resulting from referencing structures not actually allocated because, for instance, a call to hcs_$star_ failed. */ do segment_idx = segment_count to 1 by -1; last_segment_entered = last_segment_entered - 1; /* Get the index of the one to be entered */ log_read_data.dname (last_segment_entered) = P_dname; log_read_data.dir_uid (last_segment_entered) = P_uid; log_read_data.ename (last_segment_entered) = star_names (sort_pointers.ptr (segment_idx) -> one_star_entry.nindex); log_read_data.suffix_time (last_segment_entered) = log_name_$time (log_read_data.ename (last_segment_entered)); if (segment_idx = segment_count) then /* We've initiated (or at least tried) the oldest log */ log_read_data.ptr (last_segment_entered) = last_log_ptr; /* already, so record the pointer we got */ else log_read_data.ptr (last_segment_entered) = null (); end; call free_star_entries (); /* Clean out this level of recursion */ return; %page; list_this_directory: procedure () returns (bit (1) aligned); /* First, try to list any matching logs in the directory. If there is an error, or none can be found, we're all done here. A "0"b is returned if there are no more directories to search, which is the case for all returns except the very last. */ call hcs_$star_ (P_dname, log_starname, star_BRANCHES_ONLY, system_area_ptr, star_entry_count, star_entry_ptr, star_names_ptr, code); if (code ^= 0) then return ("0"b); if (star_entry_count = 0) then return ("0"b); allocate sort_pointers in (system_area) set (sort_pointers_ptr); sort_pointers.n_entries = star_entry_count; segment_count = 0; do entry_idx = 1 to star_entry_count; sort_pointers.ptr (entry_idx) = addr (star_entries (entry_idx)); if (star_entries.type (entry_idx) = star_SEGMENT) then segment_count = segment_count + 1; end; if (segment_count = 0) then return ("0"b); total_segment_count = total_segment_count + segment_count; call sort_items_$general (addr (sort_pointers), compare_entries); if ^P_keep_looking then /* If we're not supposed to keep looking, we */ return ("0"b); /* stop right here without looking at the history */ /* Find the last (oldest) log in this directory, and see what it says about earlier ones */ last_log_name = star_names (sort_pointers.ptr (segment_count) -> one_star_entry.nindex); call log_initiate_ (P_dname, last_log_name, 1, last_log_ptr, code); if (code ^= 0) then return ("0"b); /* See if this log contains a usable previous log pathname */ if ^get_dname_and_uid (last_log_ptr, older_dname, older_uid) then return ("0"b); /* Now, check to see whether the "previous" directory in the oldest log of record is different from the directory we're already looking at. This will fail catastrophically if the "previous" directory is, in fact, one we've listed earlier than this call, since it will lead us back to here, and so forth. It's difficult to check for that case, so we'll just take the risk. */ if (older_uid = P_uid) then return ("0"b); return ("1"b); end list_this_directory; %page; compare_entries: procedure (P_entry_1, P_entry_2) returns (fixed bin (35)); declare P_entry_1 unaligned pointer parameter; declare P_entry_2 unaligned pointer parameter; declare entry_1_ptr pointer; declare entry_2_ptr pointer; declare 1 entry_1 aligned like star_entries based (entry_1_ptr); declare 1 entry_2 aligned like star_entries based (entry_2_ptr); entry_1_ptr = P_entry_1; entry_2_ptr = P_entry_2; /* These first two cases make non-segments always sort at the end, which means they will be ignored when collection time comes. */ if (entry_1.type = star_SEGMENT) & (entry_2.type ^= star_SEGMENT) then return (-1); else if (entry_1.type ^= star_SEGMENT) & (entry_2.type = star_SEGMENT) then return (1); else if (star_names (entry_1.nindex) < star_names (entry_2.nindex)) then return (1); else return (-1); end compare_entries; free_star_entries: procedure (); declare star_stuff fixed bin based; /* This procedure has to have its own based variable to use when freeing, because the standard include file declares the star structures in a way that requires various pointers to be set properly when they may not be. BRAINDAMAGE. It should use fixed array bounds the way it used to before Davidoff got to it. */ if (star_entry_ptr ^= null ()) then free star_entry_ptr -> star_stuff in (system_area); if (star_names_ptr ^= null ()) then free star_names_ptr -> star_stuff in (system_area); if (sort_pointers_ptr ^= null ()) then free sort_pointers in (system_area); return; end free_star_entries; %page; /* This must be declared here, in the internal procedure, because it is used recursively */ %include star_structures; end list_log_directory; /* The recursive procedure */ /* format: off */ %page; %include log_segment; %page; %include log_read_data; end log_list_history_;  log_move_.pl1 11/11/89 1059.9rew 11/11/89 0802.0 27387 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ log_move_: procedure (); /* * LOG_MOVE_ * * This procedure moves a message from one log segment to another * (using log_write_ to create the new message), and deletes the * old message from the original log segment, ensuring that a * loop of moves can be restarted after an interruption without * copying more than one extra message. * * It would be swift to add a new entrypoint for ring zero that * used log_segment_ instead of log_write_, but that's not needed * until the syserr_data segment is converted to be a log segment. * * Modification history: * 1984-11-11, W. Olin Sibert: Initial coding * 1984-12-21, WOS: Changed to make data_class the right size (16 chars) */ declare P_log_write_data_ptr pointer parameter; declare P_old_ptr pointer parameter; declare P_new_ptr pointer parameter; declare P_code fixed bin (35) parameter; declare code fixed bin (35); declare log_write_data_ptr pointer; declare old_ptr pointer; declare new_ptr pointer; declare data_class char (16) varying; declare log_data_$deleted_message_flag bit (36) aligned external static; declare log_segment_$finish_message entry (pointer, pointer, fixed bin (35)); declare log_write_$general entry (pointer, fixed bin (35), fixed bin, fixed bin, char (16) varying, pointer, fixed bin (35)); /* */ log_move_$message: entry (P_log_write_data_ptr, P_old_ptr, P_new_ptr, P_code); log_write_data_ptr = P_log_write_data_ptr; old_ptr = P_old_ptr; if (dimension (old_ptr -> log_message.data, 1) > 0) then data_class = old_ptr -> log_message.data_class; else data_class = ""; call log_write_$general (log_write_data_ptr, old_ptr -> log_message.sequence, length (old_ptr -> log_message.text), dimension (old_ptr -> log_message.data, 1), data_class, new_ptr, code); if (code ^= 0) then goto FINISHED; new_ptr -> log_message.time = old_ptr -> log_message.time; new_ptr -> log_message.severity = old_ptr -> log_message.severity; new_ptr -> log_message.process_id = old_ptr -> log_message.process_id; new_ptr -> log_message.text = old_ptr -> log_message.text; if (dimension (old_ptr -> log_message.data, 1) > 0) then unspec (new_ptr -> log_message.data) = unspec (old_ptr -> log_message.data); call log_segment_$finish_message (pointer (new_ptr, 0), new_ptr, code); old_ptr -> log_message.sentinel = log_data_$deleted_message_flag; P_new_ptr = new_ptr; FINISHED: P_code = code; return; %page; %include log_message; end log_move_;  log_read_.pl1 11/11/89 1059.9rew 11/11/89 0800.0 418338 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-06-11,Margulies), approve(86-02-21,MCR7344), audit(86-02-21,EJSharpe), install(86-04-23,MR12.0-1044): Update very_last_time on any time search, and very_last_sequence on any sequence search. END HISTORY COMMENTS */ /* format: style4 */ log_read_: procedure (); /* * LOG_READ_ * * This is the user-ring log reading procedure. More comments to come * later. * * 84-06-05, W. Olin Sibert * 84-10-09, E. Swenson to handle setting limits on an empty log. * 84-11-26, BIM: added $update for use in monitoring. * 84-11-28, Steve Herbst: Added $open_with_procedure, which sets * entry variables in log_read_data. * 84-12-06, Steve Herbst: Added $hold_message, $free_message, * $get_log_uid, $register, and $deregister. * 1984-12-15, BIM: various debugging changes to the above. * 1985-01-25, BIM: no zero code on null log message ptr. * 1985-02-18, EJ Sharpe: optimizations (binary search for message time * or sequence numbers. Use suffix_time when searching for * specific message time to avoid some initiates. * 1985-03-15, Lindsey Spratt, Steve Herbst: Fixed to allocate held * message nodes in system_area instead of caller_area. * 1985-03-18, Steve Herbst: Fixed $open entries to abort if current * log segment is null and previous not found. */ declare P_log_dname char (*) parameter; declare P_log_ename char (*) parameter; declare P_log_read_data_ptr pointer parameter; declare P_log_message_ptr pointer parameter; declare P_open_info_ptr pointer parameter; declare P_message_sequence fixed bin (35) parameter; declare P_message_time fixed bin (71) parameter; declare P_event_channel fixed bin (71) parameter; declare P_log_uid bit (36) aligned parameter; declare P_process_id bit (36) aligned parameter; declare P_search_direction bit (1) aligned parameter; declare P_code fixed bin (35) parameter; declare allocate_copies bit (1) aligned; declare code fixed bin (35); declare procedure_name char (32); declare caller_area_ptr pointer; declare good_log_read_data_ptr pointer; declare system_area_ptr pointer; declare log_in_service bit (1) aligned; declare log_idx fixed bin; declare message_sequence fixed bin (35); declare new_log_read_data_ptr pointer; declare system_area area based (system_area_ptr); declare error_table_$badcall fixed bin (35) external static; declare error_table_$fatal_error fixed bin (35) external static; declare error_table_$log_segment_damaged fixed bin (35) external static; declare error_table_$no_log_message fixed bin (35) external static; declare error_table_$null_info_ptr fixed bin (35) ext static; declare error_table_$unimplemented_version fixed bin (35) ext static; declare cv_entry_ entry (char (*), ptr, fixed bin (35)) returns (entry); /* DBG declare date_time_$format entry (char (*), fixed bin (71), char (*), char (*)) returns (char (250) var); /* DBG */ declare get_system_free_area_ entry () returns (pointer); declare hcs_$get_uid_seg entry (ptr, bit (36) aligned, fixed bin (35)); declare hcs_$terminate_noname entry (pointer, fixed bin (35)); /* DBG declare ioa_ entry options (variable); /* DBG */ declare log_initiate_ entry (char (*), char (*), fixed bin, pointer, fixed bin (35)); declare log_list_history_$all entry (pointer, char (*), fixed bin, pointer); declare log_position_$find_sequence entry (pointer, fixed bin (35), bit (1) aligned, pointer, bit (1) aligned); declare log_position_$find_time entry (pointer, fixed bin (71), bit (1) aligned, pointer, bit (1) aligned); declare log_position_$next_message entry (pointer, pointer, bit (1) aligned); declare log_position_$prev_message entry (pointer, pointer, bit (1) aligned); declare log_segment_$get_service_bit entry (pointer, bit (1) aligned, fixed binary (35)); declare log_wakeup_$register entry (pointer, bit (36) aligned, fixed bin (71), fixed bin (35)); declare log_wakeup_$deregister entry (pointer, bit (36) aligned, fixed bin (71), fixed bin (35)); declare sub_err_ entry options (variable); declare cleanup condition; declare (clock, codeptr, divide, hbound, max, min, null, segno, setwordno, unspec) builtin; %page; log_read_$open: entry (P_log_dname, P_log_ename, P_log_read_data_ptr, P_code); P_log_read_data_ptr = null (); P_code = 0; procedure_name = ""; caller_area_ptr = get_system_free_area_ (); allocate_copies = "0"b; go to OPEN_COMMON; log_read_$open_long: entry (P_log_dname, P_log_ename, P_open_info_ptr, P_log_read_data_ptr, P_code); P_log_read_data_ptr = null (); P_code = 0; log_read_open_info_ptr = P_open_info_ptr; if log_read_open_info.version ^= LOG_READ_OPEN_INFO_VERSION_1 then call finished (error_table_$unimplemented_version); procedure_name = log_read_open_info.reader_procedure; caller_area_ptr = log_read_open_info.allocation_area_ptr; allocate_copies = log_read_open_info.allocate_copies; if procedure_name ^= "" & allocate_copies then call finished (error_table_$badcall); /* too hard to implement, it gets VERY confusing in $update */ OPEN_COMMON: log_read_data_ptr, good_log_read_data_ptr = null (); system_area_ptr = get_system_free_area_ (); on condition (cleanup) begin; call log_read_$close (good_log_read_data_ptr, (0)); end; log_read_data_n_segments = 1; allocate log_read_data in (system_area) set (log_read_data_ptr); unspec (log_read_data) = ""b; log_read_data.sentinel = LOG_READ_DATA_VERSION_SENTINEL; log_read_data.n_segments = log_read_data_n_segments; log_read_data.reader_data_ptr = null (); log_read_data.first_held_message_ptr = null (); log_read_data.latest_message = null (); log_read_data.earlier_message = null (); log_read_data.last_held_message_ptr = null (); log_read_data.ptr (*) = null (); log_read_data.history_complete = "0"b; log_read_data.call_procedures = (procedure_name ^= ""); log_read_data.user_area_ptr = caller_area_ptr; log_read_data.allocate_copies = allocate_copies; begin; declare 1 null_entry aligned, 2 code ptr, 2 env ptr; declare nulle entry variable; null_entry.code = null (); null_entry.env = null (); unspec (nulle) = unspec (null_entry); log_read_data.ev = nulle; /* aggregate */ end; if log_read_data.call_procedures then do; call set_entry_variable (log_read_data.ev.open, procedure_name, "open"); call set_entry_variable (log_read_data.ev.close, procedure_name, "close"); call set_entry_variable (log_read_data.ev.prev_message, procedure_name, "prev_message"); call set_entry_variable (log_read_data.ev.next_message, procedure_name, "next_message"); call set_entry_variable (log_read_data.ev.position_time, procedure_name, "position_time"); call set_entry_variable (log_read_data.ev.position_sequence, procedure_name, "position_sequence"); call set_entry_variable (log_read_data.ev.update, procedure_name, "update"); call set_entry_variable (log_read_data.ev.hold_message, procedure_name, "hold_message"); call set_entry_variable (log_read_data.ev.free_message, procedure_name, "free_message"); call set_entry_variable (log_read_data.ev.get_log_uid, procedure_name, "get_log_uid"); end; good_log_read_data_ptr = log_read_data_ptr; /* can be used now by log_read_$close above */ if log_read_data.call_procedures then do; call log_read_data.ev.open (P_log_dname, P_log_ename, caller_area_ptr, log_read_data.reader_data_ptr, code); if code ^= 0 then call finished (code); go to OPEN_GOOD_RETURN; /* The remainder is in the inner ring */ end; /* Try to initiate the beginning segment in the log family. Any error at this stage, and we just give up. */ log_idx = 1; log_read_data.dname (1) = P_log_dname; log_read_data.ename (1) = P_log_ename; call initiate_log (1); if (code ^= 0) then do; call log_read_$close (log_read_data_ptr, (0)); call finished (code); end; log_read_data.suffix_time (1) = clock (); /* A reasonable default-- logged messages will be earlier */ call get_complete_history (); call look_for_log_segment (log_read_data.n_segments, 1); /* Set up the limits in the header */ if log_segment_ptr = null () then call finished (error_table_$fatal_error); log_read_data.very_first_log_idx = log_idx; /* Start with oldest (first) message */ log_read_data.very_first_sequence = log_segment.first_sequence; log_read_data.very_first_time = log_segment.first_time; call look_for_log_segment (1, log_read_data.n_segments); /* Find newest (last) message */ if log_segment_ptr = null () then call finished (error_table_$fatal_error); if log_segment.first_sequence = 0 & log_segment.last_sequence = 0 then do; /* Log is empty */ call look_for_log_segment (2, log_read_data.n_segments); /* Find previous log */ if log_segment_ptr = null then call finished (error_table_$fatal_error); end; log_read_data.very_last_log_idx = log_idx; log_read_data.very_last_sequence = log_segment.last_sequence; log_read_data.very_last_time = log_segment.last_time; OPEN_GOOD_RETURN: P_log_read_data_ptr = log_read_data_ptr; call finished (0); %page; log_read_$close: entry (P_log_read_data_ptr, P_code); P_code = 0; if P_log_read_data_ptr = null () then return; call check_in_pointer; if log_read_data.call_procedures then do; P_log_read_data_ptr = null (); call log_read_data.ev.close (log_read_data.reader_data_ptr, code); call finished (code); end; if log_read_data.allocate_copies then call free_held_messages (); P_log_read_data_ptr = null (); system_area_ptr = get_system_free_area_ (); do log_idx = 1 to hbound (log_read_data.ptr, 1); if (log_read_data.ptr (log_idx) ^= null ()) then call hcs_$terminate_noname (log_read_data.ptr (log_idx), (0)); end; free log_read_data in (system_area); call finished (0); %page; log_read_$next_message: entry (P_log_read_data_ptr, P_log_message_ptr, P_code); call check_in_pointer; log_message_ptr = P_log_message_ptr; if log_read_data.call_procedures then do; call log_read_data.ev.next_message (log_read_data.reader_data_ptr, P_log_message_ptr, code); call finished (code); end; if log_read_data.allocate_copies then log_message_ptr = lookup_message (log_message_ptr); /* turn ptr to user's copy into real msg ptr */ if (log_message_ptr = null ()) then do; call look_for_log_segment (log_read_data.n_segments, 1); /* Look through them all, backwards */ if (log_segment_ptr = null ()) then call finished (code); /* Couldn't find anything, punt */ end; else call find_log_idx_of_message (); call log_position_$next_message (log_segment_ptr, log_message_ptr, log_read_data.damaged (log_idx)); if (log_message_ptr = null ()) then do; /* Not in that segment, try the next one */ call look_for_log_segment ((log_idx - 1), 1);/* Search remaining ones */ if (log_segment_ptr = null ()) then call finished (error_table_$no_log_message); call log_position_$next_message (log_segment_ptr, log_message_ptr, log_read_data.damaged (log_idx)); if log_message_ptr = null () /* still no one home */ then call finished (error_table_$no_log_message); /* So say so */ end; /**** Arrive here with a found message in our mouth */ if log_read_data.allocate_copies then call short_hold_message (log_message_ptr); /* input-output, replaces pointer with copy */ P_log_message_ptr = log_message_ptr; call finished (0); %page; log_read_$prev_message: entry (P_log_read_data_ptr, P_log_message_ptr, P_code); call check_in_pointer; log_message_ptr = P_log_message_ptr; if log_read_data.call_procedures then do; call log_read_data.ev.prev_message (log_read_data.reader_data_ptr, P_log_message_ptr, code); call finished (code); end; if log_read_data.allocate_copies then log_message_ptr = lookup_message (log_message_ptr); /* turn ptr to user's copy into real msg ptr */ if (log_message_ptr = null ()) then do; call look_for_log_segment (1, log_read_data.n_segments); /* Look through them all, from the end */ if (log_segment_ptr = null ()) then /* Couldn't find anything, punt */ call finished (code); end; else call find_log_idx_of_message (); call log_position_$prev_message (log_segment_ptr, log_message_ptr, log_read_data.damaged (log_idx)); if (log_message_ptr = null ()) then do; /* Not in that segment, try the previous one */ call look_for_log_segment ((log_idx + 1), log_read_data.n_segments); /* Search remaining ones */ if (log_segment_ptr = null ()) then call finished (error_table_$no_log_message); call log_position_$prev_message (log_segment_ptr, log_message_ptr, log_read_data.damaged (log_idx)); if log_message_ptr = null () /* Still no one home? Must be an emptr segment. */ then call finished (error_table_$no_log_message); end; if log_read_data.allocate_copies then call short_hold_message (log_message_ptr); /* input-output, replaces pointer with copy */ P_log_message_ptr = log_message_ptr; call finished (0); %page; log_read_$position_sequence: entry (P_log_read_data_ptr, P_message_sequence, P_search_direction, P_log_message_ptr, P_code); call check_in_pointer; P_log_message_ptr = null (); if log_read_data.call_procedures then do; call log_read_data.ev.position_sequence (log_read_data.reader_data_ptr, P_message_sequence, P_search_direction, P_log_message_ptr, code); call finished (code); end; call sequence_search (P_search_direction); if log_read_data.allocate_copies then call short_hold_message (log_message_ptr); /* input-output, replaces pointer with copy */ P_log_message_ptr = log_message_ptr; if (log_message_ptr = null ()) then call finished (error_table_$no_log_message); else call finished (0); %page; log_read_$position_time: entry (P_log_read_data_ptr, P_message_time, P_search_direction, P_log_message_ptr, P_code); call check_in_pointer; P_log_message_ptr = null (); if log_read_data.call_procedures then do; call log_read_data.ev.position_time (log_read_data.reader_data_ptr, P_message_time, P_search_direction, P_log_message_ptr, code); call finished (code); end; call time_search (P_search_direction); if log_read_data.allocate_copies then call short_hold_message (log_message_ptr); /* input-output, replaces pointer with copy */ P_log_message_ptr = log_message_ptr; if (log_message_ptr = null ()) then call finished (error_table_$no_log_message); else call finished (0); %page; /**** This entrypoint may close and reopen the log, resetting the log_read_data_ptr. This entrypoint checks the in_service state of the log, and closes and reopens if it is not in service. */ log_read_$update: entry (P_message_sequence, P_log_read_data_ptr, P_log_message_ptr, P_code); call check_in_pointer; call update_procedure (); return; %page; log_read_$hold_message: entry (P_log_read_data_ptr, P_log_message_ptr); call check_in_pointer; if log_read_data.call_procedures then do; call log_read_data.ev.hold_message (log_read_data.reader_data_ptr, P_log_message_ptr); return; /* DO NOT pass through finish, we have no output code */ end; if log_read_data.allocate_copies then do; log_message_ptr = lookup_message (P_log_message_ptr); /* demand that we have it someplace */ call hold_message (log_message_ptr, P_log_message_ptr); /* actual, copy */ if log_message_ptr = log_read_data.latest_message.actual_ptr then log_read_data.latest_message = null (); /* To avoid having to make sure that the ref count is set to 2 */ if log_message_ptr = log_read_data.earlier_message.actual_ptr then log_read_data.earlier_message = null ();/* To avoid having to make sure that the ref count is set to 2 */ end; return; %page; log_read_$free_message: entry (P_log_read_data_ptr, P_log_message_ptr); call check_in_pointer; if log_read_data.call_procedures then do; call log_read_data.ev.free_message (log_read_data.reader_data_ptr, P_log_message_ptr); return; end; if log_read_data.allocate_copies then do; call free_message (P_log_message_ptr); /* search for the COPY */ end; return; %page; log_read_$get_log_uid: entry (P_log_read_data_ptr, P_log_uid, P_code); call check_in_pointer; P_code = 0; P_log_uid = "0"b; if log_read_data.call_procedures then do; call log_read_data.ev.get_log_uid (log_read_data.reader_data_ptr, P_log_uid, code); call finished (code); end; call hcs_$get_uid_seg (log_read_data.segments (1).ptr, P_log_uid, code); call finished (code); %page; log_read_$register: entry (P_log_read_data_ptr, P_process_id, P_event_channel, P_code); call check_in_pointer; if log_read_data.call_procedures then do; call log_read_data.ev.register (log_read_data.reader_data_ptr, P_process_id, P_event_channel, code); call finished (code); end; call log_wakeup_$register (log_read_data.segments (1).ptr, P_process_id, P_event_channel, code); call finished (code); %page; log_read_$deregister: entry (P_log_read_data_ptr, P_process_id, P_event_channel, P_code); call check_in_pointer; if log_read_data.call_procedures then do; call log_read_data.ev.deregister (log_read_data.reader_data_ptr, P_process_id, P_event_channel, code); call finished (code); end; call log_wakeup_$deregister (log_read_data.segments (1).ptr, P_process_id, P_event_channel, code); call finished (code); %page; sequence_search: procedure (P_after_sw); declare P_after_sw bit (1) aligned parameter; declare message_sequence fixed bin (35); declare found bit (1); message_sequence = P_message_sequence; call set_current_log (log_read_data.very_last_log_idx); /* update the last sequence number, messages may have arrived */ log_read_data.very_last_sequence = log_segment.last_sequence; if P_after_sw then do; if (message_sequence <= log_read_data.very_first_sequence) then do; call set_current_log (log_read_data.very_first_log_idx); log_message_ptr = null (); /* Force position to first message */ call log_position_$next_message (log_segment_ptr, log_message_ptr, ("0"b)); end; else if (message_sequence > log_read_data.very_last_sequence) then log_message_ptr = null (); else call search_for_sequence (); end; else if ^P_after_sw then do; if (message_sequence >= log_read_data.very_last_sequence) then do; call set_current_log (log_read_data.very_last_log_idx); log_message_ptr = null (); /* Force position to last message */ call log_position_$prev_message (log_segment_ptr, log_message_ptr, ("0"b)); end; else if (message_sequence < log_read_data.very_first_sequence) then log_message_ptr = null (); else call search_for_sequence (); end; return; %page; /* This routine implements a binary search to find the particular message sequence number we want. It may turn out that that sequence does not exist (due to message or log segments lost). In that case we'll find an acceptable substitute consistant sith P_after_sw. */ search_for_sequence: procedure (); declare found bit (1); declare test_idx fixed bin; declare low_idx fixed bin; declare high_idx fixed bin; log_message_ptr = null (); /* We'll try the newest log segment. If the sequence we're interested in is there, we can avoid the binary search. The newest log is already initiated, so this isn't too expensive. */ call look_for_log_segment (log_read_data.very_last_log_idx, log_read_data.very_first_log_idx); if log_idx = 0 /* all the log segments damaged? */ then return; else if message_sequence >= log_segment.first_sequence & message_sequence <= log_segment.last_sequence then goto call_log_position; /* found it, now position to message */ /* set up for binary search */ found = "0"b; low_idx = log_idx + 1; /* skip one(s) we've already looked at */ high_idx = log_read_data.very_first_log_idx; /* last log in list (oldest) */ /* DBG call ioa_ ("Test sequence is ^d", message_sequence); /* DBG */ do while ((low_idx <= high_idx) & ^found); test_idx = divide ((high_idx - low_idx), 2, 17, 0) + low_idx; /* Initiate the log segment whose index is test_idx. We'll compare the first and last sequence number values against the sequence we're looking for. The internal proc "look_for_log_segment" is called to perform the initiation. If the desired segment can't be initiated (i.e. it's damaged) look_for_log_segment will try the next in sequence automatically. We tell it in which direction to search based upon P_after_sw. It may very well happen that look_for_log_segment will hit the end of the partition we're working with. It that case, we'll adjust the partition and try again. */ call look_for_log_segment (test_idx, high_idx); if log_idx = 0 /* unable to get any log segment? */ then high_idx = test_idx; /* get damaged segs out of partition */ /* See if what we're looking for is in this log segment. If not, we must adjust the search partition to contain the range of log segments that are still candidates. This will be the upper or lower half of the current partition. Note the optimization in which we ignore those indicies between test_idx and log_idx, these are damaged log segments and should not be included in this partitioning. */ else do; /* DBG call ioa_ ("Partition= ^d to ^d; test= ^d^[ *Actually ^d*^;^s^] (^d to ^d)", low_idx, high_idx, test_idx, (test_idx^=log_idx), log_idx, log_segment.first_sequence, log_segment.last_sequence);/*DBG */ if message_sequence >= log_segment.first_sequence & message_sequence <= log_segment.last_sequence then found = "1"b; else if message_sequence < log_segment.last_sequence then low_idx = log_idx + 1; /* partition to older half */ else high_idx = test_idx - 1; /* partition to younger half */ end; end; /* If we were unable to find a log segment that contains the desired sequence number, we must assume that number falls between a pair of existing log segments. One of the pair is at the index we currently hold. Here we'll check to see if we really shouldn't be looking at the other of the pair. The value of P_after_sw will help us decide. */ if ^found then if P_after_sw then if message_sequence > log_segment.last_sequence then do; test_idx = max (test_idx - 1, log_read_data.very_last_log_idx); /* pick up next younger log segment, if there is one */ call look_for_log_segment (test_idx, log_read_data.very_last_log_idx); end; else ; /* we've got the better choice already */ else if message_sequence < log_segment.first_sequence then do; test_idx = min (test_idx + 1, log_read_data.very_first_log_idx); /* pick up next older log segment, if there is one */ call look_for_log_segment (test_idx, log_read_data.very_first_log_idx); end; else ; /* we've got the better choice already */ else ; if log_segment_ptr = null () then return; /* couldn't find anything good */ /* And finally we can have log_position_ get us to the specific message within the log segment. */ if message_sequence >= log_segment.first_sequence & message_sequence <= log_segment.last_sequence then do; call_log_position: call log_position_$find_sequence (log_segment_ptr, message_sequence, P_after_sw, log_message_ptr, ("0"b)); end; else do; /* We won't have an exact match, get the first message in the next log or the last message in the previous log. */ if P_after_sw then call log_position_$next_message (log_segment_ptr, log_message_ptr, ("0"b)); else call log_position_$prev_message (log_segment_ptr, log_message_ptr, ("0"b)); end; end search_for_sequence; end sequence_search; %page; set_entry_variable: procedure (P_entry_variable, P_procedure_name, P_entry_name); declare P_entry_variable variable entry parameter; declare P_entry_name char (*) parameter; declare P_procedure_name char (*) parameter; RETRY: P_entry_variable = cv_entry_ (P_procedure_name || "$" || P_entry_name, codeptr (log_read_), code); if (code = 0) then return; call sub_err_ (code, "log_read_", ACTION_CAN_RESTART, null (), (0), "Failed to snap link to ^a$^a.", P_procedure_name, P_entry_name); go to RETRY; end set_entry_variable; %page; time_search: procedure (P_after_sw); declare P_after_sw bit (1) aligned parameter; declare message_time fixed bin (71); message_time = P_message_time; call set_current_log (log_read_data.very_last_log_idx); /* update our notion of the last time in the family */ log_read_data.very_last_time = log_segment.last_time; /* since messages may have arrived */ if P_after_sw then do; if (message_time <= log_read_data.very_first_time) then do; call set_current_log (log_read_data.very_first_log_idx); log_message_ptr = null (); /* Force position to first message */ call log_position_$next_message (log_segment_ptr, log_message_ptr, ("0"b)); end; else if (message_time > log_read_data.very_last_time) then log_message_ptr = null (); else call search_for_time (); end; else if ^P_after_sw then do; if (message_time >= log_read_data.very_last_time) then do; call set_current_log (log_read_data.very_last_log_idx); log_message_ptr = null (); /* Force position to last message */ call log_position_$prev_message (log_segment_ptr, log_message_ptr, ("0"b)); end; else if (message_time < log_read_data.very_first_time) then log_message_ptr = null (); else call search_for_time (); end; return; %page; /* This routine implements a binary search to find a message near the desired time. Here we attempt to initiate as few log segments as possible. Rather than peek at log_segment.last_time and log_segment.first_time we trust the segment time suffix. */ search_for_time: procedure; declare found bit (1); declare test_idx fixed bin; declare low_idx fixed bin; declare high_idx fixed bin; declare first_message_time fixed bin (71); log_message_ptr = null (); /* We'll first try the newest log segment. If the time we're interested in is there, we can avoid the binary search. The newest log is already initiated, so this isn't too expensive. */ call look_for_log_segment (log_read_data.very_last_log_idx, log_read_data.very_first_log_idx); if log_idx = 0 /* all log segments damaged? */ then return; else if message_time >= log_segment.first_time & message_time <= log_segment.last_time then goto call_log_position; /* found it, now position to message */ /* set up for binary search */ found = "0"b; low_idx = log_idx + 1; /* skip one(s) we've already looked at */ high_idx = log_read_data.very_first_log_idx; /* last log in list (oldest) */ /* DBG call ioa_ ("Test time is ^a.", date_time_$format ("date_time", message_time, "", ""));/* DBG */ do while ((low_idx <= high_idx) & ^found); test_idx = divide ((high_idx - low_idx), 2, 17, 0) + low_idx; /* Get the time of the first message in this log segment. We do this by looking at the time of the last message in the previous log segment. A side effect is that we'll always find a log segment in our search (since all times between very_first_time and very_last_time will be included). This happens regardless of missing log segments. There is a chance that we'll get the wrong one this way, an extra check is made later - once the segment we select is initiated. */ if test_idx < log_read_data.very_first_log_idx then first_message_time = log_read_data.segments (test_idx + 1).suffix_time + 1; /* this may be way off */ else first_message_time = log_read_data.very_first_time; /* DBG call ioa_ ("Partition= ^d to ^d; test= ^d (^a to ^a)", low_idx, high_idx, test_idx, date_time_$format ("date_time", first_message_time, "", ""), date_time_$format ("date_time", log_read_data.segments(test_idx).suffix_time, "", ""));/* DBG */ /* See if what we're looking for is in this log segment. If not, adjust the search partition to include only those segments which are still possible candidates. */ if message_time >= first_message_time & message_time <= log_read_data.segments (test_idx).suffix_time then found = "1"b; else if message_time < log_read_data.segments (test_idx).suffix_time then low_idx = test_idx + 1; /* partition to older half */ else high_idx = test_idx - 1; /* partition to younger half */ end; if ^found then return; /* must always find a log segment */ /* Now get the log segment we've selected initiated. Note that "look_for_log_segment" may give us something different. This happens if the log we selected is damaged. The direction of search for an undamaged log segment is determined by the value of P_after_sw. */ if P_after_sw then call look_for_log_segment (test_idx, log_read_data.very_last_log_idx); else call look_for_log_segment (test_idx, log_read_data.very_first_log_idx); /* Now that we've actually got a log segment initiated we can check to see if our estimate re: log_segment.first_time (see first_message_time above) was OK. We're only concerned if P_after_sw is false (implying backward searching). */ if ^P_after_sw then if log_segment.first_time > message_time then if test_idx < log_read_data.very_first_log_idx then do; test_idx = test_idx + 1; /* go to previous log segment */ call look_for_log_segment (test_idx, log_read_data.very_first_log_idx); end; else ; else ; else ; if log_segment_ptr = null () then return; /* couldn't find anything good */ /* And finally we can have log_position_ get us to the specific message within the log segment. */ if message_time >= log_segment.first_time & message_time <= log_segment.last_time then do; call_log_position: call log_position_$find_time (log_segment_ptr, message_time, P_after_sw, log_message_ptr, ("0"b)); end; else do; /* We won't have an exact match, get the first message in the next log or the last message in the previous log. */ if P_after_sw then call log_position_$next_message (log_segment_ptr, log_message_ptr, ("0"b)); else call log_position_$prev_message (log_segment_ptr, log_message_ptr, ("0"b)); end; end search_for_time; end time_search; %page; find_log_idx_of_message: procedure (); /* This procedure sets log_segment_ptr and log_idx to identify the log segment containing the log message we were passed as an argument. If it's not the most recently used segment, a linear search is performed. */ if (log_read_data.current_idx > 0) then if (log_read_data.current_ptr = log_read_data.ptr (log_read_data.current_idx)) then if (segno (log_read_data.current_ptr) = segno (log_message_ptr)) then do; log_idx = log_read_data.current_idx; log_segment_ptr = log_read_data.current_ptr; return; end; do log_idx = 1 to log_read_data.n_segments; if (segno (log_read_data.ptr (log_idx)) = segno (log_message_ptr)) then do; call set_current_log (log_idx); /* (re-)sets global log_idx, even though we have it here */ return; end; end; /* of loop through segments */ /* If it's not one of the segments we know about, then it's flat wrong. Probably there is a better choice for status code, but this will do for now. */ call finished (error_table_$fatal_error); end find_log_idx_of_message; %page; look_for_log_segment: procedure (P_start, P_finish); /* This procedure sets log_segment_ptr and log_idx to identify the first segment it can initiate in the range specified. If none can be found, log_segment_ptr is set to null, log_idx to zero, and the caller gets to take appropriate action. */ declare P_start fixed bin parameter; declare P_finish fixed bin parameter; declare increment fixed bin; declare test_idx fixed bin; if (P_start > P_finish) then /* Force loop to proceed in right direction */ increment = -1; else increment = 1; code = 1; /* Simulate DO ... UNTIL */ do test_idx = P_start to P_finish by increment while (code ^= 0); call initiate_log (test_idx); if (code = 0) then log_idx = test_idx; /* Remember the one that succeeded */ end; if (code ^= 0) then /* A zero invalidates the current log pointer */ call set_current_log (0); else call set_current_log (log_idx); /* (re-)sets global log_idx, which is OK */ return; end look_for_log_segment; %page; set_current_log: procedure (P_log_idx); /* This procedure sets the values identifying the current log in log_read_data; these values are used solely as an optimization for find_log_idx_of_message. It also sets the global log_idx (often used as input) and log_segment_ptr values. */ declare P_log_idx fixed bin parameter; if (P_log_idx = 0) then log_segment_ptr = null (); else log_segment_ptr = log_read_data.ptr (P_log_idx); log_read_data.current_ptr = log_segment_ptr; log_read_data.current_idx = P_log_idx; log_idx = P_log_idx; return; end set_current_log; %page; initiate_log: procedure (P_idx); declare P_idx fixed bin parameter; if (log_read_data.damaged (P_idx)) then do; code = error_table_$log_segment_damaged; return; end; if (log_read_data.ptr (P_idx) ^= null ()) then do; code = 0; /* Indicate success */ return; end; call log_initiate_ (log_read_data.dname (P_idx), log_read_data.ename (P_idx), 10, log_read_data.ptr (P_idx), code); if (code ^= 0) then log_read_data.damaged (P_idx) = "1"b; return; end initiate_log; %page; get_complete_history: procedure (); declare new_log_read_data_ptr pointer; declare new_idx fixed bin; /* NL */ declare saved_n_segments fixed bin; /* This procedure is responsible for listing any remaining history for this log family-- it must be called every time we try to position before the beginning of the current history. It may change the value of log_read_data_ptr; however, because it only adds new entries at the end, it will NOT invalidate the current index into the log_read_data log array. It is the calling routine's responsibility to pass the new version of log_read_data_ptr back to the caller, but since this routine is now called only at open time, this is not a problem. It will become a problem if the optimization to initiate only the first segment (until others are needed) is implemented. */ if log_read_data.history_complete then return; /* It's already happened */ call log_list_history_$all (log_read_data.ptr (1), log_read_data.ename (1), log_read_data.n_segments, new_log_read_data_ptr); if (new_log_read_data_ptr ^= null ()) then do; /* There is some history, so replace our structure with it */ do new_idx = 1 to log_read_data.n_segments; new_log_read_data_ptr -> log_read_data.segments (new_idx) = log_read_data.segments (new_idx); end; /* Can't just copy the header, because that would copy log_read_data.n_segments, which still has the old value */ saved_n_segments = new_log_read_data_ptr -> log_read_data.n_segments; new_log_read_data_ptr -> log_read_data.header = log_read_data.header; new_log_read_data_ptr -> log_read_data.n_segments = saved_n_segments; /* NL */ system_area_ptr = get_system_free_area_ (); free log_read_data_ptr -> log_read_data in (system_area); log_read_data_ptr = new_log_read_data_ptr; new_log_read_data_ptr = null (); end; log_read_data.history_complete = "1"b; /* So we never have to go through this again */ return; end get_complete_history; %page; MAIN_RETURN: return; %page; update_procedure: procedure (); log_message_ptr = P_log_message_ptr; if log_read_data.allocate_copies then log_message_ptr = lookup_message (log_message_ptr); if (log_message_ptr = null ()) then call finished (error_table_$fatal_error); if log_read_data.call_procedures then do; call log_read_data.ev.update (P_message_sequence, log_read_data.reader_data_ptr, P_log_message_ptr, code); call finished (code); end; message_sequence = P_message_sequence; log_segment_ptr = setwordno (log_message_ptr, 0); call log_segment_$get_service_bit (log_segment_ptr, log_in_service, code); if code ^= 0 then call finished (code); if message_sequence >= log_segment.limits.first_sequence & message_sequence <= log_segment.limits.last_sequence & log_in_service then call finished (0); call log_read_$open (log_read_data.segments (1).dname, log_read_data.segments (1).ename, new_log_read_data_ptr, code); if code ^= 0 then call finished (0); /* leave well enough alone if this fails */ call log_read_$position_sequence (new_log_read_data_ptr, message_sequence, "1"b /* here or later */, log_message_ptr, code); /* this recursive call will short-hold the one preserved message */ if code ^= 0 then do; call log_read_$close (new_log_read_data_ptr, (0)); call finished (0); end; if log_read_data.allocate_copies then /* held messages cannot be held across an update */ /* because the copy pointers cannot be preserved */ call free_held_messages; call log_read_$close (log_read_data_ptr, (0)); log_read_data_ptr = new_log_read_data_ptr; P_log_read_data_ptr = log_read_data_ptr; P_log_message_ptr = log_message_ptr; call finished (0); return; end update_procedure; %page; short_hold_message: procedure (P_message_ptr); declare P_message_ptr pointer; declare mp pointer; declare node_ptr pointer; declare prev_node_ptr pointer; if P_message_ptr = null () then return; if log_read_data.earlier_message.actual_ptr ^= null () then do; call lookup_node (log_read_data.earlier_message.actual_ptr, node_ptr, prev_node_ptr); if node_ptr ^= null () then call dereference_node (node_ptr, prev_node_ptr); else free log_read_data.earlier_message.copy_ptr -> log_message; log_read_data.earlier_message = null (); /* in aggregate */ end; log_read_data.earlier_message = log_read_data.latest_message; /* roll over ! */ mp = P_message_ptr; call lookup_node (mp, node_ptr, (null ())); if node_ptr ^= null () then do; node_ptr -> log_held_message_node.reference_count = node_ptr -> log_held_message_node.reference_count + 1; log_read_data.latest_message = node_ptr -> log_held_message_node.message; end; else do; log_read_data.latest_message.actual_ptr = mp; call allocate_copy (mp, log_read_data.latest_message.copy_ptr); end; P_message_ptr = log_read_data.latest_message.copy_ptr; return; end short_hold_message; hold_message: procedure (P_message_ptr, P_message_copy_ptr); declare P_message_ptr pointer; declare P_message_copy_ptr pointer; declare mp pointer; declare node_ptr pointer; mp = P_message_ptr; call lookup_node (mp, node_ptr, (null ())); if node_ptr = null () then do; node_ptr = new_node (); node_ptr -> log_held_message_node.actual_ptr = mp; node_ptr -> log_held_message_node.copy_ptr = P_message_copy_ptr; end; node_ptr -> log_held_message_node.reference_count = node_ptr -> log_held_message_node.reference_count + 1; return; end hold_message; free_message: procedure (P_message_ptr); declare P_message_ptr pointer; declare mp pointer; declare prev_node_ptr pointer; declare node_ptr pointer; declare next_node_ptr pointer; mp = P_message_ptr; prev_node_ptr = null (); node_ptr = log_read_data.first_held_message_ptr; do while (node_ptr ^= null ()); if node_ptr -> log_held_message_node.copy_ptr = mp then go to FOUND_NODE; prev_node_ptr = node_ptr; node_ptr = node_ptr -> log_held_message_node.next_ptr; end; call sub_err_ (0, "log_read_", ACTION_CAN_RESTART, null (), (0), "free_message failed to find message ^p on held list.", mp); return; FOUND_NODE: DEREFERENCE_COMMON: if node_ptr -> log_held_message_node.reference_count > 1 then do; node_ptr -> log_held_message_node.reference_count = node_ptr -> log_held_message_node.reference_count - 1; return; end; free node_ptr -> log_held_message_node.copy_ptr -> log_message; next_node_ptr = node_ptr -> log_held_message_node.next_ptr; if prev_node_ptr ^= null () then prev_node_ptr -> log_held_message_node.next_ptr = next_node_ptr; else log_read_data.first_held_message_ptr = prev_node_ptr; if log_read_data.last_held_message_ptr = node_ptr then log_read_data.last_held_message_ptr = prev_node_ptr; free node_ptr -> log_held_message_node; return; dereference_node: entry (P_node_ptr, P_prev_node_ptr); declare P_node_ptr pointer; declare P_prev_node_ptr pointer; prev_node_ptr = P_prev_node_ptr; node_ptr = P_node_ptr; go to DEREFERENCE_COMMON; end free_message; lookup_node: procedure (P_message_ptr, P_node_ptr, P_prev_node_ptr); declare (P_message_ptr, P_node_ptr, P_prev_node_ptr) pointer; declare (mp, node_ptr, prev_node_ptr) pointer; mp = P_message_ptr; node_ptr = log_read_data.first_held_message_ptr; prev_node_ptr = null (); do while (node_ptr ^= null ()); if node_ptr -> log_held_message_node.actual_ptr = mp then go to FOUND_NODE; prev_node_ptr = node_ptr; node_ptr = node_ptr -> log_held_message_node.next_ptr; end; P_node_ptr, P_prev_node_ptr = null (); return; FOUND_NODE: P_node_ptr = node_ptr; P_prev_node_ptr = prev_node_ptr; return; end lookup_node; new_node: procedure returns (pointer); declare node_ptr pointer; system_area_ptr = get_system_free_area_ (); allocate log_held_message_node in (system_area) set (node_ptr); node_ptr -> log_held_message_node.next_ptr = null (); node_ptr -> log_held_message_node.reference_count = 0; if log_read_data.first_held_message_ptr = null () then do; log_read_data.first_held_message_ptr, log_read_data.last_held_message_ptr = node_ptr; return (node_ptr); end; log_read_data.last_held_message_ptr -> log_held_message_node.next_ptr = node_ptr; log_read_data.last_held_message_ptr = node_ptr; return (node_ptr); end new_node; lookup_message: procedure (P_copy_ptr) returns (pointer); declare node_ptr pointer; declare P_copy_ptr pointer; declare mp pointer; mp = P_copy_ptr; if mp = null () then return (null ()); if mp = log_read_data.latest_message.copy_ptr then return (log_read_data.latest_message.actual_ptr); if mp = log_read_data.earlier_message.copy_ptr then return (log_read_data.earlier_message.actual_ptr); node_ptr = log_read_data.first_held_message_ptr; do while (node_ptr ^= null ()); if mp = node_ptr -> log_held_message_node.copy_ptr then return (node_ptr -> log_held_message_node.actual_ptr); node_ptr = node_ptr -> log_held_message_node.next_ptr; end; call sub_err_ (error_table_$no_log_message, "log_read_", ACTION_CANT_RESTART, null (), (0), "Invalid message pointer ^p.", mp); end lookup_message; allocate_copy: procedure (P_message_ptr, P_copy_ptr); declare (P_message_ptr, P_copy_ptr) pointer; declare caller_area area based (log_read_data.user_area_ptr); log_message_text_lth = P_message_ptr -> log_message.text_lth; log_message_data_class_lth = P_message_ptr -> log_message.data_class_lth; log_message_data_lth = P_message_ptr -> log_message.data_lth; allocate log_message in (caller_area) set (P_copy_ptr); P_copy_ptr -> log_message = P_message_ptr -> log_message; return; end allocate_copy; free_held_messages: procedure; declare smp_this pointer; declare smp_next pointer; if log_read_data.latest_message.actual_ptr ^= null () then do; call lookup_node (log_read_data.latest_message.actual_ptr, smp_this, (null ())); if smp_this = null () /* its NOT in the held chain */ then free log_read_data.latest_message.copy_ptr -> log_message; log_read_data.latest_message = null (); end; if log_read_data.earlier_message.actual_ptr ^= null () then do; call lookup_node (log_read_data.earlier_message.actual_ptr, smp_this, (null ())); if smp_this = null () /* its NOT in the held chain */ then free log_read_data.earlier_message.copy_ptr -> log_message; log_read_data.earlier_message = null (); end; smp_this = log_read_data.first_held_message_ptr; do while (smp_this ^= null ()); free smp_this -> log_held_message_node.message.copy_ptr -> log_message; smp_next = smp_this -> log_held_message_node.next_ptr; free smp_this -> log_held_message_node; smp_this = smp_next; end; return; end free_held_messages; %page; check_in_pointer: procedure; log_read_data_ptr = P_log_read_data_ptr; if log_read_data_ptr = null () then call sub_err_ (error_table_$null_info_ptr, "log_read_", ACTION_CANT_RESTART, null (), (0), "Null log_read_data_ptr supplied."); if log_read_data.sentinel ^= LOG_READ_DATA_VERSION_SENTINEL then call sub_err_ (error_table_$badcall, "log_read_", ACTION_CANT_RESTART, null (), (0), "Invalid log_read_data_ptr supplied in call to log_read_."); return; end check_in_pointer; finished: procedure (P_return_code); declare P_return_code fixed bin (35) parameter; P_code = P_return_code; goto MAIN_RETURN; end finished; /* format: off */ %page; %include log_read_data; %page; %include log_read_open_info; %page; %include log_segment; %page; %include log_message; %page; %include sub_err_flags; end log_read_;  log_salvage_.pl1 11/11/89 1059.9r w 11/11/89 0800.0 310347 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /* format: style4,indattr */ log_salvage_: procedure (P_log_dname, P_log_ename, P_salvage_arg_ptr, P_salv_code); /* * LOG_SALVAGE_ * * This user-ring program is responsible for ensuring the log * family is in a usable state. System crashes at critical times * can cause a variety of disasters (mostly when an ESD is not * completed). For instance, the "current" log segment may be * found out of service or uninitialized. * * Here we check all segments in the primary log directory. It * is assumed that all other history directories are OK. * * NOTE: There is no attempt to lock other processes from modifying * the log. This routine should be called only when some other means * has been employed to obtain exclusive access to the log. * * Suggested usage: * call log_write_$open (dir, name, "0"b, datap, code); * if code ^= 0 then do; * unspec (salv_arg) = ""b; * salv_arg.version = LOG_SALVAGE_ARG_VERSION_1; * salv_arg.reporter_proc = print_errors; * call log_salvage_ (dir, name, addr(salv_arg), code); * if salv_code = 0 * then call log_write_$open (dir, name, "0"b, datap, code); * if code ^= 0 (* still failing? *) * then call error (code); * end; * * Note that the call to log_write_ has the parameter which controls * log creation set to "0"b. In cases where it is expected a log * segment already exists, it is best to leave possible re-creation * to log_salvage_. The log_salvage_ routine will attempt to set the * proper sequence number in a newly created log segment; log_write_ * will not. This is because log_write_ does not have the facility * to interrogate the log history. * * Modification History: * 85-04-09, EJ Sharpe: initial coding */ %page; /* Parameters */ declare P_log_dname char (*) parameter; /* Input: log dir path */ declare P_log_ename char (*) parameter; /* Input: log family name */ declare P_salvage_arg_ptr pointer parameter; /* Input: controls our behaviour */ declare P_salv_code fixed bin (35) parameter; /* Output: 0 tells caller to retry open */ /* Automatic */ declare log_dname char (168); /* arg copy */ declare log_ename char (32); /* arg copy */ declare 1 auto_log_salvage_arg aligned like log_salvage_arg; /* arg copy */ declare bit_count fixed bin (24); /* ignored */ declare code fixed bin (35); /* the usual */ declare current_log_ptr pointer; /* pointer to current (non-history) log seg */ declare done bit (1) aligned; /* loop control */ declare error_found bit (1) aligned; /* found some anomaly */ declare first_sequence_temp fixed bin (35); /* temp value */ declare fix_applied bit (1) aligned; /* changed something for the better */ declare i fixed bin; /* loop control */ declare history_log_ptr pointer; /* pointer to most recent usable history seg */ declare n_good_hist_segs fixed bin; /* the number of usable history segs */ declare newest_hist_log_idx fixed bin; /* index of most recent usable history seg */ declare next_older_log_idx fixed bin; /* temp idx */ declare next_older_log_ptr pointer; /* temp ptr */ declare oldest_hist_log_idx fixed bin; /* index of oldest history log which is usable */ declare renamed_damaged_log bit (1) aligned; /* set if current log seg damaged */ declare sequence_problem_detected bit (1) aligned; /* found problem with history sequencing */ /* Based */ /* NOTE NOTE NOTE - The following structure is copied from log_segment_. It does not exist in an include file because log_segment_ is the only program which is supposed to know this format. */ declare sequence_info_ptr pointer; declare 1 sequence_info aligned based (sequence_info_ptr), 2 pad bit (17) unal, 2 number fixed bin (35) unal, /* spans word boundary!!!!!!! */ 2 in_service bit (1) unal, 2 words_used fixed bin (18) unsigned unal; /* External */ declare error_table_$action_not_performed fixed bin (35) external; declare error_table_$bad_arg fixed bin (35) external; declare error_table_$namedup fixed bin (35) external; declare error_table_$noentry fixed bin (35) external; declare error_table_$nomatch fixed bin (35) external; declare error_table_$no_w_permission fixed bin (35) external; declare error_table_$unexpected_condition fixed bin (35) external; declare error_table_$unimplemented_version fixed bin (35) external; declare log_data_$default_log_size fixed bin (35) external; declare sys_info$first_reasonable_time fixed bin (71) external; /* Entries */ declare convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); declare cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); declare cu_$level_get entry returns (fixed bin); declare formline_ entry options (variable); declare get_group_id_ entry () returns (char (32)); declare get_process_access_class_ entry () returns (bit (72) aligned); declare get_system_free_area_ entry () returns (ptr); declare hcs_$chname_file entry (char (*), char (*), char (*), char (*), fixed bin (35)); declare hcs_$chname_seg entry (ptr, char (*), char (*), fixed bin (35)); declare hcs_$get_max_length_seg entry (ptr, fixed bin (19), fixed bin (35)); declare hcs_$list_acl entry (char (*), char (*), ptr, ptr, ptr, fixed bin, fixed bin (35)); declare hcs_$status_for_backup entry (char (*), char (*), pointer, fixed bin (35)); declare hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); declare initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); declare ioa_$rsnpnnl entry () options (variable); declare log_create_$new_segment entry (ptr, ptr, fixed bin (35)); declare log_list_history_$single_dir entry (char (*), char (*), ptr, fixed bin (35)); declare log_name_$name entry (char (*), fixed bin (71)) returns (char (32)); declare log_segment_$initialize_sequence entry (ptr, fixed bin (35), fixed bin (35)); declare log_segment_$place_in_service entry (ptr, fixed bin (35)); declare pathname_ entry (char (*), char (*)) returns (char (168)); declare terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); declare timer_manager_$sleep entry (fixed bin (71), bit (2)); declare unique_bits_ entry () returns (bit (70)); declare unique_chars_ entry (bit (*)) returns (char (15)); /* Misc */ declare NUM_GOOD_HIST_DESIRED fixed bin init (5) internal static options (constant); declare ONE_SECOND fixed bin (71) init (1000000) internal static options (constant); declare RELATIVE_MICROSECONDS bit (2) init ("10"b) internal static options (constant); declare any_other condition; declare cleanup condition; declare no_write_permission condition; declare seg_fault_error condition; declare abs builtin; declare addr builtin; declare clock builtin; declare length builtin; declare null builtin; declare rtrim builtin; declare size builtin; declare substr builtin; %page; /* MAIN CODE */ /* Here's the plan: Somehow log_write_ has failed to open the log, or we're being called just to check up on things. We will deal only with the log segments in the primary log directory. We won't try going off to other directories in search of older family members. The first step will be to get a list of the history logs in the directory (i.e. those with the name LOGNAME.??????.????). This list will be used to look at the last few segments or back to salvage_args.from_time. Each seg will be initiated and its header inspected. Any errors will be reported. The log_read_data structure will be used to keep track of those found "good" (the "ptr" element will be set non-null). The next step will be to check the good history segments for consistant sequence numbers. Any inconsistancies will be reported (a future enhancement will be to automatically adjust the sequence numbers). Finally, the current log segment "LOG_NAME" will be checked. If we're supposed to migrate segments to this log, this segment should not exist. Otherwise, we have to make sure the segment is there and usable. If there's some problem the segment will be renamed to "LOG_NAME.!(unique)" and a new one created. Some checks are made to ensure the sequence numbers are consistant between the current log segment and the history. */ /* Setup. */ error_found = "0"b; /* this will get set if we find a proble, */ fix_applied = "0"b; /* this will get set if we change something */ log_read_data_ptr = null (); history_log_ptr = null (); oldest_hist_log_idx = 0; newest_hist_log_idx = 0; current_log_ptr = null (); renamed_damaged_log = "0"b; /*** copy args */ log_dname = P_log_dname; log_ename = P_log_ename; log_salvage_arg_ptr = P_salvage_arg_ptr; auto_log_salvage_arg = log_salvage_arg; log_salvage_arg_ptr = addr (auto_log_salvage_arg); if log_salvage_arg.version ^= LOG_SALVAGE_ARG_VERSION_1 then call Finished (error_table_$unimplemented_version); if log_salvage_arg.from_time ^= 0 then if log_salvage_arg.from_time > clock () | log_salvage_arg.from_time < sys_info$first_reasonable_time then call Finished (error_table_$bad_arg); on cleanup call Cleanup; /* Get a list of the history segments (in the primary log directory) for this log. */ call log_list_history_$single_dir (log_dname, log_ename, log_read_data_ptr, code); if code = error_table_$nomatch then goto SKIP_HISTORY; if code ^= 0 then do; call Report_Error (code, "Unable to list ""^a"" log segments in ^a.", log_ename, log_dname); call Finished (code); end; /* Here we'll initiate the latest log history segments (excluding the damaged ones). The number of segments to initiate is determined by log_salvage_arg.from_time (but at least one). If zero, then we'll initiate the last NUM_GOOD_HIST_DESIRED segments. */ n_good_hist_segs = 0; done = "0"b; do i = 1 to log_read_data.n_segments while (^done); call Initiate_History_Segment_and_Check (i); /* will remove damaged ones from list */ if log_read_data.segments (i).ptr ^= null () /* will be null if seg is damaged in some way */ then do; n_good_hist_segs = n_good_hist_segs + 1; if n_good_hist_segs = 1 /* first one? */ then newest_hist_log_idx = i; /* remember it */ oldest_hist_log_idx = i; /* and the last one */ end; if log_salvage_arg.from_time > 0 then done = (log_read_data.segments (i).suffix_time <= log_salvage_arg.from_time); else done = n_good_hist_segs >= NUM_GOOD_HIST_DESIRED; end; if n_good_hist_segs = 0 then goto SKIP_HISTORY; /* At this point newest_hist_log_idx and oldest_hist_log_idx define the range of log segments we're interested in investigating further. There may be some in-between that are damaged, so we have to be careful to make sure we have the pointer. */ /* We'll check their sequence numbers to make sure they agree with the time stamps on the segment names (i.e. they must be ascending). */ sequence_problem_detected = "0"b; next_older_log_ptr = log_read_data.segments (oldest_hist_log_idx).ptr; next_older_log_idx = oldest_hist_log_idx; do i = (oldest_hist_log_idx - 1) to newest_hist_log_idx by -1; log_segment_ptr = log_read_data.segments (i).ptr; if log_segment_ptr ^= null () then do; if log_segment.first_sequence <= next_older_log_ptr -> log_segment.last_sequence then do; call Report_Error (0, "Sequence conflict in ""^a"" with ""^a"".", log_read_data.segments (i).ename, log_read_data.segments (next_older_log_idx).ename); sequence_problem_detected = "1"b; end; next_older_log_ptr = log_segment_ptr; next_older_log_idx = i; end; end; /*** The following is for future implementation; right now we'll have only the error messages, no fixes. if log_salvage_arg.flags.adjust_history_sequence & sequence_problem_detected then call Fix_History_Sequence; */ /* OK, checking of the log history is done. Now we deal with the current log segment. */ SKIP_HISTORY: call initiate_file_ (log_dname, log_ename, RW_ACCESS, current_log_ptr, bit_count, code); if code = error_table_$noentry then do; if ^log_salvage_arg.flags.migrating then do; call Create_New_Log_Seg (null ()); /* create a new one for 'em */ call Finished (0); end; else call Finished (0); /* thats how it should be */ end; else if code = 0 then do; if ^log_salvage_arg.flags.migrating then do; if ^Check_Log_Segment (current_log_ptr, log_ename, "1"b) then do; call Rename_as_Damaged (log_dname, log_ename); call Create_New_Log_Seg (current_log_ptr); call Finished (0); end; end; else do; call Report_Error (0, "Found history log without timestamp ""^a"".", log_ename); if ^Check_Log_Segment (current_log_ptr, log_ename, "0"b) then do; call Rename_as_Damaged (log_dname, log_ename); call Finished (0); end; else call Rename_for_Last_Message (current_log_ptr, log_ename); /* make it a history log segment */ end; end; else do; /* totally unexpected code, treat 'em as damaged */ call Report_Error (code, "^a", pathname_ (log_dname, log_ename)); call Rename_as_Damaged (log_dname, log_ename); if ^log_salvage_arg.flags.migrating then call Create_New_Log_Seg (null ()); call Finished (0); end; /* We end up here only if a current seg existed. The last check is to make sure the sequence succeeds the most recent history segment. */ if n_good_hist_segs = 0 /* but not if there was no history... */ then call Finished (0); history_log_ptr = log_read_data.segments (newest_hist_log_idx).ptr; if history_log_ptr ^= null () /* do we have at least one history seg? */ then do; if current_log_ptr -> log_segment.first_sequence ^= 0 then first_sequence_temp = current_log_ptr -> log_segment.first_sequence; else do; /* get first sequence number from the alloc info */ sequence_info_ptr = addr (current_log_ptr -> log_segment.alloc_info); first_sequence_temp = sequence_info.number; end; if first_sequence_temp <= history_log_ptr -> log_segment.last_sequence then do; call Report_Error (0, "Sequence conflict in ""^a"" with ""^a"".", log_ename, log_read_data.segments (newest_hist_log_idx).ename); call Rename_as_Damaged (log_dname, log_ename); if ^log_salvage_arg.migrating then call Create_New_Log_Seg (current_log_ptr); call Finished (0); end; end; else do; /*** We don't have any log history ptr, but we still want to make sure the sequence numbers seem appropriate. Thus, if there was any history segment (damaged or inaccessable) we'll make sure the present log does not start at the beginning of the sequence. log_segment_ starts all logs at 1000000 (1 million), if this one starts there, and there are history segs, the sequence was restarted somehow. Unfortunately, there's no way to determine what the real sequence numbers should be. ***/ if log_read_data.n_segments > 0 & log_segment.first_sequence < 1000001 then do; call Report_Error (0, "Sequence was restarted."); call Finished (0); end; end; call Finished (0); %page; /* * * FINISHED * * This is the exit procedure. The cleanup procedure is called, and * a little editing is done on the returned code. We want to be sure * to return 0 if we didn't encounter a fatal error AND we actually * were of some help. If there was nothing we could do, we return * error_table_$action_not_performed. This tell's our caller that * it is useless to retry the log_write_$open operation. * */ Finished: procedure (P_code); declare P_code fixed bin (35) parameter; call Cleanup; if fix_applied then P_salv_code = P_code; else if P_code = 0 then P_salv_code = error_table_$action_not_performed; else P_salv_code = P_code; goto MAIN_RETURN; end Finished; MAIN_RETURN: return; %page; /* * * CLEANUP * * Terminate any initiated segs, and free allocated storage. * */ Cleanup: procedure; declare p pointer; /* local scratch pointer */ if log_read_data_ptr ^= null then do; do i = 1 to log_read_data.n_segments; if log_read_data.segments (i).ptr ^= null () then do; p = log_read_data.segments (i).ptr; log_read_data.segments (i).ptr = null (); call terminate_file_ (p, 0, TERM_FILE_TERM, (0)); end; end; free log_read_data; log_read_data_ptr = null (); end; if current_log_ptr ^= null () then do; p = current_log_ptr; current_log_ptr = null (); call terminate_file_ (p, 0, TERM_FILE_TERM, (0)); end; end Cleanup; %page; /* * * REPORT_ERROR * REPORT_FIX * * This routine is called whenever there is anything to say. The * reporter procedure specified in log_salvage_arg is used to * print (or whatever pleases it) the message. * * Also, this is where flags are set indicating whether any errors * were detected, and whether any fixes were applied. * */ Report_Error: procedure options (variable); declare arg_code fixed bin (35) based (argp); declare argl fixed bin (21); /* ignored */ declare argp pointer; declare ecode fixed bin (35); declare ignore_short_mess char (8) aligned; /* ignored */ declare long_mess char (100) aligned; /* expanded status code */ declare msg char (msg_len) based (msg_ptr); declare msg_buff char (512); declare msg_len fixed bin (21); declare msg_ptr pointer; declare complete_msg char (complete_msg_len) based (complete_msg_ptr); declare complete_msg_buff char (614); /* 102 chars bigger than msg_buff */ declare complete_msg_len fixed bin (21); declare complete_msg_ptr pointer; error_found = "1"b; /* so we remember we found some anomaly */ goto REPORT_COMMON; Report_Fix: entry options (variable); fix_applied = "1"b; /* so we remember we did something */ REPORT_COMMON: call cu_$arg_ptr (1, argp, argl, ecode); /* get arg_code */ if ecode ^= 0 then call Finished (ecode); ecode = arg_code; /* copy our arg */ /*** first format the message passed to us */ msg_ptr = addr (msg_buff); msg_len = size (msg_buff); call formline_ (2, 3, addr (msg_buff), msg_len, 0 /* no pad */); /*** second, expand the error code */ if ecode ^= 0 then do; call convert_status_code_ (ecode, ignore_short_mess, long_mess); complete_msg_ptr = addr (complete_msg_buff); complete_msg_len = length (complete_msg_buff); call ioa_$rsnpnnl ("^a ^a", complete_msg_buff, complete_msg_len, long_mess, msg); end; else do; /*** This is all we have... */ complete_msg_ptr = msg_ptr; complete_msg_len = msg_len; end; /*** finally, call the reporting procedure. This procedure will be responsible for adding the frosting on the messages (i.e. name of procedure generating the message, pathname of log we're salvaging, process group id, etc). */ on any_other call Finished (error_table_$unexpected_condition); call log_salvage_arg.reporter_proc (complete_msg); return; end Report_Error; %page; /* * * INITIATE_HISTORY_SEGMENT_AND_CHECK * * This routine initiates a log history segment. The first attempt is * made requesting RW access. If that fails, a second attempt is made * requesting only R access. Having only R access becomes a problem * only if the service bit will need to be turned off (and, in the * future, if the sequence numbers need adjustment). Any code in * log_salvage_ which tries to modify a history segment must be * prepared to take an access violation fault. * */ Initiate_History_Segment_and_Check: procedure (P_log_idx); declare P_log_idx fixed bin; /* index into log_read_data */ declare log_idx fixed bin; declare ecode fixed bin (35); declare log_ptr pointer; log_idx = P_log_idx; call initiate_file_ (log_dname, log_read_data.segments (log_idx).ename, RW_ACCESS, log_ptr, bit_count, ecode); if ecode = error_table_$no_w_permission then do; /*** We'll try it with just read access, the rest of this routine can deal with access violation faults. */ call initiate_file_ (log_dname, log_read_data.segments (log_idx).ename, R_ACCESS, log_ptr, bit_count, ecode); if ecode = 0 /* report an error in either case */ then call Report_Error (error_table_$no_w_permission, "^a", log_read_data.segments (log_idx).ename); else call Report_Error (ecode, "^a", log_read_data.segments (log_idx).ename); end; if ^Check_Log_Segment (log_ptr, log_read_data.segments (log_idx).ename, "0"b) then log_ptr = null (); /* don't want to use this guy */ log_read_data.segments (log_idx).ptr = log_ptr; /* it may still be null */ return; end Initiate_History_Segment_and_Check; %page; /* * * CHECK_LOG_SEGMENT * * This routine checks consistancy within a single log segment. * Sequence numbers and times in the header must be consistant * in respect to one another. The service bit must be off for * history segs, on for the live seg (it is adjusted if necessary). * Also, the first message sentinel is checked. * */ Check_Log_Segment: procedure (P_log_ptr, P_log_name, P_current_log) returns (bit (1) aligned); declare P_log_ptr pointer parameter; declare P_log_name char (32) parameter; declare P_current_log bit (1) aligned parameter; declare lp pointer; declare lname char (32); declare current_log bit (1) aligned; lp = P_log_ptr; lname = P_log_name; current_log = P_current_log; on seg_fault_error begin; /* watch out for damaged segs */ call Report_Error (0, "Seg Fault Error while checking ^a. Segment may be damaged.", lname); goto CHECK_LOG_SEG_EXIT; end; on any_other begin; call Report_Error (0, "Unexpected condition encountered while checking log segment ^a.", lname); goto CHECK_LOG_SEG_EXIT; end; if lp -> log_segment.version = LOG_SEGMENT_VERSION_1 then if lp -> log_segment.time_created > sys_info$first_reasonable_time & lp -> log_segment.time_created <= clock () then if lp -> log_segment.first_sequence <= lp -> log_segment.last_sequence & (lp -> log_segment.first_sequence >= 1000000 | lp -> log_segment.first_sequence = 0) then if lp -> log_segment.first_time <= lp -> log_segment.last_time & lp -> log_segment.last_time <= clock () then return (Check_Alloc_Info_and_Messages ()); call Report_Error (0, "Internal header problem in seg ^a.", lname); CHECK_LOG_SEG_EXIT: return ("0"b); Check_Alloc_Info_and_Messages: procedure () returns (bit (1) aligned); declare flip_service_bit bit (1) aligned; declare service_bit bit (1) aligned; flip_service_bit = "0"b; sequence_info_ptr = addr (lp -> log_segment.alloc_info); service_bit = sequence_info.in_service; /* compiler will have an easier time with it here */ if current_log & ^service_bit /* checking current seg? */ then do; call Report_Error (0, "Current log ^a found out of service.", lname); flip_service_bit = "1"b; /* will fix it if nothing else wrong */ end; if ^current_log & service_bit /* checking history seg? */ then do; call Report_Error (0, "History log ^a found in service.", lname); flip_service_bit = "1"b; /* will fix it if nothing else wrong */ end; if abs (sequence_info.number - lp -> log_segment.last_sequence) > 3 & lp -> log_segment.first_sequence > 0 then do; call Report_Error (0, "Last sequence and ""real"" sequence disagree in ^a.", lname); goto return_failure; end; if sequence_info.words_used > lp -> log_segment.max_size then do; call Report_Error (0, "Words used inconsistant with max size in ^a.", lname); goto return_failure; end; /* Check the first message. */ if lp -> log_segment.first_sequence = 0 /* but not if there's none there */ then goto return_success; log_message_ptr = addr (lp -> log_segment.data); /* get to first message */ if log_message.sentinel ^= LOG_SEGMENT_NEW_MESSAGE & log_message.sentinel ^= LOG_SEGMENT_COMPLETE_MESSAGE then do; call Report_Error (0, "First message invalid in ^a.", lname); goto return_failure; end; /* We might consider going through all the messages, but it seems a waste. If the first one is there intact, log_position_ will be able to handle any other problem. */ return_success: if flip_service_bit then do; on no_write_permission goto return_failure; /* may happen here */ sequence_info.in_service = ^service_bit; revert no_write_permission; call Report_Fix (0, "Service bit set ^[on^;off^] in ^a.", ^service_bit, lname); end; return ("1"b); return_failure: return ("0"b); end Check_Alloc_Info_and_Messages; end Check_Log_Segment; %page; /* * * CREATE_NEW_LOG_SEGMENT * * This routine is invoked if there is no live log segment, or if * the live log segment has internal damages. If the immediately * previous history segment is available, the sequence numbers * in the new segment may be set correctly. However, if there * is no history, or it is damaged, an estimated sequence number * is calculated. * * If some history segment is available, the access list and other * file system attributes are copied from that history segment to * the newly created segment. * */ Create_New_Log_Seg: procedure (P_old_log_ptr); declare P_old_log_ptr pointer parameter; declare old_logp pointer; declare acl_ptr pointer; declare acl_count fixed bin; declare code fixed bin (35); declare hist_log_name char (32); declare max_len fixed bin (19); declare n_logs_unseen fixed bin; declare new_log_ptr pointer; declare new_sequence fixed bin (35); declare system_area area based (system_area_ptr); declare system_area_ptr pointer; declare 1 auto_log_segment_info aligned like log_segment_info; declare 1 status aligned like status_branch; declare 1 sfb aligned like status_for_backup; system_area_ptr = null (); acl_ptr = null (); acl_count = 0; old_logp = P_old_log_ptr; on cleanup call create_new_log_seg_cleanup (); on any_other begin; call Report_Error (0, "Unexpected error while creating new log segment."); goto CREATE_NEW_LOG_SEG_EXIT; end; /* This procedure mimicks the way log_write_ would create a new log segment. That is, it attempts to set up the sequence such that it follows the history. However, in this case the most recent history segment may not be available. In that case we'll estimate what the next sequence number should be based upon the number of history logs we can't see. */ if log_read_data.n_segments = 0 then new_sequence = 1000000; /* start it a a million */ else do; if n_good_hist_segs = 0 then n_logs_unseen = log_read_data.n_segments; /* account for its possible sequence numbers */ else n_logs_unseen = newest_hist_log_idx - 1;/* account for sequence numbers of history logs we can't look at */ if renamed_damaged_log /* was current log damaged? */ then n_logs_unseen = n_logs_unseen + 1; /* account for its sequence numbers too */ if n_good_hist_segs = 0 then /* new sequence is based on number of logs in history */ new_sequence = 1000000 + (n_logs_unseen * 100000) + 1; else /* new sequence is based on number of history logs we can't see and the last sequence number we can see. */ new_sequence = log_read_data.segments (newest_hist_log_idx).ptr -> log_segment.last_sequence + (n_logs_unseen * 100000) + 1; end; /*** set up default info about the new segment */ log_segment_info_ptr = addr (auto_log_segment_info); log_segment_info.dname = log_dname; log_segment_info.ename = log_ename; log_segment_info.acl_ptr = null (); log_segment_info.acl_count = 0; log_segment_info.rings (*) = cu_$level_get (); log_segment_info.max_length = log_data_$default_log_size; log_segment_info.access_class = get_process_access_class_ (); log_segment_info.multi_class = "0"b; log_segment_info.effective_mode = RW_ACCESS; /*** we may be able to get more precise info */ if newest_hist_log_idx ^= 0 then do; hist_log_name = log_read_data.segments (newest_hist_log_idx).ename; sfb.version = status_for_backup_version_2; call hcs_$status_for_backup (log_dname, hist_log_name, addr (sfb), code); if code = 0 then do; log_segment_info.multi_class = sfb.multiple_class; log_segment_info.access_class = sfb.access_class; end; call hcs_$status_long (log_dname, hist_log_name, 1, addr (status), null (), code); if code = 0 then do; log_segment_info.effective_mode = substr (status.mode, 2, 3); log_segment_info.rings (*) = status.ring_brackets (*); end; system_area_ptr = get_system_free_area_ (); call hcs_$list_acl (log_dname, hist_log_name, system_area_ptr, acl_ptr, null (), acl_count, code); if code = 0 then do; log_segment_info.acl_ptr = acl_ptr; log_segment_info.acl_count = acl_count; end; call hcs_$get_max_length_seg (log_read_data.segments (newest_hist_log_idx).ptr, max_len, code); if code = 0 then do; log_segment_info.max_length = max_len; end; end; new_log_ptr = null (); call log_create_$new_segment (log_segment_info_ptr, new_log_ptr, code); if code ^= 0 then do; call Report_Error (code, "Unable to create new log segment."); call Finished (code); end; else do; call Report_Fix (0, "Created new log segment."); call log_segment_$initialize_sequence (new_log_ptr, new_sequence, code); if code ^= 0 then call Report_Error (code, "Error initializing sequence in new log segment."); call log_segment_$place_in_service (new_log_ptr, code); if code ^= 0 then call Report_Error (code, "Error placing new log segment in service."); call terminate_file_ (old_logp, 0, TERM_FILE_TERM, code); if code ^= 0 then call Report_Error (code, "Error terminating old log pointer."); P_old_log_ptr = new_log_ptr; /* change caller's pointer */ end; CREATE_NEW_LOG_SEG_EXIT: call create_new_log_seg_cleanup (); return; create_new_log_seg_cleanup: procedure; declare based_word bit (36) based; if acl_ptr ^= null () then do; /*** The runtime support for areas will know how much to actually free. ***/ free acl_ptr -> based_word in (system_area); end; end create_new_log_seg_cleanup; end Create_New_Log_Seg; %page; /* * * RENAME_AS_DAMAGED * * This routine is invoked when the live log segment is found to * have internal inconsistancies or cannot be initiated. It changes * the name to LOG_NAME.!(unique). It happens that a unique character * string and the standard timestamp suffix ("YYYYMMDD.HHMMSS") are the * same length. Thus, we need not worry about truncation of the name * and namedup errors. * */ Rename_as_Damaged: procedure (P_log_dir, P_log_name); declare P_log_name char (32) parameter; declare P_log_dir char (168) parameter; declare lname char (32); declare ldir char (168); declare new_name char (32); declare code fixed bin (35); lname = P_log_name; ldir = P_log_dir; new_name = rtrim (P_log_name) || "." || unique_chars_ (unique_bits_ ()); call hcs_$chname_file (ldir, lname, lname, new_name, code); if code = 0 then do; renamed_damaged_log = "1"b; call Report_Fix (0, "Changed name of damaged log segment ^a to ^a.", lname, new_name); end; else call Report_Error (code, "Unable to change name of damaged log segment ^a to ^a.", lname, new_name); return; end Rename_as_Damaged; %page; /* * * RENAME_FOR_LAST_MESSAGE * * This routine is invoked when a live log segment is found in a * directory to which we are trying to perform a log migratation. * It places the standard timestamp suffix on the name of the log. * */ Rename_for_Last_Message: procedure (P_log_ptr, P_log_name); declare P_log_name char (32) parameter; declare P_log_ptr pointer parameter; declare lname char (32); declare log_ptr pointer; declare name_time fixed bin (71); declare new_name char (32); declare code fixed bin (35); declare i fixed bin; lname = P_log_name; log_ptr = P_log_ptr; if log_ptr -> log_segment.last_time = 0 then name_time = clock (); else name_time = log_ptr -> log_segment.last_time; do i = 1 to 10; new_name = log_name_$name (lname, name_time); call hcs_$chname_seg (log_ptr, lname, new_name, code); if code = error_table_$namedup then do; name_time = name_time + ONE_SECOND; if name_time > clock () then call timer_manager_$sleep (ONE_SECOND, RELATIVE_MICROSECONDS); end; else if code = 0 then do; call Report_Fix (0, "Renamed log segment ^a to ^a.", lname, new_name); return; end; else goto CANNOT_RENAME; /* unexpected code */ end; CANNOT_RENAME: call Report_Error (code, "Unable to rename log segment ^a to ^a.", lname, new_name); return; end Rename_for_Last_Message; /* format: off */ %page; %include log_salvage_arg; %page; %include log_segment; %page; %include log_message; %page; %include log_read_data; %page; %include log_write_data; %page; %include access_mode_values; %page; %include terminate_file; %page; %include status_structures; %page; %include status_for_backup; %page; %include syserr_constants; end log_salvage_;  log_write_.pl1 11/11/89 1059.9rew 11/11/89 0800.0 248823 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* format: style4 */ log_write_: procedure (); /* * LOG_WRITE_ * * This is the user-ring program responsible for writing messages into a * family of log segments. It keeps track (in log_write_data) of the * current log, and switches log segments when it finds one full. * * Modification history: * 84-05-29, W. Olin Sibert: Initial coding * 84-08-25, WOS: Added $open_for_migrate and related changes * 84-10-16, WOS: Changed to rename segments with suffix of last message time * 84-10-19, WOS: Changed to ignore segnamedup when renaming logs. * 84-12-21, WOS: Changed to handle uninitialized logs better. * 84-12-21, WOS: Changed data_class to 16 chars like it should be * 84-12-23, WOS: Changed to create segments with suffixes when migrating * 85-01-17, GMP: Changed to create segments with the proper access class * 85-03-03, EJ Sharpe: Changed name of entry in log_list_history_ from single_dir to * single_dir_oldest_and_newest, added format * 85-03-27, EJ Sharpe: get masked for sleeping and for swapping to new log segment, * open now fails if log is not in service */ declare P_log_write_data_ptr pointer parameter; /* Input: control information */ declare P_log_dname char (*) parameter; /* Input: Log dname/ename when opening */ declare P_log_ename char (*) parameter; declare P_create_sw bit (1) aligned parameter; /* Input: Whether to create, at open, default log */ declare P_severity fixed bin parameter; /* Input: Log message severity */ declare P_message char (*) parameter; /* Input: Text message */ declare P_data_ptr pointer parameter; /* Input: Binary data message location, size, class and type */ declare P_data_lth fixed bin parameter; /* Input: Length of data message */ declare P_data_class char (16) varying parameter; /* Input: Class of data message */ declare P_sequence fixed bin (35) parameter; /* Input: Special sequence for $general */ declare P_message_lth fixed bin parameter; /* Input: Length of text portion */ declare P_log_message_ptr pointer parameter; /* Output: Location of written message */ declare P_code fixed bin (35) parameter; /* Output: Status code */ declare code fixed bin (35); declare open_for_migrate bit (1) aligned; declare log_segment_damaged bit (1) aligned; declare log_not_initialized bit (1) aligned; declare service_bit bit (1) aligned; declare system_area_ptr pointer; declare system_area area based (system_area_ptr); declare based_word bit (36) aligned based; declare based_page (1024) bit (36) aligned based; /* Variables associated with mask manipulation. Note that initializations are assumed by cleanup handler. */ dcl ipc_mask_code fixed bin (35) init (-1); dcl ipc_unmask_code fixed bin (35) init (-1); dcl mask bit (36) aligned init (""b); declare 1 message_info aligned automatic, /* Description of message being added */ 2 time fixed bin (71), /* Set for: $message, $data */ 2 process_id bit (36) aligned, /* Set for: $message, $data */ 2 severity fixed bin (35), /* Set for: $message, $data */ 2 text_lth fixed bin, /* Set for: $message, $data, $general */ 2 text_ptr pointer, /* Set for: $message, $data */ 2 data_lth fixed bin, /* Set for: $data, $general */ 2 data_ptr pointer, /* Set for: $data */ 2 data_class char (16) varying, /* Set for: $data, $general */ 2 sequence fixed bin (35); /* Set for: $general */ declare message_text char (message_info.text_lth) unaligned based (message_info.text_ptr); declare message_data dim (message_info.data_lth) bit (36) aligned based (message_info.data_ptr); declare log_data_$default_log_size 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 error_table_$log_segment_invalid fixed bin (35) external static; declare error_table_$log_uninitialized fixed bin (35) external static; declare error_table_$namedup fixed bin (35) external static; declare error_table_$noentry fixed bin (35) external static; declare error_table_$nomatch fixed bin (35) external static; declare error_table_$no_w_permission fixed bin (35) external static; declare error_table_$segnamedup fixed bin (35) external static; declare cu_$level_get entry () returns (fixed bin (3)); declare get_process_access_class_ entry () returns (bit (72) aligned); declare get_process_id_ entry () returns (bit (36) aligned); declare get_system_free_area_ entry () returns (pointer); declare hcs_$chname_seg entry (pointer, char (*), char (*), fixed bin (35)); declare hcs_$reset_ips_mask entry (bit (36) aligned, bit (36) aligned); declare hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned); declare hcs_$terminate_noname entry (pointer, fixed bin (35)); declare ipc_$mask_ev_calls entry (fixed bin (35)); declare ipc_$unmask_ev_calls entry (fixed bin (35)); declare log_create_$duplicate_segment entry (pointer, char (*), char (*), pointer, pointer, fixed bin (35)); declare log_create_$get_info entry (pointer, pointer, fixed bin (35)); declare log_create_$new_segment entry (pointer, pointer, fixed bin (35)); declare log_initialize_ entry (pointer, pointer, fixed bin (18), char (*), fixed bin (35)); declare log_initiate_ entry (char (*), char (*), fixed bin, pointer, fixed bin (35)); declare log_list_history_$single_dir_oldest_and_newest entry (char (*), char (*), char (*), char (*), fixed bin, fixed bin (35)); declare log_name_$name entry (char (*), fixed bin (71)) returns (char (32)); declare log_segment_$create_message entry (pointer, fixed bin, fixed bin, char (16) varying, pointer, fixed bin (35)); declare log_segment_$create_message_number entry (pointer, fixed bin, fixed bin, char (16) varying, fixed bin (35), pointer, fixed bin (35)); declare log_segment_$finish_message entry (pointer, pointer, fixed bin (35)); declare log_segment_$get_service_bit entry (ptr, bit (1) aligned, 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 log_wakeup_$send_wakeups entry (pointer, pointer, fixed bin (35)); declare sub_err_ entry options (variable); declare timer_manager_$sleep entry (fixed bin (71), bit (2)); declare seg_fault_error condition; declare WHOAMI char (32) internal static options (constant) init ("log_write_"); declare MAX_TRIES fixed bin internal static options (constant) init (10); declare RELATIVE_MICROSECONDS bit (2) internal static options (constant) init ("10"b); declare ONE_SECOND fixed bin (71) internal static options (constant) init (1000000); declare ONE_QUARTER_SECOND fixed bin (71) internal static options (constant) init (250000); declare cleanup condition; declare (addr, clock, length, null, substr, unspec) builtin; %page; MAIN_RETURN: return; finished: procedure (P_return_code); declare P_return_code fixed bin (35) parameter; call CLEANUP; P_code = P_return_code; goto MAIN_RETURN; end finished; abort_open: procedure (P_error_code); declare P_error_code fixed bin (35) parameter; call log_write_$close (log_write_data_ptr, (0)); call finished (P_error_code); end abort_open; MASK: procedure (); call hcs_$set_ips_mask (""b, mask); /* mask ips interrupts */ call ipc_$mask_ev_calls (ipc_mask_code); /* mask ipc calls */ end MASK; UNMASK: procedure (); call ipc_$unmask_ev_calls (ipc_unmask_code); ipc_mask_code = -1; ipc_unmask_code = -1; call hcs_$reset_ips_mask (mask, mask); end UNMASK; CLEANUP: procedure; /* put masks back the way we found 'em and reset variables so we don't try it twice */ if ipc_mask_code ^= -1 & ipc_unmask_code = -1 then call ipc_$unmask_ev_calls (ipc_unmask_code); ipc_mask_code = -1; ipc_unmask_code = -1; if substr(mask, 36, 1) = "1"b then call hcs_$reset_ips_mask (mask, mask); end CLEANUP; %page; /* This entrypoint is called to put a text message into the log */ log_write_$open: entry (P_log_dname, P_log_ename, P_create_sw, P_log_write_data_ptr, P_code); open_for_migrate = "0"b; goto OPEN_COMMON; log_write_$open_for_migrate: entry (P_log_dname, P_log_ename, P_create_sw, P_log_write_data_ptr, P_code); open_for_migrate = "1"b; /* P_log_ename, in this case, is the primary name of the */ goto OPEN_COMMON; /* log, NOT the name of a specific segment */ OPEN_COMMON: P_log_write_data_ptr = null (); system_area_ptr = get_system_free_area_ (); allocate log_write_data in (system_area) set (log_write_data_ptr); unspec (log_write_data) = ""b; log_write_data.log_ptr = null (); log_write_data.migrating = open_for_migrate; on condition (cleanup) begin; call log_write_$close (log_write_data_ptr, (0)); end; /* For either open case, we take the dir name we received. For the plain $open case, that's true of the entry name as well. However, for the $open_for_migrate case, we have to find the newest in a series of already renamed logs, or, if there aren't any, create one with a name based on the current time. The log_name itself is the entry name we were given, in either case. */ log_write_data.dname = P_log_dname; log_write_data.log_name = P_log_ename; if log_write_data.migrating then do; call log_list_history_$single_dir_oldest_and_newest /* See if we can find newest ename.YYYYMMDD.HHMMSS */ (P_log_dname, P_log_ename, (""), log_write_data.ename, (0), code); if (code = 0) then ; /* OK: we found some oldies */ else if (code = error_table_$nomatch) then /* Also OK: Nothing there now, so we create the first */ log_write_data.ename = log_name_$name (P_log_ename, clock ()); /* Depending on P_create_sw, below */ else call abort_open (code); /* Otherwise, it's an error */ end; else log_write_data.ename = P_log_ename; /* Vanilla case, use what we got */ %page; /* What follows is the code common for both types of open operations */ call log_initiate_ (log_write_data.dname, log_write_data.ename, 10, log_write_data.log_ptr, code); log_not_initialized = (code = error_table_$log_uninitialized); /* If it exists, we consider using it. First, check to see whether it can be written; if not, give up immediately. Next, if it wasn't initialized, check to see whether it's a whole empty page, and initialize it only if it is-- that avoids trashing a random segment that isn't actually a log. Finally, if migrating, put it back in service and be gone. */ if (code = 0) | log_not_initialized then do; /* The named segment exists. Use it. */ GET_LOG_INFO: call log_create_$get_info (addr (log_write_data.segment_info), log_write_data.log_ptr, code); if (code ^= 0) then call abort_open (code); if (log_write_data.effective_mode ^= RW_ACCESS) & (log_write_data.effective_mode ^= REW_ACCESS) then call abort_open (error_table_$no_w_permission); if log_not_initialized then /* Check whether anything is there */ if (unspec (log_write_data.log_ptr -> based_page) ^= ""b) then call abort_open (error_table_$log_segment_invalid); else do; /* It has nothing there, so initialize it */ call log_initialize_ (null (), log_write_data.log_ptr, (log_data_$default_log_size), log_write_data.dname, code); if (code ^= 0) then call abort_open (code); else log_not_initialized = "0"b; end; if log_write_data.migrating then /* It's out of service now, so turn it back on */ call log_segment_$place_in_service (log_write_data.log_ptr, (0)); /* but ignore errors */ else do; /* Make sure we have a usable log since our caller apparently wants to write to it. */ call log_segment_$get_service_bit (log_write_data.log_ptr, service_bit, code); if (code ^= 0) then /* should always be possible */ call abort_open (code); if (service_bit ^= "1"b) then do; /* need to wait for new log segment */ call initiate_new_log_segment$$open; goto GET_LOG_INFO; /* make sure the new one has proper access */ end; end; end; /* If it didn't exist, and we were supposed to create it, take care of that */ else if P_create_sw & (code = error_table_$noentry) then do; log_write_data.rings (*) = cu_$level_get (); log_write_data.access_class = get_process_access_class_ (); log_write_data.max_length = log_data_$default_log_size; call log_create_$new_segment (addr (log_write_data.segment_info), log_write_data.log_ptr, code); if (code ^= 0) then call abort_open (code); end; else call abort_open (code); P_log_write_data_ptr = log_write_data_ptr; call finished (0); %page; log_write_$close: entry (P_log_write_data_ptr, P_code); log_write_data_ptr = P_log_write_data_ptr; if (log_write_data_ptr = null ()) then call finished (0); P_log_write_data_ptr = null (); system_area_ptr = get_system_free_area_ (); if (log_write_data.acl_count ^= 0) & (log_write_data.acl_ptr ^= null ()) then free log_write_data.acl_ptr -> based_word in (system_area); if (log_write_data.log_ptr ^= null ()) then do; /* If we are migrating, we take this segment out of service, and also give it a name more befitting its station-- a suffix accurately representing the newest message it contains. This renaming, though, may result in name duplications, which we have no way to handle, so we just ignore the status code. */ if log_write_data.migrating then do; call log_segment_$remove_from_service (log_write_data.log_ptr, (0)); call rename_for_last_message (log_write_data.log_ptr, log_write_data.ename, (0)); end; call hcs_$terminate_noname (log_write_data.log_ptr, (0)); log_write_data.log_ptr = null (); end; free log_write_data in (system_area); call finished (0); %page; log_write_$message: entry (P_log_write_data_ptr, P_severity, P_message, P_log_message_ptr, P_code); log_write_data_ptr = P_log_write_data_ptr; unspec (message_info) = ""b; message_info.time = clock (); message_info.process_id = get_process_id_ (); message_info.severity = P_severity; message_info.text_ptr = addr (P_message); message_info.text_lth = length (P_message); call add_message ("1"b); P_log_message_ptr = log_message_ptr; call finished (0); %page; /* This entrypoint is called to put a message in the log including binary data */ log_write_$data: entry (P_log_write_data_ptr, P_severity, P_message, P_data_ptr, P_data_lth, P_data_class, P_log_message_ptr, P_code); log_write_data_ptr = P_log_write_data_ptr; unspec (message_info) = ""b; message_info.time = clock (); message_info.process_id = get_process_id_ (); message_info.severity = P_severity; message_info.text_ptr = addr (P_message); message_info.text_lth = length (P_message); message_info.data_ptr = P_data_ptr; message_info.data_lth = P_data_lth; message_info.data_class = P_data_class; call add_message ("1"b); P_log_message_ptr = log_message_ptr; call finished (0); %page; /* This entrypoint is called to put a message in the log with arbitrary contents. The caller must fill it in after this returns, and then must call log_segment_$finish itself to complete the job. The caller has the option of setting a sequence number here, as well; if this number is non-zero, add_message will call log_segment_$create_message_number. */ log_write_$general: entry (P_log_write_data_ptr, P_sequence, P_message_lth, P_data_lth, P_data_class, P_log_message_ptr, P_code); log_write_data_ptr = P_log_write_data_ptr; unspec (message_info) = ""b; message_info.sequence = P_sequence; message_info.text_lth = P_message_lth; /* Set only the length-determining information */ message_info.data_lth = P_data_lth; message_info.data_class = P_data_class; call add_message ("0"b); P_log_message_ptr = log_message_ptr; call finished (0); %page; add_message: procedure (P_finish_message); declare P_finish_message bit (1) aligned parameter; declare fault_occurred bit (1) aligned; fault_occurred = "0"b; log_segment_damaged = "0"b; on condition (seg_fault_error) begin; if fault_occurred then do; code = error_table_$log_segment_damaged; goto MAIN_RETURN; end; fault_occurred = "1"b; call create_new_log_segment (); goto TRY_TO_CREATE_MESSAGE; end; TRY_TO_CREATE_MESSAGE: do while (^create_message ()); end; if ^P_finish_message then return; /* Leave it to our caller to fill in and finish */ log_message.time = message_info.time; log_message.severity = message_info.severity; log_message.process_id = message_info.process_id; log_message.text = message_text; if (message_info.data_lth > 0) then do; log_message.data_class = message_info.data_class; log_message.data = message_data; end; call log_segment_$finish_message (log_write_data.log_ptr, log_message_ptr, code); if (code ^= 0) then call finished (code); if log_write_data.log_ptr -> log_segment.listeners_registered then /* This test repeated here for efficiency */ call log_wakeup_$send_wakeups (log_write_data.log_ptr, log_message_ptr, (0)); revert condition (seg_fault_error); return; end add_message; %page; create_message: procedure () returns (bit (1) aligned); if (message_info.sequence > 0) then /* Caller-supplied sequence number from log_write_$general */ call log_segment_$create_message_number (log_write_data.log_ptr, message_info.text_lth, message_info.data_lth, message_info.data_class, message_info.sequence, log_message_ptr, code); else call log_segment_$create_message (log_write_data.log_ptr, message_info.text_lth, message_info.data_lth, message_info.data_class, log_message_ptr, code); if (code = 0) then return ("1"b); /* If our message won't fit, we have to swap log segments. This is done by taking the old one out of service and creating a new one. However, it's quite possible that someone else has also found the log full, and taken it out of service before we could, so we have to pay close attention to what happens when we take it out of service. */ else if (code = error_table_$log_segment_full) then do; on cleanup call CLEANUP; call MASK; call log_segment_$remove_from_service (log_write_data.log_ptr, code); if (code = 0) then call create_new_log_segment (); else call initiate_new_log_segment (); call UNMASK; return ("0"b); /* Come around and try again */ end; else if (code = error_table_$log_out_of_service) then do; call initiate_new_log_segment (); return ("0"b); end; /* If it got munched for some reason, we give up on this one, and try to create a new one. If we encounter this error more than once, though, we just give up-- that probably indicates some fairly serious internal logic error. For politeness, we *try* to take the old segment out of service, though, really, its disposition doesn't matter in the slightest at this point. */ else if (code = error_table_$log_segment_damaged) then do; if log_segment_damaged then call finished (code); log_segment_damaged = "1"b; /* Remember that this has been tried already */ on cleanup call CLEANUP; call MASK; call log_segment_$remove_from_service (log_write_data.log_ptr, (0)); call create_new_log_segment (); call UNMASK; end; else call finished (code); /* Any other error is fatal */ end create_message; %page; initiate_new_log_segment: procedure (); declare old_log_ptr pointer; declare new_log_ptr pointer; declare retry_count fixed bin; declare abort_proc entry (fixed bin (35)) variable; /* This call will try several times, returning only when new_log_ptr is different from old_log_ptr. When a log fills, it is renamed (in this case, by another process, so it won't affect our segment number), and this procedure tries to initiate with the old name, eventually (it hopes) getting the new segment of that name. */ abort_proc = finished; goto initiate_new_log_segment_join; initiate_new_log_segment$$open: entry (); /* entrypoint used when opeining a log for writing */ abort_proc = abort_open; initiate_new_log_segment_join: old_log_ptr = log_write_data.log_ptr; do retry_count = 1 to 10; call log_initiate_ (log_write_data.dname, log_write_data.ename, 1, new_log_ptr, code); if (code = 0) & (new_log_ptr ^= old_log_ptr) then do; call hcs_$terminate_noname (old_log_ptr, (0)); log_write_data.log_ptr = new_log_ptr; return; end; call sleep (ONE_QUARTER_SECOND); end; /* If we run out of tries at this, then the process that set the log out-of-service hasn't finished its job: no new log has been created, or, if it has been created, it has not been initialized. Our caller loses. This shouldn't happen, of course, since that whole task is handled by create_new_log_segment, below */ if (code = 0) then /* Old log still exists (presumably, out of service) */ call abort_proc (error_table_$log_out_of_service); else call abort_proc (code); end initiate_new_log_segment; %page; create_new_log_segment: procedure (); /* This procedure renames the old log segment and creates a new one */ declare new_log_ptr pointer; declare 1 this_segment_info aligned like log_segment_info; declare orig_log_ptr pointer; declare rename_time fixed bin (71); this_segment_info = log_write_data.segment_info; orig_log_ptr = log_write_data.log_ptr; /* When a log segment fills, it gets a suffix that's guaranteed to be as late or later (by adding ONE_SECOND) than the last message in the log. Once it's full, we rename it to an appropriate name. */ call rename_for_last_message (orig_log_ptr, log_write_data.ename, rename_time); if log_write_data.migrating then /* These calls modify this_segment_info and leave */ call create_migration_segment (rename_time); /* code set to indicate their success or failure */ else call create_initial_segment (); /* We terminate and give up on the old one, regardless-- WITHOUT modifying code */ call hcs_$terminate_noname (orig_log_ptr, (0)); log_write_data.log_ptr = null (); if (code ^= 0) then call finished (code); log_write_data.segment_info = this_segment_info; log_write_data.log_ptr = new_log_ptr; return; %page; create_initial_segment: procedure (); call log_create_$duplicate_segment (addr (this_segment_info), log_write_data.dname, log_write_data.log_name, orig_log_ptr, new_log_ptr, code); if (code = 0) then /* All went well, we managed to duplicate the segment */ return; this_segment_info = log_write_data.segment_info; /* Since it may have been altered above */ this_segment_info.ename = log_write_data.log_name; call log_create_$new_segment (addr (this_segment_info), new_log_ptr, code); return; /* code is set to indicate success/failure */ end create_initial_segment; %page; create_migration_segment: procedure (P_start_time); declare P_start_time fixed bin (71) parameter; declare tries fixed bin; declare new_log_name char (32); declare keep_trying bit (1) aligned; keep_trying = "1"b; do tries = 1 to MAX_TRIES while (keep_trying); new_log_name = log_name_$name (log_write_data.log_name, (P_start_time + (tries * ONE_SECOND))); call log_create_$duplicate_segment (addr (this_segment_info), log_write_data.dname, new_log_name, orig_log_ptr, new_log_ptr, code); if (code = 0) then /* If it's created, our job is done. */ return; /* Otherwise, as long as we keep getting name duplications, */ if (code ^= error_table_$namedup) then /* Keep trying different names. Any other sort of error */ keep_trying = "0"b; /* is cause for giving up and going on to the new-segment */ end; /* case, the assumption being that duplication failed. */ do tries = 1 to MAX_TRIES while (keep_trying); this_segment_info = log_write_data.segment_info; /* Since it may have been altered above */ this_segment_info.ename = log_name_$name (log_write_data.log_name, (P_start_time + (tries * ONE_SECOND))); call log_create_$new_segment (addr (this_segment_info), new_log_ptr, code); if (code = 0) then /* Error return logic is as above. */ return; if (code ^= error_table_$namedup) then keep_trying = "0"b; end; return; end create_migration_segment; end create_new_log_segment; %page; rename_for_last_message: procedure (P_log_ptr, P_current_name, P_rename_time); declare P_log_ptr pointer parameter; declare P_current_name char (32) parameter; declare P_rename_time fixed bin (71) parameter; declare name_time fixed bin (71); declare new_name char (32); declare tries fixed bin; name_time = P_log_ptr -> log_segment.last_time; /* The idea here is to keep trying later names until it can be set to some name that is later than the last message in the segment. */ do tries = 1 to MAX_TRIES; /* Don't try too many times.... */ name_time = name_time + ONE_SECOND; /* Add a delta so the suffix is guaranteed to be later */ new_name = log_name_$name (log_write_data.log_name, name_time); call hcs_$chname_seg (P_log_ptr, P_current_name, new_name, code); if (code = error_table_$segnamedup) then /* If it's already this, we're restarting after an */ code = 0; /* error, and the code can be ignored. */ if (code = 0) then do; /* It worked */ P_current_name = new_name; /* Set it back for our caller */ P_rename_time = name_time; /* Say what time the old one has */ return; end; else if (code ^= error_table_$namedup) then /* Nope, couldn't do it at all */ call finished (code); if ((name_time + ONE_SECOND) > clock ()) then/* Come around for another try, */ call sleep (ONE_SECOND); end; /* but don't let it get ahea of the clock */ call sub_err_ (0, WHOAMI, ACTION_CANT_RESTART, null (), "", "Tried (unsuccessfully) more than ^d times to rename log segment ^a (^p)", (tries - 1), P_current_name, P_log_ptr); end rename_for_last_message; %page; sleep: procedure (interval); /* Internal procedure to pause for a specified interval. It is used when we need to wait for some other process to finish some manipulation of the log segments. We perform our own mask setting here if our caller is not already masked. */ dcl interval fixed bin (71) parameter; /* sleep time in microseconds */ if substr(mask, 36, 1) = "0"b then do; on cleanup call CLEANUP; call MASK; call timer_manager_$sleep (interval, RELATIVE_MICROSECONDS); call UNMASK; end; else call timer_manager_$sleep (interval, RELATIVE_MICROSECONDS); end sleep; /* format: off */ %page; %include log_message; %page; %include log_segment; %page; %include log_write_data; %page; %include sub_err_flags; %page; %include access_mode_values; end log_write_; 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