



		    bj_adopt_txn.pl1                03/06/85  0801.3re  03/05/85  0757.6      120825



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

/* DESCRIPTION:

     bj_adopt_txn - procedure to change before journal transaction specific
   table entry which will allow a process other than the one that initiated
   a transaction to complete it.  It is assumed that this other process
   will be the data management daemon.

   This procedure has four entrypoints:

   adopt,      to adopt the transaction information for use by another project;
   abandon,    to restore the transaction information to the way it was 
               before the adoption (except for transaction ID after ABORT);
   force_abandon,
               to ignore all adoption errors and close adoption, this may
               leave the adoption state inconsistent, so should be used
               if all else fails;
   get_pf_oid, to generate a page file opening ID specific to this process
               and to save the OID for a close operation during the 
               abandon process.
*/

/*  HISTORY
Written by M. Pandolf, 08/30/82.
Modified:
08/15/82 by M. Pandolf: to use file_manager_ for manipulation of data
	  management system files.
12/21/82 by M. Pandolf:  to call bj_close_oid as part of abandoning.
01/13/83 by L. A. Newcomb:  to call file_manager_$open_by_uid_after_crash
	  if recovery is in progress.
01/18/83 by L. A. Newcomb:  to fix subscriptrange problem in abandon
	  in close_page_files loop and the adoption info structure.
01/27/83 by M. Pandolf:  to eliminate clearing of pf_uid_list, which caused
	  stringsize condition, and was not necessary anyway.
02/04/83 by M. Pandolf:  to save error codes from file_manager_ in
	  bjm_data_$bj_code.
03/04/83 by M. Pandolf:  to make adopt call abandon if an adoption
	  is still active and fix code to open_by_uid.
03/14/83 by M. Pandolf:  to not look at (zeroed) p_tid as an indication
	  of proper adoption during abandon.
03/16/83 by L. A. Newcomb:  to use dm_error_$not_daemon for privilege check.
05/13/83 by L. A. Newcomb:  Added pf_opening_error_code to internal hash table
            so we can return it if we match in the hash search.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
03/05/84 by L. A. Newcomb:  changed to use the include file dm_system_states
            (renamed from dm_statuses), and to use the new names therein.
04/06/84 by Lindsey L. Spratt:  Added shutdown_warning, user_shutdown, and
            system_shutdown to running as valid states to do fm_$open_by_uid.
09/10/84 by Lee A. Newcomb:  Changed to use the new system state constants and
            fixed to not have variables declared by context or implication.
11/30/84 by Maggie Sharpe:  to set/rest validation level around the calls to
	  file_manager_.
*/

/* format:  style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

bj_adopt_txn$adopt:
     proc (p_tix);

/* START OF DECLARATIONS */
/* Parameter */
dcl  (
     p_tix		        fixed bin,		/* index of transaction to be adopted */
     p_tid		        bit (36) aligned,	/* UID of transaction to be adopted */
     p_pf_uid		        bit (36) aligned,	/* UID of page file to be opened for rollback */
     p_pf_oid		        bit (36) aligned	/* OID of page file just opened */
     )			        parameter;

/* Automatic */
dcl  (
     tix			        fixed bin,		/* local copy of parameter */
     tid			        bit (36) aligned,	/* local copy of parameter */
     pf_uid		        bit (36) aligned,	/* local copy of parameter */
     saved_level		        fixed bin,		/* caller's validation level */
     code			        fixed bin (35),	/* standard system status code */
     uid_ht_index		        fixed bin,		/* index into UID hash table */
     curr_uid_list_index	        fixed bin,		/* index into UID list */
     prev_uid_list_index	        fixed bin		/* to hold onto value of curr_uid_list_index */
     )			        automatic;

/* Based */
dcl
     1 adoption_info	        aligned based (adoption_info_ptr),
       2 target_txn		        aligned,
         3 tix		        fixed bin,
         3 tid		        bit (36),
         3 process_id	        bit (36),
         3 bj_oid		        bit (36),
         3 ppte_ptr		        pointer,
       2 last_used_uid_list_entry     fixed bin,
       2 pf_uid_ht		        dimension (0:511) fixed bin,
       2 pf_uid_list	        dimension (0 refer (adoption_info.last_used_uid_list_entry)) aligned,
         3 next		        fixed bin,		/* next entry in this uid list */
         3 pf_uid		        bit (36),
         3 pf_oid		        bit (36),
         3 pf_opening_error_code      fixed bin (35);

/* Builtin */
dcl  (
     addr, binary, null, substr,
     unspec
     )			        builtin;

/* Condition */

dcl  cleanup		        condition;

/* Constant */
dcl  (
     myname		        char (32) init ("bj_adopt_txn")
     )			        int static options (constant);

/* Entry */
dcl
     get_process_id_	        entry () returns (bit (36)),
     bj_report_err		        entry (fixed bin (35), char (*)),
     get_temp_segment_	        entry (char (*), ptr, fixed bin (35)),
     bj_oid_util$get_ptr	        entry (bit (36) aligned) returns (ptr),
     bj_open_by_uid		        entry (bit (36) aligned, bit (36) aligned),
     bj_close_oid		        entry (bit (36) aligned),
     bj_pst_lock		        entry (),
     get_ring_		        entry () returns (fixed bin (3)),
     cu_$level_set		        entry (fixed bin),
     cu_$level_get		        entry (fixed bin),
     bj_pst_lock$unlock	        entry (),
     file_manager_$close	        entry (bit (36) aligned, fixed bin (35)),
     file_manager_$open_by_uid        entry (bit (36) aligned, bit (36) aligned, fixed bin (35)),
     file_manager_$open_by_uid_after_crash
			        entry (bit (36) aligned, bit (36) aligned, fixed bin (35));

/* External */
dcl  (
     dm_data_$bj_txt_ptr	        ptr,
     (dm_error_$not_daemon,				/* DM error codes */
     dm_error_$bj_not_adopting,
     dm_error_$bj_this_not_adopted
     )			        fixed bin (35),
     dm_system_data_$initializer_processid bit (36),
     dm_system_data_$current_dm_state char (4) aligned
     )			        external static;

/* Static */
dcl  (
     adoption_info_ptr	        ptr init (null ())
     )			        internal static;
%page;
/* bj_adopt_txn$adopt:		*/
/*     proc (p_tix);		*/

	tix = p_tix;

/* only the data management daemon should get past this next check */

	if dm_system_data_$initializer_processid ^= get_process_id_ ()
	then do;
	     call bj_report_err (dm_error_$not_daemon, myname);
	     return;
	end;

/* see if we have to get space for the adoption information */

	if adoption_info_ptr = null ()
	then do;
	     call get_temp_segment_ (myname, adoption_info_ptr, code);
	     if adoption_info_ptr = null ()
	     then do;
		call bj_report_err (code, myname);
		return;
	     end;
	     unspec (adoption_info) = "0"b;
	end;

/* see if an adoption is currently in progress */

	if adoption_info.tix ^= 0
	     then call abandon (adoption_info.tix, adoption_info.tid);

/* TXTE assumed verified by bjm primitive, so copy pertinent data */

	bj_txte_ptr = addr (dm_data_$bj_txt_ptr -> bj_txt.entry (tix));

	adoption_info.target_txn.tid = bj_txte.tid;
	adoption_info.target_txn.process_id = bj_txte.operator_info.process_id;
	adoption_info.target_txn.bj_oid = bj_txte.operator_info.bj_oid;
	adoption_info.target_txn.ppte_ptr = bj_txte.operator_info.ppte_ptr;
	unspec (adoption_info.pf_uid_ht) = "0"b;
	adoption_info.last_used_uid_list_entry = 0;

/* set operator_info in TXTE to values for this process */

	call bj_open_by_uid (bj_txte.bj_uid, bj_txte.operator_info.bj_oid);
	bj_txte.operator_info.ppte_ptr = bj_oid_util$get_ptr (bj_txte.operator_info.bj_oid);
	bj_txte.operator_info.process_id = dm_system_data_$initializer_processid;

/* setting the TIX validates the adoption information */

	adoption_info.target_txn.tix = tix;

/* transaction is adopted from the point of view of before journal manager */

	return;

/*   end adopt; */
%page;
abandon:
     entry (p_tix, p_tid);

	tix = p_tix;
	tid = p_tid;
	call cu_$level_get (saved_level);

	on cleanup begin;
	     call cu_$level_set (saved_level);
	end;

/* have we adopted a transaction? */

	if adoption_info_ptr = null ()		/* surely not! */
	then do;
	     call bj_report_err (dm_error_$bj_not_adopting, myname);
	     return;
	end;

	if adoption_info.target_txn.tix = 0
	then do;
	     call bj_report_err (dm_error_$bj_not_adopting, myname);
	     return;
	end;

	bj_txte_ptr = addr (dm_data_$bj_txt_ptr -> bj_txt.entry (adoption_info.target_txn.tix));

	if adoption_info.target_txn.tix ^= tix | bj_txte.tid ^= tid
	then do;
	     call bj_report_err (dm_error_$bj_this_not_adopted, myname);
	     return;
	end;

/* close all page files that were opened during the adoption */

	call cu_$level_set (get_ring_ ());

CLOSE_PAGE_FILES:
	do curr_uid_list_index = 1 to adoption_info.last_used_uid_list_entry;

	     if adoption_info.pf_uid_list (curr_uid_list_index).pf_oid ^= (36)"0"b
		then call file_manager_$close (adoption_info.pf_uid_list (curr_uid_list_index).pf_oid, code);

	end CLOSE_PAGE_FILES;

	call cu_$level_set (saved_level);

	unspec (adoption_info.pf_uid_ht) = "0"b;

/* close the before journal */

	call bj_pst_lock ();

	call bj_close_oid (bj_txte.operator_info.bj_oid);

	call bj_pst_lock$unlock ();

/* set the ppte in the txte to null:  better to hit a brick wall than to fall into a wormhole... */

	bj_txte.operator_info.ppte_ptr = null ();

/* setting the TIX completes the abandoning.  note that this is also a back door */

force_abandon:
     entry ();
	if adoption_info_ptr ^= null ()
	     then adoption_info.tix = 0;

/* finished */

	return;
%page;
get_pf_oid:
     entry (p_pf_uid, p_pf_oid);

	pf_uid = p_pf_uid;
	p_pf_oid = (36)"0"b;
	call cu_$level_get (saved_level);

	on cleanup begin;
	     call cu_$level_set (saved_level);
	end;

/* have we adopted a transaction? */

	if adoption_info_ptr = null ()		/* nope! */
	then do;
	     call bj_report_err (dm_error_$bj_not_adopting, myname);
	     return;
	end;

	if adoption_info.target_txn.tix = 0
	then do;
	     call bj_report_err (dm_error_$bj_not_adopting, myname);
	     return;
	end;

/* find beginning of list that includes the desired UID */

	uid_ht_index = binary (substr (pf_uid, 28, 9));

/* we walk the pf_uid_list looking for pf_uid */

	prev_uid_list_index = 0;

SEARCH_FOR_UID:
	do curr_uid_list_index = adoption_info.pf_uid_ht (uid_ht_index)
	     repeat (adoption_info.pf_uid_list (curr_uid_list_index).next)
	     while (curr_uid_list_index ^= 0);

	     if adoption_info.pf_uid_list (curr_uid_list_index).pf_uid = pf_uid
	     then do;
		p_pf_oid = adoption_info.pf_uid_list (curr_uid_list_index).pf_oid;
		bjm_data_$bj_code =
		     adoption_info.pf_uid_list (curr_uid_list_index).pf_opening_error_code;
		return;			/* short cut */
	     end;

	     prev_uid_list_index = curr_uid_list_index;

	end SEARCH_FOR_UID;

/* if we made it here, then UID was not in the list */

	call ALLOC_UID (pf_uid, curr_uid_list_index);

	if prev_uid_list_index = 0			/* pf_uid_ht for this uid was empty */
	     then adoption_info.pf_uid_ht (uid_ht_index) = curr_uid_list_index;
	else adoption_info.pf_uid_list (prev_uid_list_index).next = curr_uid_list_index;

	call cu_$level_set (get_ring_ ());
	if dm_system_data_$current_dm_state = DM_SYSTEM_STATE_RUNNING
	     | dm_system_data_$current_dm_state = DM_SYSTEM_STATE_SHUTDOWN_BEGUN
	     | dm_system_data_$current_dm_state = DM_SYSTEM_STATE_SHUTDOWN_BUMP_USERS
	     then
	     call file_manager_$open_by_uid (pf_uid, adoption_info.pf_uid_list (curr_uid_list_index).pf_oid,
		adoption_info.pf_uid_list (curr_uid_list_index).pf_opening_error_code);
	else call file_manager_$open_by_uid_after_crash (pf_uid, adoption_info.pf_uid_list (curr_uid_list_index).pf_oid,
		adoption_info.pf_uid_list (curr_uid_list_index).pf_opening_error_code);
						/* don't check the code, because reporting */
						/* an error would cause the whole rollback to */
						/* be aborted.  if the code is not 0, then */
						/* p_pf_oid will remain zero for the return */
						/* and the non-zero code will be in static storage */

	call cu_$level_set (saved_level);

	p_pf_oid = adoption_info.pf_uid_list (curr_uid_list_index).pf_oid;
	bjm_data_$bj_code = adoption_info.pf_uid_list (curr_uid_list_index).pf_opening_error_code;
	call cu_$level_set (saved_level);

	return;
%page;
ALLOC_UID:
     proc (p_uid, p_index);

/* Internal Declarations */

dcl  p_uid		        bit (36) aligned parameter; /* UID which needs a slot in table */
dcl  p_index		        fixed bin (17) aligned parameter; /* slot number into which we put UID */

	p_index,
	     adoption_info.last_used_uid_list_entry =
	     adoption_info.last_used_uid_list_entry + 1;

	adoption_info.pf_uid_list (adoption_info.last_used_uid_list_entry).pf_uid = p_uid;
	adoption_info.pf_uid_list (adoption_info.last_used_uid_list_entry).next = 0;

	return;

     end ALLOC_UID;


%page; %include dm_bj_static;
%page; %include dm_bj_txt;
%page; %include dm_system_states;
%page; %include dm_bj_global_error_info;


     end bj_adopt_txn$adopt;




		    bj_ci_zero.pl1                  04/04/85  1117.3re  04/04/85  0826.0       52875



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

/* DESCRIPTION:

	bj_ci_zero has several entries for reading or writing CI zero of
     a before journal.  CI0 only contains the BJ header, never any before
     images or marks.  Note we do not need to copy the parameters as this
     is only called from a bjm_* module in the DM ring.
*/

/* HISTORY:

Written by Andre Bensoussan, 7/??/82
Modified:
10/15/82 by M. Pandolf:  to use file_manager_ to manipulate data management
	  system files.
10/24/83 by M. Pandolf:  to have get_bj_uid check to see that the dm file is
	  really a before journal.
06/07/84 by Lee Baldwin:  Renamed dm_error_$bj_header_bad to $bj_bad_header.
12/05/84 by M. Sharpe:  to fix format; to set/reset validation level around
	  the calls to file_manager_.
02/13/85 by Lee A. Newcomb:  Fixed to use BJ_PSTE_VERSION_2, use an
            ERROR_RETURN proc, use like to declare my_ci_parts and correctly
	  initialize it, and format declarations; added a description
	  to that blank section; removed the invalid entry bj_ci_zero.
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bj_ci_zero$get_header:
   proc (p_bj_file_oid, p_bj_header_ptr, p_bj_header_n_words);

/* DECLARATIONS */

/* Parameter */
dcl  (
     p_bj_file_oid			bit (36) aligned,
     p_bj_header_ptr		ptr,
     p_bj_header_n_words		fixed bin
     )				parameter;

/* Automatic */
dcl  (
     code				fixed bin (35),
     1 my_bj_header			automatic aligned like bj_header,
     1 my_ci_header			aligned like ci_header,
     saved_level			fixed bin
     )				automatic;

dcl  1 my_ci_parts			aligned,
       2 number_of_parts		fixed bin (17) init (1),
       2 must_be_zero		fixed bin init (0),
       2 part			dim (1) like ci_parts.part;

/* Based */
/* Builtin */
dcl  (addr, null, size)		builtin;

/* Condition */
dcl  cleanup			condition;

/* Constant */
dcl  ME				char (10) init ("bj_ci_zero")
				internal static options (constant);

/* Entry */
dcl  (
     bj_report_err			entry (fixed bin (35), char (*)),
     cu_$level_get			entry (fixed bin),
     cu_$level_set			entry (fixed bin),
     file_manager_$get		entry (bit (36) aligned,
				fixed bin (24) uns, ptr,
				fixed bin (35)),
     file_manager_$get_ci_header	entry (bit (36) aligned,
				fixed bin (24) uns,
				1 aligned like ci_header,
				fixed bin (35)),
     file_manager_$put_journal	entry (bit (36) aligned,
				fixed bin (24) uns, ptr,
				fixed bin (35)),
     get_ring_			entry () returns (fixed bin (3))
     )				external;

/* External */
dcl  dm_error_$bj_bad_header		fixed bin (35) external;
%page;
/* bj_ci_zero$get_header:		repeat for reader	*/
/*     entry (p_bj_file_oid, p_bj_header_ptr, p_bj_header_n_words);	*/

   call FILL_CI_PARTS (p_bj_header_ptr, p_bj_header_n_words);

   call cu_$level_get (saved_level);
   on cleanup call cu_$level_set (saved_level);

   call cu_$level_set (get_ring_ ());
   call file_manager_$get (p_bj_file_oid, 0, ci_parts_ptr, code);
   call cu_$level_set (saved_level);

   if code ^= 0 then
      call ERROR_RETURN (code);

   goto MAIN_RETURN;				/* all done */

/* end bj_ci_zero$get_header; */
%skip (4);
bj_ci_zero$put_header:
   entry (p_bj_file_oid, p_bj_header_ptr, p_bj_header_n_words);

   call FILL_CI_PARTS (p_bj_header_ptr, p_bj_header_n_words);

   call cu_$level_get (saved_level);
   on cleanup call cu_$level_set (saved_level);

   call cu_$level_set (get_ring_ ());
   call file_manager_$put_journal (p_bj_file_oid, 0, ci_parts_ptr, code);
   call cu_$level_set (saved_level);

   if code ^= 0 then
      call ERROR_RETURN (code);

   goto MAIN_RETURN;				/* no error */

/* end bj_ci_zero$put_header; */
%page;
bj_ci_zero$get_pf_uid:
   entry (p_bj_file_oid) returns (bit (36));

   my_ci_header.stamp.version = CI_HEADER_STAMP_VERSION_1;

   call cu_$level_get (saved_level);
   on cleanup call cu_$level_set (saved_level);

   call cu_$level_set (get_ring_ ());
   call file_manager_$get_ci_header (p_bj_file_oid, 0, my_ci_header, code);
   call cu_$level_set (saved_level);

   if code ^= 0 then
      call ERROR_RETURN (code);

   return (my_ci_header.id.uid);

/* end bj_ci_zero$get_pf_oid; */
%skip (4);
bj_ci_zero$get_bj_uid:
   entry (p_bj_file_oid) returns (bit (36));

   call bj_ci_zero$get_header (p_bj_file_oid, addr (my_bj_header),
        size (my_bj_header));

   if my_bj_header.version ^= BJ_PSTE_VERSION_2 then
      call ERROR_RETURN (dm_error_$bj_bad_header);

   return (my_bj_header.bj_uid);

/* end bj_ci_zero$get_bj_uid; */
%page;
MAIN_RETURN:
   return;
%skip (4);
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call bj_report_err (er_p_code, ME);
   return;					/* should not get this return */

   end ERROR_RETURN;
%skip (4);
FILL_CI_PARTS:
   proc (fcp_p_bj_header_ptr, fcp_p_bj_header_n_words);

dcl  (
     fcp_p_bj_header_ptr		ptr,
     fcp_p_bj_header_n_words		fixed bin
     )				parameter;

/* Some external entries need a ci_parts structure filled	*/
/* in and by definition there is only one part, so we	*/
/* resort to a common proc.				*/

   ci_parts_ptr = addr (my_ci_parts);

   ci_parts.number_of_parts = 1;
   ci_parts.part (1).offset_in_bytes = 0;
   ci_parts.part (1).length_in_bytes = p_bj_header_n_words * 4;
						/* file_manager_ requires byte number */
   ci_parts.part (1).local_ptr = p_bj_header_ptr;

   return;

   end FILL_CI_PARTS;
%page;
%include dm_ci_parts;
%page;
%include dm_ci_header;
%page;
%include dm_bj_header;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_static;


   end bj_ci_zero$get_header;




		    bj_cleanup_tables.pl1           04/04/85  1117.3r w 04/04/85  0915.2       26190



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

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

bj_cleanup_tables$handler:
     procedure (code);

/* DESCRIPTION:
     A temporary procedure to address the need for a centralized
routine to undo changes to the PST during journalization.
*/

/* HISTORY:
Written by Mike Pandolf, 06/28/82.
Modified:
11/12/82 by M. Pandolf:  elimiated call to ioa_ just before unlocking tables.
03/09/83 by M. Pandolf:  to use new pste locking.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
*/
%page;	
/* handler:						 entry for invocation from expected error handler
	entry (code); */

	reason_invoked = HANDLER;
	code = 0;

	call BEGIN_CLEANUP;

	return;

crawl_out:					/* entry for invocation from unexpected error handler */
     entry (code);

	reason_invoked = CRAWLOUT;
	code = 0;

	call BEGIN_CLEANUP;

	return;

dead_process:					/* entry for invocation after a process destruction */
     entry (code);

	reason_invoked = DEAD_PROCESS;
	code = 0;

	call BEGIN_CLEANUP;

	return;

%page;

/* INTERNAL PROCEDURES */

BEGIN_CLEANUP:
     procedure ();

	my_process_id = get_process_id_ ();

	bj_pst_ptr = bjm_data_$bj_pst_ptr;

	do pste_no = 1 to bj_pst.max_n_entries;
	     if bj_pst.e (pste_no).lock.pid = my_process_id
	     then call bj_pste_lock$unlock_cleanup (addr (bj_pst.e (pste_no)));
	end;

	if bj_pst.lock.pid = my_process_id
	then do;
	     call lock_manager_$unlock_fast (addr (bj_pst.lock), code);
	end;

	return;

     end BEGIN_CLEANUP;


/* DECLARATIONS */

/* Parameters */

dcl  code			        fixed bin (35) parameter; /* standard status code */

/* Automatic */

dcl  reason_invoked		        fixed bin automatic;	/* indicator for the rest of the procedure */
dcl  my_process_id		        bit (36) aligned;
dcl  pste_no		        fixed bin;

/* Static, External */

dcl  bjm_data_$bj_pst_ptr	        pointer external static;

/* Entry */

dcl  bj_pste_lock$unlock_cleanup      entry (ptr);
dcl  lock_manager_$unlock_fast        entry (ptr, fixed bin (35));
dcl  get_process_id_	        entry returns (bit (36));

/* Constants */

dcl  HANDLER		        internal static options (constant) fixed bin init (1);
dcl  CRAWLOUT		        internal static options (constant) fixed bin init (2);
dcl  DEAD_PROCESS		        internal static options (constant) fixed bin init (3);

/* Condition */

dcl  error		        condition;

/* Include Files */

%page;
%include dm_bj_static;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;

     end bj_cleanup_tables$handler;




		    bj_close_oid.pl1                05/17/85  1651.2re  05/17/85  1328.6       71091



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

/* DESCRIPTION

   bj_close_oid - implements the before journal manager close primitive.

   This procedure decrements the n_opened count of the before journal
   specified by the first parameter.  It then checks the count to see if
   it is zero, indicating that the before journal is not referenced by
   any program in this process.  This being the case, the before journal
   can be closed.  If not, an appropriate code is returned.  If being
   closed, then the pste for this before journal must be adjusted to
   reflect that one less process is using it.  This is done with the pst 
   locked (as required by bj_pst_register$check_out).  The closing may
   effect the default before journal status.  This procedure makes sure
   that there is a valid default before journal reflected in dm_data_.

   Design consideration: the PST must be locked before this program is
   called.  bj_close_oid cannot know of the environment from which it
   was called, hence the requirement of locking the PST.
*/

/* HISTORY:
Written by Mike Pandolf, 07/06/82.
Modified:
08/24/82 by Mike Pandolf:  To be bjm support procedure
10/04/82 by Lee A. Newcomb:  To understand that there are two default_bj
	  OID cells as per the write_begin_mark BJ selection protocol.
10/15/82 by M. Pandolf:  to use file_manager_ for manipulation of data
	  management files.
11/03/82 by M. Pandolf:  to remove PSTE if journal is used by no one after
	  it is closed in this process.
11/23/82 by A. Bensoussan:  to call dm_hcs_$free_journal.
12/21/82 by M. Pandolf:  to remove call to bj_pst_lock.  see notes above.
03/10/83 by M. Pandolf:  to log calls to dm_send_request_.
03/15/83 by M. Pandolf:  to get rid of call to
	  dm_send_request_$adjust_process_id because this leads to an
	  endless wakeup loop if the adjustment fails; to not allow journal
	  checkout from system table if the journal has a non zero
	  transaction count.
03/29/83 by A. Bensoussan:  to call bj_pste_delete which centralizes the
	  freeing of pste's.
05/06/83 by A.Bensoussan:  to add the entry point $after_recovery.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
11/30/84 by Maggie Sharpe:  to set/reset validation level around the call to
            file_manager_.
04/05/85 by Lee A. Newcomb:  Fixed to not call dm_pste_register$check_out_dead
            during recovery.
05/10/85 by R. Michael Tague:  Removed dm_journal_seg_.incl.pl1 - unreferenced.
*/

/* format: style4,^indcomtxt,^ifthen,indattr,^inddcls,idind40 */
%page;
bj_close_oid:
     procedure (p_bj_oid);


/* DECLARATIONS */

/* Parameter */

dcl  p_bj_oid			     bit (36) aligned parameter; /* OID of before journal to be closed */

/* Automatic */

dcl  fm_oid			     bit (36) aligned; /* local aligned copy of fm_oid for call to file_manager_ */
dcl  code				     fixed bin (35);/* standard system status code */
dcl  bj_uid			     bit (36) aligned;
dcl  bj_oid			     bit (36) aligned; /* copy of the parameter */
dcl  close_after_recovery		     bit (1);
dcl  saved_level			     fixed bin;

/* Builtin */

dcl  addr				     builtin;

/* Condition */

dcl  cleanup			     condition;

/* Constant */

dcl  ME				     char (32) internal static options (constant) init ("bj_close_oid");


/* Entry */

dcl  bj_oid_util$get_ptr		     entry (bit (36) aligned) returns (pointer);
dcl  bj_oid_util$get_latest_oid	     entry () returns (bit (36) aligned);
dcl  bj_pste_register$check_out	     entry (pointer);
dcl  bj_pste_register$check_out_dead	     entry (ptr, bit (36) aligned);
dcl  bj_pste_delete			     entry (ptr);
dcl  bj_pste_delete$after_recovery	     entry (ptr);
dcl  bj_report_err			     entry (fixed bin (35), char (*));
dcl  cu_$level_get			     entry (fixed bin);
dcl  cu_$level_set			     entry (fixed bin);
dcl  file_manager_$close		     entry (bit (36) aligned, fixed bin (35));
dcl  get_ring_			     entry () returns (fixed bin (3));
dcl  hcs_$validate_processid		     entry (bit (36) aligned, fixed bin (35));




/* External Static */

dcl  bjm_data_$bj_ppt_ptr		     pointer external static;
dcl  bjm_data_$bj_pst_ptr		     pointer external static;
dcl  dm_data_$bj_txt_ptr		     pointer external static;
dcl  dm_data_$current_txn_id		     bit (36) external static;
dcl  dm_data_$current_txn_index	     fixed bin external static;
dcl  dm_error_$bj_journal_in_use	     fixed bin (35) external static;

%page;

/* Standard entrypoint */

	close_after_recovery = "0"b;
	goto COMMON;

after_recovery: entry (p_bj_oid);

	close_after_recovery = "1"b;
	goto COMMON;



COMMON:	bj_oid = p_bj_oid;
	code = 0;
	call cu_$level_get (saved_level);

	on cleanup begin;
	     call cu_$level_set (saved_level);
	end;

/* get pointer to ppte referenced by OID */

	bj_ppte_ptr = bj_oid_util$get_ptr (bj_oid);


/* if we are trying to close a journal which we are currently using, give up */

	if dm_data_$current_txn_id ^= (36)"0"b then
	     if bj_ppte.bj_uid = addr (dm_data_$bj_txt_ptr -> bj_txt.entry (dm_data_$current_txn_index)) -> bj_txte.bj_uid
	     then do;
		code = dm_error_$bj_journal_in_use;
		goto local_error_exit;
	     end;


/* decrement number of openings this process by one */

	if close_after_recovery = "0"b
	then bj_ppte.n_opening = bj_ppte.n_opening - 1;
	else bj_ppte.n_opening = 0;


/* if openings > 0, then we can do no more */

	if bj_ppte.n_opening > 0
	then goto exit;


/* begin the big close... */

	bjm_data_$bj_ppt_ptr -> bj_ppt.n_entries_used = bjm_data_$bj_ppt_ptr -> bj_ppt.n_entries_used - 1;


/* get the file manager opening ID for later use */

	fm_oid = bj_ppte.pf_oid;


/* openings = 0, so we can actually close the before journal at the system level */

	bj_pste_ptr = bj_ppte.bj_pste_ptr;

	call bj_pste_register$check_out (bj_pste_ptr);	/* Check me out */

	if close_after_recovery = "0"b
	then do;
	     call bj_pste_register$check_out_dead (bj_pste_ptr, (36)"0"b); /* Check all dead out */
	     if bj_pste.n_processes = 0 & bj_pste.n_txn = 0
	     then call bj_pste_delete (bj_pste_ptr);
	end;
	else
	     call bj_pste_delete$after_recovery (bj_pste_ptr);
%page;
/* mark the PPTE as unused */

	bj_ppte.version = 0;

/* open a window where there is no known default before journal */

	bj_ppt_ptr = bjm_data_$bj_ppt_ptr;		/* get bj_ppt loc. in auto. storage */

	if bj_ppt.default_bj.user_set_oid = bj_oid then	/* lost our explicit default BJ */
	     bj_ppt.default_bj.user_set_oid = ""b;

	if bj_ppt.default_bj.last_opened_oid = bj_oid then/* lost our 1st implicit BJ */
	     bj_ppt.default_bj.last_opened_oid = ""b;


/* close the before journal in its capacity as a dms file */

	call cu_$level_set (get_ring_ ());
	call file_manager_$close (fm_oid, code);
	call cu_$level_set (saved_level);

/* close the window where there is no known default before journal */
/* note we only get an implicit default if the user set one has been closed */

	if bj_ppt.default_bj.last_opened_oid = ""b then
	     bj_ppt.default_bj.last_opened_oid = bj_oid_util$get_latest_oid ();

/* check the code we got last call, during the default journal window */

	if code ^= 0
	then goto local_error_exit;


/* the close operation is now completed */

exit:
	return;

local_error_exit:
	call bj_report_err (code, ME);
	goto exit;


/* Include Files */

%page;
%include dm_bj_static;
%page;
%include dm_bj_ppt;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_check_in_table;
%page;
%include dm_bj_pn_table;
%page;
%include dm_bj_txt;
%page;
%include dm_log_sv_codes;
%page;

     end bj_close_oid;




		    bj_error_util_.pl1              04/04/85  1117.3re  04/04/85  0826.0       87201



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

/* DESCRIPTION:

*/

/* HISTORY:

Written by Matthew Pierret, 07/02/84.
Modified:
03/05/85 by Steve Herbst: Replaced dm_log_ with dm_misc_util_$log.
*/

/* format: style2,ind3 */
%page;
bj_error_util_$signal:
   procedure ();


/* START OF DECLARATIONS */
/* Parameter */

      dcl	    p_code	       fixed bin (35) based (p_code_ptr);
						/* is a standard system error code. */
      dcl	    p_signalling_program_name
			       char (pspn_length) based (p_signalling_program_name_ptr);
      dcl	    p_bj_error_flags_string
			       bit (36) aligned based (p_bj_error_flags_ptr);
      dcl	    p_severity	       fixed bin (17) based (p_severity_ptr);

/* Automatic */

      dcl	    arg_count	       fixed bin init (-1);
      dcl	    arg_list_ptr	       ptr init (null);
      dcl	    p_code_ptr	       ptr init (null);
      dcl	    p_signalling_program_name_ptr
			       ptr init (null);
      dcl	    p_bj_error_flags_ptr   ptr init (null);
      dcl	    p_severity_ptr	       ptr init (null);
      dcl	    pspn_length	       fixed bin (21) init (-1);

      dcl	    code		       fixed bin (35) init (0);

      dcl	    prev_error_object_ptr  ptr init (null);
      dcl	    message_buffer_ptr     ptr init (null);
      dcl	    message_length	       fixed bin (21) init (-1);

      dcl	    (pad_sw, nl_sw)	       bit (1) aligned;

      dcl	    1 my_bj_sub_error_info aligned like bj_sub_error_info;

      dcl	    1 my_condition_info    aligned like condition_info;

/* Based */

      dcl	    message_buffer	       char (sys_info$max_seg_size * 4) based (message_buffer_ptr);
      dcl	    message	       char (message_length) based (message_buffer_ptr);

/* Builtin */

      dcl	    (addr, length, max, min, null, rtrim, substr)
			       builtin;

/* Condition */

      dcl	    (any_other, cleanup)   condition;

/* Constant */

      dcl	    myname	       init ("bj_error_util_") char (32) varying internal static options (constant);
      dcl	    (
	    CODE_ARGUMENT_IDX      init (1),
	    SIGNALLING_PROGRAM_NAME_ARGUMENT_IDX
			       init (2),
	    BJ_ERROR_FLAGS_ARGUMENT_IDX
			       init (3),
	    SEVERITY_ARGUMENT_IDX  init (4),
	    FIRST_MESSAGE_ARGUMENT_IDX
			       init (5),
	    NUMBER_OF_REQUIRED_ARGUMENTS
			       init (4),
	    DEFAULT_SEVERITY       init (0)
	    )		       fixed bin internal static options (constant);
      dcl	    NON_ACTION_FLAGS_MASK  init ((18)"1"b || (18)"0"b) bit (36) aligned internal static options (constant);

/* Entry */

      dcl	    hcs_$create_branch_    entry (char (*), char (*), ptr, fixed bin (35));
      dcl	    cu_$arg_list_ptr       entry (ptr);
      dcl	    cu_$arg_count	       entry (fixed bin, fixed bin (35));
      dcl	    cu_$arg_ptr	       entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
      dcl	    cu_$cp	       entry (ptr, fixed bin (21), fixed bin (35));
      dcl	    dm_misc_util_$log      entry () options (variable);
      dcl	    find_condition_info_   entry (ptr, ptr, fixed bin (35));
      dcl	    get_dm_dir_	       entry () returns (char (168));
      dcl	    get_temp_segment_      entry (char (*), ptr, fixed bin (35));
      dcl	    ioa_$general_rs	       entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned,
			       bit (1) aligned);
      dcl	    pathname_	       entry (char (*), char (*)) returns (char (168));
      dcl	    release_temp_segment_  entry (char (*), ptr, fixed bin (35));
      dcl	    signal_	       entry () options (variable);
      dcl	    sub_err_	       entry () options (variable);
      dcl	    unique_chars_	       entry (bit (*)) returns (char (15));

/* External */

      dcl	    dm_error_$programming_error
			       fixed bin (35) ext;
      dcl	    (
	    error_table_$fatal_error,
	    error_table_$unimplemented_version
	    )		       fixed bin (35) ext;
      dcl	    sys_info$max_seg_size  fixed bin (35) ext;

/* END OF DECLARATIONS */

/* format: ^indblkcom,indcomtxt */

/* This "entry point" is actually the main procedure statement above.

   signal:
   entry ();
*/

/**** Get pointer to this routine's arg_list */

      call cu_$arg_list_ptr (arg_list_ptr);
      call cu_$arg_count (arg_count, (0));

      if arg_count < NUMBER_OF_REQUIRED_ARGUMENTS
      then call
	    sub_err_ (dm_error_$programming_error, myname, ACTION_CANT_RESTART, null, 0,
	    "^/^10xThis entry requires at least ^d arguments.^/^10xOnly ^d arguments were received.",
	    (NUMBER_OF_REQUIRED_ARGUMENTS), arg_count);

/**** Set the parameter values. */

      call cu_$arg_ptr (CODE_ARGUMENT_IDX, p_code_ptr, (0), (0));
      call cu_$arg_ptr (SIGNALLING_PROGRAM_NAME_ARGUMENT_IDX, p_signalling_program_name_ptr, (0), (0));
      call cu_$arg_ptr (BJ_ERROR_FLAGS_ARGUMENT_IDX, p_bj_error_flags_ptr, (0), (0));
      call cu_$arg_ptr (SEVERITY_ARGUMENT_IDX, p_severity_ptr, (0), (0));

/**** Setup message buffer in a temporary segment. ****/

      on cleanup call FINISH ();

      call get_temp_segment_ ((myname), message_buffer_ptr, code);
      if code ^= 0
      then call
	    sub_err_ (code, myname, ACTION_CANT_RESTART, null, 0,
	    "^/^10xAn attempt to acquire a temporary segment failed while^/^10xpreparing error message.");

      call
         ioa_$general_rs (arg_list_ptr, FIRST_MESSAGE_ARGUMENT_IDX, FIRST_MESSAGE_ARGUMENT_IDX + 1, message_buffer,
         message_length, pad_sw, nl_sw);

      unspec (my_bj_sub_error_info) = ""b;
      bj_sub_error_info_ptr = addr (my_bj_sub_error_info);

      bj_sub_error_info.header.version = BJ_SUB_ERROR_INFO_VERSION_100;
      bj_sub_error_info.header.length = size (bj_sub_error_info);
      bj_sub_error_info.header.status_code = p_code;
      string (bj_sub_error_info.header.action_flags) = p_bj_error_flags_string & NON_ACTION_FLAGS_MASK;
      bj_sub_error_info.header.action_flags.support_signal = "1"b;

      bj_sub_error_info.module_name = p_signalling_program_name;

      if message_length <= 256
      then
         do;
	  bj_sub_error_info.header.info_string = message;
	  bj_sub_error_info.message_length = message_length;
	  bj_sub_error_info.message_ptr = addr (bj_sub_error_info.header.info_string);
         end;
      else
         do;
	  bj_sub_error_info.header.info_string = "";
	  bj_sub_error_info.message_length = message_length;
	  bj_sub_error_info.message_ptr = message_buffer_ptr;
         end;


/**** Log message if requested. */

      if p_bj_error_flags_ptr -> bj_error_flags.log.system
      then call
	    dm_misc_util_$log (max (DEFAULT_SEVERITY, p_severity), bj_sub_error_info.header.status_code,
	    (bj_sub_error_info.module_name), message);



/**** Signal bj_sub_error_ condition. */

      call signal_ ("bj_sub_error_", null, bj_sub_error_info_ptr, null);

      do while (bj_sub_error_info.header.action_flags.cant_restart);
						/* If user can't hack return */
         call signal_ ("illegal_return", null, bj_sub_error_info_ptr, null);
      end;

      call FINISH ();

      return;
%page;
FINISH:
   proc ();

      if message_buffer_ptr ^= null
      then call release_temp_segment_ ((myname), message_buffer_ptr, (0));

   end FINISH;
%page;
get_code:
   entry () returns (fixed bin (35));

      bj_sub_error_info_ptr = GET_ERROR_INFO_PTR ();

      return (bj_sub_error_info.header.status_code);




get_message:
   entry () returns (char (*));

      bj_sub_error_info_ptr = GET_ERROR_INFO_PTR ();

      message_length = bj_sub_error_info.message_length;
      message_buffer_ptr = bj_sub_error_info.message_ptr;

      return (message);


GET_ERROR_INFO_PTR:
   proc () returns (ptr);

      dcl	    geip_code	       fixed bin (35) init (0);

      condition_info_ptr = addr (my_condition_info);
      call find_condition_info_ ((null), condition_info_ptr, geip_code);
      if geip_code ^= 0
      then call sub_err_ (geip_code, myname, ACTION_CANT_RESTART, null, 0, "^/Attempt to find condition info failed.");
      if condition_info_ptr = null
      then call
	    sub_err_ (dm_error_$programming_error, myname, ACTION_CANT_RESTART, null, 0,
	    "^/^10xThis entry was invoked to handle a ^a condition,^/^10xbut no condition info exists.",
	    BJ_SUB_ERROR_CONDITION_NAME);
      if condition_info.condition_name ^= BJ_SUB_ERROR_CONDITION_NAME
      then call
	    sub_err_ (dm_error_$programming_error, myname, ACTION_CANT_RESTART, null (), 0,
	    "^/^10xThis entry was invoked to handle a ^a condition,^/^10xbut the current condition is ^a.",
	    BJ_SUB_ERROR_CONDITION_NAME, condition_info.condition_name);
      if condition_info.info_ptr = null
      then call
	    sub_err_ (dm_error_$programming_error, myname, ACTION_CANT_RESTART, null (), 0,
	    "^/The condition_info.info_ptr variable is not set.");

      if condition_info.info_ptr -> bj_sub_error_info.header.version ^= BJ_SUB_ERROR_INFO_VERSION_100
      then call
	    sub_err_ (dm_error_$programming_error, myname, ACTION_CANT_RESTART, null, 0,
	    "^/Expected version ^d of the bj_sub_error_info structure; received ^d.", BJ_SUB_ERROR_INFO_VERSION_100,
	    condition_info.info_ptr -> bj_sub_error_info.header.version);

      return (condition_info.info_ptr);


   end GET_ERROR_INFO_PTR;
%page;
%include dm_bj_sub_error_info;
%page;
%include dm_bj_sub_error_flags;
%page;
%include condition_info;
%page;
%include condition_info_header;
%page;
%include sub_err_flags;

   end bj_error_util_$signal;




		    bj_flush_pnt.pl1                04/04/85  1117.3re  04/04/85  0826.0       33939



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

/* DESCRIPTION:

	bj_flush_pnt flushes the Data Management System's before journal
     pathname to UID table.  This is done to guarantee a journal can be
     opened for recovery after a Multics' system crash.
*/

/* HISTORY:
Written by Lee A. Newcomb, 04/30/83.
Modified:
12/06/83 by Lee A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
02/18/85 by Lee A. Newcomb:  Fixed to check the version of the BJ PST and the
            format and declarations; also added a DESCRIPTION section.
*/

/* format:style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bj_flush_pnt:
   proc ();

/* DECLARATIONS */

/* Parameter */
/* Automatic */
dcl  (
     code				fixed bin (35) init (0),
     first_page			fixed bin,
     last_page			fixed bin,
     n_pages			fixed bin
     )				automatic;

dcl  1 my_flush_consec		aligned automatic,
       2 version			init (FLUSH_CONSEC_VERSION_1),
       2 n_segs			init (1),		/* UID-pathname table is single seg. */
       2 seg			dim (1) like flush_consec.seg;

/* Based */
/* Builtin */
dcl  (addr, baseno, bin, divide, ptr, size)
				builtin;

/* Condition */
/* Constant */
dcl  ME				char (12)
				init ("bj_flush_pnt") internal
				static options (constant);

/* Entry */
dcl  (
     bj_report_err			entry (fixed bin (35), char (*)),
     hcs_$flush_consecutive_pages	entry (ptr, fixed bin (35))
     )				external;

/* External */
dcl  (
     bjm_data_$bj_pst_ptr		ptr,
     dm_error_$bj_bad_pst_version	fixed bin (35),
     dm_system_data_$bj_max_n_journals	fixed bin
     )				external static;

/* Static */

/* END OF DECLARATIONS */
%page;
/* bj_flush_pnt:				repeat for reader	*/
/*      proc ();						*/

   bj_pst_ptr = bjm_data_$bj_pst_ptr;
   call CHECK_VERSION_NUMERIC (bj_pst.version, BJ_PST_VERSION_1,
        dm_error_$bj_bad_pst_version);
   bj_pn_table_ptr = ptr (bj_pst_ptr, bj_pst.pn_table_offset);

   first_page = divide (bj_pst.pn_table_offset, 1024, 17, 0);

   last_page =
        divide (bj_pst.pn_table_offset + size (bj_pn_table) - 1, 1024, 17, 0);

   n_pages = last_page - first_page + 1;

   my_flush_consec.seg (1).segno = bin (baseno (bj_pst_ptr));
   my_flush_consec.seg (1).first_page = first_page;
   my_flush_consec.seg (1).n_pages = n_pages;


   call hcs_$flush_consecutive_pages (addr (my_flush_consec), code);
   if code ^= 0 then
      call ERROR_RETURN (code);

   return;

/* end bj_flush_pnt; */
%page;
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call bj_report_err (er_p_code, ME);			/* Will do a non local goto */

   end ERROR_RETURN;
%skip (4);
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_correct_version, cvn_p_error_to_use);

/* The error code to use is passed as this is really a template proc	*/
/* used in several modules to check structure versions.  It is hoped	*/
/* newer versions of these structures will be changed to use	*/
/*  char (8) versions.					*/

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_correct_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_correct_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_pn_table;
%page;
%include flush_structures;


   end bj_flush_pnt;




		    bj_max_txn_storage_limit.pl1    04/04/85  1125.6re  04/04/85  0826.3       39303



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

/* DESCRIPTION:

		bj_max_txn_storage_limit.pl1

	returns the maximum number of bytes available to users in a
     before journal.

	The input parameter must locate a BJ header (bj_pste) with
     a valid version, and the ci_size and max_size components set.
     The following list gives the list of overhead storage in a BJ
     control interval not included it in the maximum limit.  Please
     note the maximum is accurate only if one BJ record per CI (i.e.,
     one slot) is used; in the common case of >1 slots per CI in use,
     the maximum will exceed the actual available storage by a small
     amount, but other mechanisms prevent the overwriting of valid BJ
     records and the inaccuracy is relatively small.

     OVERHEAD STORAGE:
     - CI zero (used only for BJ header)
     - DM file CI headers and trailers (see dm_ci_header.incl.pl1)
     - per-CI BJ specific headers (see dm_bj_ci.incl.pl1)
     - the first slot of each CI.
*/

/* HISTORY:

Written by Lee A. Newcomb, 03/13/85.
Modified:
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bj_max_txn_storage_limit:
   proc (p_bj_header_ptr) returns (fixed bin (35));

/* START OF DECLARATIONS */
/* Parameter */
dcl  p_bj_header_ptr		ptr		/* loc. of BJ header.*/
				parameter;

/* Automatic */
dcl  (
     total_available_CIs		fixed bin (24) init (0),
     total_bytes			fixed bin (35) init (0),
     total_bytes_not_available	fixed bin (35) init (0),
     total_words_not_available	fixed bin (32) init (0),
     words_not_available_per_CI	fixed bin (18) init (0)
     )				automatic;

/* Based */
dcl  1 bj_ci_slot			aligned like bj_ci.slot;
						/* for size calculation */

/* Builtin */
dcl  (multiply, null, size)		builtin;

/* Constant */
dcl  (
     BYTES_PER_WORD			fixed bin init (4),
     MYNAME			init ("bj_max_txn_storage_limit")
				char (24)
     )				internal static options (constant);

/* Entry */
dcl  bj_report_err			entry (fixed bin (35), char (*))
				external;

/* External */
dcl  dm_error_$bj_bad_header		fixed bin (35) external static;

/* END OF DECLARATIONS */
%page;
COPY_PARAMETER:
   bj_header_ptr = p_bj_header_ptr;

/* bj_header's are currently equivalent to bj_pste's */
   call CHECK_VERSION_NUMERIC (bj_header.version, BJ_PSTE_VERSION_2,
        dm_error_$bj_bad_header);

   total_available_CIs = bj_header.max_size - 1;		/* -1 ==> do not include CI 0 */

   total_bytes = multiply (total_available_CIs, bj_header.ci_size,
						/* times CI size in bytes */
        35, 0);

   words_not_available_per_CI = size (ci_header)		/* DM file CI headers */
        + size (ci_trailer)				/* and DM file CI trailers */
        + size (header2)				/* and BJ specific CI header */
        + size (bj_ci_slot) /* and 1st BJ slot */;

   total_words_not_available =
        multiply (total_available_CIs, words_not_available_per_CI, 32, 0);

   total_bytes_not_available =
        multiply (total_words_not_available, BYTES_PER_WORD, 35, 0);

/* return max storage limit */

   return (total_bytes - total_bytes_not_available);

/* end bj_max_txn_storage_limit; */
%page;
ERROR_RETURN:
   proc (er_p_code);
dcl  er_p_code			fixed bin (35);

   call bj_report_err (er_p_code, MYNAME);

   end ERROR_RETURN;
%skip (4);
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_correct_version, cvn_p_error_to_use);

/* The error code to use is passed as this is really a template proc	*/
/* used in several modules to check structure versions.  It is hoped	*/
/* newer versions of these structures will be changed to use	*/
/* char (8) versions.					*/

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_correct_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_correct_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%page;
%include dm_bj_header;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_ci;
%page;
%include dm_ci_header;


   end bj_max_txn_storage_limit;




		    bj_oid_util.pl1                 03/06/85  0801.3re  03/05/85  0757.7       61938



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

/*   DESCRIPTION:

	Bj_oid_util is a procedure to convert between a before journal
     opening id and the per process before journal table entry pointer.
     The before journal opening id is based upon the table entry pointer:
     its first 18 bits are the offset from the pointer and its last 18 bits
     are the last 18 bits from the before journal unique id.

     	Each entrypoint as a short description section.

	NOTE:  the use of dm_error_$bj_bad_ppte_version to report a
     mismatch in the CHECK_UID_PART_OF_OID internal procedure should be
     changed.  It is not currently being done as it is unknown how many
     other places the same "error" is and time constraints.
*/

/*   HISTORY:

Written by Mike Pandolf, 06/28/82.
Modified:
07/10/82 by M. Pandolf:  added get_default_oid entry.
10/27/82 by M. Pandolf:  changed get_default_oid to get_latest_oid.
12/07/82 by Lee A. Newcomb:  added get_uid.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/07/84 by Lee Baldwin:  Renamed dm_error_$bj_(ppt ppte)_version_bad
            to $bj_bad_(ppt ppte)_version.
02/05/85 by Lee A. Newcomb:  Fixed format to conform with project standards;
            removed declarations for unused variables and added some for
            variables dcl'd by context or implication; added various internal
            procedures to aid in maintenance (e.g., ERROR_RETURN).
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bj_oid_util$get_oid:
   proc (p_bj_ppte_ptr) returns (bit (36) aligned);


/* DECLARATIONS */

/* Parameter */
dcl  (
     p_bj_ppte_ptr			pointer,
     p_bj_oid			bit (36) aligned
     )				parameter;

/* Automatic */
dcl  (
     bj_oid			bit (36) aligned,
     max_open_time			fixed bin (71),
     myname			char (32) init ("bj_oid_util$?"),
     this_ppte			fixed bin
     )				automatic;

/* Builtins */
dcl  (addr, ptr, rel, substr)		builtin;

/* Condition */
/* Constants */
/* Entries */

dcl  bj_report_err			entry (fixed bin (35), char (*));

/* External */
dcl  (
     bjm_data_$bj_ppt_ptr		pointer,
     dm_error_$bj_bad_ppt_version	fixed bin (35),
     dm_error_$bj_bad_ppte_version	fixed bin (35)
     )				external static;

/* Static */
/* END OF DECLARATIONS */
%page;
/* bj_oid_util$get_oid:			repeat for reader	*/
/*     proc (p_bj_ppte_ptr) returns (bit (36) aligned);		*/

/*   DESCRIPTION:

	The get_oid entrypoint expects a pointer to a before journal
     per-process table entry and will generate an opening id from the
     information in the pointer and the entry.
*/

   bj_ppte_ptr = p_bj_ppte_ptr;
   myname = "bj_oid_util$get_oid";

   call CHECK_VERSION_NUMERIC (bj_ppte.version, BJ_PPT_VERSION_1,
        dm_error_$bj_bad_ppte_version);

   bj_oid = rel (bj_ppte_ptr) || substr (bj_ppte.bj_uid, 19, 18);

   return (bj_oid);

/* end bj_oid_util$get_oid; */
%page;
bj_oid_util$get_uid:
   entry (p_bj_oid) returns (bit (36) aligned);

/*   DESCRIPTION:

	Get_uid is expected to return the unique ID of a before journal
     to its caller given the journal's opening ID.  It does this using the
     basic code of the get_ptr entry, but for convenience, grabs the UID
     for the caller.
*/

   bj_oid = p_bj_oid;				/* copy to local */

   bj_ppte_ptr = ptr (bjm_data_$bj_ppt_ptr, substr (bj_oid, 1, 18));
   myname = "bj_oid_util$get_uid";

   call CHECK_VERSION_NUMERIC (bj_ppte.version, BJ_PPTE_VERSION_1,
        dm_error_$bj_bad_ppte_version);
   call CHECK_UID_PART_OF_OID (bj_ppte.bj_uid, bj_oid);

   return (bj_ppte.bj_uid);

/* end bj_oid_util$get_uid; */
%page;
bj_oid_util$get_ptr:
   entry (p_bj_oid) returns (pointer);

/*   DESCRIPTION:

	The get_ptr entrypoint expects a before journal opening id and
     will obtain a pointer to the before journal table entry for the before
     journal referenced by the oid.     
*/

   bj_oid = p_bj_oid;

   bj_ppte_ptr = ptr (bjm_data_$bj_ppt_ptr, substr (bj_oid, 1, 18));
   myname = "bj_oid_util$get_ptr";

   call CHECK_VERSION_NUMERIC (bj_ppte.version, BJ_PPTE_VERSION_1,
        dm_error_$bj_bad_ppte_version);
   call CHECK_UID_PART_OF_OID (bj_ppte.bj_uid, bj_oid);

   return (bj_ppte_ptr);

/* end bj_oid_util$get_ptr; */
%page;
bj_oid_util$get_latest_oid:
   entry () returns (bit (36) aligned);

/*   DESCRIPTION:

	The bj_latest_oid entry searches the PPT for the most
     recently opened before journal, which is specified to be the default
     before journal when the old one is closed.

     ASSUMPTIONS:

     1) the cell bjm_data_$bj_ppt_ptr -> bj_ppt.default_bj_oid is zero,
     2) the version of the PPTE for the just closed before journal is zero.
*/

   bj_ppt_ptr = bjm_data_$bj_ppt_ptr;
   myname = "bj_oid_util$get_latest_oid";

   call CHECK_VERSION_NUMERIC (bj_ppt.version, BJ_PPT_VERSION_1,
        dm_error_$bj_bad_ppt_version);

   bj_oid = (36)"0"b;
   max_open_time = 0;

   do this_ppte = 1 to dm_system_data_$bj_max_n_journals;

      if bj_ppt.e (this_ppte).version = BJ_PPTE_VERSION_1 then
         if bj_ppt.e (this_ppte).open_time > max_open_time then do;

	  max_open_time = bj_ppt.e (this_ppte).open_time;
	  bj_oid =
	       rel (addr (bj_ppt.e (this_ppte)))
	       || substr (bj_ppt.e (this_ppte).bj_uid, 19, 18);
         end;
         else ;

   end;

   return (bj_oid);

/* end bj_oid_util$get_latest_oid; */
%page;
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call bj_report_err (er_p_code, myname);		/* no return */

   end ERROR_RETURN;
%skip (4);
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_correct_version, cvn_p_error_to_use);

/* The error code to use is passed since we use this to check both	*/
/* the PPT and PPTE structure versions.				*/

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_correct_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_correct_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%skip (4);
CHECK_UID_PART_OF_OID:
   proc (cupoo_p_bj_ppte_uid, cupoo_p_bj_oid);

dcl  (
     cupoo_p_bj_ppte_uid		bit (36) aligned,
     cupoo_p_bj_oid			bit (36) aligned
     )				parameter;

   if (substr (cupoo_p_bj_ppte_uid, 19, 18) ^= substr (cupoo_p_bj_oid, 19, 18))
        then
      call ERROR_RETURN (dm_error_$bj_bad_ppte_version);

   end CHECK_UID_PART_OF_OID;
%page;
%include dm_bj_ppt;
%page;
%include dm_bj_static;


   end bj_oid_util$get_oid;




		    bj_open_by_uid.pl1              04/04/85  1117.3r w 04/04/85  0915.2       57699



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

/* DESCRIPTION:
A procedure to open a before journal given only its UID.

     This procedure is designed to be called during rollback situations where
a process is rolling back some portion of a transaction on behalf of
another process, and must open the before journal in its own address space.
All it has available to it is the before jorunal UID  of the before
journal used by the now crippled process.

     ASSUMPTION:  since the crippled process is in the midst of a transaction,
it should not have the before journal closed.  This means that the journal
is registered in the before journal per system table.  If not found, no
attempt will be made to search far and wide across the hierarchy because
the process did something erroneous with the before journal.
*/

/* HISTORY:
Written by M. Pandolf, 08/24/82.
Modified:
10/15/82 by M. Pandolf:  to use file_manager_ for manipulating
	  data management system files.
01/11/83 by Lee A. Newcomb:  to call bj_oid_util$get_oid if the call
	  to bj_ppt_search is successful.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
12/03/84 by M. Sharpe:  to clean up format and dcls; to use ERROR_RETURN;
	  to set/reset validation level around calls to file_manager_.
*/

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */
%page;
bj_open_by_uid:
     procedure (p_bj_uid, p_bj_oid);

/* DECLARATIONS */

/* Parameters */

dcl  p_bj_uid		        bit (36) aligned parameter; /* UID of before journal that some other process was using */
dcl  p_bj_oid		        bit (36) aligned parameter; /* OID of the before journal in this process */

/* Automatic */

dcl  code			        fixed bin (35);	/* standard status code */
dcl  bj_oid		        bit (36) aligned;	/* copy of parameter */
dcl  bj_uid		        bit (36) aligned;	/* copy of parameter */
dcl  bj_dir		        char (168);		/* dir name of before journal to be opened */
dcl  bj_entry		        char (32);		/* entry name of before journal to be opened */
dcl  fm_oid		        bit (36) aligned;	/* page file OID of before journal in this process */
dcl  call_fm_close_when_done	        bit (1) aligned;	/* "1"b => need to close DM file before return */
dcl  current_ring		        fixed bin (3);
dcl  saved_level		        fixed bin;		/* user's validation level */

/* Builtin */

dcl  (null, ptr)		        builtin;

/* Condition */

dcl  cleanup		        condition;

/* Constant */

dcl  ME			        char (32) internal static options (constant) init ("bj_open_by_uid");

/* Entry */

dcl  bj_ppt_search		        entry (bit (36) aligned) returns (ptr);
dcl  bj_ppte_register$check_in        entry (ptr);
dcl  bj_pst_lock		        entry ();
dcl  bj_pst_search		        entry (bit (36) aligned) returns (ptr);
dcl  bj_pst_lock$unlock	        entry ();
dcl  file_manager_$open	        entry (char (*), char (*), bit (36) aligned, fixed bin (35));
dcl  file_manager_$close	        entry (bit (36) aligned, fixed bin (35));
dcl  bj_pste_register$check_in        entry (ptr);
dcl  bj_ppte_create		        entry (bit (36) aligned, bit (36) aligned, ptr) returns (ptr);
dcl  bj_oid_util$get_oid	        entry (ptr) returns (bit (36) aligned);
dcl  bj_report_err		        entry (fixed bin (35), char (*));
dcl  cu_$level_set		        entry (fixed bin);
dcl  cu_$level_get		        entry (fixed bin);
dcl  get_ring_		        entry() returns(fixed bin(3));

/* External Static */

dcl  dm_error_$file_already_open      fixed bin (35) external static;
dcl  dm_error_$bj_journal_not_registered fixed bin (35) external static;
dcl  bjm_data_$bj_pst_ptr	        pointer external static;

%page;
/* first  some housekeeping */

	bj_uid = p_bj_uid;
	bj_oid = p_bj_oid;

/* Next, do we have the before journal in question opened in our process? */

	bj_ppte_ptr = bj_ppt_search (bj_uid);

	if bj_ppte_ptr ^= null ()
	then do;
	     bj_oid = bj_oid_util$get_oid (bj_ppte_ptr);
	     call bj_ppte_register$check_in (bj_ppte_ptr);
	     goto MAIN_RETURN;
	end;

/* well, we do not have it opened...check in the per system table */

	call bj_pst_lock ();

	bj_pste_ptr = bj_pst_search (bj_uid);

	if bj_pste_ptr = null ()			/* give up */
	then do;
	     call bj_pst_lock$unlock ();
	     call ERROR_RETURN (dm_error_$bj_journal_not_registered);
	end;

/* form the pathname to be given to page file manager */

	bj_pn_table_ptr = ptr (bjm_data_$bj_pst_ptr, bjm_data_$bj_pst_ptr -> bj_pst.pn_table_offset);

	bj_dir = bj_pn_table (bj_pste.bj_ix).dir;
	bj_entry = bj_pn_table (bj_pste.bj_ix).entry;

/* open the before journal in this process */

	/* but first, set up a cleanup handler */

	call cu_$level_get (saved_level);
	current_ring = get_ring_ ();

	on cleanup call cu_$level_set (saved_level);

	/* now back to the business at hand. */

	call cu_$level_set ((current_ring));
	call file_manager_$open (bj_dir, bj_entry, fm_oid, code);
	call cu_$level_set (saved_level);

	if code ^= 0
	then if code = dm_error_$file_already_open
	     then call_fm_close_when_done = "1"b;
	     else do;
		call bj_pst_lock$unlock ();
		call ERROR_RETURN (code);
	     end;
	else call_fm_close_when_done = "0"b;
%page;
/* register the before journal and create a PPTE for it */

	call bj_pste_register$check_in (bj_pste_ptr);

	bj_ppte_ptr = bj_ppte_create (bj_uid, fm_oid, bj_pste_ptr);

	call bj_pst_lock$unlock ();

/* set return parameter and close the file, if necessary */

	bj_oid = bj_oid_util$get_oid (bj_ppte_ptr);

	if call_fm_close_when_done
	then do;
	     call cu_$level_set ((current_ring));
	     call file_manager_$close (fm_oid, code);
	     call cu_$level_set (saved_level);
	end;

/* exit  protocols */

MAIN_RETURN:
	p_bj_oid = bj_oid;
	p_bj_uid = bj_uid;
	return;


ERROR_RETURN:
	proc (er_code);

dcl  er_code			fixed bin (35);

	call bj_report_err (er_code, ME);
	goto MAIN_RETURN;

     end ERROR_RETURN;


/* Include Files */
%page;
%include dm_bj_static;
%page;
%include dm_bj_ppt;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%skip (6);
%include dm_bj_pn_table;


     end bj_open_by_uid;




		    bj_ppt_search.pl1               03/06/85  0801.3re  03/05/85  0757.7       16920



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

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

bj_ppt_search:
     proc (bj_uid) returns (ptr);

/* HISTORY:
Written by Mike Pandolf, 08/03/82.
Modified:
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/07/84 by Lee Baldwin:  Renamed dm_error_$bj_(ppt ppte)_version_bad
            to $bj_bad_(ppt ppte)_version.
*/
%page;
dcl  bj_uid		        bit (36) aligned;


dcl  found		        bit (1);
dcl  i			        fixed bin;
dcl  code			        fixed bin (35);

dcl  ME			        char (13) internal static options (constant)
			        init ("bj_ppt_search");


dcl  bjm_data_$bj_ppt_ptr	        pointer external;
dcl  bj_report_err		        entry options (variable);


dcl  dm_error_$bj_bad_ppt_version     ext;
dcl  dm_error_$bj_bad_ppte_version    ext;



	bj_ppt_ptr = bjm_data_$bj_ppt_ptr;

	if bj_ppt.version ^= BJ_PPT_VERSION_1 then
	     do;
	     code = dm_error_$bj_bad_ppt_version;
	     goto exit_err;
	end;

	found = "0"b;

	do i = 1 to bj_ppt.highest_ix_used while (^found);
	     bj_ppte_ptr = addr (bj_ppt.e (i));
	     if bj_ppte.version ^= 0 then
		do;
		if bj_ppte.version ^= BJ_PPTE_VERSION_1 then
		     do;
		     code = dm_error_$bj_bad_ppte_version;
		     goto exit_err;
		end;
		if bj_ppte.bj_uid = bj_uid then found = "1"b;
	     end;
	end;

	if ^found then bj_ppte_ptr = null ();

	return (bj_ppte_ptr);


exit_err: call bj_report_err (code, ME);


%include dm_bj_static;


%include dm_bj_ppt;


     end bj_ppt_search;




		    bj_ppte_create.pl1              03/06/85  0801.3re  03/05/85  0757.7       35865



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

/* DESCRIPTION:

	bj_ppte_create adds information of a before journal open in the
     current process to the BJ per-process table.  Any entry's version
     component being zero indicates a free entry.  We use the first entry
     free as found via a linear search through the table.  It is assumed
     the calling module has already determined there is no entry for the
     journal; no check is made to verify this.
*/

/* HISTORY:
Written by Mike Pandolf, 08/04/82.
Modified:
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/07/84 by Lee Baldwin:  Renamed dm_error_$bj_ppt_version_bad to
            bj_bad_ppt_version.
02/08/85 by Lee A. Newcomb:  Fixed to declare dm_error_ codes correctly (with
            precision 35 instead of 17); added DESCRIPTION section and fixed
            format to follow project standards; removed obsolete comments
            about "undo" functionality; added ERROR_RETURN and
            CHECK_VERSION_NUMERIC procs.
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bj_ppte_create:
   proc (p_bj_uid, p_file_oid, p_pste_ptr) returns (ptr);

/* DECLARATIONS */

/* Parameter */
dcl  (
     p_bj_uid			bit (36) aligned,
     p_file_oid			bit (36) aligned,
     p_pste_ptr			ptr
     )				parameter;

/* Automatic */
dcl  (
     found			bit (1) aligned init (""b),
     ppte_index			fixed bin
     )				automatic;

/* Builtin */
dcl  (addr, max)			builtin;

/* Condition */
/* Constant */
dcl  ME				char (14)
				init ("bj_ppte_create") internal
				static options (constant);

/* Entry */
dcl  (
     bj_report_err			entry (fixed bin (35), char (*)),
     clock_			entry returns (fixed bin (71))
     )				external;

/* External */
dcl  (
     bjm_data_$bj_ppt_ptr		pointer,
     dm_error_$bj_bad_ppt_version	fixed bin (35),
     dm_error_$bj_ppt_full		fixed bin (35)
     )				external;

/* Static */

/* END OF DECLARATIONS */
%page;
/* bj_ppte_create:				repeat for reader	*/
/*     proc (p_bj_uid, p_file_oid, p_pste_ptr) returns (ptr);	*/

   bj_ppt_ptr = bjm_data_$bj_ppt_ptr;

   call CHECK_VERSION_NUMERIC (bj_ppt.version, BJ_PPT_VERSION_1,
        dm_error_$bj_bad_ppt_version);

   do ppte_index = 1 to bj_ppt.max_n_entries while (^found);
      if bj_ppt.e (ppte_index).version = 0 then
         found = "1"b;
   end;

   if ^found then
      call ERROR_RETURN (dm_error_$bj_ppt_full);
   else						/* must fix since PL/I puts us one past */
        ppte_index = ppte_index - 1;			/* the entry we desire */

   bj_ppte_ptr = addr (bj_ppt.e (ppte_index));

   bj_ppte.bj_uid = p_bj_uid;
   bj_ppte.pf_oid = p_file_oid;
   bj_ppte.bj_pste_ptr = p_pste_ptr;
   bj_ppte.open_time = clock_ ();
   bj_ppte.n_opening = 1;

   bj_ppt.n_entries_used = bj_ppt.n_entries_used + 1;
   bj_ppt.highest_ix_used = max (ppte_index, bj_ppt.highest_ix_used);

   bj_ppte.version = BJ_PPTE_VERSION_1;

   return (bj_ppte_ptr);

/* end bj_ppte_create; */
%page;
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call bj_report_err (er_p_code, ME);

   end ERROR_RETURN;
%skip (4);
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_desired_version, cvn_p_error_to_use);

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_desired_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_desired_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%page;
%include dm_bj_static;
%page;
%include dm_bj_ppt;


   end bj_ppte_create;




		    bj_ppte_register.pl1            03/06/85  0801.3re  03/05/85  0757.7       20016



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

/* DESCRIPTION

	bj_ppte_register$check_in increments the number of per-process
     openings for a before journal;  bj_close_oid will decrement this
     count.  Currently, $check_in is the only entry in this module.
*/

/* HISTORY

Written by Michael A. Pandolf, 08/04/82.
Modified:
02/10/85 by Lee A. Newcomb:  Added Description and History sections; fixed to
            check the verson of PPTE to be updated; minor format fixes.
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bj_ppte_register$check_in:
   proc (p_bj_ppte_ptr);

/* DECLARATIONS */

/* Parameter */
dcl  p_bj_ppte_ptr			pointer parameter;

/* Builtin */
/* Condition */
/* Constant */
dcl  ME				char (25)
				init ("bj_ppte_register$check_in")
				internal static options (constant);

/* Entry */
dcl  bj_report_err			entry (fixed bin (35), char (*))
				external;

/* External */
dcl  dm_error_$bj_bad_ppte_version	fixed bin (35) external static;

/* Static */

/* END OF DECLARATIONS */
%page;
   bj_ppte_ptr = p_bj_ppte_ptr;

   call CHECK_VERSION_NUMERIC (bj_ppte.version, BJ_PPTE_VERSION_1,
        dm_error_$bj_bad_ppte_version);

   bj_ppte.n_opening = bj_ppte.n_opening + 1;

   return;

/* end bj_ppte_register$check_in; */
%page;
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call bj_report_err (er_p_code, ME);

   end ERROR_RETURN;
%skip (4);
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_desired_version, cvn_p_error_to_use);

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_desired_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_desired_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%page;
%include dm_bj_ppt;
%page;
%include dm_bj_static;


   end bj_ppte_register$check_in;




		    bj_pst_lock.pl1                 04/04/85  1117.3r w 04/04/85  0915.3       23436



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

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

bj_pst_lock: proc;

/* DESCRIPTION:
     The lock entry point sets the lock in the header of the bj_pst
(per system table). This lock has the standard format assumed by the
fast lock primitive of the Lock Manager. The lock is a double word
that must be initialized by calling lock_manager_$init_fast_lock.

     This lock must be acquired by any operation that searches the table
for a bj_uid, or does allocation or dealocation of any kind in the table:
allocate/free entry, alocate/free buffer, create/delete entry....etc.

     If the lock was already set by this process, this is an error; it should
never happen. If it happens, an error is reported.

     If the lock was set by a dead process, the lock procedure is responsible
for forcing the lock and calling the bj_undo procedure to undo whatever
the dead process had done to the table before dying.

     The unlock entry point unlocks the table.
*/

/* HISTORY:
Written by Mike Pandolf, 08/04/82.
Modified:
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
*/
%page;
dcl  ME			        char (11) internal static options (constant)
			        init ("bj_pst_lock");


dcl  code			        fixed bin (35);

dcl  bjm_data_$lock_manager_timeout
			        fixed bin (71) aligned external static;

dcl  bj_report_err		        entry (fixed bin (35), char (*));
dcl  bjm_data_$bj_pst_ptr	        pointer external;

dcl  lock_manager_$lock_fast	        entry (ptr, fixed bin (71) aligned, fixed bin (35));
dcl  lock_manager_$unlock_fast        entry (ptr, fixed bin (35));


/* Lock entry point */


	bj_pst_ptr = bjm_data_$bj_pst_ptr;

	call lock_manager_$lock_fast (addr (bj_pst.lock), bjm_data_$lock_manager_timeout, code);

	if code ^= 0 then goto exit_err;		/* This is temporary - Should analyse code */

	goto exit;





unlock: entry;

	bj_pst_ptr = bjm_data_$bj_pst_ptr;

	bj_pst.mod_list_area (1) = 0;

	call lock_manager_$unlock_fast (addr (bj_pst.lock), code);

	if code ^= 0 then goto exit_err;

	goto exit;



exit:	return;

exit_err: call bj_report_err (code, ME);


%include dm_bj_static;


%include dm_bj_pst;


%include dm_bj_pste;


     end bj_pst_lock;




		    bj_pst_search.pl1               04/04/85  1117.3re  04/04/85  0826.0       32490



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

/* DESCRIPTION:

	bj_pst_search does a linear walk through the BJ_PST looking for
     a before journal with the input BJ UID.  We return a pointer to the
     BJ_PST entry found, or null if the journal is not active in the DM
     system.
*/

/* HISTORY:

Written by Mike Pandolf, 08/04/82.
Modified:
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/07/84 by Lee Baldwin:  Renamed dm_error_$bj_(pst pste)_version_bad
            to bj_bad_(pst pste)_version.
02/14/85 by Lee A. Newcomb:  Fixed:  to use project program format, declare
            all variables, to name variables to imply a usage, use
            CHECK_VERSION_NUMERIC and ERROR_RETURN procs, and correctly
            declare dm_error_$*'s; added a description section; removed
	  %include of unused dm_bj_static.
02/14/85 by Lee A. Newcomb:  Fixed declaration and calling sequence of
	  bj_report_err.
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bj_pst_search:
   proc (p_bj_uid) returns (ptr);

/* DECLARATIONS */

/* Parameter */
dcl  p_bj_uid			bit (36) aligned parameter;

/* Automatic */
dcl  (
     bj_pste_index			fixed bin init (0),
     found			bit (1) init (""b)
     )				automatic;

/* Based */
/* Builtin */
dcl  (addr, null)			builtin;

/* Condition */
/* Constant */
dcl  ME				char (13)
				init ("bj_pst_search") internal
				static options (constant);

/* Entry */
dcl  bj_report_err			entry (fixed bin (35), char (*));

/* External */
dcl  (
     (
     dm_error_$bj_bad_pst_version,
     dm_error_$bj_bad_pste_version
     )				fixed bin (35),
     bjm_data_$bj_pst_ptr		pointer
     )				external static;

/* Static */

/* END OF DECLARATIONS */
%page;
FIND_BJ_PST:
   do;
      bj_pst_ptr = bjm_data_$bj_pst_ptr;
      call CHECK_VERSION_NUMERIC (bj_pst.version, BJ_PST_VERSION_1,
	 dm_error_$bj_bad_pst_version);
   end FIND_BJ_PST;

SEARCH_FOR_BJ_UID:
   do bj_pste_index = 1 to bj_pst.highest_ix_used while (^found);
      bj_pste_ptr = addr (bj_pst.e (bj_pste_index));
      if bj_pste.version ^= 0 then
CHECK_IN_USE_PST_ENTRY:
         do;
         call CHECK_VERSION_NUMERIC (bj_pste.version, BJ_PSTE_VERSION_2,
	    dm_error_$bj_bad_pste_version);
         if bj_pste.bj_uid = p_bj_uid then
	  found = "1"b;
      end CHECK_IN_USE_PST_ENTRY;
   end SEARCH_FOR_BJ_UID;

   if ^found then
      bj_pste_ptr = null ();

   return (bj_pste_ptr);

/* end bj_pst_search; */
%page;
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call bj_report_err (er_p_code, ME);			/* will not return */

   end ERROR_RETURN;
%skip (4);
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_correct_version, cvn_p_error_to_use);

/* The error code to use is passed since we use this to check both	*/
/* the PST and PSTE structure versions.				*/

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_correct_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_correct_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;


   end bj_pst_search;




		    bj_pste_create.pl1              04/04/85  1117.3re  04/04/85  0826.0      195957



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

/* DESCRIPTION :

     This procedure creates and initializes an entry in the bj_pst for
   the BJ with the uid given as input. It assumes that the bj_pst is already 
   locked by the caller, that is, no other process can allocate or free any
   pste, or search the pst for a given uid. It also allocates the buffer
   for this pste, stores the pathname of the journal in the pathname table
   for use by rollback after crash, and checks in the process as a user
   of this BJ.
*/

/*
   CONVENTIONS FOR CURSORS IN CIRCULAR LIST

   
   The bj_pste structure contains various cursors that keep track of several
   positions of interest in the journal. These cursors are expressed in
   absolute CI numbers. They are representedby the following items:
   
   	- bj_pste.cl.origin_ci
   	- bj_pste.last_ci_buffered
   	- bj_pste.last_ci_put
   	- bj_pste.last_ci_flushed
   	- bj_pste.last_ci_on_disk
   
   After the bj_pste structure has been initialized, all these cursors MUST be
   maintained according to the following conventions:
   
   
   1. All cursors ALWAYS point to a CI of the circular list, ie, at any time,
      the following relation is satisfied:

   	bj_pste.cl.lowest_ci <= any cursor <= bj_pste.cl.highest_ci.

      There is no such thing as a "null" value for a cursor, even at special
      times such as when the journal is empty, or full, or has been
      recycle, ect.

   2. All cursors ALWAYS point to a CI of the used part of the journal. The
      used part consists of the origin_ci followed by all the "next" CI's, up
      to, and including, the last_ci_buffered. The function "distance (ci)"
      has been implemented, and gives the distance if a CI to the origin.
      The distance is defined as being the number steps forward needed to
      reach the CI, starting from the origin_ci. At any instant, the
      following relation must hold:

   	0 <= distance (any_cursor) <= distance (bj_pste.last_ci_buffered)


   3. The value of the origin_ci is ALWAYS safely recorded in the journal
      header, in CI zero. It must be update in the journal header each time
      its value changes.

   
   These conventions have been made in order to simplify programs that deal
   with the circular list. These programs do not have to have special cases
   to handle special situations where cursors could be "null". Also, the fact
   that cursors are never null and must be in the used part of the journal
   makes it possible to perform consistency checks at the lowest level of
   programs. The last convention has been made to simplify the life of the
   program that has to find the end of the journal after a system crash.
*/

/*
   ENFORCING THESE CONVENTIONS:

   
   These conventions must be enforced by taking a special action whenever they
   might be in violation; that is at start_up time and recycle time.
   
   At start_up time, no record has been written in the journal yet. Cursors 
   pointing to the last_ci_put, last_ci_flushed and last_ci_on_disk are
   undefined.  Their values could be set to a conventional "null" value, but
   since we do not allow null values, we have to take a special action which
   will result in giving these cursors a legitimate value. One could, for
   example, define a start_up record type and write it in the journal at
   start_up time, put it in the file, flush it and wait for I/O completion.
   This would give our cursors legitimate values but it would require that a
   new record type be known from all programs that check the record type.
   Instead, we chose to write only the "end" of a imaginary record, whose
   beginning would have been in the previous CI, but which would have been
   overlapped by a recycle operation which moved the origin over it. So,

   o AT START_UP time, we set all cursors to point to the first CI of the
     circular list, and we write, in the first CI, an "element" which is the
     continuation of an imaginary record whose beginning would have vanished
     after a recycle. We flush the first CI, which is the origin, and wait for
     I/O completion. Now all cursors point to the origin, in a legitimate
     manner.  In addition, we write in the header in CI zero the value of
     the origin.

     This start_up protocol is used whenever a journal is "activated" after
     having been "deactivated" in an orderly manner, ie, when it contains no
     information that has to be rolled back. 

   o AT RECYCLE time, if the new origin was not flushed yet, we flush it
     and wait for I/O completion. In addition, the new origin is safely
     recorded in the journal header, in CI zero.

     At open after crash time, the origin is taken from the journal header.
     This CI is the starting point to search for the end of the journal
     (unless the header is updated more often, in which case, a more recent
     info may be used).

*/

/* HISTORY:
Written by Andre Bensoussan, 07/07/82.
Modified:
08/15/82 by M. Pandolf: to use file_manager_ to manipulate data
	  management system files.
11/23/82 by A. Bensoussan: to call dm_hsc_$allocate_journal.
12/16/82 by A. Bensoussan: to find the last CI after a crash.
12/20/82 by A. Bensoussan: to open after crash.
01/26/83 by L. A. Newcomb: to call file_manager_$flush_consecutive_ci
	  instead of page_file_manager_$...
03/16/83 by L. A. Newcomb: to use dm_error_$bj_header_bad, not ..bad_header
04/06/83 by A. Bensoussan: to add the entry point $for_recovery.
05/13/83 by A. Bensoussan: to add the entry point $force.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/11/84 by Lee Baldwin:  Renamed dm_error_$bj_header_bad to $bj_bad_header.
12/03/84 by Lindsey L. Spratt:  Added the dm_ci_layout_types include file.
12/03/84 by M. Sharpe:  to clean up dcls and format; to set/reset 
	  validation level around the calls to file_manager_; to %include
	  dm_ci.
02/14/85 by Lee A. Newcomb:  Fixed:  to use new constant BJ_PSTE_VERSION_2,
            turn formatting back on after short time of it being off, variable
            naming for parameters and internal proc variables; removed all
            reference to the obsolete undo functionality; changed entry_no to
            be entry_name; removed unused dm_bj_static include.
03/13/85 by Lee A. Newcomb:  Changed to fill in a valid value for
            bj_pste.txn_storage_limit if it is zero in the BJ header.
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bj_pste_create:
   proc (p_bj_dir, p_bj_entry, p_bj_file_oid, p_bj_uid) returns (ptr);


/* DECLARATIONS */

/* Parameter */
dcl  (
     p_bj_dir			char (168),
     p_bj_entry			char (32),
     p_bj_file_oid			bit (36) aligned,
     p_bj_uid			bit (36) aligned
     )				parameter;

/* Automatic */
dcl  (
     bj_ix			fixed bin init (0),
     code				fixed bin (35) init (0),
     current_ring			fixed bin (3) init (-1),
     entry_name			char (32) init (""),
     1 my_bj_header			aligned like bj_header,
     n_txn			fixed bin init (0),
     saved_level			fixed bin init (-1)
     )				automatic;

/* Based */
/* Builtin */
dcl  (addr, max, null, ptr, size, unspec)
				builtin;

/* Condition */
dcl  cleanup			condition;

/* Constant */
dcl  (
     BJ_PSTE_CREATE			char (32) init ("bj_pste_create"),
     BJ_PSTE_CREATE_FORCE		char (32)
				init ("bj_pste_create$force"),
     BJ_PSTE_CREATE_FOR_RECOVERY	char (32)
				init ("bj_pste_create$for_recovery"),
     ME				char (14) init ("bj_pste_create")
     )				internal static options (constant);

/* Entry */
dcl  (
     bj_ci_zero$get_header		entry (bit (36) aligned, ptr,
				fixed bin),
     bj_ci_zero$put_header		entry (bit (36) aligned, ptr,
				fixed bin),
     bj_flush_pnt			entry (),
     bj_max_txn_storage_limit		entry (ptr) returns (fixed bin (35)),
     bj_pste_register$check_in	entry (ptr),
     bj_report_err			entry (fixed bin (35), char (*)),
     bj_storage_get_header$find_last_record
				entry (bit (36) aligned, ptr, ptr)
				returns (bit (36) aligned),
     bj_storage_put_buffered_ci	entry (bit (36) aligned, ptr),
     clock_			entry returns (fixed bin (71)),
     cu_$level_get			entry (fixed bin),
     cu_$level_set			entry (fixed bin),
     dm_hcs_$allocate_journal		entry (bit (36) aligned, fixed bin,
				fixed bin (35)),
     file_manager_$flush_consecutive_ci entry (bit (36) aligned,
				fixed bin (27), fixed bin (27),
				fixed bin (35)),
     file_manager_$get_ci_header	entry (bit (36) aligned,
				fixed bin (27),
				1 like ci_header aligned,
				fixed bin (35)),
     get_ring_			entry () returns (fixed bin (3))
     )				external;

/* External */
dcl  (
     (
     dm_error_$bj_bad_header,
     dm_error_$bj_logic_err,
     dm_error_$bj_needed_for_recovery
     )				fixed bin (35),
     bjm_data_$bj_pst_ptr		pointer
     )				external static;

/* Static */

/* END OF DECLARATIONS */
%page;
/* bj_pste_create:				repeat for reader	*/
/*      proc (p_bj_dir, p_bj_entry, p_bj_file_oid, p_bj_uid)	*/
/*      returns (ptr);					*/

   entry_name = BJ_PSTE_CREATE;
   goto COMMON;

for_recovery:
   entry (p_bj_dir, p_bj_entry, p_bj_file_oid, p_bj_uid) returns (ptr);

   entry_name = BJ_PSTE_CREATE_FOR_RECOVERY;
   goto COMMON;

force:
   entry (p_bj_dir, p_bj_entry, p_bj_file_oid, p_bj_uid) returns (ptr);

   entry_name = BJ_PSTE_CREATE_FORCE;
   goto COMMON;


COMMON:						/* all entries have MUCH in common */
INIT_INCLUDE_AUTOMATICS_AND_RING:
   do;
      bj_header_ptr = addr (my_bj_header);
      bj_ix = 0;
      bj_pn_table_ptr = null ();
      bj_pst_ptr = bjm_data_$bj_pst_ptr;
      bj_pste_ptr = null ();
      current_ring = get_ring_ ();
      call cu_$level_get (saved_level);
   end INIT_INCLUDE_AUTOMATICS_AND_RING;


   on cleanup call cu_$level_set (saved_level);


/* Read the bj_header from CI zero and check it is consistent */

   call bj_ci_zero$get_header (p_bj_file_oid, bj_header_ptr, size (bj_header));
   call CHECK_HEADER ();


/* Allocate an entry for this journal in the hardcore table used by	*/
/* Page Control to keep the time stamps. Then use this index as the	*/
/* index in the PST for the PSTE for this journal.		*/

   call dm_hcs_$allocate_journal (p_bj_uid, bj_ix, code);
   if code ^= 0 then
      call ERROR_RETURN (code);

   if bj_ix < 1 | bj_ix > bj_pst.max_n_entries | bj_pst.e (bj_ix).version ^= 0
        then
      call ERROR_RETURN (dm_error_$bj_logic_err);

   bj_pste_ptr = addr (bj_pst.e (bj_ix));
%page;
/* Initialize the bj_pste entry, setting the version number last. */

   unspec (bj_pste) = "0"b;

   bj_pste.bj_ix = bj_ix;
   bj_pste.bj_uid = p_bj_uid;
   bj_pste.ci_size = bj_header.ci_size;
   bj_pste.max_size = bj_header.max_size;
   bj_pste.update_frequency = bj_header.update_frequency;
   bj_pste.txn_storage_limit = bj_header.txn_storage_limit;
   if bj_pste.txn_storage_limit = 0 then		/* old journal, fill limit in */
      bj_pste.txn_storage_limit = bj_max_txn_storage_limit (bj_header_ptr);

   bj_pste.active = "1"b;
   bj_pste.n_processes = 0;				/* Incremented by bj_pste_register$check_in */

   bj_pste.cl.lowest_ci = 1;
   bj_pste.cl.highest_ci = bj_header.max_size - 1;
   bj_pste.cl.number_ci = bj_header.max_size - 1;

   bj_pste.buffer_offset = ALLOC_BUFFER (bj_ix);

/* Initialize the BJ buffer.  This sets bj_uid in bj_ci.header1.	*/
/* Must be done before calling WRITE_START_UP_RECORD.		*/

   call INIT_BUFFER (ptr (bj_pst_ptr, bj_pste.buffer_offset));


/* If the active switch in the BJ's header is off, a proper close	*/
/* was done; otherwise, the journal was left open during a crash.	*/
   if bj_header.active = "0"b then
INIT_FOR_CLOSED_BJ:
      do;
      bj_pste.time_header_updated = clock_ ();
      bj_pste.cl.origin_ci = bj_pste.cl.lowest_ci;
      bj_pste.last_ci_on_disk = bj_pste.cl.lowest_ci;
      bj_pste.last_ci_flushed = bj_pste.cl.lowest_ci;
      bj_pste.last_ci_put = bj_pste.cl.lowest_ci;
      bj_pste.last_ci_buffered = bj_pste.cl.lowest_ci;
      bj_pste.last_rec_id = "0"b;
      bj_pste.n_txn = 0;
      call WRITE_START_UP_RECORD ();
   end INIT_FOR_CLOSED_BJ;
   else
INIT_FOR_CRASHED_BJ:
      do;
      bj_pste.time_header_updated = bj_header.time_header_updated;
      bj_pste.cl.origin_ci = bj_header.cl.origin_ci;	/* This item is refreshed at each recycle */
      bj_pste.last_ci_on_disk = FIND_LAST_CI ();		/* Using time stamps */
      bj_pste.last_ci_flushed = bj_pste.last_ci_on_disk;
      bj_pste.last_ci_put = bj_pste.last_ci_on_disk;
      bj_pste.last_ci_buffered = bj_pste.last_ci_on_disk;
      bj_pste.last_rec_id = FIND_LAST_RECORD (n_txn);	/* Using BJ format */
      bj_pste.n_txn = 0;				/* Since txt shows no txn yet */
   end INIT_FOR_CRASHED_BJ;

   bj_pste.stamp_for_last_ci_put, bj_pste.stamp_for_last_ci_on_disk =
        clock_ ();
%page;
/* Update the number of entries in the bj_pst */

   bj_pst.n_entries_used = bj_pst.n_entries_used + 1;
   bj_pst.highest_ix_used = max (bj_ix, bj_pst.highest_ix_used);


/* Store the pathname of the journal in the pathname table to be	*/
/* available if the system crashes -  This table is implemented as a	*/
/* parallel table to the bj_pst array. The pathname is stored  in	*/
/* entry "bj_ix". The pathname is stored first, the bj_uid last. The	*/
/* pathname and the bj_uid have been provided as input arguments to	*/
/* bj_pste_create.						*/

   bj_pn_table_ptr = ptr (bj_pst_ptr, bj_pst.pn_table_offset);

   bj_pn_table (bj_ix).bj_uid = "0"b;
   bj_pn_table (bj_ix).dir = p_bj_dir;
   bj_pn_table (bj_ix).entry = p_bj_entry;
   bj_pn_table (bj_ix).bj_uid = p_bj_uid;


/* Page Control must be called now to flush those pages holding the	*/
/* bj_pn_table, so that the table can be safe before one starts	*/
/* using the journal.					*/

   call bj_flush_pnt ();


/* Check the process in as a user of the before journal being opened.	*/
/* This consists of adding the process id to the list of processes	*/
/* that have open this journal. This list is maintained in addition	*/
/* to the count of processes that have open the journal. The list is	*/
/* more reliable that the count because if a process dies it may not	*/
/* have time to decrease the count. With the list, one can detect	*/
/* that a process id in the list belongs to a process that no longer	*/
/* exists, and remove it from the list. A journal cannot be		*/
/* "deactivated", i.e., its pste cannot be removed until this list is	*/
/* empty.							*/

   call bj_pste_register$check_in (bj_pste_ptr);
%page;
/* Now, set the version number in the pste, indicating the bj_pste	*/
/* is completely initialized.					*/

   bj_pste.version = BJ_PSTE_VERSION_2;


/* Finally update the bj_header in CI zero to show that the journal	*/
/* is "active". But do it only if the journal was not found open	*/
/* after a crash.						*/

   if bj_header.active = "0"b then
UPDATE_BJ_HEADER:
      do;
      call bj_ci_zero$put_header (p_bj_file_oid, bj_pste_ptr, size (bj_pste));
      call cu_$level_set ((current_ring));
      call file_manager_$flush_consecutive_ci (p_bj_file_oid, 0, 1, code);
      call cu_$level_set (saved_level);

      if code ^= 0 then
         call ERROR_RETURN (code);
   end UPDATE_BJ_HEADER;


/* Return the bj_pste_ptr to the caller */

   return (bj_pste_ptr);
%page;
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call bj_report_err (er_p_code, ME);			/* does not return */
   end ERROR_RETURN;
%skip (4);
ALLOC_BUFFER:
   proc (ab_p_bj_pste_index) returns (fixed bin (18) uns);

dcl  ab_p_bj_pste_index		fixed bin parameter;

/* Calculates and returns the offset of the buffer reserved for pste	*/
/* number ab_p_bj_pste_index.					*/

   return (bj_pst.buffer_table_offset + (ab_p_bj_pste_index - 1) * 1024);

   end ALLOC_BUFFER;
%skip (4);
INIT_BUFFER:
   proc (ib_p_bj_buffer_ptr);				/* Convention with bj_storage */

dcl  ib_p_bj_buffer_ptr		ptr parameter;

   bj_ci_ptr = ib_p_bj_buffer_ptr;

   unspec (bj_ci.header1) = "0"b;
   unspec (bj_ci.header2) = "0"b;

   bj_ci.header1.stamp.bj_idx = bj_ix;
   bj_ci.header1.id.uid = p_bj_uid;
   bj_ci.header1.id.num = bj_pste.last_ci_buffered;

   bj_ci.header2.layout_type = CI_LAYOUT_BJ;		/* Declared in dm_ci_header.incl.pl1 */

   return;

   end INIT_BUFFER;
%page;
CHECK_HEADER:
   proc ();

/* format: off */
	if bj_header.version       ^= BJ_PSTE_VERSION_2
	 | bj_header.bj_uid        ^= p_bj_uid
	 | bj_header.ci_size       ^= 4096
	 | bj_header.max_size      <= 0
	 | bj_header.cl.lowest_ci  ^= 1
	 | bj_header.cl.highest_ci ^= bj_header.max_size - 1
	 | bj_header.cl.number_ci  ^= bj_header.max_size - 1
	 | bj_header.cl.origin_ci  <  bj_header.cl.lowest_ci
	 | bj_header.cl.origin_ci  >  bj_header.cl.highest_ci

	then call ERROR_RETURN (dm_error_$bj_bad_header);
/* format: on */

   if bj_header.active = "1"b then do;
      if entry_name = BJ_PSTE_CREATE then
         call ERROR_RETURN (dm_error_$bj_needed_for_recovery);
      if entry_name = BJ_PSTE_CREATE_FOR_RECOVERY then
         ;
      if entry_name = BJ_PSTE_CREATE_FORCE then
         bj_header.active = "0"b;
   end;

   return;

   end CHECK_HEADER;
%page;
FIND_LAST_CI:
   proc returns (fixed bin (24) uns);

dcl  (
     flc_current			fixed bin (24) uns init (0),
     flc_current_is_last		bit (1) aligned init (""b),
     flc_last			fixed bin (24) uns init (0),
     flc_next			fixed bin (24) uns init (0),
     flc_time_current		fixed bin (71) init (0),
     flc_time_next			fixed bin (71) init (0)
     )				automatic;


   flc_current = bj_pste.cl.origin_ci;
   flc_time_current = TIME_STAMP (flc_current);
   flc_current_is_last = "0"b;

SEARCH_FROM_ORIGIN:
   do while (^flc_current_is_last);

      if flc_current < bj_pste.cl.highest_ci then
         flc_next = flc_current + 1;
      else flc_next = bj_pste.cl.lowest_ci;

      flc_time_next = TIME_STAMP (flc_next);

      if flc_time_next < flc_time_current then
         flc_current_is_last = "1"b;
      else do;
         flc_current = flc_next;
         flc_time_current = flc_time_next;
      end;
   end SEARCH_FROM_ORIGIN;

   flc_last = flc_current;

   return (flc_last);

   end FIND_LAST_CI;
%page;
FIND_LAST_RECORD:
   proc (flr_p_number_of_txn) returns (bit (36) aligned);

/* Note: flr_p_number_of_txn is an output parameter even though this	*/
/* is a function procedure;  it is the number of txn in progress at	*/
/* the time the last record was written.			*/

dcl  flr_p_number_of_txn		fixed bin parameter;

dcl  (
     1 flr_my_rec_hdr		like bj_rec_hdr aligned,
     flr_last_rec_id		bit (36) aligned
     )				automatic;

   unspec (flr_my_rec_hdr) = "0"b;

   flr_last_rec_id =
        bj_storage_get_header$find_last_record (p_bj_file_oid, bj_pste_ptr,
        addr (flr_my_rec_hdr));

   if flr_last_rec_id ^= "0"b then
      flr_p_number_of_txn = flr_my_rec_hdr.n_txn;
   else flr_p_number_of_txn = 0;

   return (flr_last_rec_id);

   end FIND_LAST_RECORD;
%skip (4);
TIME_STAMP:
   proc (ts_p_ci_no) returns (fixed bin (71));

dcl  ts_p_ci_no			fixed bin (24) uns parameter;

dcl  (
     ts_my_ci			fixed bin (27),
     ts_time_stamp			fixed bin (71),
     1 ts_my_ci_header		like ci_header aligned
     )				automatic;


   ts_my_ci_header.stamp.version = CI_HEADER_STAMP_VERSION_1;
   ts_my_ci = ts_p_ci_no;

   call cu_$level_set ((current_ring));
   call file_manager_$get_ci_header (p_bj_file_oid, ts_my_ci, ts_my_ci_header,
        code);
   call cu_$level_set (saved_level);

   if code ^= 0 then
      call ERROR_RETURN (code);

   ts_time_stamp = ts_my_ci_header.stamp.time_modified;


   return (ts_time_stamp);

   end TIME_STAMP;
%page;
WRITE_START_UP_RECORD:
   proc ();

dcl  (
     wsur_last_ci			fixed bin (24) uns init (0),
     wsur_last_rec_id		bit (36) aligned init (""b),
     wsur_nb_txn			fixed bin
     )				automatic;

dcl  1 wsur_str_rec_id		aligned automatic,
       2 ci_no			fixed bin (24) uns unal,
       2 sl_no			fixed bin (12) uns unal;


   bj_ci.header1.id.num = bj_pste.cl.lowest_ci;

   bj_ci.slot (1).length = 20;			/* Arbitrary number of bytes */
   bj_ci.slot (1).offset =
        bj_pste.ci_size - 4 * (size (ci_header) + size (ci_trailer)) - 20;

   wsur_str_rec_id.ci_no = bj_pste.cl.highest_ci;
   wsur_str_rec_id.sl_no = 1;

   bj_ci.header2.first_rec_id = unspec (wsur_str_rec_id);
   bj_ci.header2.last_is_contd = "0"b;
   bj_ci.header2.first_is_contn = "1"b;
   bj_ci.header2.n_slots = 1;

   call bj_storage_put_buffered_ci (p_bj_file_oid, bj_pste_ptr);

   call cu_$level_set ((current_ring));
   call file_manager_$flush_consecutive_ci (p_bj_file_oid,
        (bj_pste.cl.lowest_ci), 1, code);
   call cu_$level_set (saved_level);

   if code ^= 0 then
      call ERROR_RETURN (code);


/* Double check that FIND_LAST_CI and FIND_LAST_RECORD would find	*/
/* no record in the journal.					*/

   wsur_last_ci = FIND_LAST_CI ();
   wsur_last_rec_id = FIND_LAST_RECORD (wsur_nb_txn);

   if wsur_last_ci ^= bj_pste.last_ci_on_disk
        | wsur_last_rec_id ^= bj_pste.last_rec_id
        | wsur_nb_txn ^= bj_pste.n_txn then
      call ERROR_RETURN (dm_error_$bj_logic_err);

   return;
   end WRITE_START_UP_RECORD;

%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_header;
%page;
%include dm_bj_pn_table;
%page;
%include dm_bj_ci;
%page;
%include dm_ci_header;
%page;
%include dm_ci_layout_types;
%page;
%include dm_bj_records;


   end bj_pste_create;




		    bj_pste_delete.pl1              05/17/85  1651.2re  05/17/85  1328.6      100872



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

/* DESCRIPTION:

	bj_pste_delete handles all removal of a before journal from the
     BJ_PST.  This is only done when no user on the system is using the
     journal to be removed.  It is assumed the BJ_PST is locked to this
     process.
*/

/* HISTORY:
Written by A. Bensoussan, 03/23/83.
Modified:
04/06/83 by A. Bensoussan:  added the entry point $after_recovery.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
12/05/84 by M. Sharpe:  to correct format and dcls; to use ERROR_RETURN;
	  to set/reset validation level around calls to file_manager_.
02/14/85 by Lee A. Newcomb:  Added a description to that section; changed
            ERROR_RETURN to be an int proc and added CHECK_VERSION_NUMERIC
            proc; deleted the unused $adjust entry as there was no difference
            with the main entry; FIXED to check several structure versions not
            previously tested; minor format fixes.
02/28/85 by Lee A. Newcomb:  Initialized myname to an indicator of invalidity.
            Fixed to set dm_error_$bj_bad_pste_idx, not *_index.
03/05/85 by Steve Herbst: Replaced dm_log_ with dm_misc_util_$log.
04/05/85 by Lee A. Newcomb:  Fixed to not call dm_pste_register$check_out_dead
            during recovery.
05/10/85 by R. Michael Tague:  Changed bj_uid check by reference to 
            dm_journal_seg to a call to dm_hcs_$validate_bj_uid instead.
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bj_pste_delete:
   proc (p_bj_pste_ptr);

/* DECLARATIONS */

/* Parameter */
dcl  p_bj_pste_ptr			ptr parameter;

/* Automatic */
dcl  (
     dir_name			char (168),
     entry_name			char (32),
     file_not_found			bit (1) init ("1"b),
     bj_ix			fixed bin init (0),
     bj_uid			bit (36) aligned init (""b),
     code				fixed bin (35) init (0),
     my_access_class		bit (72) aligned init (""b),
     myname			char (32)
				init (BJ_PSTE_DELETE_MYNAME_NOT_SET),
     pf_oid			bit (36) aligned init (""b),
     close_after_recovery		bit (1) init (""b),
     n_processes			fixed bin init (-1),
     n_txns			fixed bin init (-1),
     saved_level			fixed bin init (-1),
     current_ring			fixed bin (3) init (-1),
     1 my_header			like bj_header
     )				automatic;

/* Based */
/* Builtin */
dcl  (addr, hbound, lbound, ptr, size, unspec)
				builtin;

/* Condtion */
dcl  cleanup			condition;

/* Constant */
dcl  (
     BJ_PSTE_DELETE			char (32) init ("bj_pste_delete"),
     BJ_PSTE_DELETE_AFTER_RECOVERY	char (32)
				init ("bj_pste_delete$after_recovery"),
     BJ_PSTE_DELETE_MYNAME_NOT_SET	char (32)
				init ("bj_pste_delete myname not set")
     )				internal static options (constant);

/* Entry */
dcl  (
     bj_ci_zero$get_bj_uid		entry (bit (36) aligned)
				returns (bit (36) aligned),
     bj_ci_zero$put_header		entry (bit (36) aligned, ptr,
				fixed bin),
     bj_flush_pnt			entry (),
     bj_pste_register$check_out_dead	entry (ptr, bit (36) aligned),
     cu_$level_get			entry (fixed bin),
     cu_$level_set			entry (fixed bin),
     dm_hcs_$free_journal		entry (fixed bin, fixed bin (35)),
     dm_hcs_$validate_bj_uid		entry (bit (36) aligned, fixed bin)
				returns (bit (1) aligned),
     dm_misc_util_$log		entry options (variable),
     file_manager_$close		entry (bit (36) aligned,
				fixed bin (35)),
     file_manager_$flush_consecutive_ci entry (bit (36) aligned,
				fixed bin (24) uns, fixed bin (24) uns,
				fixed bin (35)),
     file_manager_$open		entry (char (*), char (*),
				bit (36) aligned, fixed bin (35)),
     get_authorization_		entry returns (bit (72) aligned),
     get_ring_			entry () returns (fixed bin (3))
     )				external;

/* External */
dcl  (
     bjm_data_$bj_pst_ptr		ptr,
     dm_data_$bj_txt_ptr		ptr,
     (
     dm_error_$bj_bad_pst_version,
     dm_error_$bj_bad_pste_idx,
     dm_error_$bj_bad_pste_ptr,
     dm_error_$bj_bad_pste_version,
     dm_error_$bj_bad_txt_version,
     dm_error_$bj_logic_err,
     dm_error_$bj_uids_dont_agree
     )				fixed bin (35)
     )				external static;

/* Static */

/* END OF DECLARATIONS */
%page;
/* bj_pste_delete:			repeat for reader	*/
/*      proc (p_bj_pste_ptr);				*/

   myname = BJ_PSTE_DELETE;
   close_after_recovery = "0"b;
   goto COMMON;


bj_pste_delete$after_recovery:
   entry (p_bj_pste_ptr);

   myname = BJ_PSTE_DELETE_AFTER_RECOVERY;
   close_after_recovery = "1"b;
   goto COMMON;


COMMON:
   bj_pste_ptr = p_bj_pste_ptr;
   call CHECK_VERSION_NUMERIC (bj_pste.version, BJ_PSTE_VERSION_2,
        dm_error_$bj_bad_pste_version);
   bj_pst_ptr = bjm_data_$bj_pst_ptr;
   call CHECK_VERSION_NUMERIC (bj_pst.version, BJ_PST_VERSION_1,
        dm_error_$bj_bad_pst_version);
   bj_txt_ptr = dm_data_$bj_txt_ptr;
   call CHECK_VERSION_NUMERIC (bj_txt.version, BJ_TXT_VERSION_1,
        dm_error_$bj_bad_txt_version);
   bj_pn_table_ptr = ptr (bj_pst_ptr, bj_pst.pn_table_offset);
						/* no version */

   bj_ix = bj_pste.bj_ix;
   my_access_class = get_authorization_ ();

   current_ring = get_ring_ ();
   call cu_$level_get (saved_level);
   on cleanup call cu_$level_set (saved_level);


   if bj_ix < 1 | bj_ix > bj_pst.max_n_entries then
      call ERROR_RETURN (dm_error_$bj_bad_pste_idx);

   if bj_pste_ptr ^= addr (bj_pst.e (bj_ix)) then
      call ERROR_RETURN (dm_error_$bj_bad_pste_ptr);

   if ^dm_hcs_$validate_bj_uid (bj_pste.bj_uid, bj_ix) then
      call ERROR_RETURN (dm_error_$bj_uids_dont_agree);

%page;
   if ^close_after_recovery then			/* normal operation */
      call bj_pste_register$check_out_dead (bj_pste_ptr, (36)"0"b);

   n_processes = bj_pste.n_processes;
   n_txns = N_TXNS ();

   pf_oid = OPEN_FILE (file_not_found);

   if pf_oid = "0"b & file_not_found & n_processes = 0 & n_txns = 0 then do;
      call FREE_PSTE ();
      call FREE_HCSE ();
      call dm_misc_util_$log (LOG_SV, 0, myname,
	 "Journal ^a>^a was not found.", dir_name, entry_name);
   end;

   if pf_oid = "0"b & file_not_found = "0"b then
      call dm_misc_util_$log (LOG_SV, 0, myname,
	 "Journal ^a>^a could not be opened by fm.", dir_name, entry_name);

   if pf_oid ^= "0"b & n_processes = 0 & n_txns = 0 then do;
      call UPDATE_HEADER ("0"b);
      call FREE_PSTE ();
      call FREE_HCSE ();
   end;

   if pf_oid ^= "0"b & n_processes = 0 & n_txns > 0 & close_after_recovery
   then do;
      call UPDATE_HEADER ("1"b);
      call FREE_PSTE ();
      call FREE_HCSE ();
   end;

   if pf_oid ^= "0"b then do;
      call cu_$level_set ((current_ring));
      call file_manager_$close (pf_oid, code);
      call cu_$level_set (saved_level);
      if code ^= 0 then
         call dm_misc_util_$log (LOG_SV, code, myname,
	    " code returned by fm_$close");
   end;

/* end bj_pste_delete; */
%page;
MAIN_RETURN:
   return;
%skip (4);
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call dm_misc_util_$log (LOG_SV, er_p_code, myname);

   goto MAIN_RETURN;

   end ERROR_RETURN;
%skip (4);
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_correct_version, cvn_p_error_to_use);

/* The error code to use is passed since we use this to check several	*/
/* structures with numeric versions.  It is hoped newer versions of	*/
/* these structures will be changed to use char (8) versions.	*/

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_correct_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_correct_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%page;
UPDATE_HEADER:
   proc (active_sw);

dcl  active_sw			bit (1);
dcl  code				fixed bin (35);

   my_header = bj_pste;
   my_header.active = active_sw;

   call bj_ci_zero$put_header (pf_oid, addr (my_header), size (my_header));
   call cu_$level_set ((current_ring));
   call file_manager_$flush_consecutive_ci (pf_oid, 0, 1, code);
   call cu_$level_set (saved_level);
   if code ^= 0 then
      call dm_misc_util_$log (LOG_SV, code, myname, "UPDATE_HEADER");

   return;
   end UPDATE_HEADER;



FREE_PSTE:
   proc ();

dcl  highest_idx			fixed bin;

   bj_pste.version = 0;

   bj_pst.n_entries_used = bj_pst.n_entries_used - 1;

   if bj_pst.highest_ix_used = bj_ix then
      do highest_idx = bj_ix by -1 to 1
	 while (bj_pst.e (highest_idx).version = 0);
         bj_pst.highest_ix_used = highest_idx - 1;
      end;


   bj_pn_table (bj_ix).bj_uid = "0"b;
   bj_pn_table (bj_ix).entry = "";
   bj_pn_table (bj_ix).dir = "";

   unspec (bj_pste) = "0"b;
   bj_pste.bj_ix = bj_ix;
   bj_pste.append_state.current_operation = "";

   call bj_flush_pnt ();

   return;
   end FREE_PSTE;





FREE_HCSE:
   proc ();

dcl  code				fixed bin (35);

   call dm_hcs_$free_journal ((bj_ix), code);		/* bj_ix passed by value because bug in dm_hcs_ */
   if code ^= 0 then
      call dm_misc_util_$log (LOG_SV, code, myname, "FREE_HCSE");

   return;
   end FREE_HCSE;
%page;
OPEN_FILE:
   proc (deleted_sw) returns (bit (36) aligned);

dcl  deleted_sw			bit (1);

dcl  file_oid			bit (36) aligned;
dcl  ec				fixed bin (35);

dcl  error_table_$noentry		fixed bin (35) ext;
dcl  error_table_$no_dir		fixed bin (35) ext;



   deleted_sw = "0"b;
   ec = 0;

   dir_name = bj_pn_table (bj_ix).dir;
   entry_name = bj_pn_table (bj_ix).entry;
   bj_uid = bj_pn_table (bj_ix).bj_uid;


   call cu_$level_set ((current_ring));
   call file_manager_$open (dir_name, entry_name, file_oid, ec);
   call cu_$level_set (saved_level);

   if file_oid = "0"b then
      if ec = error_table_$noentry | ec = error_table_$no_dir
						/* no_dir and noaccess have same value */
	 then
         deleted_sw = "1"b;
      else ;

   else if bj_uid ^= bj_ci_zero$get_bj_uid (file_oid) then do;
      call cu_$level_set ((current_ring));
      call file_manager_$close (file_oid, ec);
      call cu_$level_set (saved_level);
      deleted_sw = "1"b;
      file_oid = (36)"0"b;
   end;

   else ;

   return (file_oid);

   end OPEN_FILE;
%page;
N_TXNS:
   proc returns (fixed bin);

dcl  bj_uid			bit (36) aligned;
dcl  n_trans			fixed bin;
dcl  entry_idx			fixed bin;



   bj_uid = bj_pste.bj_uid;
   n_trans = 0;


   do entry_idx = lbound (bj_txt.entry, 1) to hbound (bj_txt.entry, 1);

      bj_txte_ptr = addr (bj_txt.entry (entry_idx));

      if bj_txte.tid ^= "0"b then
         if bj_txte.bj_uid = bj_uid then
	  if bj_txte.last_completed_operation ^= COMMITTED then
	     if bj_txte.last_completed_operation ^= ABORTED then
	        n_trans = n_trans + 1;

   end;


   return (n_trans);


   end N_TXNS;


%page;
%include dm_bj_pst;

%page;
%include dm_bj_pste;

%page;
%include dm_bj_pn_table;

%page;
%include dm_bj_header;

%page;
%include dm_log_sv_codes;

%page;
%include dm_bj_txt;

%page;
%include dm_bj_records;


   end bj_pste_delete;




		    bj_pste_lock.pl1                05/17/85  1651.2re  05/17/85  1328.6       84087



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

/* DESCRIPTION:

	This module, bj_pste_lock, manages the lock on an individual
     entry in the BJ_PST.  There are four entries:  $lock,
     $lock_partial_check, $unlock, and $unlock_cleanup.  $lock requires the
     PSTE to be valid.  $lock_partial_check is used in reocvery from a
     crash and the PSTE version may not have been filled in yet.  $unlock
     and $unlock_cleanup do not check the PSTE version by design, but
     require the process_id in the lock word and the calling process to be
     the same;  the only difference is $unlock causes an error and
     $unlock_cleanup will only log an error.

     NOTE:
     The PST does not have to be locked to lock a PSTE.  See bj_pst_lock
     for the cases wehere the PST is locked.  We lock a PSTE when doing a
     read or write operation on the BJ, or when synchronizing the PSTE with
     the associated TXTE.
*/

/* HISTORY:
Written by A. Bensoussan, 02/23/83.
Modified:
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/07/84 by Lee Baldwin:  Renamed dm_error_$bj_bad_pste_ix to bj_bad_pste_idx.
11/02/84 by Maggie Sharpe:  To use "call ERROR_RETURN (code)" method of error
            handling; clean up dcls and format; use the constant APPE instead
            of the literal "appe" in several place.
02/14/85 by Lee A. Newcomb:  Fixed to use the new BJ_PSTE_VERSION_2 constant;
            removed the unused entry bj_pste_lock$; added the
            CHECK_VERSION_NUMERIC proc; changed so each entry would use its
            full name in calls to bj_report_err.
02/28/85 by Lee A. Newcomb:  Fixed to always check the PSTE version in $lock;
            reverted to NOT check the PSTE version in the unlock entries;
            initialized myname to an indicator of invalidity; added to the
            description to help readers.
03/05/85 by Steve Herbst: Replaced dm_log_ with dm_misc_util_$log.
05/10/85 by R. Michael Tague:  Replaced explicit reference to dm_journal_seg
            will a call to dm_hcs_$validate_bj_uid.
*/
/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bj_pste_lock$lock:
   proc (p_bj_pste_ptr, p_bj_uid);

/* DECLARATIONS */
/* Parameter */
dcl  (
     p_bj_pste_ptr			ptr,		/* Input */
     p_bj_uid			bit (36) aligned	/* Input - If null dont check uid */
     )				parameter;

/* Automatic */
dcl  (
     code				fixed bin (35) init (0),
     myname			char (32)
				init (BJ_PSTE_LOCK_MYNAME_NOT_SET)
     )				automatic;

/* Based */
/* Builtin */
dcl  addr				builtin;

/* Condition */
/* Constant */
dcl  (
     APPE				char (4) init ("appe"),
     BJ_PSTE_LOCK			char (32) init ("bj_pste_lock$lock"),
     BJ_PSTE_LOCK_MYNAME_NOT_SET	char (32)
				init ("bj_pste_lock myname not set"),
     BJ_PSTE_LOCK_UNLOCK		char (32) init ("bj_pste_lock$unlock"),
     BJ_PSTE_LOCK_UNLOCK_CLEANUP	char (32)
				init ("bj_pste_lock$unlock_cleanup"),
     BJ_PSTE_LOCK_PARTIAL_CHECK	char (32)
				init (
				"bj_pste_lock$lock_partial_check")
     )				internal static options (constant);

/* Entry */
dcl  (
     bj_report_err			entry (fixed bin (35), char (*)),
     bj_storage_append$adjust		entry (ptr),
     dm_hcs_$validate_bj_uid		entry (bit (36) aligned, fixed bin) returns (bit (1) aligned),
     dm_misc_util_$log		entry () options (variable),
     get_process_id_		entry returns (bit (36) aligned),
     lock_manager_$lock_fast		entry (ptr, fixed bin (71),
				fixed bin (35)),
     lock_manager_$unlock_fast	entry (ptr, fixed bin (35))
     )				external;

/* External */
dcl  (
     bjm_data_$bj_pst_ptr		ptr,
     bjm_data_$lock_manager_timeout	fixed bin (71),
     (
     dm_error_$bj_bad_pst_version,
     dm_error_$bj_bad_pste_idx,
     dm_error_$bj_bad_pste_ptr,
     dm_error_$bj_bad_pste_version,
     dm_error_$bj_uids_dont_agree,
     dm_error_$bj_uids_dont_match,
     dm_error_$fast_lock_invalid_reset
     )				fixed bin (35)
     )				external static;

/* Static */

/* END OF DECLARATIONS */
%page;
/* bj_pste_lock$lock:			repeat for reader	*/
/*      proc (p_bj_pste_ptr, p_bj_uid);				*/

   myname = BJ_PSTE_LOCK;
   bj_pst_ptr = bjm_data_$bj_pst_ptr;
   call CHECK_VERSION_NUMERIC (bj_pst.version, BJ_PST_VERSION_1,
        dm_error_$bj_bad_pst_version);

   bj_pste_ptr = p_bj_pste_ptr;
   call CHECK_VERSION_NUMERIC (bj_pste.version, BJ_PSTE_VERSION_2,
        dm_error_$bj_bad_pste_version);

   if bj_pste.bj_ix < 1 | bj_pste.bj_ix > bj_pst.max_n_entries then
      call ERROR_RETURN (dm_error_$bj_bad_pste_idx);

   if bj_pste_ptr ^= addr (bj_pst.e (bj_pste.bj_ix)) then
      call ERROR_RETURN (dm_error_$bj_bad_pste_ptr);

   call lock_manager_$lock_fast (addr (bj_pste.lock),
        bjm_data_$lock_manager_timeout, code);

   if code ^= 0 & code ^= dm_error_$fast_lock_invalid_reset then
      call ERROR_RETURN (code);

/* We recheck the PSTE version in case another process	*/
/* deleted it between the time we checked the version and	*/
/* got the lock.					*/
   call CHECK_VERSION_NUMERIC (bj_pste.version, BJ_PSTE_VERSION_2,
        dm_error_$bj_bad_pste_version);

   if bj_pste.bj_uid ^= p_bj_uid then
      call ERROR_RETURN (dm_error_$bj_uids_dont_match);

   if ^dm_hcs_$validate_bj_uid (bj_pste.bj_uid, bj_pste.bj_ix) then
      call ERROR_RETURN (dm_error_$bj_uids_dont_agree);

   if bj_pste.append_state.current_operation = APPE then
      call bj_storage_append$adjust (bj_pste_ptr);

   go to MAIN_RETURN;

/* end bj_pste_lock$lock; */
%page;
bj_pste_lock$unlock:
   entry (p_bj_pste_ptr);

   myname = BJ_PSTE_LOCK_UNLOCK;
   bj_pste_ptr = p_bj_pste_ptr;

   if bj_pste.append_state.current_operation = APPE then
      if bj_pste.lock.pid = get_process_id_ () then
         call bj_storage_append$adjust (bj_pste_ptr);

   call lock_manager_$unlock_fast (addr (bj_pste.lock), code);
   if code ^= 0 then
      call ERROR_RETURN (code);

   go to MAIN_RETURN;

/* end bj_pste_lock$unlock; */
%skip (4);
bj_pste_lock$unlock_cleanup:
   entry (p_bj_pste_ptr);

   myname = BJ_PSTE_LOCK_UNLOCK_CLEANUP;
   bj_pste_ptr = p_bj_pste_ptr;

   if bj_pste.append_state.current_operation = APPE then
      if bj_pste.lock.pid = get_process_id_ () then
         call bj_storage_append$adjust (bj_pste_ptr);

   call lock_manager_$unlock_fast (addr (bj_pste.lock), code);

   if code ^= 0 then
      call dm_misc_util_$log (LOG_SV, code, myname, "while unlocking bj_pste");

   go to MAIN_RETURN;

/* end bj_pste_lock$unlock_cleanup; */
%page;
bj_pste_lock$lock_partial_check:
   entry (p_bj_pste_ptr);

   myname = BJ_PSTE_LOCK_PARTIAL_CHECK;
   bj_pst_ptr = bjm_data_$bj_pst_ptr;
   call CHECK_VERSION_NUMERIC (bj_pst.version, BJ_PST_VERSION_1,
        dm_error_$bj_bad_pst_version);
   bj_pste_ptr = p_bj_pste_ptr;
   if bj_pste.version ^= 0 then			/* may be a PSTE */
      call CHECK_VERSION_NUMERIC (bj_pste.version, BJ_PSTE_VERSION_2,
	 dm_error_$bj_bad_pste_version);

   if bj_pste.bj_ix < 1 | bj_pste.bj_ix > bj_pst.max_n_entries then
      call ERROR_RETURN (dm_error_$bj_bad_pste_idx);

   if bj_pste_ptr ^= addr (bj_pst.e (bj_pste.bj_ix)) then
      call ERROR_RETURN (dm_error_$bj_bad_pste_ptr);

   call lock_manager_$lock_fast (addr (bj_pste.lock),
        bjm_data_$lock_manager_timeout, code);

   if code ^= 0 & code ^= dm_error_$fast_lock_invalid_reset then
      call ERROR_RETURN (code);

/* We recheck the PSTE version in case another process	*/
/* deleted it between the time we checked the version and	*/
/* got the lock.					*/
   if bj_pste.version ^= 0 then			/* fully in use entry */
      call CHECK_VERSION_NUMERIC (bj_pste.version, BJ_PSTE_VERSION_2,
	 dm_error_$bj_bad_pste_version);

   if ^dm_hcs_$validate_bj_uid (bj_pste.bj_uid, bj_pste.bj_ix) then
      call ERROR_RETURN (dm_error_$bj_uids_dont_agree);

   if bj_pste.append_state.current_operation = APPE then
      if bj_pste.version ^= 0 then
         call bj_storage_append$adjust (bj_pste_ptr);

   go to MAIN_RETURN;

/* end bj_pste_lock$lock_partial_check; */
%page;
MAIN_RETURN:
   return;
%skip (4);
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35);

   call bj_report_err (er_p_code, myname);		/* does not return */
   goto MAIN_RETURN;				/* but better safe than sorry */
   end ERROR_RETURN;
%skip (4);
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_correct_version, cvn_p_error_to_use);

/* The error code to use is passed since we use this to check several	*/
/* structures with numeric versions.  It is hoped newer versions of	*/
/* these structures will be changed to use char (8) versions.	*/

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_correct_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_correct_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_log_sv_codes;


   end bj_pste_lock$lock;




		    bj_pste_register.pl1            04/04/85  1117.3re  04/04/85  0826.1      127323



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

/* DESCRIPTION:

	bj_pste_register -  Procedure with three entry points to
     associate a process with a per-system table entry.  The entry points
     are "check_in", "check_out", and "check_out_dead" which create and
     delete association information.  The two main functions of these
     operations are to register the procedure in the per-system table
     check-in-table, and to update the PSTE cell "n_processes".

     NOTE: (bj_pste.version = 0) means that pste is not in use.

     ASSUMPTIONS ABOUT ENVIRONMENT:
      1) the before journal PST is already locked for one writer only.
      2) the process executing this code may not be able to successfuly
         complete this procedure.
*/

/* HISTORY:
Written by Mike Pandolf, 06/28/82.
Modified:
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/07/84 by Lee Baldwin:  Renamed dm_error_$bj_(pst pste)_version_bad
            to bj_bad_(pst pste)_version.
11/12/84 by M. Sharpe:  to correct format and dcls; to use ERROR_RETURN
	  technology; to remove the unused entrypoint bj_pste_register;
	  to change "if pix ^= 0..." ~line 306 to "if pix = 0...".
02/18/85 by Lee A. Newcomb:  Fixed to use the new BJ_PSTE_VERSION_2 constant;
            added the CHECK_VERSION_NUMERIC proc; changed each entry to use
            its full name in calls to bj_report_err; turned formatting on for
            the procedure; removed all mention of the never-implemented "undo"
	  functionality; standardized int process variable names.
02/28/85 by Lee A. Newcomb:  Added journalization comment for previous
            changes; initialized myname to an indicator of an invalid entry.
*/
/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bj_pste_register$check_in:
   proc (p_bj_pste_ptr);

/* DECLARATIONS */

/* Parameter */
dcl  (
     p_bj_pste_ptr			ptr,		/* PSTE to which we are to "attach" */
     p_process_id			bit (36) aligned
     )				parameter;

/* Automatic */
dcl  (
     code				fixed bin (35) init (0),
						/* status code we use to verify subroutine calls */
     my_process_id			bit (36) init (""b),/* used to compare against check_in_table entries */
     have_process_ix		bit (1) aligned,	/* "1"b => found check_in_table entry with our process_id */
     first_free_process_ix		fixed bin (17) init (0),
						/* index of empty check_in_table entry that we will use */
     this_process_ix		fixed bin (17) init (0),
						/* do loop variable; index into check_in_table */
     max_n_processes		fixed bin init (0),
     max_n_journals			fixed bin init (0),
     myname			char (32)
				init (BJ_PSTE_REGISTER_MYNAME_NOT_SET)
     )				automatic;

/* Based */
/* Builtin */
dcl  (null, ptr)			builtin;

/* Condition */
/* Constants */
dcl  (
     BJ_PSTE_REGISTER_CHECK_IN	char (32)
				init ("bj_pste_register$check_in"),
     BJ_PSTE_REGISTER_CHECK_OUT	char (32)
				init ("bj_pste_register$check_out"),
     BJ_PSTE_REGISTER_CHECK_OUT_DEAD	char (32)
				init (
				"bj_pste_register$check_out_dead"),
     BJ_PSTE_REGISTER_MYNAME_NOT_SET	char (32)
				init (
				"bj_pste_register myname not set")
     )				internal static options (constant);

/* Entry */
dcl  (
     bj_report_err			entry (fixed bin (35), char (*)),
     get_process_id_		entry () returns (bit (36)),
     hcs_$validate_processid		entry (bit (36) aligned,
				fixed bin (35))
     )				external;

/* External */
dcl  (
     bjm_data_$bj_pst_ptr		ptr,
     (
     dm_error_$bj_bad_pst_version,
     dm_error_$bj_bad_pste_version,
     dm_error_$bj_pst_cit_full
     )				fixed bin (35)
     )				external;

/* Static */
dcl  process_ix			fixed bin init (-1) internal static;

/* END OF DECLARATIONS */
%page;
/* bj_pste_register$check_in:			repeat for reader	*/
/*      proc (p_bj_pste_ptr);					*/

   myname = BJ_PSTE_REGISTER_CHECK_IN;
   bj_pste_ptr = p_bj_pste_ptr;
   if bj_pste.version ^= 0 then			/* will be 0 for first user of PSTE */
      call CHECK_VERSION_NUMERIC (bj_pste.version, BJ_PSTE_VERSION_2,
	 dm_error_$bj_bad_pste_version);

   call SET_PTRS ();

   if process_ix = -1 then				/* must get an index */
      process_ix = GET_PROCESS_IX ();

   if bj_check_in_table.cross_proc_bj (process_ix, bj_pste.bj_ix) = "0"b
   then do;
      bj_pste.n_processes = bj_pste.n_processes + 1;
      bj_check_in_table.cross_proc_bj (process_ix, bj_pste.bj_ix) = "1"b;
   end;

   go to MAIN_RETURN;

/* end bj_pste_register$check_in; */
%skip (4);
bj_pste_register$check_out:
   entry (p_bj_pste_ptr);

   myname = BJ_PSTE_REGISTER_CHECK_OUT;

   if process_ix = -1 then
      ;						/* process not in check in table */
   else do;
      bj_pste_ptr = p_bj_pste_ptr;			/* version of zero ==> not in use */
      if bj_pste.version ^= 0 then do;
         call CHECK_VERSION_NUMERIC (bj_pste.version, BJ_PSTE_VERSION_2,
	    dm_error_$bj_bad_pste_version);

         call SET_PTRS ();

         call CHECK_OUT (process_ix, bj_pste.bj_ix);
      end;
   end;

   go to MAIN_RETURN;

/* end bj_pste_register$check_out; */
%page;
bj_pste_register$check_out_dead:
   entry (p_bj_pste_ptr, p_process_id);

   myname = BJ_PSTE_REGISTER_CHECK_OUT_DEAD;
   call SET_PTRS ();

   if p_bj_pste_ptr ^= null () then do;
      bj_pste_ptr = p_bj_pste_ptr;
      call CHECK_VERSION_NUMERIC (bj_pste.version, BJ_PSTE_VERSION_2,
	 dm_error_$bj_bad_pste_version);
      if p_process_id = "0"b then
         call CLEAN_ALL_DEAD_IN_ONE_BJ (bj_pste_ptr);
      else call CLEAN_ONE_DEAD_IN_ONE_BJ (bj_pste_ptr, p_process_id);
   end;
   else						/* p_bj_pste_ptr must be null */
        if p_process_id ^= "0"b then
      call CLEAN_ONE_DEAD_IN_ALL_BJ (p_process_id);
   else call CLEAN_ALL_DEAD_IN_ALL_BJ ();

   go to MAIN_RETURN;

/* end bj_pste_register$check_out_dead; */
%skip (4);
MAIN_RETURN:
   return;
%skip (4);
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35);

   call bj_report_err (er_p_code, myname);		/* does not return */

   end ERROR_RETURN;
%page;
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_correct_version, cvn_p_error_to_use);

/* The error code to use is passed since we use this to check several	*/
/* structures with numeric versions.  It is hoped newer versions of	*/
/* these structures will be changed to use char (8) versions.	*/

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_correct_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_correct_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%skip (4);
SET_PTRS:
   procedure ();

/* Get pointers to system tables and the max dimensions of them.	*/

   bj_pst_ptr = bjm_data_$bj_pst_ptr;
   call CHECK_VERSION_NUMERIC (bj_pst.version, BJ_PST_VERSION_1,
        dm_error_$bj_bad_pst_version);

   bj_check_in_table_ptr = ptr (bj_pst_ptr, bj_pst.check_in_table_offset);

   max_n_processes = dm_system_data_$bj_max_n_processes;
   max_n_journals = dm_system_data_$bj_max_n_journals;

   return;

   end SET_PTRS;
%page;
CHECK_OUT:
   proc (co_p_process_index, co_p_journal_index);

/* Remove the process as a user of the PSTE in the check in table,	*/
/* decrementing the count of the process' using the PSTE on the way.	*/

dcl  (
     co_p_process_index		fixed bin,	/* Input */
     co_p_journal_index		fixed bin		/* Input */
     )				parameter;

   if bj_check_in_table.cross_proc_bj (co_p_process_index, co_p_journal_index)
        = "1"b then do;				/* are using */
      bj_check_in_table
	 .cross_proc_bj (co_p_process_index, co_p_journal_index) = "0"b;
						/* now not using */
      bj_pst.e (co_p_journal_index).n_processes =
	 bj_pst.e (co_p_journal_index).n_processes - 1;
   end;

   return;

   end CHECK_OUT;
%page;
CLEAN_ALL_DEAD_IN_ONE_BJ:
   proc (cadiob_p_bj_pste_ptr);			/* Used by bj_close_oid */

dcl  cadiob_p_bj_pste_ptr		ptr parameter;

dcl  (
     (
     cadiob_journal_index		init (0),
     cadiob_number_of_live_processes	init (0),
     cadiob_process_index		init (0)
     )				fixed bin,
     cadiob_process_id		bit (36) aligned
     )				automatic;

   bj_pste_ptr = cadiob_p_bj_pste_ptr;

   cadiob_journal_index = bj_pste.bj_ix;

   do cadiob_process_index = 1 to max_n_processes;
      if bj_check_in_table
	 .cross_proc_bj (cadiob_process_index, cadiob_journal_index) then do;
         cadiob_process_id =
	    bj_check_in_table.process_id (cadiob_process_index);
         if PROCESS_IS_DEAD (cadiob_process_id) then
	  call CHECK_OUT (cadiob_process_index, cadiob_journal_index);
         else cadiob_number_of_live_processes =
	         cadiob_number_of_live_processes + 1;
      end;
   end;

   bj_pste.n_processes = cadiob_number_of_live_processes;

   return;

   end CLEAN_ALL_DEAD_IN_ONE_BJ;
%page;
CLEAN_ONE_DEAD_IN_ALL_BJ:
   proc (codiab_p_process_id);			/* Used bt bjm_adjust_processes */

dcl  codiab_p_process_id		bit (36) aligned parameter;

dcl  (
     codiab_process_id		bit (36) aligned init (""b),
     codiab_process_index		fixed bin init (0),
     codiab_journal_index		fixed bin init (0)
     )				automatic;

   codiab_process_id = codiab_p_process_id;
   if ^PROCESS_IS_DEAD (codiab_process_id) then
      return;

   codiab_process_index = FIND_PROCESS_IX (codiab_process_id);
   if codiab_process_index = 0 then
      return;

   do codiab_journal_index = 1 to max_n_journals;

      if bj_pst.e (codiab_journal_index).version = 0 then
         ;					/* pste not in use */
      else do;
         call CHECK_VERSION_NUMERIC (bj_pst.e (codiab_journal_index).version,
	    BJ_PSTE_VERSION_2, dm_error_$bj_bad_pste_version);
         call CHECK_OUT (codiab_process_index, codiab_journal_index);
      end;
   end;

   bj_check_in_table.process_id (codiab_process_index) = (36)"0"b;

   return;

   end CLEAN_ONE_DEAD_IN_ALL_BJ;
%page;
CLEAN_ONE_DEAD_IN_ONE_BJ:
   proc (codiob_p_bj_pste_ptr, codiob_p_process_id);	/* Not very useful */

dcl  (
     codiob_p_bj_pste_ptr		ptr,
     codiob_p_process_id		bit (36) aligned
     )				parameter;

dcl  (
     codiob_process_id		bit (36) aligned,
     codiob_process_index		fixed bin,
     codiob_journal_index		fixed bin
     )				automatic;

   bj_pste_ptr = codiob_p_bj_pste_ptr;
   codiob_process_id = codiob_p_process_id;

   codiob_journal_index = bj_pste.bj_ix;

   codiob_process_index = FIND_PROCESS_IX (codiob_process_id);
   if codiob_process_index = 0 then
      return;

   if ^PROCESS_IS_DEAD (codiob_process_id) then
      return;

   call CHECK_OUT (codiob_process_index, codiob_journal_index);

   return;

   end CLEAN_ONE_DEAD_IN_ONE_BJ;
%page;
CLEAN_ALL_DEAD_IN_ALL_BJ:
   proc ();

/* NOT IMPLEMENTED */
   return;

   end CLEAN_ALL_DEAD_IN_ALL_BJ;
%skip (4);
PROCESS_IS_DEAD:
   proc (pid_p_process_id) returns (bit (1) aligned);


dcl  pid_p_process_id		bit (36) aligned parameter;

dcl  pid_code			fixed bin (35) init (0) automatic;

   call hcs_$validate_processid (pid_p_process_id, pid_code);

   if pid_code ^= 0 then
      return ("1"b);
   else return ("0"b);

   end PROCESS_IS_DEAD;
%page;
GET_PROCESS_IX:
   procedure () returns (fixed bin);

/* See if our process is in the check in table (CIT).  If	*/
/* it is not, we try to find a free spot and claim it for	*/
/* ourself.  Whether we were in it to start or not, we tell	*/
/* the caller what index into the CIT we have.  Note: it is	*/
/* possible for the CIT to be full; if so, we call the	*/
/* ERROR_RETURN procedure and do not return to the caller.	*/

dcl  (
     gpi_first_free_process_index	fixed bin init (0),
     gpi_have_process_index		bit (1) aligned init (""b),
     gpi_this_process_id		bit (36) aligned init (""b),
     gpi_this_process_index		fixed bin init (0)
     )				automatic;

   gpi_this_process_id = get_process_id_ ();

IS_PROCESS_IN_CIT:
   do gpi_this_process_index = 1 to dm_system_data_$bj_max_n_processes
        while (^gpi_have_process_index);		/* to see if we are registered in PST already */

      if bj_check_in_table.process_id (gpi_this_process_index)
	 = gpi_this_process_id then
         gpi_have_process_index = "1"b;

      else if bj_check_in_table.process_id (gpi_this_process_index) = (36)"0"b
	 then
         if gpi_first_free_process_index = 0 then
	  gpi_first_free_process_index = gpi_this_process_index;
   end IS_PROCESS_IN_CIT;

   gpi_this_process_index = gpi_this_process_index - 1;	/* cancel out +1 effect of do loop */

   if ^gpi_have_process_index then			/* NOT in PST yet */
      if gpi_first_free_process_index = 0 then		/* no more room in CIT */
         call ERROR_RETURN (dm_error_$bj_pst_cit_full);

      else do;					/* we now add new CIT entry for our process */
         gpi_this_process_index = gpi_first_free_process_index;

/* zero the cross_proc_bj row this process will use */
         bj_check_in_table.cross_proc_bj (gpi_this_process_index, *) = "0"b;

         bj_check_in_table.process_id (gpi_this_process_index) =
	    gpi_this_process_id;
      end;					/* now in CIT */

   else ;						/* we were already in CIT */

   return (gpi_this_process_index);

   end GET_PROCESS_IX;
%page;
FIND_PROCESS_IX:
   proc (fpi_p_process_id) returns (fixed bin);

dcl  fpi_p_process_id		bit (36) aligned parameter;

dcl  (
     fpi_process_id			bit (36) aligned init (""b),
     fpi_process_index		fixed bin init (0)
     )				automatic;

   fpi_process_id = fpi_p_process_id;

   do fpi_process_index = 1 to max_n_processes;

      if bj_check_in_table.process_id (fpi_process_index) = fpi_process_id then
         return (fpi_process_index);

   end;

   return (0);

   end FIND_PROCESS_IX;
%page;
%include dm_bj_static;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_check_in_table;


   end bj_pste_register$check_in;




		    bj_report_err.pl1               04/04/85  1117.3re  04/04/85  0826.1       32598



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

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

bj_report_err:
     procedure (p_code, p_caller_name);

/* DESCRIPTION

	The gateway through which before journal manager support routines
     tell before journal manager subroutine interfaces that an error has
     occurred.  this procedure will make the error code available to the
     before journal manager in a global basis, log the error in the system
     log, and either return to the before journal manager interface
     procedure or signal an error.  the intelligence needed to decide
     whether or not to signal an error resides in this procedure.

	Arguments:

     p_code -        INPUT, standard status code of error
     p_caller_name - INPUT, name of support routine that took the error
*/

/* HISTORY
Written by M. Pandolf, 05/24/83.
Modified:
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
02/05/85 by Stanford Cox: Added trailing "_" to transaction_bj_full_ condition.
03/05/85 by Steve Herbst: Replaced dm_log_ with dm_misc_util_$log.
*/
%page;
/* copy the error code into a externally available location */

	bjm_data_$bj_code = p_code;

/* log the error in the data management log. we assume errors are few */

	call dm_misc_util_$log (LOG_SV, p_code, p_caller_name,
	     "When called by ^a in transaction ^o.",
	     bjm_data_$bj_operation, dm_data_$current_txn_id);

/*
   this next portion of code sends the error in one of two directions: either
   a non standard return is made to a predefined location or a condition is
   signalled.  there is no slick way to test and branch - the error code must
   be checked to see if it is one of those requiring a signal.
*/

	if p_code = dm_error_$bj_journal_full
	then do;

	     call FILL_SIGNAL_STRUCTURE ();
	     call signal_ ("transaction_bj_full_", null (), addr (my_signal_structure));

	end;

	else do;

	     goto bjm_data_$bj_exit_err;

	end;

%page;

/* INTERNAL PROCEDURE */

FILL_SIGNAL_STRUCTURE:
     procedure ();

	my_signal_structure.length = size (my_signal_structure);
	my_signal_structure.version = 1;
	my_signal_structure.action_flags.cant_restart = "1"b;
	my_signal_structure.action_flags.default_restart = "0"b;
	my_signal_structure.action_flags.quiet_restart = "0"b;
	my_signal_structure.action_flags.support_signal = "0"b;
	my_signal_structure.action_flags.pad = ""b;
	my_signal_structure.info_string = "";
	my_signal_structure.status_code = p_code;

	return;

     end FILL_SIGNAL_STRUCTURE;

%page;

/* DECLARATIONS */

/* Parameters */

dcl  p_code		        fixed bin (35) parameter;
dcl  p_caller_name		        char (*);

/* Automatic */

dcl  1 my_signal_structure	        aligned like condition_info_header;

/* Static, External */

dcl  dm_data_$current_txn_id	        bit (36) aligned external static;
dcl  dm_error_$bj_journal_full        fixed bin (35) ext static;

/* Entry */

dcl  dm_misc_util_$log	        entry () options (variable);
dcl  signal_		        entry () options (variable);

/* Builtin */

dcl  null			        builtin;
dcl  size			        builtin;

/* Include Files */

%page;
%include dm_bj_global_error_info;
%page;
%include dm_log_sv_codes;
%page;
%include condition_info_header;
%page;

     end bj_report_err;




		    bj_storage_append.pl1           05/17/85  1651.2re  05/17/85  1328.6      192240



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

/* DESCRIPTION:

	bj_storage_append:
	This module actually writes to a before journal or the
     journal's buffer.  It maintains the number of active transacitons
     in the header of each record of the journal so crash recovery
     "knows" how far to walk backwards to get the records needed for
     recovery.  It makes sure there are enough free control intervals
     to be able to abort or commit each currently active transaction
     being journalized.  The per-transaction storage limit is enforced
     by this module.

	We try to use the BJ buffer, write the buffer to disk
     when it full, and initialize the buffer with a new CI when the
     buffer is on disk.

	The bj_storage_append$adjust entry is provided to complete
     an append operation that has been interrupted in the middle.

	NOTE: bj_storage_append locks the pste, the $adjust entry
     does not.
*/

/* HISTORY:
Written  by Andre Bensoussan,  07/08/1982.
Modified:
08/16/82 by Andre Bensoussan: to maintain the value of
            bj_ci.header2.first_rec_id and bj_pste.stamp_for_last_ci_put in the
            internal proc PUT_BUFFERED_CI.
11/01/82 by Andre Bensoussan: to guard against producing too many unsafe before
            images, which would cause too many pages to be held in main memory;
            if this happened, page control might not honor the contract it has
            with before journal manager, and we might be in trouble with Bongo
            too.
11/18/82 by Andre Bensoussan: to reflect the change to the calling sequence to
            bj_storage_recycle.
12/19/82 by Andre Bensoussan: to not split record header across CI's.
01/18/83 by Andre Bensoussan: to return bj_ix in the stamp.
02/14/83 by Andre Bensoussan: to change the calling sequence.
03/29/83 by Andre Bensoussan: to improve the adjust entry point.
06/07/84 by Lee Baldwin:      Renamed dm_error_$bj_buffer_bad_address to
            $bj_bad_buffer_address, $bj_buffer_bad_uid to $bj_bad_buffer_uid.
11/05/84 by Matthew Pierret:  to allow for the possibility that an
            fm_postcommit_handler or an fm_rollback_handler can be the first
            bj record for a transaction, and to set delta_n_txn to +1 if
            such is the case.
11/12/84 by Maggie Sharpe:  to clean up dcls; to use addcharno instead of
            substr (...)  = substr (...); to use ERROR_RETURN technology; to
            replace two goto-implemented loops to do-whiles; to make
            BUFFER_NEXT_CI more efficient by using fewer assignments to reset
            bj_ci.header2.
11/16/84 by Lindsey L. Spratt:  Changed the do-while loop to use the (new)
            PUT_RECORD_IN_BUFFERED_CI internal proc.  Removed use of the
            need_space_for_full_bj_rec_hdr flag and changed to reference
            "next_bytes > 0" directly.
03/14/85 by Lee A. Newcomb:  Added per-transaction storage limit support;
            fixed to always use ERROR_RETURN to report errors, to use
            dm_element_id.incl.pl1 instead of an auto declared structure, and
            to declare all parameters and entries in one location; removed
            unused dm_bj_static.incl.pl1; made a procedure to calculate the
	  bj_txte_ptr; and fixed format.
03/27/85 by Lee A. Newcomb:  Changed to meter the number of times transactions
            hit a BJ's transaction storage limit.
05/10/85 by R. Michael Tague:  Replaced based reference to dm_journal_seg with
            explicit call to dm_hcs_$get_max_held_per_journal since
	  dm_journal_seg is now ring 0 only.
*/
/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bj_storage_append:
   proc (p_bj_oid, p_ptr, p_bytes, p_delta_n_txn, p_delta_n_bi, p_rec_id,
        p_stamp);

/* START OF DECLARATIONS */

/* Parameters */

dcl  p_bj_oid			bit (36) aligned;	/* bj opening id. Input */
dcl  p_bj_pste_ptr			ptr;		/* ptr to BJ pste for $adjust to use. Input */
dcl  p_ptr			ptr;		/* ptr to logical record. Input */
dcl  p_bytes			fixed bin;	/* number of bytes of logical record. Input */
dcl  p_delta_n_txn			fixed bin;	/* -1, 0 or +1 . Input */
dcl  p_delta_n_bi			fixed bin;	/* 0, 1 or n>1.  Input */
dcl  p_rec_id			bit (36) aligned;	/* rec_id of the record appended. Output */
dcl  p_stamp			fixed bin (71);	/* Time stamp - Output */

/* Automatic */
dcl  (
     code				fixed bin (35) init (0),
     curr_bytes			fixed bin init (0),
     delta_n_txn			fixed bin init (0),
     flush			bit (1) aligned init (DONT_FLUSH_BJ),
     free_bytes			fixed bin init (0),
     last_element_id		bit (36) aligned init (NO_RECORD),
     myname			char (32)
				init (BJ_STORAGE_APPEND_INVALID_ENTRY),
     new_offset			fixed bin init (0),
     new_record_ptr			ptr init (null),
     next_bytes			fixed bin init (0),
     number_of_slots		fixed bin init (0),
     old_offset			fixed bin init (0),
     prev_bytes			fixed bin init (0),
     rec_was_stored			bit (1) aligned init (FALSE),
     record_ptr			ptr init (null)
     )				automatic;

dcl  1 bj_ci_hdr2_template		aligned automatic,	/* see dm_bj_ci for detail */
       2 n_slots			fixed bin (17) unaligned,
       2 first_is_contn		bit (1) unaligned,
       2 last_is_contd		bit (1) unaligned,
       2 pad			bit (16) unaligned;

/* Based */
dcl  based_record			char (curr_bytes) based,
     based_word			bit (36) aligned based;

/* Builtin */
dcl  (addcharno, addr, bin, null, ptr, rel, size, unspec)
				builtin;

/* Constant */
dcl  (
     APPE				char (4) init ("appe"),
     BJ_STORAGE_APPEND_INVALID_ENTRY	char (32)
				init (
				"bj_storage_append ENTRY NOT SET"),
     BJ_STORAGE_APPEND_MAIN_ENTRY	char (32) init ("bj_storage_append"),
     BJ_STORAGE_APPEND_ADJUST_ENTRY	char (32)
				init ("bj_storage_append$adjust"),
     BYTES_PER_WORD			fixed bin init (4),
     DONT_FLUSH_BJ			bit (1) aligned init (""b),
     FALSE			bit (1) aligned init (""b),
     FLUSH_BJ			bit (1) aligned init ("1"b),
     NO_RECORD			bit (36) aligned init (""b),
     TRUE				bit (1) aligned init ("1"b)
     )				internal static options (constant);

/* Entry */
dcl  (
     bj_oid_util$get_ptr		entry (bit (36) aligned) returns (ptr),
     bj_pste_lock$lock		entry (ptr, bit (36) aligned),
     bj_pste_lock$unlock		entry (ptr),
     bj_report_err			entry (fixed bin (35), char (*)),
     bj_storage_flush$threshold	entry (ptr),
     bj_storage_put_buffered_ci	entry (bit (36) aligned, ptr),
     bj_storage_recycle		entry (ptr, fixed bin (35)),
     bj_storage_util$distance		entry (ptr, fixed bin (24) uns)
				returns (fixed bin (24) uns),
     clock_			entry returns (fixed bin (71)),
     dm_hcs_$get_max_held_per_journal	entry returns (fixed bin)
     )				external;

/* External */
dcl  (
     dm_data_$bj_txt_ptr		ptr,
     (
     dm_error_$bj_bad_buffer_uid,
     dm_error_$bj_bad_ci_no,
     dm_error_$bj_journal_full,
     dm_error_$bj_logic_err
     )				fixed bin (35)
     )				external static;

/* END OF DECLARATIONS */
%page;
/* bj_storage_append:		repeat for reader	*/
/*      proc (p_bj_oid, p_ptr, p_bytes, p_delta_n_txn,	*/
/*      p_delta_n_bi, p_rec_id, p_stamp);		*/

   myname = BJ_STORAGE_APPEND_MAIN_ENTRY;
   bj_ppte_ptr = bj_oid_util$get_ptr (p_bj_oid);
   bj_pste_ptr = bj_ppte.bj_pste_ptr;

   next_bytes = p_bytes;

   call bj_pste_lock$lock (bj_pste_ptr, bj_ppte.bj_uid);


/* Update the number of txn in the bj_rec_hdr.  This number is the	*/
/* number of txn that actually have at least 1 record in this	*/
/* journal; it is needed after a system crash to determine how far	*/
/* back one should look for transactions that have to be rolled back.	*/
/* This item cannot be maintained by the bjm_primitives themselves	*/
/* because the bj_pste needs to be locked.			*/
/*							*/
/* Also, set the variable delta_n_txn to +1, -1 or 0 to indicate if	*/
/* the number of txn has to be increased by 1, decreased by 1 or stay	*/
/* the same.  This variable is used later to update bj_pste.n_txn.	*/
/* It is used also by the internal proc NEXT_CI to determine if one	*/
/* has enough free CI's for an ABORT mark for each transaction in	*/
/* progress.						*/

   bj_rec_hdr_ptr = p_ptr;

   if bj_rec_hdr.type = BJ_RECORD_TYPE.BEFORE_IMAGE
        | bj_rec_hdr.type = BJ_RECORD_TYPE.FM_POSTCOMMIT_HANDLER
        | bj_rec_hdr.type = BJ_RECORD_TYPE.FM_ROLLBACK_HANDLER then do;
      call CHECK_TXN_STORAGE_LIMIT (rel (addr (p_rec_id)), next_bytes,
	 bj_pste_ptr);
      if bj_rec_hdr.prev_rec_id = NO_RECORD then
         delta_n_txn = +1;
      else delta_n_txn = 0;
   end;
   else if bj_rec_hdr.type = BJ_RECORD_TYPE.COMMITTED
        | bj_rec_hdr.type = BJ_RECORD_TYPE.ABORTED then
      delta_n_txn = -1;
   else delta_n_txn = 0;

   if delta_n_txn ^= p_delta_n_txn then
      call ERROR_RETURN (dm_error_$bj_logic_err);


   bj_rec_hdr.n_txn = bj_pste.n_txn + p_delta_n_txn;


/* Set the pointer to the buffer and validate that the	*/
/* buffer has the expected uid in it.  The header of the	*/
/* buffer is supposed to contain the bj_uid.  Then resolve	*/
/* any unstability that may be detected for that journal:	*/
/*  - If the buffer should be put in the page file, put it.	*/
/*  - If the buffer should be initialized with a new CI,	*/
/*       do it.					*/

   bj_ci_ptr = ptr (bj_pste_ptr, bj_pste.buffer_offset);

   if bj_ci.header1.id.uid ^= bj_pste.bj_uid then
      call ERROR_RETURN (dm_error_$bj_bad_buffer_uid);

   if bj_pste.last_ci_put = bj_pste.last_ci_buffered then
      call BUFFER_NEXT_CI;				/* Resolve unfinished "buffer_next"op */

   if bj_ci.last_is_contd then
      call PUT_BUFFERED_CI;				/* Resolve unfinished "put" op */
%page;
WRITE_BJ_RECORD_LOOP:
   do while (next_bytes > 0);
      number_of_slots = bj_ci.n_slots;

      if number_of_slots = 0 then
         old_offset =
	    bj_pste.ci_size - 4 * (size (ci_header) + size (ci_trailer));

      else old_offset = bj_ci.slot (number_of_slots).offset;

      free_bytes = old_offset - 4 * (size (header2) + (number_of_slots + 1));

      if next_bytes <= free_bytes then do;
         curr_bytes = next_bytes;
         next_bytes = 0;
         call PUT_RECORD_IN_BUFFERED_CI ();
      end;
      else if 4 * size (bj_rec_hdr) <= free_bytes then do;
         curr_bytes = free_bytes;
         next_bytes = next_bytes - curr_bytes;
         call PUT_RECORD_IN_BUFFERED_CI ();
      end;
      else do;
         call PUT_BUFFERED_CI;			/* WOULD NOT BE NICE TO SPLIT THE HEADER */
         call BUFFER_NEXT_CI;
      end;

   end WRITE_BJ_RECORD_LOOP;

/* NOW, THE ENTIRE LOGICAL RECORD IS IN THE JOURNAL - IT IS IRREVERSIBLE */

SYNC_BJ_PSTE_AND_TXTE:
   do;
      bj_pste.last_rec_id = bj_pste.append_state.pending_last_rec_id;
      bj_pste.n_txn = bj_pste.append_state.pending_n_txn;
      p_rec_id = bj_pste.append_state.pending_last_rec_id;
      bj_pste.append_state.current_operation = "";
   end SYNC_BJ_PSTE_AND_TXTE;
%page;
/* KEEP TRACK OF THE NUMBER OF DM PAGES HELD AND FLUSH BJ IF TOO MANY */

   if p_delta_n_bi > 0 then do;			/* Decreased by bj_storage_flush */

      bj_pste.n_bi_still_unsafe = bj_pste.n_bi_still_unsafe + p_delta_n_bi;
      bj_ci.header2.n_bi = bj_ci.header2.n_bi + p_delta_n_bi;

/* reset to 0 by BUFFER_NEXT_CI */

      if bj_pste.n_bi_still_unsafe > dm_hcs_$get_max_held_per_journal () then
         flush = FLUSH_BJ;
      else flush = DONT_FLUSH_BJ;
   end;

   else flush = DONT_FLUSH_BJ;

   call bj_pste_lock$unlock (bj_pste_ptr);

   if flush then
      call bj_storage_flush$threshold (bj_ppte_ptr);

/*
   Note - bj_storage_flush behaves as follows with respect to the pste lock:

   LOCK; do some work; UNLOCK; wait for IO; RELOCK; do some work; UNLOCK;

   It might save some overhead if we made the convention that
   the caller of bj_storage_flush may already hold the lock;
   upon return the lock would be in the same state as at the time
   the call was made; however, the caller would have to understand
   that bj_storage_flush does not keep the lock while waiting for I/O.
*/


/* p_rec_id has already been set. Set p_stamp before return */

   unspec (p_stamp) = unspec (bj_ci.header1.stamp);

   call RETURN ();

/* end bj_storage_append; */
%page;
bj_storage_append$adjust:
   entry (p_bj_pste_ptr);

/* Complete an interrupted append operation */

   bj_pste_ptr = p_bj_pste_ptr;
   myname = BJ_STORAGE_APPEND_ADJUST_ENTRY;

   if bj_pste.append_state.current_operation ^= APPE then
      call ERROR_RETURN (dm_error_$bj_logic_err);

   bj_ci_ptr = ptr (bj_pste_ptr, bj_pste.buffer_offset);

   element_id.control_interval_id = bj_ci.header1.id.num;
   element_id.index = bj_ci.header2.n_slots;

   last_element_id = element_id_string;


   if bj_pste.append_state.pending_last_element_id = NO_RECORD then
      rec_was_stored = FALSE;
   else if bj_pste.last_rec_id = bj_pste.append_state.pending_last_rec_id then
      rec_was_stored = TRUE;
   else if bj_pste.append_state.pending_last_element_id = last_element_id then
      rec_was_stored = TRUE;
   else rec_was_stored = FALSE;
%page;
   if rec_was_stored then
FINISH_BJ_TABLE_UPDATES:
      do;

FINISH_BJ_PSTE_UPDATE:
      do;
         bj_pste.last_rec_id = bj_pste.append_state.pending_last_rec_id;
         bj_pste.n_txn = bj_pste.append_state.pending_n_txn;
      end FINISH_BJ_PSTE_UPDATE;

FINISH_BJ_TXTE_UPDATE:				/* show record has been written */
      do;
         bj_txte_ptr = BJ_TXTE_PTR (bj_pste.append_state.txte_rec_id_relp);

         bj_txte.append_state.pending_bj_rec_id = bj_pste.last_rec_id;

         bj_txte.last_bj_rec_id = bj_pste.append_state.pending_last_rec_id;
         bj_txte.n_rec_written = bj_txte.append_state.pending_n_rec_written;
         bj_txte.n_bytes_written =
	    bj_txte.append_state.pending_n_bytes_written;

         if bj_txte.first_bj_rec_id = NO_RECORD then
	  bj_txte.first_bj_rec_id = bj_txte.append_state.pending_bj_rec_id;

      end FINISH_BJ_TXTE_UPDATE;

   end FINISH_BJ_TABLE_UPDATES;

   bj_pste.append_state.current_operation = "";

   call RETURN ();

/* end bj_storage_append$adjust; */
%page;
MAIN_RETURN:
   return;
%skip (4);
RETURN:
   proc ();

/* central location for all entries to return if no errors */
   go to MAIN_RETURN;

   end RETURN;
%skip (4);
ERROR_RETURN:
   proc (er_p_code);

/* central location for ALL returns due to an error */

dcl  er_p_code			fixed bin (35) parameter;

   call bj_report_err (er_p_code, myname);		/* does not return */

   end ERROR_RETURN;
%skip (4);
BJ_TXTE_PTR:
   proc (btp_p_bj_txte_rec_id_relp) returns (ptr);

/* Proc to calculate the txte pointer so we only need the logic in	*/
/* one location.  This is done by using the TXT ptr in dm_data_ as	*/
/* the starting point, adding in the offset to the pending record ID	*/
/* (bj_pste.txte_rec_id_relp), and then using TXT entry 1 to adjust	*/
/* the offset to the start of the entry.			*/

dcl  btp_p_bj_txte_rec_id_relp	bit (18) aligned parameter;

   return (
        ptr (dm_data_$bj_txt_ptr,
        bin (btp_p_bj_txte_rec_id_relp)
        -
        bin (
        rel (
        addr (dm_data_$bj_txt_ptr
        -> bj_txt.entry (1).append_state.pending_bj_rec_id)))
        + bin (rel (addr (dm_data_$bj_txt_ptr -> bj_txt.entry (1))))));

   end BJ_TXTE_PTR;
%skip (4);
CHECK_TXN_STORAGE_LIMIT:
   proc (ctsl_p_bj_txte_rec_id_relp, ctsl_p_next_bytes, ctsl_p_bj_pste_ptr);

/* Cause a before journal full condition if the transaction would	*/
/* exceed the per-transaction storage limit of the before journal.	*/

dcl  (
     ctsl_p_next_bytes		fixed bin,
     ctsl_p_bj_txte_rec_id_relp	bit (18) aligned,
     ctsl_p_bj_pste_ptr		ptr
     )				parameter;
dcl  ctsl_bj_txte_ptr		ptr init (null) automatic;

   ctsl_bj_txte_ptr = BJ_TXTE_PTR (ctsl_p_bj_txte_rec_id_relp);
   if ctsl_bj_txte_ptr -> bj_txte.n_bytes_written		/* curr. storage used */
        + ctsl_p_next_bytes				/* plus requested storage */
        > ctsl_p_bj_pste_ptr -> bj_pste.txn_storage_limit then
TXN_AT_STORAGE_LIMIT_SO_SIGNAL_BJ_FULL:
      do;
      ctsl_p_bj_pste_ptr -> bj_pste.n_txn_storage_limit_hits =
						/* meter it */
	 ctsl_p_bj_pste_ptr -> bj_pste.n_txn_storage_limit_hits + 1;
      call ERROR_RETURN (dm_error_$bj_journal_full);
   end TXN_AT_STORAGE_LIMIT_SO_SIGNAL_BJ_FULL;
   else ;						/* OK */

   end CHECK_TXN_STORAGE_LIMIT;
%page;
PUT_RECORD_IN_BUFFERED_CI:
   proc ();

   new_offset = old_offset - curr_bytes;

   new_record_ptr =
        addcharno (bj_ci_ptr, BYTES_PER_WORD * size (ci_header) + new_offset);
   record_ptr = addcharno (p_ptr, prev_bytes);

   new_record_ptr -> based_record = record_ptr -> based_record;
						/* STORE RECORD IN BUFFER */


   number_of_slots = number_of_slots + 1;

   bj_ci.slot (number_of_slots).offset = new_offset;
   bj_ci.slot (number_of_slots).length = curr_bytes;

   element_id.control_interval_id = bj_pste.last_ci_buffered;
   element_id.index = number_of_slots;


   if prev_bytes = 0 then				/* First element_id is rec_id */
      do;
      bj_pste.append_state.current_operation = "";

      bj_pste.append_state.pending_n_txn = bj_pste.n_txn + p_delta_n_txn;
      bj_pste.append_state.pending_last_rec_id = element_id_string;
      bj_pste.append_state.pending_last_element_id = NO_RECORD;
      bj_pste.append_state.txte_rec_id_relp = rel (addr (p_rec_id));

      bj_pste.append_state.current_operation = APPE;
   end;


   if next_bytes = 0 then				/* Last element - Logical record is
								   about to come into existence */
      bj_pste.append_state.pending_last_element_id = element_id_string;

   if curr_bytes = p_bytes				/* Implies prev_bytes = next_bytes = 0 */
        then
      bj_ci.n_slots = number_of_slots;			/* ATOMIC - Brings rec into existence */

   else do;
      addr (bj_ci_hdr2_template) -> based_word =
	 addr (bj_ci.n_slots) -> based_word;

      bj_ci_hdr2_template.n_slots = number_of_slots;
      if next_bytes > 0 then
         bj_ci_hdr2_template.last_is_contd = TRUE;
      if prev_bytes > 0 then do;
         bj_ci_hdr2_template.first_is_contn = TRUE;
         bj_ci.header2.first_rec_id = bj_pste.append_state.pending_last_rec_id;
      end;

      addr (bj_ci.n_slots) -> based_word =
	 addr (bj_ci_hdr2_template) -> based_word;	/* ATOMIC - Brings rec into existence if storing last element */
   end;


   bj_ci.header1.stamp.time_modified = clock_ ();
   bj_ci.header1.stamp.bj_idx = bj_pste.bj_ix;

   if next_bytes > 0 then do;
      call PUT_BUFFERED_CI;
      call BUFFER_NEXT_CI;

      prev_bytes = prev_bytes + curr_bytes;
   end;

   end PUT_RECORD_IN_BUFFERED_CI;
%page;
PUT_BUFFERED_CI:
   proc ();

/* The code of bj_storage_put_buffered_ci is repeatable.		*/
/*	Its point of non return is the instruction:		*/
/*							*/
/*	bj_pste.last_ci_put = bj_pste.last_ci_buffered		*/

   call bj_storage_put_buffered_ci ((bj_ppte.pf_oid), bj_pste_ptr);

   return;

   end PUT_BUFFERED_CI;
%page;
BUFFER_NEXT_CI:
   proc;

/* This code is repeatable. It can be executed any number of times	*/
/* without any effect as long as the instruction of non-return has	*/
/* not been executed; that instruction is:			*/
/*	bj_pste.last_ci_bufferd = bj_ci.header.id.num		*/

dcl  temp_layout_type		bit (36) aligned;


   bj_ci.header1.id.num = NEXT_CI (bj_pste.last_ci_buffered);

   temp_layout_type = bj_ci.header2.layout_type;
   unspec (bj_ci.header2) = "0"b;
   bj_ci.header2.layout_type = temp_layout_type;

   bj_pste.last_ci_buffered = bj_ci.header1.id.num;	/* Point of non-return */

/*	Buffering a CI consists merely of restting the bj_ci header of the
	existing ci buffer for this before_journal. The fact that it has
	been reset is recorded in the pste.			     */

   return;

   end BUFFER_NEXT_CI;
%page;
NEXT_CI:
   proc (current) returns (fixed bin (24) uns);

dcl  current			fixed bin (24) uns;
dcl  next				fixed bin (24) uns;
dcl  n_ci_left			fixed bin (24) uns;
dcl  recycle_called			bit (1) init (FALSE);


   if current < bj_pste.cl.lowest_ci | current > bj_pste.cl.highest_ci then
      call ERROR_RETURN (dm_error_$bj_bad_ci_no);

   n_ci_left =
        bj_pste.cl.number_ci
        - (bj_storage_util$distance (bj_pste_ptr, bj_pste.last_ci_buffered)
        + 1);

   do while (n_ci_left <= bj_pste.n_txn + p_delta_n_txn);

      if recycle_called then
         call ERROR_RETURN (dm_error_$bj_logic_err);

      call bj_storage_recycle (bj_ppte_ptr, code);
      if code ^= 0 then
         call ERROR_RETURN (code);


      recycle_called = TRUE;

      n_ci_left =
	 bj_pste.cl.number_ci
	 - (bj_storage_util$distance (bj_pste_ptr, bj_pste.last_ci_buffered)
	 + 1);
   end;


   if current < bj_pste.cl.highest_ci then
      next = current + 1;
   else next = bj_pste.cl.lowest_ci;


   if next = bj_pste.cl.origin_ci then
      call ERROR_RETURN (dm_error_$bj_logic_err);

   return (next);

   end NEXT_CI;
%page;
%include dm_bj_ppt;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_ci;
%page;
%include dm_ci_header;
%page;
%include dm_ci_parts;
%page;
%include dm_element_id;
%page;
%include dm_bj_records;
%page;
%include dm_bj_txt;


   end bj_storage_append;




		    bj_storage_flush.pl1            04/04/85  1117.3r w 04/04/85  0915.4      104166



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

/* DESCRIPTION:

     This program contains 2 entrypoints:

     $up_to_rec_id flushes the journal up to the specified record.
	It is called by bjm_flush_transaction to flush all records
	appended to the journal by a transaction, as a step to get
	ready to commit. It is also called by bj_storage_append, to
	flush the logical record just appended to the journal, when
	the type of the record requires a flush (ie committed mark,
	aborted mark and rolled back mark).

     $threshold flushes the journal up to the last ci put. It is called
	by bj_storage_append when the number of unflushed before images,
	and consequently the number of pages held in main memory, becomes
	higher than a threshold.


     Most of the code is common to the 2 procedures. The $threshold
     entrypoint initializes the record id to be the first record of the
     last CI put and then relies on the $up_to_rec_id entrypoint to do
     the job. So, the remainder of the description applies to both procedures.


     This procedure returns to the caller only after all required
     disk I/O's are physically completed.

     It updates the time stamp associated with the before journal
     involved, for use by page control to honor the write ahead log protocol.

	It also updated the number of "unsafe before images" in this
     journal, that is, the number of before images that are not yet known
     to be on disk.  This number is kept in bj_pste.n_bi_still_unsafe.  It
     representes an upper bound of the current number of CI's that may be
     held in main memory because of this journal.  Whenever a BI is
     appended to a journal, the count of unsafe before images in this
     journal is incremented by 1.  If the count becomes larger than a
     threshold per journal, the append procedure calls the $threshold entry
     point to flush the journal to release the pressure in main memory.


     NOTE - To minimize the number of pages held in main memory, the journal
     is always flushed up to the last ci put, unless the specified record
     happens to be in the buffer, in which case the buffer is flushed too.

     
     The basic steps taken by this program are as follows:

     1. If any part of the last record to be flushed is in the buffer,
        put the buffer in the page file.

     2. Flush the journal from the CI following the portion of the journal
        known completely on disk, up to the last ci put in the page file.
        The flushing is done by calling the page file manager, which in
        turn, will call page control.

        It is important to point out that the journal, ie the bj_pste, is
        unlocked before calling the page file manager so that other processes
        can use it during the physical I/O's. Upon return the journal is locked
        again, and the rest of the program is ready to deal with any change
        that may have happened while the journal was unlocked.
     
     3. Update the cursor to the last_ci_on_disk, carefully, making sure it can
        only move forward in the circular journal.
     
     4. Update the time stamp used by page control for this journal, carefully,
        making sure it can only move forward in time.

     5. Update the number of still unsafe before images, carefully, making sure it can
        only decrease.
*/

/* HISTORY:
Written by A. Bensoussan, 10/29/82.
Modified:
02/23/83 by A. Bensoussan:  to lock/unlock using bj_pste_lock$lock/unlock.
12/05/84 by M. Sharpe:  to correct format and dcls; to use ERROR_RETURN; to
	  set/reset validation level around the calls to file_manager_.
*/

/* format: style2,ind3,^indcomtxt */
%page;
bj_storage_flush:
   proc;
      signal not_an_entrypoint;			/* Not an entry point */
      return;

/* START OF DECLARATIONS */

/* Parameter */

      dcl	    p_bj_ppte_ptr	       ptr;
      dcl	    p_rec_id	       bit (36) aligned;

/* Automatic */

      dcl	    code		       fixed bin (35);
      dcl	    pf_oid	       bit (36) aligned;
      dcl	    rec_id	       bit (36) aligned;
      dcl	    ci_no		       fixed bin (24) uns;
      dcl	    first		       fixed bin (24) uns;
      dcl	    last		       fixed bin (24) uns;
      dcl	    my_last_ci_flushed     fixed bin (24) uns;
      dcl	    my_stamp	       fixed bin (71);
      dcl	    n_bi_being_saved_by_me fixed bin;
      dcl	    n_bi_in_buffer	       fixed bin;
      dcl	    entry_no	       fixed bin;
      dcl	    current_ring	       fixed bin (3);
      dcl	    saved_level	       fixed bin;


/* Based */

      dcl	    1 rec_id_str	       based,
	      2 ci_no	       fixed bin (24) uns unaligned,
	      2 slot_no	       fixed bin (12) uns unaligned;

/* Builtin */

      dcl	    (addr, ptr)	       builtin;

/* Conditions */

      dcl	    (cleanup, not_an_entrypoint)
			       condition;

/* Constant */

      dcl	    ME		       char (16) internal static options (constant) init ("bj_storage_flush");

/* Entry */

      dcl	    bj_pste_lock$lock      entry (ptr, bit (36) aligned);
      dcl	    bj_pste_lock$unlock    entry (ptr);

      dcl	    file_manager_$flush_consecutive_ci
			       entry (bit (36) aligned, fixed bin (24) uns, fixed bin (24) uns, fixed bin (35));

      dcl	    bj_storage_put_buffered_ci
			       entry (bit (36) aligned, ptr);
      dcl	    bj_storage_util$next_used_ci
			       entry (ptr, fixed bin (24) uns) returns (fixed bin (24) uns);
      dcl	    dm_hcs_$set_journal_stamp
			       entry (fixed bin, fixed bin (71), fixed bin (35));
      dcl	    bj_report_err	       entry (fixed bin (35), char (*));
      dcl	    get_ring_	       entry () returns (fixed bin (3));
      dcl	    cu_$level_get	       entry (fixed bin);
      dcl	    cu_$level_set	       entry (fixed bin);

/* External */

      dcl	    dm_error_$bj_bad_ci_no ext fixed bin (35);

/* END OF DECLARATIONS */
%page;
up_to_rec_id:
   entry (p_bj_ppte_ptr, p_rec_id);			/* ----- ENTRYPOINT 1 ----- */

      entry_no = 1;
      rec_id = p_rec_id;
      goto COMMON;


threshold:
   entry (p_bj_ppte_ptr);				/* ----- ENTRYPOINT 2 ----- */

      entry_no = 2;
      rec_id = "0"b;
      goto COMMON;

COMMON:						/* Initialize some variables */
      bj_ppte_ptr = p_bj_ppte_ptr;
      bj_pste_ptr = bj_ppte.bj_pste_ptr;
      pf_oid = bj_ppte.pf_oid;

      current_ring = get_ring_ ();
      call cu_$level_get (saved_level);
      on cleanup call cu_$level_set (saved_level);

/* Lock the bj_pste to be alone working on this journal */

      call bj_pste_lock$lock (bj_pste_ptr, bj_ppte.bj_uid);



/* If the last record to be flushed has any portion in the
   current buffer, put the buffer in the page file. 
   Then decide to flush up to the last CI put. */


      bj_ci_ptr = ptr (bj_pste_ptr, bj_pste.buffer_offset);


      if entry_no = 2
      then
         do;
	  addr (rec_id) -> rec_id_str.ci_no = bj_pste.last_ci_put;
	  addr (rec_id) -> rec_id_str.slot_no = 1;

/* In fact a better way would be to check if it is also
		necessary to flush the buffer in order to get below the
		threshold. Should be done some day.*/

         end;



      ci_no = addr (rec_id) -> rec_id_str.ci_no;

      if ci_no < bj_pste.cl.lowest_ci | ci_no > bj_pste.cl.highest_ci
      then call ERROR_RETURN (dm_error_$bj_bad_ci_no);

%page;
      if ci_no = bj_pste.last_ci_buffered | (bj_ci.header2.first_is_contn & bj_ci.header2.first_rec_id = rec_id)
      then if bj_pste.last_ci_put ^= bj_pste.last_ci_buffered
	 then call bj_storage_put_buffered_ci (pf_oid, bj_pste_ptr);


      last = bj_pste.last_ci_put;




/* Calculate the ci number of the first CI to be flushed.
   If no flush is needed, go to the end to unlock. This case may happen
   if another process has already started and completed the flush up to
   the last ci we need to flush.

   If a flush is needed, remember:
      - the last ci I am going to flush
      - the time stamp for the last ci I am going to flush
      - the number of bi's my flush is going to make safe.
*/

      if bj_pste.last_ci_on_disk = bj_pste.last_ci_put
      then goto Done;


      if bj_pste.last_ci_put = bj_pste.last_ci_buffered
      then n_bi_in_buffer = 0;
      else n_bi_in_buffer = bj_ci.header2.n_bi;


      first = bj_storage_util$next_used_ci (bj_pste_ptr, bj_pste.last_ci_on_disk);
						/* Should not rollover*/

      bj_pste.last_ci_flushed = last;

      my_last_ci_flushed = bj_pste.last_ci_flushed;
      my_stamp = bj_pste.stamp_for_last_ci_put;

      n_bi_being_saved_by_me = bj_pste.n_bi_still_unsafe - bj_pste.n_bi_being_saved - n_bi_in_buffer;

      bj_pste.n_bi_being_saved = bj_pste.n_bi_being_saved + n_bi_being_saved_by_me;
%page;
/* - Unlock the bj_pste.
   - Call the page file manager to do the flush and wait for completion.
   - Relock the bj_pste. 
*/

      call bj_pste_lock$unlock (bj_pste_ptr);

      if first <= last
      then
         do;
	  call cu_$level_set ((current_ring));
	  call file_manager_$flush_consecutive_ci (pf_oid, first, last - first + 1, code);
	  if code ^= 0
	  then call ERROR_RETURN (code);
         end;

      else
         do;
	  call cu_$level_set ((current_ring));
	  call file_manager_$flush_consecutive_ci (pf_oid, first, bj_pste.cl.highest_ci - first + 1, code);
	  if code ^= 0
	  then call ERROR_RETURN (code);

	  call file_manager_$flush_consecutive_ci (pf_oid, bj_pste.cl.lowest_ci, last - bj_pste.cl.lowest_ci + 1, code);
	  if code ^= 0
	  then call ERROR_RETURN (code);
         end;

      call cu_$level_set (saved_level);
      call bj_pste_lock$lock (bj_pste_ptr, bj_ppte.bj_uid);
%page;
/* Update the cursor bj_pste.last_ci_on_disk so that it points to the end of 
   the journal's portion completely on disk, and update the time stamp used
   by page control. These 2 items are cursors in nature and should only move
   forward, one in the journal, the other in time. The updating should cause
   these cursors to move forward, otherwise no updating should be done. 
*/


      if my_stamp > bj_pste.stamp_for_last_ci_on_disk
      then
         do;

	  bj_pste.last_ci_on_disk = my_last_ci_flushed;
	  bj_pste.stamp_for_last_ci_on_disk = my_stamp;

	  call dm_hcs_$set_journal_stamp (bj_pste.bj_ix, my_stamp, code);
	  if code ^= 0
	  then call ERROR_RETURN (code);

	  bj_pste.n_bi_still_unsafe = bj_pste.n_bi_still_unsafe - n_bi_being_saved_by_me;

	  if bj_pste.last_ci_on_disk = bj_pste.last_ci_flushed
	  then
	     do;
	        bj_pste.n_bi_being_saved = 0;

	        if bj_pste.last_ci_on_disk = bj_pste.last_ci_put
	        then
		 do;
		    if bj_pste.last_ci_put = bj_pste.last_ci_buffered
		    then bj_pste.n_bi_still_unsafe = 0;
		    else bj_pste.n_bi_still_unsafe = bj_ci.header2.n_bi;
		 end;
	     end;
         end;







Done:
      call bj_pste_lock$unlock (bj_pste_ptr);


      return;



ERROR_RETURN:
   proc (er_code);

      dcl	    er_code	       fixed bin (35);

      call cu_$level_set (saved_level);
      call bj_report_err (er_code, ME);			/* does not return */
   end ERROR_RETURN;



%page;
%include dm_bj_static;

%page;
%include dm_bj_ppt;

%page;
%include dm_bj_pst;

%page;
%include dm_bj_pste;

%page;
%include dm_bj_txt;

%page;
%include dm_bj_ci;

%page;
%include dm_ci_header;

%page;
%include dm_bj_global_error_info;

   end bj_storage_flush;




		    bj_storage_get.pl1              04/04/85  1117.3r w 04/04/85  0915.5       64305



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

/* DESCRIPTION:

*/


/* HISTORY:
Written by Andre Bensoussan,  07/14/1982 (Bastille Day).
Modified:
10/15/82 by M. Pandolf to use file_manager_ to manipulate data management
	  system files.
02/23/83 by A. Bensoussan to lock/unlock using bj_pste_lock$lock/unlock.
06/11/84 by Lee Baldwin:  Renamed dm_error_$bj_buffer_bad_uid to
            bj_bad_buffer_uid, removed dcls for dm_error_$bj_bad_buffer_address
            
            and $bj_journal_full because they're not being used.
10/12/84 by M. Sharpe:  to use "call ERROR_RETURN (code)" convention; to
	  change a goto-simulated loop to a "do while"; to clean up
	  format and dcls; to rewrite GET_CI internal procedure to
	  return a pointer to the requested ci obtained from
	  file_manager_$get_ci_ptr. 
12/06/84 by M. Sharpe:  to add format statement; to set/reset validation level
	  around the call to file_manager_.
01/11/85 by M. Sharpe:  to rest validation level in the ERROR_RETURN
	  subroutine.
*/

/* format: style4,^indcomtxt,idind40,^inddcls,indattr */

bj_storage_get: proc (p_bj_oid, p_rec_id, p_rec_ptr, p_rec_bytes);


/* Parameters */

dcl  p_bj_oid			     bit (36) aligned;
dcl  p_rec_id			     bit (36) aligned; /* id of requested record */
dcl  p_rec_ptr			     ptr;		/* ptr to logical record */
dcl  p_rec_bytes			     fixed bin;	/* number of bytes of logical record - Output */



/* Automatic */

dcl  ci_no			     fixed bin (24) uns;
dcl  code				     fixed bin (35);
dcl  curr_bytes			     fixed bin;
dcl  curr_offset			     fixed bin;
dcl  more_to_be_gotten		     bit (1);
dcl  prev_bytes			     fixed bin;
dcl  rel_distance			     fixed bin (35);
dcl  sl_no			     fixed bin (12) uns;
dcl  saved_level			     fixed bin init (-1);
dcl  current_ring			     fixed bin (3);

dcl  1 rec_id			     aligned,
       2 ci_no			     fixed bin (24) uns unaligned,
       2 sl_no			     fixed bin (12) uns unaligned;

/* Based */

dcl  RECORD_STRING			     char (curr_bytes) based;

/* Builtin */

dcl  (addcharno, addrel, null,
     ptr, size, unspec)		     builtin;

/* Condition */

dcl  cleanup			     condition;


/* Constants */

dcl  ME				     char (14) int static
				     options (constant) init ("bj_storage_get");


/* Entries */

dcl  bj_pste_lock$lock		     entry (ptr, bit (36) aligned);
dcl  bj_pste_lock$unlock		     entry (ptr);
dcl  bj_oid_util$get_ptr		     entry (bit (36) aligned) returns (ptr);
dcl  bj_report_err			     entry (fixed bin (35), char (*));
dcl  bj_storage_util$distance
				     entry (ptr, fixed bin (24) uns) returns (fixed bin (24) uns);
dcl  bj_storage_util$next_used_ci
				     entry (ptr, fixed bin (24) uns) returns (fixed bin (24) uns);
dcl  cu_$level_get			     entry (fixed bin);
dcl  cu_$level_set			     entry (fixed bin);
dcl  file_manager_$get_ci_ptr
				     entry (bit (36) aligned, fixed bin (27), ptr, fixed bin (35));
dcl  get_ring_			     entry () returns (fixed bin (3));


/* External Static */

dcl  dm_error_$bj_bad_buffer_uid	     fixed bin (35) ext;
dcl  dm_error_$bj_bad_rec_id		     fixed bin (35) ext;
dcl  dm_error_$bj_bad_continuation_flag	     fixed bin (35) ext;
dcl  dm_error_$bj_logic_err		     fixed bin (35) ext;

%page;
/* Code */

	bj_ppte_ptr = bj_oid_util$get_ptr (p_bj_oid);
	bj_pste_ptr = bj_ppte.bj_pste_ptr;
	bj_ci_ptr = ptr (bj_pste_ptr, bj_pste.buffer_offset);



	call bj_pste_lock$lock (bj_pste_ptr, bj_ppte.bj_uid);



	if bj_ci.header1.id.uid ^= bj_pste.bj_uid	/* Consistency check */
	then call ERROR_RETURN (dm_error_$bj_bad_buffer_uid);


/*
	The bj_storage_get primitive should not be concerned with buffering
	the next CI since it is not going to write in the journal. If the
	last_ci_put is the last_ci_buffered, this should not prevent the get
	primitive to function correctly.

	The bj_storage_get primitive should not be concerned with putting
	the buffered CI in the file either, even if the buffer is full, as
	long as the get primitive gets the record from the buffer if it
	happens to be in the buffer, which it does.
     */



	prev_bytes = 0;
	curr_bytes = 0;

	unspec (rec_id) = p_rec_id;
	ci_no = rec_id.ci_no;
	sl_no = rec_id.sl_no;


	current_ring = get_ring_ ();
	call cu_$level_get (saved_level);

	on cleanup call cu_$level_set (saved_level);

	more_to_be_gotten = "1"b;
	do while (more_to_be_gotten);
	     rel_distance = bj_storage_util$distance (bj_pste_ptr, bj_pste.last_ci_put)
		- bj_storage_util$distance (bj_pste_ptr, ci_no);

	     if rel_distance >= 0			/* Normal case */
	     then do;
		call cu_$level_set ((current_ring));
		bj_ci_ptr = GET_CI (ci_no);
		call cu_$level_set (saved_level);
	     end;

	     else if rel_distance = -1		/* Very special case: record is in buffer */
	     then if ci_no = bj_pste.last_ci_buffered
		then bj_ci_ptr = ptr (bj_pste_ptr, bj_pste.buffer_offset);
		else call ERROR_RETURN (dm_error_$bj_logic_err);

	     else call ERROR_RETURN (dm_error_$bj_bad_rec_id);

	     if prev_bytes = 0			/* Check existence of record with this rec_id */
	     then if sl_no > bj_ci.header2.n_slots
		     | sl_no < 1
		     | (sl_no = 1 & bj_ci.header2.first_is_contn)
		then call ERROR_RETURN (dm_error_$bj_bad_continuation_flag);
		else ;				/* OK */

	     else if sl_no > bj_ci.header2.n_slots
		| sl_no ^= 1
		| bj_ci.header2.first_is_contn = "0"b
	     then call ERROR_RETURN (dm_error_$bj_bad_continuation_flag);
	     else ;				/* OK */

	     curr_bytes = bj_ci.slot (sl_no).length;
	     curr_offset = bj_ci.slot (sl_no).offset;

	     addcharno (p_rec_ptr, prev_bytes) -> RECORD_STRING =
		addcharno (bj_ci_ptr, size (ci_header) * 4 + curr_offset) -> RECORD_STRING;

	     prev_bytes = prev_bytes + curr_bytes;

	     if (sl_no = bj_ci.header2.n_slots) & (bj_ci.header2.last_is_contd) /* Is record continued? */
	     then do;
		ci_no = bj_storage_util$next_used_ci (bj_pste_ptr, ci_no);
		sl_no = 1;
	     end;

	     else more_to_be_gotten = "0"b;

	end;					/* do while */

	p_rec_bytes = prev_bytes;

	call bj_pste_lock$unlock (bj_pste_ptr);

MAIN_RETURN:
	return;


ERROR_RETURN:
     proc (error_code);

dcl  error_code			     fixed bin (35);

	call bj_report_err (error_code, ME);		/* ....Who is going to unlock?...*/
	if saved_level > -1 then call cu_$level_set (saved_level);

	goto MAIN_RETURN;
     end ERROR_RETURN;


GET_CI: proc (get_ci_idx) returns (ptr);


dcl  get_ci_idx			     fixed bin (24) uns;
dcl  get_ci_ptr			     ptr;


	call file_manager_$get_ci_ptr ((bj_ppte.pf_oid), (get_ci_idx), get_ci_ptr, code);
	if code ^= 0 then call ERROR_RETURN (code);

	get_ci_ptr = addrel (get_ci_ptr, -(size (ci_header)));

	return (get_ci_ptr);
     end GET_CI;

%page; %include dm_bj_static;
%page; %include dm_bj_ppt;
%page; %include dm_bj_pst;
%page; %include dm_bj_pste;
%page; %include dm_bj_ci;
%page; %include dm_ci_header;
%page; %include dm_ci_parts;

     end bj_storage_get;




		    bj_storage_get_header.pl1       04/04/85  1117.3r w 04/04/85  0914.7      169560



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

/* DESCRIPTION:    


 ==> bj_storage_get_header (bj_oid, rec_id, header_ptr)

       Copies into the user's space pointed to by header_ptr (input), the header
       of the record specfied by its rec_id (input), in the journal specified
       by its opening id bj_oid (input).


 ==> bj_storage_get_header$previous (bj_oid, rec_id, header_ptr)

       Copies, into the user's space pointed to by header_ptr, the header 
       of the record previous to the record specified by its rec_id (input),
       in the journal specified by its opening id bj_oid (input). It also
       returns the rec_id of previous record in rec_id (input and output).
       If the rec_id passed by the caller has no previous record, this
       procedure sets rec_id to "0"b and does not modify the user's space
       pointed to by header_ptr.



 ==> bj_storage_get_header$last (bj_oid, rec_id, header_ptr)

       Copies, into the user's space pointed to by header_ptr (input), the 
       header of the last record of the journal specified by its opening id
       bj_oid (input), and returns the rec_id of that record in rec_id (output).
       If there is no last record, ie, the journal is empty, it returns a
       null rec_id (rec_id = "0"b) and leaves the user's space pointed to by
       header_ptr unchanged.



 ==> bj_storage_get_header$find_last_record (pf_oid, bj_pste_ptr, header_ptr)    returns rec_id.


       This procedure is called only by bj_pste_create, while opening
       a journal after a system crash. It does not assume that the process
       has a valid bj_oid for this journal, since the journal is being opened.

       It assumes however that the bj_pste is completely initialized, with
       the exception of bj_pste.last_rec_id. (In fact bj_pste.n_txn is not
       initialized either at this point, but this is irrelevant for this
       procedure.

       At this point, the last CI of the journal has already be found, and
       its ci number has been entered in bj_pste.last_ci_buffered, put, flushed
       and on_disk. Where the origin of the circular list was at the time of
       the crash is not known, and it is not neceassry to know it. The origin
       has been temporarly set to be as far as possible from the last CI, so that
       any attempt to append a record to the journal would cause a "journal_full"
       error. Later in the recovery after crash program, the journal will be
       examined to find all the unfinished transactions that were using this
       journal at the time of the crash. At that point, the bj_pste.n_txn 
       will be initialized, and the origin of the circular list will be set
       to the least recently written CI by any of the unfinished transactions.

       In order to do its job, this program starts with the last element of
       the last CI. If it is a full record, it is the last record of the
       journal. Otherwise, the previous elements have to be examined until
       a record is found. Most of the logic needed by this program already
       exist in bj_storage_get_header$previous; that is why find_last_record
       has been packaged in this segment. 


*/

/* HISTORY:

Written by A. Bensoussan, 12/06/82.
Modified:
02/23/83 by A. Bensoussan:  to lock/unlock using bj_pste_lock$lock/unlock.
12/06/84 by M. Sharpe:  to set/reset validation level around the call to
	  file_manager_, to use ERROR_RETURN.
12/06/84 by Matthew Pierret:  Changed to set current_ring in each entry
            instead of just the first.  current_ring is used to set the
            validation level.
01/17/85 by Matthew Pierret:  Changed to recognize FM_ROLLBACK_HANDLER and
            FM_POSTCOMMIT_HANDLER records.
01/23/85 by Lee A. Newcomb:  Fixed to recognize BEGIN_COMMIT records.
*/
/* format: style4,^indcomtxt,indattr,^inddcls,idind40 */
%page;
bj_storage_get_header: proc (p_bj_oid, p_rec_id, p_header_ptr);

/* Parameters */

dcl  p_bj_oid			     bit (36) aligned; /* opening id.  Input */
dcl  p_rec_id			     bit (36) aligned; /* rec_id of curr/last/prev. Input + Output */
dcl  p_header_ptr			     ptr;		/* ptr to record header.  Input */
dcl  p_pf_oid			     bit (36) aligned; /* page file oid . Input */
dcl  p_bj_pste_ptr			     ptr;		/* pste ptr. Input */


/* Automatic */


dcl  code				     fixed bin (35);
dcl  rel_distance			     fixed bin (35);

dcl  ci_no			     fixed bin (24) uns;
dcl  sl_no			     fixed bin (12) uns;

dcl  pf_oid			     bit (36) aligned;
dcl  rec_id			     bit (36) aligned;
dcl  expected_rec_id		     bit (36) aligned;
dcl  element_id			     bit (36) aligned;
dcl  record_id			     bit (36) aligned;

dcl  element_type			     char (8) aligned;
dcl  entry_point			     char (8) aligned;

dcl  LOCAL_CI			     dim (512) fixed bin (71);

dcl  saved_level			     fixed bin init (-1);
dcl  current_ring			     fixed bin (3) init (-1);


/* Based */

dcl  1 str_rec_id			     based aligned,
       2 ci_no			     fixed bin (24) uns unal,
       2 sl_no			     fixed bin (12) uns unal;

dcl  ci_bytes			     char (bj_pste.ci_size) aligned based (addr (LOCAL_CI));


/* Builtin */

dcl  (addr, null, ptr, size, substr)	     builtin;


/* Condition */

dcl  cleanup			     condition;


/* Constant */

dcl  ME				     char (21) int static
				     options (constant) init ("bj_storage_get_header");


/* Entries */

dcl  bj_oid_util$get_ptr		     entry (bit (36) aligned) returns (ptr);
dcl  bj_pste_lock$lock		     entry (ptr, bit (36) aligned);
dcl  bj_pste_lock$lock_partial_check	     entry (ptr);
dcl  bj_pste_lock$unlock		     entry (ptr);
dcl  bj_report_err			     entry (fixed bin (35), char (*));
dcl  bj_storage_util$distance		     entry (ptr, fixed bin (24) uns) returns (fixed bin (24) uns);
dcl  cu_$level_get			     entry (fixed bin);
dcl  cu_$level_set			     entry (fixed bin);
dcl  file_manager_$get		     entry (bit (36) aligned, fixed bin (24) uns, ptr, fixed bin (35));
dcl  get_ring_			     entry () returns (fixed bin (3));


/* External */

dcl  dm_error_$bj_inconsistent_ci	     fixed bin (35) ext;
dcl  dm_error_$bj_bad_ci_no		     fixed bin (35) ext;
dcl  dm_error_$bj_bad_slot_no		     fixed bin (35) ext;
dcl  dm_error_$bj_bad_rec_id		     fixed bin (35) ext;
dcl  dm_error_$bj_unknown_record_type	     fixed bin (35) ext;
dcl  dm_error_$bj_logic_err		     fixed bin (35) ext;
%page;

	entry_point = "";

	bj_ppte_ptr = bj_oid_util$get_ptr (p_bj_oid);	/* USED GLOBALLY */
	bj_pste_ptr = bj_ppte.bj_pste_ptr;		/* USED GLOBALLY */
	pf_oid = bj_ppte.pf_oid;			/* USED GLOBALLY */
	bj_ci_ptr = addr (LOCAL_CI);			/* USED GLOBALLY */


	call bj_pste_lock$lock (bj_pste_ptr, bj_ppte.bj_uid);


	rec_id = p_rec_id;

	ci_no = addr (rec_id) -> str_rec_id.ci_no;
	sl_no = addr (rec_id) -> str_rec_id.sl_no;

	call cu_$level_get (saved_level);
	current_ring = get_ring_ ();

	on cleanup call cu_$level_set (saved_level);

	call COPY_CI_LOCALLY (ci_no);			/* Copies the CI from the file 
							   or the buffer into LOCAL_CI */

	element_type = ELEMENT_TYPE (sl_no);		/* Operates on LOCAL_CI; returns 
							   "full","head", "tail" or "middle" */
	if element_type = "tail" | element_type = "middle"
	then call ERROR_RETURN (dm_error_$bj_bad_rec_id);


	call GET_RECORD_HEADER (p_rec_id, p_header_ptr);	/* Operates on LOCAL_CI */
						/* Record header is never split */



	call bj_pste_lock$unlock (bj_pste_ptr);

	return;

previous: entry (p_bj_oid, p_rec_id, p_header_ptr);


	entry_point = "previous";

	bj_ppte_ptr = bj_oid_util$get_ptr (p_bj_oid);	/* USED GLOBALLY */
	bj_pste_ptr = bj_ppte.bj_pste_ptr;		/* USED GLOBALLY */
	pf_oid = bj_ppte.pf_oid;			/* USED GLOBALLY */
	bj_ci_ptr = addr (LOCAL_CI);			/* USED GLOBALLY */

	call bj_pste_lock$lock (bj_pste_ptr, bj_ppte.bj_uid);


	rec_id = p_rec_id;

	ci_no = addr (rec_id) -> str_rec_id.ci_no;
	sl_no = addr (rec_id) -> str_rec_id.sl_no;

	call cu_$level_get (saved_level);
	current_ring = get_ring_ ();
	on cleanup call cu_$level_set (saved_level);

	call COPY_CI_LOCALLY (ci_no);			/* Copies the CI from the file 
							   or the buffer into LOCAL_CI */

	element_type = ELEMENT_TYPE (sl_no);		/* Operates on LOCAL_CI; returns 
							   "full","head", "tail" or "middle" */
	if element_type = "tail" | element_type = "middle"
	then call ERROR_RETURN (dm_error_$bj_bad_rec_id);

	element_id = rec_id;
	record_id = "0"b;
	expected_rec_id = "0"b;

	do while (record_id = "0"b & element_id ^= "0"b);

	     element_id = PREVIOUS_ELEMENT_ID (element_id); /* Gets previous ci in LOCAL_CI if necessary.
							   Returns "0"b if there is no previous. */
	     if element_id ^= "0"b then
		record_id = RECORD_ID (element_id, expected_rec_id); /* Returns "0"b if element_id is not a record_id. */
	end;


	if record_id ^= "0"b then
	     call GET_RECORD_HEADER (record_id, p_header_ptr); /* Operates on LOCAL_CI */
						/* Record header is never split */

	p_rec_id = record_id;


	call bj_pste_lock$unlock (bj_pste_ptr);

	return;



last: entry (p_bj_oid, p_rec_id, p_header_ptr);


	entry_point = "last";

	bj_ppte_ptr = bj_oid_util$get_ptr (p_bj_oid);	/* USED GLOBALLY */
	bj_pste_ptr = bj_ppte.bj_pste_ptr;		/* USED GLOBALLY */
	pf_oid = bj_ppte.pf_oid;			/* USED GLOBALLY */
	bj_ci_ptr = addr (LOCAL_CI);			/* USED GLOBALLY */



	call bj_pste_lock$lock (bj_pste_ptr, bj_ppte.bj_uid);


	ci_no = bj_pste.last_ci_buffered;

	call cu_$level_get (saved_level);
	current_ring = get_ring_ ();
	on cleanup call cu_$level_set (saved_level);

	call COPY_CI_LOCALLY (ci_no);

	if bj_ci.header2.n_slots = 0 then
	     do;
	     ci_no = bj_pste.last_ci_put;
	     call COPY_CI_LOCALLY (ci_no);
	end;

	sl_no = bj_ci.header2.n_slots;

	addr (rec_id) -> str_rec_id.ci_no = ci_no;
	addr (rec_id) -> str_rec_id.sl_no = sl_no;



	element_id = rec_id;
	record_id = "0"b;
	expected_rec_id = "0"b;

	do while (record_id = "0"b & element_id ^= "0"b);

	     record_id = RECORD_ID (element_id, expected_rec_id); /* Returns "0"b if element_id is not a record_id */

	     if record_id = "0"b then
		element_id = PREVIOUS_ELEMENT_ID (element_id); /* Returns "0"b if there is no previous element */
	end;

	if record_id ^= "0"b then
	     call GET_RECORD_HEADER (record_id, p_header_ptr); /* Operates on LOCAL_CI */
						/* Assumes record is never split */
	p_rec_id = record_id;


	call bj_pste_lock$unlock (bj_pste_ptr);


	return;


find_last_record: entry (p_pf_oid, p_bj_pste_ptr, p_header_ptr) returns (bit (36) aligned);


	entry_point = "findlast";
	bj_pste_ptr = p_bj_pste_ptr;
	pf_oid = p_pf_oid;
	bj_ci_ptr = addr (LOCAL_CI);


	call bj_pste_lock$lock_partial_check (bj_pste_ptr);

	ci_no = bj_pste.last_ci_buffered;

	call cu_$level_get (saved_level);
	current_ring = get_ring_ ();
	on cleanup call cu_$level_set (saved_level);

	call COPY_CI_LOCALLY (ci_no);

	if bj_ci.n_slots = 0 then
	     do;
	     ci_no = bj_pste.last_ci_put;
	     call COPY_CI_LOCALLY (ci_no);
	end;

	sl_no = bj_ci.n_slots;

	addr (rec_id) -> str_rec_id.ci_no = ci_no;
	addr (rec_id) -> str_rec_id.sl_no = sl_no;



	element_id = rec_id;
	record_id = "0"b;
	expected_rec_id = "0"b;

	do while (record_id = "0"b & element_id ^= "0"b);

	     record_id = RECORD_ID (element_id, expected_rec_id); /* Returns "0"b if element_id is not a record_id*/

	     if record_id = "0"b then
		element_id = PREVIOUS_ELEMENT_ID (element_id); /* Returns "0"b if no more previous element.*/
						/* Gets previous CI in LOCAL_CI if necessary. */
	end;

	if record_id ^= "0"b then
	     call GET_RECORD_HEADER (record_id, p_header_ptr); /* Operates on LOCAL_CI. */
						/* Assumes header never split */

	call bj_pste_lock$unlock (bj_pste_ptr);

MAIN_RETURN:
	return (record_id);


ERROR_RETURN:
     proc (er_code);

dcl  er_code			     fixed bin (35);

	call bj_report_err (er_code, ME || "$" || entry_point);
						/* does not return */
     end ERROR_RETURN;

%page;
COPY_CI_LOCALLY: proc (ci);

/* Copies the specified control interval into LOCAL_CI. 
	If the ci has already been put in the file, it reads it from the file. 
	If the ci is still in the buffer, it reads it from the buffer.
	It checks the consistency of the slot table. */

/* This function should be available in bj_storage_util. It could
	be used by bj_storage_get, which has almost duplicate code */


dcl  ci				     fixed bin (24) uns parameter;

dcl  p				     ptr;
dcl  q				     ptr;



	rel_distance = bj_storage_util$distance (bj_pste_ptr, bj_pste.last_ci_put)
	     - bj_storage_util$distance (bj_pste_ptr, ci);

	if rel_distance >= 0

	then do;
	     call cu_$level_set ((current_ring));
	     call GET_CI (ci);			/* Normal case: get ci from file */
	     call cu_$level_set (saved_level);
	end;

	else if rel_distance = -1

	then if ci = bj_pste.last_ci_buffered
	     then do;				/* Special case: get ci from buffer */
		p = addr (LOCAL_CI);
		q = ptr (bj_pste_ptr, bj_pste.buffer_offset);
		p -> ci_bytes = q -> ci_bytes;
	     end;

	     else call ERROR_RETURN (dm_error_$bj_logic_err);

	else call ERROR_RETURN (dm_error_$bj_bad_rec_id);


	if bj_ci.n_slots > 64 | bj_ci.n_slots < 0
	then call ERROR_RETURN (dm_error_$bj_inconsistent_ci);

	if bj_ci.n_slots > 0 then
	     if (bj_ci.header2.first_is_contn
		& bj_ci.header2.first_rec_id = "0"b)
	     then call ERROR_RETURN (dm_error_$bj_inconsistent_ci);

	return;

     end COPY_CI_LOCALLY;
%page;

GET_CI: proc (ci);					/* Could also be part of bj_storage_util */


dcl  ci				     fixed bin (24) uns;

dcl  my_ci_parts			     (5) fixed bin (71);



	if ci = 0
	     | ci < bj_pste.cl.lowest_ci
	     | ci > bj_pste.cl.highest_ci
	then call ERROR_RETURN (dm_error_$bj_bad_ci_no);


	ci_parts_ptr = addr (my_ci_parts);

	ci_parts.number_of_parts = 1;

	ci_parts.part (1).offset_in_bytes = 0;		/* Relative to header2 */
	ci_parts.part (1).length_in_bytes = bj_pste.ci_size - (size (ci_header) + size (ci_trailer)) * 4;
	ci_parts.part (1).local_ptr = addr (bj_ci.header2);

	call file_manager_$get (pf_oid, ci, ci_parts_ptr, code);
	if code ^= 0 then call ERROR_RETURN (code);


	return;
     end GET_CI;



ELEMENT_TYPE: proc (sl) returns (char (8) aligned);

/* Operate on LOCAL_CI pointed to by bj_ci_ptr. Determines if
	the element specified by its slot number sl is a "full" record,
	or only the "head", the "middle" or the "tail" part of a record.
	Returns the corresponding character string of the type found.
	Also validates the slot no and does some consistency checks. */


dcl  sl				     fixed bin (12) uns;


	if sl = 0 | sl > bj_ci.n_slots
	then call ERROR_RETURN (dm_error_$bj_bad_slot_no);


	if bj_ci.header2.first_is_contn
	     & bj_ci.header2.last_is_contd
	then do;
	     if sl = 1 & bj_ci.n_slots = 1 then return ("middle");
	end;


	if bj_ci.header2.first_is_contn
	     & sl = 1 then return ("tail");


	if bj_ci.header2.last_is_contd
	     & sl = bj_ci.header2.n_slots then return ("head");


	else return ("full");

     end ELEMENT_TYPE;

RECORD_ID: proc (element_id, expected_rec_id) returns (bit (36) aligned);


dcl  element_id			     bit (36) aligned; /* Input param */
dcl  expected_rec_id		     bit (36) aligned; /* Input + Output param */

dcl  sl				     fixed bin (12) uns;



	sl = addr (element_id) -> str_rec_id.sl_no;

	element_type = ELEMENT_TYPE (sl);

	if element_type = "full" then return (element_id);

	if element_type = "head"
	     & element_id = expected_rec_id then return (element_id);

	if element_type = "tail" then
	     expected_rec_id = bj_ci.header2.first_rec_id;

	if element_type = "middle"
	     & bj_ci.header2.first_rec_id ^= expected_rec_id then expected_rec_id = "0"b;

	return ("0"b);

     end RECORD_ID;


PREVIOUS_ELEMENT_ID: proc (element_id) returns (bit (36) aligned);

/* Operate on LOCAL_CI pointed to by bj_ci_ptr.
	The input argument is the element_id of the current element;
	that is, the element is currently in the LOCAL_CI. If there is
	a previous element in this ci, it just decreases sl by 1.
	Otherwise, it reads the previous CI into LOCAL_CI and
	sets ci to the value of the previous ci and sl to the value
	of the last slot in the CI.*/


dcl  element_id			     bit (36) aligned; /* Parameter */

dcl  ci				     fixed bin (24) uns;
dcl  sl				     fixed bin (12) uns;

dcl  bj_storage_util$previous_used_ci
				     entry (ptr, fixed bin (24) uns) returns (fixed bin (24) uns);


	ci = addr (element_id) -> str_rec_id.ci_no;
	sl = addr (element_id) -> str_rec_id.sl_no;


	if sl > 1
	then sl = sl - 1;
	else do;
	     if ci = bj_pste.cl.origin_ci then return ("0"b);
	     ci = bj_storage_util$previous_used_ci (bj_pste_ptr, ci); /* Never returns "nul value */
	     call GET_CI (ci);
	     sl = bj_ci.n_slots;
	     if sl = 0 | sl > 64			/* What is the max_sl ? */
	     then call ERROR_RETURN (dm_error_$bj_bad_slot_no);
	end;

	addr (element_id) -> str_rec_id.ci_no = ci;
	addr (element_id) -> str_rec_id.sl_no = sl;

	return (element_id);

     end PREVIOUS_ELEMENT_ID;


GET_RECORD_HEADER: proc (rec_id, header_ptr);


/* Operates on LOCAL_CI. It knows that a record header is never
	split between 2 CI's. */

dcl  rec_id			     bit (36) aligned; /* Parameter */
dcl  header_ptr			     ptr;		/* Parameter */

dcl  header_bytes			     char (4 * size (bj_rec_hdr)) aligned based (header_ptr);

dcl  sl				     fixed bin (12) uns;
dcl  offset			     fixed bin (18) uns;
dcl  rec_type			     char (4);




	sl = addr (rec_id) -> str_rec_id.sl_no;

	offset = bj_ci.slot (sl).offset;

	if bj_ci.slot (sl).length < size (bj_rec_hdr) * 4
	then call ERROR_RETURN (dm_error_$bj_inconsistent_ci);

	header_bytes = substr (ci_bytes, size (ci_header) * 4 + (offset + 1), size (bj_rec_hdr) * 4);


	rec_type = header_ptr -> bj_rec_hdr.type;

	if rec_type = BJ_RECORD_TYPE.COMMITTED
	     | rec_type = BJ_RECORD_TYPE.ABORTED
	     | rec_type = BJ_RECORD_TYPE.ROLLED_BACK
	     | rec_type = BJ_RECORD_TYPE.BEFORE_IMAGE
	     | rec_type = BJ_RECORD_TYPE.HANDLER
	     | rec_type = BJ_RECORD_TYPE.FM_ROLLBACK_HANDLER
	     | rec_type = BJ_RECORD_TYPE.FM_POSTCOMMIT_HANDLER
	     | rec_type = BJ_RECORD_TYPE.BEGIN_COMMIT
						/*
               | rec_type = BJ_RECORD_TYPE.PERFORM_COMMIT
               | rec_type = BJ_RECORD_TYPE.BEGIN_MARK
*/
	then ;					/* OK */
	else call ERROR_RETURN (dm_error_$bj_unknown_record_type);

	return;

     end GET_RECORD_HEADER;

%page;
%include dm_bj_static;

%page;
%include dm_bj_ppt;

%page;
%include dm_bj_pst;

%page;
%include dm_bj_pste;

%page;
%include dm_bj_ci;

%page;
%include dm_ci_header;

%page;
%include dm_ci;

%page;
%include dm_ci_parts;

%page;
%include dm_bj_records;


     end bj_storage_get_header;




		    bj_storage_put_buffered_ci.pl1  04/04/85  1117.3r w 04/04/85  0914.7       41058



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

/* DESCRIPTION:

     This procedure puts the last ci encached in the buffer into
     the journal by calling the file manager.

     Its callers are: - bj_storage_append (main caller)
	            - bj_storage_get (to resolve instablity)
     		  - bj_flush (if the buffer has to go to disk).

     Its code is repeatable. It can be executed any number of times
     without any effect as long as the "point of non-return" has not been
     reached, that is, as long as the instruction that changes the value
     of bj_pste.last_ci_buffered has not been executed.

     If the process is interrupted after the point of non-return,
     bj_pste.last_ci_put = bj_pste.last_ci_buffered, which indicates
     that the buffer has been put in the file and should 
     not be put again; instead, the buffer has to be advanced to the
     next free ci if anything has to be appended to the journal. It
     is only in the bj_storage_append procedure that this need exists.
     Whenever append needs to advance the buffer it calls its internal
     procedure BUFFER_NEXT_CI, whose code is also repeatable up to
     a point of non-return.
*/



/* HISTORY:
Written by Andre Bensoussan,  08/20/1982.
Modified:
10/15/82 by M. Pandolf:  to use file_manager_ for manipulation of data
	  management system files.
11/02/84 by Maggie Sharpe:  to use call ERROR_RETURN (code) convention; set
            validation level to inner-ring before calling file_manager and
            reset to user level after returning; setup a cleanup handler to
            ensure resetting of the validation level; correct minor format
            problem; rename p_pf_oid to p_file_oid as requested by auditor.
*/

/* format: style4,^inddcls,indattr,idind35,^indcomtxt */

bj_storage_put_buffered_ci:
     proc (p_file_oid, p_bj_pste_ptr);


/* Parameters */

dcl  p_file_oid			bit (36) aligned;
dcl  p_bj_pste_ptr			ptr;


/* Automatic */

dcl  ci_no			fixed bin (24) uns;
dcl  code				fixed bin (35);
dcl  my_ci_parts			(5) fixed bin (71);
dcl  saved_level			fixed bin;


/* Builtin */

dcl  (addr, ptr, size)		builtin;


/* Condition */

dcl  cleanup			condition;

/* Constant */

dcl  ME				char (26) internal static options (constant)
				init ("bj_storage_put_buffered_ci");

/* Entries */

dcl  file_manager_$put_journal	entry (bit (36) aligned, fixed bin (27), ptr, fixed bin (35));
dcl  get_ring_			entry() returns (fixed bin(3));
dcl  cu_$level_set			entry (fixed bin);
dcl  cu_$level_get			entry (fixed bin);
dcl  bj_report_err			entry (fixed bin (35), char (*));

/* External */

dcl  dm_error_$bj_bad_ci_no		fixed bin (35) ext;

%page;
/* Code */


	call cu_$level_get (saved_level);

/*  Don't leave without resetting validation level */

	on cleanup begin;
	     call cu_$level_set (saved_level);
	end;


	bj_pste_ptr = p_bj_pste_ptr;

	bj_ci_ptr = ptr (bj_pste_ptr, bj_pste.buffer_offset);

	ci_no = bj_pste.last_ci_buffered;

	if ci_no = 0
	     | ci_no < bj_pste.cl.lowest_ci
	     | ci_no > bj_pste.cl.highest_ci
	     | ci_no ^= bj_ci.header1.id.num then
	     call ERROR_RETURN (dm_error_$bj_bad_ci_no);


	ci_parts_ptr = addr (my_ci_parts);

	ci_parts.number_of_parts = 1;

	ci_parts.part (1).offset_in_bytes = 0;		/* Relative to header2 */

	ci_parts.part (1).length_in_bytes = bj_pste.ci_size - (size (ci_header) + size (ci_trailer)) * 4;

	ci_parts.part (1).local_ptr = addr (bj_ci.header2);


	call cu_$level_set (get_ring_ ());
	call file_manager_$put_journal (p_file_oid, (bj_pste.last_ci_buffered), ci_parts_ptr, code);
	call cu_$level_set (saved_level);
	if code ^= 0 then call ERROR_RETURN (code);

	bj_pste.stamp_for_last_ci_put = bj_ci.header1.stamp.time_modified; /* Used by flush */
						/* WATCH! It may have to be done AFTER
								   the point of non return to be safe */


	bj_pste.last_ci_put = bj_pste.last_ci_buffered;	/* Point of non-return */

MAIN_RETURN:
	return;


ERROR_RETURN:
	proc (error_code);

dcl  error_code			fixed bin (35);

	call bj_report_err (error_code, ME);		/* does not return */
	goto MAIN_RETURN;				/* but better safe than sorry */
	end ERROR_RETURN;


%page;	%include dm_bj_pste;
%page;	%include dm_bj_ci;
%page;	%include dm_ci_header;
%page;	%include dm_ci_parts;

     end bj_storage_put_buffered_ci;





		    bj_storage_recycle.pl1          04/04/85  1117.3re  04/04/85  0826.1      123984



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

/* DESCRIPTION:

     This procedure is called when the end of the journal is reached.
     The journal is circular; it has a head and a tail. The head moves
     forward as the journal is written into; the tail stays where it is
     and is located by bj_pste.cl.origin_ci. When the head tries to step over
     the tail, it is time to recycle some of the control intervals starting
     from the tail and going towards the head. The tail is moved forward 
     towards the head, as far as possible, that is, up to the closest CI (to
     the tail) which still has some useful information, i.e. some information
     about a transaction still in progress.

     If it can recycle at least 1 CI, it returns a zero code to the caller.
     If it cannot recycle any CI at all, it returns a "bj_journal_full"
     error code.

     It does not attempt to rollback the "slow" transactions that may be
     responsible for filling up the journal. One may try to do it in a
     later version.

     This procedure assumes that the bj_pste for this journal is already
     locked by the caller. 
*/

/* HISTORY:
Written by Andre Bensoussan,  08/06/82.
Modified:
11/18/82 by Andre Bensoussan:  to handle the special case where the caller
	  is trying to write its first logical record in the journal and
	  happens to be the only txn using the journal.
12/15/82 by Andre Bensoussan:  to update the header of the journal each time
	  the origin changes. This is necessary for finding the last CI
	  after a crash.
02/24/83 by Lee A. Newcomb:  to log error if n_txns found in pste does not
	  agree with the total found b walking the txt for the BJ used.
04/07/83 by A. Bensoussan:  to improve the message logged when number of txns 
	  in txt and pste do not agree; and also to no longer adjust the
	  number in the pste with the number found in the txt.
05/04/83 by M. Pandolf:  to add meters.
05/16/83 by A. Bensoussan:  to actually flush the new origin.
01/30/84 by M. Pandolf:  to dump txt and pst at n_txn discrepancy.
03/15/84 by M. Pandolf:  to perform more checking when determining whether
	  or not a txte has a valid transaction when calculating n_txn.  A
	  transaction is considered finished when its append state is
	  "comm" or "abor" and the record has been written; this ought to
	  close up the window where the n_txn discrepancy was.
11/02/84 by Maggie Sharpe:  to correct format and dcls; to convert a begin
            block to an internal procedure; to use "call ERROR_RETURN (code)"
            method of error_handling; to set and reset validation level
	  before calling file_manager_$? and after returning.
11/22/84 by Lee A. Newcomb:  Changed to use dm_misc_util_$get_aim_dir.
12/10/84 by R. Michael Tague:  Changed incl name to dm_daemon_sv_codes.
01/15/85 by Lee A. Newcomb:  Fixed to use dm_log_sv_codes.incl.pl1 instead of
            the obsolete dm_daemon_sv_codes.
03/05/85 by Steve Herbst: Replaced dm_log_ with dm_misc_util_$log.
*/
/* format: style4,indattr,^inddcls,ifthenstmt,ifthen,^indcomtxt,idind35 */
%page;
bj_storage_recycle: proc (p_bj_ppte_ptr, p_code);

/* START OF DECLARATIONS */

/* Parameters */
dcl  (
     p_bj_ppte_ptr			ptr,		/* Input */
     p_code			fixed bin (35)	/* Output */
     )				parameter;

/* Automatic */
dcl  (
     n_ci_recycled			fixed bin (24) uns,
     new_origin_ci			fixed bin (24) uns,
     ci_no			fixed bin (24) uns,
     distance			fixed bin (24) uns,
     bj_txt_idx			fixed bin,
     code				fixed bin (35),
     n_txn			fixed bin,
     bj_uid			bit (36) aligned,
     pf_oid			bit (36) aligned,
     txn_id			bit (36) aligned,
     saved_level			fixed bin,
     current_ring			fixed bin (3),
     1 my_bj_pste			like bj_pste aligned
     )				automatic;

/* Based */

dcl  1 rec_id_overlay		based aligned,
       2 ci_no			fixed bin (24) uns unaligned,
       2 slot			fixed bin (12) uns unaligned;

/* Builtin */

dcl  (addr, hbound, lbound, null,
     size, unspec)			builtin;

/* Condition */

dcl  cleanup			condition;

/* Entries */

dcl  bj_storage_util$distance		entry (ptr, fixed bin (24) uns) returns (fixed bin (24) uns);
dcl  bj_ci_zero$put_header		entry (bit (36) aligned, ptr, fixed bin);
dcl  cu_$level_get			entry (fixed bin);
dcl  cu_$level_set			entry (fixed bin);
dcl  dm_misc_util_$log		entry options (variable);
dcl  file_manager_$flush_consecutive_ci
				entry (bit (36) aligned, fixed bin (24), fixed bin (24), fixed bin (35));
dcl  get_ring_			entry () returns (fixed bin (3));


/* External */
dcl  (
     dm_data_$bj_txt_ptr		ptr,
     dm_error_$bj_journal_full	fixed bin (35)
     )				external;
%page;
	call cu_$level_get (saved_level);
	current_ring = get_ring_ ();

	on cleanup begin;
	     call cu_$level_set (saved_level);
	end;

	bj_ppte_ptr = p_bj_ppte_ptr;
	bj_pste_ptr = bj_ppte.bj_pste_ptr;
	bj_txt_ptr = dm_data_$bj_txt_ptr;
	bj_uid = bj_pste.bj_uid;
	pf_oid = bj_ppte.pf_oid;

	code = 0;


	new_origin_ci = bj_pste.cl.origin_ci;
	n_ci_recycled = bj_pste.cl.number_ci;		/* Max number of ci's that can be recycled */
						/* is also the max distance from origin to a ci */
	n_txn = 0;

/*
   this next loop is to find the transaction that has the oldest record
   in the before journal, so that we know how many ci's to recycle.  the
   elaborate if-then statement contains all the logic necessary to see
   if a transaction ought to be considered in our search
*/

	do bj_txt_idx = lbound (bj_txt.entry, 1) to hbound (bj_txt.entry, 1);

	     bj_txte_ptr = addr (bj_txt.entry (bj_txt_idx));

	     txn_id = bj_txte.tid;

	     if bj_txte.bj_uid = bj_uid then		/* is this txn using our BJ? */
		if txn_id ^= "0"b then		/* and is it active? */
		     if bj_txte.first_bj_rec_id ^= "0"b then /* and has a record been written? */
			if bj_txte.last_completed_operation ^= COMMITTED then
						/* and has it not been committed */
			     if bj_txte.last_completed_operation ^= ABORTED then
						/* nor aborted? */
				if (bj_txte.pending_bj_rec_id = "0"b) /* and if an operation is pending */
				     | ((bj_txte.current_operation ^= COMMITTED) /* is neither for a commit */
				     & (bj_txte.current_operation ^= ABORTED)) then /* nor for an abort? */
				     if bj_txte.tid = txn_id then /* and hasn't changed from under us? */
					do;	/* THEN THIS IS A LIVE ONE! */
					n_txn = n_txn + 1;
					ci_no = addr (bj_txte.first_bj_rec_id) -> rec_id_overlay.ci_no;
					distance = bj_storage_util$distance (bj_pste_ptr, ci_no);

					if distance < n_ci_recycled then
					     do;
					     new_origin_ci = ci_no;
					     n_ci_recycled = distance;
					end;
				     end;
	end;


	if n_txn ^= bj_pste.n_txn then		/* bj_pste and bj_txte don't agree */
	     call DUMP ();


	if n_txn = 0 then				/* See NOTE 1 */
	     do;
	     new_origin_ci = bj_pste.last_ci_on_disk;
	     n_ci_recycled = bj_storage_util$distance (bj_pste_ptr, new_origin_ci);
	end;
%page;
	if n_ci_recycled <= 0 then do;
	     bj_pste.meters.n_journal_full = bj_pste.meters.n_journal_full + 1; /* METER */
	     call ERROR_RETURN (dm_error_$bj_journal_full);
	end;

	bj_pste.meters.n_successful_recycles = bj_pste.meters.n_successful_recycles + 1; /* METER */
	bj_pste.meters.n_ci_recycled = bj_pste.meters.n_ci_recycled + n_ci_recycled;


/* Journal should be flushed at least up to the ci which will become the new 
   origin. This is to honor the convention that the origin should always be 
   flushed. With this convention, the cursors last_ci_buffered, last_ci_put,
   last_ci_flushed and last_ci_on_disk ALWAYS point to a CI in the circular 
   list and NEVER have null values.
   The bj_pste should not be unlocked during the I/O. 
*/


	if n_ci_recycled > bj_storage_util$distance (bj_pste_ptr, bj_pste.last_ci_on_disk)
	     then call FLUSH_NEW_ORIGIN ();



/* The header of the journal must be updated each time the origin of the
   circular list changes. This is to be able to find the end of the journal
   after a system crash. If we change the origin in the pste and then update
   the header, we have a window in between; if the process crashes in the
   window, the next process will not know that the header has to be updated.
   So, we take a copy of the pste, we change the origin in the copy, and we
   use the copy to update the header; then we change the origin in the pste.
   If the process crashes in the window, the header will be updated again
   when recycle is done again. */


	unspec (my_bj_pste) = unspec (bj_pste);

	my_bj_pste.cl.origin_ci = new_origin_ci;

	call bj_ci_zero$put_header (pf_oid, addr (my_bj_pste), size (bj_pste));

	call cu_$level_set ((current_ring));
	call file_manager_$flush_consecutive_ci (pf_oid, 0, 1, code);
	call cu_$level_set (saved_level);

	if code ^= 0 then call ERROR_RETURN (code);


/* Now change the origin in the bj_pste */

	bj_pste.cl.origin_ci = new_origin_ci;

	p_code = 0;
MAIN_RETURN:
	return;

ERROR_RETURN:
     proc (error_code);

dcl  error_code			fixed bin (35);

	p_code = error_code;
	goto MAIN_RETURN;

     end ERROR_RETURN;
%page;
/* NOTE 1 - This means that no transaction using the journal was found by
	inspecting the bj_txt table. However, bj_storage_recycle was called
	on behalf of a txn trying to put its first logical record in the
	journal. Since the logical record is not stored yet, or at least
	not stored completely yet, in the journal, it does not appear yet
	in the bj_txte as the first rec_id stored by this txn.

	In the special situation, if no portion of the logical record was
	stored yet, the entire journal is available; if one or several
	portions of the logical record have already be written and more
	space is needed for the rest, the entire journal is available except
	for the CI's containing the portion(s) of the logical record already
	stored. In both cases, it is safe to move the origin forward, up to
	the last_ci_on_disk. This is what the program does.

	Setting the origin to the last_ci_on_disk does, in general, make
	space available except in the following case, which is a very special
	case and very unlikely to happen: The logical record that this txn
	is attempting to write is larger than the entire journal; in this
	case the last_ci_on_disk is equal to the origin_ci. The program does
	the right thing even in this strange case: When it calculates the 
	number of recycled CI's, it does it by evaluating the distance
	between the new origin and the old origin. In this special case, the
	new origin and the old are the same and the distance is zero. The
	program returns n_ci_recycled = 0, which indicates that the journal 
	is full. */
%page;
FLUSH_NEW_ORIGIN: proc;


	call cu_$level_set ((current_ring));
	call file_manager_$flush_consecutive_ci (pf_oid, (new_origin_ci), 1, code);
	call cu_$level_set (saved_level);

	if code ^= 0 then call ERROR_RETURN (code);

	if n_ci_recycled > bj_storage_util$distance (bj_pste_ptr, bj_pste.last_ci_flushed) then
	     bj_pste.last_ci_flushed = new_origin_ci;

	bj_pste.last_ci_on_disk = new_origin_ci;



/* Note - The stamp and various counters of before images held are 
	not updated. In order to update them with the correct values, one 
	would have to keep stamp and before image info about all ci's that
	are not on disk yet; or one should read the CI before flushing it,
	and get the necessary info from the ci itself, which would be too 
	bad, considering that the ci is most likely already written out by
	page control. The "error" introduced by not doing the proper updating
	is always on the "safe" side; the flush mechanism is self adjusting,
	and the stamp and counters will soon become correct again. */



	return;
     end FLUSH_NEW_ORIGIN;
%page;
DUMP: proc ();

/*
   this routine is not to see the light of day in production.  it is an
   attempt to determine why the n_txn calculation has gone awry.
*/

dcl  dm_misc_util_$get_aim_dir	entry (char (*));
dcl  unique_chars_			entry (bit (*)) returns (char (15));
dcl  hcs_$make_seg			entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
dcl  term_$seg_ptr			entry (ptr, fixed bin (35));
dcl  aim_dir			char (168);
dcl  ecode			fixed bin (35);
dcl  entryname_prefix		char (15);
dcl  txt_cptr			ptr;
dcl  pste_cptr			ptr;
dcl  tables_available		bit (1) aligned;
dcl  RW				fixed bin (5) internal static options (constant) init (01010b);

	call dm_misc_util_$get_aim_dir (aim_dir);

	entryname_prefix = unique_chars_ (""b);

	call hcs_$make_seg (aim_dir, entryname_prefix || ".bj_pste", "",
	     RW, pste_cptr, ecode);
	if pste_cptr ^= null () then
	     do;
	     call hcs_$make_seg (aim_dir, entryname_prefix || ".bj_txt", "",
		RW, txt_cptr, ecode);
	     if txt_cptr ^= null () then
		do;
		pste_cptr -> bj_pste = bj_pste_ptr -> bj_pste;
		txt_cptr -> bj_txt = bj_txt_ptr -> bj_txt;
		call term_$seg_ptr (pste_cptr, ecode);
		call term_$seg_ptr (txt_cptr, ecode);
		tables_available = "1"b;
	     end;
	     else do;
		call term_$seg_ptr (txt_cptr, ecode);
		tables_available = "0"b;
	     end;
	end;
	else tables_available = "0"b;

	call dm_misc_util_$log (INFORM_SV, 0, "bj_storage_recycle",
	     "For bj_uid = ^o, n_txn in txt is ^d, but bj_pste.n_txn = ^d. Tables ^[copied into ^a.*^;not available^s^].",
	     bj_uid, n_txn, bj_pste.n_txn, tables_available, entryname_prefix);


     end DUMP;
%page; %include dm_bj_static;
%page; %include dm_bj_ppt;
%page; %include dm_bj_pste;
%page; %include dm_bj_txt;
%page; %include dm_log_sv_codes;
%page; %include dm_bj_records;


     end bj_storage_recycle;




		    bj_storage_util.pl1             04/04/85  1117.3r w 04/04/85  0915.5       55350



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

/* DESCRIPTION:


   ==> bj_storage_util$next_used_ci (bj_pste_ptr, ci_no)  	returns ci_no of next CI in used part of Circ. List.

   ==> bj_storage_util$previous_used_ci (bj_pste_ptr, ci_no)	returns ci_no of previous CI in used part of Circ. List.

   ==> bj_storage_util$next_free_ci  (bj_pste_ptr)		returns ci_no of next free CI.

   ==> bj_storage_util$distance (bj_pste_ptr, ci_no)	returns distance from origin.

*/


/* HISTORY:
Written by Andre Bensoussan,  08/13/1982.
Modified:
12/17/82 by Andre Bensoussan:  to add the previous_used_ci entrypoint
11/02/84 by Maggie Sharpe:  to change parameter names from capitalized names
	  to names prefixed by "p_"; to use call ERROR_RETURN (code) method
	  of error handling; corrected minor format problems.
*/

/* format: style5,^inddcls,^indcomtxt */

bj_storage_util:
        proc;				      /*  Never called here */

        signal error;
        return;


/* Paramaters */

dcl     p_bj_pste_ptr	  ptr;
dcl     p_current		  fixed bin (24) uns;
dcl     p_ci_no		  fixed bin (24) uns;


/* Automatic */

dcl     current		  fixed bin (24) uns;
dcl     next		  fixed bin (24) uns;
dcl     previous		  fixed bin (24) uns;
dcl     ci_no		  fixed bin (24) uns;
dcl     code		  fixed bin (35);

/* Conditions */

dcl     error		  condition;


/* Constant */

dcl     ME		  char (15) internal static
			  options (constant) init ("bj_storage_util");

/* External */

dcl     dm_error_$bj_bad_ci_no  ext fixed bin (35);
dcl     dm_error_$bj_no_next_used_ci
			  ext fixed bin (35);
dcl     dm_error_$bj_no_previous_used_ci
			  ext fixed bin (35);
dcl     dm_error_$bj_logic_err  ext fixed bin (35);

/* Entries */

dcl     bj_storage_recycle	  entry (ptr, fixed bin (35));
dcl     bj_report_err	  entry (fixed bin (35), char (*));

%page;

next_used_ci:
        entry (p_bj_pste_ptr, p_current) returns (fixed bin (24) uns);



/* Returns the ci_no of the next CI used in the journal.

   If the next ci used is undefined, it sets a code and invokes
   the bj_report_err procedure, which will do a non local goto
   to the bjm primitive. The various cases where the next used ci
   may be undefined are:

   o p_current is not in the circular list of the journal.
   o p_current is not in the used part of the journal.
   o p_current is the last in the used part of the journal and has no next used. */



        bj_pste_ptr = p_bj_pste_ptr;
        current = p_current;


/* Note that DISTANCE checks that current is in the circular list */


        if DISTANCE (current) >= DISTANCE (bj_pste.last_ci_buffered) then
	      call ERROR_RETURN (dm_error_$bj_no_next_used_ci);


        if current < bj_pste.cl.highest_ci then
	      next = current + 1;

        else
	      next = bj_pste.cl.lowest_ci;

        if next = bj_pste.cl.origin_ci then
	      call ERROR_RETURN (dm_error_$bj_logic_err);

        return (next);
%page;

/**** ******  NOT USED YET -- Still an internal proc in bj_storage_append. *** ****/


next_free_ci:
        entry (p_bj_pste_ptr) returns (fixed bin (24) uns);



        bj_pste_ptr = p_bj_pste_ptr;
        current = bj_pste.last_ci_buffered;

        if current < bj_pste.cl.highest_ci then
	      next = current + 1;
        else
	      next = bj_pste.cl.lowest_ci;

        if next = bj_pste.cl.origin_ci then
	      do;
	      call bj_storage_recycle (bj_pste_ptr, code);
	      if code ^= 0 then
		    call ERROR_RETURN (code);
	      end;


        return (next);
%page;

previous_used_ci:
        entry (p_bj_pste_ptr, p_current) returns (fixed bin (24) uns);



/* Returns the ci_no of the previous CI used in the journal.
   If there is no such CI, it sets the code to an error code value
   and invokes the bj_report_err procedure, which will do a non local
   goto to the external label set by the bjm primitive, or the caller
   of bj_storage_util. The various cases where there is no such CI are:

   o p_current is not a CI of the circular list of the journal
   o p_current is not in the used part of the journal.
   o p_current is the first CI in the used list: it has no previous. */



        bj_pste_ptr = p_bj_pste_ptr;
        current = p_current;


        if DISTANCE (current) > DISTANCE (bj_pste.last_ci_buffered) then
	      call ERROR_RETURN (dm_error_$bj_bad_ci_no);


        if current = bj_pste.cl.origin_ci then
	      call ERROR_RETURN (dm_error_$bj_no_previous_used_ci);


        if current > bj_pste.cl.lowest_ci then
	      previous = current - 1;
        else
	      previous = bj_pste.cl.highest_ci;

        return (previous);
%page;

distance:
        entry (p_bj_pste_ptr, p_ci_no) returns (fixed bin (24) uns);


/* Returns the distance of a given CI to the origin of the
   circular list. The given CI has to be in the circular list,
   otherwise an error_code is set and a nonlocal goto is performed.
   the distance returned is always  positive or null, and represents
   the number of steps forwards starting at the origin to get to
   the given CI.

   0 <= distance < bj_pste.cl.number_ci

*/





        bj_pste_ptr = p_bj_pste_ptr;
        ci_no = p_ci_no;


        return (DISTANCE (ci_no));
%page;


DISTANCE:
        proc (ci) returns (fixed bin (24) uns);


dcl     ci		  fixed bin (24) uns;



        if ci < bj_pste.cl.lowest_ci		      /* Make sure ci is in Circ.List */
	  | ci > bj_pste.cl.highest_ci then
	      call ERROR_RETURN (dm_error_$bj_bad_ci_no);


        if ci >= bj_pste.cl.origin_ci then
	      return (ci - bj_pste.cl.origin_ci);
        else
	      return (ci - bj_pste.cl.origin_ci + bj_pste.cl.number_ci);

        end DISTANCE;



ERROR_RETURN:
        proc (error_code);

dcl     error_code		  fixed bin (35);

        call bj_report_err (error_code, ME);	      /* does not return */

        end ERROR_RETURN;

%page;
%include dm_bj_pste;

        end bj_storage_util;




		    bj_txte_util.pl1                04/02/87  1316.1rew 04/02/87  1300.0      173439



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

/* DESCRIPTION

	A support routine for bjm_write, bjm_rollback, and
     bjm_adopt_transaction.  This procedure contains the necessary logic to
     finish the housekeeping after a record is successfully written in a
     before journal.  If a record has not been successfully written (ie.,
     it is pending), then the state is quiesed, assuming that it was never
     even written.  Although this code seems better suited for residence in
     bjm_write.pl1, its functions are required by the other two procedures
     mentioned above.  Instead of duplicating code, the writer chose to
     localize the funcitonal capability into a single compileable unit.
     Nevertheless, the thought of fairly optimized code in bjm_write making
     an external call to this routine turns this author's stomach.


	NOTE	NOTE	NOTE	NOTE
	ANY changes to this procedure's mechanisms should be carefully
     examined to be sure they do not conflict with assumptions made in
     bjm_write and bjm_find_txns_after_crash.  Though the latter does not
     directly call this procedure, it "knows" various assumptions made by
     bjm_write and this module and crash recovery could break if changes
     are not propogated.
*/

/* HISTORY PRIOR TO INITIAL ISTALLATION:
     
     Written by M. Pandolf, 03/08/83.
     Modified:
     04/08/83 by M. Pandolf:  to use bj_txte.entry_state and
                 to add update_records_info.
     04/29/83 by M. Pandolf:  to add meters.
     12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
     11/02/84 by Maggie Sharpe:  To use "call ERROR_RETURN (code)" method of error
            handling; to clean up format and dcls; to remove 2 lines of
            duplicated code from the FINISH_BEFORE_IMAGE procedure (code
            already executed in COPY_REC_INFO) in callers); to set validation
            level before calling file_manager and reset it after retruning
            (includes setting up a cleanup handler in the routine
            EXECUT_POSTCOMMIT_HANDLER).
     12/14/84 by Matthew C. Pierret:  Changed contract with
            file_manager_$postcommit_do slightly.  Now, if this process is the
            same as the owner process, the opening id in the postcommit
            handler is passed to file_mnager_$postcommit_do, otherwise a value
            of ZERO is passed.  file_manager_ has decided that it wants the
            opening id in the former case so that it can reset the opening
            information.
     03/04/85 by Lee A. Newcomb:  Fixed to flush FM_ROLLBACK_HANDLER records.
     03/05/85 by Steve Herbst: Replaced dm_log_ with dm_misc_util_$log.

     END HISTORY PRIOR TO INITIAL INSTALLATION */

/****^  HISTORY COMMENTS:
  1) change(86-01-07,Pierret), approve(86-01-30,MCR7331),
     audit(86-04-28,Newcomb), install(86-05-06,MR12.0-1054):
     Changed to correctly set bj_rec_hdr.tid in WRITE_COMMITTED_MARK.
  2) change(87-01-15,Hergert), approve(87-04-01,MCR7632),
     audit(87-02-09,Dupuis), install(87-04-02,MR12.1-1020):
     For TR phx20754, added the internal procedure FIND_NEW_INCR_ARRAY to be
     used when the increment array in key_count_array has moved as detected by
     fm_do_. This is the case if the control interval has been rearranged as is
     the case in a compaction or split. Most of the contents of this new
     procedure are taken from cm_get_bci_header$slot.
                                                   END HISTORY COMMENTS */
/* format: style4,^inddcls,indattr,ifthenstmt,ifthen,^indcomtxt,idind35 */
%page;
bj_txte_util$before_image:
     procedure (p_txte_ptr);


/* Parameter */

dcl  p_txte_ptr			pointer parameter;	/* assume this value to be correct */

/* Automatic */
dcl  code				fixed bin (35);	/* system status code */
dcl  fm_oid			bit (36) aligned;	/* per-process opening ID of DM file */
dcl  n_rec_bytes			fixed bin;	/* length of a record in bytes, incl header */
dcl  saved_level			fixed bin;	/* user's validation level */
dcl  this_rec_id			bit (36) aligned;	/* ID of BJ record to be processed */
dcl  time_stamp			fixed bin (71);	/* time BJ record written */


/* Builtin */

dcl  (addr, size)			builtin;

/* Condition */

dcl  cleanup			condition;

/* Constant */

dcl  ZERO				bit (36) aligned internal static options (constant)
				init ((36)"0"b);
dcl  ME				char (32) internal static options (constant)
				init ("bj_txte_util");

/* Entry */

dcl  bj_storage_flush$up_to_rec_id	entry (ptr, bit (36) aligned);
dcl  bj_storage_get			entry (bit (36) aligned, bit (36) aligned, ptr, fixed bin);
dcl  bj_storage_append		entry (bit (36) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (36) aligned,
				fixed bin (71));
dcl  bj_report_err			entry (fixed bin (35), char (*));
dcl  bj_pste_lock$lock		entry (ptr, bit (36) aligned);
dcl  bj_pste_lock$unlock		entry (ptr);
dcl  cu_$level_get			entry (fixed bin);
dcl  cu_$level_set			entry (fixed bin);
dcl  dm_misc_util_$log		entry () options (variable);
dcl  file_manager_$postcommit_do	entry (bit (36) aligned, bit (36) aligned, ptr, fixed bin, fixed bin (35));
dcl  get_ring_			entry () returns (fixed bin (3));

/* External Static */

dcl  bjm_data_$bj_ppt_ptr		pointer external static;
dcl  bjm_data_$bj_rollback_buffer_ptr	pointer external static;
dcl  dm_error_$ci_not_allocated	fixed bin (35) ext static;
dcl  dm_error_$misformatted_ci	fixed bin (35) ext static;
dcl  dm_error_$not_own_transaction	fixed bin (35) ext static;
dcl  dm_error_$incr_array_not_found     fixed bin (35) ext static;
     

%page;
/* bj_txte_util$before_image:			repeat for reader	*/
/*      procedure (p_txte_ptr);				*/

	bj_txte_ptr = p_txte_ptr;

	if bj_txte.append_state.pending_bj_rec_id ^= ZERO
	     then call FINISH_BEFORE_IMAGE ();

	call MAKE_STATE_QUIESED ();

	return;

bj_txte_util$aborted_mark:
     entry (p_txte_ptr);

	bj_txte_ptr = p_txte_ptr;

	if bj_txte.append_state.pending_bj_rec_id ^= ZERO
	     then call FINISH_ABORTED_MARK ();

	call MAKE_STATE_QUIESED ();

	return;

bj_txte_util$simple_commit:
     entry (p_txte_ptr);

	bj_txte_ptr = p_txte_ptr;

	if bj_txte.append_state.pending_bj_rec_id ^= ZERO
	     then call FINISH_COMMITTED_MARK ();

	call MAKE_STATE_QUIESED ();

	return;

bj_txte_util$complex_commit:
     entry (p_txte_ptr);

	bj_txte_ptr = p_txte_ptr;

	if bj_txte.append_state.pending_bj_rec_id ^= ZERO
	then do;

	     call FINISH_BEGIN_COMMIT_MARK ();

	     call EXECUTE_POSTCOMMIT_HANDLERS ();

	     call WRITE_COMMITTED_MARK ();

	     call FINISH_COMMITTED_MARK ();

	end;

	call MAKE_STATE_QUIESED ();

	return;

bj_txte_util$postcommit_mark:
     entry (p_txte_ptr);

	bj_txte_ptr = p_txte_ptr;

	if bj_txte.append_state.pending_bj_rec_id ^= ZERO
	     then call FINISH_POSTCOMMIT_MARK ();

	call MAKE_STATE_QUIESED ();

	return;

bj_txte_util$rolled_back_mark:
     entry (p_txte_ptr);

	bj_txte_ptr = p_txte_ptr;

	if bj_txte.append_state.pending_bj_rec_id ^= ZERO
	     then call FINISH_ROLLED_BACK_MARK ();

	call MAKE_STATE_QUIESED ();

	return;

bj_txte_util$fm_rollback_handler:
     entry (p_txte_ptr);

	bj_txte_ptr = p_txte_ptr;

	if bj_txte.append_state.pending_bj_rec_id ^= ZERO
	     then call FINISH_FM_ROLLBACK_HANDLER ();

	call MAKE_STATE_QUIESED ();

	return;

bj_txte_util$fm_postcommit_handler:
     entry (p_txte_ptr);

	bj_txte_ptr = p_txte_ptr;

	if bj_txte.append_state.pending_bj_rec_id ^= ZERO
	     then call FINISH_FM_POSTCOMMIT_HANDLER ();

	call MAKE_STATE_QUIESED ();

	return;

bj_txte_util$update_records_info:
     entry (p_txte_ptr);

	bj_txte_ptr = p_txte_ptr;

	if bj_txte.append_state.current_operation = ""
	     then return;

	if bj_txte.operator_info.process_id ^= bjm_data_$bj_ppt_ptr -> bj_ppt.process_id
	     then call bj_report_err (dm_error_$not_own_transaction, ME);

	call COPY_REC_INFO ();

	return;

bj_txte_util$synchronize_txte_pste:
     entry (p_txte_ptr);

	bj_txte_ptr = p_txte_ptr;

	if bj_txte.append_state.current_operation = ""
	     then return;

	if bj_txte.operator_info.process_id ^= bjm_data_$bj_ppt_ptr -> bj_ppt.process_id
	     then call bj_report_err (dm_error_$not_own_transaction, ME);

	bj_ppte_ptr = bj_txte.operator_info.ppte_ptr;
	bj_pste_ptr = bj_ppte.bj_pste_ptr;

/*
   at this point, locking the PSTE will synchronize it with its TXTE.  however,
   we don't know if the pste_ptr points to the correct PSTE.  if we were to
   check the PSTE, all we would know is that it did not belong to this TXTE.
   in the mean time we have just synchronized it with its own TXTE.  if we were
   really concerned with finding the correct PSTE, we would check each PSTE
   for a meaningful append_state.txte_rec_id_relp, but is the overhead worth
   it?
*/

	call bj_pste_lock$lock (bj_pste_ptr, bj_ppte.bj_uid); /* will blow up if pste and ppte UIDs don't match */
	call bj_pste_lock$unlock (bj_pste_ptr);		/* so we were successful if we are here */

/* complete any operation that was pending */

	if bj_txte.append_state.pending_bj_rec_id = ZERO	/* write never completed */
	then do;
	     call MAKE_STATE_QUIESED ();
	     return;
	end;

	if bj_txte.append_state.current_operation = BEGIN_COMMIT
	then do;
	     call FINISH_BEGIN_COMMIT_MARK ();
	     call EXECUTE_POSTCOMMIT_HANDLERS ();
	     call WRITE_COMMITTED_MARK ();
	     call FINISH_COMMITTED_MARK ();
	end;
	else if bj_txte.append_state.current_operation = PERFORM_COMMIT
	then do;
	     call EXECUTE_POSTCOMMIT_HANDLERS ();
	     call WRITE_COMMITTED_MARK ();
	     call FINISH_COMMITTED_MARK ();
	end;
	else if bj_txte.append_state.current_operation = COMMITTED
	     then call FINISH_COMMITTED_MARK ();
	else if bj_txte.append_state.current_operation = ABORTED
	     then call FINISH_ABORTED_MARK ();
	else if bj_txte.append_state.current_operation = ROLLED_BACK
	     then call FINISH_ROLLED_BACK_MARK ();
	else if bj_txte.append_state.current_operation = BEFORE_IMAGE
	     then call FINISH_BEFORE_IMAGE ();
	else if bj_txte.append_state.current_operation = FM_ROLLBACK_HANDLER
	     then call FINISH_FM_ROLLBACK_HANDLER ();
	else if bj_txte.append_state.current_operation = FM_POSTCOMMIT_HANDLER
	     then call FINISH_FM_POSTCOMMIT_HANDLER ();

	call MAKE_STATE_QUIESED ();

	return;


%page;

/* INTERNAL PROCEDURES */

MAKE_STATE_QUIESED:
     procedure ();

	bj_txte.entry_state.last_completed_operation = bj_txte.append_state.current_operation;

	bj_txte.append_state.current_operation = "";	/* officially quiesed */
	bj_txte.append_state.pending_bj_rec_id = ZERO;
	bj_txte.append_state.pending_n_rec_written = 0;
	bj_txte.append_state.pending_n_bytes_written = 0;

	return;

     end MAKE_STATE_QUIESED;

COPY_REC_INFO:
     procedure ();

	bj_txte.records_info.last_bj_rec_id = bj_txte.append_state.pending_bj_rec_id;
	bj_txte.records_info.n_rec_written = bj_txte.append_state.pending_n_rec_written;
	bj_txte.records_info.n_bytes_written = bj_txte.append_state.pending_n_bytes_written;

	if bj_txte.records_info.first_bj_rec_id = ZERO
	then do;
	     bj_txte.records_info.first_bj_rec_id = bj_txte.records_info.last_bj_rec_id;
	     bj_txte.ppte_ptr -> bj_ppte.bj_pste_ptr -> bj_pste.meters.n_non_null_txn =
		bj_txte.ppte_ptr -> bj_ppte.bj_pste_ptr -> bj_pste.meters.n_non_null_txn + 1;
	end;

	return;

     end COPY_REC_INFO;

FINISH_BEFORE_IMAGE:
     procedure ();

	call COPY_REC_INFO ();

	return;

     end FINISH_BEFORE_IMAGE;

FINISH_ABORTED_MARK:
     procedure ();

	call COPY_REC_INFO ();

	call bj_storage_flush$up_to_rec_id (bj_txte.ppte_ptr, bj_txte.append_state.pending_bj_rec_id);

	bj_txte.entry_state.ok_to_write = "0"b;

	return;

     end FINISH_ABORTED_MARK;

FINISH_COMMITTED_MARK:
     procedure ();

	call COPY_REC_INFO ();

	call bj_storage_flush$up_to_rec_id (bj_txte.ppte_ptr, bj_txte.append_state.pending_bj_rec_id);

	bj_txte.entry_state.ok_to_write = "0"b;

	return;

     end FINISH_COMMITTED_MARK;

FINISH_BEGIN_COMMIT_MARK:
     procedure ();

	call COPY_REC_INFO ();

	call bj_storage_flush$up_to_rec_id (bj_txte.ppte_ptr, bj_txte.append_state.pending_bj_rec_id);

	return;

     end FINISH_BEGIN_COMMIT_MARK;

FINISH_POSTCOMMIT_MARK:
     procedure ();

	call COPY_REC_INFO ();

	call bj_storage_flush$up_to_rec_id (bj_txte.ppte_ptr, bj_txte.append_state.pending_bj_rec_id);

	return;

     end FINISH_POSTCOMMIT_MARK;

FINISH_ROLLED_BACK_MARK:
     procedure ();

	call COPY_REC_INFO ();

	call bj_storage_flush$up_to_rec_id (bj_txte.ppte_ptr, bj_txte.append_state.pending_bj_rec_id);

	bj_txte.curr_checkpoint_rec_id = ZERO;
	bj_txte.last_fm_postcommit_handler_rec_id = ZERO;
	bj_txte.records_info.first_bj_rec_id = bj_txte.records_info.last_bj_rec_id;

	return;

     end FINISH_ROLLED_BACK_MARK;

FINISH_FM_ROLLBACK_HANDLER:
     procedure ();

	call COPY_REC_INFO ();

	call bj_storage_flush$up_to_rec_id (bj_txte.ppte_ptr, bj_txte.append_state.pending_bj_rec_id);

	return;

     end FINISH_FM_ROLLBACK_HANDLER;

FINISH_FM_POSTCOMMIT_HANDLER:
     procedure ();

	call COPY_REC_INFO ();

	bj_txte.last_fm_postcommit_handler_rec_id =
	     bj_txte.append_state.pending_bj_rec_id;

	return;

     end FINISH_FM_POSTCOMMIT_HANDLER;

WRITE_COMMITTED_MARK:
     procedure ();

dcl  1 my_bj_committed_record		like bj_committed_rec;

	my_bj_committed_record.type = BJ_RECORD_TYPE.COMMITTED;
	my_bj_committed_record.tid = bj_txte.tid;
	my_bj_committed_record.process_id = bj_txte.owner_info.process_id;
	my_bj_committed_record.prev_rec_id = bj_txte.last_bj_rec_id;
	my_bj_committed_record.tx_rec_no = bj_txte.n_rec_written + 1;
	n_rec_bytes = size (my_bj_committed_record) * 4;

/* next section of code is to behave as bjm_write does:
	call APPEND (addr (my_bj_committed_record), n_rec_bytes, -1, 0, FLUSH);
*/

	bj_txte.append_state.pending_bj_rec_id = ZERO;
	bj_txte.append_state.pending_n_rec_written = bj_txte.records_info.n_rec_written + 1;
	bj_txte.append_state.pending_n_bytes_written = bj_txte.records_info.n_bytes_written + size (my_bj_committed_record) * 4;

	bj_txte.append_state.current_operation = my_bj_committed_record.type;

	call bj_storage_append (bj_txte.bj_oid, addr (my_bj_committed_record), size (my_bj_committed_record) * 4,
	     -1, 0, bj_txte.append_state.pending_bj_rec_id, time_stamp);

	return;

     end WRITE_COMMITTED_MARK;

EXECUTE_POSTCOMMIT_HANDLERS:
     procedure ();

/* change the append state of this transaction  to reflect this operation */

	bj_txte.append_state.current_operation = BJ_RECORD_TYPE.PERFORM_COMMIT;
	bj_txte.append_state.pending_bj_rec_id = ZERO;
	bj_txte.append_state.pending_n_rec_written = 0;
	bj_txte.append_state.pending_n_bytes_written = 0;

	bj_rec_hdr_ptr = bjm_data_$bj_rollback_buffer_ptr;

	call cu_$level_get (saved_level);

	on cleanup begin;
	     call cu_$level_set (saved_level);
	end;

postcommit_loop:
	do this_rec_id = bj_txte.last_fm_postcommit_handler_rec_id
	     repeat (bj_fm_handler_rec.prev_fm_handler_rec_id)
	     while (this_rec_id ^= ZERO);

	     call bj_storage_get (bj_txte.bj_oid, this_rec_id, bj_rec_hdr_ptr, n_rec_bytes);

	     if bj_rec_hdr.type ^= BJ_RECORD_TYPE.FM_POSTCOMMIT_HANDLER
		then call dm_misc_util_$log (LOG_SV, 0, ME, "non postcommit handler record found in postcommit list.");
	     else do;

		if bj_txte.owner_info.process_id ^= bjm_data_$bj_ppt_ptr -> bj_ppt.process_id
		     then fm_oid = ZERO;
		else fm_oid = bj_fm_handler_rec.fm_oid;
		call cu_$level_set (get_ring_ ());
		call file_manager_$postcommit_do (bj_fm_handler_rec.fm_uid, fm_oid,
		     addr (bj_fm_handler_rec.info_bytes), bj_fm_handler_rec.info_len, code);
		call cu_$level_set (saved_level);

		if code = dm_error_$incr_array_not_found
		then do;
		     call dm_misc_util_$log (INFORM_SV, code, ME, "One attempt will be made to recover it.");
		     call FIND_NEW_INCR_ARRAY;
		     call cu_$level_set (get_ring_ ());
		     call file_manager_$postcommit_do (bj_fm_handler_rec.fm_uid, fm_oid,
			addr (bj_fm_handler_rec.info_bytes), bj_fm_handler_rec.info_len, code);
		     call cu_$level_set (saved_level);
		end;
		if code = dm_error_$incr_array_not_found
		then call dm_misc_util_$log (ERROR_SV, 0, ME, "Attempt to recover new key_count_array failed.");
		else if code ^= 0
		     then call dm_misc_util_$log (ERROR_SV, code, ME,
		          "Error from calling file_manager_$postcommit_do.");
	     end;

	end postcommit_loop;

     end EXECUTE_POSTCOMMIT_HANDLERS;

FIND_NEW_INCR_ARRAY:
     proc;

 /* here we have concluded that the key_count_array is not where we left it 
    at the time we wrote the post_commit handler (usually firstref in a txn).
    we will try to find it with the fm_oid and the element_id stored in
    bj_fm_handler_rec and increment_postcommit_info.
*/

dcl 1 local_bci_header aligned like bci_header;
dcl 1 local_datum_slot aligned like datum_slot;
dcl 1 local_ci_parts aligned,
      2 number_of_parts fixed bin,
      2 part (2) like ci_parts.part;
     
dcl BYTES_PER_WORD init(4) fixed bin(17) internal static options(constant);
dcl file_manager_$get entry (bit(36) aligned, fixed bin(27), ptr, fixed bin(35));

     postcommit_info_ptr = addr(bj_fm_handler_rec.info_bytes);
     element_id_string= increment_postcommit_info.element_id;

     local_ci_parts.number_of_parts = 1;
     local_ci_parts.part (1).offset_in_bytes = 0;
     local_ci_parts.part (1).length_in_bytes = size (local_bci_header) * BYTES_PER_WORD;
     local_ci_parts.part (1).local_ptr = addr(local_bci_header);

     if element_id.index > 0 then do;
	local_ci_parts.number_of_parts = 2;
	local_ci_parts.part (2).offset_in_bytes = (size (local_bci_header) + element_id.index - 1) * BYTES_PER_WORD;
	local_ci_parts.part (2).length_in_bytes = BYTES_PER_WORD;
	local_ci_parts.part (2).local_ptr = addr(local_datum_slot);
     end;

     call file_manager_$get (fm_oid, (element_id.control_interval_id), addr (local_ci_parts), code);
     if code = 0
	then if local_bci_header.layout_type ^= BASIC_CI_LAYOUT_1
	     then if unspec (local_bci_header) = "0"b
	          then code = dm_error_$ci_not_allocated;
                    else code = dm_error_$misformatted_ci;

     if code ^= 0 then
	call dm_misc_util_$log(ERROR_SV, code, ME, 
	"Attempting to recover new key_count_array after second try.");

/* local_datum_slot.offset_in_bytes point to the beginning of the key_count
   structure. The array actually starts at key_count_array.count(0) which is
    KEY_COUNT_OFFSET_IN_CHARACTERS bytes in.
*/

     increment_postcommit_info.offset_in_bytes =
	local_datum_slot.offset_in_bytes + KEY_COUNT_OFFSET_IN_CHARACTERS; 

end FIND_NEW_INCR_ARRAY;

/* Include Files */
%page; %include dm_bj_pst;
%page; %include dm_bj_pste;
%page; %include dm_bj_ppt;
%page; %include dm_bj_txt;
%page; %include dm_bj_records;
%page; %include dm_ci_parts;
%page; %include dm_cm_basic_ci;
%page; %include dm_element_id;
%page; %include dm_fm_postcommit_info;
%page; %include dm_key_count_array;
%page; %include dm_log_sv_codes;


     end bj_txte_util$before_image;




		    bjm_abandon_transaction.pl1     04/04/85  1117.3re  04/04/85  0826.1       34020



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

/* DESCRIPTION:

	A procedure to allow a process other than the one that started a
     transaction to complete the transaction.  from the point of before
     journal manager, abandoning means the changing of some TXTE
     information for a transaction.  this change is local to before journal
     manager and there are no implicit effects to any other subsystem.
*/

/* HISTORY
Written by M. Pandolf, 09/01/82.
Modified:
10/27/82 by M. Pandolf:  to bjm_abandon_transaction.
 02/14/83 by M. Pandolf:  to force abandon on cleanup.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/07/84 by Lee Baldwin:  Fixed to call dm_error_$no_current_transaction
            instead of dm_error_$bj_no_txn.
10/24/84 by M.Sharpe:  to clean up dcls and format; to use the
	  "call ERROR_RETURN (code)" convention.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
*/
 
/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

bjm_abandon_transaction:
     procedure (p_tid, p_tix, p_code);

/* DECLARATIONS */

/* Parameter */

dcl  p_tid		        bit (36) aligned parameter; /* transaction ID */
dcl  p_tix		        fixed bin parameter;	/* transaction index */
dcl  p_code		        fixed bin (35) parameter; /* standard system status code */

/* Automatic */

dcl  tid			        bit (36) aligned;	/* local copy of transaction ID */
dcl  tix			        fixed bin;		/* local copy of transaction index */

/* Condition */

dcl  cleanup		        condition;

/* Constant */

dcl  ME			        char (32) internal static options (constant) init ("bjm_abandon_transaction");

/* Entry */

dcl  bj_adopt_txn$abandon	        entry (fixed bin, bit (36) aligned);
dcl  bj_adopt_txn$force_abandon       entry ();
dcl  bj_cleanup_tables$handler        entry (fixed bin (35));

/* External Static */

dcl  dm_error_$bj_recursive_invoc     fixed bin (35) external static;
dcl  dm_error_$no_current_transaction fixed bin (35) external static;

%page;
/* initialize parameters */

	tid = p_tid;
	tix = p_tix;
	p_code = 0;

/* set up addresses for unexpected error */

	bjm_data_$bj_exit_err = nonlocal_error_exit;
	bjm_data_$bj_code = 0;

	on cleanup call CLEANUP;

	if bjm_data_$bj_operation = ""
	then bjm_data_$bj_operation = ME;
	else do;
	     p_code = dm_error_$bj_recursive_invoc;
	     goto MAIN_RETURN;
	end;

/* check parameters */

	if tix < 1 | tix > dm_system_data_$max_n_transactions
	then call ERROR_RETURN (dm_error_$no_current_transaction);


/* the transaction seems valid, so invoke the primitive to abandon the transaciton */

	call bj_adopt_txn$abandon (tix, tid);


	bjm_data_$bj_operation = "";
	bjm_data_$bj_exit_err = bjm_data_$bj_default_error_label;

MAIN_RETURN:
	return;

nonlocal_error_exit:
	call ERROR_RETURN (bjm_data_$bj_code);

%page;
/* Internal Procedures */

ERROR_RETURN:
	procedure (error_code);

dcl	error_code		fixed bin (35);

	call CLEANUP;
	p_code = error_code;
	goto MAIN_RETURN;

     end ERROR_RETURN;



CLEANUP:
     procedure ();

dcl  cleanup_code		        fixed bin (35);

	call bj_adopt_txn$force_abandon ();
	call bj_cleanup_tables$handler (cleanup_code);

	bjm_data_$bj_operation = "";
	bjm_data_$bj_exit_err = bjm_data_$bj_default_error_label;

	return;

     end CLEANUP;


%page;
%include dm_bj_static;
%page;
%include dm_bj_txt;
%page;
%include dm_bj_global_error_info;
%page;

     end bjm_abandon_transaction;




		    bjm_adjust_process_id.pl1       04/04/85  1117.3re  04/04/85  0826.1       64710



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

/* DESCRIPTION:

	This procedure removes a process_id from the before journal per
     system check in table.  It produces minimal changes: all bits in the
     table for a process are removed and the process_id is removed.  If the
     journal is no longer used by any process nor by any transaction, it is
     deactivated.
*/

/* HISTORY:

Written by M. Pandolf, 11/08/82.
Modified:
11/23/82 by A. Bensoussan:  to call dm_hcs_$free_journal.
02/25/83 by A. Bensoussan:  to free bj_pste.
03/29/83 by A. Bensoussan:  to call bj_pste_register$check_out_dead where
	  the knowledge about the check_in_table is centralized, and also
	  to call bj_pste_delete where the deletion of pste is centralized.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
12/10/84 by R. Michael Tague:  Changed incl name to dm_daemon_sv_codes.
01/16/85 by Lee A. Newcomb:  Fixed to not set bjm_data_$exit_err before setting
            bjm_data_$bj_operation; removed the unreferenced
            dm_daemon_sv_codes.incl.pl1 and other unref'd variables; fixed the
            format to conform with project standards.
02/13/85 by Lee A. Newcomb:  Fixed to use the ERROR_RETURN mechanism; use
	  use the new version constant BJ_PSTE_VERSION_2; and to check
	  the version of the BJ_PST after we get its location.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
*/
/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bjm_adjust_process_id:
   procedure (p_process_id, p_code);

/* DECLARATIONS */

/* Parameters */
dcl  (
     p_process_id			bit (36),		/* process to eliminate */
     p_code			fixed bin (35)	/* error code */
     )				parameter;

/* Automatic */
dcl  (
     bjm_clean_up_needed		bit (1) aligned init (""b),
     process_id			bit (36) aligned,	/* local copy of parameter */
     code				fixed bin (35),	/* local status code */
     bj_ix			fixed bin		/* index of journal in PST tables */
     )				automatic;

/* Builtin */
dcl  (addr, null)			builtin;

/* Condition */
dcl  cleanup			condition;

/* Constant */
dcl  (
     CHECK_FOR_BJM_RECURSION		bit (1) aligned init ("1"b),
     DONT_CHECK_FOR_BJM_RECURSION	bit (1) aligned init ("0"b),
     ME				char (32)
				init ("bjm_adjust_process_id")
     )				internal static options (constant);

/* Entry */
dcl  (
     bj_cleanup_tables$handler	entry (fixed bin (35)),
     bj_pst_lock			entry (),
     bj_pst_lock$unlock		entry (),
     bj_pste_delete			entry (ptr),
     bj_pste_register$check_out_dead	entry (ptr, bit (36) aligned),
     hcs_$validate_processid		entry (bit (36) aligned,
				fixed bin (35))
     )				external;		/* External */
dcl  (
     bjm_data_$bj_pst_ptr		pointer,
     (
     dm_error_$bj_bad_pst_version,
     dm_error_$bj_recursive_invoc,
     dm_error_$valid_process
     )				fixed bin (35)
     )				external static;

/* Static */

/* END OF DECLARATIONS */
%page;
COPY_AND_INIT_PARAMETERS:
   do;
      process_id = p_process_id;
      p_code = 0;
   end COPY_AND_INIT_PARAMETERS;

SETUP_FOR_NON_STANDARD_EXIT:
   do;
      on cleanup call CLEAN_UP ();

      call SET_BJM_DATA_ERROR_HANDLING_VALUES (NONLOCAL_ERROR_EXIT, ME,
	 CHECK_FOR_BJM_RECURSION);

   end SETUP_FOR_NON_STANDARD_EXIT;

FIND_BJ_PST:
   do;
      bj_pst_ptr = bjm_data_$bj_pst_ptr;
      call CHECK_VERSION_NUMERIC (bj_pst.version, BJ_PST_VERSION_1,
	 dm_error_$bj_bad_pst_version);
   end FIND_BJ_PST;

/* verify that the process is is valid */

   call hcs_$validate_processid (process_id, code);
   if code = 0 then
      call ERROR_RETURN (dm_error_$valid_process);
   else code = 0;

/* lock the PST to prevent the tables being modified */

   call bj_pst_lock ();


/* Check out this dead process from all journals where it might be registered.
   Also remove its process_id from the before journal process table.*/

   call bj_pste_register$check_out_dead (null (), process_id);


/* Now try to deactivate any journal that seems to be not used by any process
   and any transaction.*/
DEACTIVE_UNUSED_JOURNALS:
   do bj_ix = 1 to bj_pst.max_n_entries;

      bj_pste_ptr = addr (bj_pst.e (bj_ix));

      if bj_pste.version = BJ_PSTE_VERSION_2 & bj_pste.n_processes = 0
	 & bj_pste.n_txn = 0 then
         call bj_pste_delete (bj_pste_ptr);		/* Will double check */
   end DEACTIVE_UNUSED_JOURNALS;

/* Unlock the bj_pst */
   call bj_pst_lock$unlock ();

   call FINISH ();

MAIN_RETURN:
   return;
%page;
NONLOCAL_ERROR_EXIT:
   call ERROR_RETURN (bjm_data_$bj_code);
%skip (4);
FINISH:
   proc ();

   call SET_BJM_DATA_ERROR_HANDLING_VALUES (bjm_data_$bj_default_error_label,
        "", DONT_CHECK_FOR_BJM_RECURSION);

   return;

   end FINISH;
%skip (4);
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call CLEAN_UP ();
   p_code = er_p_code;
   goto MAIN_RETURN;

   end ERROR_RETURN;
%skip (4);
CLEAN_UP:
   proc ();

   if bjm_clean_up_needed then
      call bj_cleanup_tables$handler (0);

   call FINISH ();

   return;

   end CLEAN_UP;
%page;
SET_BJM_DATA_ERROR_HANDLING_VALUES:
   proc (sbdehv_p_error_exit, sbdehv_p_operation,
        sbdehv_p_check_for_recursive_invocation);

/* This internal procedure centralizes the setting of the BJM global	*/
/* error values in bjm_data_.  It is called near the beginning of	*/
/* this module, and in the FINISH internal procedure.  ONLY THE FIRST	*/
/* OF THESE CALLS SHOULD ASK FOR DETECTION OF A RECURSIVE INVOCATION	*/
/* OF THE BEFORE JOURNAL MANAGER, if the other calls did, we could	*/
/* end up getting a recursive call ERROR_RETURN, CLEAN_UP, FINISH,	*/
/* this proc, etc.						*/

dcl  (
     sbdehv_p_error_exit		label variable,
     sbdehv_p_operation		char (*),
     sbdehv_p_check_for_recursive_invocation
				bit (1) aligned
     )				parameter;

   if sbdehv_p_check_for_recursive_invocation then
      if bjm_data_$bj_operation ^= "" then
         call ERROR_RETURN (dm_error_$bj_recursive_invoc);

   bjm_clean_up_needed = "1"b;
   bjm_data_$bj_exit_err = sbdehv_p_error_exit;
   bjm_data_$bj_operation = sbdehv_p_operation;
   bjm_data_$bj_code = 0;

   return;

   end SET_BJM_DATA_ERROR_HANDLING_VALUES;
%skip (4);
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_correct_version, cvn_p_error_to_use);

/* The error code to use is passed since we use this to check both	*/
/* the PPT and PPTE structure versions.				*/

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_correct_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_correct_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_global_error_info;


   end bjm_adjust_process_id;




		    bjm_adopt_transaction.pl1       04/04/85  1117.3re  04/04/85  0826.1       33327



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

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

bjm_adopt_transaction:
     procedure (p_tid, p_tix, p_code);

/* DESCRIPTION

	bjm_adopt_transaction - procedure to allow a process other than the
     one that started a transaction to complete the transaction.  from the
     point of before journal manager, adoption means the changing of some
     TXTE information for a transaction.  this change is local to before
     journal manager and there are no implicit effects to any other subsystem.
*/

/* HISTORY:
Written by M. Pandolf, 09/01/82.
Modified:
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/07/84 by Lee Baldwin:  Fixed to call dm_error_$no_current_transaction
            instead of dm_error_$bj_no_txn.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
*/
%page;
/* initialize parameters */

	tid = p_tid;
	tix = p_tix;
	p_code = 0;

/* set up addresses for unexpected error */

	bjm_data_$bj_exit_err = nonlocal_error_exit;
	bjm_data_$bj_code = 0;

	on cleanup call CLEANUP;

	if bjm_data_$bj_operation = ""
	then bjm_data_$bj_operation = ME;
	else do;
	     p_code = dm_error_$bj_recursive_invoc;
	     goto quick_exit;
	end;

/* check parameters */

	if tix < 1 | tix > dm_system_data_$max_n_transactions | tid = (36)"0"b
	then do;
	     p_code = dm_error_$no_current_transaction;
	     goto local_error_exit;
	end;

	bj_txte_ptr = addr (dm_data_$bj_txt_ptr -> bj_txt.entry (tix));

	if bj_txte.tid ^= tid
	then do;
	     p_code = dm_error_$bj_bad_tid;
	     goto local_error_exit;
	end;

/* the transaction seems valid, so invoke the primitive to adopt the transaciton */

	call bj_adopt_txn$adopt (tix);

std_exit:
	bjm_data_$bj_operation = "";
	bjm_data_$bj_exit_err = bjm_data_$bj_default_error_label;

quick_exit:
	return;

nonlocal_error_exit:
	p_code = bjm_data_$bj_code;

local_error_exit:
	call CLEANUP;
	goto quick_exit;


/* INTERNAL PROCEDURES */

CLEANUP:
     procedure ();

dcl  code			        fixed bin (35);

	call bj_cleanup_tables$handler (code);

	bjm_data_$bj_operation = "";
	bjm_data_$bj_exit_err = bjm_data_$bj_default_error_label;

	return;

     end CLEANUP;

/* DECLARATIONS */

/* Parameter */

dcl  p_tid		        bit (36) aligned parameter; /* transaction ID */
dcl  p_tix		        fixed bin parameter;	/* transaction index */
dcl  p_code		        fixed bin (35) parameter; /* standard system status code */

/* Automatic */

dcl  tid			        bit (36) aligned;	/* local copy of transaction ID */
dcl  tix			        fixed bin;		/* local copy of transaction index */

/* Static, External */

dcl  dm_error_$bj_recursive_invoc     fixed bin (35) external static;
dcl  dm_error_$no_current_transaction fixed bin (35) external static;
dcl  dm_error_$bj_bad_tid	        fixed bin (35) external static;
dcl  dm_data_$bj_txt_ptr	        pointer external static;

/* Constant */

dcl  ME			        char (32) internal static options (constant) init ("bjm_adopt_transaction");

/* Entry */

dcl  bj_adopt_txn$adopt	        entry (fixed bin);
dcl  bj_cleanup_tables$handler        entry (fixed bin (35));

/* Condition */

dcl  cleanup		        condition;

/* Include Files */

%page;
%include dm_bj_static;
%page;
%include dm_bj_txt;
%page;
%include dm_bj_global_error_info;
%page;

     end bjm_adopt_transaction;




		    bjm_attribute_fref_.pl1         04/24/85  1017.5re  04/24/85  0803.8      116388



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

/* DESCRIPTION:

		bjm_attribute_fref_
	This module maintains or gets before journal attributes which
     require a running DM system.  It is different from bjm_attribute_ in
     that it sets of the the DM firstref trap and does not rely on
     file_manager_ for all support.

	Currently, only setting the per-transaction storage limit is
     supported.  The general scenario is open the journal, set the limit,
     and close the journal.  Due to the current bjm error handling
     mechanism, the setup for BJM error handling is left until the open
     call has returned.  If it was setup immediately, a BJM recursion error
     would occur.
*/

/* HISTORY:

Written by Lee A. Newcomb, 03/18/85.
Modified:
03/22/85 by Lee A. Newcomb:  Fixed to use error_table_$item_too_big instead of
            =$bigarg.
03/25/85 by Lee A. Newcomb:  Fixed to make sure user has at least "m"
            access to a BJ's containing dir before setting txn storage limit.
04/08/85 by Lee A. Newcomb:  Fixed to have FINISH only call ERROR_RETURN if
            bjm_data_$bj_code is non-zero, instead of any time it is called in
            normal return; added several explainatory comments; renamed and
            added several comments for readability.
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bjm_attribute_fref_$set_transaction_storage_limit:
   proc (p_dir_path, p_entry_name, p_transaction_storage_limit, p_code);


/* START OF DECLARATIONS */

/* Parameter */
dcl  (
     p_dir_path			char (*),		/* dir containing BJ (Input) */
     p_entry_name			char (*),		/* BJ name (Input) */
     p_transaction_storage_limit	fixed bin (35),	/* new txn storage limit (Input) */
     p_code			fixed bin (35)	/* status code (Output) */
     )				parameter;

/* Automatic */
dcl  (
     bj_oid			bit (36) aligned init (NULL_BJ_OID),
     bjm_clean_up_needed		bit (1) aligned init (NO),
						/* for cleanup handler */
     code				fixed bin (35) init (0),
     containing_dir_path		char (168) init (""),
						/* dir containing dir containing BJ */
     dir_name			char (32) init (""),/* entry name portion of dir_path */
     dir_path			char (168) init (""),
						/* copy of parameter */
     dir_path_effective_access	bit (36) aligned init (N_ACCESS),
     dir_path_from_bjm		char (168) init (""),
						/* dir_path as recorded in BJM tables */
						/* used so links won't bypass access check */
     entry_name			char (32) init (""),/* copy of parameter */
     transaction_storage_limit	fixed bin (35) init (-1)
						/* copy of parameter */
     )				automatic;

/* Based */
/* Builtin */
dcl  (length, reverse, rtrim, substr)	builtin;

/* Condition */
dcl  cleanup			condition;

/* Constant */
dcl  (
     CHECK_FOR_BJM_RECURSION		bit (1) aligned init ("1"b),
     DONT_CHECK_FOR_BJM_RECURSION	bit (1) aligned init (""b),
     FINISH_MUST_IGNORE_ERRORS	bit (1) aligned init (""b),
     FINISH_MUST_NOT_IGNORE_ERRORS	bit (1) aligned init ("1"b),
     MYNAME			char (32) init ("bjm_attribute_fref_"),
     NO				bit (1) aligned init (""b),
     NULL_BJ_OID			bit (36) aligned init (""b),
     YES				bit (1) aligned init ("1"b)
     )				internal static options (constant);

/* Entry */
dcl  (
     before_journal_manager_$get_bj_path_from_oid
				entry (bit (36) aligned, char (*),
				char (*), fixed bin (35)),
     before_journal_manager_$open_bj	entry (char (*), char (*),
				bit (36) aligned, fixed bin (35)),
     bj_ci_zero$put_header		entry (bit (36) aligned, ptr,
				fixed bin),
     bj_cleanup_tables$handler	entry (fixed bin (35)),
     bj_close_oid			entry (bit (36) aligned),
     bj_oid_util$get_ptr		entry (bit (36) aligned) returns (ptr),
     bj_max_txn_storage_limit		entry (ptr) returns (fixed bin (35)),
     bj_pste_lock$lock		entry (ptr, bit (36) aligned),
     bj_pste_lock$unlock		entry (ptr),
     expand_pathname_		entry (char (*), char (*), char (*),
				fixed bin (35)),
     get_group_id_			entry () returns (char (32)),
     get_ring_			entry () returns (fixed bin (3)),
     hcs_$get_user_access_modes	entry (char (*), char (*), char (*),
				fixed bin, bit (36) aligned,
				bit (36) aligned, fixed bin (35))
     )				external;

/* External */
dcl  (
     (
     dm_error_$bj_bad_ppte_version,
     dm_error_$bj_bad_pste_version,
     dm_error_$bj_invalid_name,
     dm_error_$bj_recursive_invoc,
     error_table_$incorrect_access,
     error_table_$item_too_big,
     error_table_$smallarg
     )				fixed bin (35)
     )				external static;

/* END OF DECLARATIONS */
%page;
/*			repeat for reader's convenience	*/
/* bjm_attribute_fref_$set_transaction_storage_limit:		*/
/*     proc (p_dir_path, p_entry_name,			*/
/*		p_stransaction_storage_limit, p_code);		*/

COPY_AND_INIT_PARAMETERS:
   do;
      dir_path = p_dir_path;
      entry_name = p_entry_name;
      transaction_storage_limit = p_transaction_storage_limit;
      p_code = 0;
   end COPY_AND_INIT_PARAMETERS;

PARTIALLY_VALIDATE_INPUT_PARAMETERS:
   do;
      if ^IS_VALID_BJ_NAME (entry_name) then
         call ERROR_RETURN (dm_error_$bj_invalid_name);
      if transaction_storage_limit < 0 then
         call ERROR_RETURN (error_table_$smallarg);
   end PARTIALLY_VALIDATE_INPUT_PARAMETERS;

SETUP_FOR_NON_STANDARD_EXIT:
   on cleanup call CLEAN_UP ();

OPEN_JOURNAL:					/* to get the BJ's header */
   do;
      call before_journal_manager_$open_bj (dir_path, entry_name, bj_oid, code)
	 ;
      if bj_oid = NULL_BJ_OID then
         call ERROR_RETURN (code);
   end OPEN_JOURNAL;

VALIDATE_CONTAINING_DIR_MODIFY_ACCESS:
   do;
      call before_journal_manager_$get_bj_path_from_oid (bj_oid,
	 dir_path_from_bjm, (32)"" /* already have BJ name */, code);
      if code ^= 0 then
         call ERROR_RETURN (code);
      call expand_pathname_ (dir_path_from_bjm, containing_dir_path, dir_name,
	 code);
      if code ^= 0 then
         call ERROR_RETURN (code);
      call hcs_$get_user_access_modes (containing_dir_path, dir_name,
	 get_group_id_ (), get_ring_ (), dir_path_effective_access,
	 (""b) /* ignore xmodes */, code);
      if code ^= 0 then
         call ERROR_RETURN (code);
      if (dir_path_effective_access & M_ACCESS) ^= M_ACCESS then
         call ERROR_RETURN (error_table_$incorrect_access);
   end VALIDATE_CONTAINING_DIR_MODIFY_ACCESS;
%page;
/* Now we can set the bjm_data_ error handling values to indicate we	*/
/* are in control.  The only way this should be able to fail is if	*/
/* the DM ring is the login ring.				*/
   call SET_BJM_DATA_ERROR_HANDLING_VALUES (NONLOCAL_ERROR_EXIT, MYNAME,
        CHECK_FOR_BJM_RECURSION);

FIND_BJ_PST_ENTRY:
   do;
      bj_ppte_ptr = bj_oid_util$get_ptr (bj_oid);
      call CHECK_VERSION_NUMERIC (bj_ppte.version, BJ_PPTE_VERSION_1,
	 dm_error_$bj_bad_ppte_version);
      bj_pste_ptr = bj_ppte.bj_pste_ptr;
      call CHECK_VERSION_NUMERIC (bj_pste.version, BJ_PSTE_VERSION_2,
	 dm_error_$bj_bad_pste_version);
      call bj_pste_lock$lock (bj_pste_ptr, bj_ppte.bj_uid);
   end FIND_BJ_PST_ENTRY;

   if transaction_storage_limit = 0 then
SET_LIMIT_TO_MAXIMUM:
      transaction_storage_limit = bj_max_txn_storage_limit (bj_pste_ptr);
   else
VALIDATE_TRANSACTION_STORAGE_LIMIT:
        if transaction_storage_limit > bj_max_txn_storage_limit (bj_pste_ptr)
        then
      call ERROR_RETURN (error_table_$item_too_big);

SET_NEW_TRANSACTION_STORAGE_LIMIT:
   do;
      bj_pste.txn_storage_limit = transaction_storage_limit;
      call bj_ci_zero$put_header (bj_ppte.pf_oid, bj_pste_ptr, size (bj_pste));
   end SET_NEW_TRANSACTION_STORAGE_LIMIT;


   call RETURN ();

/* end bjm_attribute_fref_$set_transaction_storage_limit; */
%page;
MAIN_RETURN:
   return;
%skip (4);
NONLOCAL_ERROR_EXIT:
   call ERROR_RETURN (bjm_data_$bj_code);
%skip (4);
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_correct_version, cvn_p_error_to_use);

/* The error code to use is passed as this is really a template proc	*/
/* used in several modules to check structure versions.  It is hoped	*/
/* newer versions of these structures will be changed to use	*/
/* char (8) versions.					*/

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_correct_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_correct_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%skip (4);
CLEAN_UP:
   proc ();

/* CLEAN_UP doubles as a cleanup handler and ERROR_FINISH procedure.	*/
/* We will call the FINISH proc as it is a subset of the work we must	*/
/* do, passing an argument telling it to not report any errors.	*/

   if bjm_clean_up_needed = YES then
      call bj_cleanup_tables$handler (0);

   call FINISH (FINISH_MUST_IGNORE_ERRORS);

   return;

   end CLEAN_UP;
%page;
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   p_code = er_p_code;
   call CLEAN_UP ();				/* our ERROR_FINISH proc */
   goto MAIN_RETURN;

   end ERROR_RETURN;
%skip (4);
FINISH:
   proc (f_p_ignore_errors);

/* FINISH is used to undo anything done which should be reset.  An	*/
/* example is closing a before journal we may have opened.  Note some	*/
/* of this work must be done whether we are returning from an error,	*/
/* while cleaning up, or in the normal course of work.  Rather than	*/
/* duplicate this code in CLEAN_UP, CLEAN_UP informs us we may not	*/
/* call ERROR_RETURN.  However, if we want to return normally, RETURN	*/
/* also calls, but passes a parameter indicating we must report any	*/
/* errors encountered.					*/

dcl  f_p_ignore_errors		bit (1) aligned parameter;
dcl  f_bj_oid			bit (36) aligned
				init (NULL_BJ_OID) automatic;

   if bj_oid ^= NULL_BJ_OID then
CLOSE_THIS_BJ_OPENING:
      do;
      bjm_data_$bj_exit_err = FINISH_ERROR_LABEL;
      f_bj_oid = bj_oid;
      bj_oid = NULL_BJ_OID;				/* so we can't close >1 times */
      call bj_close_oid (f_bj_oid);
   end CLOSE_THIS_BJ_OPENING;

FINISH_ERROR_LABEL:
   if (f_p_ignore_errors = FINISH_MUST_NOT_IGNORE_ERRORS)
        & (bjm_data_$bj_code ^= 0) then
      call ERROR_RETURN (bjm_data_$bj_code);		/* won't return */

   call SET_BJM_DATA_ERROR_HANDLING_VALUES (bjm_data_$bj_default_error_label,
        "", DONT_CHECK_FOR_BJM_RECURSION);

   return;

   end FINISH;
%page;
IS_VALID_BJ_NAME:
   proc (ivbn_p_bj_name) reducible returns (bit (1) aligned);

dcl  ivbn_p_bj_name			char (*) parameter;

   return ((length (rtrim (ivbn_p_bj_name)) < 33)
        & (substr (reverse (rtrim (ivbn_p_bj_name)), 1, 3) = "jb."));

   end IS_VALID_BJ_NAME;
%skip (4);
RETURN:
   proc ();

   call bj_pste_lock$unlock (bj_pste_ptr);
   call FINISH (FINISH_MUST_NOT_IGNORE_ERRORS);
   go to MAIN_RETURN;

   end RETURN;
%page;
SET_BJM_DATA_ERROR_HANDLING_VALUES:
   proc (sbdehv_p_error_exit, sbdehv_p_operation,
        sbdehv_p_check_for_recursive_invocation);

/* This internal procedure centralizes the setting of the BJM global	*/
/* error values in bjm_data_.  It is called near the beginning of	*/
/* this module, and in the FINISH internal procedure.  ONLY THE FIRST	*/
/* OF THESE CALLS SHOULD ASK FOR DETECTION OF A RECURSIVE INVOCATION	*/
/* OF THE BEFORE JOURNAL MANAGER, if the other calls did, we could	*/
/* end up getting a recursive call ERROR_RETURN, CLEAN_UP, FINISH,	*/
/* this proc, etc.						*/
/*							*/
/* Note: if sbdehv_p_check_for_recursive_invocation and		*/
/* bjm_clean_up_needed both have negative meanings, we do not set any	*/
/* values.  This may happen if we call ERROR_RETURN before calling	*/
/* this proc (e.g., a failure in partial argument validation).	*/

dcl  (
     sbdehv_p_error_exit		label variable,
     sbdehv_p_operation		char (*),
     sbdehv_p_check_for_recursive_invocation
				bit (1) aligned
     )				parameter;

   if sbdehv_p_check_for_recursive_invocation = CHECK_FOR_BJM_RECURSION then
      if bjm_data_$bj_operation ^= "" then
         call ERROR_RETURN (dm_error_$bj_recursive_invoc);

   if (bjm_clean_up_needed = NO)
        & (sbdehv_p_check_for_recursive_invocation
        = DONT_CHECK_FOR_BJM_RECURSION) then
      ;
   else
SET_BJM_DATA_ERROR_VALUES:
      do;
      bjm_clean_up_needed = YES;
      bjm_data_$bj_operation = sbdehv_p_operation;
      bjm_data_$bj_exit_err = sbdehv_p_error_exit;
      bjm_data_$bj_code = 0;
   end SET_BJM_DATA_ERROR_VALUES;

   return;

   end SET_BJM_DATA_ERROR_HANDLING_VALUES;
%page;
%include dm_bj_global_error_info;
%page;
%include dm_bj_ppt;
%page;
%include dm_bj_pste;
%page;
%include access_mode_values;


   end bjm_attribute_fref_$set_transaction_storage_limit;




		    bjm_close.pl1                   04/04/85  1117.3re  04/04/85  0826.1       32841



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

/* DESCRIPTION:

	This procedure is the interface into the close operation of before
     journal manager.  The actual steps in closing are embodied in the
     procedure bj_close_oid.  This was implemented so that other bjm
     primitives can call the close code without worry about a recursion error.

	This procedure locks the PST as per the requirement of bj_close_oid.
*/

/* HISTORY:
Written by Mike Pandolf, 07/06/82.
Modified:
08/24/82 by M. Pandolf:  to separate code fom wrapper.
11/11/82 by M. Pandolf:  to use standard entry and exit protocol.
11/21/82 by M. Pandolf:  to lock the PST before calling bj_close_oid.
04/06/83 by A. Bensoussan:  to add the entry point $after_recovery.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
10/22/84 by M. Sharpe:  to convert to use "call ERROR_RETURN (code)"
	  convention, to clean up format and variable names, to
	  reset bjm_data_$bj_exit_err to bjm_data_$default_error_label
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
*/

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

bjm_close:
     procedure (p_bj_oid, p_code);


/* DECLARATIONS */

/* Parameter */

dcl  p_bj_oid bit (36) aligned parameter;		/* OID of before journal to be closed */
dcl  p_code fixed bin (35) parameter;			/* standard system status code */


/* Automatic */

dcl close_after_recovery bit(1);


/* Condition */

dcl  cleanup condition;


/* Constant */

dcl  ME char (12) internal static options (constant) init ("bjm_close");



/* Entry */

dcl  bj_cleanup_tables$handler entry (fixed bin(35));
dcl  bj_close_oid entry (bit(36) aligned);
dcl  bj_close_oid$after_recovery entry (bit(36) aligned);
dcl  bj_pst_lock entry ();
dcl  bj_pst_lock$unlock entry ();

/* External Static */

dcl  dm_error_$bj_recursive_invoc fixed bin (35) external static;


/* Standard entry point */

	close_after_recovery = "0"b;
	goto COMMON;


after_recovery: entry (p_bj_oid, p_code);

	close_after_recovery = "1"b;
	goto COMMON;

COMMON:

/* initially set status code */

	p_code = 0;

/* set up before journal error recovery environment */

	if bjm_data_$bj_operation = ""
	then bjm_data_$bj_operation = ME;
	else do;
	     p_code = dm_error_$bj_recursive_invoc;
	     goto MAIN_RETURN;
	end;

	on cleanup call CLEANUP;

	bjm_data_$bj_exit_err = nonlocal_error_exit;
	bjm_data_$bj_code = 0;

/* call the support routine */

	call bj_pst_lock ();

	if close_after_recovery = "0"b
	   then call bj_close_oid (p_bj_oid);
	   else call bj_close_oid$after_recovery (p_bj_oid);

	call bj_pst_lock$unlock ();

/* simple return */

	bjm_data_$bj_operation = "";

	bjm_data_$bj_exit_err =
	     bjm_data_$bj_default_error_label;

MAIN_RETURN:
	return;

nonlocal_error_exit:
	call ERROR_RETURN (bjm_data_$bj_code);

%page;
/* INTERNAL PROCEDURES */

ERROR_RETURN:
	procedure (error_code);

dcl	error_code		fixed bin (35);

	call CLEANUP;
	p_code = error_code;
	goto MAIN_RETURN;

     end ERROR_RETURN;



CLEANUP:	procedure ();

dcl  cleanup_code fixed bin (35);

	call bj_cleanup_tables$handler (cleanup_code);

	bjm_data_$bj_operation = "";
	bjm_data_$bj_exit_err =
	     bjm_data_$bj_default_error_label;

	return;

end CLEANUP;

%page;
%include dm_bj_global_error_info;


end bjm_close;




		    bjm_create.pl1                  04/09/85  1448.4r w 04/08/85  1128.0      128223



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


/* DESCRIPTION:

	bjm_create implements before_journal_manager_$create_bj to create a
     before journal in a specific directory with a given name.  File manager
     is used to create the journal and journal specific data is written for
     later use.  The journal is in a closed state at return time.

	The current calling sequence is very specific; it is hoped a
     future implementation will replace the size parameters with a
     create_info strucutre (as file_manager_ uses).  As a result of the
     current calling sequence, a user wishing to set a per-transaction
     storage limit for the new before journal must first create it, and
     then call before_journal_manager_$set_transaction_storage_limit.
*/

/* HISTORY:
Written by Andre Bensoussan, 07/15/82.
Modified:
10/15/82 by M. Pandolf:  to use file_manager_ to manipulate data 
	  management system files.
11/11/82 by M. Pandolf:  to conform to standard entry and exit sequence.
12/20/82 by M. Pandolf:  to better manage file_manager_ calls.
03/16/83 by A. Bensoussan:  to set the ACL of the created journal using
	  using dm_system_data_$initializer_name so the DMS creator
	  (Daemon) can use it in rollback.
03/23/83 by Jeff Ives:  to set p_code (parameter) on normal return.
03/24/83 by Lee A. Newcomb:  to set p_code when a bj_recursive_invoc is
	  detected.
06/07/83 by A. Bensoussan:  to refuse to create a journal with size < 3.
11/02/83 by M. Pandolf:  to only allow entrynames ending in ".bj"
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/25/84 by Matthew Pierret: Changed to use file_manager_$add_acl_entries
            instead of the obsolete $acl_add.
08/20/84 by Matthew C. Pierret:  Changed to use FILE_CREATE_INFO_VERSION_2,
            which required explicitly setting the protected flag to off and
            setting the extended ring brackets to the ring of execution (the
            data management ring).
10/18/84 by Maggie Sharpe:  cleaned up dcls; corrected minor format problems;
            checked "code" after call to fm_$close; changed to use
            fm_$add_acl_entries instead of fm_$acl_add;changed to use "call
            ERROR (code)" convention.
10/26/84 by Maggie Sharpe:  to changed the label ERROR to ERROR_RETURN.
12/12/84 by Lindsey Spratt:  Fixed to create the dmf with rings of 7,7, rather
	  than "level", since the bj's can only be used properly if the user
	  level is in the read/write bracket of the bj.  When this
	  limitation is removed, bj's will be dmf's with ring brackets equal
	  to the data_management_ringno.
12/27/84 by Matt Pierret:  Fixed call to file_manager_$add_acl_entries to use
	  the general_acl structure instead of just the acl entries.
12/28/84 by Lee A. Newcomb:  Fixed to create the BJ DMF with rings brackets
	  [DM ring, DM ring], used acl_structures and access_mode_values
	  includes, fixed up error/cleanup processing, renamed ERROR_RETRUN
	  to ERROR_RETURN, and did some general reorganization for the above
	  changes and readability.
02/07/85 by Lee A. Newcomb:  Fixed to use file_manager_$create_open instead of
            separate create and open calls; added FINISH procedure and fixed
            CLEANUP to use it so the validation level gets reset properly.
02/12/85 by Lee A. Newcomb:  Fixed to use the correct version constant for
	  bj_pste's:  BJ_PSTE_VERSION_2, and to have CLEAN_UP not do
	  all its steps unless setup to do so.
02/13/85 by Lee A. Newcomb:  Removed unused "%include dm_bj_static;".
03/13/85 by Lee A. Newcomb:  Added the setting of the per-transaction storage
            limit, currently as the maximum possible value.
03/22/85 by Lee A. Newcomb:  Fixed to setup the cleanup handler when it should
            be and to set bjm_data_$bj_code in case it has a leftover status
            in it.
*/
/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo */
/* format: ^inddcls,dclind5,idind35,linecom */
%page;
bjm_create:
   proc (p_dir, p_entry, p_max_size, p_ci_size, p_code);


/* DECLARATIONS */

/* Parameter */
dcl  (
     p_dir			char (*),		/* Dir path of the journal */
     p_entry			char (*),		/* Entry name of the journal */
     p_max_size			fixed bin,	/* In number of CI's */
     p_ci_size			fixed bin,	/* In number of bytes */
     p_code			fixed bin (35)	/* returned status code */
     )				parameter;

/* Automatic */
dcl  (
     bj_dir			char (168) init (""),
     bj_entry			char (32) init (""),
     bj_uid			bit (36) aligned init (NULL_ID),
     bjm_clean_up_needed		bit (1) aligned init (FALSE),
     ci_size			fixed bin init (0),
     code				fixed bin (35) init (0),
     create_code			fixed bin (35) init (-1),
     dm_ring			fixed bin,
     fm_oid			bit (36) aligned init (NULL_ID),
     fm_uid			bit (36) init (NULL_ID),
     level			fixed bin init (0),
     max_size			fixed bin init (0),
     1 my_bj_header			like bj_header,
     1 my_file_create_info		aligned like file_create_info
     )				automatic;

dcl  1 my_general_acl		aligned automatic,
       2 version			char (8) aligned
				init (GENERAL_ACL_VERSION_1),
       2 count			fixed bin init (1),
       2 entries			dim (1)
				like general_extended_acl_entry;

/* Builtin */
dcl  (addr, length, size, substr, reverse, rtrim, unspec)
				builtin;

/* Condition */
dcl  cleanup			condition;
%page;
/* Constant */
dcl  (
     myname			char (10) init ("bjm_create"),
     CHECK_FOR_BJM_RECURSION		bit (1) aligned init ("1"b),
     DONT_CHECK_FOR_BJM_RECURSION	bit (1) aligned init (""b),
     FALSE			bit (1) aligned init (""b),
     NULL_ID			bit (36) aligned init (""b),
     TRUE				bit (1) aligned init ("1"b)
     )				internal static options (constant);

/* Entry */
dcl  (
     bj_ci_zero$put_header		entry (bit (36) aligned, ptr,
				fixed bin),
     bj_ci_zero$get_pf_uid		entry (bit (36) aligned)
				returns (bit (36)),
     bj_cleanup_tables$handler	entry (fixed bin (35)),
     bj_max_txn_storage_limit		entry (ptr) returns (fixed bin (35)),
     cu_$level_get			entry (fixed bin),
     cu_$level_set			entry (fixed bin),
     file_manager_$add_acl_entries	entry (char (*), char (*), ptr,
				fixed bin (35)),
     file_manager_$allocate		entry (bit (36) aligned, fixed bin,
				fixed bin, fixed bin (35)),
     file_manager_$close		entry (bit (36) aligned,
				fixed bin (35)),
     file_manager_$create_open	entry (char (*), char (*), ptr,
				bit (36) aligned, fixed bin (35)),
     file_manager_$delete		entry (char (*), char (*),
				fixed bin (35)),
     file_manager_$flush_consecutive_ci entry (bit (36) aligned, fixed bin,
				fixed bin, fixed bin (35)),
     get_ring_			entry returns (fixed bin (3))
     )				external;

/* External */
dcl  (
     (
     dm_error_$bj_illegal_size,
     dm_error_$bj_invalid_name,
     dm_error_$bj_recursive_invoc
     )				fixed bin (35),
     dm_system_data_$initializer_name	char (32) aligned
     )				external static;

/* Static */

/* END OF DECLARATIONS */
%page;
COPY_PARAMETERS:
   do;
      bj_dir = p_dir;
      bj_entry = p_entry;
      max_size = p_max_size;
      ci_size = p_ci_size;				/* let fm_$create_open tell if in error */
      p_code = 0;					/* assume we will succeed */
   end COPY_PARAMETERS;


PARTIALLY_VALIDATE_INPUT_PARAMETERS:
   do;
      if ^IS_VALID_BJ_NAME (bj_entry) then
         call ERROR_RETURN (dm_error_$bj_invalid_name);
      if max_size < 3 then
         call ERROR_RETURN (dm_error_$bj_illegal_size);
   end PARTIALLY_VALIDATE_INPUT_PARAMETERS;


SETUP_FOR_NON_STANDARD_EXIT:
   do;
      call cu_$level_get (level);
      dm_ring = get_ring_ ();

      on cleanup call CLEANUP ();
      call SET_BJM_DATA_ERROR_HANDLING_VALUES (NONLOCAL_ERROR_EXIT, myname,
	 CHECK_FOR_BJM_RECURSION);

   end SETUP_FOR_NON_STANDARD_EXIT;


FILL_IN_FILE_CREATE_INFO:
   do;
      unspec (my_file_create_info) = "0"b;
      my_file_create_info.version = FILE_CREATE_INFO_VERSION_2;
      my_file_create_info.blocking_factor = 255;
      my_file_create_info.ci_size_in_bytes = ci_size;
      my_file_create_info.ring_brackets (*) = dm_ring;
   end FILL_IN_FILE_CREATE_INFO;
%page;
   call cu_$level_set (dm_ring);			/* set for rest of main proc */

CREATE_NEW_BJ:
   do;
      call file_manager_$create_open (bj_dir, bj_entry,
	 addr (my_file_create_info), fm_oid, create_code);
      if create_code ^= 0 then
         call ERROR_RETURN (create_code);

      fm_uid = bj_ci_zero$get_pf_uid (fm_oid);
      bj_uid = fm_uid;
   end CREATE_NEW_BJ;


GIVE_DM_DAEMON_RW_ACCESS_TO_BJ:
   do;
      my_general_acl.access_name (1) = dm_system_data_$initializer_name;
      my_general_acl.mode (1) = RW_ACCESS;
      my_general_acl.extended_mode (1) = N_ACCESS;	/* BJ's don't have xacl's */
      my_general_acl.status_code (1) = 0;		/* assume no error */

      call file_manager_$add_acl_entries (bj_dir, bj_entry,
	 addr (my_general_acl), code);
      if code ^= 0 then
         call ERROR_RETURN (code);
   end GIVE_DM_DAEMON_RW_ACCESS_TO_BJ;


ALLOCATE_AND_INITIALIZE_ALL_BJ_CIS:
   do;

/* Have file_manager_ allocate disk addresses for all CI's.  Then	*/
/* flush all of them to make sure the CI's and their VTOCE'S are	*/
/* updated on disk.						*/

      call file_manager_$allocate (fm_oid, 1, max_size - 1, code);
      if code ^= 0 then
         call ERROR_RETURN (code);

      call file_manager_$flush_consecutive_ci (fm_oid, 1, max_size - 1, code);
      if code ^= 0 then
         call ERROR_RETURN (code);

   end ALLOCATE_AND_INITIALIZE_ALL_BJ_CIS;
%page;
MAKE_BJ_HEADER:
   do;

/* Get the journal header information & write it to CI 0 and flush it */

      bj_header_ptr = addr (my_bj_header);
      unspec (bj_header) = "0"b;

      bj_header.version = BJ_PSTE_VERSION_2;
      bj_header.bj_uid = bj_uid;
      bj_header.ci_size = ci_size;
      bj_header.max_size = max_size;
      bj_header.update_frequency = BJ_UPDATE_FREQUENCY;
      bj_header.txn_storage_limit = bj_max_txn_storage_limit (bj_header_ptr);
      bj_header.active = "0"b;

      bj_header.cl.lowest_ci = 1;
      bj_header.cl.highest_ci = max_size - 1;
      bj_header.cl.number_ci = max_size - 1;
      bj_header.cl.origin_ci = 1;

      call bj_ci_zero$put_header (fm_oid, bj_header_ptr, size (bj_header));

      call file_manager_$flush_consecutive_ci (fm_oid, 0 /* CI 0 */,
	 1 /* one CI to flush */, code);
      if code ^= 0 then
         call ERROR_RETURN (code);

   end MAKE_BJ_HEADER;


CLOSE_BJ_FILE:
   do;
      call file_manager_$close (fm_oid, code);
      if code ^= 0 then
         call ERROR_RETURN (code);
   end CLOSE_BJ_FILE;



   call FINISH ();

MAIN_RETURN:
   return;

/* end bjm_create; */
%page;
NONLOCAL_ERROR_EXIT:
   call ERROR_RETURN (bjm_data_$bj_code);
%skip (4);
FINISH:
   proc ();

   call SET_BJM_DATA_ERROR_HANDLING_VALUES (bjm_data_$bj_default_error_label,
        "", DONT_CHECK_FOR_BJM_RECURSION);
   call cu_$level_set (level);

   return;

   end FINISH;
%skip (4);
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call CLEANUP ();
   p_code = er_p_code;
   goto MAIN_RETURN;

   end ERROR_RETURN;
%skip (4);
CLEANUP:
   proc ();

/* We ignore errors as it does not matter if we get called	*/
/* >1 times.  We may not use fm_$delete_close as there is a	*/
/* slight possibility we may have closed the file after	*/
/* creating it before executing this code.		*/

   if fm_oid ^= NULL_ID then				/* we opened */
      call file_manager_$close (fm_oid, 0);

   if create_code = 0 then				/* we created */
      call file_manager_$delete (bj_dir, bj_entry, 0);

   if bjm_clean_up_needed = TRUE then
      call bj_cleanup_tables$handler (0);

   call FINISH ();

   return;

   end CLEANUP;
%page;
SET_BJM_DATA_ERROR_HANDLING_VALUES:
   proc (sbdehv_p_error_exit, sbdehv_p_operation,
        sbdehv_p_check_for_recursive_invocation);

/* This internal procedure centralizes the setting of the BJM global	*/
/* error values in bjm_data_.  It is called near the beginning of	*/
/* this module, and in the FINISH internal procedure.  ONLY THE FIRST	*/
/* OF THESE CALLS SHOULD ASK FOR DETECTION OF A RECURSIVE INVOCATION	*/
/* OF THE BEFORE JOURNAL MANAGER, if the other calls did, we could	*/
/* end up getting a recursive call ERROR_RETURN, CLEANUP, FINISH,	*/
/* this proc, etc.						*/
/*							*/
/* Note: if sbdehv_p_check_for_recursive_invocation and		*/
/* bjm_clean_up_needed are both false, we do not set any values.	*/
/* This may happen if we call ERROR_RETURN before calling this	*/
/* proc, if the partial argument validation fails.		*/

dcl  (
     sbdehv_p_error_exit		label variable,
     sbdehv_p_operation		char (*),
     sbdehv_p_check_for_recursive_invocation
				bit (1) aligned
     )				parameter;

   if sbdehv_p_check_for_recursive_invocation = CHECK_FOR_BJM_RECURSION then
      if bjm_data_$bj_operation ^= "" then
         call ERROR_RETURN (dm_error_$bj_recursive_invoc);

/* only set bjm_data_ values if we set them */
   if bjm_clean_up_needed = FALSE
        & sbdehv_p_check_for_recursive_invocation
        = DONT_CHECK_FOR_BJM_RECURSION then
      ;
   else
SET_BJM_DATA_ERROR_VALUES:
      do;
      bjm_clean_up_needed = TRUE;
      bjm_data_$bj_operation = sbdehv_p_operation;
      bjm_data_$bj_exit_err = sbdehv_p_error_exit;
      bjm_data_$bj_code = 0;
   end SET_BJM_DATA_ERROR_VALUES;

   return;

   end SET_BJM_DATA_ERROR_HANDLING_VALUES;
%skip (4);
IS_VALID_BJ_NAME:
   proc (ivbn_p_bj_name) reducible returns (bit (1) aligned);

dcl  ivbn_p_bj_name			char (*) parameter;

   return ((length (rtrim (ivbn_p_bj_name)) < 33)
        & (substr (reverse (rtrim (ivbn_p_bj_name)), 1, 3) = "jb."));

   end IS_VALID_BJ_NAME;
%page;
%include dm_bj_header;
%page;
%include dm_bj_pste;
%page;
%include dm_file_create_info;
%page;
%include dm_bj_global_error_info;
%page;
%include acl_structures;
%page;
%include access_mode_values;


   end bjm_create;




		    bjm_data_.alm                   03/06/85  0801.3re  03/05/85  0758.1       29295



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1983 *
" *                                                         *
" ***********************************************************

" DESCRIPTION:
"	bjm_data_'s static section is used to keep track of
"     per-process values specific to the before journal manager.  This
"     includes invocation error info for the BJM primitives.  Currently,
"     all per-process values except bj_txt_ptr are kept here, the txt ptr
"     is referenced directly by transaction_manager_ as it really
"     corresponds to the TDT, even though TM may only read it.
"
"     bj_code:  contains the value of a code which explains why a
"	before journal manager support routine called
"	bj_report_err.  It is available to the BJM primitive so
"	that it may be passed back to the caller of BJM services.
"	bj_default_error_label:  the address to where a before journal
"	manager support routine can transfer upon encountering an
"	error.
"     bj_exit_err:  contains the address of the location to which
"	a before journal manager support routine should return
"	if an unexpected error is encountered.  The transfer,
"	implemented by a non-local goto, is not performed by the
"	support routine:  the support routine calls bj_report_err
"	which complains and performs the goto.
"     bj_operation:  identifies the current BJ primitive invoked.
"	Its values is the name of the primitive.  It is set to
"	null if there is no current primitive invoked.
"     bj_ppt_ptr:  the location of the per-process bjm table.
"     bj_pst_ptr:  the location of the per-system bjm table.
"     bj_rollback_buffer_ptr:  the location of the bjm per-process
"	rollback buffer.
"     initialized:  a cell that indicates whether or not BJM
"	has been invoked in this process (0 => not yet).
"     lock_manager_timeout:  the amount of time we wait for a lock to be
"	locked via lock manager.
"
" HISTORY:
" Written by Mike Pandolf, 08/18/82.
"
" Modified:
" 08/20/82 by M. Pandolf:  added initialized.
" 10/22/82 by M. Pandolf:  added lock_manager_timeout.
" 11/22/83 by Lee A. Newcomb:  renamed to bjm_data_ to be consistent with
"	    the other per-process data segments.  Added bj_ppt_ptr,
"	    bj_pst_ptr, and bj_rollback_buffer_ptr from dm_data_.
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

	name	bjm_data_

	segdef	bj_default_error_label
	segdef	bj_operation
	segdef	bj_exit_err
	segdef	bj_code
	segdef	bj_ppt_ptr
	segdef	bj_pst_ptr
	segdef	bj_rollback_buffer_ptr
	segdef	lock_manager_timeout
	segdef	initialized

	use rw_data

bj_code:	oct	0		"system status code, not dbl-word aligned

	even
bj_default_error_label:
	its	-1,1		"label variable
	its	-1,1

bj_exit_err:
	its	-1,1		"label variable
	its	-1,1

bj_operation:
	aci	/                              /,32

bj_ppt_ptr:				" dcl $bj_ppt_ptr ptr ext;
	its	-1,1

bj_pst_ptr:				" dcl $bj_pst_ptr ptr ext;
	its	-1,1

bj_rollback_buffer_ptr:			" dcl $bj_rollback_buffer_ptr ptr ext;
	its	-1,1

initialized:				"not dbl-word aligned
	oct	0

	even
lock_manager_timeout:
	vfd	72/120000000	"120 seconds

	join	/static/rw_data

	end




		    bjm_delete.pl1                  04/04/85  1117.3re  04/04/85  0826.1       67482



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

/* DESCRIPTION

	The before journal manager delete before journal primitive.

	This procedure will delete a specified before journal if the file is
     not being used at the time of the call.  To insure this, the before
     journal per system table is locked by this process, preventing any
     other process from referencing the PST.  With the PST locked, a check
     is made to see how many processes actually reference the before
     journal; if none, it is deleted via a call to file_manager.
*/

/* HISTORY:
Written by M. Pandolf, 11/02/82.
Modified:
12/21/82 by M. Pandolf:  to add more sophistication to the algorithm.
11/02/83 by M. Pandolf:  to only allow entrynames ending in ".bj".
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
10/18/84 by M. Sharpe:  to clean up dcls and format; to set validation
	  level down before calling file_manager_$? and up after
	  returning; to use "call ERROR_RETURN (code)" convention
11/29/84 by Maggie Sharpe:  to correct the call to cu_$level_get.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
*/

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

bjm_delete:
     procedure (p_dir, p_entry, p_code);


/* DECLARATIONS */ 

/* Parameters */

dcl  p_dir		        char (*) parameter;	/* dir of the before journal */
dcl  p_entry		        char (*) parameter;	/* entry name of the before journal */
dcl  p_code		        fixed bin (35) parameter; /* standard system status code */

/* Automatic */

dcl  bj_dir		        char (168);		/* local copy of parameter */
dcl  bj_entry		        char (32);		/* local copy of parameter */
dcl  code			        fixed bin (35);	/* system status code */
dcl  fm_oid		        bit (36) aligned;	/* opening ID of data management file */
dcl  saved_level		        fixed bin;
dcl  current_ring		        fixed bin(3);
dcl  bj_uid		        bit (36) aligned;	/* before journal specific ID of a before journal */
dcl  bj_ppte_ptr		        pointer;		/* pointer to PPT entry for before journal, if open */

/* Builtin */

dcl  null			        builtin;

/* Condition */

dcl  cleanup		        condition;

/* Constant */

dcl  ME			        char (32) internal static options (constant)
			        init ("bjm_delete");

/* Entry */

dcl  get_ring_		        entry returns (fixed bin (3));
dcl  cu_$level_get		        entry (fixed bin);
dcl  cu_$level_set		        entry (fixed bin);
dcl  file_manager_$open	        entry (char (*), char (*), bit (36) aligned, fixed bin (35));
dcl  bj_ci_zero$get_bj_uid	        entry (bit (36) aligned) returns (bit (36));
dcl  bj_pst_lock		        entry ();
dcl  bj_pst_lock$unlock	        entry ();
dcl  bj_pst_search		        entry (bit (36) aligned) returns (ptr);
dcl  bj_ppt_search		        entry (bit (36) aligned) returns (ptr);
dcl  bj_close_oid		        entry (bit (36) aligned);
dcl  bj_oid_util$get_oid	        entry (ptr) returns (bit (36) aligned);
dcl  file_manager_$delete_close       entry (bit (36) aligned, fixed bin (35));
dcl  bj_cleanup_tables$handler        entry (fixed bin (35));

/* External Static */

dcl  dm_error_$bj_recursive_invoc     fixed bin (35) ext static;
dcl  dm_error_$bj_journal_in_use      fixed bin (35) ext static;
dcl  dm_error_$bj_invalid_name        fixed bin (35) ext static;
dcl  bjm_data_$bj_pst_ptr	        pointer external static;


%page;
/* initialize parameters */

	bj_dir = p_dir;
	bj_entry = p_entry;
	p_code = 0;
	call cu_$level_get (saved_level);
	current_ring = get_ring_ ();

/* validate the entry name */

	if ^is_valid_bj_name (bj_entry)
	then do;
	     p_code = dm_error_$bj_invalid_name;
	     goto MAIN_RETURN;
	end;

	on cleanup call CLEANUP;

	if bjm_data_$bj_operation = ""
	then bjm_data_$bj_operation = ME;
	else do;
	     p_code = dm_error_$bj_recursive_invoc;
	     goto MAIN_RETURN;
	end;


/* prepare for unexpected error */

	bjm_data_$bj_exit_err = nonlocal_error_exit;
	bjm_data_$bj_code = 0;

/* get the bj_uid from the journal */

	call cu_$level_set ((current_ring));

	call file_manager_$open (bj_dir, bj_entry, fm_oid, code);

	if fm_oid = (36)"0"b
	then call ERROR_RETURN (code);

	call cu_$level_set (saved_level);

	bj_uid = bj_ci_zero$get_bj_uid (fm_oid);

/*
   lock the PST to begin the following operation:

	if   JOURNAL_UNUSED
	then call DELETE_JOURNAL
	else if   JOURNAL_HAS_1_USER
	     then if   I_AM_ONLY_USER
		then call CLOSE_AND_DELETE_JOURNAL
		else call JOURNAL_IN_USE_ERROR
	     else call JOURNAL_IN_USE_ERROR

   because the PST will be locked, the used status of the journal in question
   will not change while the comparisons are being made.
*/

	call bj_pst_lock ();

	bj_pste_ptr = bj_pst_search (bj_uid);
	bj_ppte_ptr = bj_ppt_search (bj_uid);

	if bj_pste_ptr = null ()
	then call DELETE ();
	else if N_USERS () = 1
	then if bj_ppte_ptr ^= null ()
	     then do;
		call bj_close_oid (bj_oid_util$get_oid (bj_ppte_ptr));
		call DELETE ();
	     end;
	     else call ERROR_RETURN (dm_error_$bj_journal_in_use);
	else call  ERROR_RETURN (dm_error_$bj_journal_in_use);

/* free up the PST for further use */

	call bj_pst_lock$unlock ();

/* begin exit sequence */

	bjm_data_$bj_operation = "";
	bjm_data_$bj_exit_err = bjm_data_$bj_default_error_label;

MAIN_RETURN:
	call cu_$level_set (saved_level);
	return;

nonlocal_error_exit:
	call ERROR_RETURN (bjm_data_$bj_code);

%page;
/* Internal Procedures */

ERROR_RETURN:
	proc (error_code);

dcl  error_code		fixed bin (35);


	call CLEANUP;
	p_code = error_code;
	goto  MAIN_RETURN;

     end ERROR_RETURN;



is_valid_bj_name:
     proc (bj_name)
	reducible
	returns (bit (1) aligned);

dcl  bj_name		        char (*) parameter;
dcl  (length, substr, reverse, rtrim) builtin;

	return (
	     (length (rtrim (bj_name)) < 33) &
	     (substr (reverse (rtrim (bj_name)), 1, 3) = "jb."));

     end is_valid_bj_name;


CLEANUP:
     procedure ();

dcl  cleanup_code			        fixed bin (35);

	call bj_cleanup_tables$handler (cleanup_code);

	bjm_data_$bj_operation = "";
	bjm_data_$bj_exit_err = bjm_data_$bj_default_error_label;

	call cu_$level_set (saved_level);
	return;

     end CLEANUP;

DELETE:
     procedure ();

dcl  delete_code			        fixed bin (35);

	call cu_$level_set ((current_ring));

	call file_manager_$delete_close (fm_oid, delete_code);
	if delete_code ^= 0
	     then call ERROR_RETURN (delete_code);

	call cu_$level_set (saved_level);

	return;

     end DELETE;



N_USERS:
     procedure () returns (fixed bin);

dcl  n_processes		        fixed bin;
dcl  bj_index		        fixed bin;
dcl  proc_index		        fixed bin;

	bj_index = bj_pste.bj_ix;
	bj_check_in_table_ptr = ptr (bjm_data_$bj_pst_ptr, bjm_data_$bj_pst_ptr -> bj_pst.check_in_table_offset);
	n_processes = 0;

	do proc_index = 1 to bj_check_in_table.max_n_processes;
	     if bj_check_in_table.cross_proc_bj (proc_index, bj_index) ^= "0"b
	     then n_processes = n_processes + 1;
	end;

	return (n_processes);

     end N_USERS;


%page;
%include dm_bj_global_error_info;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_check_in_table;
%page;

     end bjm_delete;




		    bjm_find_old_uid_pn_table.pl1   04/09/85  1448.4r w 04/08/85  1128.0       17757



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */
bjm_find_old_uid_pn_table:
     proc (Old_boot_dir, Bj_pn_table_p, Code);

/*  DESCRIPTION:
     This program locates the before journal unique id-pathname table from
   an old bootload instance of DMS.  Currently, this table is in the
   bj_pst_segment.  The table is required for DMS recovery to operate.
*/

/*  HISTORY:
Written by Lee A. Newcomb, 6 Jan 1983
Modified:
*/
/* format:  style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */
%page;
/* initialize output parameter */
	Code = 0;					/* let's be optimistic */


/* now initiate the PST segment in the old directory */
	call initiate_file_ (Old_boot_dir, BJ_PST, R_ACCESS, bj_pst_ptr, (0), Code); /* ignore bit count */
	if Code ^= 0 then				/* sorry */
	     return;


/* OK, now get the location we want */
	Bj_pn_table_p = addrel (bj_pst_ptr, bj_pst.pn_table_offset);

	return;					/* I never said
it was lengthy */

/* end bjm_find_old_uid_pn_table; */
%page;
/* DECLARATIONS */

dcl  (						/* parameters */
     Old_boot_dir		        char (*),		/* INPUT: old bootload dir. of DMS */
     Bj_pn_table_p		        ptr,		/* OUTPUT: the location of the BJ UID-pathname table */
     Code			        fixed bin (35)	/* OUTPUT: normal error code, recovery fails if ^= 0 */
     )			        parameter;

dcl						/* PL/I things */
     addrel		        builtin;

dcl						/* external entries called */
     initiate_file_		        entry (char (*), char (*), bit (*), ptr, fixed bin
			        (24), fixed bin (35));
%page;
/* INCLUDE FILES */
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_names;
%skip (6);
%include access_mode_values;


     end bjm_find_old_uid_pn_table;




		    bjm_find_txns_after_crash.pl1   05/06/86  1321.0rew 05/06/86  1305.4      370044



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



/****^  HISTORY COMMENTS:
  1) change(86-01-07,Pierret), approve(86-01-30,MCR7331),
     audit(86-04-28,Newcomb), install(86-05-06,MR12.0-1054):
     Changed to check the tid in bj_rec_hdr and log an error if it is less than
     or equal to 0.
                                                   END HISTORY COMMENTS */


/* HISTORY PRIOR TO INITIAL INSTALLATION:

Written by Lee A. Newcomb, 11/15/82.
Modified:
12/06/82 by L. A. Newcomb:  handle Check_mode and fill in bj_txte.bj_uid.
03/02/83 by L. A. Newcomb: to recognize file_manager_ rollback and
	  post-commit handlers, and the begin commit mark;  this is
	  preparation for their actual use, more work is needed.  In
	  addition, the program is brought up-to-date with modifications
	  made to the bj_txt.
04/29/83 by L. A. Newcomb:  Added setting of bj_txte.(last_completed_operation
            ok_to_write) so writing an abort mark will work; initialized entry
            counts in the TDT and TXT; expanded inline documentation.
05/18/83 by Lindsey L. Spratt:  Changed to use the version 3 TDT.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/07/84 by Lee Baldwin:  Renamed dm_error_$bj_first_txn_record_type_bad to
            $bj_bad first_txn_record_type, $bj_inconsistent_txn_records to
            $bj_unexpected_eot_mark, and $bj_prev_rec_id_wrong to
            $wrong_prev_rec_id.
06/11/84 by Lee Baldwin:  Renamed dm_error_$bj_bad_txn_id_in_prev_record
            to $bj_rec_txn_id_mismatch.
10/24/84 by Lee A. Newcomb:  Changed user id in TDT to "<PRE-CRASH>" from
            "<GUESS WHO>" and did some small fixing up of format.
12/10/84 by R. Michael Tague:  Changed incl name to dm_daemon_sv_codes.
01/16/85 by Lee A. Newcomb:  Fixed to use dm_log_sv_codes.incl.pl1 instead of
            the obsolete dm_daemon_sv_codes.incl.pl1; fixed the BJM entry
            protocol to only invoke the cleanup procedure if we can set
            bj_data_$bj_operation; minor format changes.
02/28/85 by Lee A. Newcomb:  Added understanding FM_(ROLLBACK
            POSTCOMMIT)_HANDLER's can be first records of a txn chain; removed
            tests for HANDLER records as they are not currently supported;
            reset code at each step through the GET_PREVIOUS_LOOP as
            check_mode would cause an error to occur for each record read
            after the one in error was read; fixed to set the txn state to
            TM_COMMIT_WRITING_MARK_STATE when a BEGIN_COMMIT record is found
            so we will roll the txn forward.
03/04/85 by Lee A. Newcomb:  Fixed to report txn ID's in decimal and not read
            past a ROLLED_BACK mark in the FIND_FIRST_RECORD do group.
03/05/85 by Steve Herbst: Replaced dm_log_ with dm_misc_util_$log.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.

END HISTORY PRIOR TO INITIAL INSTALLATION */


/* DESCRIPTION:

	bjm_find_txns_after_crash is THE program to read a before journal
     opened for crash recovery.  ANY CHANGES TO BJM_WRITE OR BJ_TXTE_UTIL
     SHOULD BE EXAMINED TO BE SURE THEY DO NOT INVALIDATE ASSUMPTIONS MADE
     IN THIS MODULE.  Likewise, any changes to this module should be sure
     to not contradict the journal writing mechanisms in the above modules.

	This program is contracted to find all unfinished transactions in a
     before journal (BJ) that was open during a crash.  Its intended caller is
     dm_recovery_.  Two lists are created for "registering" txns: unfinished
     txns to be rolled back or, if multi-phase commits, to be completed; and
     finished txns (i.e., a commit or abort mark is in the BJ for the txn).
     These two lists are kept in temp.  segs.  in the process' [pd] for
     accounting purposes.  However, ONLY INFORMATION NEEDED FOR RECOVERY OF THE
     UNFINISHED TRANSACTIONS IS RETURNED TO THE CALLER.  This data is returned
     in two structures provided by the caller that are currently images of the
     tm_tdt and bj_txt.  No information on any found, finished txns is returned
     to the caller.

	Currently, if any error in processing is encountered, a non-zero code
     is returned and no data is returned.  The exception to this is when
     check mode is enabled; then the fact that too many or few unfinished
     (active) transactions were found is reported.  The entire journal will be
     swept in reverse order and the bj_storage_get loop will not be reached
     (N.B., it is theoretically possible for check_mode to find non-existant
     errors).  In general, if a "fatal" error occurs, the caller's lists will
     contain the data acquired up to the time the error happens.

	The main procedure is responsible for detecting gross errors (e.g.
     multiple commit or abort marks for the same transaction).  The error
     detection should stand out when the main proc.  is read as it is all
     over the place.  Besides the normal clean_up proc., there are four
     other internal procedures, in two sets.  The first set is called to see
     if a transaction has been recognized as either finished or unfinished.
     These do a simple sequential search through the lists of finished or
     unfinished transactons, returning true or false; they also set
     "txn_idx", the slot into the appropriate list where this transaction's
     data is kept.  If false is returned, txn_idx is zero indicating a new
     transaction has been encountered in the journal.  The second set
     registers the data for the transaction in the appropriate list.  They
     also do consistency checking (e.g., the owner's process_id is the same
     in all records of the transaction).  These two require txn_idx to be
     set to the proper index into the list(s), zero (register a new txn), or
     -1 (must find the correct position in the lists).

	Note: changes will have to be made when checkpoints, multi-phase
     commits, and any change to the before journal record structure are
     made.  Also, the effect of "orphan" records in the journal must be
     examined and allowances made for them if necessary.
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bjm_find_txns_after_crash:
   proc (p_old_tm_tdt_ptr, p_old_bj_txt_ptr, p_bj_oid, p_check_mode, p_code);

/* START OF DECLARATIONS */

/* Parameters */
dcl  (
     p_old_tm_tdt_ptr		ptr,
     p_old_bj_txt_ptr		ptr,
     p_bj_oid			bit (36) aligned,
     p_check_mode			bit (1) aligned,	/* sweep the entire journal for inconsistencies? */
     p_code			fixed bin (35)	/* OUTPUT: normal error code, recovery fails if ^= 0 */
     )				parameter;

/* Automatic */
dcl  (
     bit_bucket			bit (1) aligned,
     bj_oid			bit (36) aligned,	/* local holder of param. */
     bj_rec_id			bit (36) aligned,
     bj_uid			bit (36) aligned,	/* for error reporting */
     check_mode			bit (1) aligned,	/* local holder of param. */
     clean_code			fixed bin (35),
     code				fixed bin (35),	/* local holder of error code */
     finished_txns_list_p		ptr,		/* local finished txn list loc. */
     get_previous_loop		bit (1) aligned,	/* so register_unknown knows how to cmp rec_id's */
     last_bj_rec_id			bit (36) aligned,	/* for error reporting in get_previous loop */
     1 local_bj_rec_hdr		aligned like bj_rec_hdr,
						/* local copy since it's small */
     n_registered_finished_txns	fixed bin,	/* # of finished txns found */
     n_registered_unfinished_txns	fixed bin,	/* # of unfinished txns found */
     n_unfinished_txns		fixed bin,	/* # of unfinished txns recorded in last bj rec. */
     old_bj_txt_p			ptr,		/* local of loc. of caller's bjm data list */
     old_tm_tdt_p			ptr,		/* local of loc. of caller's tm data list */
     txn_idx			fixed bin,	/* used for loops in is_("" un)finished_txn */
     unfinished_txns_list_p		ptr		/* local unfinished txn list loc. */
     )				automatic;

/* Based */

/* the next two structures are used to keep track of the transactions found */
/*     in the before journal.  Extra data is currently being kept during */
/*     development phase to help detect errors in recording journal records */
/*     (if they occur). */

dcl  1 finished_txns_list		dim (1:n_registered_finished_txns)
				aligned based (finished_txns_list_p),
       2 txn_id			bit (36),
       2 owners_process_id		bit (36),		/* of txn owner */
       2 n_effective_records_written	fixed bin (36) unsigned,
						/* would have matched bj_txte.tx_rec_no */
       2 n_effective_records_read	fixed bin (36) unsigned,
						/* never to exceed ...written */
       2 prev_rec_id		bit (36),		/* may restart after rollback mark found */
       2 rollback_mark_found		bit (1);		/* allows extra records after ...written = ...read */

dcl  1 unfinished_txns_list		dim (1:n_registered_unfinished_txns)
				aligned based (unfinished_txns_list_p),
						/* most data kept in tm_tdt and bj_txt */
       2 n_effective_records_read	fixed bin (36) unsigned,
						/* never to exceed bj_txte.n_rec_written */
       2 prev_rec_id		bit (36),		/* may restart after rollback mark found */
       2 rollback_mark_found		bit (1);		/* allows extra records after ...written = ...read */

/* Builtin */
dcl  (addr, bin, null, unspec)	builtin;

/* Condition */
dcl  cleanup			condition;

/* Entry */
dcl  (
     bj_cleanup_tables$handler	entry (fixed bin (35)),
     bj_oid_util$get_uid		entry (bit (36) aligned)
				returns (bit (36) aligned),
     bj_storage_get_header		entry (bit (36) aligned,
				bit (36) aligned, ptr),
     bj_storage_get_header$last	entry (bit (36) aligned,
				bit (36) aligned, ptr),
     bj_storage_get_header$previous	entry (bit (36) aligned,
				bit (36) aligned, ptr),
     dm_misc_util_$log		entry options (variable),
     get_temp_segment_		entry (char (*), ptr, fixed bin (35)),
     release_temp_segment_		entry (char (*), ptr, fixed bin (35))
     )				external;

/* External */
dcl  (
     dm_error_$bj_rec_txn_id_mismatch,
     dm_error_$bj_first_txn_rec_not_found,
     dm_error_$bj_bad_first_txn_record_type,
     dm_error_$bj_bad_tid,
     dm_error_$bj_unexpected_eot_mark,
     dm_error_$bj_neg_txns_in_unfinished_rec,
     dm_error_$bj_wrong_prev_rec_id,
     dm_error_$bj_rec_process_id_mismatch,
     dm_error_$bj_recursive_invoc,
     dm_error_$bj_too_few_records,
     dm_error_$bj_too_few_unfinished_txns,
     dm_error_$bj_too_many_unfinished_txns,
     dm_error_$bj_wrong_numb_txn_records,
     dm_error_$bj_zero_txns_in_unfinished_rec,
     error_table_$unimplemented_version
     )				fixed bin (35) ext static;

/* END OF DECLARATIONS */
%page;
COPY_INPUT_AND_INIT_OUTPUT_PARAMETERS:
   do;
      old_tm_tdt_p = p_old_tm_tdt_ptr;
      if old_tm_tdt_p -> tm_tdt.version ^= TM_TDT_VERSION_3 then do;
         p_code = error_table_$unimplemented_version;
         return;
      end;
      old_bj_txt_p = p_old_bj_txt_ptr;
      if old_bj_txt_p -> bj_txt.version ^= BJ_TXT_VERSION_1 then do;
         p_code = error_table_$unimplemented_version;
         return;
      end;

      bj_oid = p_bj_oid;
      bj_uid = bj_oid_util$get_uid (bj_oid);		/* we want the UID for reporting errors */
      check_mode = p_check_mode;
      p_code = 0;					/* let's be optimistic */

   end COPY_INPUT_AND_INIT_OUTPUT_PARAMETERS;

BJM_STANDARD_ENTRY_PROTOCOL:
   do;

      if bjm_data_$bj_operation ^= "" then do;
         code = dm_error_$bj_recursive_invoc;
         go to no_cleanup_return;
      end;

SET_CLEANUP_HANDLER:
      do;

/* N.B. we do not cross rings for now as this should only	*/
/* be used as this should be used from DM ring only.	*/
/* However, we must be able to reset bj_operation before it */
/* we set it.					*/

         finished_txns_list_p, unfinished_txns_list_p = null ();
         code = 0;
         on cleanup call clean_up ();

      end SET_CLEANUP_HANDLER;

      bjm_data_$bj_operation = "bjm_find_txns_after_crash";
      bjm_data_$bj_code = 0;

   end BJM_STANDARD_ENTRY_PROTOCOL;
%page;
GET_TEMP_STORAGE:
   call get_temp_segment_ ("bjm_find_txns_after_crash", finished_txns_list_p,
        code);
   if code ^= 0 then do;
      call dm_misc_util_$log (LOG_SV, code, "bjm_find_txns_after_crash",
	 "Unable to get temp. storage for finished txn. list.");
      go to clean_and_return;
   end;

   call get_temp_segment_ ("bjm_find_txns_after_crash", unfinished_txns_list_p,
        code);
   if code ^= 0 then do;
      call dm_misc_util_$log (LOG_SV, code, "bjm_find_txns_after_crash",
	 "Unable to get temp. storage for unfinished txn. list.");
      go to clean_and_return;
   end;


SET_COUNTERS:
   do;
      n_registered_unfinished_txns,			/* initialize these for the register_* procs. */
	 n_registered_finished_txns, old_tm_tdt_p -> tm_tdt.entry_count,
	 old_bj_txt_p -> bj_txt.n_entries_used = 0;
   end SET_COUNTERS;

   bj_rec_hdr_ptr = addr (local_bj_rec_hdr);		/* for convience */
%page;
GET_LAST_JOURNAL_RECORD:				/* must get the last record of the journal to start things off; better known */
						/*     as the head chasing the tail.  Must set up bj_... error handling, */
						/*     though I can't think why getting the last record hdr would blow up */
						/*     Note the special mercy given if check_mode is true. */
   bjm_data_$bj_exit_err = cannot_get_last_journal_record;
   call bj_storage_get_header$last (bj_oid, bj_rec_id, bj_rec_hdr_ptr);

   if bj_rec_id = ""b then				/* no records in journal ==> nothing to do */
      go to clean_and_return;

   n_unfinished_txns = bj_rec_hdr.n_txn;		/* # of active txns in before journal */

   if n_unfinished_txns < 0 then do;			/* a negative # of active txns?? */

      code = dm_error_$bj_neg_txns_in_unfinished_rec;
      call dm_misc_util_$log (LOG_SV, code, "bjm_find_txns_after_crash",
	 "Last journal record, BJ uid ^o, record id ^o.", bj_uid, bj_rec_id);
      if check_mode then
         go to register_last_record;			/* keep plugging */
      else go to clean_and_return;			/* or use the die_immediate instruction */
   end;

   if n_unfinished_txns = 0 then do;			/* better be a commit or abort */

      if bj_rec_hdr.type ^= BJ_RECORD_TYPE.COMMITTED
	 & bj_rec_hdr.type ^= BJ_RECORD_TYPE.ABORTED then do;

         code = dm_error_$bj_zero_txns_in_unfinished_rec;
         call dm_misc_util_$log (LOG_SV, code, "bjm_find_txns_after_crash",
	    "Invalid last before journal record, BJ uid ^o, record id ^o.",
	    bj_uid, bj_rec_id);
      end;
      if check_mode then
         go to register_last_record;			/* we sweep the whole journal */
      else go to clean_and_return;			/* or nothing to do */
   end;

   else go to register_last_record;
%page;
cannot_get_last_journal_record:
   do;

/* we come here if a non-local goto is done by the bj_storage_get_header$last */
/*     call.  Even check_mode can't save us this time. */

      code = bjm_data_$bj_code;
      call dm_misc_util_$log (LOG_SV, code, "bjm_find_txns_after_crash",
	 "Unable to read last record in before journal, BJ uid ^o.", bj_uid);
      go to clean_and_return;
   end;
%skip (4);
register_last_record:
   do;

/* If we get here, we have the header of the last record in the journal. */
/*     Since our lists of txns. are empty, must always add the txn. data. */
/*     Remember, if we decide the record is active, register_unfinished_txn */
/*     will decrement n_unfinished_txns. */

      txn_idx = 0;					/* know the txn list is empty */

      if bj_rec_hdr.type = BJ_RECORD_TYPE.COMMITTED
	 | bj_rec_hdr.type = BJ_RECORD_TYPE.ABORTED then
         call register_finished_txn (code);
      else call register_unfinished_txn (code);

      if code ^= 0 then do;				/* can't do a thing */

         call dm_misc_util_$log (LOG_SV, code, "bjm_find_txns_after_crash",
	    "Could not register last BJ record, BJ uid ^o, record id ^o.",
	    bj_uid, bj_rec_id);
         if ^check_mode then
	  go to clean_and_return;
      end;
   end;
%page;
/* Now loop until all unfinished txns have been found and	*/
/* most or all of the data required for recovery has been	*/
/* recorded in the caller's storage.  If check_mode is on,	*/
/* we will never leave this loop until all journal records	*/
/* have been read or an error is taken by the		*/
/* get_header$previous call.  If check_mode is off, the	*/
/* get_header loop (following this loop) will be used to	*/
/* make sure all recovery data has been found.		*/

FIND_AND_REGISTER_TRANSACTONS:
   do;
      get_previous_loop = "1"b;			/* for register_unfinished... */
      last_bj_rec_id = ""b;				/* for error reporting */
      bjm_data_$bj_exit_err = cannot_get_previous_record;

/* Loop until we have what we think are all active txns or the entire */
/* BJ has been read backwards chronologically (latter if check_mode on). */
/* Note we clear any error from the code cell; this is only	*/
/* really useful if we are in check_mode as any error found	*/
/* will stay with us for ALL records read from that point	*/
/* on; as the setting is cheap, we do not bother to test	*/
/* check_mode to see if we need to set code to zero.	*/

GET_PREVIOUS_LOOP:
      do while (n_unfinished_txns > 0 | check_mode);

         code = 0;
         call bj_storage_get_header$previous (bj_oid, bj_rec_id,
	    bj_rec_hdr_ptr);

         if bj_rec_id = ""b then do;			/* We have read all the records in the BJ. */

	  if ^check_mode then do;			/* should not happen unless in check mode */
	     code = dm_error_$bj_too_few_records;	/* by definition */
	     call dm_misc_util_$log (LOG_SV, code,
		"bjm_find_txns_after_crash",
		"In get_previous loop, BJ uid ^o, last read record id ^o.",
		bj_uid, last_bj_rec_id);
	     go to clean_and_return;
	  end;

	  if n_unfinished_txns > 0 then do;		/* we missed some active txns */
	     code = dm_error_$bj_too_few_unfinished_txns;
	     call dm_misc_util_$log (LOG_SV, code,
		"bjm_find_txns_after_crash",
		"BJ uid ^o, last read record id ^o.", bj_uid,
		last_bj_rec_id);
	  end;
	  else if n_unfinished_txns < 0 then do;	/* we got too many active txns */
	     code = dm_error_$bj_too_many_unfinished_txns;
	     call dm_misc_util_$log (LOG_SV, code,
		"bjm_find_txns_after_crash",
		"BJ uid ^o, last read record id ^o.", bj_uid, bj_rec_id);
	  end;
	  else do;				/* must check all 1st records of active txns found */
						/* if code stays zero, no problems in journal */
	     do txn_idx = 1 to n_registered_unfinished_txns;
	        if unfinished_txns_list.prev_rec_id (txn_idx) ^= ""b then do;
		 code = dm_error_$bj_first_txn_rec_not_found;
		 call dm_misc_util_$log (LOG_SV, code,
		      "bjm_find_txns_after_crash",
		      "While in check_mode with all transactions found, BJ uid ^o, txn id ^d.",
		      bj_uid,
		      bin (old_tm_tdt_p -> tm_tdt.entry (txn_idx).txn_id));
	        end;
	     end;					/* of checking for 1st records */
	  end;

	  go to clean_and_return;
         end;					/* end beginning of BJ check */

/* LOOP CONTINUED ON NEXT PAGE */
%page;
/* LOOP CONTINUED FROM PREVIOUS PAGE */

         if bj_rec_hdr.n_txn < 0 then do;
	  code = dm_error_$bj_neg_txns_in_unfinished_rec;
	  call dm_misc_util_$log (LOG_SV, code, "bjm_find_txns_after_crash",
	       "During bj_storage_get_header$previous loop, BJ uid ^o, record id ^o.",
	       bj_uid, bj_rec_id);
	  if check_mode then
	     go to end_get_previous_loop;		/* continue reading */
	  else go to clean_and_return;
         end;

         if bin (bj_rec_hdr.tid) <= 0 then do;
	  code = dm_error_$bj_bad_tid;
	  call dm_misc_util_$log (LOG_SV, code, "bjm_find_txns_after_crash",
	       "During bj_storage_get_header$previous loop, BJ uid ^o, record id ^o, TID ^d.",
	       bj_uid, bj_rec_id, bin (bj_rec_hdr.tid));
	  if check_mode then
	     go to end_get_previous_loop;		/* continue reading */
	  else go to clean_and_return;
         end;

         if bj_rec_hdr.type = BJ_RECORD_TYPE.COMMITTED
	    | bj_rec_hdr.type = BJ_RECORD_TYPE.ABORTED then do;

	  if is_unfinished_txn () then do;		/* finished and then unfinished? */

	     code = dm_error_$bj_unexpected_eot_mark;
	     call dm_misc_util_$log (LOG_SV, code,
		"bjm_find_txns_after_crash",
		"Commit or abort mark found ahead of a before image.  "
		|| "BJ uid ^o, record id ^o, txn id ^d.", bj_uid,
		bj_rec_id, bin (bj_rec_hdr.tid));
	     if check_mode then
	        go to end_get_previous_loop;
	     else go to clean_and_return;
	  end;

	  if is_finished_txn () then do;		/* can't be finished more than once */

	     code = dm_error_$bj_unexpected_eot_mark;
	     call dm_misc_util_$log (LOG_SV, code,
		"bjm_find_txns_after_crash",
		"Multiple commit or abort marks found for the same txn.  BJ uid ^o, "
		|| "record id ^o, txn id ^d.", bj_uid, bj_rec_id,
		bin (bj_rec_hdr.tid));
	     if check_mode then
	        go to end_get_previous_loop;
	     else go to clean_and_return;
	  end;

/* LOOP CONTINUED ON NEXT PAGE */
%page;
/* LOOP CONTINUED FROM PREVIOUS PAGE */
/* OK, it's a good record and is_finished_txn has set txn_idx to 0 for us. */
/*     Add the record to the list of finished transactions. */

	  call register_finished_txn (code);

	  if code ^= 0 then do;
finsihed_txn_reg_err:				/* to avoid some duplication later */
	     call dm_misc_util_$log (LOG_SV, code,
		"bjm_find_txns_after_crash",
		"Error registering finished txn., BJ uid ^o, record id ^o, txn id ^d.",
		bj_uid, bj_rec_id, bin (bj_rec_hdr.tid));
	     if check_mode then
	        go to end_get_previous_loop;
	     else go to clean_and_return;
	  end;
         end;

         else if ^is_finished_txn () then do;		/* if not a before image of an already finished txn */

	  txn_idx = -1;				/* must find the place in lists */
	  call register_unfinished_txn (code);		/* will affect n_unfinished_txns */
	  if code ^= 0 then do;

	     call dm_misc_util_$log (LOG_SV, code,
		"bjm_find_txns_after_crash",
		"Error registering unfinished txn., BJ uid ^o, record id ^o, txn id ^d.",
		bj_uid, bj_rec_id, bin (bj_rec_hdr.tid));
	     if check_mode then
	        go to end_get_previous_loop;
	     else go to clean_and_return;
	  end;
         end;
         else do;					/* for now do consistency checking on finished txn */

	  call register_finished_txn (code);		/* is_finsihed_txn call still has txn_idx set */
	  if code ^= 0 then
	     go to finsihed_txn_reg_err;		/* just being a bit lazy */
         end;

end_get_previous_loop:
         last_bj_rec_id = bj_rec_id;			/* for error reporting only */

      end GET_PREVIOUS_LOOP;

   end FIND_AND_REGISTER_TRANSACTONS;

   go to GET_FIRST_RECORD_FOR_UNFINISHED_TXNS;		/* this loop worked, skip its unwinding handler */
%page;
cannot_get_previous_record:
   do;

/* We come here if bj_storage_get_header$previous call takes an error and */
/* unwinds.  We don't care about check_mode in this case. */

      code = bjm_data_$bj_code;

      call dm_misc_util_$log (LOG_SV, code, "bjm_find_txns_after_crash",
	 "A call to bj_storage_get_previous in recovery phase failed, BJ uid ^o, last read record id ^o.",
	 bj_uid, bj_rec_id);
      go to clean_and_return;
   end;
%page;
/* GET LOOP */

/* We now have a list of all unfinished txns in the before journal being */
/*     used.  If the 1st record in the journal for a txn. has not yet been */
/*     found, find it.  For now, any error will cause processing to stop. */
/*     It is not advised to attempt to rollback any txns with the data */
/*     gathered before the error.  Note: this loop will never be executed if */
/*     check_mode is on. */

GET_FIRST_RECORD_FOR_UNFINISHED_TXNS:
   do;
      get_previous_loop = ""b;			/* for register_unfinished... */
      bjm_data_$bj_exit_err = cannot_get_a_record;

WALK_UNFINISHED_TXNS_LIST:
      do txn_idx = 1 to n_registered_unfinished_txns;	/* get 1st record of the unfinished txns */

FIND_FIRST_RECORD:					/* done when previous record ID is null, or we have found a	*/
						/* ROLLED_BACK mark with checkpoint ID zero (in this case,	*/
						/* we cannot trust previous records have not been		*/
						/* recycled).  THIS CODE WILL NEED MODIFICATION WHEN A	*/
						/* CHECKPOINT FACILITY IS AVAILABLE.			*/
         do while (unfinished_txns_list.prev_rec_id (txn_idx) ^= ""b
	    & ^unfinished_txns_list.rollback_mark_found (txn_idx));

	  call bj_storage_get_header (bj_oid,
	       unfinished_txns_list.prev_rec_id (txn_idx), bj_rec_hdr_ptr);

	  if bj_rec_hdr.n_txn < 0 then do;

	     code = dm_error_$bj_neg_txns_in_unfinished_rec;
	     call dm_misc_util_$log (LOG_SV, code,
		"bjm_find_txns_after_crash",
		"During bj_storage_get_header loop, BJ uid ^o, record id ^o.",
		bj_uid, unfinished_txns_list.prev_rec_id (txn_idx));
	     go to clean_and_return;
	  end;
	  if bj_rec_hdr.n_txn = 0 then do;

	     code = dm_error_$bj_zero_txns_in_unfinished_rec;
	     call dm_misc_util_$log (LOG_SV, code,
		"bjm_find_txns_after_crash",
		"During bj_storage_get_header loop, BJ uid ^o, record id ^o.",
		bj_uid, unfinished_txns_list.prev_rec_id (txn_idx));
	     go to clean_and_return;
	  end;

	  if bj_rec_hdr.type = BJ_RECORD_TYPE.COMMITTED | /* finished and then unfinished?? */
	       bj_rec_hdr.type = BJ_RECORD_TYPE.ABORTED then do;

	     code = dm_error_$bj_unexpected_eot_mark;
	     call dm_misc_util_$log (LOG_SV, code,
		"bjm_find_txns_after_crash",
		"Commit or abort mark found ahead of before image.  BJ uid ^o, record id ^o, txn id ^d.",
		bj_uid, unfinished_txns_list.prev_rec_id (txn_idx),
		bin (old_tm_tdt_p -> tm_tdt.entry (txn_idx).txn_id));
	     go to clean_and_return;
	  end;
%page;
	  if bj_rec_hdr.tid ^= old_tm_tdt_p -> tm_tdt.entry (txn_idx).txn_id
	  then do;

	     code = dm_error_$bj_rec_txn_id_mismatch;
	     call dm_misc_util_$log (LOG_SV, code,
		"bjm_find_txns_after_crash",
		"During bj_storage_get_header loop, BJ uid ^o, record id ^o, txn id ^d.",
		bj_uid, unfinished_txns_list.prev_rec_id (txn_idx),
		bin (old_tm_tdt_p -> tm_tdt.entry (txn_idx).txn_id));
	     go to clean_and_return;
	  end;

	  call register_unfinished_txn (code);		/* merges in required data for caller */

	  if code ^= 0 then do;
	     call dm_misc_util_$log (LOG_SV, code,
		"bjm_find_txns_after_crash",
		"Error while looking for 1st record of unfinished txn. BJ uid ^o, record id ^o, txn id ^d.",
		bj_uid, unfinished_txns_list.prev_rec_id (txn_idx),
		bin (old_tm_tdt_p -> tm_tdt.entry (txn_idx).txn_id));
	     go to clean_and_return;
	  end;

         end FIND_FIRST_RECORD;			/* of getting 1st record for a single txn */

      end WALK_UNFINISHED_TXNS_LIST;			/* of getting all txns 1st records */

   end GET_FIRST_RECORD_FOR_UNFINISHED_TXNS;

   go to clean_and_return;				/* loop worked, skip its unwinding handler */
%skip (4);
cannot_get_a_record:				/* come here if get call unwinds */
   do;

      code = bjm_data_$bj_code;

      call dm_misc_util_$log (LOG_SV, code, "bjm_find_txns_after_crash",
	 "A call to bj_storage_get in recovery phase failed, BJ uid ^o, record id ^o, txn id ^d.",
	 bj_uid, unfinished_txns_list.prev_rec_id (txn_idx),
	 bin (old_tm_tdt_p -> tm_tdt.entry (txn_idx).txn_id));
      go to clean_and_return;
   end;
%skip (6);
/* we're DONE, error or not */
clean_and_return:
   call clean_up ();
no_cleanup_return:
   p_code = code;					/* in case clean_up took error */

   return;
%page;
is_finished_txn:
   proc () returns (bit (1) aligned);

/* This procedure does a simple look through the finished_txns_list to see */
/*     if the txn we are working over has had a commit or abort mark found */
/*     in a previously read before image.  If so, "1"b is returned, */
/*     otherwise, ""b. N.B., txn_idx is left as a residue for the */
/*     registering routines for efficency, and zeroed if the txn id is */
/*     not found. */

   do txn_idx = 1 to n_registered_finished_txns;

      if finished_txns_list.txn_id (txn_idx) = bj_rec_hdr.tid then
         return ("1"b);
   end;

   txn_idx = 0;					/* for registering proc. */
   return (""b);					/* did not find the txn id in the temp list */

   end is_finished_txn;
%skip (6);
is_unfinished_txn:
   proc () returns (bit (1) aligned);

/* This procedure does a simple look to see if the txn we are working over */
/*     has never had a commit or abort mark found in a previously read */
/*     before image.  If so, "1"b is returned, otherwise, ""b.  N.B. see */
/*     is_finished_txn proc for use of txn_idx */

   do txn_idx = 1 to n_registered_unfinished_txns;

      if old_tm_tdt_p -> tm_tdt.entry (txn_idx).txn_id = bj_rec_hdr.tid then
         return ("1"b);
   end;

   txn_idx = 0;					/* let registering routines know a new entry needed */
   return (""b);					/* did not find the txn id in the temp list */

   end is_unfinished_txn;
%page;
register_finished_txn:
   proc (temp_code);

/* This proc. records a list of finished txns for later searching. */
/*     Some consistency checking will also be done. */
/*     Note the only way for a txn. to get registered initially is for a */
/*     commit or abort record to be found.  This fact is used in the */
/*     "if txn_idx = 0" do group which does the initial registration. */

dcl  temp_code			fixed bin (35) parameter;

   if txn_idx = -1 then				/* must get it */
      bit_bucket = is_finished_txn ();

   if txn_idx = 0 then do;				/* totally new data */
      n_registered_finished_txns, txn_idx = n_registered_finished_txns + 1;

      finished_txns_list.txn_id (txn_idx) = bj_rec_hdr.tid;
      finished_txns_list.owners_process_id (txn_idx) = bj_rec_hdr.process_id;
      finished_txns_list.n_effective_records_written (txn_idx) =
	 bj_rec_hdr.tx_rec_no;
      finished_txns_list.n_effective_records_read (txn_idx) = 1;

      if bj_rec_hdr.prev_rec_id = ""b then do;		/* must verify some things */
         temp_code = dm_error_$bj_bad_first_txn_record_type;
         if check_mode then
	  go to finish_initializing_data;		/* so we don't lose error code */
         else return;
      end;

      if bj_rec_hdr.tx_rec_no <= 1 then do;
         temp_code = dm_error_$bj_wrong_numb_txn_records;
         if ^check_mode then
	  return;
      end;

finish_initializing_data:
      finished_txns_list.prev_rec_id (txn_idx) = bj_rec_hdr.prev_rec_id;
      finished_txns_list.rollback_mark_found (txn_idx) = ""b;


      return;					/* done with initial data recording */
   end;
%page;
/* THIS TRANSACTION ALREADY IN LIST, so do some consistency checking */
/*     compared to what we expected to find.  If the checks pass, update */
/*     some of the saved data for future possible checks.  Note this code */
/*     only called if we are in the get_previous calling loop. */

   if bj_rec_hdr.process_id ^= finished_txns_list.owners_process_id (txn_idx)
   then do;
      temp_code = dm_error_$bj_rec_process_id_mismatch;
      if check_mode then
         go to update_data;
      else return;
   end;

   if finished_txns_list.rollback_mark_found (txn_idx) then /* no more checks are meaningfull */
      if check_mode then
         go to update_data;
      else return;

   if bj_rec_id ^= finished_txns_list.prev_rec_id (txn_idx) then do;
      temp_code = dm_error_$bj_wrong_prev_rec_id;
      if check_mode then
         go to update_data;
      else return;
   end;

   if bj_rec_hdr.prev_rec_id = ""b then do;

      if bj_rec_hdr.type ^= BJ_RECORD_TYPE.ROLLED_BACK
	 & bj_rec_hdr.type ^= BJ_RECORD_TYPE.FM_POSTCOMMIT_HANDLER
	 & bj_rec_hdr.type ^= BJ_RECORD_TYPE.FM_ROLLBACK_HANDLER
	 & bj_rec_hdr.type ^= BJ_RECORD_TYPE.BEFORE_IMAGE then do;

         temp_code = dm_error_$bj_bad_first_txn_record_type;
         if check_mode then
	  go to update_data;
         else return;
      end;
%page;
/* must be last record to read */
      if finished_txns_list.n_effective_records_read (txn_idx)
	 ^= finished_txns_list.n_effective_records_written (txn_idx) - 1
      then do;

         temp_code = dm_error_$bj_wrong_numb_txn_records;
         if check_mode then
	  go to update_data;
         else return;
      end;
   end;

/* checks out, OK to update registered data */

update_data:
   finished_txns_list.n_effective_records_read (txn_idx) =
        finished_txns_list.n_effective_records_read (txn_idx) + 1;
   if bj_rec_hdr.type = BJ_RECORD_TYPE.ROLLED_BACK then
      finished_txns_list.rollback_mark_found (txn_idx) = "1"b;
   finished_txns_list.prev_rec_id (txn_idx) = bj_rec_hdr.prev_rec_id;


   return;					/* free again */

   end register_finished_txn;
%page;
register_unfinished_txn:
   proc (temp_code);

/* This procedure is responsible for maintaining the internal list of */
/*     unfinished txns.  There is actually a second important function for */
/*     this proc.:  to update the caller's list of information needed to */
/*     rollback the txns.  The internal list is kept for consistency checks */

dcl  temp_code			fixed bin (35) parameter;

   if txn_idx = -1 then				/* must get it */
      bit_bucket = is_unfinished_txn ();		/* and this does it */

   if txn_idx = 0 then do;				/* a new one comes into the fold */

      if n_unfinished_txns <= 0 & ^check_mode then do;	/* don't do this test in check_mode */
         temp_code = dm_error_$bj_too_many_unfinished_txns;
         return;
      end;

      n_unfinished_txns = n_unfinished_txns - 1;		/* one less to look for */
      n_registered_unfinished_txns, txn_idx,
	 old_tm_tdt_p -> tm_tdt.entry_count,
	 old_bj_txt_p -> bj_txt.max_n_entries,
	 old_bj_txt_p -> bj_txt.n_entries_used =
	 n_registered_unfinished_txns + 1;		/* the next slot */

/* fill in new slot with data available first, the internal list */

      unfinished_txns_list.n_effective_records_read (txn_idx) = 1;
      unfinished_txns_list.prev_rec_id (txn_idx) = bj_rec_hdr.prev_rec_id;
      if bj_rec_hdr.prev_rec_id = ""b then do;

         if bj_rec_hdr.type ^= BJ_RECORD_TYPE.ROLLED_BACK
	    & bj_rec_hdr.type ^= BJ_RECORD_TYPE.BEFORE_IMAGE
	    & bj_rec_hdr.type ^= BJ_RECORD_TYPE.FM_ROLLBACK_HANDLER
	    & bj_rec_hdr.type ^= BJ_RECORD_TYPE.FM_POSTCOMMIT_HANDLER
         then do;

	  temp_code = dm_error_$bj_bad_first_txn_record_type;
	  if check_mode then
	     go to finish_initializing_data;
	  else return;
         end;

         if bj_rec_hdr.tx_rec_no < 1 then do;

	  temp_code = dm_error_$bj_wrong_numb_txn_records;
	  if check_mode then
	     go to finish_initializing_data;
	  else return;
         end;
      end;
%page;
finish_initializing_data:
      if bj_rec_hdr.type = BJ_RECORD_TYPE.ROLLED_BACK then
         unfinished_txns_list.rollback_mark_found (txn_idx) = "1"b;
      else unfinished_txns_list.rollback_mark_found (txn_idx) = ""b;

/* Initialize the tdt and txt entries and fill in common data after zeroing */
/* the entries.  tm_recover_after_crash and bjm_rebuild_after_crash are */
/* responsible for filling any values left zeroed that must be set for */
/* tm_adjust and cannot be set in this procedure. */

/* The following TDT entry elements are set to zero and left that way: */
/*	all mbzN's, event_channel, abandoned_sw, date_time_created, mode, */
/*	error_code, daemon_adjust_count, return_idx, and all flags and */
/*	post_commit_flags. */
/* The following TXT entry elements are set to zero and left that way: */
/*	bj_uid, all operator_info, curr_checkpoint_rec_id, */
/*	n_bytes_written, last_fm_postcommit_handler_rec_id, all */
/*	append_state, pad_entry_to_32_words */

      unspec (old_tm_tdt_p -> tm_tdt.entry (txn_idx)),
	 unspec (old_bj_txt_p -> bj_txt.entry (txn_idx)) = ""b;
      old_tm_tdt_p -> tm_tdt.entry (txn_idx).txn_id,
	 old_bj_txt_p -> bj_txt.entry (txn_idx).tid = bj_rec_hdr.tid;
      old_tm_tdt_p -> tm_tdt.entry (txn_idx).process_id,
	 old_bj_txt_p -> bj_txt.entry (txn_idx).owner_info.process_id =
	 bj_rec_hdr.process_id;

      if bj_rec_hdr.type = BJ_RECORD_TYPE.BEGIN_COMMIT then do;
         old_tm_tdt_p -> tm_tdt.entry (txn_idx).state =
	    TM_COMMIT_WRITING_MARK_STATE;
         old_bj_txt_p -> bj_txt.entry (txn_idx).last_completed_operation =
	    BJ_RECORD_TYPE.BEGIN_COMMIT;
      end;
      else old_tm_tdt_p -> tm_tdt.entry (txn_idx).state =
	      TM_ABORT_FLUSHING_TXN_STATE;
      old_bj_txt_p -> bj_txt.entry (txn_idx).bj_uid = bj_uid;
      old_bj_txt_p -> bj_txt.entry (txn_idx).last_bj_rec_id = bj_rec_id;
      old_bj_txt_p -> bj_txt.entry (txn_idx).n_rec_written =/* === n_effective_records_written in finished */
	 bj_rec_hdr.tx_rec_no;
      old_bj_txt_p -> bj_txt.entry (txn_idx).last_completed_operation =
	 bj_rec_hdr.type;
      old_bj_txt_p -> bj_txt.entry (txn_idx).ok_to_write = "1"b;
						/* so we can write mark */

/* NEED TEST ON POST COMMIT HANDLER HERE WHEN IMPLEMENTED */
      if bj_rec_hdr.prev_rec_id = ""b then
         old_bj_txt_p -> bj_txt.entry (txn_idx).first_bj_rec_id = bj_rec_id;

/* fill in things we don't currently get */
      old_tm_tdt_p -> tm_tdt.owner_name = "<PRE-CRASH>";

      return;					/* done initilizing this txn in our lists */
   end;

/* register_unfinished_txn CONTINUED ON NEXT PAGE */
%page;
/* CONTINUATION OF register_unfinished_txn PROC */

KNOWN_UNFINISHED_TXN:				/* so do some consistency checking */
   if bj_rec_hdr.process_id
        ^= old_tm_tdt_p -> tm_tdt.entry (txn_idx).process_id then do;

      temp_code = dm_error_$bj_rec_process_id_mismatch;
      if ^check_mode then
         return;
   end;

   if unfinished_txns_list.rollback_mark_found (txn_idx) & ^check_mode then
						/* we have the active part of the chain */
      return;					/* no more checks are meaningful */

/* special check if we are in get_previous call loop */

   if get_previous_loop then
      if n_unfinished_txns >= 0 then			/* must check prev_rec_id against curr. one */
         if bj_rec_id ^= unfinished_txns_list.prev_rec_id (txn_idx) then do;

	  temp_code = dm_error_$bj_wrong_prev_rec_id;
	  if check_mode then
	     go to update_data;
	  else return;
         end;

/* register_unfinished_txn CONTINUED ON NEXT PAGE */
%page;
/* CONTINUATION OF register_unfinished_txn PROC */

   if bj_rec_hdr.prev_rec_id = ""b then do;		/* better be 1st image, handler, or rollback */

      if bj_rec_hdr.type ^= BJ_RECORD_TYPE.ROLLED_BACK
	 & bj_rec_hdr.type ^= BJ_RECORD_TYPE.BEFORE_IMAGE
	 & bj_rec_hdr.type ^= BJ_RECORD_TYPE.FM_ROLLBACK_HANDLER
	 & bj_rec_hdr.type ^= BJ_RECORD_TYPE.FM_POSTCOMMIT_HANDLER then do;

         temp_code = dm_error_$bj_bad_first_txn_record_type;
         if check_mode then
	  go to update_data;
         else return;
      end;

      if unfinished_txns_list.n_effective_records_read (txn_idx) ^=
						/* must be last record to read */
	 old_bj_txt_p -> bj_txt.entry (txn_idx).n_rec_written - 1 then do;

         temp_code = dm_error_$bj_wrong_numb_txn_records;
         if check_mode then
	  go to update_data;
         else return;
      end;
   end;

/* checks out, OK to register new data */

update_data:
   unfinished_txns_list.n_effective_records_read (txn_idx) =
        unfinished_txns_list.n_effective_records_read (txn_idx) + 1;

   if bj_rec_hdr.type = BJ_RECORD_TYPE.ROLLED_BACK then
      unfinished_txns_list.rollback_mark_found (txn_idx) = "1"b;

   if bj_rec_hdr.prev_rec_id = ""b then
      if get_previous_loop then
         old_bj_txt_p -> bj_txt.entry (txn_idx).first_bj_rec_id = bj_rec_id;
      else old_bj_txt_p -> bj_txt.entry (txn_idx).first_bj_rec_id =
	      unfinished_txns_list.prev_rec_id (txn_idx);

   unfinished_txns_list.prev_rec_id (txn_idx) = bj_rec_hdr.prev_rec_id;

/* MUST ADD TEST/UPDATE OF USER POSTCOMMIT HANDLER RECORD WHEN IMPLEMENTED */

   return;					/* free at last */

   end register_unfinished_txn;
%page;
clean_up:
   proc ();

   call release_temp_segment_ ("bjm_find_txns_after_crash",
        finished_txns_list_p, clean_code);

   if clean_code ^= 0 then
      call dm_misc_util_$log (LOG_SV, clean_code, "bjm_find_txns_after_crash",
	 "Unable to release temp. storage for finished txn. list.");

   if code = 0 then
      code = clean_code;


   call release_temp_segment_ ("bjm_find_txns_after_crash",
        unfinished_txns_list_p, clean_code);

   if clean_code ^= 0 then
      call dm_misc_util_$log (LOG_SV, clean_code, "bjm_find_txns_after_crash",
	 "Unable to release temp. storage for unfinished txn. list.");

   if code = 0 then
      code = clean_code;


   call bj_cleanup_tables$handler (clean_code);

   if clean_code ^= 0 then
      call dm_misc_util_$log (LOG_SV, clean_code, "bjm_find_txns_after_crash",
	 "Unable to cleanup BJ tables.");

   if code = 0 then
      code = clean_code;


   bjm_data_$bj_operation = "";			/* ALWAYS release our hold */
   bjm_data_$bj_exit_err = bjm_data_$bj_default_error_label;

   return;

   end clean_up;
%page;
%include dm_bj_records;
%page;
%include dm_bj_txt;
%page;
%include dm_tm_tdt;
%page;
%include dm_log_sv_codes;
%page;
%include dm_tm_states;
%page;
%include dm_bj_global_error_info;


   end bjm_find_txns_after_crash;




		    bjm_firstref_tv_.alm            04/04/85  1117.3re  04/04/85  0826.2       35001



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1983 *
" *                                                         *
" ***********************************************************
"
"
" DESCRIPTION:
"
"	The inner ring transfer vector for the before journal
"    manager.  Only entries that must have a running Data Management
"    System should be in this transfer vector.  These entries are
"    alphabetized, keep them so.
"
"
" HISTORY:
"
" Written by M. Pandolf & J. Ives, 02/24/83.
" Modified:
" 04/13/83 by M. Pandolf: for get_journal_status.
" 04/27/83 by Lee A. Newcomb: added close_bj_after_recovery and
"	    open_bj_for_recovery.
" 08/01/83 by Lindsey Spratt: added the open_bj_force entry.
"	    Alphabetized the entries.
" 09/07/83 by Lee A. Newcomb:  to add "_" to per-process init entry.
" 09/09/83 by Lee A. Newcomb:  to call new system part 2 init program.
" 05/02/84 by Lee A. Newcomb:  added user_shutdown entry.
" 10/29/84 by Matthew Pierret: Added write_fm_postcommit_handler and
"             write_fm_rollback_handler.
" 11/22/84 by Lee A. Newcomb:  Added $per_process_init entry and changed
"	    firstref to be transaction_manager_$per_process_init.	 
" 12/03/84 by Stanford S. Cox: Renamed bjm_firstref_tv_, added flush_all.
" 03/20/85 by Lee A. Newcomb:  Added $set_transaction_storage_limit.
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " "


"
"	macro to transfer to bjm primitives
"

	macro	transfer
	entry	&1
&1:	tra	<&2>|[&3]
	&end


	name	bjm_firstref_tv_

	firstref	transaction_manager_$per_process_init


	transfer	abandon,bjm_abandon_transaction,bjm_abandon_transaction
	transfer	adjust_process_id,bjm_adjust_process_id,bjm_adjust_process_id
	transfer	adopt,bjm_adopt_transaction,bjm_adopt_transaction
	transfer	clear_txn_tables,bjm_rebuild_after_crash,bjm_clear_txn_tables
	transfer	close_bj,bjm_close,bjm_close
	transfer	close_bj_after_recovery,bjm_close,after_recovery
	transfer	create_bj,bjm_create,bjm_create
	transfer	delete_bj,bjm_delete,bjm_delete
	transfer	find_old_uid_pn_table,bjm_find_old_uid_pn_table,bjm_find_old_uid_pn_table
	transfer	find_txns_after_crash,bjm_find_txns_after_crash,bjm_find_txns_after_crash
	transfer	flush_all,bjm_flush_all,bjm_flush_all
	transfer	flush_transaction,bjm_flush_transaction,bjm_flush_transaction
	transfer	get_bj_oid,bjm_get_bj_oid,bjm_get_bj_oid
	transfer	get_bj_path_from_oid,bjm_get_bj_path_from_oid,bjm_get_bj_path_from_oid
	transfer	get_bj_path_from_uid,bjm_get_bj_path_from_uid,bjm_get_bj_path_from_uid
	transfer	get_default_bj,bjm_get_default_bj,bjm_get_default_bj
	transfer	get_journal_status,bjm_get_journal_status,bjm_get_journal_status
	transfer	open_all_after_crash,bjm_open_all_after_crash,bjm_open_all_after_crash
	transfer	open_bj,bjm_open,bjm_open
	transfer	open_bj_for_recovery,bjm_open,for_recovery
	transfer  open_bj_force,bjm_open,force
	transfer	per_process_init,bjm_per_process_init_,bjm_per_process_init_
	transfer	per_system_init_2,bjm_per_system_init_2_,bjm_per_system_init_2_
	transfer	rebuild_after_crash,bjm_rebuild_after_crash,bjm_rebuild_after_crash
	transfer	rollback,bjm_rollback,bjm_rollback
	transfer	set_default_bj,bjm_set_default_bj,bjm_set_default_bj
	transfer	set_transaction_storage_limit,bjm_attribute_fref_,set_transaction_storage_limit
	transfer	user_shutdown,bjm_user_shutdown,bjm_user_shutdown
	transfer	write_aborted_mark,bjm_write,aborted_mark
	transfer	write_before_image,bjm_write,before_image
	transfer	write_begin_mark,bjm_write,begin_mark
	transfer	write_committed_mark,bjm_write,committed_mark
          transfer  write_fm_postcommit_handler,bjm_write,fm_postcommit_handler
          transfer  write_fm_rollback_handler,bjm_write,fm_rollback_handler
	transfer	write_rolled_back_mark,bjm_write,rolled_back_mark
end




		    bjm_flush_all.pl1               04/04/85  1117.3re  04/04/85  0826.2       58518



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

/* DESCRIPTION:

     This procedure is supposed to be invoked by the Data Management Daemon.
Its job is to flush all before journals described by a bj_pste, up to the
last record written in the journal. Its execution is requested when, for
some unknown reason, the number of data management pages held in main
memory becomes higher that the allowed threashold. This procedure has to
be executed by the Daemon because the Daemon has access to all journals.

     The loop to all bj_pste's is written in such a way that, if there is a
problem trying to flush a journal, instead of giving up, the program
will go to the next journal.
*/

/* HISTORY:
Written by A. Bensoussan, 06/07/83.
Modified:
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
10/23/84 by M. Sharpe:  to correct format and check version of pst
	  before its first use; to use "call ERROR_RETURN (code)"
	  convention.
02/13/85 by Lee A. Newcomb:  Fixed to use new constant BJ_PSTE_VERSION_2
	  and to have cleanup handler not work if the values it resets
	  have not been set; also minor format and dcl changes.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bjm_flush_all:
   proc ();

/* DECLARATIONS */

/* Parameter */
/* Automatic */
dcl  (
     bj_oid			bit (36) aligned,
     bj_uid			bit (36) aligned,
     bjm_clean_up_needed		bit (1) aligned init (""b),
     code				fixed bin (35),
     journal_idx			fixed bin,
     last_rec_id			bit (36) aligned,
     max_n_journals			fixed bin
     )				automatic;

/* Based */
/* Builtin */
dcl  addr				builtin;

/* Condition */
dcl  cleanup			condition;

/* Constant */
dcl  (
     CHECK_FOR_BJM_RECURSION		bit (1) aligned init ("1"b),
     DONT_CHECK_FOR_BJM_RECURSION	bit (1) aligned init ("0"b),
     ME				char (13) init ("bjm_flush_all")
     )				internal static options (constant);

/* Entry */
dcl  (
     bj_cleanup_tables$handler	entry (fixed bin (35)),
     bj_close_oid			entry (bit (36) aligned),
     bj_oid_util$get_ptr		entry (bit (36) aligned) returns (ptr),
     bj_open_by_uid			entry (bit (36) aligned,
				bit (36) aligned),
     bj_storage_flush$up_to_rec_id	entry (ptr, bit (36) aligned)
     )				external;

/* External */
dcl  (
     bjm_data_$bj_pst_ptr		ptr,
     dm_error_$bj_bad_pst_version	fixed bin (35),
     dm_error_$bj_recursive_invoc	fixed bin (35),
     dm_system_data_$bj_max_n_journals	fixed bin
     )				external static;

/* Static */

/* END OF DECLARATIONS */
%page;
   code = 0;

SETUP_FOR_NON_STANDARD_EXIT:
   do;
      on cleanup call CLEANUP ();

      call SET_BJM_DATA_ERROR_HANDLING_VALUES (NONLOCAL_ERROR_EXIT, ME,
	 CHECK_FOR_BJM_RECURSION);

   end SETUP_FOR_NON_STANDARD_EXIT;

   bj_pst_ptr = bjm_data_$bj_pst_ptr;
   call CHECK_VERSION_NUMERIC (bj_pst.version, BJ_PST_VERSION_1,
        dm_error_$bj_bad_pst_version);

   max_n_journals = dm_system_data_$bj_max_n_journals;	/* don't let one error stop us */
   bjm_data_$bj_exit_err = NEXT_AFTER_ERR;

FLUSH_LOOP:
   do journal_idx = 1 to max_n_journals;

      bj_pste_ptr = addr (bj_pst.e (journal_idx));
      if bj_pste.version = BJ_PSTE_VERSION_2 then
BJ_TO_FLUSH:
         do;
         bj_oid = "0"b;
         bj_uid = bj_pste.bj_uid;

         call bj_open_by_uid (bj_uid, bj_oid);

         if bj_oid ^= "0"b then do;
	  bj_ppte_ptr = bj_oid_util$get_ptr (bj_oid);
	  last_rec_id = bj_pste.last_rec_id;
	  call bj_storage_flush$up_to_rec_id (bj_ppte_ptr, last_rec_id);
	  call bj_close_oid (bj_oid);
         end;

      end BJ_TO_FLUSH;

      goto NEXT;

NEXT_AFTER_ERR:					/* if we fail on a BJ, continue on */
      call bj_cleanup_tables$handler (0);

NEXT:
   end FLUSH_LOOP;

   call FINISH ();

MAIN_RETURN:
   return;

/* end bjm_flush_all; */
%page;
NONLOCAL_ERROR_EXIT:
   call ERROR_RETURN (bjm_data_$bj_code);
%skip (4);
FINISH:
   proc ();

   call SET_BJM_DATA_ERROR_HANDLING_VALUES (bjm_data_$bj_default_error_label,
        "", DONT_CHECK_FOR_BJM_RECURSION);

   return;

   end FINISH;
%skip (4);
ERROR_RETURN:
   proc (er_p_code);				/* we currently ignore the parameter */

dcl  er_p_code			fixed bin (35) parameter;

   call CLEANUP ();

   goto MAIN_RETURN;

   end ERROR_RETURN;
%skip (4);
CLEANUP:
   proc ();

   if bjm_clean_up_needed then
      call bj_cleanup_tables$handler (0);

   call FINISH ();

   return;

   end CLEANUP;
%page;
SET_BJM_DATA_ERROR_HANDLING_VALUES:
   proc (sbdehv_p_error_exit, sbdehv_p_operation,
        sbdehv_p_check_for_recursive_invocation);

/* This internal procedure centralizes the setting of the BJM global	*/
/* error values in bjm_data_.  It is called near the beginning of	*/
/* this module, and in the FINISH internal procedure.  ONLY THE FIRST	*/
/* OF THESE CALLS SHOULD ASK FOR DETECTION OF A RECURSIVE INVOCATION	*/
/* OF THE BEFORE JOURNAL MANAGER, if the other calls did, we could	*/
/* end up getting a recursive call ERROR_RETURN, CLEANUP, FINISH,	*/
/* this proc, etc.						*/

dcl  (
     sbdehv_p_error_exit		label variable,
     sbdehv_p_operation		char (*),
     sbdehv_p_check_for_recursive_invocation
				bit (1) aligned
     )				parameter;

   if sbdehv_p_check_for_recursive_invocation then
      if bjm_data_$bj_operation ^= "" then
         call ERROR_RETURN (dm_error_$bj_recursive_invoc);

   bjm_clean_up_needed = "1"b;
   bjm_data_$bj_exit_err = sbdehv_p_error_exit;
   bjm_data_$bj_operation = sbdehv_p_operation;
   bjm_data_$bj_code = 0;

   return;

   end SET_BJM_DATA_ERROR_HANDLING_VALUES;
%skip (4);
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_correct_version, cvn_p_error_to_use);

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_correct_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_correct_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_ppt;
%page;
%include dm_bj_global_error_info;


   end bjm_flush_all;




		    bjm_flush_transaction.pl1       04/24/85  1017.5re  04/24/85  0803.8       79812



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

/* DESCRIPTION:

     This procedure flushes all before journal records that have been
produced by the transaction specified by the caller. This transaction
is supposed to be in progress. It returns to the caller only after
all records produced by the transaction are physically on disk.

     It also updates the time stamp associated with the before journal
involved, for use by page control to honor the write ahead log protocol.
     
     In fact, for ease of implementation with (I think) no additional
overhead, the journal is flushed further than necessary. It is flushed
up to the last CI put in the page file. If it is also necessary to
flush records that happen to be in the buffer, the buffer is first
put in the page file and then the page file is flushed up to the last
CI put.
     
     The basic steps taken by this program are as follows:

     1. Find the rec_id of the last record produced by this transaction.

     2. call bj_storage_flush$up_to_rec_id.
*/

/* HISTORY:
Written by Andre Bensoussan, 08/11/82.
Modified:
08/15/82 by M. Pandolf:  to use file_manager_ to manipluate data
	  management system files.
11/17/82 by A. Bensoussan:  to call bj_storage_flush.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
10/16/84 by Maggie Sharpe:  corrected format; checked version of bj_txt
	  and bj_ppte structures before they are used; revised error
	  handling to "call ERROR_RETURN (code)" convention; cleaned up
	  dcls.
02/26/85 by Lee A. Newcomb:  Corrected dm_error_$bj_(ppte txt)_version_bad to
            be *$bj_bad_(ppte tst)_version.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
04/02/85 by Lee A. Newcomb:  Fixed to zero out bjm_data_$bj_code on entry;
            removed the unused dm_bj_static.incl.pl1; did general fixing of
            internal procedures to ease maintenance.
*/
/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bjm_flush_transaction:
   proc (p_txn_id, p_txn_ix, p_code);

/* START OF DECLARATIONS */

/* Parameter */
dcl  (
     p_txn_id			bit (36) aligned,
     p_txn_ix			fixed bin (17),
     p_code			fixed bin (35)
     )				parameter;

/* Automatic */
dcl  (
     bjm_clean_up_needed		bit (1) aligned init (^TRUE),
     last_rec_id			bit (36) aligned init (NULL_ID)
     )				automatic;

/* Builtin */
dcl  addr				builtin;

/* Condition */
dcl  cleanup			condition;

/* Constant */
dcl  (
     CHECK_FOR_BJM_RECURSION		bit (1) aligned init ("1"b),
     MYNAME			char (32)
				init ("bjm_flush_transaction"),
     NULL_ID			bit (36) aligned init (""b),
     TRUE				bit (1) aligned init ("1"b)
     )				internal static options (constant);

/* Entry */
dcl  (
     bj_cleanup_tables$handler	entry (fixed bin (35)),
     bj_storage_flush$up_to_rec_id	entry (ptr, bit (36) aligned)
     )				external;

/* External */
dcl  (
     dm_data_$bj_txt_ptr		ptr,
     (
     dm_error_$bj_bad_ppte_version,
     dm_error_$bj_bad_tid,
     dm_error_$bj_bad_txt_version,
     dm_error_$bj_recursive_invoc
     )				fixed bin (35)
     )				external static;

/* END OF DECLARATIONS */
%page;
COPY_AND_INIT_PARAMETERS:
   do;
      p_code = 0;					/* assume we will succeed */
   end COPY_AND_INIT_PARAMETERS;

SETUP_FOR_NON_STANDARD_EXIT:
   do;

      on cleanup call CLEAN_UP ();

      call SET_BJM_DATA_ERROR_HANDLING_VALUES (NONLOCAL_ERROR_EXIT, MYNAME,
	 CHECK_FOR_BJM_RECURSION);

   end SETUP_FOR_NON_STANDARD_EXIT;


GET_BJ_TXTE_PTR:
   do;
      bj_txt_ptr = dm_data_$bj_txt_ptr;
      call CHECK_VERSION_NUMERIC (bj_txt.version, BJ_TXT_VERSION_1,
	 dm_error_$bj_bad_txt_version);

      bj_txte_ptr = addr (bj_txt.entry (p_txn_ix));

      if bj_txte.tid ^= p_txn_id then
         call ERROR_RETURN (dm_error_$bj_bad_tid);
   end GET_BJ_TXTE_PTR;

/*
   The txte should have the process id for which the bj_ppte_ptr and bj_oid
   are valid. If the process that owns the txn is still alive, the set
   pid, ppte_ptr, bj_oid are the original values put it the txte. If the
   process dies, the daemon will execute procedures that use the txte.
   It would be convenient if these procedures used the same protocol when
   taking info from the txte: If the pid is equal to the pid of the process
   executing the procedure, then it is safe to use the ppte_ptr and the bj_oid.
   Otherwise, the BJ has to be opened by its uid and the txte updated
   as follows:
	     - zero the pid
	     - set the new ppte_ptr
	     - set the new bj_oid
	     - set the pid.
*/

GET_BJ_PPTE_PTR:
   do;
      bj_ppte_ptr = bj_txte.ppte_ptr;			/* WHAT SHOULD BE DONE FOR DAEMON ? */
      call CHECK_VERSION_NUMERIC (bj_ppte.version, BJ_PPTE_VERSION_1,
	 dm_error_$bj_bad_ppte_version);
   end GET_BJ_PPTE_PTR;
%page;
DO_THE_FLUSH:
   do;

/* Get the rec_id of the last record produced by this transaction	*/
/* from the bj_txte Then call the bj_storage_flush procedure to flush	*/
/* the journal up to the last record produced by the transaction	*/

      last_rec_id = bj_txte.last_bj_rec_id;

      if last_rec_id ^= "0"b then
         call bj_storage_flush$up_to_rec_id (bj_ppte_ptr, last_rec_id);
   end DO_THE_FLUSH;

   call RETURN ();

/* end bjm_flush_transaction */
%page;
MAIN_RETURN:
   return;
%skip (4);
NONLOCAL_ERROR_EXIT:
   call ERROR_RETURN (bjm_data_$bj_code);
%skip (4);
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_correct_version, cvn_p_error_to_use);

/* The error code to use is passed as this is really a template proc	*/
/* used in several modules to check structure versions.  It is hoped	*/
/* newer versions of these structures will be changed to use	*/
/* char (8) versions.					*/

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_correct_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_correct_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%skip (4);
CLEAN_UP:
   proc ();

   if bjm_clean_up_needed then
      call bj_cleanup_tables$handler (0);

   call FINISH ();

   return;

   end CLEAN_UP;
%skip (4);
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call CLEAN_UP ();
   p_code = er_p_code;
   goto MAIN_RETURN;

   end ERROR_RETURN;
%skip (4);
FINISH:
   proc ();

   call SET_BJM_DATA_ERROR_HANDLING_VALUES (bjm_data_$bj_default_error_label,
        "", ^CHECK_FOR_BJM_RECURSION);

   return;

   end FINISH;
%skip (4);
RETURN:
   proc ();

   call FINISH ();
   go to MAIN_RETURN;

   end RETURN;
%page;
SET_BJM_DATA_ERROR_HANDLING_VALUES:
   proc (sbdehv_p_error_exit, sbdehv_p_operation,
        sbdehv_p_check_for_recursive_invocation);

/* This internal procedure centralizes the setting of the BJM global	*/
/* error values in bjm_data_.  It is called near the beginning of	*/
/* this module, and in the FINISH internal procedure.  ONLY THE FIRST	*/
/* OF THESE CALLS SHOULD ASK FOR DETECTION OF A RECURSIVE INVOCATION	*/
/* OF THE BEFORE JOURNAL MANAGER, if the other calls did, we could	*/
/* end up getting a recursive call ERROR_RETURN, CLEANUP, FINISH,	*/
/* this proc, etc.						*/
/*							*/
/* Note: if sbdehv_p_check_for_recursive_invocation and		*/
/* bjm_clean_up_needed are both false, we do not set any values.	*/
/* This may happen if we call ERROR_RETURN before calling this	*/
/* proc, if the partial argument validation fails.		*/

dcl  (
     sbdehv_p_error_exit		label variable,
     sbdehv_p_operation		char (*),
     sbdehv_p_check_for_recursive_invocation
				bit (1) aligned
     )				parameter;

   if sbdehv_p_check_for_recursive_invocation = CHECK_FOR_BJM_RECURSION then
      if bjm_data_$bj_operation ^= "" then
         call ERROR_RETURN (dm_error_$bj_recursive_invoc);

/* only set bjm_data_ values if we set them */
   if bjm_clean_up_needed ^= TRUE
        & sbdehv_p_check_for_recursive_invocation ^= CHECK_FOR_BJM_RECURSION
        then
      ;
   else
SET_BJM_DATA_ERROR_VALUES:
      do;
      bjm_clean_up_needed = TRUE;
      bjm_data_$bj_operation = sbdehv_p_operation;
      bjm_data_$bj_exit_err = sbdehv_p_error_exit;
      bjm_data_$bj_code = 0;
   end SET_BJM_DATA_ERROR_VALUES;

   return;

   end SET_BJM_DATA_ERROR_HANDLING_VALUES;
%page;
%include dm_bj_ppt;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_txt;
%page;
%include dm_bj_ci;
%page;
%include dm_ci_header;
%page;
%include dm_bj_global_error_info;

   end bjm_flush_transaction;




		    bjm_get_bj_oid.pl1              04/04/85  1117.3re  04/04/85  0826.3       56259



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

/* DESCRIPTION:
     An entry to return the opening ID of a before journal.  If the journal
is not found in the PPT, then a code is returned to reflect this observation.

     BJ_DIR  and BJ_ENTRY are input parameters.  BJ_OID and CODE are
output parameters.
*/

/* HISTORY:
Written by Mike Pandolf, 08/19/82.
Modified:
10/15/82 by M. Pandolf:  to use file_manger_ for manipulating
	  data management files.
11/03/82 by M. Pandolf:  to handle codes returned by file_manager_$open
	  according to new spec.
11/11/82 by M. Pandolf:  to conform to standard entry and exit protocol.
11/02/83 by M. Pandolf:  to only allow entrynames ending in ".bj".
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
11/15/84 by Maggie Sharpe:  to correct format and dcls; to use ERROR_RETURN
            technology; to set and rest validation level before and after
            calls to file_manager_.
11/20/84 by Maggie Sharpe:  to reset validation level in cleanup handler.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
*/
%page;
/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

bjm_get_bj_oid:
     procedure (p_bj_dir, p_bj_entry, p_bj_oid, p_code);

/* DECLARATIONS */

/* Parameter */

dcl  p_bj_dir		        char (*) parameter;	/* dir of potential before journal */
dcl  p_bj_entry		        char (*) parameter;	/* entryname of potential before journal */
dcl  p_bj_oid		        bit (36) aligned parameter; /* OID of before journal */
dcl  p_code		        fixed bin (35);	/* standard system status code */

/* Automatic */

dcl  bj_dir		        char (168);		/* local copy of bj dir */
dcl  bj_entry		        char (32);		/* local copy of bj entryname */
dcl  saved_level		        fixed bin;		/* saves caller's validation level */
dcl  current_ring		        fixed bin (3);
dcl  this_ppte		        fixed bin;		/* index into PPT entries */
dcl  pf_oid		        bit (36) aligned;	/* page file opening ID */
dcl  bj_uid		        bit (36) aligned;	/* before journal unique ID, used for comparisons */

/* Static, External */

dcl  dm_error_$bj_recursive_invoc     fixed bin (35) external static;
dcl  dm_error_$bj_journal_not_opened  fixed bin (35) external static;
dcl  dm_error_$bj_invalid_name        fixed bin (35) external static;
dcl  bjm_data_$bj_ppt_ptr	        pointer external static;

/* Constant */

dcl  ME			        char (16) internal static options (constant)
			        init ("bjm_get_bj_oid");

/* Entry */

dcl  bj_ci_zero$get_bj_uid	        entry (bit (36) aligned) returns (bit (36));
dcl  bj_oid_util$get_oid	        entry (ptr) returns (bit (36) aligned);
dcl  bj_cleanup_tables$handler        entry (fixed bin (35));
dcl  cu_$level_get		        entry (fixed bin);
dcl  cu_$level_set		        entry (fixed bin);
dcl  file_manager_$open	        entry (char (*), char (*), bit (36) aligned, fixed bin (35));
dcl  file_manager_$close	        entry (bit (36) aligned, fixed bin (35));
dcl  get_ring_		        entry () returns (fixed bin (3));

/* Builtin */

dcl  addr			        builtin;

/* Condition */

dcl  cleanup		        condition;

%page;
/* initialize parameters */

	bj_dir = p_bj_dir;				/* truncation to char (168) */
	bj_entry = p_bj_entry;			/* truncation to char (32) */
	p_bj_oid = (36)"0"b;
	p_code = 0;

/* validate entry name */

	if ^is_valid_bj_name (bj_entry)
	then do;
	     p_code = dm_error_$bj_invalid_name;
	     goto MAIN_RETURN;
	end;


/* set up addresses for unexpected error */

	call cu_$level_get (saved_level);
	current_ring = get_ring_ ();

	on cleanup call CLEANUP;

	if bjm_data_$bj_operation = ""
	then bjm_data_$bj_operation = ME;
	else do;
	     p_code = dm_error_$bj_recursive_invoc;
	     goto MAIN_RETURN;
	end;

	bjm_data_$bj_exit_err = nonlocal_exit_err;
	bjm_data_$bj_code = 0;

/* get pointer to PPT */

	bj_ppt_ptr = bjm_data_$bj_ppt_ptr;

/* get the page file unique ID to use for comparisons later */

	call cu_$level_set ((current_ring));
	call file_manager_$open (bj_dir, bj_entry, pf_oid, p_code);
	if pf_oid = (36)"0"b
	then goto ERROR_RETURN;
	call cu_$level_set (saved_level);


	bj_uid = bj_ci_zero$get_bj_uid (pf_oid);

	call cu_$level_set ((current_ring));
	call file_manager_$close (pf_oid, p_code);
	if p_code ^= 0
	then goto ERROR_RETURN;
	call cu_$level_set (saved_level);

/* walk down the PPT looking for the UID we just found */

walk_ppt:
	do this_ppte = 1 to dm_system_data_$bj_max_n_journals;

	     bj_ppte_ptr = addr (bj_ppt.e (this_ppte));
	     if bj_ppte.version = BJ_PPTE_VERSION_1
	     then do;				/* an open journal */
		if bj_ppte.bj_uid = bj_uid
		then do;
		     p_bj_oid = bj_oid_util$get_oid (bj_ppte_ptr);
		     goto JOURNAL_OPENED;
		end;
	     end;

	end walk_ppt;

/* did not find the before journal in our list, so the call is not successful */

	p_code = dm_error_$bj_journal_not_opened;
	goto ERROR_RETURN;

JOURNAL_OPENED:
	bjm_data_$bj_operation = "";

	bjm_data_$bj_exit_err =
	     bjm_data_$bj_default_error_label;

MAIN_RETURN:
	return;

nonlocal_exit_err:
	p_code = bjm_data_$bj_code;

ERROR_RETURN:
	call CLEANUP;
	goto MAIN_RETURN;

%page;

/* INTERNAL PROCEDURES */

is_valid_bj_name:
     proc (bj_name)
	reducible
	returns (bit (1) aligned);

dcl  bj_name		        char (*) parameter;
dcl  (length, substr, reverse, rtrim) builtin;

	return (
	     (length (rtrim (bj_name)) < 33) &
	     (substr (reverse (rtrim (bj_name)), 1, 3) = "jb."));

     end is_valid_bj_name;

%page;

CLEANUP:
     procedure ();

dcl  cleanup_code		        fixed bin (35);

	call bj_cleanup_tables$handler (cleanup_code);

	bjm_data_$bj_operation = "";
	bjm_data_$bj_exit_err = bjm_data_$bj_default_error_label;
	call cu_$level_set (saved_level);

	return;

     end CLEANUP;


/* Include Files */

%page;	%include dm_bj_static;
%page;	%include dm_bj_ppt;
%page;	%include dm_bj_global_error_info;



     end bjm_get_bj_oid;




		    bjm_get_bj_path_from_oid.pl1    04/04/85  1117.3re  04/04/85  0826.3       59589



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

/* DESCRIPTION:
     A procedure to return the dir and entry names of an open before
journal given its opening ID.  We do not lock the PST; as the journal is
open, the pathname info will not be modified.

     BJ_OID is an input argument.  BJ_DIR, BJ_ENTRY, and CODE are
output arguments.
*/

/* HISTORY:
Written by Mike Pandolf, 08/19/82.
Modified:
11/11/82 by M. Pandolf:  to use standard entry and exit protocol.
11/15/82 by M. Pandolf:  to be called as bjm_get_bj_path_from_oid.
11/18/82 by M. Pandolf:  to not lock PST: as long as we have the
	  journal open, pathname info will not be modified.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
02/19/85 by Lee A. Newcomb:  Fixed to check the versions of the various
            structures used and to properly cleanup; standardized format.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
*/
/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bjm_get_bj_path_from_oid:
   procedure (p_bj_oid, p_bj_dir, p_bj_entry, p_code);

/* DECLARATIONS */

/* Parameter */
dcl  (
     p_bj_oid			bit (36) aligned,	/* BJ opening ID */
     p_bj_dir			char (*),		/* dir of BJ identified bj BJ_OID */
     p_bj_entry			char (*),		/* entryname of BJ identified bj BJ_OID */
     p_code			fixed bin (35)	/* standard system status code */
     )				parameter;

/* Automatic */
dcl  (
     bj_oid			bit (36) aligned init (""b),
     bjm_clean_up_needed		bit (1) aligned init (""b)
     )				automatic;

/* Based */
/* Builtin */
dcl  ptr				builtin;

/* Condition */
dcl  cleanup			condition;

/* Constant */
dcl  (
     CHECK_FOR_BJM_RECURSION		bit (1) aligned init ("1"b),
     DONT_CHECK_FOR_BJM_RECURSION	bit (1) aligned init (""b),
     ME				char (32)
				init ("bjm_get_bj_path_from_oid")
     )				internal static options (constant);

/* Entry */
dcl  (
     bj_cleanup_tables$handler	entry (fixed bin (35)),
     bj_oid_util$get_ptr		entry (bit (36) aligned) returns (ptr),
     bj_pst_search			entry (bit (36) aligned) returns (ptr)
     )				external;

/* External */
dcl  (
     bjm_data_$bj_pst_ptr		ptr,
     (
     dm_error_$bj_bad_ppte_version,
     dm_error_$bj_bad_pst_version,
     dm_error_$bj_bad_pste_version,
     dm_error_$bj_recursive_invoc
     )				fixed bin (35)
     )				external static;

/* Static */

/* END OF DECLARATIONS */
%page;
COPY_AND_INIT_PARAMETERS:
   do;
      bj_oid = p_bj_oid;
      p_bj_dir = "";
      p_bj_entry = "";
      p_code = 0;
   end COPY_AND_INIT_PARAMETERS;

SETUP_FOR_NON_STANDARD_EXIT:
   do;
      on cleanup call CLEAN_UP ();
      call SET_BJM_DATA_ERROR_HANDLING_VALUES (NONLOCAL_ERROR_EXIT, ME,
	 CHECK_FOR_BJM_RECURSION);

   end SETUP_FOR_NON_STANDARD_EXIT;

GET_BJ_TABLE_PTRS:
   do;
      bj_ppte_ptr = bj_oid_util$get_ptr (bj_oid);
      call CHECK_VERSION_NUMERIC (bj_ppte.version, BJ_PPTE_VERSION_1,
	 dm_error_$bj_bad_ppte_version);

      bj_pste_ptr = bj_pst_search ((bj_ppte.bj_uid));	/* get a pointer to the PSTE for this PPTE */
      call CHECK_VERSION_NUMERIC (bj_pste.version, BJ_PSTE_VERSION_2,
	 dm_error_$bj_bad_pste_version);
   end GET_BJ_TABLE_PTRS;

/* use the bj_ix to look up the BJ pathname in the pathname table */
   call CHECK_VERSION_NUMERIC (bjm_data_$bj_pst_ptr -> bj_pst.version,
        BJ_PST_VERSION_1, dm_error_$bj_bad_pst_version);
   bj_pn_table_ptr =
        ptr (bjm_data_$bj_pst_ptr,
        bjm_data_$bj_pst_ptr -> bj_pst.pn_table_offset);

SET_OUTPUT_PARAMETERS:
   do;
      p_bj_dir = bj_pn_table (bj_pste.bj_ix).dir;
      p_bj_entry = bj_pn_table (bj_pste.bj_ix).entry;
   end SET_OUTPUT_PARAMETERS;

   call FINISH ();

MAIN_RETURN:
   return;
%page;
NONLOCAL_ERROR_EXIT:
   call ERROR_RETURN (bjm_data_$bj_code);
%skip (4);
FINISH:
   proc ();

   call SET_BJM_DATA_ERROR_HANDLING_VALUES (bjm_data_$bj_default_error_label,
        "", DONT_CHECK_FOR_BJM_RECURSION);

   return;

   end FINISH;
%skip (4);
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call CLEAN_UP ();
   p_code = er_p_code;
   goto MAIN_RETURN;

   end ERROR_RETURN;
%skip (4);
CLEAN_UP:
   proc ();

   if bjm_clean_up_needed then
      call bj_cleanup_tables$handler (0);

   call FINISH ();

   return;

   end CLEAN_UP;
%page;
SET_BJM_DATA_ERROR_HANDLING_VALUES:
   proc (sbdehv_p_error_exit, sbdehv_p_operation,
        sbdehv_p_check_for_recursive_invocation);

/* This internal procedure centralizes the setting of the BJM global	*/
/* error values in bjm_data_.  It is called near the beginning of	*/
/* this module, and in the FINISH internal procedure.  ONLY THE FIRST	*/
/* OF THESE CALLS SHOULD ASK FOR DETECTION OF A RECURSIVE INVOCATION	*/
/* OF THE BEFORE JOURNAL MANAGER, if the other calls did, we could	*/
/* end up getting a recursive call ERROR_RETURN, CLEAN_UP, FINISH,	*/
/* this proc, etc.						*/

dcl  (
     sbdehv_p_error_exit		label variable,
     sbdehv_p_operation		char (*),
     sbdehv_p_check_for_recursive_invocation
				bit (1) aligned
     )				parameter;

   if sbdehv_p_check_for_recursive_invocation then
      if bjm_data_$bj_operation ^= "" then
         call ERROR_RETURN (dm_error_$bj_recursive_invoc);

   bjm_clean_up_needed = "1"b;
   bjm_data_$bj_exit_err = sbdehv_p_error_exit;
   bjm_data_$bj_operation = sbdehv_p_operation;
   bjm_data_$bj_code = 0;

   return;

   end SET_BJM_DATA_ERROR_HANDLING_VALUES;
%skip (4);
CHECK_VERSION_NUMERIC:
   proc (cvn_p_given_version, cvn_p_correct_version, cvn_p_error_to_use);

/* The error code to use is passed as this is really a template proc	*/
/* used in several modules to check structure versions.  It is hoped	*/
/* newer versions of these structures will be changed to use	*/
/* char (8) versions.					*/

dcl  (
     cvn_p_given_version		fixed bin,
     cvn_p_correct_version		fixed bin,
     cvn_p_error_to_use		fixed bin (35)
     )				parameter;

   if cvn_p_given_version ^= cvn_p_correct_version then
      call ERROR_RETURN (cvn_p_error_to_use);

   end CHECK_VERSION_NUMERIC;
%page;
%include dm_bj_ppt;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_pn_table;
%page;
%include dm_bj_global_error_info;


   end bjm_get_bj_path_from_oid;




		    bjm_get_bj_path_from_uid.pl1    04/04/85  1117.3re  04/04/85  0826.3       34317



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

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

bjm_get_bj_path_from_uid:
     procedure (p_bj_uid, p_bj_dir, p_bj_entry, p_code);


/* DESCRIPTION:
     A procedure to return the dir and entry names of an open before
journal given its opening ID.

     BJ_UID is an input argument.  BJ_DIR, BJ_ENTRY, and CODE are
output arguments.
*/

/* HISTORY:
Written by M. Pandolf, 01/05/83.
Modified:
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
*/
%page;
/* initialize parameters */

	bj_uid = p_bj_uid;
	p_bj_dir = "";
	p_bj_entry = "";
	p_code = 0;

/* set up addresses for unexpected error */

	on cleanup call CLEANUP;

	if bjm_data_$bj_operation = ""
	then bjm_data_$bj_operation = ME;
	else do;
	     p_code = dm_error_$bj_recursive_invoc;
	     goto quick_exit;
	end;

	bjm_data_$bj_exit_err = nonlocal_error_exit;
	bjm_data_$bj_code = 0;

/* lock the PST so that the references to it will be done while it is stable */

	call bj_pst_lock ();

/* get a pointer to the PSTE */

	bj_pste_ptr = bj_pst_search (bj_uid);
	if bj_pste_ptr = null ()
	then do;
	     call bj_pst_lock$unlock ();
	     p_code = error_table_$noentry;
	     goto local_error_exit;
	end;

/* use the bj_ix to look up the BJ pathname in the pathname table */

	bj_pn_table_ptr = ptr (bjm_data_$bj_pst_ptr, bjm_data_$bj_pst_ptr -> bj_pst.pn_table_offset);

	p_bj_dir = bj_pn_table (bj_pste.bj_ix).dir;
	p_bj_entry = bj_pn_table (bj_pste.bj_ix).entry;

/* done */

	call bj_pst_lock$unlock ();

std_exit:
	bjm_data_$bj_operation = "";

	bjm_data_$bj_exit_err =
	     bjm_data_$bj_default_error_label;

quick_exit:
	return;

nonlocal_error_exit:
	p_code = bjm_data_$bj_code;

local_error_exit:
	call CLEANUP;
	goto quick_exit;

/* INTERNAL PROCEDURES */

CLEANUP:
     procedure ();

dcl  code			        fixed bin (35);

	call bj_cleanup_tables$handler (code);

	bjm_data_$bj_exit_err =
	     bjm_data_$bj_default_error_label;
	bjm_data_$bj_operation = "";

	return;

     end CLEANUP;


/* DECLARATIONS */

/* Parameters */

dcl  p_bj_uid		        bit (36) aligned parameter; /* BJ unique ID */
dcl  p_bj_dir		        char (*) parameter;	/* dir of BJ identified bj BJ_OID */
dcl  p_bj_entry		        char (*) parameter;	/* entryname of BJ identified bj BJ_OID */
dcl  p_code		        fixed bin (35) parameter; /* standard system ststus code */

/* Automatic */

dcl  bj_uid		        bit (36) aligned;	/* local copy of before journal UID */

/* Static, External */

dcl  dm_error_$bj_recursive_invoc     fixed bin (35) external static;
dcl  error_table_$noentry	        fixed bin (35) ext static;
dcl  bjm_data_$bj_pst_ptr	        pointer external static;

/* Constant */

dcl  ME			        char (32) internal static options (constant)
			        init ("bjm_get_bj_path_from_uid");

/* Entry */

dcl  bj_pst_lock		        entry ();
dcl  bj_pst_search		        entry (bit (36) aligned) returns (ptr);
dcl  bj_pst_lock$unlock	        entry ();
dcl  bj_cleanup_tables$handler        entry (fixed bin (35));

/* Builtin */

dcl  ptr			        builtin;

/* Condition */

dcl  cleanup		        condition;

/* Include Files */

%page;
%include dm_bj_static;
%page;
%include dm_bj_ppt;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_pn_table;
%page;
%include dm_bj_global_error_info;
%page;

     end bjm_get_bj_path_from_uid;




		    bjm_get_default_bj.pl1          03/06/85  0801.3re  03/05/85  0758.2       26820



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

/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

bjm_get_default_bj:
     proc (p_bj_oid, p_code);

/*  DESCRIPTION:
     Procedure to return the opening ID of the current default BJ using the
   protocol for write_begin_mark:  user_set_oid if user has called
   bjm_set_default_bj and has not closed it since setting it, or the last
   opened BJ if no explicit setting.  If both these fail, the system default
   BJ will be opened.  p_bj_oid and p_code are output parameters.
*/

/*  HISTORY:
Written by Mike Pandolf, 08/19/82.
Modified:
10/04/82 by Lee A. Newcomb to change from one default BJ setting to
	  the two cell definition of bjm_write_begin_mark.
03/24/83 by L. A. Newcomb to use default bj dir and name defined
	  in dm_system_data_ by dm_load_configuration_.
03/28/83 by M. Pandolf:  to use changed dm_system_data_ names for default bj.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
*/
%page;
/* initialize parameters */

	p_code = 0;
	bj_ppt_ptr = bjm_data_$bj_ppt_ptr;		/* get it once */

/* if the current default journal is nominally null, then we must open a  before journal */

	if bj_ppt.default_bj.user_set_oid ^= ""b then	/* user has explicitly set the default */
	     bj_oid = bj_ppt.default_bj.user_set_oid;
	else if bj_ppt.default_bj.last_opened_oid ^= ""b then /* OK, then use the last opened one */
	     bj_oid = bj_ppt.default_bj.last_opened_oid;

	else do;					/* must use system default BJ */
	     call before_journal_manager_$open_bj (dm_system_data_$bj_default_dirname,
		dm_system_data_$bj_default_filename, bj_oid, p_code);
	     if p_code ^= 0 then
		go to exit;
	end;

/* now get the calculated default before journal opening ID */

	p_bj_oid = bj_oid;

exit:						/* get back */
	return;
%page;
/* DECLARATIONS */

dcl  (						/* Parameters */
     p_bj_oid		        bit (36) aligned,	/* before journal opening ID */
     p_code		        fixed bin (35)	/* status code */
     )			        parameter;

dcl						/* Automatic */
     bj_oid		        bit (36) aligned	/* for call to open_bj */
			        automatic;

dcl  (						/* Static, External */
     bjm_data_$bj_ppt_ptr	        ptr,
     dm_system_data_$bj_default_dirname char (168),
     dm_system_data_$bj_default_filename char (32)
     )			        external static;

dcl						/* Entries */
     dm_per_system_$find_bootload_dir entry (char (*), fixed bin (35)),
     before_journal_manager_$open_bj  entry (char (*), char (*), bit (36) aligned, fixed bin (35));

/* INCLUDE FILES start next page */
%include dm_bj_ppt;


     end bjm_get_default_bj;




		    bjm_get_journal_status.pl1      04/09/85  1448.4r w 04/08/85  1128.0      149454



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

/* DESCRIPTION:

     A subroutine interface to before (image) journal manager to return
information about a selected journal.  This subroutine will return either
information about a single journal (if p_dir and p_entry are non-null
strings), from the journals in the PPT (if p_dir is null and
p_entry = "process"), or will return information from the PST (if p_dir
is null and p_entry = "system").  When specifying that information from
a single journal be obtained, the journal can be currently unused, in
which case its info will come from its header. when a journal is in use,
its information will come from the per system table entry, which is really
the "most recent" copy of the header.  Instead of placing the info in a
caller provided location, we expect to find an area in which we can
allocate the information structure ourselves.
*/

/* HISTORY:
Written by M. Pandolf, 04/13/83.
Modified:
04/13/83 by M. Pandolf:  to bypass compiler bug when copying pste.
04/15/83 by M. Pandolf:  to add metering parameter.
07/01/83 by M. Pandolf:  to specify process or system openings.
10/01/83 by M. Pandolf:  to validate p_area_ptr before use.
11/01/83 by M. Pandolf:  to only allow entrynames ending in ".bj".
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
01/06/84 by M. Pandolf: modified jan 1984 by M. Pandolf to not check
            p_entry if p_dir is null.
06/11/84 by Lee Baldwin:  Renamed dm_error_$bj_header_bad to $bj_bad_header.
11/30/84 by Maggie Sharpe:  to use ERROR_RETURN technology; to set/reset
            validation level around calls to file_manager_.
02/13/85 by Lee A. Newcomb:  Fixed to return error_table_$null_info_ptr
            instead of $argerr if area_ptr is null; fixed RETURN_WHOLE_PST to
            check for "e" access to dm_admin_gate_; fixed up declarations and
            format, and use FINISH, etc.  procs.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
bjm_get_journal_status:
   procedure (p_dir, p_entry, p_area_ptr, p_bj_status_ptr,
        p_bj_global_meters_ptr, p_code);


/* DECLARATIONS */

/* Parameter */
dcl  (
     p_dir			char (*),
     p_entry			char (*),
     p_area_ptr			pointer,
     p_bj_status_ptr		pointer,
     p_bj_global_meters_ptr		pointer,
     p_code			fixed bin (35)
     )				parameter;

/* Automatic */
dcl  (
     area_ptr			pointer,
     bj_dir			char (168),
     bj_entry			char (32),
     bj_ix			fixed bin,
     bj_pst_dir			char (168) init (""),
     bj_pst_entry			char (32) init (""),
     bj_uid			bit (36) aligned init (NULL_ID),
     bjm_clean_up_needed		bit (1) aligned init (""b),
     clean_up_started_freeing		bit (1) aligned init (""b),
						/* for CLEAN_UP */
     code				fixed bin (35) init (0),
     current_ring			fixed bin (3) init (-1),
     dm_admin_gate_access_bin		fixed bin (5) init (N_ACCESS_BIN),
     dm_admin_gate_dir		char (168) init (""),
     dm_admin_gate_dir_length		fixed bin init (0),
     dm_admin_gate_ptr		ptr init (null),
     fm_oid			bit (36) aligned init (NULL_ID),
     fm_uid			bit (36) aligned init (NULL_ID),
     journal_info_ix		fixed bin,
     ppt_ix			fixed bin,
     pst_ix			fixed bin,
     saved_level			fixed bin init (-1),
     1 my_bj_pste			aligned like bj_pste
     )				automatic;

/* Based */
dcl  caller_supplied_area		area based (area_ptr);

/* Builtin */
dcl  (addr, bit, codeptr, length, null, ptr, reverse, rtrim, size, substr,
     unspec)			builtin;

/* Condition */
dcl  cleanup			condition;

/* Constant */
dcl  (
     MY_NAME			char (32)
				init ("bjm_get_journal_status"),
     CHECK_FOR_BJM_RECURSION		bit (1) aligned init ("1"b),
     DM_ADMIN_GATE_NAME		char (32) init ("dm_admin_gate_"),
     DONT_CHECK_FOR_BJM_RECURSION	bit (1) aligned init ("0"b),
     NULL_ID			bit (36) aligned init ((36)"0"b)
     )				internal static options (constant);

/* Entry */
dcl  (
     bj_ci_zero$get_bj_uid		entry (bit (36) aligned)
				returns (bit (36)),
     bj_ci_zero$get_header		entry (bit (36) aligned, ptr,
				fixed bin),
     bj_ci_zero$get_pf_uid		entry (bit (36) aligned)
				returns (bit (36)),
     bj_cleanup_tables$handler	entry (fixed bin (35)),
     bj_pst_lock			entry (),
     bj_pst_lock$unlock		entry (),
     bj_pst_search			entry (bit (36) aligned) returns (ptr),
     cu_$level_set			entry (fixed bin),
     cu_$level_get			entry (fixed bin),
     file_manager_$close		entry (bit (36) aligned,
				fixed bin (35)),
     file_manager_$open		entry (char (*), char (*),
				bit (36) aligned, fixed bin (35)),
     get_ring_			entry () returns (fixed bin (3)),
     get_group_id_			entry () returns (char (32)),
     hcs_$fs_get_path_name		entry (ptr, char (*), fixed bin,
				char (*), fixed bin (35)),
     hcs_$get_user_effmode		entry (char (*), char (*), char (*),
				fixed bin, fixed bin (5),
				fixed bin (35)),
     hcs_$make_ptr			entry (ptr, char (*), char (*), ptr,
				fixed bin (35))
     )				external;

/* External */
dcl  (
     (
     bjm_data_$bj_ppt_ptr,
     bjm_data_$bj_pst_ptr
     )				pointer,
     (
     dm_error_$bj_recursive_invoc,
     dm_error_$bj_bad_header,
     dm_error_$bj_invalid_name,
     error_table_$badpath,
     error_table_$not_privileged,
     error_table_$null_info_ptr
     )				fixed bin (35)
     )				external static;

/* Static */

/* END OF DECLARATIONS */
%page;
COPY_AND_INIT_PARAMETERS:
   do;
      bj_dir = p_dir;
      bj_entry = p_entry;
      area_ptr = p_area_ptr;
      p_bj_status_ptr = null ();
      p_bj_global_meters_ptr = null ();
      p_code = 0;
   end COPY_AND_INIT_PARAMETERS;


PARTIALLY_VALIDATE_INPUT_PARAMETERS:
   do;
      if p_area_ptr = null () then			/* must have a place to put info */
         call ERROR_RETURN (error_table_$null_info_ptr);

      if p_dir ^= "" then
         if ^IS_VALID_BJ_NAME (bj_entry) then
	  call ERROR_RETURN (dm_error_$bj_invalid_name);
   end PARTIALLY_VALIDATE_INPUT_PARAMETERS;


SETUP_FOR_NON_STANDARD_EXIT:
   do;
      call cu_$level_get (saved_level);
      current_ring = get_ring_ ();

      call SET_BJM_DATA_ERROR_HANDLING_VALUES (NONLOCAL_ERROR_EXIT, MY_NAME,
	 CHECK_FOR_BJM_RECURSION);

      bj_status_ptr = null ();
      bj_global_meters_ptr = null ();
      on cleanup call CLEAN_UP ();

   end SETUP_FOR_NON_STANDARD_EXIT;


GET_STATUS:
   do;
      if bj_dir = "" then
         if (bj_entry = "system") | (bj_entry = "") then
	  call RETURN_WHOLE_PST ();
         else if bj_entry = "process" then
	  call RETURN_MINE_FROM_PST ();
         else call ERROR_RETURN (error_table_$badpath);

      else if bj_entry = "" then
         call ERROR_RETURN (error_table_$badpath);

      else call RETURN_ONE_PSTE ();

      p_bj_status_ptr = bj_status_ptr;
   end GET_STATUS;


GET_METERS:
   do;
      allocate bj_global_meters set (bj_global_meters_ptr)
	 in (caller_supplied_area);

      bj_global_meters.meters = bjm_data_$bj_pst_ptr -> bj_pst.meters;
      bj_global_meters.time_of_bootload =
	 bjm_data_$bj_pst_ptr -> bj_pst.time_of_bootload;
      p_bj_global_meters_ptr = bj_global_meters_ptr;
   end GET_METERS;


   call FINISH ();

MAIN_RETURN:
   return;

/* end bjm_get_journal_status; */
%page;
NONLOCAL_ERROR_EXIT:
   call ERROR_RETURN (bjm_data_$bj_code);
%skip (4);
FINISH:
   proc ();

   call SET_BJM_DATA_ERROR_HANDLING_VALUES (bjm_data_$bj_default_error_label,
        "", DONT_CHECK_FOR_BJM_RECURSION);
   call cu_$level_set (saved_level);

   return;

   end FINISH;
%skip (4);
ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call CLEAN_UP ();
   p_code = er_p_code;
   goto MAIN_RETURN;

   end ERROR_RETURN;
%page;
CLEAN_UP:
   proc ();

/* Try to free any allocated for the status or metering	*/
/* structures.  We guarantee we can never free more than	*/
/* once as errors should be few.  Also make sure any files	*/
/* openings we did are closed and cleanup the BJ tables.	*/

   if fm_oid ^= ""b then				/* we opened */
      call file_manager_$close (fm_oid, 0);

   if ^clean_up_started_freeing then			/* in case called >1 times */
CLEAN_UP_FREE_STRUCTURES:
      do;
      clean_up_started_freeing = "1"b;
      if bj_status_ptr ^= null () then
         free bj_status_ptr -> bj_status in (caller_supplied_area);
      if bj_global_meters_ptr ^= null () then
         free bj_global_meters_ptr
	    -> bj_global_meters in (caller_supplied_area);
   end CLEAN_UP_FREE_STRUCTURES;

   if bjm_clean_up_needed then
      call bj_cleanup_tables$handler (0);

   call FINISH ();

   return;

   end CLEAN_UP;
%page;
SET_BJM_DATA_ERROR_HANDLING_VALUES:
   proc (sbdehv_p_error_exit, sbdehv_p_operation,
        sbdehv_p_check_for_recursive_invocation);

/* This internal procedure centralizes the setting of the BJM global	*/
/* error values in bjm_data_.  It is called near the beginning of	*/
/* this module, and in the FINISH internal procedure.  ONLY THE FIRST	*/
/* OF THESE CALLS SHOULD ASK FOR DETECTION OF A RECURSIVE INVOCATION	*/
/* OF THE BEFORE JOURNAL MANAGER, if the other calls did, we could	*/
/* end up getting a recursive call ERROR_RETURN, CLEAN_UP, FINISH,	*/
/* this proc, etc.						*/

dcl  (
     sbdehv_p_error_exit		label variable,
     sbdehv_p_operation		char (*),
     sbdehv_p_check_for_recursive_invocation
				bit (1) aligned
     )				parameter;

   if sbdehv_p_check_for_recursive_invocation then
      if bjm_data_$bj_operation ^= "" then
         call ERROR_RETURN (dm_error_$bj_recursive_invoc);

   bjm_clean_up_needed = "1"b;
   bjm_data_$bj_exit_err = sbdehv_p_error_exit;
   bjm_data_$bj_operation = sbdehv_p_operation;
   bjm_data_$bj_code = 0;

   return;

   end SET_BJM_DATA_ERROR_HANDLING_VALUES;
%skip (4);
IS_VALID_BJ_NAME:
   proc (ivbn_p_bj_name) reducible returns (bit (1) aligned);

dcl  ivbn_p_bj_name			char (*) parameter;

   return ((length (rtrim (ivbn_p_bj_name)) < 33)
        & (substr (reverse (rtrim (ivbn_p_bj_name)), 1, 3) = "jb."));

   end IS_VALID_BJ_NAME;
%page;
RETURN_ONE_PSTE:
   procedure ();

   call cu_$level_set ((current_ring));
   call file_manager_$open (bj_dir, bj_entry, fm_oid, code);
   call cu_$level_set (saved_level);

   if fm_oid = NULL_ID then
      call ERROR_RETURN (code);

CHECK_FILE_AND_BJ_UIDS:
   do;
      fm_uid = bj_ci_zero$get_pf_uid (fm_oid);
      bj_uid = bj_ci_zero$get_bj_uid (fm_oid);

      if fm_uid ^= bj_uid then do;
         call cu_$level_set ((current_ring));
         call file_manager_$close (fm_oid, code);
         call cu_$level_set (saved_level);
         call ERROR_RETURN (dm_error_$bj_bad_header);
      end;
   end CHECK_FILE_AND_BJ_UIDS;

/* the selected file seems to be a journal. obtain info on it */

   bj_pn_table_ptr =
        ptr (bjm_data_$bj_pst_ptr,
        bjm_data_$bj_pst_ptr -> bj_pst.pn_table_offset);

   call bj_pst_lock ();

   bj_pste_ptr = bj_pst_search (bj_uid);
   if bj_pste_ptr ^= null () then
JOURNAL_IS_ACTIVE:
      do;
      my_bj_pste = bj_pste;
      bj_pst_dir = bj_pn_table (bj_pste.bj_ix).dir;
      bj_pst_entry = bj_pn_table (bj_pste.bj_ix).entry;
   end JOURNAL_IS_ACTIVE;

   call bj_pst_lock$unlock ();			/* don't wait for getting inactive info */

   if bj_pste_ptr = null () then
INACTIVE_BJ_GET_INFO_FROM_HEADER:
      do;
      call bj_ci_zero$get_header (fm_oid, addr (my_bj_pste), size (my_bj_pste))
	 ;
      bj_pst_dir = bj_dir;
      bj_pst_entry = bj_entry;
      my_bj_pste.active = "0"b;
   end INACTIVE_BJ_GET_INFO_FROM_HEADER;

CLOSE_BJ_FILE:
   do;
      call cu_$level_set ((current_ring));
      call file_manager_$close (fm_oid, code);
      call cu_$level_set (saved_level);
   end CLOSE_BJ_FILE;

COPY_INFO_TO_USER_AREA:
   do;
      bj_status_n_journals = 1;
      allocate bj_status set (bj_status_ptr) in (caller_supplied_area);

      bj_status.journal (1).dir = bj_pst_dir;
      bj_status.journal (1).entry = bj_pst_entry;
      unspec (bj_status.journal (1).system_info) = unspec (my_bj_pste);
   end COPY_INFO_TO_USER_AREA;

   return;

   end RETURN_ONE_PSTE;
%page;
RETURN_WHOLE_PST:
   procedure ();

/* We do not guarantee totally exact info, particularly in	*/
/* case a journal was removed from use.  We will not return	*/
/* info on more journals than when we first examined the	*/
/* bj_pst as we read the PST without it locked.  We may	*/
/* get a journal with some info invalid if we pick it up	*/
/* while it was being removed from use by another process.	*/

VALIDATE_ADMINISTRATIVE_ACCESS:
   do;
      call hcs_$make_ptr (codeptr (bjm_get_journal_status), DM_ADMIN_GATE_NAME,
	 "", dm_admin_gate_ptr, code);
      if dm_admin_gate_ptr = null () then
         call ERROR_RETURN (code);
      call hcs_$fs_get_path_name (dm_admin_gate_ptr, dm_admin_gate_dir,
	 dm_admin_gate_dir_length, (32)" " /* don't care what ename is */,
	 code);
      if code ^= 0 then
         call ERROR_RETURN (code);
      call hcs_$get_user_effmode (
	 substr (dm_admin_gate_dir, 1, dm_admin_gate_dir_length),
	 DM_ADMIN_GATE_NAME, get_group_id_ (), saved_level,
	 dm_admin_gate_access_bin, code);
      if code ^= 0 then
         call ERROR_RETURN (code);
      if substr (bit (dm_admin_gate_access_bin), 2, 3) & E_ACCESS ^= E_ACCESS
	 then
         call ERROR_RETURN (error_table_$not_privileged);
   end VALIDATE_ADMINISTRATIVE_ACCESS;

GET_SYSTEM_TABLES_PTRS:
   do;
      bj_pst_ptr = bjm_data_$bj_pst_ptr;
      bj_pn_table_ptr = ptr (bj_pst_ptr, bj_pst.pn_table_offset);
   end GET_SYSTEM_TABLES_PTRS;

ALLOCATE_STATUS_INFO_STORAGE:
   do;
      bj_status_n_journals = bj_pst.n_entries_used;
      allocate bj_status set (bj_status_ptr) in (caller_supplied_area);
   end ALLOCATE_STATUS_INFO_STORAGE;

/* NOTE: we don't lock the pst */
   journal_info_ix = 0;
COPY_PST:
   do pst_ix = 1 to bj_pst.highest_ix_used
        while (journal_info_ix <= bj_status.n_journals);

      bj_pste_ptr = addr (bj_pst.e (pst_ix));
      if (bj_pste.version = BJ_PSTE_VERSION_2) & bj_pste.active then do;
         bj_ix = bj_pste.bj_ix;
         journal_info_ix = journal_info_ix + 1;
         bj_status.journal (journal_info_ix).dir = bj_pn_table (bj_ix).dir;
         bj_status.journal (journal_info_ix).entry = bj_pn_table (bj_ix).entry;
         unspec (bj_status.journal (journal_info_ix).system_info) =
	    unspec (bj_pste);
      end;

   end COPY_PST;

/* Adjust the n_journals count in the return structure. */
   bj_status.n_journals = journal_info_ix;

   return;

   end RETURN_WHOLE_PST;
%page;
RETURN_MINE_FROM_PST:
   procedure ();

/* Return info about only those BJ's the process is currently using.	*/
/* As in RETURN_WHOLE_PST, we do not lock the bj_pst.		*/

GET_SYSTEM_TABLE_POINTERS:
   do;
      bj_ppt_ptr = bjm_data_$bj_ppt_ptr;
      bj_pst_ptr = bjm_data_$bj_pst_ptr;
      bj_pn_table_ptr = ptr (bj_pst_ptr, bj_pst.pn_table_offset);
   end GET_SYSTEM_TABLE_POINTERS;

ALLOCATE_STATUS_INFO_STORAGE:
   do;
      bj_status_n_journals = bj_ppt.n_entries_used;
      allocate bj_status set (bj_status_ptr) in (caller_supplied_area);
   end ALLOCATE_STATUS_INFO_STORAGE;

/* NOTE: we don't lock the pst */
   journal_info_ix = 0;
COPY_MY_ACTIVE_JOURNALS:
   do ppt_ix = 1 to bj_ppt.max_n_entries
        while (journal_info_ix <= bj_status.n_journals);

      if bj_ppt.e (ppt_ix).version = BJ_PPTE_VERSION_1 then do;
         bj_pste_ptr = bj_ppt.e (ppt_ix).bj_pste_ptr;

         if (bj_pste.version = BJ_PSTE_VERSION_2) & bj_pste.active then do;
	  bj_ix = bj_pste.bj_ix;
	  journal_info_ix = journal_info_ix + 1;
	  bj_status.journal (journal_info_ix).dir = bj_pn_table (bj_ix).dir;
	  bj_status.journal (journal_info_ix).entry =
	       bj_pn_table (bj_ix).entry;
	  unspec (bj_status.journal (journal_info_ix).system_info) =
	       unspec (bj_pste);
         end;
      end;
   end COPY_MY_ACTIVE_JOURNALS;

/* Adjust the n_journals count in the return structure */
   bj_status.n_journals = journal_info_ix;

   return;

   end RETURN_MINE_FROM_PST;
%page;
%include dm_bj_global_error_info;
%page;
%include dm_bj_status;
%page;
%include dm_bj_ppt;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_pn_table;
%page;
%include access_mode_values;


   end bjm_get_journal_status;




		    bjm_open.pl1                    04/04/85  1117.3re  04/04/85  0826.3       77409



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

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

bjm_open:
     proc (p_dir, p_entry, p_bj_oid, p_code);

/*  DESCRIPTION:

     This opens a BJ in a user's process.  There are five major steps in
opening a BJ to a process:

- calling file_manager_ to actually open the BJ,

- creating a bj_pst entry for the BJ if one does not exist,

- registering the user as a user of the BJ in the bj_check_in_table,

- creating a bj_ppt entry if needed and adding one to the number of times
the user process has opened the BJ,

- and setting the BJ last opened value for write_begin_mark to select
a default BJ if the user does not give it one and has not called
bjm_set_default_bj.
*/

/*  HISTORY:
Written by Andre Bensoussan, 07/01/82.
Modified:
10/04/82 by Lee A. Newcomb:  To replace the old default_bj setting with the
	  new bj_ppt.default_bj.last_opened_oid for write_begin_mark, fix
	  the calling protocol so recursive references to dm_data_ will not
	  occur, and to document.
10/15/82 by M. Pandolf:  to use file_manager_ to manipulate data management
	  files.
12/10/82 by M. Pandolf:  to bring rest of code up to date.
04/06/83 by A. Bensoussan:  to add the new entry point $for_recovery.
05/13/83 by A. Bensoussan:  to add the new entry point $force.
11/02/83 by M. Pandolf:  to only allow entrynames ending in ".bj"
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/11/84 by Lee Baldwin:  Renamed dm_error_$bj_header_bad to $bj_bad_header.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
*/
%page;
/* standard entry: */

	entry_no = 1;
	goto COMMON;

for_recovery: entry (p_dir, p_entry, p_bj_oid, p_code);

	entry_no = 2;
	goto COMMON;

force: entry (p_dir, p_entry, p_bj_oid, p_code);

	entry_no = 3;
	goto COMMON;


COMMON:

/* validate entry name */

	if ^is_valid_bj_name (p_entry)
	then do;
		p_code = dm_error_$bj_invalid_name;
		return;
	     end;

/* Enter BJM primitive via standard protocol: */

/* Check that BJM is not already active and claim it if not */

	if bjm_data_$bj_operation = ""
	then bjm_data_$bj_operation = ME;
	else do;
	     p_code = dm_error_$bj_recursive_invoc;
	     goto quick_exit;
	end;

/* Set up values for and enable the cleanup handler */

	pf_oid = ""b;
	level  = cu_$level_get ();

	bjm_data_$bj_exit_err = nonlocal_error_exit;
	bjm_data_$bj_code = 0;

	on cleanup
	     call CLEANUP ();

/* copy arguments into BJM ring and set local code to zero for safety */

	bj_dir   = p_dir;
	bj_entry = p_entry;
	p_code   = 0;

	call cu_$level_set (get_ring_ ());

/* End of standard BJM entry protocol */

/*
   Open the page file for that journal. Compare the pf_uid recorded in the
   CI header with the bj_uid recorded in the bj_header; they must be 
   identical
*/

	call file_manager_$open (bj_dir, bj_entry, pf_oid, code);

	if code ^= 0 
	   then if code = dm_error_$file_already_open
	           then call_fm_close_when_done = "1"b;
	           else do;
		      p_code = code;
		      goto local_error_exit;
	   	      end;
	   else call_fm_close_when_done = "0"b;

	pf_uid = bj_ci_zero$get_pf_uid (pf_oid);

	bj_uid = bj_ci_zero$get_bj_uid (pf_oid);

	if pf_uid ^= bj_uid then
	   do;
	   if call_fm_close_when_done then call file_manager_$close (pf_oid, code);
	   p_code = dm_error_$bj_bad_header;
	   goto local_error_exit;
	   end;

%page;

/* Search the per process and the per system tables for an entry for this
   journal.  Build an entry in the appropriate table if it does not already
   exist.  Register the process as a user of the journal. */

	bj_ppte_ptr = bj_ppt_search (bj_uid);

	if bj_ppte_ptr = null ()
	   then do;
	        call bj_pst_lock ();
	        bj_pste_ptr = bj_pst_search (bj_uid);

	        if bj_pste_ptr = null () 
		then do;
		     if entry_no = 1 then bj_pste_ptr = bj_pste_create              (bj_dir, bj_entry, pf_oid, bj_uid);
		     if entry_no = 2 then bj_pste_ptr = bj_pste_create$for_recovery (bj_dir, bj_entry, pf_oid, bj_uid);
		     if entry_no = 3 then bj_pste_ptr = bj_pste_create$force        (bj_dir, bj_entry, pf_oid, bj_uid);
		     end;

	          else call bj_pste_register$check_in (bj_pste_ptr);

	        bj_ppte_ptr = bj_ppte_create (bj_uid, pf_oid, bj_pste_ptr);

	        call bj_pst_lock$unlock ();

	        end;

	   else call bj_ppte_register$check_in (bj_ppte_ptr);


	bj_oid = bj_oid_util$get_oid (bj_ppte_ptr);
	bjm_data_$bj_ppt_ptr -> bj_ppt.default_bj.last_opened_oid = bj_oid;

	p_bj_oid = bj_oid;

	if call_fm_close_when_done then call file_manager_$close (pf_oid, code);

/* Exit according to standard protocol */

std_exit:
	call cu_$level_set (level);
	bjm_data_$bj_exit_err =
	     bjm_data_$bj_default_error_label;
	bjm_data_$bj_operation = "";

quick_exit:
	return;

nonlocal_error_exit:
	p_code = bjm_data_$bj_code;

local_error_exit:
	call CLEANUP;
	goto quick_exit;

%page;

/* INTERNAL PROCEDURES */

is_valid_bj_name:
	proc (bj_name)
	reducible
	returns (bit (1) aligned);

dcl  bj_name char (*) parameter;
dcl (length, substr, reverse, rtrim) builtin;

	return (
	     (length (rtrim (bj_name)) < 33) &
	     (substr (reverse (rtrim (bj_name)), 1, 3) = "jb."));

end is_valid_bj_name;

%page;

CLEANUP: proc;

	dcl  ec		 fixed bin (35);



	call bj_cleanup_tables$handler (ec);		/* Also unlocks the locks */

	if call_fm_close_when_done
	then call file_manager_$close (pf_oid, ec);

	bjm_data_$bj_operation = "";
	bjm_data_$bj_exit_err =
	     bjm_data_$bj_default_error_label;

	call cu_$level_set (level);

	return;

     end CLEANUP;

%page;

/* PARAMETERS */

dcl  p_dir		        char (*),		/* Dir path of the journal */
     p_entry		        char (*),		/* Entry name of the journal */
     p_bj_oid		        bit (36) aligned,
     p_code		        fixed bin (35);

/* AUTOMATIC */

dcl  bj_dir		        char (168);
dcl  bj_entry		        char (32);
dcl  bj_oid		        bit (36) aligned;
dcl  code			        fixed bin (35);
dcl  pf_oid		        bit (36) aligned;
dcl  pf_uid		        bit (36) aligned;
dcl  bj_uid		        bit (36) aligned;
dcl  level		        fixed bin;
dcl  bj_pste_ptr		        ptr;
dcl  call_fm_close_when_done	        bit (1) aligned;
dcl  entry_no		        fixed bin;


/* CONSTANT */

dcl  ME			        char (8) internal static
			        options (constant) init ("bjm_open");

/* EXTERNAL */

dcl  dm_error_$bj_recursive_invoc     fixed bin(35) ext static;
dcl  dm_error_$bj_bad_header	        fixed bin(35) ext static;
dcl  dm_error_$file_already_open      fixed bin(35) ext static;
dcl  dm_error_$bj_invalid_name        fixed bin(35) ext static;
dcl  bjm_data_$bj_ppt_ptr	        pointer ext static;

/* ENTRY */

dcl  cu_$level_get		        entry returns (fixed bin);
dcl  cu_$level_set		        entry (fixed bin);
dcl  get_ring_		        entry returns (fixed bin (3));
dcl  file_manager_$open	        entry (char (*), char (*), bit (36) aligned, fixed bin (35));
dcl  file_manager_$close	        entry (bit (36) aligned, fixed bin (35));
dcl  bj_ci_zero$get_pf_uid	        entry (bit (36) aligned) returns (bit (36) aligned);
dcl  bj_ci_zero$get_bj_uid	        entry (bit (36) aligned) returns (bit (36) aligned);
dcl  bj_ppt_search		        entry (bit (36) aligned) returns (ptr);
dcl  bj_pst_search		        entry (bit (36) aligned) returns (ptr);
dcl  bj_pste_create		        entry (char (168), char (32), bit (36) aligned, bit (36) aligned) returns (ptr);
dcl  bj_pste_create$for_recovery      entry (char (168), char (32), bit (36) aligned, bit (36) aligned) returns (ptr);
dcl  bj_pste_create$force	        entry (char (168), char (32), bit (36) aligned, bit (36) aligned) returns (ptr);
dcl  bj_ppte_create		        entry (bit (36) aligned, bit (36) aligned, ptr) returns (ptr);
dcl  bj_pst_lock		        entry;
dcl  bj_pst_lock$unlock	        entry;
dcl  bj_pste_register$check_in        entry (ptr);
dcl  bj_ppte_register$check_in        entry (ptr);
dcl  bj_oid_util$get_oid	        entry (ptr) returns (bit (36) aligned);
dcl  bj_cleanup_tables$handler        entry (fixed bin (35));

/* CONDITION */

dcl  cleanup		        condition;

/* INCLUDE FILES */

%page;
%include dm_bj_global_error_info;
%page;
%include dm_bj_static;
%page;
%include dm_bj_ppt;
%page;

end bjm_open;




		    bjm_open_all_after_crash.pl1    04/04/85  1117.3re  04/04/85  0826.3       48114



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

/* format:  style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

bjm_open_all_after_crash:
     proc (Old_boot_dir, Bj_oid_p, Bj_uid_p, N_bjs_opened_for_recovery, Code);

/*  DESCRIPTION:
     This program is intended to be called during DMS crash recovery by the
   DMS Daemon.  It finds the BJ unique id to pathname table in the
   directory specified and loops through it calling the normal opening
   program once it has the name.  The opening id returned and the unique id
   found are returned in the arrays located by Bj_oid_p and Bj_uid_p.
*/

/*  HISTORY:

Written by Lee A. Newcomb, 01/06/83.
Modified:
03/07/83 by L. A. Newcomb: use dm_log_sv_codes.incl.pl1.
04/06/83 by L. A. Newcomb: use bjm_$open_bj_for_recovery and
	  $find_old_uid_pn_table.
03/05/85 by Steve Herbst: Replaced dm_log_ with dm_misc_util_$log.
*/
%page;
/* START DECLARATIONS (except include files) */

dcl  (						/* parameters */
     Old_boot_dir		        char (*),		/* INPUT: dir. with the old bootload's tables */
     Bj_oid_p		        ptr,		/* INPUT: loc. of BJ opening id array */
     Bj_uid_p		        ptr,		/* INPUT: loc. of BJ unique id array */
     N_bjs_opened_for_recovery        fixed bin,		/* OUTPUT: how successful we were */
     Code			        fixed bin (35)	/* OUTPUT: normal error code, recovery fails if ^= 0 */
     )			        parameter;

dcl  (						/* automatics */
     bj_oid_p		        ptr,		/* local copy of parameter */
     bj_uid_p		        ptr,		/* local copy of parameter */
     curr_bj_oid		        bit (36) aligned,	/* holder before storing in caller's array */
     code			        fixed bin (35),	/* local error code holder */
     have_an_error		        bit (1) aligned,	/* used for setting return Code after loop */
     idx			        fixed bin,		/* index to loop through BJ UID-pathname table */
     n_bjs_opened_for_recovery        fixed bin		/* local copy of parameter */
     )			        automatic;

dcl  (						/* arrays the caller expects filled in */
     bj_oid		        based (bj_oid_p),	/* based on the local version of */
     bj_uid		        based (bj_uid_p)	/*     the parameters */
     )			        bit (36) aligned dim (1:n_bjs_opened_for_recovery);

dcl  (						/* error codes */
     dm_error_$bj_not_all_opened_after_crash
     )			        fixed bin (35) ext static;

dcl						/* external entries called */
     before_journal_manager_$open_bj_for_recovery
			        entry (char (*), char (*), bit (36) aligned, fixed bin (35)),
     before_journal_manager_$find_old_uid_pn_table
			        entry (char (*), ptr, fixed bin (35)),
     dm_misc_util_$log	        entry options (variable);

/* END DECLARATIONS */
%page;
/* copy much used input parameters to automatic and init. output parameters */

	bj_oid_p = Bj_oid_p;
	bj_uid_p = Bj_uid_p;

	N_bjs_opened_for_recovery = 0;		/* assume all BJ's were closed */
	Code = 0;					/* and let's be optimistic */

	n_bjs_opened_for_recovery = 0;		/* set local holder of # of BJ's we've opened */


/* First things first, we have to find the old UID-pathname table used */
/*     by the previous DMS boot. */

	call before_journal_manager_$find_old_uid_pn_table (Old_boot_dir, bj_pn_table_ptr, Code);
	if Code ^= 0 then do;			/* could not find the table */
	     call dm_misc_util_$log (LOG_SV, Code, "bjm_open_all_after_crash",
		"Could not find BJ UID-pathname table in dir. ^a.", Old_boot_dir);
	     return;				/* no cleanup to do */
	end;


/* Now loop through the table, opening before journals as we find them. */
/*     When an opening is successful, store the required data in the */
/*     return arrays. */

	have_an_error = ""b;			/* to detect an error on one or more opens */

	do idx = 1 to bj_pn_table.max_n_entries;

	     if bj_pn_table.bj_uid (idx) ^= ""b then do;	/* have an occupied entry */
						/* N.B., we pass dir & entry by value for alignment */
		call before_journal_manager_$open_bj_for_recovery ((bj_pn_table.dir (idx)),
		     (bj_pn_table.entry (idx)), curr_bj_oid, code);
		if code ^= 0 then do;
		     have_an_error = "1"b;		/* so we can set Code at end */
		     call dm_misc_util_$log (LOG_SV, code, "bjm_open_all_after_crash",
			"Error trying to open ^a>^a.", bj_pn_table.dir (idx), bj_pn_table.entry (idx));
		end;

		else do;				/* no problems, record data */
		     n_bjs_opened_for_recovery = n_bjs_opened_for_recovery + 1;
		     bj_oid (n_bjs_opened_for_recovery) = curr_bj_oid;
		     bj_uid (n_bjs_opened_for_recovery) = bj_pn_table.bj_uid (idx);
		end;

	     end;					/* of trying to open a filled entry */
	end;					/* of opening loop */
%page;
/* now must see if any errors were encountered so can tell caller */

	if have_an_error then
	     Code = dm_error_$bj_not_all_opened_after_crash;

/* DONE */
	N_bjs_opened_for_recovery = n_bjs_opened_for_recovery; /* tell caller how many we got for her */

	return;

/*   end bjm_open_all_after_crash; */

/* INCLUDE FILES start next page */
%page;
%include dm_bj_pn_table;
%page;
%include dm_log_sv_codes;


     end bjm_open_all_after_crash;




		    bjm_per_process_init_.pl1       03/06/85  0801.3re  03/05/85  0758.3       38268



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

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

bjm_per_process_init_:
     procedure ();

/* bjm_per_process_init_ - the before journal manager per process data
   initialization procedure.

   this procedure fills in the necessary cells in the data segment
   dm_data_.  it implicitly creates the table bj_ppt, which is the
   per process before journal table.  if all is successful, it returns
   with a zero code.
*/

/* HISTORY:
Written by M. Pandolf, 07/10/82.
Modified:
02/25/83 by M. Pandolf to be used as a first ref trap.
03/04/83 by Jeffrey D. Ives, add validation level setting.
08/05/83 by Lee A. Newcomb:  removed obsolete status codes in
	  calls to dm_per_system_ entries.
09/07/83 by L. A. Newcomb: renamed so an "_" ends the proc name.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
11/22/84 by Lee A. Newcomb:  Removed obsolete dm_common_init_ references.
*/

/*  set up dm_data_ */

	call cu_$level_get (saved_validation_level);
	on cleanup call cu_$level_set (saved_validation_level);
	call cu_$level_set (get_ring_ ());

/* allocate the per process table according to data management protocol */

	allocate bj_ppt
	     in (dm_data_$area_ptr -> per_process_dms_area)
	     set (bjm_data_$bj_ppt_ptr);

/* initialize the per process table */

	bj_ppt_ptr = bjm_data_$bj_ppt_ptr;

	unspec (bj_ppt) = "0"b;

	bj_ppt.max_n_entries = dm_system_data_$bj_max_n_journals;
	bj_ppt.n_entries_used = 0;
	bj_ppt.highest_ix_used = 0;
	bj_ppt.process_id = get_process_id_ ();
	bj_ppt.process_ix = -1;

	bj_ppt.version = BJ_PPT_VERSION_1;

/* fill pointers to other data bases */

	call dm_per_system_$initiate (BJ_PST, "", bjm_data_$bj_pst_ptr);
	if bjm_data_$bj_pst_ptr = null ()
	then do;
	     call sub_err_ (code, ME, "s", null (), retval, "Cannot access before journal system table.");
	     goto exit;
	end;

	dm_data_$bj_txt_ptr =
	     ptr (addr (dm_system_data_$bj_txt_relp), dm_system_data_$bj_txt_relp);

	call get_temp_segment_ (BJ_MGR, bjm_data_$bj_rollback_buffer_ptr, code);
	if code ^= 0
	then do;
	     call sub_err_ (code, ME, "s", null (), retval, "Cannot get temporary space for rollbacks.");
	     goto exit;
	end;

/* finished */

exit:
	call cu_$level_set (saved_validation_level);

	return;


/* DECLARATIONS */

/* Automatic */

dcl  code			        fixed bin (35);	/* local copy of status code */
dcl  retval		        fixed bin (35) init (0); /* needed for sub_err_ call */
dcl  saved_validation_level	        fixed bin init (0);
dcl  cleanup		        condition;

/* Static, External */

dcl  dm_data_$area_ptr	        pointer external static;
dcl  bjm_data_$bj_ppt_ptr	        pointer external static;
dcl  bjm_data_$bj_pst_ptr	        pointer external static;
dcl  dm_data_$bj_txt_ptr	        pointer external static;
dcl  dm_system_data_$bj_txt_relp      bit (18) external static;
dcl  bjm_data_$bj_rollback_buffer_ptr pointer external static;


/* Based */

dcl  per_process_dms_area	        area based;

/* Constant */

dcl  BJ_MGR		        char (32) internal static options (constant)
			        init ("before_journal_manager_");
dcl  ME			        char (32) internal static options (constant)
			        init ("before journal process init");

/* Entry */

dcl  cu_$level_get		        entry (fixed bin);
dcl  cu_$level_set		        entry (fixed bin);
dcl  get_ring_		        entry () returns (fixed bin (3));

dcl  dm_per_system_$initiate	        entry (char (*), char (*), pointer);
dcl  get_process_id_	        entry () returns (bit (36));
dcl  get_temp_segment_	        entry (char (*), ptr, fixed bin (35));
dcl  sub_err_		        entry () options (variable);

/* Builtin */

dcl  (
     addr, ptr, rel, unspec
     )			        builtin;

/* Include Files */
%page; %include dm_bj_static;
%page; %include dm_bj_ppt;
%page; %include dm_bj_names;


     end bjm_per_process_init_;




		    bjm_per_system_init_2_.pl1      04/24/85  1017.5re  04/24/85  0803.8       96246



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

/* DESCRIPTION:

     This is the part two initialization program for the before journal
     manager.  This assumes the current process may run Data Management in the
     using the standard interfaces.  It is responisble for making the default
     before journal exist and available to users.  If the journal already
     exists, it must make sure the journal is valid.  Currently, the journal
     is forced to work via a call to bj_open$force, but more work needs to be
     done to use the DMS configuration file indicators in deciding how to
     handle this case.
*/

/* HISTORY:

Written by M. Pandolf, 07/10/82.
Modified:
08/31/82 by M. Pandolf: to split into two parts
11/04/82 by M. Pandolf: to set acl on default BJ for all processes
02/14/83 by M. Pandolf: to set version for TXT
03/23/83 by Lee A. Newcomb: to create default BJ where told by config file.
03/24/83 by L. A. Newcomb: to not give up if the default BJ already exists
	  from a previous DMS invocation.
03/30/83 by M. Pandolf: use new dm_system_data_ names for default journal.
04/12/83 by L. A. Newcomb:  added special handling of the default BJ being in
            the bootload directory during part 2 init so the default dirname
            in dm_system_data_ is set properly.
05/03/83 by L. A. Newcomb:  part_2 system initialization now uses
            dm_system_data_ to get the default size of the system default
            before journal.
05/15/83 by L. A. Newcomb:  part_2 now tries to open the default before
	  journal if it existed previous to this bootload; and too make
	  sure that the journal is in a usable state.
08/01/83 by Lindsey L. Spratt:  Changed to reference before_journal_manager_
            create close and open_force primitives through the
            before_journal_manager_ TV, rather than directly (e.g., "call
            before_journal_manager_$create_bj" instead of "call bjm_create").
            This is necessary to support the binding of the integrity
            services.
08/06/83 by Lee A. Newcomb: removed obsolete code arg. from calls
	  to dm_per_system_ entries.
09/09/83 by L. A. Newcomb:  split part one and two into two distinct programs.
	  This helps maintenance and binding.  History comments for part one
	  BJM initialization have been removed.
06/25/84 by Matthew Pierret:  Changed to use file_manager_$add_acl_entries 
            instead of file_manager_$open/$acl_add/$close.
11/22/84 by Lee A. Newcomb:  Fixed to use new dm_misc_util_$get_(""
            enabled_)bootload_dir("" name) entries.
12/05/84 by M. Sharpe:  to correct format; set/reset/validation level around
	  the calls to file_manager_.
12/11/84 by M. Sharpe:  to use ERROR_RETURN and ERROR_LOG_RETURN; to use 
	  a constant for "bootload_dir"; to restructure the conditional
	  for checking the status code.
12/26/84 by Matthew Pierret:  Changed to use modern calling sequence of
            file_manager_$add_acl_entries, which takes a general_acl structure.
01/16/84 by M. Sharpe:  to replace the call to file_manager_$add_acl_entries
	  with a call to before_journal_manager_$= and thus remove all
	  validation setting in the program; to add cleanup handler.
03/05/85 by Steve Herbst: Replaced dm_log_ with dm_misc_util_$log.
03/18/85 by Steve Herbst: Removed spurious newline from warning log message.
04/02/85 by Lee A. Newcomb:  Fixed to not pass this modules name to
            dm_misc_util_$log when calling $log without an error code.
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo */
/* format: ^inddcls,dclind5,idind35,linecom */
%page;

bjm_per_system_init_2_:
   procedure (p_code);

/* DECLARATIONS */

/* Parameter */

dcl  p_code			fixed bin (35)	/* standard system status code */
				parameter;

/* Automatics */

dcl  (
     code				fixed bin (35),	/* local copy of status code */
     create_code			fixed bin (35) init (-1),
						/* indicates to cleanup whether or not bj was created */
     default_before_journal_directory	char (168),	/* where we put the default BJ */
     default_before_journal_oid	bit (36) aligned init (""b)
						/* used in part_2 to make sure BJ is ok. */
     )				automatic;

dcl  1 default_before_journal_default_acl		/* used to set default BJ ACL */
				aligned automatic,
       2 version			char (8) aligned
				init (GENERAL_ACL_VERSION_1),
       2 count			fixed bin init (1),
       2 entries			dim (1) like general_acl_entry;

/* Builtin */
dcl  addr				builtin;

/* Condition */

dcl  cleanup			condition;

/* Constants */

dcl  (
     CI_SIZE			fixed bin init (4096),
     BOOTLOAD_DIR			char (12) init ("bootload_dir"),
     IOA_GENERAL_RS_NO_NEW_LINE	bit (1) aligned init ("0"b),
     IOA_GENERAL_RS_DONT_PAD		bit (1) aligned init ("1"b),
     MY_NAME			char (26)
				init ("bjm_per_system_init$part_2")
     )				internal static options (constant);

/* Entries */

dcl  before_journal_manager_$close_bj	entry (bit (36) aligned,
				fixed bin (35));
dcl  before_journal_manager_$create_bj	entry (char (*), char (*), fixed bin,
				fixed bin, fixed bin (35));
dcl  before_journal_manager_$delete_bj	entry (char (*), char (*),
				fixed bin (35));
dcl  before_journal_manager_$open_bj_force
				entry (char (*), char (*),
				bit (36) aligned, fixed bin (35));
dcl  cu_$arg_list_ptr		entry (ptr);
dcl  dm_misc_util_$log		entry options (variable);
dcl  dm_misc_util_$get_bootload_dir	entry (char (*));
dcl  dm_misc_util_$get_enabled_bootload_dirname
				entry () returns (char (32));
dcl  before_journal_manager_$add_acl_entries
				entry (char (*), char (*), ptr,
				fixed bin (35));
dcl  ioa_$general_rs		entry (ptr, fixed bin, fixed bin,
				char (*), fixed bin (21),
				bit (1) aligned, bit (1) aligned);


/* External Static */


dcl  (
     dm_error_$file_already_exists	fixed bin (35),
     dm_system_data_$bj_default_dirname char (168),
     dm_system_data_$bj_default_filename
				char (32),
     dm_system_data_$bj_default_journal_size
				fixed bin
     )				external static;

%page;
   p_code = 0;

/* create the default system before journal */
/* we must take care of the case where the default dirname is the keyword */
/* BOOTLOAD_DIR (see dcls), and fill in the bootload dir name as load     */
/* config cannot */

   if dm_system_data_$bj_default_dirname = BOOTLOAD_DIR then/* must use init dir name */
      call dm_misc_util_$get_bootload_dir (default_before_journal_directory);
   else default_before_journal_directory = dm_system_data_$bj_default_dirname;

   on cleanup call CLEAN_UP ();

   call before_journal_manager_$create_bj (default_before_journal_directory,
        dm_system_data_$bj_default_filename,
        dm_system_data_$bj_default_journal_size, CI_SIZE, create_code);
   if create_code ^= 0 then
      if create_code ^= dm_error_$file_already_exists then
         call ERROR_RETURN (create_code);
      else					/* we need to make sure its valid. */
						/* Brain damage if we just created in bootload dir */
						/* and the journal already existed, so will fall through */
	 if dm_system_data_$bj_default_dirname ^= BOOTLOAD_DIR then do;
						/* check validity */
         call before_journal_manager_$open_bj_force (
	    default_before_journal_directory,
	    dm_system_data_$bj_default_filename, default_before_journal_oid,
	    code);
         if code ^= 0 then
	  call ERROR_LOG_RETURN (code,
	       "Default BJ from previous bootload is unrecoverably damaged: ^a>^a.",
	       default_before_journal_directory,
	       dm_system_data_$bj_default_filename);

         call before_journal_manager_$close_bj (default_before_journal_oid,
	    code);
         if code ^= 0 then
	  call ERROR_LOG_RETURN (code,
	       "Default BJ from previous bootload cannot be closed, aborting: ^a>^a.",
	       default_before_journal_directory,
	       dm_system_data_$bj_default_filename);

/* OK to use the journal */
         call dm_misc_util_$log (LOG_SV,
	    "Warning: using default BJ from previous DMS invocation.");
         code = 0;					/* so we fall through and make sure the ACL is right */
      end;

%page;
/* set ACL to RW for all users of DMS */

   default_before_journal_default_acl.entries (1).access_name = "*.*.*";
   default_before_journal_default_acl.entries (1).mode = "500000000000"b3;
   default_before_journal_default_acl.entries (1).status_code = 0;

   call before_journal_manager_$add_acl_entries
        ((default_before_journal_directory),
        (dm_system_data_$bj_default_filename),
        addr (default_before_journal_default_acl), code);

   if code ^= 0 then
      call ERROR_RETURN (code);

   if dm_system_data_$bj_default_dirname = BOOTLOAD_DIR then
      dm_system_data_$bj_default_dirname =
	 dm_misc_util_$get_enabled_bootload_dirname ();

   p_code = 0;					/* successful */

/* finished */

MAIN_RETURN:
   return;

ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35);

   p_code = er_p_code;
   call CLEAN_UP ();
   goto MAIN_RETURN;

   end ERROR_RETURN;


%page;

CLEAN_UP:
   proc ();

dcl  c_code			fixed bin (35);

   if default_before_journal_oid ^= ""b then
      call before_journal_manager_$close_bj (default_before_journal_oid,
	 c_code);

   if create_code = 0 then
      call before_journal_manager_$delete_bj (default_before_journal_directory,
	 dm_system_data_$bj_default_filename, c_code);

   return;

   end CLEAN_UP;


%page;
ERROR_LOG_RETURN:
   proc options (variable);

dcl  (
     erl_arg_list_ptr		ptr,
     erl_code			fixed bin (35),
     erl_message			char (1024),
     erl_message_length		fixed bin (21)
     )				automatic;

dcl  (
     erl_fixed_bin_35_value		fixed bin (35),
     erl_message_overlay		char (erl_message_length)
     )				based;

   call cu_$arg_list_ptr (erl_arg_list_ptr);
   erl_code =
        erl_arg_list_ptr -> arg_list.arg_ptrs (1) -> erl_fixed_bin_35_value;

   call ioa_$general_rs (erl_arg_list_ptr, 2, 3, erl_message,
        erl_message_length, IOA_GENERAL_RS_DONT_PAD,
        IOA_GENERAL_RS_NO_NEW_LINE);

   call dm_misc_util_$log (LOG_SV, erl_code, MY_NAME,
        addr (erl_message) -> erl_message_overlay);

   call ERROR_RETURN (erl_code);

   end ERROR_LOG_RETURN;

/* end bjm_per_system_init_2_; */


/* INCLUDE FILES start next page */
%page;
%include dm_bj_pste;
%page;
%include dm_bj_txt;
%page;
%include dm_log_sv_codes;
%page;
%include arg_list;
%page;
%include acl_structures;

   end bjm_per_system_init_2_;




		    bjm_rebuild_after_crash.pl1     04/04/85  1117.3r w 04/04/85  0915.8       52020



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

/* format:  style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

bjm_rebuild_after_crash:
     proc (Txn_recovery_data_p, Code);

/*  DESCRIPTION:
     This program overwrites the current DMS bootload bj_txt with data
   derived from the transactive recovery data passed.  Its opposite entry,
   bjm_clean_txn_tables, is in this program and totally clears the bj_txt.
   These are meant to be called by
   transaction_manager_$recover_after_crash after it has acquired a list
   of the transactions to rollback or finish (when multi-phase commit is
   implemented), and when it is finished trying to recover them (in case
   some could not be finished).
*/
/* HISTORY:

Written by Lee A. Newcomb, 12/17/82.
Modified:
03/01/83 by L. A. Newcomb: to not destroy bj_txt.max_n_entries value.
03/07/83 by L. A. Newcomb: clear txt entries correctly (nulling tid).
04/08/83 by L. A. Newcomb:  the PST entry for the journal being rebuilt now
            has its n_txn value set for consistency checks in bj_storage* to
            work properly.
12/05/83 by L. A. Newcomb:  renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells in dm_data_ to bjm_data_.
*/
%page;
/* DECLARATIONS */

dcl  (						/* parameters */
     Txn_recovery_data_p	        ptr,		/* INPUT: loc. of txn data needed by recovery */
     Code			        fixed bin (35)	/* OUTPUT: normal error code, recovery fails if ^= 0 */
     )			        parameter;

dcl  (						/* automatic */
     entry_called		        char (32) aligned,
     idx			        fixed bin		/* do loop counter for clearing txn tables */
     )			        automatic;

dcl						/* PL/I things */
     unspec		        builtin,
     cleanup		        condition;

dcl						/* non-error external statics */
     dm_data_$bj_txt_ptr	        ptr		/* loc. of curr. bootload's bj_txt */
			        ext static;

dcl  (						/* error codes */
     dm_error_$bj_recursive_invoc,
     error_table_$unimplemented_version
     )			        fixed bin (35) ext static;

dcl						/* external entries called */
     bj_cleanup_tables$handler        entry (fixed bin (35)),
     bj_pst_search		        entry (bit (36) aligned) returns (ptr);
%page;
/* initialize output parameter */

	Code = 0;

/* check we are passed a version we understand.  We assume all bj_txt */
/* entries have the same version until the txt gets a version itself. */
/* Must make sure we have some entries, BTW. */

	if Txn_recovery_data_p -> bj_txt.version ^= BJ_TXT_VERSION_1 then do;
	     Code = error_table_$unimplemented_version;
	     return;
	end;
	if Txn_recovery_data_p -> bj_txt.n_entries_used = 0 then
	     return;				/* nothing to do */

/* Use standard BJM entry sequence, just to be sure.  Some modification has */
/* been made to make use of two entries easier */

	entry_called = "bjm_rebuild_after_crash";
	on cleanup
	     call clean_up ("1"b);
	call common_entry_sequence (entry_called, Code);
	if Code ^= 0 then
	     return;


/* Now actually do the rebuilding of the bj_txt.  Since we currently use */
/* the txt data structure, just do a copy of the useful entries. */
	bj_txt_ptr = dm_data_$bj_txt_ptr;
	bj_txt.n_entries_used = Txn_recovery_data_p -> bj_txt.n_entries_used;

	do idx = 1 to bj_txt.n_entries_used;
(nosubrg):
	     bj_txt.entry (idx) = Txn_recovery_data_p -> bj_txt.entry (idx);
	end;

/* now set the # of txns active in this journal in the PST entry */
	bj_pst_search (bj_txt.entry (1).bj_uid) -> bj_pste.n_txn = bj_txt.n_entries_used;

/* Done, go through standard BJM exit sequence. */

	call clean_up (""b);
	return;


/* end bjm_rebuild_after_crash entry */
%page;
bjm_clear_txn_tables:
     entry (Code);

/* Just zero out the entire bj_txt */
/* first initialize output parameter */

	Code = 0;


/* do standard BJM entry sequence */

	entry_called = "bjm_clear_txn_tables";
	on cleanup
	     call clean_up ("1"b);
	call common_entry_sequence (entry_called, Code);
	if Code ^= 0 then
	     return;


/* Now clear the tables.  It turns out the clean_up internal proc. does */
/* this for us anyway. */

	call clean_up (""b);
	return;


/* end bjm_clean_txn_tables entry */
%skip (6);
/* INTERNAL PROCEDURES */

common_entry_sequence:
     proc (Entry_called, Int_code);

/* simple proc. to do the things we're supposed to do in a BJM entry */

	if bjm_data_$bj_operation = "" then
	     bjm_data_$bj_operation = Entry_called;
	else Int_code = dm_error_$bj_recursive_invoc;

	return;

dcl  (						/* common_entry_sequence parameters */
     Entry_called		        char (*) aligned,
     Int_code		        fixed bin (35)
     )			        parameter;

     end common_entry_sequence;
%page;
clean_up:
     proc (Cleanup_condition);

/* clear the txt if necessary and do standard BJM exit sequence */

	if Cleanup_condition | entry_called = "bjm_clear_txn_tables" then do;
	     dm_data_$bj_txt_ptr -> bj_txt.entry.tid = ""b;
	     dm_data_$bj_txt_ptr -> bj_txt.n_entries_used = 0;
	end;


/* Standard exit sequence */

	if bjm_data_$bj_operation = entry_called then do;

	     call bj_cleanup_tables$handler (Code);
	     bjm_data_$bj_exit_err =
		bjm_data_$bj_default_error_label;
	     bjm_data_$bj_operation = "";
	end;

	return;


dcl  Cleanup_condition	        bit (1) aligned parameter;

     end clean_up;

/* INCLUDE FILES start next page */
%page;
%include dm_bj_txt;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_global_error_info;


     end bjm_rebuild_after_crash;




		    bjm_rollback.pl1                05/10/85  0807.0re  05/08/85  1036.7      170388



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

/*  DESCRIPTION:

	This program rolls back the before images created by any process
     during the current transaction.

	The transaction ID, transaction index, and checkpoint number are
     input parameters.  p_code is an output parameter.  Rollback should
     only be called by transacton_manager_, and it is assumed the
     transaction being rolled back was started in this process.  An added
     check is made if the process does not own the transaction to try to
     adopt the transaction to roll it back.

	NOTE: checkpoints are not currently supported.
*/

/*  HISTORY:
Written by M. Pandolf, 07/23/82.
Modified:
08/23/83 by M. Pandolf: to become bjm_rollback for operation in any proces.
08/15/82 by M. Pandolf: to use file_manager_ to manipulate data
	  management files.
11/11/82 by M. Pandolf: to not die when a before image cannot be rolled back.
12/15/82 by M. Pandolf: to not change txte.n_rec_written.
01/04/83 by M. Pandolf:  to check TID from image, verify number of records
	  read, and keep track of instances of rollback failures.
01/24/83 by M. Pandolf:  to log errors and to not use "addr (substr)".
02/14/83 by M. Pandolf:  to get bj_txt_ptr before getting bj_txte_ptr.
03/02/83 by M. Pandolf:  to use new txte protocol and new bj marks.
03/16/83 by M. Pandolf:  to get report errors more intellegently.
04/29/83 by M. Pandolf:  to add meters and report n_recs_rolledback.
05/12/83 by L. A. Newcomb:  made TEMP MOD to special handle deleted protected
            files until file_manager_ does so.
05/13/83 by L. A. Newcomb:  Modified Rollback summary to be more accurate in
            wording and easier to read.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/07/84 by Lee Baldwin:  Fixed to call dm_error_$no_current_transaction
            instead of $bj_no_txn, renamed dm_error_$bj_txt_version_bad
            to $bj_bad_txt_version.
10/23/84 by M. Sharpe:  to use addcharno; to check for et_$noinfo in the
	  "TEMP MOD" section of the code; cleanup dcls and format; to
	  use "call ERROR_RETURN (code)" technique; to set level to   
	  current (lower) ring before calling file_manager and reset
	  it after returning;
10/29/84 by Matthew Pierret:  Changed handling of FM_ROLLBACK_HANDLER record
            to call file_manager_$undo instead of $rollback_handler and to
            not attempt to open the file if no opening id is supplied in
            in the bj_fm_handler_rec.
11/29/84 by M.  Sharpe:  to correct call to cu_$level_get.
12/10/84 by R. Michael Tague:  Changed incl name to dm_daemon_sv_codes.
12/14/84 by Matthew C. Pierret:  Removed FM_ROLLBACK_HANDLER code which
            special cased bj_handler_rec.oid equal to ZERO and attempted to
            get an oid if a non-null oid was supplied, but the process is
            different from the owner process.  We only want opening
            information if this is the owner process.
01/07/84 by R. Michael Tague:  changed error_table_$noinfo to $no_info.
01/14/85 by Lee A. Newcomb:  Corrected my_ci_parts declaration in
            RESTORE_BEFORE_IMAGE to have the must_be_zero component; removed
            the unused before_image_array; declared builtin's used; fixed to
            use dm_log_sv_codes.incl.pl1; corrected internal procs' variables
            to use project naming standard; removed temporary modification
            added before deletes of DM files were protected; changed to only
            report rollback errors instead of a complete summary of the
            rollback (to make it easier to read the log); changed to use init
            clauses to initialize most automatic storage; fixed to have one
            format comment instead of two conflicting ones.
01/16/85 by Lee A. Newcomb:  Fixed to not set bjm_data_$bj_exit_err or the
            cleanup handler until it is known =$bj_operation may be set.
03/05/85 by Steve Herbst: Replaced dm_log_ with dm_misc_util_$log.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code to zero.
04/26/85 by Lee A. Newcomb:  Fixed to always reset validation level after
            setting it and to understand some errors are benign, such as when
            a file was created, deleted in a rollback, but the rollback was
            re-run due to an error in the first run.
05/02/85 by Lee A. Newcomb:  Fixed to open DM files when a FM_ROLLBACK_HANDLER
            record is found; this is required so recovery can find the file in
            the UID-pathname table.
*/
/* format:  style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,comcol80,linecom */
%page;
bjm_rollback:
   proc (p_tid, p_tix, p_checkpoint_no, p_code);


/* DECLARATIONS */

/* Parameter */
dcl  (
     p_tid			bit (36) aligned,		         /* transaction id */
     p_tix			fixed bin,		         /* transaction index */
     p_checkpoint_no		fixed bin (35),		         /* checkpoint to rollback to */
     p_code			fixed bin (35)		         /* standard system status code */
     )				parameter;

/* Automatic */
dcl  (
     before_image_length		fixed bin (24),		         /* bit length of before image */
     code				fixed bin (35) init (0),	         /* local error code */
     current_ring			fixed bin (3),
     fm_oid			bit (36) aligned init (NULL_ID),       /* local copy of file manager OID */
     n_bi_unput			fixed bin (35) init (0),
     n_bytes_unput			fixed bin (71) init (0),
     n_get_oid_errors		fixed bin (35) init (0),
     n_handler_errors		fixed bin (35) init (0),
     n_rec_bytes			fixed bin,		         /* size of current before image */
     n_rec_read			fixed bin (35) init (0),	         /* # of records in BJ for this TID */
     n_unput_errors			fixed bin (35) init (0),
     number_of_ci_parts		fixed bin (17) init (0),	         /* # of ci parts in before image record */
     prev_get_oid_code		fixed bin (35) init (0),
     prev_handler_code		fixed bin (35) init (0),
     prev_unput_code		fixed bin (35) init (0),
     records_used_mismatch		bit (1) aligned init ("0"b),	         /* # records read ^= txte.n_rec_written */
     saved_level			fixed bin,
     this_rec_id			bit (36) aligned,		         /* record currently rolling back */
     tid				bit (36) aligned,		         /* copy of transaction id */
     tix				fixed bin,		         /* copy of the transaction index */
     uns_ci_no			fixed bin (24) unsigned	         /* for file_manager_ calling seq */
     )				automatic;

/* Builtin */
dcl  (addcharno, addr, fixed, null)	builtin;

/* Condition */
dcl  cleanup			condition;

/* Constant */
dcl  (
     ME				char (32) init ("bjm_rollback"),
     NULL_ID			bit (36) aligned init ((36)"0"b)
     )				internal static options (constant);

/* Entry */
dcl  (
     bj_adopt_txn$get_pf_oid		entry (bit (36) aligned,
				bit (36) aligned),
     bj_cleanup_tables$handler	entry (fixed bin (35)),
     bj_storage_get			entry (bit (36) aligned,
				bit (36) aligned, ptr, fixed bin),
     bj_txte_util$synchronize_txte_pste entry (ptr),
     cu_$level_get			entry (fixed bin),
     cu_$level_set			entry (fixed bin),
     dm_misc_util_$log		entry () options (variable),
     file_manager_$undo		entry (bit (36) aligned,
				bit (36) aligned, ptr, fixed bin,
				fixed bin (35)),
     file_manager_$unput		entry (bit (36) aligned,
				uns fixed bin (24), ptr,
				fixed bin (35)),
     get_ring_			entry returns (fixed bin (3))
     )				external;

/* External */
dcl  (
     bjm_data_$bj_ppt_ptr		pointer,
     bjm_data_$bj_pst_ptr		pointer,
     bjm_data_$bj_rollback_buffer_ptr	pointer,
     dm_data_$bj_txt_ptr		pointer,
     (
     dm_error_$bj_bad_rec_count,
     dm_error_$bj_bad_tid,
     dm_error_$bj_bad_txt_version,
     dm_error_$bj_incomplete_rollback,
     dm_error_$bj_not_my_txn,
     dm_error_$bj_recursive_invoc,
     dm_error_$bj_rollback_bad_cp_no,
     dm_error_$bj_txn_aborted,
     dm_error_$bj_txn_committed,
     dm_error_$bj_unexpected_aborted_mark,
     dm_error_$bj_unexpected_committed_mark,
     dm_error_$bj_unknown_record_type,
     dm_error_$file_doesnt_exist,
     dm_error_$file_was_deleted,
     dm_error_$no_current_transaction,
     error_table_$noentry
     )				fixed bin (35)
     )				external static;

/* Static */

/* END OF DECLARATIONS */
%page;
COPY_AND_INIT_PARAMETERS:
   do;
      tid = p_tid;
      tix = p_tix;
      p_code = 0;
   end COPY_AND_INIT_PARAMETERS;

SETUP_ERROR_HANDLING:
   do;
      if bjm_data_$bj_operation ^= "" then do;
         p_code = dm_error_$bj_recursive_invoc;			         /* do not use ERROR_RETURN so */
         goto MAIN_RETURN;					         /* CLEAN_UP will not be called */
      end;

      call cu_$level_get (saved_level);
      on cleanup call CLEAN_UP ();

      bjm_data_$bj_operation = ME;
      bjm_data_$bj_exit_err = NONLOCAL_ERROR_EXIT;
      bjm_data_$bj_code = 0;

   end SETUP_ERROR_HANDLING;


UPDATE_METERS:
   bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_rollback =
        bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_rollback + 1;


VALIDATE_PARAMETERS_AND_SYSTEM_TABLES:
   do;

      if tix < 1 | tix > dm_system_data_$max_n_transactions | tid = NULL_ID
	 then
         call ERROR_RETURN (dm_error_$no_current_transaction);

      bj_txt_ptr = dm_data_$bj_txt_ptr;
      bj_txte_ptr = addr (bj_txt.entry (tix));

      if bj_txt.version ^= BJ_TXT_VERSION_1 then
         call ERROR_RETURN (dm_error_$bj_bad_txt_version);

      if bj_txte.tid ^= tid then
         if bj_txte.tid = NULL_ID then
	  call ERROR_RETURN (dm_error_$no_current_transaction);
         else call ERROR_RETURN (dm_error_$bj_bad_tid);

/* checkpoint numbers for version 1 will be 0 and -1 only */

      if p_checkpoint_no ^= 0 & p_checkpoint_no ^= -1 then
         call ERROR_RETURN (dm_error_$bj_rollback_bad_cp_no);

   end VALIDATE_PARAMETERS_AND_SYSTEM_TABLES;
%page;
SYNC_TXTE_WITH_PSTE:
   do;

/* This might complete a pending operation. */

      call bj_txte_util$synchronize_txte_pste (bj_txte_ptr);

      if bj_txte.tid = NULL_ID then
         call ERROR_RETURN (dm_error_$no_current_transaction);

   end SYNC_TXTE_WITH_PSTE;


IS_BJ_OPEN_IN_THIS_PROCESS:
   if bj_txte.operator_info.process_id
        ^= bjm_data_$bj_ppt_ptr -> bj_ppt.process_id then
      call ERROR_RETURN (dm_error_$bj_not_my_txn);


/* set up bj_rec_hdr_ptr so we can get before images, and	*/
/* current_ring so we do not have to keep calling get_ring_.*/

   bj_rec_hdr_ptr = bjm_data_$bj_rollback_buffer_ptr;
   current_ring = get_ring_ ();
%page;
/* walk the transaction records backward, restoring before images */
/* This loop assumes no checkpoint facility exists.	      */

ROLLBACK_LOOP:
   do this_rec_id = bj_txte.last_bj_rec_id
        repeat (bj_rec_hdr.prev_rec_id) while (this_rec_id ^= NULL_ID);

      call bj_storage_get (bj_txte.bj_oid, this_rec_id, bj_rec_hdr_ptr,
	 n_rec_bytes);					         /* get before image record */

      if bj_rec_hdr.tid ^= bj_txte.tid then			         /* validate TID threading in the */
         call ERROR_RETURN (dm_error_$bj_bad_tid);		         /* before images */

      n_rec_read = n_rec_read + 1;


CHECK_IMAGE_TYPE_AND_ROLLBACK:
      do;

         if bj_rec_hdr.type = COMMITTED | bj_rec_hdr.type = BEGIN_COMMIT then
	  if this_rec_id ^= bj_txte.last_bj_rec_id then
	     call ERROR_RETURN (dm_error_$bj_unexpected_committed_mark);
	  else call ERROR_RETURN (dm_error_$bj_txn_committed);

         if bj_rec_hdr.type = ABORTED then
	  if this_rec_id ^= bj_txte.last_bj_rec_id then
	     call ERROR_RETURN (dm_error_$bj_unexpected_aborted_mark);
	  else call ERROR_RETURN (dm_error_$bj_txn_aborted);
%page;
         if bj_rec_hdr.type = BEFORE_IMAGE then
DATA_TO_ROLLBACK:
	  do;

	  number_of_ci_parts = bj_before_image.n_parts;
	  before_image_length = bj_before_image.image_len;

RESTORE_BEFORE_IMAGE:
	  begin;

/* This begin block automatically allocates the correct amount of	*/
/* storage for the ci_parts structure; the number of elements in the	*/
/* parts array is determined by number_of_ci_parts, set in the main	*/
/* procedure block.						*/

dcl  1 my_ci_parts			aligned,
       2 number_of_parts		fixed bin,
       2 must_be_zero		fixed bin init (0),
       2 part			dim (number_of_ci_parts)
				like ci_parts.part;
dcl  curr_image_pos			fixed bin (24) init (0);
dcl  this_part			fixed bin;

	     my_ci_parts.number_of_parts = number_of_ci_parts;

	     do this_part = 1 to number_of_ci_parts;

	        my_ci_parts.part (this_part).offset_in_bytes =
		   bj_before_image.part (this_part).byte_offset;
	        my_ci_parts.part (this_part).length_in_bytes =
		   bj_before_image.part (this_part).byte_length;

	        my_ci_parts.part (this_part).local_ptr =
		   addcharno (addr (bj_before_image.image), curr_image_pos)
		   ;

	        curr_image_pos =
		   curr_image_pos
		   + bj_before_image.part (this_part).byte_length;
	     end;

	     if bj_txte.owner_info.process_id
		^= bjm_data_$bj_ppt_ptr -> bj_ppt.process_id then
	        call bj_adopt_txn$get_pf_oid (bj_before_image.fm_uid, fm_oid)
		   ;
	     else fm_oid = bj_before_image.fm_oid;

	     if fm_oid ^= NULL_ID then			         /* have file to work with */
UNPUT_IMAGE:
	        do uns_ci_no = bj_before_image.ci_no;
		 call cu_$level_set ((current_ring));
		 call file_manager_$unput (fm_oid, uns_ci_no,
		      addr (my_ci_parts), code);
		 call cu_$level_set (saved_level);
		 if code ^= 0 & code ^= dm_error_$file_doesnt_exist
		      & code ^= dm_error_$file_was_deleted then do;
		    n_unput_errors = n_unput_errors + 1;
		    if prev_unput_code ^= code then do;
		       call dm_misc_util_$log (ERROR_SV, code, ME,
			  "Error occurred ^i times consecutively calling unput",
			  n_unput_errors);
		       n_unput_errors = 0;
		       prev_unput_code = code;
		    end;
		 end;
		 else do;
		    n_bi_unput = n_bi_unput + 1;
		    n_bytes_unput = n_bytes_unput + before_image_length;
		 end;
	        end UNPUT_IMAGE;
	     else if bjm_data_$bj_code ^= error_table_$noentry then do;
	        n_get_oid_errors = n_get_oid_errors + 1;
	        if prev_get_oid_code ^= bjm_data_$bj_code then do;
		 call dm_misc_util_$log (ERROR_SV, bjm_data_$bj_code, ME,
		      "Error occurred ^i consecutive times while getting OID, file UID ^w",
		      n_get_oid_errors, bj_before_image.fm_uid);
		 n_get_oid_errors = 0;
		 prev_get_oid_code = bjm_data_$bj_code;
	        end;
	     end;
	     else ;					         /* OK, image of a now deleted file */

	     bjm_data_$bj_code = 0;				         /* reset for the next round */
	  end RESTORE_BEFORE_IMAGE;

         end DATA_TO_ROLLBACK;
%page;
         else if bj_rec_hdr.type = ROLLED_BACK then
	  ;

         else if bj_rec_hdr.type = FM_POSTCOMMIT_HANDLER then
	  ;

         else if bj_rec_hdr.type = FM_ROLLBACK_HANDLER then
ACTION_TO_ROLLBACK:
	  do;

	  if bj_txte.owner_info.process_id
	       ^= bjm_data_$bj_ppt_ptr -> bj_ppt.process_id then
	     call bj_adopt_txn$get_pf_oid (bj_fm_handler_rec.fm_uid, fm_oid);
	  else fm_oid = bj_fm_handler_rec.fm_oid;

	  if fm_oid ^= NULL_ID then				         /* have file to work with */
RUN_FM_ROLLBACK_HANDLER:
	     do;
	     call cu_$level_set ((current_ring));
	     call file_manager_$undo (bj_fm_handler_rec.fm_uid, fm_oid,
		addr (bj_fm_handler_rec.info_bytes),
		bj_fm_handler_rec.info_len, code);
	     call cu_$level_set (saved_level);
	     if code ^= 0 then do;
	        n_handler_errors = n_handler_errors + 1;
	        if prev_handler_code ^= code then do;
		 call dm_misc_util_$log (ERROR_SV, code, ME,
		      "Error occurred ^i consecutive times while calling rollback handler.",
		      n_handler_errors);
		 n_handler_errors = 0;
		 prev_handler_code = code;
	        end;
	     end;
	  end RUN_FM_ROLLBACK_HANDLER;
	  else if bjm_data_$bj_code ^= error_table_$noentry then do;
	     n_get_oid_errors = n_get_oid_errors + 1;
	     if prev_get_oid_code ^= bjm_data_$bj_code then do;
	        call dm_misc_util_$log (ERROR_SV, bjm_data_$bj_code, ME,
		   "Error occurred ^i consecutive times while getting OID, file UID ^w",
		   n_get_oid_errors, bj_before_image.fm_uid);
	        n_get_oid_errors = 0;
	        prev_get_oid_code = bjm_data_$bj_code;
	     end;
	  end;
	  else ;						         /* OK, handler for a now deleted file */

	  bjm_data_$bj_code = 0;				         /* reset for the next round */

         end ACTION_TO_ROLLBACK;


         else call ERROR_RETURN (dm_error_$bj_unknown_record_type);	         /* unknown or unsupported BJ rec type */

      end CHECK_IMAGE_TYPE_AND_ROLLBACK;

   end ROLLBACK_LOOP;

   bj_txte.curr_checkpoint_rec_id = this_rec_id;			         /* change when checkpoints implemented */
%page;
CHECK_FOR_ERRORS:
   do;
      records_used_mismatch = (n_rec_read ^= bj_txte.n_rec_written);

      if records_used_mismatch then
         bjm_data_$bj_code = dm_error_$bj_bad_rec_count;
      else if n_get_oid_errors + n_unput_errors + n_handler_errors > 0 then
         bjm_data_$bj_code = dm_error_$bj_incomplete_rollback;

      if bjm_data_$bj_code ^= 0 then
LOG_ERROR_SUMMARY:
         do;
         call dm_misc_util_$log (LOG_SV, bjm_data_$bj_code, ME,
	    "TID ^d^[;^2x^d images read vs. ^d written^;^2s^]^[;^2x^d unput errors^;^s^]^[;^2x^d OID errors^;^s^]^[;^2x^d handler errors.^]",
	    fixed (tid), records_used_mismatch, n_rec_read,
	    bj_txte.n_rec_written, (n_unput_errors > 0), n_unput_errors,
	    (n_get_oid_errors > 0), n_get_oid_errors, (n_handler_errors > 0),
	    n_handler_errors);
         call ERROR_RETURN (bjm_data_$bj_code);

      end LOG_ERROR_SUMMARY;

   end CHECK_FOR_ERRORS;

   call FINISH ();

MAIN_RETURN:
   return;


/* end bjm_rollback; */
%page;
NONLOCAL_ERROR_EXIT:
   call ERROR_RETURN (bjm_data_$bj_code);




ERROR_RETURN:
   proc (er_p_code);

dcl  er_p_code			fixed bin (35) parameter;

   call CLEAN_UP ();
   p_code = er_p_code;
   goto MAIN_RETURN;

   end ERROR_RETURN;



CLEAN_UP:
   procedure ();

dcl  cu_code			fixed bin (35) automatic;

   call bj_cleanup_tables$handler (cu_code);

   call FINISH ();

   return;

   end CLEAN_UP;




FINISH:
   proc ();

/* operations we must do no matter how we exit bjm_rollback */

   bjm_data_$bj_operation = "";
   bjm_data_$bj_exit_err = bjm_data_$bj_default_error_label;
   call cu_$level_set (saved_level);

   return;

   end FINISH;
%page;
%include dm_bj_global_error_info;
%page;
%include dm_bj_ppt;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;
%include dm_bj_records;
%page;
%include dm_bj_static;
%page;
%include dm_bj_txt;
%page;
%include dm_ci_parts;
%page;
%include dm_log_sv_codes;


   end bjm_rollback;




		    bjm_set_default_bj.pl1          04/04/85  1117.3re  04/04/85  0826.3       36504



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

/* DESCRIPTION:
     This program sets up an implicitly referenced before journal.

     This procedure accepts a before journal OID and validates the before
journal.  If the before journal is opened in this process, it then
becomes the new default before journal.  If it is not opened, then
a non-zero error code is returned.
*/

/*  HISTORY:
Written by Mike Pandolf, 07/06/82.
Modified:
10/04/82 by Lee A. Newcomb:  To record user's explicit setting in a new
	  default_bj cell:  user_set_oid.
11/11/82 by M. Pandolf:  to use standard entry and exit protocol.
03/14/83 by L. A. Newcomb:  to use dm_error_$bj_journal_not_opened.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
10/16/84 by Maggie Sharpe:  placed a version check of bj_ppte after getting
            the bj_ppte_ptr; corrected format; changed to use
	  "call ERROR_RETURN (code)" convention.
02/26/85 by Lee A. Newcomb:  Corrected to use dm_error_$bj_bad_ppte_version
            when testing the PPTE, not $bj_txt_version_bad.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
*/

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */
%page;
bjm_set_default_bj:
     procedure (p_bj_oid, p_code);

/* DECLARATIONS */

/* Parameter */

dcl  p_bj_oid		        bit (36) aligned parameter; /* bj OID to become the new default */
dcl  p_code		        fixed bin (35) parameter; /* standard system status code */

/* Automatic */

dcl  bj_oid		        bit (36) aligned;	/* local copy of bj OID */
dcl  code			        fixed bin (35);

/* Condition */

dcl  cleanup		        condition;

/* Entry */

dcl  bj_oid_util$get_ptr	        entry (bit (36) aligned) returns (ptr);
dcl  bj_cleanup_tables$handler        entry (fixed bin (35));

/* External Static  */

dcl  bjm_data_$bj_ppt_ptr	        pointer external static;
dcl  dm_error_$bj_bad_ppte_version    fixed bin (35) external static;
dcl  dm_error_$bj_journal_not_opened  fixed bin (35) external static;
dcl  dm_error_$bj_recursive_invoc     fixed bin (35) external static;

/* Internal Static */

dcl  ME			        char (20) internal static options (constant) init ("bjm_set_default_bj");

/* copy argument */

	bj_oid = p_bj_oid;
	p_code = 0;

/* set up error handling environment */

	on cleanup call CLEANUP;

	if bjm_data_$bj_operation = ""
	     then bjm_data_$bj_operation = ME;
	else do;
	     p_code = dm_error_$bj_recursive_invoc;
	     goto MAIN_RETURN;
	end;

	bjm_data_$bj_exit_err = nonlocal_exit_err;
	bjm_data_$bj_code = 0;

/* get pointer to the PPTE */

	bj_ppte_ptr = bj_oid_util$get_ptr (bj_oid);
	if bj_ppte.version ^= BJ_PPTE_VERSION_1 then
	     call ERROR_RETURN (dm_error_$bj_bad_ppte_version);

/* make sure the before journal is open, then set default OID */

	if bj_ppte.n_opening = 0
	     then call ERROR_RETURN (dm_error_$bj_journal_not_opened);
	else
	     bjm_data_$bj_ppt_ptr -> bj_ppt.default_bj.user_set_oid = bj_oid;

	bjm_data_$bj_operation = "";

	bjm_data_$bj_exit_err =
	     bjm_data_$bj_default_error_label;

MAIN_RETURN:
	return;

nonlocal_exit_err:
	call ERROR_RETURN (bjm_data_$bj_code);


/* INTERNAL PROCEDURES */


ERROR_RETURN:
     proc (error_code);

dcl  error_code		        fixed bin (35);

	call CLEANUP;
	p_code = error_code;
	goto MAIN_RETURN;

     end ERROR_RETURN;


CLEANUP:
     procedure ();

dcl  cleanup_code		        fixed bin (35);

	call bj_cleanup_tables$handler (cleanup_code);

	bjm_data_$bj_operation = "";
	bjm_data_$bj_exit_err =
	     bjm_data_$bj_default_error_label;

	return;

     end CLEANUP;


%page; %include dm_bj_static;
%page; %include dm_bj_ppt;
%page; %include dm_bj_global_error_info;


     end bjm_set_default_bj;




		    bjm_user_shutdown.pl1           03/06/85  0801.3re  03/05/85  0758.4        5985



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

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

bjm_user_shutdown:
     proc ();

/* DESCRIPTION:

	This entry is currently a no-op and is being used as a place-holder
     until and if a real bjm_user_shutdown is needed.
*/

/* HISTORY:

Written by L. A. Newcomb, 05/01/84.
Modified:
*/

	return;

     end bjm_user_shutdown;




		    bjm_write.pl1                   04/04/85  1117.3re  04/04/85  0826.3      309285




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

/* DESCRIPTION:

	The bjm_write procedure has entrypoints for each type of before
     journal write operation.  ANY CHANGES TO BJM_FIND_TXNS_AFTER_CRASH OR
     BJ_TXTE_UTIL SHOULD BE EXAMINED TO BE SURE THEY AGREE WITH THE
     MEHCANISMS IN THIS MODULE USED TO WRITE TO BEFORE JOURNALS.  Likewise,
     any changes to this module may need to be reflected in the above two
     modules.

LIST OF ENTRYPOINTS:

   aborted_mark     (tid, tix, code)
   before_image     (fm_uid, fm_oid, ci_no, ci_parts_ptr, time_stamp, code)
   begin_mark       (tid, tix, bj_oid, code)
   committed_mark   (tid, tix, code)
   rolled_back_mark (tid, tix, checkpoint_no, code)
   fm_rollback_handler
                    (fm_uid, fm_oid, buff_ptr, buff_byte_len, n_ci_held, time_stamp, code)
   fm_postcommit_handler
                    (fm_uid, fm_oid, buff_ptr, buff_byte_len, code)

LIST OF PARAMETERS:

   tid           INPUT   bit (36) aligned         current transaction ID
   tix           INPUT   fixed bin                current transaction index
   bj_oid        INPUT   bit (36) aligned         opening ID of a before journal or "0"b
   checkpoint_no INPUT   fixed bin (35)           number of the checkpoint of previous rollback
   fm_uid        INPUT   bit (36) aligned         unique ID of protected file being imaged
   fm_oid        INPUT   bit (36) aligned         opening ID of protected file being imaged
   ci_no         INPUT   fixed bin (24) unsigned  control interval number in file being imaged
   ci_parts_ptr  INPUT   pointer                  pointer to ci_parts description structure
   buff_ptr      INPUT   pointer                  pointer to handler info buffer
   buff_len      INPUT   fixed bin (17)           length of fm handler image in bytes
   n_ci_held     INPUT   fixed bin (27)           number of control intervals held
   time_stamp    OUTPUT  fixed bin (71)           time at which image saved
   code          OUTPUT  fixed bin (35)           system status code

     This code was originally contained in five separate programs.
*/

/* HISTORY:
Written by M. Pandolf, 03/08/83.
Modified:
03/28/83 by M. Pandolf:  to align record buffers.
04/08/83 by M. Pandolf:  to use new validation protocol.
04/20/83 by M. Pandolf:  to have abort and commit leave TID alone and
	  to zero the ok_to_write flag.
04/29/83 by M. Pandolf:  added meters.
04/30/83 by L. A. Newcomb: fixed VALIDATE_TRANSACTION to goto the local error
	  exit instead of the non-local one to preserve the status code.
12/06/83 by L. A. Newcomb:  Renamed before_journal_manager_static_ to
            bjm_data_ and moved some cells from dm_data_ to bjm_data_.
06/07/84 by Lee Baldwin:  Fixed to call dm_error_$no_current_transaction
            instead of $bj_no_txn, renamed dm_error_$bj_txt_version_bad to
            $bj_bad_txt_version.
10/29/84 by Matthew Pierret:  Changed fm_rollback_mark to fm_rollback_handler.
            Changed WRITE_COMMITTED_MARK to have no effect on the number of 
            transactions in the journal if writing a BEGIN_COMMIT mark instead
            of a COMMIT mark.  The latter case continues to decrease the
            number of transactions by one.  In the BEGIN_COMMIT case, the
            number of transactions is decremented later in 
            bj_txte_util$complex_commit, when it finally writes the
            COMMIT mark.
            Changed to set bj_fm_handler_rec.prev_fm_handler_rec_id to
            ZERO in the WRITE_FM_ROLLBACK_HANDLER, to 
            bj_txte.last_fm_postcommit_handler_rec_id in 
            WRITE_FM_POSTCOMMIT_HANDLER.
            Changed to make WRITE_FM_POSTCOMMIT_HANDLER and
            WRITE_FM_ROLLBACK_HANDLER increase the number of transactions
            in the journal by 1 if writing the first record for a transaction.
03/04/85 by Lee A. Newcomb:  Fixed to not write more than one BEGIN_COMMIT
            mark.
03/19/85 by Steve Herbst: Fixed to initialize bjm_data_$bj_code.
*/

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */
%page;
/*
   ************************************************************************
   **********           BEGIN bjm_write$begin_mark               **********
   ************************************************************************
*/
bjm_write$begin_mark:
     procedure (p_tid, p_tix, p_bj_oid, p_begin_code);

/* copy parameters and identify self */

	txn_id = p_tid;
	txn_index = p_tix;

	p_begin_code = 0;

	my_name = BEGIN_ID;
	return_code_ptr = addr (p_begin_code);

/* before entering BJM environment, obtain a BJ OID */

	if p_bj_oid ^= ZERO
	     then bj_oid = p_bj_oid;
	else do;
	     call before_journal_manager_$get_default_bj (bj_oid, p_begin_code);
	     if p_begin_code ^= 0
		then goto bjm_return;
	end;

/* invoke entry protocol common to all before_journal_manager_ */

	on cleanup call EMERGENCY_CLEANUP ();

	call ENTER_BJM ();

/* fill in the transaction table entry */

	call INITIALIZE_TRANSACTION ();

/* meter */

	bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_begin_txn =
	     bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_begin_txn + 1;
	bj_ppte_ptr -> bj_ppte.bj_pste_ptr -> bj_pste.meters.n_txn_started =
	     bj_ppte_ptr -> bj_ppte.bj_pste_ptr -> bj_pste.meters.n_txn_started + 1;

/* go to common wrap up point */

	goto bjm_wrap_up;
%page;
/*
   ************************************************************************
   **********           BEGIN bjm_write$aborted_mark             **********
   ************************************************************************
*/
bjm_write$aborted_mark:
     entry (p_tid, p_tix, p_abort_code);

/* copy parameters and identify self */

	txn_id = p_tid;
	txn_index = p_tix;

	p_abort_code = 0;

	my_name = ABORT_ID;
	return_code_ptr = addr (p_abort_code);

/* invoke entry protocol common to all before_journal_manager_ */

	on cleanup call EMERGENCY_CLEANUP ();

	call ENTER_BJM ();

/* meter */

	bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_abort =
	     bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_abort + 1;

/* validate transaction index and ID */

	call VALIDATE_TRANSACTION ();

/* if no record has been written this transaction, then don't now */

	if bj_txte.first_bj_rec_id = ZERO
	then do;
	     bj_txte.ok_to_write = NO;
	     bj_txte.last_completed_operation = ABORTED;
	     goto bjm_wrap_up;
	end;

/* make the before journal record and write it */

	call WRITE_ABORTED_MARK ();

/* go to common wrap up point */

	goto bjm_wrap_up;
%page;
/*
   ************************************************************************
   **********           BEGIN bjm_write$before_image             **********
   ************************************************************************
*/
bjm_write$before_image:
     entry (p_fm_uid, p_fm_oid, p_ci_no, p_ci_parts_ptr, p_bi_time_stamp, p_before_image_code);

/* copy parameters and identify self */

	fm_uid = p_fm_uid;
	fm_oid = p_fm_oid;
	ci_no = p_ci_no;
	ci_parts_ptr = p_ci_parts_ptr;
	txn_id = dm_data_$current_txn_id;
	txn_index = dm_data_$current_txn_index;

	p_before_image_code = 0;

	my_name = BEFORE_IMAGE_ID;
	return_code_ptr = addr (p_before_image_code);

/* invoke entry protocol common to all before_journal_manager_ */

	on cleanup call EMERGENCY_CLEANUP ();

	call ENTER_BJM ();

/* meter */

	bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_before_image =
	     bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_before_image + 1;

/* validate transaction index and ID */

	call VALIDATE_TRANSACTION ();

/* make the before journal record and write it */

	call WRITE_BEFORE_IMAGE ();

/* go to common wrap up point */

	goto bjm_wrap_up;
%page;
/*
   ************************************************************************
   **********           BEGIN bjm_write$committed_mark             ********
   ************************************************************************
*/
bjm_write$committed_mark:
     entry (p_tid, p_tix, p_commit_code);

/* copy parameters and identify self */

	txn_id = p_tid;
	txn_index = p_tix;

	p_commit_code = 0;

	my_name = COMMIT_ID;
	return_code_ptr = addr (p_commit_code);

/* invoke entry protocol common to all before_journal_manager_ */

	on cleanup call EMERGENCY_CLEANUP ();

	call ENTER_BJM ();

/* meter */

	bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_commit =
	     bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_commit + 1;

/* validate transaction index and ID */

	call VALIDATE_TRANSACTION ();

/* if no record has been written this transaction, then don't now */

	if bj_txte.first_bj_rec_id = ZERO
	then do;
	     bj_txte.ok_to_write = NO;
	     bj_txte.last_completed_operation = COMMITTED;
	     goto bjm_wrap_up;
	end;

/* make the before journal record and write it */

	call WRITE_COMMITTED_MARK ();

/* go to common wrap up point */

	goto bjm_wrap_up;
%page;
/*
   ************************************************************************
   **********           BEGIN bjm_write$rolled_back_mark             ******
   ************************************************************************
*/
bjm_write$rolled_back_mark:
     entry (p_tid, p_tix, p_checkpoint_no, p_rolled_back_code);

/* copy parameters and identify self */

	txn_id = p_tid;
	txn_index = p_tix;
	checkpoint_no = p_checkpoint_no;

	p_rolled_back_code = 0;

	my_name = ROLLED_BACK_ID;
	return_code_ptr = addr (p_rolled_back_code);

/* invoke entry protocol common to all before_journal_manager_ */

	on cleanup call EMERGENCY_CLEANUP ();

	call ENTER_BJM ();

/* meter */

	bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_rb_mark =
	     bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_rb_mark + 1;

/* validate transaction index and ID */

	call VALIDATE_TRANSACTION ();

/* if no record has been written this transaction, then don't now */

	if bj_txte.first_bj_rec_id = ZERO
	     then goto bjm_wrap_up;

/* make the before journal record and write it */

	call WRITE_ROLLED_BACK_MARK ();

/* go to common wrap up point */

	goto bjm_wrap_up;
%page;
/*
   ************************************************************************
   **********        BEGIN bjm_write$fm_rollback_handler         **********
   ************************************************************************
*/
bjm_write$fm_rollback_handler:
     entry (p_fm_uid, p_fm_oid, p_buff_ptr, p_buff_len, p_n_ci_held, p_fr_time_stamp, p_fm_rollback_code);

/* copy parameters and identify self */

	fm_uid = p_fm_uid;
	fm_oid = p_fm_oid;
	buff_ptr = p_buff_ptr;
	buff_len = p_buff_len;
	n_ci_held = p_n_ci_held;
	txn_id = dm_data_$current_txn_id;
	txn_index = dm_data_$current_txn_index;

	p_fm_rollback_code = 0;

	my_name = FM_ROLLBACK_HANDLER_ID;
	return_code_ptr = addr (p_fm_rollback_code);

/* invoke entry protocol common to all before_journal_manager_ */

	on cleanup call EMERGENCY_CLEANUP ();

	call ENTER_BJM ();

/* meter */

	bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_fm_rbh =
	     bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_fm_rbh + 1;

/* validate transaction index and ID */

	call VALIDATE_TRANSACTION ();

/* make then before journal record and write it */

	call WRITE_FM_ROLLBACK_HANDLER ();

/* go to common wrap up point */

	goto bjm_wrap_up;
%page;
/*
   ************************************************************************
   **********        BEGIN bjm_write$fm_postcommit_handler         ********
   ************************************************************************
*/
bjm_write$fm_postcommit_handler:
     entry (p_fm_uid, p_fm_oid, p_buff_ptr, p_buff_len, p_fm_postcommit_code);

/* copy parameters and identify self */

	fm_uid = p_fm_uid;
	fm_oid = p_fm_oid;
	buff_ptr = p_buff_ptr;
	buff_len = p_buff_len;
	txn_id = dm_data_$current_txn_id;
	txn_index = dm_data_$current_txn_index;

	p_fm_postcommit_code = 0;

	my_name = FM_POSTCOMMIT_HANDLER_ID;
	return_code_ptr = addr (p_fm_postcommit_code);

/* invoke entry protocol common to all before_journal_manager_ */

	on cleanup call EMERGENCY_CLEANUP ();

	call ENTER_BJM ();

/* meter */

	bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_fm_pc_mark =
	     bjm_data_$bj_pst_ptr -> bj_pst.meters.n_calls_fm_pc_mark + 1;

/* validate transaction index and ID */

	call VALIDATE_TRANSACTION ();

/* make then before journal record and write it */

	call WRITE_FM_POSTCOMMIT_HANDLER ();

/* go to common wrap up point */

	goto bjm_wrap_up;
%page;
/* standard bjm exit sequence, except to set return code */

bjm_wrap_up:
	bjm_data_$bj_exit_err =
	     bjm_data_$bj_default_error_label;
	bjm_data_$bj_operation = "";

bjm_return:
	return;

bjm_nonlocal_error_exit:
	code = bjm_data_$bj_code;

bjm_local_error_exit:
	return_code = code;
	call EMERGENCY_CLEANUP;
	goto bjm_return;

%page;
/* BEGIN INTERNAL SUPPORT PROCEDURES */

ENTER_BJM:					/* procedure to execute standard */
     procedure ();					/* bjm entry sequence */

	if bjm_data_$bj_operation = ""
	     then bjm_data_$bj_operation = my_name;
	else do;
	     return_code = dm_error_$bj_recursive_invoc;
	     goto bjm_return;
	end;

	bjm_data_$bj_exit_err = bjm_nonlocal_error_exit;
	bjm_data_$bj_code = 0;

	return;

     end ENTER_BJM;
%page;
VALIDATE_TRANSACTION:				/* procedure to insure that state of the */
     procedure ();					/* TXTE is consistent */

/* get to TXT */

	bj_txt_ptr = dm_data_$bj_txt_ptr;

	if bj_txt.version ^= BJ_TXT_VERSION_1
	then do;
	     code = dm_error_$bj_bad_txt_version;
	     goto bjm_local_error_exit;
	end;

/* validate transaction identifiers */

	if txn_index < 1 | txn_index > dm_system_data_$max_n_transactions | txn_id = ZERO
	then do;
	     code = dm_error_$no_current_transaction;
	     goto bjm_local_error_exit;
	end;

/* get to TXTE */

	bj_txte_ptr = addr (bj_txt.entry (txn_index));

/* see if a write is pending */

	if bj_txte.append_state.current_operation ^= ""
	     then call bj_txte_util$synchronize_txte_pste (bj_txte_ptr);

	if bj_txte.tid ^= txn_id
	then do;
	     if bj_txte.tid ^= ZERO
		then code = dm_error_$bj_bad_tid;
	     else code = dm_error_$no_current_transaction;
	     goto bjm_local_error_exit;
	end;

/* have we been called by transaction_manager_ for the same operation twice? */

	if bj_txte.entry_state.ok_to_write = NO
	then do;
	     if my_name = COMMIT_ID
		then if bj_txte.last_completed_operation = COMMITTED
		     then code = 0;
		else code = dm_error_$bj_cant_commit;
	     else if my_name = ABORT_ID
		then if bj_txte.last_completed_operation = ABORTED
		     then code = 0;
		else code = dm_error_$bj_cant_abort;
	     else code = dm_error_$no_current_transaction;

	     goto bjm_local_error_exit;
	end;

/* after all is fine, find the PPTE */

	bj_ppte_ptr = bj_txte.ppte_ptr;

	return;

     end VALIDATE_TRANSACTION;
%page;
INITIALIZE_TRANSACTION:				/* procedure to  fill txte for new transaction */
     procedure ();

	bj_txt_ptr = dm_data_$bj_txt_ptr;
	bj_txte_ptr = addr (bj_txt.entry (txn_index));
	bj_ppte_ptr = bj_oid_util$get_ptr (bj_oid);

	bj_txte.tid = ZERO;
	bj_txte.bj_uid = bj_ppte.bj_uid;

	bj_txte.entry_state.ok_to_write = NO;

	bj_txte.owner_info.process_id = bjm_data_$bj_ppt_ptr -> bj_ppt.process_id;

	bj_txte.operator_info.process_id = bj_txte.owner_info.process_id;
	bj_txte.operator_info.ppte_ptr = bj_ppte_ptr;
	bj_txte.operator_info.bj_oid = bj_oid;		/* bj_oid must come from parameters */

	unspec (bj_txte.records_info) = ""b;

	bj_txte.append_state.current_operation = "";

	bj_txte.tid = txn_id;
	bj_txte.entry_state.last_completed_operation = BEGIN_MARK;
	bj_txte.entry_state.ok_to_write = YES;

	return;

     end INITIALIZE_TRANSACTION;
%page;
WRITE_ABORTED_MARK:					/* procedure to format aborted mark and */
     procedure ();					/* forward it for writing in the journal */

dcl  1 my_bj_aborted_record	        aligned like bj_aborted_rec; /* local copy of aborted mark */

	bj_rec_hdr_ptr = addr (my_bj_aborted_record);

	bj_aborted_rec.type = BJ_RECORD_TYPE.ABORTED;
	bj_aborted_rec.tid = txn_id;
	bj_aborted_rec.process_id = bj_txte.owner_info.process_id;
	bj_aborted_rec.prev_rec_id = bj_txte.last_bj_rec_id;
	bj_aborted_rec.tx_rec_no = bj_txte.n_rec_written + 1;
	n_rec_bytes = size (my_bj_aborted_record) * 4;

	bj_txte.append_state.pending_bj_rec_id = ZERO;
	bj_txte.append_state.pending_n_rec_written = bj_txte.records_info.n_rec_written + 1;
	bj_txte.append_state.pending_n_bytes_written = bj_txte.records_info.n_bytes_written + n_rec_bytes;

	call APPEND (addr (my_bj_aborted_record), n_rec_bytes, -1, 0);
	call bj_txte_util$aborted_mark (bj_txte_ptr);

	return;

     end WRITE_ABORTED_MARK;
%page;
WRITE_BEFORE_IMAGE:					/* procedure to format a before image and */
     procedure ();					/* forward it for writing in the journal */

dcl  default_bj_before_image_space    aligned char (1024);	/* space to build small before image */
dcl  part_no		        fixed bin;		/* ci part number */
dcl  part_len		        fixed bin;		/* length of one ci_part, used for based variable one_ci_part */
dcl  one_ci_part		        char (part_len) based;/* image of the ci_part provided via parameters */

/* if the before image is small enough, we will make it here; if not, grow a frame in which to put it */

	bj_rec_hdr_ptr = addr (default_bj_before_image_space);
	bj_before_image.n_parts = 1;			/* do this so next statement won't blow up */

	n_rec_bytes = (bin (rel (addr (bj_before_image.part (1)))) -
	     bin (rel (bj_rec_hdr_ptr))) * 4;		/* length of constant portion of before image record in bytes */

	do part_no = 1 to ci_parts_ptr -> ci_parts.number_of_parts;
	     n_rec_bytes = n_rec_bytes + 8 + ci_parts_ptr -> ci_parts.part (part_no).length_in_bytes;
						/* 8 = length of part.offset and part.length */
	end;

/* determine effect of adding this image to journal upon n_txn in journal */

	if bj_txte.last_bj_rec_id = ZERO
	     then delta_txn = 1;
	else delta_txn = 0;

/* see if there is enough space in the internal buffer for the before image */

	if n_rec_bytes > 1024
	then do;					/* the bj_before_image_rec will be too big for default space */

MAKE_LARGE_BEFORE_IMAGE:
	     begin;				/* push a stack frame with enough room for before image */

dcl  bj_before_image_space	        aligned char (n_rec_bytes);

		bj_rec_hdr_ptr = addr (bj_before_image_space);

		call FILL_BEFORE_IMAGE ();

		bj_txte.append_state.pending_bj_rec_id = ZERO;
		bj_txte.append_state.pending_n_rec_written = bj_txte.records_info.n_rec_written + 1;
		bj_txte.append_state.pending_n_bytes_written = bj_txte.records_info.n_bytes_written + n_rec_bytes;

		call APPEND (bj_rec_hdr_ptr, n_rec_bytes, delta_txn, 1);
		call bj_txte_util$before_image (bj_txte_ptr);

	     end MAKE_LARGE_BEFORE_IMAGE;

	end;

	else do;

	     call FILL_BEFORE_IMAGE ();

	     bj_txte.append_state.pending_bj_rec_id = ZERO;
	     bj_txte.append_state.pending_n_rec_written = bj_txte.records_info.n_rec_written + 1;
	     bj_txte.append_state.pending_n_bytes_written = bj_txte.records_info.n_bytes_written + n_rec_bytes;

	     call APPEND (bj_rec_hdr_ptr, n_rec_bytes, delta_txn, 1);
	     call bj_txte_util$before_image (bj_txte_ptr);

	end;

/* more meters - here because the quantities are easiest obtained at this point */

	bj_pste_ptr = bj_ppte.bj_pste_ptr;
	bj_pste.meters.n_bi_written = bj_pste.meters.n_bi_written + 1;
	bj_pste.meters.n_bi_bytes_written = bj_pste.meters.n_bi_bytes_written + n_rec_bytes;

	p_bi_time_stamp = time_stamp;

	return;

FILL_BEFORE_IMAGE:
	procedure ();

	     bj_before_image.header.type = BJ_RECORD_TYPE.BEFORE_IMAGE;
	     bj_before_image.header.tid = txn_id;
	     bj_before_image.header.process_id = bj_txte.owner_info.process_id;
	     bj_before_image.header.prev_rec_id = bj_txte.last_bj_rec_id;
	     bj_before_image.header.tx_rec_no = bj_txte.n_rec_written + 1;

	     bj_before_image.fm_uid = fm_uid;
	     bj_before_image.fm_oid = fm_oid;
	     bj_before_image.ci_no = ci_no;
	     bj_before_image.n_parts = ci_parts_ptr -> ci_parts.number_of_parts;

	     bj_before_image.image_len = 0;		/* initialize running size of before image */

	     do part_no = 1 to ci_parts_ptr -> ci_parts.number_of_parts;
		bj_before_image.part (part_no).byte_offset = ci_parts_ptr -> ci_parts.part (part_no).offset_in_bytes;
		part_len = ci_parts_ptr -> ci_parts.part (part_no).length_in_bytes;
		bj_before_image.part (part_no).byte_length = part_len;
		bj_before_image_len = bj_before_image.image_len + 1;
						/* set this value for use in string copying later */
		bj_before_image.image_len = bj_before_image.image_len + part_len;
						/* set this value to indicate the actual running size */
		substr (bj_before_image.image, bj_before_image_len, part_len) =
		     ci_parts_ptr -> ci_parts.part (part_no).local_ptr -> one_ci_part;
						/* make a copy of the ci_part.  notice that */
						/* bj_before_image_len is not being used */
						/* as the declarations imply */
	     end;

	     return;

	end FILL_BEFORE_IMAGE;

     end WRITE_BEFORE_IMAGE;
%page;
WRITE_COMMITTED_MARK:
     procedure ();

/* Procedure to format a committed mark and forward it for	*/
/* writing in the before journal.  If we have written a	*/
/* BEGIN_COMMIT mark, then we simply call		*/
/* bj_txte_util$complex_commit and be done with it.	*/
/* Otherwise we see if we need to write a BEGIN_COMMIT or	*/
/* simply a COMMIT and then call bj_txte_util.		*/

dcl  1 my_bj_committed_record	        aligned like bj_committed_rec;
dcl  commit_mark_delta_txn	        fixed bin;		/* Effect on number of transactions in journal: */
						/* -1 for COMMIT means reduces number by 1,     */
						/* 0 for BEGIN_COMMIT means has no effect.      */

	bj_rec_hdr_ptr = addr (my_bj_committed_record);

	if bj_txte.last_completed_operation = BJ_RECORD_TYPE.BEGIN_COMMIT then
	     call bj_txte_util$complex_commit (bj_txte_ptr);
	else
DO_COMPLETE_COMMIT_MARK_OPERATION: do;
	     if bj_txte.last_fm_postcommit_handler_rec_id = ZERO
	     then do;
		bj_committed_rec.type = BJ_RECORD_TYPE.COMMITTED;
		commit_mark_delta_txn = -1;
	     end;
	     else do;
		bj_committed_rec.type = BJ_RECORD_TYPE.BEGIN_COMMIT;
		commit_mark_delta_txn = 0;
	     end;
	     bj_committed_rec.tid = txn_id;
	     bj_committed_rec.process_id = bj_txte.owner_info.process_id;
	     bj_committed_rec.prev_rec_id = bj_txte.last_bj_rec_id;
	     bj_committed_rec.tx_rec_no = bj_txte.n_rec_written + 1;
	     n_rec_bytes = size (my_bj_committed_record) * 4;

	     bj_txte.append_state.pending_bj_rec_id = ZERO;
	     bj_txte.append_state.pending_n_rec_written = bj_txte.records_info.n_rec_written + 1;
	     bj_txte.append_state.pending_n_bytes_written = bj_txte.records_info.n_bytes_written + n_rec_bytes;

	     call APPEND (addr (my_bj_committed_record), n_rec_bytes, commit_mark_delta_txn, 0);
	     if bj_txte.last_fm_postcommit_handler_rec_id = ZERO
		then call bj_txte_util$simple_commit (bj_txte_ptr);
	     else call bj_txte_util$complex_commit (bj_txte_ptr);

	end DO_COMPLETE_COMMIT_MARK_OPERATION;


	return;

     end WRITE_COMMITTED_MARK;
%page;
WRITE_ROLLED_BACK_MARK:				/* procedure to format rolled_back mark and */
     procedure ();					/* forward it for writing in the journal */

dcl  1 my_bj_rolled_back_record       aligned like bj_rolled_back_rec; /* local copy of rolled_back mark */

	bj_rec_hdr_ptr = addr (my_bj_rolled_back_record);

	bj_rolled_back_rec.type = BJ_RECORD_TYPE.ROLLED_BACK;
	bj_rolled_back_rec.tid = txn_id;
	bj_rolled_back_rec.process_id = bj_txte.owner_info.process_id;
	bj_rolled_back_rec.prev_rec_id = bj_txte.curr_checkpoint_rec_id;
	bj_rolled_back_rec.checkpoint_no = 0;
	bj_rolled_back_rec.last_rolled_back_rec_id = bj_txte.last_bj_rec_id;
	bj_rolled_back_rec.tx_rec_no = 1;		/* must calculate this when checkpoints are implemented */
	n_rec_bytes = size (my_bj_rolled_back_record) * 4;

	bj_txte.append_state.pending_bj_rec_id = ZERO;
	bj_txte.append_state.pending_n_rec_written = 1;
	bj_txte.append_state.pending_n_bytes_written = n_rec_bytes;

	call APPEND (addr (my_bj_rolled_back_record), n_rec_bytes, 0, 0);
	call bj_txte_util$rolled_back_mark (bj_txte_ptr);

	return;

     end WRITE_ROLLED_BACK_MARK;
%page;
WRITE_FM_ROLLBACK_HANDLER:				/* procedure to format fm rollback handler mark and */
     procedure ();					/* forward it for writing in the journal */

dcl  handler_buffer		        aligned char (512);
dcl  info_buffer		        char (buff_len) based (buff_ptr);
dcl  fm_rollback_delta_n_txn	        fixed bin;

	if bj_txte.last_bj_rec_id = ZERO
	     then fm_rollback_delta_n_txn = 1;
	else fm_rollback_delta_n_txn = 0;

	bj_rec_hdr_ptr = addr (handler_buffer);

	bj_fm_handler_rec.type = BJ_RECORD_TYPE.FM_ROLLBACK_HANDLER;
	bj_fm_handler_rec.tid = txn_id;
	bj_fm_handler_rec.process_id = bj_txte.owner_info.process_id;
	bj_fm_handler_rec.prev_rec_id = bj_txte.last_bj_rec_id;
	bj_fm_handler_rec.prev_rec_byte_size = 0;	/* not used */
	bj_fm_handler_rec.tx_rec_no = bj_txte.n_rec_written + 1;

	bj_fm_handler_rec.fm_uid = fm_uid;
	bj_fm_handler_rec.fm_oid = fm_oid;
	bj_fm_handler_rec.prev_fm_handler_rec_id = ZERO;
	bj_fm_handler_rec.info_len = buff_len;

	bj_fm_handler_rec.info_bytes = buff_ptr -> info_buffer;

	n_rec_bytes = (size (bj_rec_hdr) * 4) +
	     16 +					/* size of constant portion of bj_fm_handler */
	     buff_len;

	bj_txte.append_state.pending_bj_rec_id = ZERO;
	bj_txte.append_state.pending_n_rec_written = bj_txte.records_info.n_rec_written + 1;
	bj_txte.append_state.pending_n_bytes_written = bj_txte.records_info.n_bytes_written + n_rec_bytes;

	call APPEND (bj_rec_hdr_ptr, n_rec_bytes, fm_rollback_delta_n_txn, n_ci_held);
	call bj_txte_util$fm_rollback_handler (bj_txte_ptr);

	p_fr_time_stamp = time_stamp;

	return;

     end WRITE_FM_ROLLBACK_HANDLER;
%page;
WRITE_FM_POSTCOMMIT_HANDLER:				/* procedure to format fm postcommit handler mark and */
     procedure ();					/* forward it for writing in the journal */

dcl  handler_buffer		        aligned char (512);
dcl  info_buffer		        char (buff_len) based (buff_ptr);
dcl  fm_postcommit_delta_n_txn        fixed bin;

	if bj_txte.last_bj_rec_id = ZERO
	     then fm_postcommit_delta_n_txn = 1;
	else fm_postcommit_delta_n_txn = 0;

	bj_rec_hdr_ptr = addr (handler_buffer);

	bj_fm_handler_rec.type = BJ_RECORD_TYPE.FM_POSTCOMMIT_HANDLER;
	bj_fm_handler_rec.tid = txn_id;
	bj_fm_handler_rec.process_id = bj_txte.owner_info.process_id;
	bj_fm_handler_rec.prev_rec_id = bj_txte.last_bj_rec_id;
	bj_fm_handler_rec.prev_rec_byte_size = 0;	/* not used */
	bj_fm_handler_rec.tx_rec_no = bj_txte.n_rec_written + 1;

	bj_fm_handler_rec.fm_uid = fm_uid;
	bj_fm_handler_rec.fm_oid = fm_oid;
	bj_fm_handler_rec.prev_fm_handler_rec_id = bj_txte.records_info.last_fm_postcommit_handler_rec_id;
	bj_fm_handler_rec.info_len = buff_len;

	bj_fm_handler_rec.info_bytes = buff_ptr -> info_buffer;

	n_rec_bytes = (size (bj_rec_hdr) * 4) +
	     16 +					/* size of constant portion of bj_fm_handler */
	     buff_len;

/* bj_txte.append_state was verified quiesed previously: use it without checking */

	bj_txte.append_state.pending_bj_rec_id = ZERO;
	bj_txte.append_state.pending_n_rec_written = bj_txte.records_info.n_rec_written + 1;
	bj_txte.append_state.pending_n_bytes_written = bj_txte.records_info.n_bytes_written + n_rec_bytes;

	call APPEND (bj_rec_hdr_ptr, n_rec_bytes, fm_postcommit_delta_n_txn, 0);
	call bj_txte_util$fm_postcommit_handler (bj_txte_ptr);

	return;

     end WRITE_FM_POSTCOMMIT_HANDLER;
%page;
APPEND:						/* procedure to write a record in the before journal */
     procedure (p_rec_ptr, p_n_bytes, p_delta_txn, p_delta_image);

dcl  p_rec_ptr		        pointer;		/* points to record to be written */
dcl  p_n_bytes		        fixed bin;		/* size of record in bytes */
dcl  p_delta_txn		        fixed bin;		/* effect this record has on number of txn in journal */
dcl  p_delta_image		        fixed bin (27);	/* change in number of before images when record written */

/* change append_state to WRITE_PENDING by setting current_operation */

	bj_txte.append_state.current_operation = p_rec_ptr -> bj_rec_hdr.type;

/* call upon external service routine to change append_state */

	call bj_storage_append (bj_txte.bj_oid, p_rec_ptr, p_n_bytes,
	     p_delta_txn, p_delta_image,
	     bj_txte.append_state.pending_bj_rec_id, time_stamp);

	return;

     end APPEND;

EMERGENCY_CLEANUP:					/* procedure to reset bjm static storage */
     procedure ();

dcl  cleanup_code		        fixed bin (35);	/* local status code */

	call bj_cleanup_tables$handler (cleanup_code);

	bjm_data_$bj_operation = "";
	bjm_data_$bj_exit_err =
	     bjm_data_$bj_default_error_label;

	return;

     end EMERGENCY_CLEANUP;

%page;

/* DECLARATIONS */

/* Parameters - see description in program header comments */

dcl  p_tid		        bit (36) aligned parameter;
dcl  p_tix		        fixed bin parameter;
dcl  p_bj_oid		        bit (36) aligned parameter;
dcl  p_checkpoint_no	        fixed bin (35) parameter;
dcl  p_fm_uid		        bit (36) aligned parameter;
dcl  p_fm_oid		        bit (36) aligned parameter;
dcl  p_ci_no		        fixed bin (24) unsigned parameter;
dcl  p_ci_parts_ptr		        pointer parameter;
dcl  p_buff_ptr		        pointer parameter;
dcl  p_buff_len		        fixed bin parameter;
dcl  p_n_ci_held		        fixed bin (27) parameter;
dcl  p_bi_time_stamp	        fixed bin (71) parameter;
dcl  p_fr_time_stamp	        fixed bin (71) parameter;
dcl  p_abort_code		        fixed bin (35) parameter;
dcl  p_before_image_code	        fixed bin (35) parameter;
dcl  p_begin_code		        fixed bin (35) parameter;
dcl  p_commit_code		        fixed bin (35) parameter;
dcl  p_rolled_back_code	        fixed bin (35) parameter;
dcl  p_fm_rollback_code	        fixed bin (35) parameter;
dcl  p_fm_postcommit_code	        fixed bin (35) parameter;

/* Automatic */

dcl  txn_id		        bit (36) aligned;	/* copy of parameter */
dcl  txn_index		        fixed bin;		/* copy of parameter */
dcl  bj_oid		        bit (36) aligned;	/* copy of parameter */
dcl  checkpoint_no		        fixed bin (35);	/* copy of parameter */
dcl  fm_uid		        bit (36) aligned;	/* copy of parameter */
dcl  fm_oid		        bit (36) aligned;	/* copy of parameter */
dcl  ci_no		        fixed bin (24) unsigned; /* copy of parameter */
dcl  buff_ptr		        pointer;		/* copy of parameter */
dcl  buff_len		        fixed bin;		/* copy of parameter */
dcl  n_ci_held		        fixed bin (27);	/* copy of parameter */
dcl  time_stamp		        fixed bin (71);	/* copy of parameter */
dcl  code			        fixed bin (35);	/* local status code */
dcl  my_name		        char (32);		/* ID of operation */
dcl  return_code_ptr	        pointer;		/* pointer to current return code, set at each entrypoint */
dcl  n_rec_bytes		        fixed bin;		/* number of bytes in record, including header */
dcl  delta_txn		        fixed bin;		/* change in number of transaction in journal */

/* Static, External */

dcl  dm_data_$current_txn_id	        bit (36) aligned external static;
dcl  dm_data_$current_txn_index       fixed bin external static;
dcl  dm_data_$bj_txt_ptr	        pointer external static;
dcl  bjm_data_$bj_ppt_ptr	        pointer external static;
dcl  bjm_data_$bj_pst_ptr	        pointer external static;
dcl  dm_error_$no_current_transaction fixed bin (35) external static;
dcl  dm_error_$bj_bad_txt_version     fixed bin (35) external static;
dcl  dm_error_$bj_bad_tid	        fixed bin (35) external static;
dcl  dm_error_$bj_recursive_invoc     fixed bin (35) external static;
dcl  dm_error_$bj_cant_abort	        fixed bin (35) external static;
dcl  dm_error_$bj_cant_commit	        fixed bin (35) external static;

/* Based */

dcl  return_code		        fixed bin (35) based (return_code_ptr); /* overlays parameter return codes */

/* Constant */

dcl  ABORT_ID		        char (32) internal static options (constant)
			        init ("write_aborted_mark");
dcl  BEFORE_IMAGE_ID	        char (32) internal static options (constant)
			        init ("write_before_image");
dcl  BEGIN_ID		        char (32) internal static options (constant)
			        init ("write_begin_mark");
dcl  COMMIT_ID		        char (32) internal static options (constant)
			        init ("write_committed_mark");
dcl  ROLLED_BACK_ID		        char (32) internal static options (constant)
			        init ("write_rolled_back_mark");
dcl  FM_ROLLBACK_HANDLER_ID	        char (32) internal static options (constant)
			        init ("write_fm_rollback_handler");
dcl  FM_POSTCOMMIT_HANDLER_ID	        char (32) internal static options (constant)
			        init ("write_fm_postcommit_handler");
dcl  ZERO			        bit (36) aligned internal static options (constant)
			        init ((36)"0"b);
dcl  YES			        bit (1) aligned internal static options (constant)
			        init ("1"b);
dcl  NO			        bit (1) aligned internal static options (constant)
			        init ("0"b);

/* Entry */

dcl  before_journal_manager_$get_default_bj entry (bit (36) aligned, fixed bin (35));
dcl  bj_storage_append	        entry (bit (36) aligned, ptr, fixed bin, fixed bin, fixed bin (27), bit (36) aligned, fixed bin (71));
dcl  bj_cleanup_tables$handler        entry (fixed bin (35));
dcl  bj_oid_util$get_ptr	        entry (bit (36) aligned) returns (ptr);
dcl  bj_txte_util$synchronize_txte_pste entry (ptr);
dcl  bj_txte_util$before_image        entry (ptr);
dcl  bj_txte_util$aborted_mark        entry (ptr);
dcl  bj_txte_util$simple_commit       entry (ptr);
dcl  bj_txte_util$complex_commit      entry (ptr);
dcl  bj_txte_util$rolled_back_mark    entry (ptr);
dcl  bj_txte_util$fm_rollback_handler entry (ptr);
dcl  bj_txte_util$fm_postcommit_handler entry (ptr);

/* Builtin */

dcl  addr			        builtin;
dcl  bin			        builtin;
dcl  rel			        builtin;
dcl  size			        builtin;
dcl  substr		        builtin;
dcl  unspec		        builtin;

/* Condition */

dcl  cleanup		        condition;

/* Include Files */

%page;
%include dm_bj_global_error_info;
%page;
%include dm_bj_ppt;
%page;
%include dm_bj_txt;
%page;
%include dm_bj_static;
%page;
%include dm_bj_records;
%page;
%include dm_ci_parts;
%page;
%include dm_bj_pst;
%page;
%include dm_bj_pste;
%page;

     end bjm_write$begin_mark;




		    dm_admin_sched_shutdown.pl1     04/24/85  1017.5re  04/24/85  0803.8       72396



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

/* DESCRIPTION:

        This  routine schedules a Data Management shutdown on behalf of a DM
   administrator or operator.  It is the data-management-ring portion of the
   dm_system_shutdown  command  and  the  Data_Management  daemon   shutdown
   request.      Expected   as  input  are  a  pointer  to  a  shutdown_spec
   (p_shutdown_spec_ptr) containing the reason, times and  delays  specified
   by  the  caller of the command/request,  and a pointer to a shutdown_info
   structure (p_shutdown_info_ptr).  The shutdown_info.version must be  set,
   but  otherwise  the  structure  is  used  to  return  information.    The
   shutdown_info structure, on return, contains the reason  and  a  complete
   set  of  times.,  as well as output flags indicating whether there was an
   error (no_time_specified is ON) and whether  any  of  the  administrative
   times  were  used to re-schedule the current shutdown (times_have_changed
   is ON).

   The algorithm used by this routine is as follows:
   
   1) Calculate a complete set of times from the times and delays specified
   by the admnistrator.
   
   2) If no times could be calculated because there was both no
   administrator-specified time and no Multics shutdown time currently
   scheduled, return a shutdown_info with all times equal to 0 and
   output_flags.no_time_specified set to on.
   
   Otherwise,
   
   3) Select a set of times by:
      3.1) Calculating the default times based on the scheduled Multics
           shutdown time;
      3.2) If there is no Multics shutdown time currently scheduled
           (multics_shutdown_info.output_flags.no_time_specified is on),
           select the administrative times as the times for the new DM
           shutdown;
      3.3) Otherwise, compare the administrative and Multics times,
           selecting the earlier of each time, to create the resultant set
           of times for the new DM shutdown.

   4) Save the administrative times in dm_system_data_.

   5) If any of the administrative times were selected (indicated by
      resultant_shutdown_info.output_flags.times_have_changed being on)
      alert the Data Management daemon to actually schedule the new DM
      shutdown.  Otherwise, don't bother the daemon, as the current
      shutdown should not be changed.
   
   6) Return to the caller the resultant times.
*/

/* HISTORY:

Written by Matthew C. Pierret, 09/13/84.
Modified:
09/27/84 by Lee A. Newcomb:  Saved admin shutdown reason in dm_system_data_
	  and fixed sending shutdown request to Daemon.
02/19/85 by Lee A. Newcomb:  Fixed to copy the ptr parameters and the
            structures they locate before validating the structure versions.
*/

/* format: style2,ind3 */
/* format: ll79,comcol50,^indprocbody,^indnoniterdo,indnoniterend */

dm_admin_sched_shutdown:
   proc (p_shutdown_spec_ptr, p_shutdown_info_ptr);

/* START OF DECLARATIONS */
/* Parameter */

   dcl	 p_shutdown_spec_ptr    ptr;	         /*points to a shutdown_spec.*/
   dcl	 p_shutdown_info_ptr    ptr;	         /*points to a shutdown_info.*/

/* Automatic */

   dcl	 1 admin_shutdown_info  aligned like shutdown_info;
   dcl	 1 admin_shutdown_spec  aligned like shutdown_spec;
   dcl	 1 multics_shutdown_info
			    aligned like shutdown_info;
   dcl	 1 multics_shutdown_spec
			    aligned like shutdown_spec;
   dcl	 1 resultant_shutdown_info
			    aligned like shutdown_info;

/* Based */
/* Builtin */

   dcl	 (addr, null, unspec)   builtin;

/* Constant */

   dcl	 myname		    char (32) varying
			    init ("dm_admin_sched_shutdown")
			    internal static options (constant);

/* Entry */

   dcl	 dm_compare_shutdown_info
			    entry (ptr, ptr, ptr);
   dcl	 dm_process_shutdown_spec
			    entry (ptr, ptr);
   dcl	 dm_send_request_$shutdown
			    entry (fixed bin (35));
   dcl	 sub_err_		    entry () options (variable);

/* External */

   dcl	 (
	 dm_system_data_$saved_user_warning_time,
	 dm_system_data_$saved_begin_shutdown_time,
	 dm_system_data_$saved_user_shutdown_time,
	 dm_system_data_$saved_user_bump_time,
	 dm_system_data_$saved_daemon_logout_time
	 )		    fixed bin (71) ext;
   dcl	 dm_system_data_$saved_shutdown_reason
			    char (64) ext;
   dcl	 error_table_$unimplemented_version
			    fixed bin (35) ext;

/* END OF DECLARATIONS */
%page;
COPY_PARAMETERS:
   do;
      shutdown_spec_ptr = p_shutdown_spec_ptr;
      shutdown_info_ptr = p_shutdown_info_ptr;
      admin_shutdown_spec = shutdown_spec;
      resultant_shutdown_info.version = shutdown_info.version;
				         /* all we need for the info structure */
   end COPY_PARAMETERS;

   call CHECK_VERSION (admin_shutdown_spec.version, SHUTDOWN_SPEC_VERSION_1,
        "shutdown_spec");
   call CHECK_VERSION (resultant_shutdown_info.version,
        SHUTDOWN_INFO_VERSION_1, "shutdown_info");

   unspec (admin_shutdown_info) = ""b;
   admin_shutdown_info.version = SHUTDOWN_INFO_VERSION_1;

   unspec (multics_shutdown_spec) = ""b;
   multics_shutdown_spec.version = SHUTDOWN_SPEC_VERSION_1;
   unspec (multics_shutdown_info) = ""b;
   multics_shutdown_info.version = SHUTDOWN_INFO_VERSION_1;

   unspec (resultant_shutdown_info) = ""b;
   resultant_shutdown_info.version = SHUTDOWN_INFO_VERSION_1;

   call dm_process_shutdown_spec (addr (admin_shutdown_spec),
        addr (admin_shutdown_info));

   if admin_shutdown_info.output_flags.no_time_specified
   then p_shutdown_info_ptr -> shutdown_info = admin_shutdown_info;
   else
      do;
      call dm_process_shutdown_spec (addr (multics_shutdown_spec),
	 addr (multics_shutdown_info));
      if multics_shutdown_info.output_flags.no_time_specified
      then
TAKE_ADMIN_TIMES:
         do;
         resultant_shutdown_info = admin_shutdown_info;
         resultant_shutdown_info.output_flags.times_have_changed = "1"b;
         end TAKE_ADMIN_TIMES;
      else
TAKE_EARLIER_TIMES:
         do;
         call dm_compare_shutdown_info (addr (multics_shutdown_info),
	    addr (admin_shutdown_info), addr (resultant_shutdown_info));
         end TAKE_EARLIER_TIMES;
%page;
SET_SAVED_ADMIN_SHUTDOWN_TIMES_AND_REASON:
      do;
         dm_system_data_$saved_user_warning_time =
	    admin_shutdown_info.times.user_warning_time;
         dm_system_data_$saved_begin_shutdown_time =
	    admin_shutdown_info.times.begin_shutdown_time;
         dm_system_data_$saved_user_shutdown_time =
	    admin_shutdown_info.times.user_shutdown_time;
         dm_system_data_$saved_user_bump_time =
	    admin_shutdown_info.times.user_bump_time;
         dm_system_data_$saved_daemon_logout_time =
	    admin_shutdown_info.times.daemon_logout_time;
         dm_system_data_$saved_shutdown_reason = admin_shutdown_info.reason;
      end SET_SAVED_ADMIN_SHUTDOWN_TIMES_AND_REASON;

      if resultant_shutdown_info.output_flags.times_have_changed
      then call dm_send_request_$shutdown ((0));
      else /* actual shutdown schedule is unchanged */
	 ;

      p_shutdown_info_ptr -> shutdown_info = resultant_shutdown_info;

      end;

   return;

/* end dm_admin_sched_shutdown; */
%page;
CHECK_VERSION:
   proc (cv_p_received_version, cv_p_expected_version, cv_p_structure_name);

   dcl	 cv_p_received_version  char (8) aligned;
   dcl	 cv_p_expected_version  char (8) aligned;
   dcl	 cv_p_structure_name    char (*);

   if cv_p_received_version ^= cv_p_expected_version
   then call sub_err_ (error_table_$unimplemented_version, myname,
	   ACTION_CANT_RESTART, null, 0,
	   "^/Expected version ^a of the ^a structure.
Received version ^d instead.", cv_p_expected_version, cv_p_structure_name,
	   cv_p_received_version);

   end CHECK_VERSION;
%page;
%include dm_shutdown_spec;
%page;
%include sub_err_flags;
   end dm_admin_sched_shutdown;




		    dm_compare_shutdown_info.pl1    03/06/85  0801.3re  03/05/85  0758.4       65007



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

/* DESCRIPTION:

         This  routine  compares  two shutdown_info structures, pointed to by
     p_shutdown_info_1_ptr and p_shutdown_info_2_ptr,  returning  a  resultant
     shutdown_info  structure  pointed  to  by  p_resultant_shutdown_info_ptr.
     p_resultant_shutdown_info_ptr is an input argument, so  the  caller  must
     have  set it to point to an empty shutdown_info structure in the caller's
     address space.  For each time in shutdown_info, the earlier  of  the  two
     input times is taken as the resultant time.  If any of the times in times
     p_shutdown_info_2_ptr->shutdown_info    is   taken,   the   output   flag
     times_have_changed  is  set  to  "1"b.   In  many  comparisons, the first
     shutdown_info  will  have the times calculated from the Multics down time
     and the second will be administratively requested times.

	This  module  is  used by both the administrative shutdown interface
     and   the  Daemon  shutdown  scheduling  interface.   The  administrative
     interface  will  always have p_shutdown_info_2_ptr locate a shutdown_info
     structure  will  non-zero  times.   The  flag  times_have_changed  in the
     resultant structure is only meaningful in this side of DMS shutdown.  The
     Daemon  interface may supply a first shutdown_info with times set or not,
     the  second  shutdown_info  with  times  set  or  not, in any of the four
     combinations  possible.  The no_time_specified flag may be set on if both
     input shutdown_infos' have zero times; the times_have_changed flag is not
     meaningful to the Daemon interface.  This method was used to keep as much
     of the shutdown time comparisons in one place as possible.

*/

/* HISTORY:

Written by Matthew C. Pierret, 09/11/84.
Modified:
10/02/84 by Lee A. Newcomb:  allowed handling of all four possible
	  combinations of shutdown_info times: 0:0, >0:0, 0:>0, and >0:>0,
	  so the Daemon shutdown scheduling modules may use this module.
*/

/* format: style2,ind3,^indprocbody,indnoniterend,^indnoniterdo */
/* format: ll79,comcol50 */

dm_compare_shutdown_info:
   proc (p_shutdown_info_1_ptr, p_shutdown_info_2_ptr,
        p_resultant_shutdown_info_ptr);

/* START OF DECLARATIONS */
/* Parameter */

   dcl	 p_shutdown_info_1_ptr  ptr;	         /*points to first shutdown_info.*/
   dcl	 p_shutdown_info_2_ptr  ptr;	         /*points to the second shutdown_info*/
   dcl	 p_resultant_shutdown_info_ptr
			    ptr;	         /*points to the resultant shutdown_info.*/

/* Automatic */

   dcl	 shutdown_info_1_ptr    ptr;
   dcl	 shutdown_info_2_ptr    ptr;
   dcl	 resultant_shutdown_info_ptr
			    ptr;

/* Based */
/* Builtin */

   dcl	 (null, unspec)	    builtin;

/* Constant */

   dcl	 myname		    init ("dm_compare_shutdown_info")
			    char (32) varying internal static
			    options (constant);

/* Entry */

   dcl	 sub_err_		    entry () options (variable);

/* External */

   dcl	 error_table_$unimplemented_version
			    ext fixed bin (35);

/* END OF DECLARATIONS */
%page;
   shutdown_info_1_ptr = p_shutdown_info_1_ptr;
   shutdown_info_2_ptr = p_shutdown_info_2_ptr;
   resultant_shutdown_info_ptr = p_resultant_shutdown_info_ptr;

   call CHECK_VERSION (shutdown_info_1_ptr -> shutdown_info.version,
        SHUTDOWN_INFO_VERSION_1, "shutdown_info");
   call CHECK_VERSION (shutdown_info_2_ptr -> shutdown_info.version,
        SHUTDOWN_INFO_VERSION_1, "shutdown_info");
   call CHECK_VERSION (resultant_shutdown_info_ptr -> shutdown_info.version,
        SHUTDOWN_INFO_VERSION_1, "shutdown_info");

   if unspec (shutdown_info_1_ptr -> shutdown_info.times) = ""b
   then
TAKE_LATTER:			         /* 0:>0 or 0:0 case */
      resultant_shutdown_info_ptr -> shutdown_info.times =
	 shutdown_info_2_ptr -> shutdown_info.times;
   else if unspec (shutdown_info_2_ptr -> shutdown_info.times) = ""b
   then
TAKE_FORMER:			         /* >0:0 case */
      resultant_shutdown_info_ptr -> shutdown_info.times =
	 shutdown_info_1_ptr -> shutdown_info.times;
   else
TAKE_LESSER:			         /* >0:>0 case */
      do;				         /* format: off */
      resultant_shutdown_info_ptr -> shutdown_info.times.user_warning_time =
	    min (
              shutdown_info_1_ptr -> shutdown_info.times.user_warning_time,
	    shutdown_info_2_ptr -> shutdown_info.times.user_warning_time);

      resultant_shutdown_info_ptr -> shutdown_info.times.begin_shutdown_time =
	    min (
              shutdown_info_1_ptr -> shutdown_info.times.begin_shutdown_time,
	    shutdown_info_2_ptr -> shutdown_info.times.begin_shutdown_time);

      resultant_shutdown_info_ptr -> shutdown_info.times.user_shutdown_time =
	    min (
              shutdown_info_1_ptr -> shutdown_info.times.user_shutdown_time,
	    shutdown_info_2_ptr -> shutdown_info.times.user_shutdown_time);

      resultant_shutdown_info_ptr -> shutdown_info.times.user_bump_time =
	    min (
              shutdown_info_1_ptr -> shutdown_info.times.user_bump_time,
	    shutdown_info_2_ptr -> shutdown_info.times.user_bump_time);

      resultant_shutdown_info_ptr -> shutdown_info.times.daemon_logout_time =
	    min (
              shutdown_info_1_ptr -> shutdown_info.times.daemon_logout_time,
	    shutdown_info_2_ptr -> shutdown_info.times.daemon_logout_time);
      end TAKE_LESSER;                            /* format: on */

   if unspec (resultant_shutdown_info_ptr -> shutdown_info.times)
        = unspec (shutdown_info_1_ptr -> shutdown_info.times)
   then
KEEP_FORMER_TIMES:
      do;
      resultant_shutdown_info_ptr
	 -> shutdown_info.output_flags.times_have_changed = "0"b;
      resultant_shutdown_info_ptr -> shutdown_info.reason =
	 shutdown_info_1_ptr -> shutdown_info.reason;
      end KEEP_FORMER_TIMES;
   else
TIMES_HAVE_CHANGED:
      do;
      resultant_shutdown_info_ptr
	 -> shutdown_info.output_flags.times_have_changed = "1"b;
      resultant_shutdown_info_ptr -> shutdown_info.reason =
	 shutdown_info_2_ptr -> shutdown_info.reason;
      end TIMES_HAVE_CHANGED;

   if unspec (resultant_shutdown_info_ptr -> shutdown_info.times) = ""b
   then
NO_TIMES_IN_EITHER_INFO:
      resultant_shutdown_info_ptr -> shutdown_info.no_time_specified = "1"b;

   return;

/* end dm_compare_shutdown_info; */
%page;
CHECK_VERSION:
   proc (cv_p_received_version, cv_p_expected_version, cv_p_structure_name);
   dcl	 cv_p_received_version  char (8) aligned;
   dcl	 cv_p_expected_version  char (8) aligned;
   dcl	 cv_p_structure_name    char (*);

   if cv_p_received_version ^= cv_p_expected_version
   then call sub_err_ (error_table_$unimplemented_version, myname,
	   ACTION_CANT_RESTART, null, 0,
	   "^/Expected version ^a of the ^a structure.
Received version ^d instead.", cv_p_expected_version, cv_p_structure_name,
	   cv_p_received_version);

   end CHECK_VERSION;
%page;
%include dm_shutdown_spec;
%page;
%include sub_err_flags;
   end dm_compare_shutdown_info;




		    dm_data_.alm                    03/06/85  0801.3re  03/05/85  0758.4       25389



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1983 *
" *                                                         *
" ***********************************************************
"
"    This is the external static data used by the data management system.
"
" HISTORY:
"	Written by Jeffrey D. Ives, in March 1983, converted from
"		  John Bongiovanni's original cds.
"	Modified:
"	03/24/83 by Jeffrey D. Ives:  removed fields used exclusively
"		  by file manager to fm_data_.
"	09/20/83 by Lee A. Newcomb:  removed useless firstref trap. and
"		  unreferenced variables.
"	12/05/83 by L. A. Newcomb:  removed before journal manager
"		  specific entries to bjm_data_.  bj_txt_ptr is still
"		  here as transaction_manager_ may read it, and the
"		  TXT directly corresponds to the TDT.
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

	name	dm_data_

" LINKAGE  LINKAGE  LINKAGE  LINKAGE  LINKAGE  LINKAGE  LINKAGE  LINKAGE

	use	linkage_data

	even

	segdef	area_ptr			" Points to area for table allocation
	segdef	inner_ring_areap		" Inner ring extendable area
area_ptr:					" dcl $area_ptr ptr ext;
inner_ring_areap:				" dcl $inner_ring_areap ptr ext;
	its	-1,1

	segdef	dm_journal_segp		" -> hardcore dm_journal_seg_
dm_journal_segp:				" dcl $dm_journal_segp ptr ext;
	its	-1,1

	segdef	tm_tdt_ptr
tm_tdt_ptr:				" dcl $tm_tdt_ptr ptr ext;
	its	-1,1

	segdef	bj_txt_ptr
bj_txt_ptr:				" dcl $bj_txt_ptr ptr ext;
	its	-1,1

	segdef	default_error_label
default_error_label:			" dcl $default_error_label label var ext;
	its	-1,1
	its	-1,1


" !!!!!!!!!!!!!!!!!! END OF DOUBLE WORD ALIGNMENT REGION !!!!!!!!!!!!!!!!!!!!!!

	segdef	initialization_state	" Initialization state
initialization_state:			" dcl $initialization_state char (8) ext;
	aci	//,8

	segdef	system_id			" System identifier
system_id:				" dcl $system_id fixed bin (35) ext;
	dec	0

	segdef	my_tdt_index		" Txn table position for this process
my_tdt_index:				" dcl $my_tdt_index fixed bin ext;
	dec	0

	segdef	my_process_id		" Unique ID for this process
my_process_id:				" dcl $my_process_id bit (36) aligned ext;
	oct	0

	segdef	current_txn_id		" Current Transaction Identifier
current_txn_id:				" dcl $current_txn_id bit (36) aligned ext
	oct	0

	segdef	current_txn_index		" Transaction Table Index of Current Txn
current_txn_index:				" dcl $current_txn_index fixed bin (35)
	dec	0

	segdef	suspended_txn_id		" Transaction Identifier of suspended txn
suspended_txn_id:				" dcl $suspended_txn_id bit (36) aligned
	oct	0

	segdef	suspended_txn_index		" Transaction Table index of suspended txn
suspended_txn_index:			" dcl $suspended_txn_index fixed bin (35)
	dec	0


	join	/link/linkage_data

	end




		    dm_firstref_tv_.alm             04/04/85  1117.3re  04/04/85  0826.3       33903



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1984 *
" *                                                         *
" ***********************************************************
"
"
" DESCRIPTION:
"
"	This is the inner-ring transfer vector for miscellaneous Data
"    Management primitives which require the process to have DM initialized.
"    This transfer has a first-reference trap which executes per-process
"    initialization.  Any primitive which explicitly must not have per-process
"    initialization executed, or per-process initialization does not matter,
"    should be channelled through the transfer vector dm_no_firstref_tv_.
"
"
" HISTORY:
"
" Written by Matthew Pierret, 09/17/84.
" Modified:
" 10/30/84 by Lee A. Newcomb:  Added set_shutdown_info entry.
" 11/22/84 by Lee A. Newcomb:  Changed firstref to
"	    transaction_manager_$per_process_init.
" 12/03/84 by Stanford S. Cox: Renamed dm_firstref_tv_, added get_(daemon_info
"	    daemon_logout_time begin_shutdown_time shutdown_reason
"	    shutdown_warning_time system_data user_shutdown_time
"	    user_bump_time), and start_shutdown.
" 12/07/84 by Lindsey Spratt:  Added $get_initialization_time, removed
"	    $get_system_data.  Changed references to dm_util_ to be
"	    references to dm_firstref_util_.
" 12/08/84 by Lindsey Spratt:  Removed the send_(noop flush_journals terminate
"	    list_ref_names process_command) entries. 
" 12/09/84 by Lindsey Spratt:  Moved $dm_status, $find_old_boot_dir, $find_log
"	    and $log_message from  dm_no_firstref_tv_.
" 12/10/84 by Lindsey Spratt:  Moved $find_log back to dm_no_firstref_tv_.
" 01/16/85 by R. Michael Tague:  Added send_new_process_notifies and 
"	    send_kill_txn.
" 01/25/85 by Lindsey Spratt:  Added get_system_version.
" 03/05/85 by Steve Herbst:  Moved dm_log_ back to dm_no_firstref_tv_.
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

	name	dm_firstref_tv_

	firstref	transaction_manager_$per_process_init


	macro	transfer
	entry	&1
&1:	tra	<&2>|[&3]
	&end


          transfer  admin_schedule_shutdown,dm_admin_sched_shutdown,dm_admin_sched_shutdown

	transfer	dm_status,dm_firstref_util_,dm_status

	transfer	find_old_boot_dir,dm_firstref_util_,find_old_boot_dir

	transfer	get_begin_shutdown_time,dm_firstref_util_,get_begin_shutdown_time

	transfer	get_daemon_info,dm_get_daemon_info_,dm_get_daemon_info_

	transfer	get_daemon_logout_time,dm_firstref_util_,get_daemon_logout_time

	transfer	get_initialization_time,dm_firstref_util_,get_initialization_time

	transfer	get_shutdown_reason,dm_firstref_util_,get_shutdown_reason

	transfer	get_shutdown_warning_time,dm_firstref_util_,get_shutdown_warning_time

	transfer	get_system_state,dm_firstref_util_,get_system_state

	transfer	get_system_version,dm_firstref_util_,get_system_version
	transfer	get_user_bump_time,dm_firstref_util_,get_user_bump_time

	transfer	get_user_shutdown_time,dm_firstref_util_,get_user_shutdown_time

          transfer	schedule_shutdown,dm_firstref_tv_,admin_schedule_shutdown

          transfer  send_adjust_process_id,dm_send_request_,adjust_process_id

          transfer  send_adjust_tdt,dm_send_request_,adjust_tdt

          transfer  send_adjust_tdt_entry,dm_send_request_,adjust_tdt_entry

          transfer  send_adjust_txn,dm_send_request_,adjust_txn

	transfer	send_kill_txn,dm_send_request_,kill_txn

          transfer  send_new_proc,dm_send_request_,new_proc

	transfer	send_new_process_notifies,dm_send_request_,new_process_notifies

          transfer  send_shutdown,dm_send_request_,shutdown

	transfer	set_shutdown_info,dm_set_shutdown_info,dm_set_shutdown_info

	end




		    dm_firstref_util_.pl1           04/04/85  1117.3re  04/04/85  0826.3      110250



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

/*  DESCRIPTION:

     This is a general repository for little programs for DMS.  Its current
   residents are:

   dm_status:		given a DMS per-bootload directory, return
   			the status recorded in the system data.  This
   			is currently used to get the system state of
   			an old DMS during recovery.

   find_old_boot_dir:	Find the last valid per-bootload directory.
   			This basically involves getting a list of all
   			the properly named directories
   			(dm_dir.<date_time_created>) in the per-AIM
   			directory.  There should NEVER be more than one
			file system entity in the per-AIM dir matching
			the per-bootload dir's starname; if there is,
			it should be treated as a fatal recovery error,
			even if the config file says we should ignore
			recovery failure.

   get_begin_shutdown_time:	Returns the time when the DMS caretaker Daemon
			will prevent new transactions from starting
			and set the DMS state to "shutdown begun";
			invoked through dm_gate_.

   get_daemon_logout_time:	Returns the time when the DMS caretaker
   			Daemon is to logout, regardless if the DMS
   			is totally shutdown; invoked through
   			dm_daemon_gate_.

   get_initialization_time:   Returns the time the current DMS was created.

   get_shutdown_warning_time:	Returns the time when user processes
			are to run
			dm_misc_util_$signal_shutdown_warning;
			invoked through dm_gate_.

   get_system_state:	Returns the current system state of the DMS;
			invoked through dm_gate_.

   get_system_version:	Gets the software version id of the DM software
			in use by the current process in the DM ring and
			the software version id in use by the Daemon
			when it created the current DM bootload.

   get_user_bump_time:	returns the time when users will be bumped
   			from Multics if they have not finished user
   			shutdown; invoked through dm_daemon_gate_.

   get_user_shutdown_time:	returns the time when user processes should
   			run dm_misc_util_$signal_user_shutdown;
			invoked through dm_gate_.

*/

/*  HISTORY:
Written by Lee A. Newcomb, 01/07/83.
Modified:
03/07/83 by L. A. Newcomb: to terminate old_dm_system_data_ ref name.
04/23/83 by L. A. Newcomb:  changed the star-name used by
            find_old_bootload_dir to match new name created via
	  request_id_ subr.
04/26/83 by L. A. Newcomb:  Again fixed the starname used to find an old DMS
            bootload directory.
08/17/83 by M. Pandolf: to add set_journal_stamps and get_system_data.
11/29/83 by S. Herbst: to add terminate_dm and using_dm.
01/26/84 by S. Herbst: made $using_dm check that DM_SEGMENT_NAME's linkage
	  section has been combined.
05/11/84 by Lee A. Newcomb: to have $terminate_dm work for an unbound version
	  of DM by terminating single refname fm_'s, bjm_'s, and lm_'s
	  inner ring TV before terminating tm_firstref_tv_.
06/08/84 by Lindsey L. Spratt:  Added the *data_ modules to the list of
            refnames to be terminated by the $terminate_dm entry.  This is
            necessary to ensure that any per-process static data associated
            with these data segments is gotten rid of. Also, added the
	  dm_journal_seg_ and dm_aim_dir_util_ refnames to be explicitly
	  terminated.
06/12/84 by Lindsey L. Spratt:  Changed $terminate_dm to terminate all of the
            DM_SEGMENT_NAMES in all of the rings from get_ring_() to
            OUTERMOST_RING (7).
07/31/84 by Lee A. Newcomb:  added entries $get_daemon_logout_time,
	  $get_system_state, $get_user_bump_time, and
	  $get_user_shutdown_time.
09/27/84 by Lee A. Newcomb:  added the entries get_(begin_shutdown
            shutdown_warning)_time and fixed $get_user_shutdown_time to
	  not use dm_system_data_$initializer_shutdown_time which has
	  been renamed to $user_shutdown_time.
12/02/84 by Lindsey L. Spratt:  Removed the obsolete $get_system_data entry.
            Added $get_initialization_time.
12/03/84 by Stanford S. Cox: Chg refs from *inner_ring_tv_ to =firstref_tv_
12/05/84 by Lindsey L. Spratt:  Removed dm_aim_dir_util_ from the
            DM_SEGMENT_NAMES array as it's obsolete.  Made minor format
            changes.
12/07/84 by Lindsey L. Spratt:  Copied from dm_util_.  Kept all of the entries
            except using_dm, terminate_dm, and set_journal_stamps.  These are
            now in dm_no_firstref_util_.
12/11/84 by Lindsey Spratt: Fixed to reference
	  dm_system_data_$user_warning_time instead of
	  $shutdown_warning_time.
01/24/85 by Lindsey L. Spratt:  Added $get_system_version.  Added
	  dm_firstref_tv_ to the DM_SEGMENT_NAMES to be terminated when
	  doing a user_shutdown.
02/15/85 by Lindsey L. Spratt:  Changed $get_system_version to have two output
            args, p_bootload_version and p_dm_ring_version.
02/26/85 by Lee A. Newcomb:  Fixed to:  return error if >1 file system object
            matches the bootload directory starname; use pathname_ instead
            of concatentation; use standard parameter naming convention.
	  Also removed MANY unused variables and improved the internal
	  procs for cleaning up and error returns.
03/05/85 by Steve Herbst: Replaced dm_log_ with dm_misc_util_$log.
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo,^inddcls,dclind5,idind35,linecom */
%page;
dm_firstref_util_$find_old_boot_dir:
   proc (p_dm_aim_dir, p_old_boot_dir, p_code);

/* START OF DECLARATIONS */

/* Parameter */
dcl  (
     p_dm_aim_dir			char (*),		/* I: dir. to look for per-bootload dir. */
     p_old_boot_dir			char (*),		/* O: in find_old_boot_dir,
						/* I: in dm_status: */
						/* last per-bootload dir. for DMS */
     p_old_dm_status		char (4) aligned,	/* O: status of DMS in a particular boot dir. */
     p_bootload_version		char (8) aligned,
     p_dm_ring_version		char (8) aligned,
     p_code			fixed bin (35)	/* O: normal error code, recovery fails if ^= 0 */
     )				parameter;

/* Automatic */

dcl  (
     code				fixed bin (35),	/* local error code holder */
     sys_data_p			ptr		/* dummy for holding */
     )				automatic;

/* Builtin */
dcl  (null, sum)			builtin;

/* Condition */
dcl  cleanup			condition;

/* Constant */
/* Entry */
dcl  (
     dm_misc_util_$log		entry options (variable),
     get_system_free_area_		entry returns (ptr),
     hcs_$initiate			entry (char (*), char (*), char (*),
				fixed bin (1), fixed bin (2), ptr,
				fixed bin (35)),
     hcs_$star_			entry (char (*), char (*),
				fixed bin (2), ptr, fixed bin, ptr,
				ptr, fixed bin (35)),
     pathname_			entry (char (*), char (*))
				returns (char (168)),
     term_$seg_ptr			entry (ptr, fixed bin (35))
     )				external;

/* External */
dcl  (
     dm_error_$too_many_bootload_dirs	fixed bin (35),
     dm_system_data_$begin_shutdown_time
				fixed bin (71),
     dm_system_data_$current_dm_state	char (4) aligned,
     dm_system_data_$daemon_logout_time fixed bin (71),
     dm_system_data_$initialization_time
				fixed bin (71),
     dm_system_data_$shutdown_reason	char (64) aligned,
     dm_system_data_$system_software_version
				char (8) aligned,
     dm_system_data_$user_warning_time	fixed bin (71),
     dm_system_data_$user_bump_time	fixed bin (71),
     dm_system_data_$user_shutdown_time fixed bin (71),
     dm_system_data_template_$system_software_version
				char (8) aligned,
     old_dm_system_data_$current_dm_state
				char (4) aligned
     )				external static;
%page;
/* find_old_boot_dir:				/* for ease of programming */
/*      proc (p_dm_aim_dir, p_old_boot_dir, p_code); */

/* initialize output parameter */
   p_code = 0;					/* let's be optimistic */

/* Set up for cleaning garbage if we fail */
   star_entry_ptr, star_names_ptr = null ();
   on cleanup call CLEAN_UP_FIND_OLD_BOOT_DIR ();

/* Get a list of all directories with a properly formatted name */
   call hcs_$star_ (p_dm_aim_dir, "dm_dir.??????????", star_BRANCHES_ONLY,
        get_system_free_area_ (), star_entry_count, star_entry_ptr,
        star_names_ptr, code);
   if code ^= 0 then				/* can't do a thing */
      call ERROR_RETURN_FROM_FIND_OLD_BOOT_DIR (code);

/* We should NEVER find more than one validly named old bootload dir.	*/
   if star_entry_count > 1 then
      call ERROR_RETURN_FROM_FIND_OLD_BOOT_DIR (
	 dm_error_$too_many_bootload_dirs);

   p_old_boot_dir =
        pathname_ (p_dm_aim_dir, star_names (star_entries.nindex (1)));

   call FINISH_FIND_OLD_BOOT_DIR ();

MAIN_RETURN:
   return;

/* end dm_firstref_util_$find_old_boot_dir; */
%page;
dm_firstref_util_$dm_status:
   entry (p_old_boot_dir, p_old_dm_status, p_code);

/* must find the dm_system_data_ in the per_bootload_dir. */
   call hcs_$initiate (p_old_boot_dir, "dm_system_data_",
        "old_dm_system_data_", 0, 0, sys_data_p, code);
   if sys_data_p = null () then do;			/* could not find it */
      call dm_misc_util_$log (LOG_SV, code, "dm_firstref_util_$dm_status",
	 "Warning: error attempting to find old dm_system_data_.");
      p_code = code;
      return;
   end;

   p_old_dm_status = old_dm_system_data_$current_dm_state;

   call term_$seg_ptr (sys_data_p, code);
   if code ^= 0 then
      call dm_misc_util_$log (LOG_SV, code, "dm_firstref_util_$dm_status",
	 "Warning: could not terminate old dm_system_data_.");
   return;

/* end dm_firstref_util_$dm_status; */
%skip (4);
dm_firstref_util_$get_initialization_time:
   entry () returns (fixed bin (71));

   return (dm_system_data_$initialization_time);

/* end dm_firstref_util_$get_initialization_time; */
%skip (4);
dm_firstref_util_$get_system_state:
   entry returns (char (4) aligned);

   return (dm_system_data_$current_dm_state);

/* end dm_firstref_util_$get_system_state; */
%skip (4);
dm_firstref_util_$get_system_version:
   entry (p_bootload_version, p_dm_ring_version);

   p_bootload_version = dm_system_data_$system_software_version;
   p_dm_ring_version = dm_system_data_template_$system_software_version;
   return;

/* end dm_firstref_util_$get_system_version; */
%page;
/* user interface to retrieve the shutdown reason */
dm_firstref_util_$get_shutdown_reason:
   entry returns (char (64));

   return (dm_system_data_$shutdown_reason);

/* end dm_firstref_util_$get_shutdown_reason; */
%skip (4);
/* Now the entries that get various time values from dm_system_data_ */

dm_firstref_util_$get_begin_shutdown_time:
   entry returns (fixed bin (71));

   return (dm_system_data_$begin_shutdown_time);

/* end dm_firstref_util_$get_begin_shutdown_time; */
%skip (4);
dm_firstref_util_$get_daemon_logout_time:
   entry returns (fixed bin (71));

   return (dm_system_data_$daemon_logout_time);

/* end dm_firstref_util_$get_daemon_logout_time; */
%skip (4);
dm_firstref_util_$get_shutdown_warning_time:
   entry returns (fixed bin (71));

   return (dm_system_data_$user_warning_time);

/* end dm_firstref_util_$get_shutdown_warning_time; */
%skip (4);
dm_firstref_util_$get_user_bump_time:
   entry returns (fixed bin (71));

   return (dm_system_data_$user_bump_time);

/* end dm_firstref_util_$get_user_bump_time; */
%skip (4);
dm_firstref_util_$get_user_shutdown_time:
   entry returns (fixed bin (71));

   return (dm_system_data_$user_shutdown_time);

/* end dm_firstref_util_$get_user_shutdown_time; */
%page;
FINISH_FIND_OLD_BOOT_DIR:
   proc ();					/* cleanup and finish the same currently */
CLEAN_UP_FIND_OLD_BOOT_DIR:
   entry ();

/* Internal proc. to free star structures if any get allocated */

   if star_names_ptr ^= null () then
      free star_names;

   if star_entry_ptr ^= null () then
      free star_entries;

   end FINISH_FIND_OLD_BOOT_DIR;
%skip (4);
ERROR_RETURN_FROM_FIND_OLD_BOOT_DIR:
   proc (erffobd_p_code);

dcl  erffobd_p_code			fixed bin (35) parameter;

   call CLEAN_UP_FIND_OLD_BOOT_DIR ();

   p_code = erffobd_p_code;

   go to MAIN_RETURN;

   end ERROR_RETURN_FROM_FIND_OLD_BOOT_DIR;
%page;
%include dm_log_sv_codes;
%page;
%include star_structures;


   end dm_firstref_util_$find_old_boot_dir;




		    dm_get_daemon_info_.pl1         03/06/85  0801.3re  03/05/85  0758.5       27900



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

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

dm_get_daemon_info_:
     proc (p_dm_daemon_info_ptr);

/* DESCRIPTION:

         This program retrieves from a DMS' dm_system_data_ information about
     the caretaker Daemon of the DMS.  This is because the system data segment
     for  a  DM system is not available in any ring other than ring 2, but the
     data on the caretaker Daemon is needed in ring 4.    Currently,  this  is
     considered privileged data and wil be called via dm_daemon_gate_.
*/

/* HISTORY:

Written by L. A. Newcomb, 03/22/84.
Modified:
*/

/* START OF DECLARATIONS */
/* Parameter */

dcl  p_dm_daemon_info_ptr	        ptr;		/* addr (dm_daemon_info) struct. to be filled in.*/

/* Automatic */
/* Based */
/* Builtin */

dcl  null			        builtin;

/* Constant */

dcl  myname		        init ("dm_get_daemon_info_") char (32) varying internal static options (constant);

/* Entry */

dcl  sub_err_		        entry () options (variable);

/* External */

dcl  (
     dm_system_data_$command_ms_name  char (32) aligned,
     dm_system_data_$initializer_event_chn fixed bin (71),
     dm_system_data_$initializer_name char (32) aligned,
     dm_system_data_$initializer_processid bit (36) aligned,
     dm_system_data_$initializer_wakeup_increment fixed bin
     )			        external static;

/* Status/Error Codes */

dcl  error_table_$unimplemented_version fixed bin (35) ext;

/* END OF DECLARATIONS */
%page;
	dm_daemon_info_ptr = p_dm_daemon_info_ptr;	/* get to local storage */

/* check version of return structure, passing given version by value to */
/* bypass alignment warning. */

	call CHECK_VERSION ((dm_daemon_info.version), DM_DAEMON_INFO_VERSION_1, "dm_daemon_info");

/* now fill in the return structure */

	dm_daemon_info.event_channel = dm_system_data_$initializer_event_chn;
	dm_daemon_info.process_id = dm_system_data_$initializer_processid;
	dm_daemon_info.wakeup_increment = dm_system_data_$initializer_wakeup_increment;
	dm_daemon_info.user_id = dm_system_data_$initializer_name;
	dm_daemon_info.command_ms_name = dm_system_data_$command_ms_name;

	return;

/*   end dm_get_daemon_info_ */
%page;
CHECK_VERSION:
     proc (p_received_version, p_expected_version, p_structure_name);
dcl  p_received_version	        char (*);
dcl  p_expected_version	        char (*);
dcl  p_structure_name	        char (*);

	if p_received_version ^= p_expected_version
	then call
		sub_err_ (error_table_$unimplemented_version, myname, ACTION_CANT_RESTART, null, 0,
		"^/Expected version ^a of the ^a structure.
Received version ^d instead.", p_expected_version, p_structure_name, p_received_version);

     end CHECK_VERSION;
%page; %include sub_err_flags;
%page; %include dm_daemon_info;


     end dm_get_daemon_info_;




		    dm_process_shutdown_spec.pl1    03/06/85  0801.3re  03/05/85  0758.6       94986



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

/* DESCRIPTION:

         This    routine    takes    a    shutdown_spec,     pointed   to   by
     p_shutdown_spec_ptr, and processes it to  determine  a  complete  set  of
     shutdown  info,  returning  the info in the caller-supplied shutdown_info
     structure pointed to by p_shutdown_info_ptr.  Shutdown info consists of a
     reason for shutdown, which is copied directly from the shutdown_spec, and
     a set of times - one time for each of the five events which  comprise  DM
     shutdown.  The times are determined as follows:

     1)  Any  time in shutdown_spec.times which is not equal to 0 is copied to
     shutdown_info.times.  These times are referred to as "specified times".

     2) If no times are specified (i.e., all times in shutdown_spec.times  are
     equal to 0) then shutdown_info.times.user_bump_time is set to the current
     Multics scheduled down time.  If there is no Multics down time scheduled,
     set shutdown_info.output_flags.no_time_specified to "1"b and return.

     3)  Starting  with  the  begin_shutdown_time  and  proceeding through the
     daemon_logout_time, for each shutdown_info.times cell which  is  not  yet
     set (i.e., shutdown_info.times.<time> is equal to 0), attempt to set that
     time as follows:
        3.1) If the previous time in shutdown_info.times is equal to 0,
             we have no way of determining the this time, so skip to
             the next time.
        3.2) Otherwise, set the time based on the previous time using
             a delay.  If there is a delay for this event specified in
             shutdown_spec.delays, add that delay to the previous time;
             otherwise use the default delay for this event stored in
             dm_system_data_.

     4)    Stepping    backwards    from   the   user_shutdown_time   to   the
     user_warning_time, for each time in shutdown_info.times  which  is  still
     set  to  0,  determine the time subtracting a delay from the time for the
     next event.  It is guaranteed that when stepping  through  the  times  in
     this  way,  if  the time for an event is still set to 0, the time for the
     next event is not 0.  Determine the delay as follows:
        4.1) If the delay for the NEXT event is specified in
             shutdown_spec.delays, subtract it from the time in
             shutdown_info.times for the NEXT event to get the time
             for the current event.
        4.2) Otherwise, subtract the delay for the next event in
             dm_system_data_ from the time for the next event to get
             the time for the current event.
*/

/* HISTORY:

Written by Matthew C. Pierret, 09/11/84.
Modified:
09/27/84 by Lee A. Newcomb:  Added setting of reason to default value if times
            are calculated from the Multics down time.
*/

/* format: style2,ind3,^indprocbody,^indnoniterdo,indnoniterend */
/* format: ll79,comcol50,indblkcom */

dm_process_shutdown_spec:
   proc (p_shutdown_spec_ptr, p_shutdown_info_ptr);

/* START OF DECLARATIONS */
/* Parameter */

   dcl	 p_shutdown_spec_ptr    ptr;	         /*points to a shutdown_spec.*/
   dcl	 p_shutdown_info_ptr    ptr;	         /*points to a shutdown_info*/

/* Automatic */

   dcl	 1 my_shutdown_info	    aligned like shutdown_info;
   dcl	 user_bump_time_str	    char (24);
   dcl	 whoptr		    ptr init (null ());

/* Based */
/* Builtin */

   dcl	 (null, unspec)	    builtin;

/* Constant */

   dcl	 myname		    init ("dm_process_shutdown_spec")
			    char (32) varying internal static
			    options (constant);

/* Entry */

   dcl	 date_time_	    entry (fixed bin (71), char (*));
   dcl	 hcs_$initiate	    entry (char (*), char (*), char (*),
			    fixed bin (1), fixed bin (2), ptr,
			    fixed bin (35));
   dcl	 sub_err_		    entry () options (variable);
   dcl	 system_info_$next_shutdown
			    entry (fixed bin (71), char (*),
			    fixed bin (71));

/* External */

   dcl	 (
	 dm_system_data_$begin_shutdown_delay,
	 dm_system_data_$user_shutdown_delay,
	 dm_system_data_$user_bump_delay,
	 dm_system_data_$daemon_logout_delay
	 )		    ext fixed bin (71);
   dcl	 sys_info$system_control_dir
			    ext char (168) varying;
   dcl	 error_table_$unimplemented_version
			    fixed bin (35) ext;

/* END OF DECLARATIONS */

   shutdown_spec_ptr = p_shutdown_spec_ptr;
   call CHECK_VERSION (shutdown_spec.version, SHUTDOWN_SPEC_VERSION_1,
        "shutdown_spec");
   call CHECK_VERSION (p_shutdown_info_ptr -> shutdown_info.version,
        SHUTDOWN_INFO_VERSION_1, "shutdown_info");

   unspec (my_shutdown_info) = ""b;
   my_shutdown_info.version = SHUTDOWN_INFO_VERSION_1;
   my_shutdown_info.reason = shutdown_spec.reason;

   /*** Steps (1) and (2) of DESCRIPTION. ***/

   if unspec (shutdown_spec.times) ^= ""b
   then unspec (my_shutdown_info.times) = unspec (shutdown_spec.times);
   else
GET_DEFAULTS_FROM_MULTICS_DOWN_TIME:
      do;
      call system_info_$next_shutdown (my_shutdown_info.times.user_bump_time,
	 (""), (0));		         /* only want down time */
      if unspec (my_shutdown_info.reason) = ""b
      then
GET_DEFAULT_SHUTDOWN_REASON:
         do;
         call date_time_ (my_shutdown_info.times.user_bump_time,
	    user_bump_time_str);
         my_shutdown_info.reason =
	    "Multics is shutting down @ "
	    || substr (user_bump_time_str, 11, 6);
				         /* just use HHMM.M part */
         end GET_DEFAULT_SHUTDOWN_REASON;
      end GET_DEFAULTS_FROM_MULTICS_DOWN_TIME;

   if unspec (my_shutdown_info.times) = ""b
   then
CANT_CALCULATE_TIMES:
      my_shutdown_info.output_flags.no_time_specified = "1"b;
   else
CALCULATE_UNSPECIFIED_TIMES:
      do;
      my_shutdown_info.output_flags.no_time_specified = "0"b;
FIRST_PASS_FORWARD:
      do;

         /*** Step (3) of DESCRIPTION. ***/

         if my_shutdown_info.times.begin_shutdown_time = 0
	    & my_shutdown_info.times.user_warning_time ^= 0
         then if shutdown_spec.delays.begin_shutdown_delay = 0
	    then my_shutdown_info.times.begin_shutdown_time =
		    my_shutdown_info.times.user_warning_time
		    + dm_system_data_$begin_shutdown_delay;
	    else my_shutdown_info.times.begin_shutdown_time =
		    my_shutdown_info.times.user_warning_time
		    + shutdown_spec.delays.begin_shutdown_delay;

         if my_shutdown_info.times.user_shutdown_time = 0
	    & my_shutdown_info.times.begin_shutdown_time ^= 0
         then if shutdown_spec.delays.user_shutdown_delay = 0
	    then my_shutdown_info.times.user_shutdown_time =
		    my_shutdown_info.times.begin_shutdown_time
		    + dm_system_data_$user_shutdown_delay;
	    else my_shutdown_info.times.user_shutdown_time =
		    my_shutdown_info.times.begin_shutdown_time
		    + shutdown_spec.delays.user_shutdown_delay;

         if my_shutdown_info.times.user_bump_time = 0
	    & my_shutdown_info.times.user_shutdown_time ^= 0
         then if shutdown_spec.delays.user_bump_delay = 0
	    then my_shutdown_info.times.user_bump_time =
		    my_shutdown_info.times.user_shutdown_time
		    + dm_system_data_$user_bump_delay;
	    else my_shutdown_info.times.user_bump_time =
		    my_shutdown_info.times.user_shutdown_time
		    + shutdown_spec.delays.user_bump_delay;

         if my_shutdown_info.times.daemon_logout_time = 0
	    & my_shutdown_info.times.user_bump_time ^= 0
         then if shutdown_spec.delays.daemon_logout_delay = 0
	    then my_shutdown_info.times.daemon_logout_time =
		    my_shutdown_info.times.user_bump_time
		    + dm_system_data_$daemon_logout_delay;
	    else my_shutdown_info.times.daemon_logout_time =
		    my_shutdown_info.times.user_bump_time
		    + shutdown_spec.delays.daemon_logout_delay;

      end FIRST_PASS_FORWARD;
SECOND_PASS_BACKWARD:
      do;

         /*** Step (4) of DESCRIPTION. ***/

         if my_shutdown_info.times.user_bump_time = 0
         then if shutdown_spec.delays.daemon_logout_delay = 0
	    then my_shutdown_info.times.user_bump_time =
		    my_shutdown_info.times.daemon_logout_time
		    - dm_system_data_$daemon_logout_delay;
	    else my_shutdown_info.times.user_bump_time =
		    my_shutdown_info.times.daemon_logout_time
		    - shutdown_spec.delays.daemon_logout_delay;

         if my_shutdown_info.times.user_shutdown_time = 0
         then if shutdown_spec.delays.user_bump_delay = 0
	    then my_shutdown_info.times.user_shutdown_time =
		    my_shutdown_info.times.user_bump_time
		    - dm_system_data_$user_bump_delay;
	    else my_shutdown_info.times.user_shutdown_time =
		    my_shutdown_info.times.user_bump_time
		    - shutdown_spec.delays.user_bump_delay;

         if my_shutdown_info.times.begin_shutdown_time = 0
         then if shutdown_spec.delays.user_shutdown_delay = 0
	    then my_shutdown_info.times.begin_shutdown_time =
		    my_shutdown_info.times.user_shutdown_time
		    - dm_system_data_$user_shutdown_delay;
	    else my_shutdown_info.times.begin_shutdown_time =
		    my_shutdown_info.times.user_shutdown_time
		    - shutdown_spec.delays.user_shutdown_delay;

         if my_shutdown_info.times.user_warning_time = 0
         then if shutdown_spec.delays.begin_shutdown_delay = 0
	    then my_shutdown_info.times.user_warning_time =
		    my_shutdown_info.times.begin_shutdown_time
		    - dm_system_data_$begin_shutdown_delay;
	    else my_shutdown_info.times.user_warning_time =
		    my_shutdown_info.times.begin_shutdown_time
		    - shutdown_spec.delays.begin_shutdown_delay;

      end SECOND_PASS_BACKWARD;

      end CALCULATE_UNSPECIFIED_TIMES;

   p_shutdown_info_ptr -> shutdown_info = my_shutdown_info;

   return;





CHECK_VERSION:
   proc (cv_p_received_version, cv_p_expected_version, cv_p_structure_name);
   dcl	 cv_p_received_version  char (8) aligned;
   dcl	 cv_p_expected_version  char (8) aligned;
   dcl	 cv_p_structure_name    char (*);

   if cv_p_received_version ^= cv_p_expected_version
   then call sub_err_ (error_table_$unimplemented_version, myname,
	   ACTION_CANT_RESTART, null, 0,
	   "^/Expected version ^a of the ^a structure.
Received version ^d instead.", cv_p_expected_version, cv_p_structure_name,
	   cv_p_received_version);

   end CHECK_VERSION;
%page;
%include dm_shutdown_spec;
%page;
%include sub_err_flags;

   end dm_process_shutdown_spec;




		    dm_send_request_.pl1            03/06/85  0801.3re  03/05/85  0758.6       50166



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

/* format: ^indcomtxt */
/* DESCRIPTION:
	The subroutine interface to send wakeup to alleged daemon process
     which is running the data management system.  There is one entrypoint
     for each request.
*/

/* HISTORY:

Written by M. Pandolf, 10/27/82.
Modified:
11/04/82 by M. Pandolf:  to add bury_dead_process entrypoint.
11/22/82 by M. Pandolf:  to add new_proc entrypoint.
01/25/83 by M. Pandolf:  to add adjust_tdt_entry entrypoint and to add the
	  name adjust_process_id to bury entry.
06/07/83 by M. Pandolf:  to add flush_journals entrypoint.
07/26/83 by M. Pandolf:  to add process_command entrypoint.
01/04/84 by L. A. Newcomb:  renamed dm_gate_$get_aim_dir to
            dm_gate_$dm_get_aim_dir to track the gates entries new name.
09/27/84 by Lee A. Newcomb:  added the new_process_notifications entry, and
	  removed unused entry dm_send_request_.
10/29/84 by Lee A. Newcomb:  Fixed to not use dm_ prefix on
            dm_misc_util_$get_aim_dir.
12/08/84 by Lindsey L. Spratt:  Removed the entryname bury_dead_process.
            Removed entirely the entries:  noop, flush_journals, terminate,
            list_ref_names, process_command.
01/22/85 by R. Michael Tague:  Added the kill_txn entry and changed the 
            new_process_notifications entry name to new_process_notifies.
*/

/* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,idind33 */

dm_send_request_$shutdown:
     proc (p_code);


/* START OF DECLARATIONS */

/* Parameter */
dcl  (
     p_code		        fixed bin (35),
     p_process_id		        bit (36),
     p_txn_id		        bit (36) aligned,
     p_txn_ix		        fixed bin (17)
     )			        parameter;

/* Automatic */
dcl  (
     message		        fixed bin (71),	/* for wakeup call */
     emp			        pointer		/* pointer to message */
     )			        automatic;

/* Based */

dcl  1 event_message	        aligned based (emp) like dm_request_message;

/* Builtin */
dcl  addr			        builtin;

/* Entry */
dcl  hcs_$wakeup		        entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35))
			        external;

/* External */
dcl  (
     (dm_request_action_$adjust_process_id,
     dm_request_action_$adjust_tdt,
     dm_request_action_$adjust_tdt_entry,
     dm_request_action_$adjust_txn,
     dm_request_action_$kill_txn,
     dm_request_action_$new_proc,
     dm_request_action_$new_process_notifications,
     dm_request_action_$shutdown)     fixed bin,
     dm_system_data_$initializer_event_chn fixed bin (71),
     dm_system_data_$initializer_processid bit (36) aligned
     )			        external static;

/* END OF DECLARATIONS */
%page;
/* dm_send_request_$shutdown: */
/*     proc (p_code); */

	p_code = 0;
	message = 0;
	emp = addr (message);
	event_message.action_type = dm_request_action_$shutdown;
	call SEND_MESSAGE (message, p_code);
	return;

new_proc:
     entry (p_code);

	p_code = 0;
	message = 0;
	emp = addr (message);
	event_message.action_type = dm_request_action_$new_proc;
	call SEND_MESSAGE (message, p_code);
	return;

adjust_txn:
     entry (p_txn_id, p_txn_ix, p_code);

	p_code = 0;
	message = 0;
	emp = addr (message);
	emp -> dm_adjust_txn_message.action_type = dm_request_action_$adjust_txn;
	emp -> dm_adjust_txn_message.transaction_index = p_txn_ix;
	emp -> dm_adjust_txn_message.transaction_id = p_txn_id;
	call SEND_MESSAGE (message, p_code);
	return;

adjust_tdt_entry:
     entry (p_txn_id, p_txn_ix, p_code);

	p_code = 0;
	message = 0;
	emp = addr (message);
	emp -> dm_adjust_tdt_entry_message.action_type = dm_request_action_$adjust_tdt_entry;
	emp -> dm_adjust_tdt_entry_message.transaction_index = p_txn_ix;
	emp -> dm_adjust_tdt_entry_message.transaction_id = p_txn_id;
	call SEND_MESSAGE (message, p_code);
	return;

adjust_tdt:
     entry (p_code);

	p_code = 0;
	message = 0;
	emp = addr (message);
	event_message.action_type = dm_request_action_$adjust_tdt;
	call SEND_MESSAGE (message, p_code);
	return;

adjust_process_id:
     entry (p_process_id, p_code);

	p_code = 0;
	message = 0;
	emp = addr (message);
	emp -> dm_adjust_process_id_message.action_type = dm_request_action_$adjust_process_id;
	emp -> dm_adjust_process_id_message.process_id = p_process_id;
	call SEND_MESSAGE (message, p_code);
	return;

new_process_notifies:
     entry (p_code);

	p_code = 0;
	message = 0;
	emp = addr (message);
	emp -> event_message.action_type = dm_request_action_$new_process_notifications;
	call SEND_MESSAGE (message, p_code);
	return;

kill_txn:
     entry (p_txn_id, p_code);

	p_code = 0;
	message = 0;
	emp = addr (message);
	emp -> dm_kill_txn.action_type = dm_request_action_$kill_txn;
	emp -> dm_kill_txn.transaction_id = p_txn_id;
	call SEND_MESSAGE (message, p_code);
	return;

%page;

/* INTERNAL PROCEDURE */

SEND_MESSAGE:
     procedure (sm_p_message, sm_p_code);

dcl  (
     sm_p_message		        fixed bin (71),
     sm_p_code		        fixed bin (35)
     )			        parameter;

/* get the process and event channel from dm_system_data_ and send wakeup */

	call hcs_$wakeup (dm_system_data_$initializer_processid,
	     dm_system_data_$initializer_event_chn,
	     sm_p_message,
	     sm_p_code);

	return;
     end SEND_MESSAGE;
%page;
%include dm_request_message;


     end dm_send_request_$shutdown;




		    dm_set_shutdown_info.pl1        03/06/85  0801.3re  03/05/85  0758.6       56376



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

/* DESCRIPTION:

         This  program  sets the real shutdown information in dm_system_data_
     for all processes.  It gets  the  administratively  set  shutdown  values
     saved  in  the  system  data,  calculates the DMS shutdown times from the
     Multics down time, compares the times, sets the real shutdown step times,
     and returns the resulting shutdown_info structure to the caller.

          THIS PROGRAM SHOULD ONLY BE CALLED BY THE DM DAEMON'S STATIC HANDLER
     FOR THE system_shutdown_scheduled_ IPS,  OR  THE  SHUTDOWN  IPC_  REQUEST
     HANDLER.            This      should     be     the     same     program,
     dm_daemon_util_$schedule_shutdown.
*/

/* HISTORY:

Written by Lee A. Newcomb, 09/21/84.
Modified:
*/

/* format: style2,ll79,ind3,^indprocbody,ifthendo,ifthen,^indnoniterdo */
/* format: ^inddcls,dclind5,idind35,linecom */

dm_set_shutdown_info:
   proc (p_shutdown_info_ptr);

/* START OF DECLARATIONS */
/* Parameter */
dcl  (
     p_shutdown_info_ptr		ptr		/* where to return the resulting shutdown info */
     )				parameter;

/* Automatic */
dcl  (
     1 admin_shutdown_info		aligned like shutdown_info,
     1 multics_shutdown_info		aligned like shutdown_info,
     1 multics_shutdown_spec		aligned like shutdown_spec,
     1 resultant_shutdown_info	aligned like shutdown_info
     )				automatic;

/* Based */
/* Builtin */
dcl  (addr, null, unspec)		builtin;

/* Constant */
dcl  (
     myname			init ("dm_set_shutdown_info")
				char (32) varying
     )				internal static options (constant);

/* Entry */
dcl  (
     dm_compare_shutdown_info		entry (ptr, ptr, ptr),
     dm_process_shutdown_spec		entry (ptr, ptr),
     sub_err_			entry () options (variable)
     )				external;

/* External */
dcl  (
     (
     dm_system_data_$begin_shutdown_time,		/* shutdown time cells */
     dm_system_data_$daemon_logout_time,
     dm_system_data_$saved_begin_shutdown_time,
     dm_system_data_$saved_daemon_logout_time,
     dm_system_data_$saved_user_bump_time,
     dm_system_data_$saved_user_shutdown_time,
     dm_system_data_$saved_user_warning_time,
     dm_system_data_$user_bump_time,
     dm_system_data_$user_shutdown_time,
     dm_system_data_$user_warning_time
     )				fixed bin (71),
     (
     dm_system_data_$shutdown_reason,			/* shutdown reason cells */
     dm_system_data_$saved_shutdown_reason
     )				char (64) aligned,
     error_table_$unimplemented_version fixed bin (35)
     )				external static;

/* END OF DECLARATIONS */
%page;
   shutdown_info_ptr = p_shutdown_info_ptr;
   call CHECK_VERSION (shutdown_info.version, SHUTDOWN_INFO_VERSION_1,
        "shutdown_info");

FILL_IN_ADMIN_INFO:
   do;
      unspec (admin_shutdown_info) = ""b;
      admin_shutdown_info.version = SHUTDOWN_INFO_VERSION_1;
      admin_shutdown_info.reason = dm_system_data_$saved_shutdown_reason;
      admin_shutdown_info.user_warning_time =
	 dm_system_data_$saved_user_warning_time;
      admin_shutdown_info.begin_shutdown_time =
	 dm_system_data_$saved_begin_shutdown_time;
      admin_shutdown_info.user_shutdown_time =
	 dm_system_data_$saved_user_shutdown_time;
      admin_shutdown_info.user_bump_time =
	 dm_system_data_$saved_user_bump_time;
      admin_shutdown_info.daemon_logout_time =
	 dm_system_data_$saved_daemon_logout_time;
   end FILL_IN_ADMIN_INFO;

PREPARE_MULTICS_SHUTDOWN_INFO:
   do;
      unspec (multics_shutdown_info) = ""b;
      multics_shutdown_info.version = SHUTDOWN_INFO_VERSION_1;
   end PREPARE_MULTICS_SHUTDOWN_INFO;

PROCESS_MULTICS_SHUTDOWN_SPEC:
   do;
      unspec (multics_shutdown_spec) = ""b;
      multics_shutdown_spec.version = SHUTDOWN_SPEC_VERSION_1;
      call dm_process_shutdown_spec (addr (multics_shutdown_spec),
	 addr (multics_shutdown_info));
   end PROCESS_MULTICS_SHUTDOWN_SPEC;

SET_NEW_SHUTDOWN_INFO:
   do;

/* Always set the shutdown info in dm_system_data_.  The use of	*/
/* the compare entry is to get the effective shutdown times and the	*/
/* no_time_specified flag set for the caller in the login ring.  It	*/
/* is possible to optimize this further to do a comparison with the	*/
/* currently set shutdown times to avoid sending multiple		*/
/* dm_shutdown_scheduled_ IPS' that are effectively no-ops.  At this 	*/
/* time, it is believed that the number of no-op IPS sendings will be	*/
/* so few that the extra complexity is not warranted.		*/

      unspec (resultant_shutdown_info) = ""b;
      resultant_shutdown_info.version = SHUTDOWN_INFO_VERSION_1;
      call dm_compare_shutdown_info (addr (multics_shutdown_info),
	 addr (admin_shutdown_info), addr (resultant_shutdown_info));

      dm_system_data_$user_warning_time =
	 resultant_shutdown_info.user_warning_time;
      dm_system_data_$begin_shutdown_time =
	 resultant_shutdown_info.begin_shutdown_time;
      dm_system_data_$user_shutdown_time =
	 resultant_shutdown_info.user_shutdown_time;
      dm_system_data_$user_bump_time = resultant_shutdown_info.user_bump_time;
      dm_system_data_$daemon_logout_time =
	 resultant_shutdown_info.daemon_logout_time;
      dm_system_data_$shutdown_reason = resultant_shutdown_info.reason;

      shutdown_info = resultant_shutdown_info;
   end SET_NEW_SHUTDOWN_INFO;

MAIN_RETURN:
   return;


/* end dm_set_shutdown_info; */
%page;
CHECK_VERSION:
   proc (cv_p_received_version, cv_p_expected_version, cv_p_structure_name);

dcl  (
     cv_p_received_version		char (*) aligned,
     cv_p_expected_version		char (*) aligned,
     cv_p_structure_name		char (*)
     )				parameter;

   if cv_p_received_version ^= cv_p_expected_version then
      call sub_err_ (error_table_$unimplemented_version, myname,
	 ACTION_CANT_RESTART, null, 0,
	 "^/Expected version ^a of the ^a structure.
Received version ^d instead.", cv_p_expected_version, cv_p_structure_name,
	 cv_p_received_version);

   end CHECK_VERSION;
%page;
%include dm_shutdown_spec;
%page;
%include sub_err_flags;


   end dm_set_shutdown_info;

*/
                                          -----------------------------------------------------------


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

*/
