



		    memo.pl1                        01/23/89  1237.1rew 01/23/89  1228.0      514044



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


/****^  HISTORY COMMENTS:
  1) change(86-07-11,Rauschelbach), approve(86-07-11,MCR7450),
     audit(86-08-05,GJohnson), install(86-08-08,MR12.0-1122):
     Changed argument processing to accept short name -dft for -default.
  2) change(86-07-15,Rauschelbach), approve(86-07-15,MCR7472),
     audit(86-08-05,GJohnson), install(86-08-08,MR12.0-1122):
     Write access checking and error handling were changed to fix an endless
     loop.  Argument processing was changed to handle null or zero secondary
     arguments.  The expiration_string variable was changed to a based type to
     accomodate long date strings. Changed default location of memo segment to
     user_info_$homedir, as is documented instead of
     static_project>static_person. Non error messages were changed to use ioa_
     instead of com_err_. Moved and added initialized of variables to
     initialize_memo.
  3) change(86-08-25,Lippard), approve(86-07-15,PBF7472),
     audit(86-09-10,GWMay), install(86-09-11,MR12.0-1152):
     Fix bug with checking write access.
  4) change(88-09-20,Flegel), approve(88-12-07,MCR8021), audit(88-12-14,Lee),
     install(89-01-23,MR12.3-1010):
     phx21142 - included "-match" in the option_count calculation so that an
                     action_arg is required.
                                                   END HISTORY COMMENTS */


memo: procedure () options (variable);

/* *	This is a command procedure for maintaining a list of memos, with differing maturity dates,
   *	and various options for processing.
   *
   *	Completely rewritten, June, 1979, W. Olin Sibert
   *      Changed iox_$order to iox_$control, 2/12/82 R. Holmstedt
   */

dcl  code fixed bin (35);
dcl  nargs fixed bin;           /* Moved out of process_args to global 				*/
dcl  rsp pointer;
dcl  rsl fixed bin (21);
dcl  rs char (rsl) varying based (rsp);
dcl  P_arg_list ptr;        /* for use with the new argument routine cu_$arg_ptr_rel 			*/
dcl  P_expiration_string ptr;        /* pointer for based expiration_string				*/
dcl  L_expiration_string fixed bin (21);    /* length for based expiration_string			*/
dcl  complain entry variable options (variable);

dcl  temp1 fixed bin;
dcl  idx fixed bin;
dcl  temp_date fixed bin (71);
dcl (month_value, day_of_month, year_value) fixed bin;
dcl  zone_value char (3) aligned;
dcl  fs_mode fixed bin (5);


dcl (list_sw, print_sw, delete_sw, postpone_sw) bit (1) aligned;
dcl (set_memo_sw, set_pathname_sw) bit (1) aligned;
dcl (alarm_sw, invisible_sw, call_sw, per_process_sw, repeat_sw,
     expires_sw, remains_sw, single_sw, repeat_count_sw) bit (1) aligned;
dcl (mature_sw, immature_sw) bit (1) aligned;
dcl (turn_timer_on_sw, turn_timer_off_sw) bit (1) aligned;
dcl  status_sw bit (1) aligned;
dcl (brief_sw, totals_sw, force_sw) bit (1) aligned;
dcl  process_memos_sw bit (1) aligned;
dcl  select_options_specified_sw bit (1) aligned;
dcl  af_sw bit (1) aligned;
dcl  memo_segment_modified bit (1) aligned;		/* set if we do something likely to change the bitcount */
dcl (have_read_access, have_write_access) bit (1) aligned;
dcl  complained bit (1) aligned init("0"b);                 /* set if we gave a benign complaint		*/
      
dcl  default_memo_directory char (64) internal static init("");
dcl  time_now fixed bin (71);
dcl  memo_time_now fixed bin (35);

dcl 1 term_switch aligned like terminate_file_switches;      /* switches for terminate_file_ functions	*/
dcl 1 arg_flags aligned like memo_segment_entry.flags;
dcl 1 set_flags aligned like memo_segment_entry.flags;
dcl 1 select_flags aligned like memo_segment_entry.flags;

dcl  maturity_time fixed bin (71);
dcl (from_time, to_time) fixed bin (71);
dcl  postpone_time fixed bin (71);
dcl  repeat_string char (32);
dcl  repeat_count fixed bin;
dcl  expiration_string char (L_expiration_string) based (P_expiration_string); /* based to accomodate very long expiration time descriptions */
dcl  expiration_time fixed bin (71);
dcl  expiration_delta fixed bin (35);

dcl  memo_text char (132) varying;			/* text of memo to set */

dcl  dname char (168);
dcl  ename char (32);

dcl  n_match_strings fixed bin;			/* number of slots actually used in the array */
dcl  match_string (40) char (32) varying;		/* strings to match against memo text */
dcl  n_memo_numbers fixed bin;			/* number of slots used in array */
dcl 1 memo_number (200) aligned,			/* ranges of memo numbers to list/print/delete/postpone */
    2 start fixed bin (17) unaligned,
    2 finish fixed bin (17) unaligned;
dcl  n_class_names fixed bin;				/* number of class names specified */
dcl  class_name (20) char (32);			/* and the array containing their names */

dcl  memo_match_count fixed bin;

dcl  memo_bits (MAX_NUMBER_MEMOS) bit (1) unaligned;

dcl  static_initialized bit (1) aligned internal static init ("0"b); 
                                                            /* initialized flag */
dcl  static_pointer pointer internal static init (null ()); /* static pointer to default memo segment */
dcl  static_dname char (168) internal static init ("");	/* pathname of default memo segment */
dcl  static_ename char (32) internal static init ("");	/* pathname of default memo segment */
dcl  static_uid bit (36) aligned internal static init (""b); /* static UID of segment, for validity checking */
dcl  memo_timers_enabled bit (1) aligned internal static init ("0"b);
dcl  memo_invocation_count fixed bin internal static init (0);
dcl  end_of_time fixed bin (71) internal static init (-1);
dcl  end_of_memo_time fixed bin (35) internal static init (-1);
dcl  static_person char (32) varying internal static init ("");
dcl  static_project char (32) varying internal static init ("");


dcl  active_fnc_err_ entry options (variable);
dcl  com_err_ entry options (variable);
dcl  command_query_$yes_no entry options (variable);
dcl  convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35));
dcl  convert_date_to_binary_$relative entry (char (*), fixed bin (71), fixed bin (71), fixed bin (35));
dcl  cu_$arg_list_ptr entry (ptr);
dcl  cu_$af_return_arg_rel entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr);
dcl  cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr);
dcl  decode_clock_value_ entry (fixed bin (71), fixed bin, fixed bin, fixed bin,
     fixed bin (71), fixed bin, char (3) aligned);
dcl  encode_clock_value_ entry (fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin,
     fixed bin (71), fixed bin, char (3) aligned, fixed bin (71), fixed bin (35));
dcl  expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
dcl  hcs_$fs_get_mode entry (pointer, fixed bin (5), fixed bin (35));
dcl  hcs_$get_uid_seg entry (pointer, bit (36) aligned, fixed bin (35));
dcl  hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), pointer, fixed bin (35));
dcl  hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), pointer, fixed bin (35));
dcl  hcs_$set_bc_seg entry (pointer, fixed bin (24), fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  ioa_$ioa_switch entry options (variable);
dcl  iox_$control entry (ptr, char(*), ptr, fixed bin(35));
dcl  memo_delete_ entry (pointer, fixed bin, bit (1) aligned);
dcl  memo_list_ entry (pointer, fixed bin, bit (*));
dcl  memo_list_$format_time entry (fixed bin (71)) returns (char (40) varying);
dcl  memo_process_memos_ entry (pointer, (*) bit (1) unaligned, fixed bin (35), bit(1) aligned);
dcl  memo_set_ entry (pointer, char (*), bit (36) aligned, fixed bin (35), fixed bin (35), char (*)) returns (fixed bin);
dcl  memo_timer_set_ entry (pointer, entry);
dcl  memo_upgrade_memo_segment_ entry (pointer);
dcl  memo_util_$end_of_time entry () returns (fixed bin (71));
dcl  timer_manager_$reset_alarm_call entry (entry);
dcl  terminate_file_ entry (ptr, fixed bin(24), bit(*), fixed bin(35));
dcl  user_info_ entry (char (*), char (*), char (*));
dcl  user_info_$homedir entry (char (*));
     
dcl  iox_$user_io pointer external static;
dcl  iox_$error_output pointer external static;
dcl  sys_info$time_correction_constant fixed bin (71) external static;

dcl (error_table_$badopt,
     error_table_$bad_conversion,
     error_table_$inconsistent,
     error_table_$noarg,
     error_table_$noentry,
     error_table_$no_r_permission,     
     error_table_$no_w_permission,
     error_table_$not_act_fnc) fixed bin (35) external static;

dcl  SPACE char (1) aligned init (" ") internal static options (constant);
dcl  WHOAMI char (32) internal static options (constant) init ("memo");

dcl  (cleanup, conversion, size) condition;

dcl (null, substr, length, maxlength, binary, min, divide, multiply, ltrim, rtrim, convert, char, clock, hbound, index, string, verify) builtin;

%page;


	call initialize_memo ();			/* set things up */

	memo_segment_modified = "0"b;

	on condition (cleanup) call clean_things_up ();	/* set up to restart the timers */

	memo_invocation_count = memo_invocation_count + 1; /* Remember that there is an active invocation */
          call cu_$arg_list_ptr (P_arg_list);
	
	call process_args ();			/* find out about our arguments */

	if dname = "" then do;			/* no pathname explicitly specified, use default. */
	     call get_default_memo_seg ();
	     memo_segment_ptr = static_pointer;		/* set our pointer */
	     end;

	else if set_pathname_sw then do;		/* otherwise, perhaps set it in static */
	     static_pointer = null ();		/* new memo seg */
	     static_dname = dname;
	     static_ename = ename;
	     static_uid = ""b;

	     call get_default_memo_seg ();		/* get the new default one */
	     memo_segment_ptr = static_pointer;
	     end;

	else do;					/* otherwise, just use it for now */
	     call hcs_$initiate_count (dname, ename, "", 0, 0, memo_segment_ptr, code);
	     if memo_segment_ptr = null () then do;
		call complain (code, WHOAMI,"^/memo segment ^a>^a does not exist.", dname, ename);
		complained = "1"b;
		goto MAIN_RETURN;
		end;

               /* handling for this temporarily known memo segment must be handled seperately */
               call hcs_$fs_get_mode (memo_segment_ptr, fs_mode, code); /* now, see if we have access */
	     if code ^= 0 then do;			/* seems unlikely */
	        call complain (code, WHOAMI, "^a>^a", dname, ename);
	        complained = "1"b;
         	        goto MAIN_RETURN;
	        end;
          
	     if fs_mode = (R_ACCESS_BIN + W_ACCESS_BIN) | fs_mode = (R_ACCESS_BIN + E_ACCESS_BIN + W_ACCESS_BIN) then
	        have_write_access, have_read_access = "1"b;
	     else if fs_mode = R_ACCESS_BIN | fs_mode = (R_ACCESS_BIN + E_ACCESS_BIN) then
	        have_read_access = "1"b;

	     if ^have_read_access then do;			/* sorry, can't do anything at all with it */
	        call complain (error_table_$no_r_permission, WHOAMI,
"^/memo segment: ^a>^a", dname, ename);
                  complained = "1"b;
	        goto MAIN_RETURN;
                  end;

               if memo_segment.version ^= MEMO_SEGMENT_VERSION_3 then do;
		call complain (0, WHOAMI, "Memo segment ^a>^a is not compatible with current version of memo.",
		     dname, ename);
		complained = "1"b;
		goto MAIN_RETURN;
		end;
	     end;					/* of getting memo segment pointer */

%page;

	if status_sw then do;			/* report status of default memo segment */
	     call ioa_ ("Default memo segment is ^[^a>^a (^p), UID = ^w^;<<Unset>>^]",
		(static_pointer ^= null ()), static_dname, static_ename, static_pointer, static_uid);
	     if static_pointer ^= null () then
		call ioa_ ("Default memo segment is version ^d, ^d slots max used.",
		     static_pointer -> memo_segment.version, static_pointer -> memo_segment.max_number_used);

	     call ioa_ ("Memo timers are ^[en^;dis^]abled.", memo_timers_enabled);
	     complained = "1"b;
	     goto MAIN_RETURN;			/* all done, since we know -status was only operation */
	     end;
	  

	if process_memos_sw then do;			/* select the memos, and process them. Selection defaults to */
	     call select_memos ();			/* mature, nonalarm memos, if user did not specify otherwise */

	     if memo_match_count > 0 then do;
		memo_segment_modified = "1"b; 	/* assume this will modify it */
		call memo_process_memos_ (memo_segment_ptr, memo_bits, memo_time_now, have_write_access);
		end;

	     else if ^brief_sw then			/* only print silly message if user wants it, of course */
		call ioa_$ioa_switch (iox_$error_output, "No memos.");
	     end; 				/* of case for no explicitly specified options */

%page;

	else if print_sw then do;			/* print selected memos */
	     call select_memos ();

	     if memo_match_count = 0 then do;		/* nothing there */
NO_MEMOS_SELECTED:	if ^brief_sw then call ioa_$ioa_switch (iox_$error_output, "No memos selected.");
		complained = "1"b;
		goto MAIN_RETURN;
		end;

	     do idx = 1 to memo_segment.max_number_used;
		if memo_bits (idx) = "1"b then do;
		     call ioa_ ("^3d)^2x^a", idx, memo_entry (idx).data);
		     end;
		end;				/* of loop through memos */
	     end; 				/* of case for deletion */


	else if list_sw then do;			/* produce formatted memo listing */
	     call select_memos ();

	     if (memo_match_count = 0) & ^af_sw then	/* nothing there */
		goto NO_MEMOS_SELECTED;

	     if totals_sw then do;			/* just print (or return) total count */
		if af_sw then rs = ltrim (char (memo_match_count));
		else call ioa_ ("^d memos selected.", memo_match_count);
		end;

	     else do idx = 1 to memo_segment.max_number_used;
		if memo_bits (idx) = "1"b then do;
		     if af_sw then do;		/* list as an AF returns a list of memo numbers */
			if length (rs) > 0 then rs = rs || " "; /* separated, natch, by spaces */
			rs = rs || ltrim (char (idx));
			end;			/* of AF case */
		     else call memo_list_ (memo_segment_ptr, idx, ""b);
		     end;
		end;				/* of loop through memos */
	     end; 				/* of case for listing */

%page;


	else if delete_sw then do;			/* delete selected memos */
	     call select_memos ();			/* find out about the ones to delete */

	     if memo_match_count = 0 then goto NO_MEMOS_SELECTED; /* nothing there */

	     if ^have_write_access then do;
		call complain (0, WHOAMI, "Must have w access to ^a>^a to delete memos.", dname, ename);
		goto MAIN_RETURN;
		end;

	     memo_segment_modified = "1"b;		/* remember that it has been modified */

	     do idx = 1 to memo_segment.max_number_used;	/* loop through them all */
		if memo_bits (idx) = "1"b then do;	/* this one was selected */
		     call memo_delete_ (memo_segment_ptr, idx, force_sw);
		     end;
		end;				/* of loop through memos */
	     end; 				/* of case for deletion */


	else if postpone_sw then do;			/* postpone some until later */
	     call select_memos ();

	     if memo_match_count = 0 then goto NO_MEMOS_SELECTED; /* nothing there */

	     if ^have_write_access then do;
		call complain (0, WHOAMI, "Must have w access to ^a>^a to postpone memos.", dname, ename);
		goto MAIN_RETURN;
		end;

	     memo_segment_modified = "1"b;		/* remember that it has been modified */

	     do idx = 1 to memo_segment.max_number_used;
		if memo_bits (idx) = "1"b then do;
		     memo_entry (idx).time = from_gmt (postpone_time);
		     end;
		end;
	     end; 				/* of case for postponement */

%page;

	else if set_memo_sw then do;			/* we are to set one */
	     set_flags = arg_flags;			/* copy flags from whatever was specified earlier */
	     set_flags.print = "1"b;

	     if call_sw then do;
		set_flags.execute = "1"b;
		set_flags.print = "0"b;
		end;

	     if invisible_sw then maturity_time = end_of_time; /* kludgy way of indicating invisibility */

	     if maturity_time = -1 then maturity_time = time_now;

	     if expires_sw then do;			/* must calculate "expiration delta" here, since there isn't */
		call convert_date_to_binary_$relative	/* room to store the actual string. Thus, values like "1month" */
		     (expiration_string, expiration_time, maturity_time, code); /* may behave strangely */

		if code ^= 0 then do;
		     call complain (code, WHOAMI, "Expiration time ^a. Memo not set.", expiration_string);
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		if expiration_time <= maturity_time then do; /* can't expire before set, dummy. */
		     call complain (0, WHOAMI, "Expiration time ^a happens before maturity (^a). Memo not set.",
			expiration_string, memo_list_$format_time (maturity_time));
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		expiration_delta = divide ((expiration_time - maturity_time), 1000000, 35, 0); /* change to seconds */
		end;

	     else expiration_delta = 0;		/* otherwise, doesn't expire */

	     if ^have_write_access then do;
		call complain (0, WHOAMI, "Must have w access to ^a>^a to set a memo. Memo not set.", dname, ename);
		goto MAIN_RETURN;
		end;

	     memo_segment_modified = "1"b;

	     temp1 = memo_set_ (memo_segment_ptr, (memo_text), string (arg_flags),
		from_gmt (maturity_time), expiration_delta, repeat_string);

	     if af_sw then rs = ltrim (char (temp1));	/* return index of memo which just got set */
	     end;					/* of case for setting a memo */

%page;

	if turn_timer_off_sw then			/* now, turn timers on and off, and set them */
	     memo_timers_enabled = "0"b;
	if turn_timer_on_sw then
	     memo_timers_enabled = "1"b;

MAIN_RETURN:					/* all done here */
	call clean_things_up ();			/* turn timers on & clean up, if necessary */

	return;

%page;


memo$alarm_entry: entry ();

/* *	This entry is invoked by the alarm timer which goes off to make alarm memos work */

	call initialize_memo ();

	complain = com_err_;    /* moved in front of on unit to avoid window				*/

          call hcs_$fs_get_mode (static_pointer, fs_mode, code); /* now, see if we have access */
	if code ^= 0 then do;			/* seems unlikely */
	   call complain (code, WHOAMI, "^a>^a", dname, ename);
         	   return;
	   end;
          
	if fs_mode = (R_ACCESS_BIN + W_ACCESS_BIN) | fs_mode = (R_ACCESS_BIN + E_ACCESS_BIN + W_ACCESS_BIN) then
	   have_write_access = "1"b;

	on condition (cleanup) call clean_things_up ();	/* turn timers back on, etc. */

	memo_invocation_count = memo_invocation_count + 1;

	memo_segment_ptr = static_pointer;
	if memo_segment_ptr = null () then do;
	     call complain (0, WHOAMI, "No memo segment is active. Please type ""memo"" to reset.");
	     return;
	     end;

	call select_mature_memos ("1"b);		/* select all mature alarm memos */

	if memo_match_count > 0 then do;
	     memo_segment_modified = "1"b;		/* assume it will get modified */
	     call memo_process_memos_ (memo_segment_ptr, memo_bits, memo_time_now, have_write_access);
	     end;
	else call complain (0, WHOAMI, "Warning: Alarm received with no memos mature.");

	call iox_$control (iox_$user_io, "start", (null ()), (0));

	call clean_things_up ();			/* exit in an orderly fashion */

	return;					/* done with alarm_entry */

%page;

select_all_memos: proc ();

/* *	This procedure selects all existing memos. */

dcl  idx fixed bin;

	memo_match_count = 0;
	string (memo_bits) = ""b;			/* start out with none */

	do idx = 1 to memo_segment.max_number_used;
	     if memo_entry (idx).taken ^= ""b then do;
		memo_match_count = memo_match_count + 1;
		memo_bits (idx) = "1"b;
		end;
	     end;					/* of loop through memos */

	return;
	end select_all_memos;
       


select_mature_memos: proc (P_alarm);

/* *	This procedure selects all the mature memos which are either alarm or non-alarm */

dcl  P_alarm bit (1) aligned;

dcl  idx fixed bin;

	memo_match_count = 0;
	string (memo_bits) = ""b;			/* start out with none */

	do idx = 1 to memo_segment.max_number_used;
	     if memo_entry (idx).taken ^= ""b then
		if memo_entry (idx).flags.alarm = P_alarm then /* perform filtering on alarmedness */
		     if memo_entry (idx).time <= memo_time_now then do; /* got one */
			memo_match_count = memo_match_count + 1;
			memo_bits (idx) = "1"b;
			end;
	     end;					/* of loop through memos */

	return;
	end select_mature_memos;
       
%page;

select_memos: proc () options (non_quick);

/* *	This procedure sets bits in the memo_bits array to indicate which memos have been selected.
   *	It has knowledge of the type of operation being performed; that is, it behaves differently
   *	when printing, listing, deleting, or postponing. */

dcl  string_match_bits (memo_segment.max_number_used) bit (1) unaligned;
dcl  range_match_bits (memo_segment.max_number_used) bit (1) unaligned;
dcl  type_match_bits (memo_segment.max_number_used) bit (1) unaligned;
dcl  range_match_count (n_memo_numbers) fixed bin;

dcl  total_string_match_count fixed bin;
dcl (idx, jdx) fixed bin;
dcl  matched bit (1) aligned;
dcl (start, finish) fixed bin;


	string (string_match_bits) = ""b;		/* start out with none */
	string (range_match_bits) = ""b;
	string (type_match_bits) = ""b;
	range_match_count (*) = 0;

	if delete_sw | postpone_sw then do;		/* special checking, since otherwise no args would mean "all" */
	     if n_match_strings = 0 & n_memo_numbers = 0 then do; /* can't delete just "invisible", etc. memos, either. */
		call complain (0, WHOAMI, "At least one memo specifier must be used for deletion or postponement.");
		complained = "1"b;
		goto MAIN_RETURN;
		end;
	     end;

	if n_memo_numbers = 0 & n_match_strings = 0 & ^select_options_specified_sw then do;
	     if print_sw | process_memos_sw then	/* mark only the mature ones, if -print or -process specified */
		call select_mature_memos ("0"b);	/* select mature, non-alarm memos */
	     else call select_all_memos ();		/* select all existing memos */
	     return;
	     end;

	if n_match_strings > 0 then do;
	     total_string_match_count = 0;
	     do idx = 1 to memo_segment.max_number_used;	/* try to match against strings */
		if memo_entry (idx).taken ^= ""b then do;
		     do jdx = 1 to n_match_strings while (^string_match_bits (idx));
			if index (memo_entry (idx).data, match_string (jdx)) > 0 then do;
			     string_match_bits (idx) = "1"b;
			     total_string_match_count = total_string_match_count + 1;
			     end;
			end;
		     end;
		end;
	     end;

	if n_memo_numbers > 0 then do;
	     do idx = 1 to n_memo_numbers;		/* loop through all the ranges */
		start = min (memo_segment.max_number_used + 1, memo_number (idx).start);
		finish = min (memo_segment.max_number_used, memo_number (idx).finish);
		do jdx = start to finish;
		     if memo_entry (jdx).taken ^= ""b then do;
			range_match_bits (jdx) = "1"b;
			range_match_count (idx) = range_match_count (idx) + 1;
			end;
		     end;
		end;
	     end;

	if select_options_specified_sw then do;		/* only select certain types of memos */
	     select_flags = arg_flags;
	     if ^invisible_sw & string (select_flags) = ""b then do; /* no explicitly specified options */
		string (select_flags) = "777777777777"b3; /* turn them all on */
		select_flags.pad1 = ""b;		/* except for the padding */
		end;

	     do idx = 1 to memo_segment.max_number_used;
		if memo_entry (idx).taken ^= ""b then do;
		     matched = "0"b;
		     if (string (memo_entry (idx).flags) & string (select_flags)) ^= ""b then
			matched = "1"b;		/* got it by selecting on flags */

		     if from_time ^= -1 then do;	/* see if it's in the right time range */
			matched = "1"b;
			if memo_entry (idx).time >= end_of_memo_time then matched = "0"b; /* discard invisibles */
			else if memo_entry (idx).time < from_gmt (from_time) then matched = "0"b;
			else if memo_entry (idx).time > from_gmt (to_time) then matched = "0"b;
			end;

		     if invisible_sw then		/* kludge mechanism to select invisible memos because it's */
			if memo_entry (idx).time >= end_of_memo_time then /* done by date, rather than having a flag */
			     matched = "1"b;

		     if string_match_bits (idx) then    /* phx21142 - another kludge to pass match strings */
			matched = "1"b;		/* ... as a match is a select_option */

		     type_match_bits (idx) = matched;
		     end;
		end;				/* of loop through memos */
	     end;

	if n_memo_numbers > 0 then do;		/* see if any of the numbers or ranges lost */
	     do idx = 1 to n_memo_numbers;
		if range_match_count (idx) = 0 then do; /* yup... */
		     if memo_number (idx).start = memo_number (idx).finish then
			call complain (0, WHOAMI, "No memos selected by specifier ^d.", memo_number (idx).start);
		     else call complain (0, WHOAMI, "No memos selected by range ^d:^d.",
			memo_number (idx).start, memo_number (idx).finish);
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;
		end;
	     end;

	if n_memo_numbers > 0 then do;
	     string (memo_bits) = string (range_match_bits);
	     if n_match_strings > 0 then
		string (memo_bits) = string (memo_bits) & string (string_match_bits);
	     if select_options_specified_sw then
		string (memo_bits) = string (memo_bits) & string (type_match_bits);
	     end;

	else if n_match_strings > 0 then do;
	     string (memo_bits) = string (string_match_bits);
	     if select_options_specified_sw then
		string (memo_bits) = string (memo_bits) & string (type_match_bits);
	     end;

	else string (memo_bits) = string (type_match_bits);

	memo_match_count = 0;
	do idx = 1 to memo_segment.max_number_used;	/* now count the total number of matches */
	     if memo_bits (idx) = "1"b then
		memo_match_count = memo_match_count + 1;
	     end;

	return;
	end select_memos;
       
%page;

process_args: proc ();

/* *	This procedure processes command arguments for the memo command. */

dcl  argno fixed bin;
dcl (al, al1) fixed bin (21);
dcl (ap, ap1) pointer;
dcl  arg char (al) based (ap);
dcl  arg1 char (al1) based (ap1);
dcl (n1, n2, n3) fixed bin (35);
dcl (collecting_memo_sw, collecting_numbers_sw) bit (1) aligned;
dcl (action_count, real_action_count, option_count) fixed bin;
dcl  might_set_sw bit (1) aligned;
dcl  answer bit (1) aligned;
dcl  repeat_time fixed bin (71);

	    
	    

	call cu_$af_return_arg_rel (nargs, rsp, rsl, code, P_arg_list);
	if code = 0 then do;
	     af_sw = "1"b;
	     complain = active_fnc_err_;
	     rs = "";
	     end;

	else if code = error_table_$not_act_fnc then do;
	     af_sw = "0"b;
	     complain = com_err_;
	     end;

	else do;
	     call com_err_ (code, WHOAMI);
	     complained = "1"b;
	     goto MAIN_RETURN;
	     end;

%page;
	might_set_sw = "1"b;			/* assume memo is gonna get set until we learn otherwise */
	collecting_memo_sw = "0"b;			/* true as soon as we encounter first apparent memo text */
	collecting_numbers_sw = "0"b;			/* true if we are collecting numbers, rather than text. */


%page;

LOOP_THROUGH_ARGUMENTS:

	do argno = 1 to nargs;
	     call cu_$arg_ptr_rel (argno, ap, al, (0), P_arg_list);
	     if list_sw | print_sw | postpone_sw | delete_sw | process_memos_sw then do;
		might_set_sw = "0"b;
		collecting_numbers_sw = "1"b;
		end;

	     if substr (arg, 1, 1) ^= "-" | collecting_memo_sw then do; /* not a control arg, see what to do */
		if ^collecting_memo_sw & ^collecting_numbers_sw then /* if not numbers, time to start with text */
		     collecting_memo_sw = "1"b;

		if collecting_numbers_sw then do;	/* try it out as a number */
		     might_set_sw = "0"b;		/* we're doing some sort of list/print/whatever, so no memo */
		     n1 = verify (arg, "0123456789:");	/* is it a number or a range ? */
		     if n1 ^= 0 then do;
BAD_MEMO_NUMBER:		code = error_table_$bad_conversion;
			call complain (code, WHOAMI,
			     "Memo number must be a positive integer or a range, not ""^a"".", arg);
			complained = "1"b;
			goto MAIN_RETURN;
			end;

		     n1 = index (arg, ":");		/* get index of range delimiter */
		     if n1 = 0 then do;		/* no colon, just a single integer */
		          on conversion, size goto BAD_MEMO_NUMBER;
                              n2 = convert (n2, arg);
                              revert conversion, size;
			n3 = n2;			/* range start and end are the same */
			end;

		     else do;			/* otherwise, it's a range */
			if n1 = 1 | n1 = al then	/* colon at start or end */
			     goto BAD_MEMO_NUMBER;

			on conversion, size goto BAD_MEMO_NUMBER;
			n2 = convert (n2, substr (arg, 1, n1 -1)); /* start of range */
			n3 = convert (n3, substr (arg, n1 + 1));   /* end of range */
			revert conversion, size;

			if n3 < n2 then do;		/* can't list 12 through 10, y'know.... */
			     call complain (0, WHOAMI,
				"The upper bound of a range must be greater than the lower bound: ^a", arg);
			     complained = "1"b;
			     goto MAIN_RETURN;
			     end;
			end;

                         if n2 = 0 then do;     /* null second argument check */
		        call complain (0, WHOAMI,
"0 is not an acceptable memo number.");
                            complained = "1"b;
		        goto MAIN_RETURN;
		        end;

		     if n_memo_numbers >= hbound (memo_number, 1) then do;
			call complain (0, WHOAMI, "Too many memo numbers specified. Max is ^d.",
			     hbound (memo_number, 1));
			complained = "1"b;
			goto MAIN_RETURN;
			end;

		     n_memo_numbers = n_memo_numbers + 1; /* remember this one in our list */
		     memo_number (n_memo_numbers).start = n2;
		     memo_number (n_memo_numbers).finish = n3;
		     end;				/* of case for a number */

		else if collecting_memo_sw then do;	/* otherwise, add it to the memo text string */
		     if al + 1 + length (memo_text) > maxlength (memo_text) then do;
			call complain (0, WHOAMI, "Memo text is too long. Max is ^d characters. Memo not set.",
			     maxlength (memo_text));
			complained = "1"b;
			goto MAIN_RETURN;
			end;

		     if length (memo_text) > 0 then	/* add a space if not first word */
			memo_text = memo_text || SPACE;
		     memo_text = memo_text || arg;	/* and add the argument as well */
		     might_set_sw = "1"b;		/* all further error messages should say Memo not set */
		     set_memo_sw = "1"b;		/* we know we're supposed to set it, now */
		     end;				/* of case for adding memo text */

		end;				/* of case for non control argument */

	     else if arg = "-memo" then do;		/* means next arg is memo text */
		if collecting_numbers_sw then do;
		     call complain (error_table_$inconsistent, WHOAMI,
			"Memo setting (with -memo) may not be combined with any other operations. Memo not set.");
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		if argno = nargs then do;
		     call complain (error_table_$noarg, WHOAMI, "Some memo text must follow -memo.^2xMemo not set.");
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		collecting_memo_sw = "1"b;
		end;

	     else if arg = "-brief" | arg = "-bf" then brief_sw = "1"b;
	     else if arg = "-long" | arg = "-lg" then brief_sw = "0"b;
	     else if arg = "-totals" | arg = "-total" | arg = "-tt" then totals_sw = "1"b;
	     else if arg = "-on" then turn_timer_on_sw = "1"b;
	     else if arg = "-off" then turn_timer_off_sw = "1"b;
	     else if arg = "-force" | arg = "-fc" then force_sw = "1"b;
	     else if arg = "-status" | arg = "-st" then status_sw = "1"b;

	     else if arg = "-invisible" | arg = "-iv" then invisible_sw = "1"b;
	     else if arg = "-alarm" | arg = "-al" then alarm_sw = "1"b;
	     else if arg = "-call" then call_sw = "1"b;
	     else if arg = "-repeat_when_processed" | arg = "-rwp" then per_process_sw = "1"b;
	     else if arg = "-retain" | arg = "-ret" then remains_sw = "1"b;
	     else if arg = "-no_retain" | arg = "-nret" then single_sw = "1"b;

	     else if arg = "-postpone" | arg = "-pp" then do; /* postpone all the memos specified */
		postpone_time = get_next_date_arg ();	/* get the date to postpone to */

		collecting_numbers_sw = "1"b;		/* and get ready to collect memo numbers */
		postpone_sw = "1"b;
		end;

	     else if arg = "-list" | arg = "-ls" then list_sw = "1"b;
	     else if arg = "-print" | arg = "-pr" then print_sw = "1"b;
	     else if arg = "-delete" | arg = "-dl" then delete_sw = "1"b;
	     else if arg = "-process" then process_memos_sw = "1"b;

	     else if arg = "-date" | arg = "-dt" then do; /* midnight of this particular date */
		if maturity_time ^= -1 then do;	/* already have one */
ALREADY_HAVE_DATE:	     call complain (0, WHOAMI,
			"Only one value may be specified with -date or -time.^[^2xMemo not set.^]", might_set_sw);
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		maturity_time = get_next_date_arg ();

		call decode_clock_value_ (maturity_time, month_value, day_of_month, year_value, (0), (0), zone_value);
		call encode_clock_value_ (month_value,
		     day_of_month, year_value, 0, 0, 0, 0, 0, zone_value, maturity_time, code);

		if code ^= 0 then do;
		     call complain (code, WHOAMI, "^a^[.^2xMemo not set.^]", arg, might_set_sw);
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;
		end;				/* of processing for -date */

	     else if arg = "-time" | arg = "-tm" then do;
		if maturity_time ^= -1 then goto ALREADY_HAVE_DATE;

		maturity_time = get_next_date_arg ();
		end;				/* of processing for -time */

	     else if arg = "-from" | arg = "-fm" then do; /* list memos maturing at or after this time */
		if from_time ^= -1 then do;		/* already have one */
		     call complain (0, WHOAMI, "Only one value may be specified for -from.");
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		from_time = get_next_date_arg ();
		end;				/* of processing for -from */

	     else if arg = "-to" then do;		/* list memos maturing at or before this time */
		if to_time ^= -1 then do;		/* already have one */
		     call complain (0, WHOAMI, "Only one value may be specified for -to.");
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		to_time = get_next_date_arg ();
		end;				/* of processing for -to */

	     else if arg = "-repeat" | arg = "-rp" | arg = "-rpt" then do;
		if repeat_sw then do;		/* we already have one */
		     call complain (0, WHOAMI,
			"Only one value may be specified for -repeat.^[^2xMemo not set.^]", might_set_sw);
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		repeat_sw = "1"b;			/* remember that we have a repeat specification */

		if argno = nargs then		/* if last argument, and listing, printing, etc., */
		     if list_sw | print_sw | postpone_sw | delete_sw then /* accept it as an option specification */
			goto END_ARGUMENT_LOOP;

		call get_next_string_arg ();		/* puts it in arg1 */

		if al1 > maxlength (repeat_string) then do; /* too long */
		     call complain (0, WHOAMI, "The repeat string may only be ^d characters.^[^2xMemo not set.^]",
			maxlength (repeat_string), might_set_sw);
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		repeat_string = arg1;
		end;				/* of processing for -repeat */


	     else if arg = "-times" then do;		/* limit on how many times we can repeat */
		if "1"b then goto BADOPT;		/* for now, it's unimplemented */
		repeat_count_sw = "1"b;		/* remember that we have one */

		if argno = nargs then		/* if last argument, and listing, printing, etc., */
		     if list_sw | print_sw | postpone_sw | delete_sw then /* accept it as an option specification */
			goto END_ARGUMENT_LOOP;

		call get_next_string_arg ();		/* put it in arg1 */

		on conversion, size goto BAD_CONVERSION;
		repeat_count = convert (repeat_count, arg1);
		revert conversion, size;

		if repeat_count < 1 then goto BAD_REPEAT_COUNT; /* must be positive, ninny (code will be zero) */
		end;				/* of processing for -times */

	     else if arg = "-expires" | arg = "-expire" | arg = "-exp" | arg = "-ex" then do;
		if expires_sw then do;
		     call complain (0, WHOAMI,
			"Only one value may be specified for expiration time.^[^2xMemo not set.^], might_set_sw");
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		expires_sw = "1"b;			/* remember that we have an expiration specification */

		if argno = nargs then		/* if last argument, and listing, printing, etc., */
		     if list_sw | print_sw | postpone_sw | delete_sw then /* accept it as an option specification */
			goto END_ARGUMENT_LOOP;

		call get_next_string_arg ();		/* puts it in arg1 */

		call convert_date_to_binary_ (arg1, temp_date, code);
		if code ^= 0 then do;
		     call complain (code, WHOAMI,
			"^a must be followed by a valid time value not ""^a"".^[^2xMemo not set.^]",
			arg, arg1, might_set_sw);
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		L_expiration_string = al1;
                    P_expiration_string = ap1;
		end;				/* of processing for -expires */

	     else if arg = "-class" then do;		/* memos in this class or classes */
		if "1"b then goto BADOPT;		/* for now, it's unimplemented */
		call get_next_string_arg ();		/* puts it in arg1 */

		if al1 > maxlength (class_name (1)) then do; /* too long */
		     call complain (0, WHOAMI, "A class name may only be ^d characters.", maxlength (class_name (1)));
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		if n_class_names >= hbound (class_name, 1) then do;
		     call complain (0, WHOAMI, "Too many class names specified. Max is ^d.", hbound (class_name, 1));
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		n_class_names = n_class_names + 1;
		class_name (n_class_names) = arg1;
		end;				/* of processing for -class */

	     else if arg = "-match" then do;		/* memos matching this string */
		call get_next_string_arg ();		/* puts it in arg1 */

		if al1 > maxlength (match_string (1)) then do; /* too long */
		     call complain (0, WHOAMI, "The match string may only be ^d characters.",
			maxlength (match_string (1)));
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		if n_match_strings >= hbound (match_string, 1) then do;
		     call complain (0, WHOAMI, "Too many match strings specified. Max is ^d.", hbound (match_string, 1));
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		n_match_strings = n_match_strings + 1;
		match_string (n_match_strings) = arg1;
		end;				/* of processing for -match */

	     else if arg = "-path_name" | arg = "-pathname" | arg = "-path" | arg = "-pn" then do;
		if dname ^= "" then do;		/* already have one */
		     call complain (0, WHOAMI, "Only one pathname may be specified.^[^2xMemo not set.^]", might_set_sw);
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;

		call get_next_string_arg ();		/* puts it in arg1 */

		if arg1 = "-default" | arg1 = "-dft" then do; /* construct default pathname */
		     call user_info_$homedir (dname);
		     ename = static_person || ".memo";
		     end;

		else do;				/* otherwise, a real pathname */
		     call expand_pathname_$add_suffix (arg1, "memo", dname, ename, code);
		     if code ^= 0 then do;
			call complain (code, WHOAMI, "^a^[.^2xMemo not set.^]", arg1, might_set_sw);
			complained = "1"b;
			goto MAIN_RETURN;
			end;
		     end;
		end;				/* of processing for -pathname */

	     else do;				/* not one of ours, Jack. */
BADOPT:		call complain (error_table_$badopt, WHOAMI, "^a^[.^2xMemo not set.^]", arg, might_set_sw);
		complained = "1"b;
		goto MAIN_RETURN;
		end;

END_ARGUMENT_LOOP:
end LOOP_THROUGH_ARGUMENTS;
	  

%page;

	if (^set_memo_sw) & (maturity_time > 0) & (to_time = -1) & (from_time = -1) then do;
	     to_time = maturity_time; 		/* Kludge to make memo -print -time 2359.9 work like it */
	     maturity_time = -1;			/* used to work. */
	     end;

	if to_time > 0 & from_time = -1 then		/* to without from, list all from beginning */
	     from_time = 0;

	if from_time > 0 & to_time = -1 then		/* from without to, list all until the end of time */
	     to_time = end_of_time;

	action_count = binary (set_memo_sw, 1)
	     + binary (process_memos_sw, 1)
	     + binary (postpone_sw, 1)
	     + binary (delete_sw, 1)
	     + binary (list_sw, 1)
	     + binary (print_sw, 1);

	string (arg_flags) = ""b;			/* copy the flags into a copy of the structure */
	arg_flags.repeatsw = repeat_sw;
	arg_flags.single = single_sw;
	arg_flags.remains = remains_sw;
	arg_flags.expires = expires_sw;
	arg_flags.execute = call_sw;
	arg_flags.alarm = alarm_sw;
	arg_flags.per_process = per_process_sw;

	option_count = binary (invisible_sw, 1)		/* whether any memo options were specified */
	     + binary ((string (arg_flags) ^= ""b), 1)	/* assorted options here */
	     + binary (mature_sw, 1)
	     + binary (immature_sw, 1)
	     + binary ((maturity_time ^= -1), 1)
	     + binary ((repeat_count ^= -1), 1)
	     + binary ((from_time ^= -1), 1)
	     + binary ((n_match_strings ^= 0), 1);	/* MF - phx21142 - -match needs to be included */

	select_options_specified_sw = (option_count > 0); /* flag for use in select_memos */

/* *	Now check for various illegal combinations. An example is provided for most of these,
   *	which illustrates the type of error that might cause the illegal combination. */

	if turn_timer_on_sw & turn_timer_off_sw then	/* memo -on -off */
	     call inconsistent ("-on and -off.");

	real_action_count = action_count;		/* to detect those options which may be combined */

	if action_count = 0 & (turn_timer_on_sw | turn_timer_off_sw) then do; /* allow timer to be turned on and off */
	     if option_count > 0 then			/* along with other actions, as well as alone */
		call inconsistent ("No memo options may be specified when turning the timers on and off.");
	     real_action_count = 1;			/* memo -invisible -off */
	     end;

	if action_count = 0 & dname ^= "" then do;	/* memo -invisible -pathname >frobboz */
	     if option_count > 0 then
		call inconsistent ("No memo options may be specified when setting the default pathname.");
	     set_pathname_sw = "1"b;			/* we are to set the static pathname */
	     memo_timers_enabled = "0"b;		/* turn this off, so switching segs won't blow us out */
	     real_action_count = 1;			/* turn it into an "action", so succeeding tests will work */
	     end;

	if real_action_count = 0 & option_count = 0 then do; /* if no other options specified, we're just to process */
	     turn_timer_on_sw = "1"b;		/* mature memos and turn on the timers */
	     process_memos_sw = "1"b;			/* so indicate that */
	     end;

	else if real_action_count = 0 then do;		/* nothing specified */
	     call complain (error_table_$noarg, WHOAMI,	/* memo -invisible */
		"Some action must be specified when memo options are specified.^2xMemo not set.");
	     complained = "1"b;
	     goto MAIN_RETURN;
	     end;					/* of case for no explicit actions */

	if repeat_sw then do;			/* check the repeat time for validity */
	     call convert_date_to_binary_$relative (repeat_string, repeat_time, time_now, code);
	     if code ^= 0 then do;
		call complain (code, WHOAMI,
		     "-repeat must be followed by a valid time offset, not ""^a"".^[^2xMemo not set.^]",
		     repeat_string, set_memo_sw);
		complained = "1"b;
		goto MAIN_RETURN;
		end;

	     if repeat_time <= time_now then do;
		call complain (0, WHOAMI, "The repeat string ^a yields a time in the past.^[^2xMemo not set.^]",
		     repeat_string, set_memo_sw);
		complained = "1"b;
		goto MAIN_RETURN;
		end;

	     if set_memo_sw & ^force_sw & ((repeat_time - time_now) < (60 * 1000000)) then do; /* allow forcing */
						/* if setting a memo, not supposed to say -repeat 1second */
		call command_query_$yes_no (answer, 0, WHOAMI, "", /* but give the user a chance anyway */
		     "The repeat interval ^a is less than one minute. Do you still wish to use it?", repeat_string);
		if answer = "0"b then do;
		     call complain (0, WHOAMI, "Memo not set.");
		     complained = "1"b;
		     goto MAIN_RETURN;
		     end;
		end;
	     end; 				/* of testing for -repeat */

%page;

	if action_count > 1 then call inconsistent	/* memo -delete -print */
	     ("Only one action (printing, listing, deletion, postponement or memo setting) may be specified.");

	if force_sw & ^(delete_sw | postpone_sw | set_memo_sw) then /* memo -force -list */
	     call inconsistent ("-force may only be specified with -delete or -postpone.");

	if set_memo_sw & (from_time ^= -1 | mature_sw | immature_sw) then
	     call inconsistent			/* memo -from 3days Shoot first, ask questions later. */
		("The -from, -to, -mature and -immature control arguments may not be combined with memo setting.");

	if af_sw & ^(set_memo_sw | list_sw) then	/* ps [memo -delete 10] */
	     call inconsistent ("Only memo setting and listing are allowed as an active function.");

	if (from_time ^= -1) & (maturity_time ^= -1) then /* memo -ls -date Monday -from Tuesday */
	     call inconsistent ("The -from and -to arguments may not be combined with -date or -time.");

	if set_memo_sw & ^alarm_sw & remains_sw then	/* memo -remains Buy new aardvark leash. */
	     call inconsistent ("-remains may only be used when setting an alarm memo.");

	if set_memo_sw & ^repeat_sw & per_process_sw then /* memo -per_process Check for elephants in the basement. */
	     call inconsistent ("-repeat_when_processed may only be used when setting a repeating memo.");

	if set_memo_sw & brief_sw then		/* memo -brief Buy 3 cans of frog propellant tomorrow! */
	     call inconsistent ("-brief not allowed when setting a memo.");

	if set_memo_sw & (n_memo_numbers > 0 | n_match_strings > 0) then /* memo -match EGGs Win 20 free dance lessons */
	     call inconsistent ("No memo numbers or match strings may be specified when setting a memo.");

	if set_memo_sw & (n_class_names > 1) then	/* memo -class C1 -class C2 This is a ring 1 multi-class memo */
	     call inconsistent ("At most one memo class may be specified when setting a memo.");

	if status_sw & nargs > 1 then 		/* This is cheating, but I really want it only for debugging */
	     call inconsistent ("-status must be the only argument if it is specified.");

	if totals_sw & ^list_sw then			/* memo -delete -tt */
	     call inconsistent ("-totals may only be used with -list.");

	return;

BAD_CONVERSION:	     code = error_table_$bad_conversion;
BAD_REPEAT_COUNT:	     call complain (code, WHOAMI,
			"-times must be followed by a positive number, not ""^a"".^[^2xMemo not set.^]",
			arg1, might_set_sw);
		     complained = "1"b;
		     goto MAIN_RETURN;
%page;

get_next_date_arg: proc () returns (fixed bin (71));

/* *	This procedure extracts the next argument in the string, and returns it as a clock value */

dcl  temp_time fixed bin (71);

	     if argno = nargs then do;
		call complain (error_table_$noarg, WHOAMI,
		     "Date/Time after ^a.^[^2xMemo not set.^]", arg, might_set_sw);
		complained = "1"b;
		goto MAIN_RETURN;
		end;

	     argno = argno + 1;
	     call cu_$arg_ptr_rel (argno, ap1, al1, (0), P_arg_list);

	     call convert_date_to_binary_ (arg1, temp_time, code);
	     if code ^= 0 then do;
		call complain (code, WHOAMI, "^a ^a^[.^2xMemo not set.^]", arg, arg1, might_set_sw);
		complained = "1"b;
		goto MAIN_RETURN;
		end;

	     return (temp_time);
	     end get_next_date_arg;
	  

get_next_string_arg: proc ();

/* *	This procedure extracts the next argument in the string, and returns it as a clock value */

	     if argno = nargs then do;
		call complain (error_table_$noarg, WHOAMI, "After ^a.^[^2xMemo not set^]", arg, might_set_sw);
		complained = "1"b;
		goto MAIN_RETURN;
		end;

	     argno = argno + 1;
	     call cu_$arg_ptr_rel (argno, ap1, al1, (0), P_arg_list);

	     return;
	     end get_next_string_arg;
	  


inconsistent: proc (P_message);

/* *	This procedure just calls complain with the message and punts. */

dcl  P_message char (*) parameter;

	     call complain (error_table_$inconsistent, WHOAMI, "^a^[^2xMemo not set.^]", P_message, set_memo_sw);
	     complained = "1"b;
	     goto MAIN_RETURN;

	     end inconsistent;
	  

	end process_args;
       

%page;

get_default_memo_seg: proc ();

/* *	This procedure tries to set the static_pointer to point to the right default memo segment */

dcl  temp_uid bit (36) aligned;

	if static_pointer ^= null () then do;		/* it claims we have one, so let's check.... */
	     call hcs_$get_uid_seg (static_pointer, temp_uid, code);
	     if code ^= 0 then do;
MEMO_SEG_ERROR:	call complain (code, WHOAMI, "^a>^a", static_dname, static_ename);
		complained = "1"b;
		goto MAIN_RETURN;
		end;

	     if temp_uid ^= static_uid then do;		/* Oh dear. Reused segment number.... */
		call com_err_ (0, WHOAMI, "Warning: ^a>^a has been terminated since last invocation of memo command.",
		     static_dname, static_ename);
		static_pointer = null ();		/* flag it as invalid */
		end;
	     end;

	if static_pointer = null () then do;		/* the segment isn't there. Let's see if we can find it */
	     if static_dname = "" then do;		/* first call, so set the pathname to the right default. */
		static_dname = default_memo_directory;
		static_ename = static_person || ".memo";
		dname = static_dname;
		ename = static_ename;
		end;

	     call hcs_$initiate_count (static_dname, static_ename, "", (0), 0, static_pointer, code);

	     if static_pointer = null () & code = error_table_$noentry then do; /* create if not there ? */
		call hcs_$make_seg (static_dname, static_ename, "", R_ACCESS_BIN + W_ACCESS_BIN, static_pointer, code);

		if static_pointer = null () then goto MEMO_SEG_ERROR; /* couldn't create, give up. */
		else call ioa_ ("^a: Creating ^a>^a.", WHOAMI, static_dname, static_ename);

		static_pointer -> memo_segment.version = MEMO_SEGMENT_VERSION_3; /* start out right.... */
		end;				/* of attempt to create memo segment */

	     if static_pointer = null () then		/* still?? we lost, then */
		goto MEMO_SEG_ERROR;

	     call hcs_$get_uid_seg (static_pointer, static_uid, code); /* remember its identifier, for good measure */
	     if code ^= 0 then goto MEMO_SEG_ERROR;
	     end;					/* of nonexistent memo seg case */

	call hcs_$fs_get_mode (static_pointer, fs_mode, code); /* now, see if we have access */
	if code ^= 0 then do;			/* seems unlikely */
	     call complain (code, WHOAMI, "^a>^a", dname, ename);
	     complained = "1"b;
	     goto MAIN_RETURN;
	     end;

	if fs_mode = (R_ACCESS_BIN + W_ACCESS_BIN) | fs_mode = (R_ACCESS_BIN + E_ACCESS_BIN + W_ACCESS_BIN) then
	     have_write_access, have_read_access = "1"b;
	else if fs_mode = R_ACCESS_BIN | fs_mode = (R_ACCESS_BIN + E_ACCESS_BIN) then
	     have_read_access = "1"b;

	if ^have_read_access then do;			/* sorry, can't do anything at all with it */
	     call complain (error_table_$no_r_permission, WHOAMI, "
memo segment: ^a>^a", static_dname, static_ename);

	     goto MAIN_RETURN;
	     end;

	if static_pointer -> memo_segment.version < MEMO_SEGMENT_VERSION_3 then /* try to covert */
	     call memo_upgrade_memo_segment_ (static_pointer); /* before testing again */

	if static_pointer -> memo_segment.version ^= MEMO_SEGMENT_VERSION_3 then do;
	     call complain (0, WHOAMI, "Memo segment ^a>^a is is not the correct version.", static_dname, static_ename);
	     complained = "1"b;
	     goto MAIN_RETURN;
	     end;

	return;
	end get_default_memo_seg;
       
%page;

initialize_memo: proc ();

/* *	This procedure initializes various variables for an invocation of memo. */

dcl (person, project) char (32);

	if ^static_initialized then do;
	     end_of_time = memo_util_$end_of_time ();	/* call and find out */
	     end_of_memo_time = from_gmt (end_of_time);
	     call user_info_ (person, project, (""));
	     static_person = rtrim (person);
	     static_project = rtrim (project);
	     call user_info_$homedir (default_memo_directory);
	     static_initialized = "1"b;
	     end;

	P_expiration_string = null;
	L_expiration_string = 0;
	P_arg_list = null;
	call timer_manager_$reset_alarm_call (memo$alarm_entry);

	complained = "0"b;
	memo_bits (*) = ""b;
	time_now = clock ();
	memo_time_now = from_gmt (time_now);
/* variable initializations moved here from process_args so they will be initialized from both entry points	*/
	memo_segment_modified = "0"b;			/* start out assuming that it wasn't modified */
	memo_segment_ptr = null ();			/* and with a null pointer to it */
 	memo_text = "";				/* the collected text of the memo being set */
	n_match_strings, n_memo_numbers = 0;		/* how many match strings/memo numbers have been collected */
	n_class_names = 0;				/* how many memo classes to process */
	list_sw, print_sw, delete_sw, postpone_sw = "0"b; /* one per action, other than setting */
	process_memos_sw = "0"b;			/* this is done if nothing else is specified */
	set_memo_sw = "0"b;
	set_pathname_sw = "0"b;			/* whether to use the specified pathname permanently */
	select_options_specified_sw = "0"b;
	maturity_time = -1;				/* the date we are interested in */
	repeat_string = "";				/* how often to repeat the memo */
	repeat_count = -1;				/* max number of times it gets repeated before exploding */
	repeat_sw, expires_sw, remains_sw, single_sw,	/* set if the option in question is to be used */
	     per_process_sw, alarm_sw, call_sw, repeat_count_sw, invisible_sw = "0"b;
	dname, ename = "";				/* pathname of specified memo segment */
	brief_sw = "0"b;				/* controls noisiness of messages */
	force_sw = "0"b;				/* whether or not to force deletion */
	totals_sw = "0"b;				/* for listing only, print total count rather than memos */
	turn_timer_on_sw, turn_timer_off_sw = "0"b;	/* timer control flags */
	af_sw = "0"b;
	fs_mode = 0;
	status_sw = "0"b;				/* whether to report status of default memo segment */
	from_time, to_time = -1;			/* time to list from/to */
	mature_sw, immature_sw = "0"b;		/* select only mature/immature memos */
	have_write_access = "0"b;
	have_read_access = "0"b;
          complained ="0"b;
	nargs = 0;

	return;
	end initialize_memo;
       


from_gmt:	proc (clock_value) returns (fixed bin (35));

dcl  clock_value fixed bin (71) parameter;
dcl  memo_time fixed bin (35);

	memo_time = divide ((clock_value - sys_info$time_correction_constant), 1000000, 35, 0);

	return (memo_time);
	end from_gmt;
       

clean_things_up: proc ();

/* *	This is the cleanup handler procedure; actually, all it does is turn timers back on if needed. */
dcl  size builtin;

     if static_pointer = null then     /* check if we got here before static variables were set */
        return;                        /* if so, no need to clean them up */
     if have_write_access | complained then do; /* do we need to clean up the static variables? */
	if memo_segment_modified then			/* set the bitcount, maybe? */
	     if memo_segment_ptr ^= null () then
		call hcs_$set_bc_seg (memo_segment_ptr, multiply ((size (memo_segment_header)
		     + memo_segment.max_number_used * size (memo_segment_entry)), 36, 24, 0), (0));

	memo_invocation_count = memo_invocation_count - 1; /* "unstack" */
	if memo_invocation_count < 0 then memo_invocation_count = 0;

	if static_pointer ^= null () then		/* only if we have one, of course */
	     if memo_timers_enabled then
		if memo_invocation_count = 0 then	/* Only outermost invocation diddles timers */
		     call memo_timer_set_ (static_pointer, memo$alarm_entry);
           end;
        
        else do; /* terminate the file we can't use, and clear the static variables that describe it */
           term_switch.truncate = "0"b;
           term_switch.set_bc = "0"b;
           term_switch.terminate = "1"b;  /* set switch for terminate_file_ to terminate a null reference name*/
           term_switch.force_write = "1"b; /* set switch to remove modified memo segment from main memory	*/
           term_switch.delete = "0"b;
           call terminate_file_ (memo_segment_ptr, 0, string (term_switch),
	    code);
           if code ^= 0 then
              call complain (code, WHOAMI, 
"Unable to terminate memo segment. ^/memo segment: ^a>^a.", dname, ename);
	 else do;
	    static_pointer = null;   /* reset static variables 					*/
              static_initialized = "0"b;
	    static_uid = ""b;
	    memo_timers_enabled = "0"b;
	    memo_invocation_count = 0;
	    end_of_time = -1;
	    end_of_memo_time = -1;
	    static_person = "";
	    static_project = "";
              if list_sw | print_sw | (list_sw & set_pathname_sw & nargs = 3) | (print_sw & set_pathname_sw & nargs = 3) then;
              else 
	       call complain (error_table_$no_w_permission,WHOAMI,"^a>^a.
Unable to delete or reschedule memos. Memos disabled.",static_dname,static_ename);
	    static_dname = "";
	    static_ename = "";
	    end;
	 end;
        return;
        end clean_things_up;
%page; %include memo_segment;
%page; %include access_mode_values;
%page; %include terminate_file;
       

	end memo; 				/* external procedure memo */




		    memo_delete_.pl1                11/04/82  1917.3rew 11/04/82  1614.8       24093



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


memo_delete_: proc (P_msp, P_idx, P_force_sw);

dcl (P_msp pointer, 				/* memo segment pointer */
     P_idx fixed bin,				/* which memo to delete */
     P_force_sw bit (1) aligned) parameter;		/* whether to delete immature memos without asking */

dcl  success bit (1);
dcl  n fixed bin (35);
dcl  memo_idx fixed bin;				/* which entry in memo_segment to be deleted */
dcl  based_bit36 bit (36) aligned based;
dcl (old_n, new_n) bit (36) aligned;
dcl  maturity_time fixed bin (71);
dcl  answer char (32) varying;

dcl  command_query_ entry options (variable);
dcl  memo_util_$end_of_memo_time entry () returns (fixed bin (35));
dcl  memo_util_$to_gmt entry (fixed bin (35)) returns (fixed bin (71));

dcl  whoami char (32) internal static options (constant) init ("memo");

dcl (addr, clock, null, stacq, unspec) builtin;

/*  */

/* *	If this is the last memo, decrement the high-water mark counter. The stacq
   *	builtin can do so uninterruptibly. (necessary because there is no lock
   *	on the counter itself). If it fails, it means that someone has changed the
   *	value in the meantime, so we do nothing. */

	memo_segment_ptr = P_msp;
	memo_idx = P_idx;

	n = memo_segment.max_number_used;
	old_n = unspec (n);
	n = n - 1;
	new_n = unspec (n);
	n = n + 1;

	if memo_idx = n then
	     success = stacq (addr (memo_segment.max_number_used) -> based_bit36, old_n, new_n);

	maturity_time = memo_util_$to_gmt (memo_entry (P_idx).time);

	if (maturity_time > clock ()) & ^P_force_sw then do; /* don't delete immature memos without asking first */
	     query_info.version = query_info_version_5;
	     query_info.yes_or_no_sw = "1"b;
	     query_info.suppress_spacing = "1"b;
	     call command_query_ (addr (query_info), answer, whoami,
		"Memo ^d is ^[invisible^;not mature^]. Delete?^2x",
		memo_idx, (memo_entry (memo_idx).time >= memo_util_$end_of_memo_time ()));
	     if answer ^= "yes" then return;		/* just give up */
	     end;

	unspec (memo_entry (memo_idx)) = ""b;		/* zero out entire memo for quota reasons */

	return;					/* all done */
%page; %include memo_segment;
%page; %include query_info;

	end;					/* external procedure memo_delete_ */




		    memo_get_.pl1                   08/08/86  1415.8rew 08/08/86  1402.6       48564



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




/****^  HISTORY COMMENTS:
  1) change(86-07-15,Rauschelbach), approve(86-07-15,MCR7472),
     audit(86-08-05,GJohnson), install(86-08-08,MR12.0-1122):
     Changed the non-existant error_table_$incorrect_version to
     error_table_$unimplemented_version.
                                                   END HISTORY COMMENTS */


memo_get_: proc (P_msp, P_idx, P_memo_info_ptr, P_code);

/* *	This procedure fills in a memo_info structure describing the selected memo in
   *	the memo segment pointed to by P_msp. If the selected (by P_idx) memo is not
   *	in use, P_code is set to error_table_$action_not_performed.
   *
   *	This procedure is not now used by any code in memo. It is also not retained in
   *	bound_memo_, but is preserved here to illustrate the possible interface for
   *	future enhancements.,
   *
   *	June, 1979, W. Olin Sibert
   */

dcl (P_msp pointer,
     P_idx fixed bin,
     P_memo_info_ptr pointer,
     P_code fixed bin (35));

dcl 1 v3_memo_seg aligned like memo_segment_v3 based (memo_segment_ptr);
dcl 1 v1_memo_info aligned like memo_info based (memo_info_ptr);

dcl  idx fixed bin;
dcl  exp_delta fixed bin (35);
dcl  exp_delta_string_ptr pointer;
dcl  exp_delta_string char (32) based (exp_delta_string_ptr);
dcl  system_area_ptr pointer internal static init (null ());
dcl  system_area area based (system_area_ptr);

dcl  get_system_free_area_ entry () returns (ptr);
dcl  ioa_$rsnnl entry options (variable);
dcl  memo_util_$to_gmt entry (fixed bin (35)) returns (fixed bin (71));

dcl (error_table_$action_not_performed,
     error_table_$unimplemented_version) fixed bin (35) external static;

dcl  NULL_STRING char (4) aligned internal static options (constant) init ("");
dcl  LARGE fixed bin (35) internal static options (constant) init (1000000000);

dcl (addr, divide, length, max, null, rtrim, string, unspec) builtin;

/*  */

	memo_segment_ptr = P_msp;
	memo_info_ptr = P_memo_info_ptr;
	idx = P_idx;

	if memo_info.version ^= MEMO_INFO_VERSION_1 then do;
	     P_code = error_table_$unimplemented_version;
	     return;
	     end;

	if memo_segment.version ^= MEMO_SEGMENT_VERSION_3 then do;
INCORRECT_VERSION:
	     P_code = error_table_$unimplemented_version;
	     return;
	     end;

	if idx < 1 | idx > memo_segment.max_number_used then do;
MEMO_NOT_IN_USE:
	     P_code = error_table_$action_not_performed;
	     return;
	     end;

	if v3_memo_seg.memo_entry_v3 (idx).taken = ""b then goto MEMO_NOT_IN_USE;

	if memo_info.version = MEMO_INFO_VERSION_1 then do; /* now, initialize the memo_info, and fill it in */
	     unspec (v1_memo_info) = ""b;		/* start with zeros, of course */

	     if memo_segment.version = MEMO_SEGMENT_VERSION_3 then do;
		v1_memo_info.class_name.ptr = addr (NULL_STRING); /* some null strings for unimplemented features */
		v1_memo_info.repeat_count = LARGE;
		string (v1_memo_info.flags) = string (v3_memo_seg.memo_entry_v3 (idx).flags);

		v1_memo_info.data_string.ptr = addr (v3_memo_seg.memo_entry_v3 (idx).data);
		v1_memo_info.data_string.lth = length (rtrim (v3_memo_seg.memo_entry_v3 (idx).data));

		if v3_memo_seg.memo_entry_v3 (idx).flags.repeatsw then do; /* get repeat time */
		     v1_memo_info.repeat_string.ptr = addr (v3_memo_seg.memo_entry_v3 (idx).repeat);
		     v1_memo_info.repeat_string.lth = length (rtrim (v3_memo_seg.memo_entry_v3 (idx).repeat));
		     end;
		v1_memo_info.repeat_string.ptr = addr (NULL_STRING); /* otherwise, use none */

		if unspec (v3_memo_seg.memo_entry_v3 (idx).pad2) ^= ""b then do; /* old TAC expiration date mechanism */
		     unspec (exp_delta) = unspec (v3_memo_seg.memo_entry_v3 (idx).pad2); /* this kludge supports it, */
		     exp_delta = max (1, divide (exp_delta, 60, 34, 1)); /* causes an ever growing system_free_4_ */
		     if system_area_ptr = null () then	     /* however, since this was never a real feature, it's */
			system_area_ptr = get_system_free_area_ (); /* probably OK to handle it this way. */
		     allocate exp_delta_string in (system_area) set (exp_delta_string_ptr); /* we reduce it to minutes */
		     call ioa_$rsnnl ("^dminute^[s^]", exp_delta_string, (0), /* to make it marginally more palatable */
			exp_delta, (exp_delta ^= 1));
		     v1_memo_info.expiration_string.ptr = exp_delta_string_ptr;
		     v1_memo_info.expiration_string.lth = length (rtrim (exp_delta_string));
		     end;
		else v1_memo_info.expiration_string.ptr = addr (NULL_STRING);

		v1_memo_info.maturity_time = memo_util_$to_gmt (v3_memo_seg.memo_entry_v3 (idx).time);
		end;				/* of V1 memo_info & V3 memo_segment */

	     else goto INCORRECT_VERSION;
	     end; 				/* of V1 memo_info */

	else goto INCORRECT_VERSION;

	return;					/* all done */
%page; %include memo_segment;
%page; %include memo_segment_v3;
%page; %include memo_info;

	end;					/* external procedure memo_get_ */




		    memo_list_.pl1                  01/23/89  1237.1rew 01/23/89  1228.5       41535



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




/****^  HISTORY COMMENTS:
  1) change(88-09-06,Flegel), approve(88-11-16,MCR8022), audit(88-12-14,Lee),
     install(89-01-23,MR12.3-1010):
     phx21095 - When (per_process and repeatsw) are on, the list will
     show "repeat_when_processed" instead of "per_process".  This is more
     descriptive.
                                                   END HISTORY COMMENTS */



memo_list_: proc (P_msp, P_idx, P_options);

/* *	This procedure lists a particular memo on the terminal. Presently, there is only
   *	one format for the listing, but the P_options string exists for expandability.
   *
   *	June, 1979, W. Olin Sibert
   */

dcl (P_msp pointer,
     P_idx fixed bin,
     P_options bit (*)) parameter;

dcl  prefix_string char (128) varying;
dcl  suffix_string char (128) varying;
dcl  idx fixed bin;
dcl  iocb pointer;

dcl  iox_$user_output pointer external static;

dcl  date_time_ entry (fixed bin (71), char (*));
dcl  ioa_$ioa_switch entry options (variable);
dcl  ioa_$rsnnl entry options (variable);
dcl  memo_util_$end_of_memo_time entry () returns (fixed bin (35));
dcl  memo_util_$to_gmt entry (fixed bin (35)) returns (fixed bin (71));

dcl (addr, substr, length, mod, multiply, divide) builtin;

/*  */

	memo_segment_ptr = P_msp;
	idx = P_idx;
	iocb = iox_$user_output;

	if memo_entry (idx).time < memo_util_$end_of_memo_time () then /* if a real memo, not invisible kludge */
	     prefix_string = format_time (memo_util_$to_gmt (memo_entry (idx).time)); /* add the formatted time string */
	else prefix_string = " ---- Invisible ---- ";

	suffix_string = "";

	if memo_entry (idx).flags.execute then
	     suffix_string = suffix_string || " call,";
	if memo_entry (idx).flags.alarm then
	     suffix_string = suffix_string || " alarm,";
	if memo_entry (idx).flags.single then
	     suffix_string = suffix_string || " single,";
	if memo_entry (idx).flags.remains then
	     suffix_string = suffix_string || " remains,";
/* MF - begin phx21095 */
	if memo_entry (idx).flags.per_process & memo_entry (idx).flags.repeatsw then
	     suffix_string = suffix_string || " repeat_when_processed,";
/* MF - end phx21095 */

	if memo_entry (idx).flags.repeatsw then
	     suffix_string = suffix_string || " """ || rtrim (memo_entry (idx).repeat) || """,";
	if memo_entry (idx).flags.expires then
	     suffix_string = suffix_string || " expires " ||
		format_time (memo_util_$to_gmt (memo_entry (idx).time + memo_entry (idx).exp_delta)) || ",";

	if length (suffix_string) > 0 then
	     suffix_string = "(" || substr (suffix_string, 2, length (suffix_string) - 2) || ")";

	call ioa_$ioa_switch (iocb, "^3d)^x^va^2x^a^2x^a", idx,
	     length (prefix_string), prefix_string, memo_entry (idx).data, suffix_string);

	return;					/* all done with a single listing */

/*  */

format_time: proc (P_clock) returns (char (40) varying);

/* *	This procedure formats a time for printing, in the standard "memo" format. */

dcl  P_clock fixed bin (71) parameter;

dcl  return_str char (32);
dcl  date_str char (32);
dcl  seconds fixed bin;

	call date_time_ (P_clock, date_str);
	seconds = mod (divide (P_clock, 1000000, 35, 0), 60);

	call ioa_$rsnnl ("^3a^x^8a^x^2a:^2a:^2d", return_str, (0),
	     substr (date_str, 22, 3),		/* day name (3 chars) */
	     substr (date_str, 1, 8), 		/* MM/DD/YY */
	     substr (date_str, 11, 2),		/* HH */
	     substr (date_str, 13, 2),		/* MM */
	     seconds);				/* SS */

	if seconds < 10 then			/* insert a leading zero, cause ioa_ don't know how */
	     substr (return_str, 20, 1) = "0";

	return (rtrim (return_str));
	end;					/* internal procedure format_time */



memo_list_$format_time: entry (P_clock) returns (char (40) varying);

/* *	This is just an external entrypoint for accessing the time formatter */

dcl  P_clock fixed bin (71) parameter;

	return (format_time (P_clock));

%page; %include memo_segment;

	end;					/* external procedure memo_list_ */




		    memo_process_memos_.pl1         09/11/86  1505.5rew 09/11/86  1500.0       51165



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




/****^  HISTORY COMMENTS:
  1) change(86-07-15,Rauschelbach), approve(86-07-15,MCR7472),
     audit(86-08-05,GJohnson), install(86-08-08,MR12.0-1122):
     Changed to pass have_write_access back to memo.
  2) change(86-08-25,Lippard), approve(86-07-15,PBF7472),
     audit(86-09-10,GWMay), install(86-09-11,MR12.0-1152):
     Changed to use have_write_access as an *input* argument.
                                                   END HISTORY COMMENTS */


memo_process_memos_: proc (P_msp, P_select_bits, P_memo_time_now, P_have_write_access);

/* *	This procedure is invoked both by a command invocation of memo (with no explicitly
   *	specified options) and by the alarm timer, to print, execute, reschedule, etc.
   *
   *	June, 1979, W. Olin Sibert
   */

dcl (P_msp pointer,
     P_select_bits (*) bit (1) unaligned,
     P_memo_time_now fixed bin (35),
     P_have_write_access bit (1) aligned) parameter;

dcl  idx fixed bin;
dcl  iocb pointer;
dcl  temp fixed bin;
dcl  code fixed bin (35);
dcl  have_write_access bit (1) aligned;
dcl  expires_sw bit (1) aligned;
dcl  complain_about_write_access bit (1) aligned;

dcl  iox_$user_io pointer external static;
dcl  iox_$user_output pointer external static;

dcl  com_err_ entry options (variable);
dcl  cu_$cp entry (pointer, fixed bin (21), fixed bin (35));
dcl  ioa_$ioa_switch entry options (variable);
dcl  memo_delete_ entry (pointer, fixed bin, bit (1) aligned);
dcl  memo_repeat_ entry (pointer, fixed bin, fixed bin (35), fixed bin (35)) returns (fixed bin);

dcl  WHOAMI char (32) internal static options (constant) init ("memo");

dcl (addr, length, rtrim) builtin;

/*  */

	memo_segment_ptr = P_msp;
	have_write_access = P_have_write_access;

	complain_about_write_access = "1"b;

	do idx = 1 to memo_segment.max_number_used;
	     if P_select_bits (idx) = "1"b then do;	/* this one is selected */
		expires_sw = "0"b;

		if memo_entry (idx).flags.expires then do; /* is this one supposed to expire? */
		     if memo_entry (idx).time + memo_entry (idx).exp_delta < P_memo_time_now then do;
			expires_sw = "1"b;		/* its time has come -- set it up to expire, and */
			goto SKIP_PROCESSING;	/* go to the code to reschedule/delete it */
			end;
		     end;

		if memo_entry (idx).flags.single then	/* this one gets processed once, and then expires */
		     expires_sw = "1"b;		/* just let it fall through and die */

		if memo_entry (idx).flags.execute then do; /* call the command processor */
		     call cu_$cp (addr (memo_entry (idx).data), length (rtrim (memo_entry (idx).data)), code);

		     if code ^= 0 then do;		/* explain what happened */
			call com_err_ (0, WHOAMI, "Command processor was invoked by ^[alarm ^]memo ^d:^/^3x^a",
			     memo_entry (idx).flags.alarm, idx, memo_entry (idx).data);

			if memo_entry (idx).flags.repeatsw then /* and warn about this */
			     call com_err_ (0, WHOAMI, "This memo will not be rescheduled.");

			if have_write_access then	/* avoid faults */
			     memo_entry (idx).flags.repeatsw = "0"b;
			end;			/* of case for command processor error */
		     end; 			/* of case for call memos */

		else do;
		     if memo_entry (idx).flags.alarm then
			iocb = iox_$user_io;
		     else iocb = iox_$user_output;

		     call ioa_$ioa_switch (iocb, "^[memo: (^d)^;^3d)^]^2x^a",
			memo_entry (idx).flags.alarm, idx, memo_entry (idx).data);
		     end;

SKIP_PROCESSING:					/* old memos come here to die (or get rescheduled) */
		if memo_entry (idx).repeatsw then do;	/* repeat it, if necessary */
		     if have_write_access then temp = memo_repeat_
			(memo_segment_ptr, idx, P_memo_time_now, (0));
		     else if complain_about_write_access then do;
			     call com_err_ (0, WHOAMI,
				"No write access on memo segment. Cannot reschedule repeating memo ^d.", idx);
			     complain_about_write_access = "0"b;
			     end;
		     end;

		if memo_entry (idx).flags.alarm & ^memo_entry (idx).flags.remains then
		     expires_sw = "1"b;		/* non remaining alarm memos expire here, as well */

		if memo_entry (idx).flags.remains then do; /* turn off some bits here, if we can */
		     if memo_entry (idx).flags.alarm | memo_entry (idx).flags.repeatsw then do;
			if have_write_access then do;
			     memo_entry (idx).flags.alarm = "0"b;
			     memo_entry (idx).flags.repeatsw = "0"b;
			     end;

			else if complain_about_write_access then do;
			     call com_err_ (0, WHOAMI,
				"No write access on memo segment. Cannot process ""remain"" memo ^d.", idx);
			     complain_about_write_access = "0"b;
			     end;
			end;
		     end; 			/* of processing for "remain" type memos */

		if expires_sw then do;
		     if have_write_access then
			call memo_delete_ (memo_segment_ptr, idx, "1"b);
		     else if complain_about_write_access then do;
			     call com_err_ (0, WHOAMI,
				"No write access on memo segment. Cannot delete alarm memo ^d.", idx);
			     complain_about_write_access = "0"b;
			     end;
		     end;
		end;				/* of case for selected memo */
	     end; 				/* of loop through memos */

	return;
%page; %include memo_segment;

	end;					/* external procedure memo_process_memos_ */




		    memo_repeat_.pl1                08/02/88  1228.0rew 08/02/88  1227.7       71622



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

/****^  HISTORY COMMENTS:
  1) change(86-07-15,Rauschelbach), approve(86-07-15,MCR7472),
     audit(86-08-07,GJohnson), install(86-08-08,MR12.0-1122):
     rewitten to fix misc_commands 344 TR 20424
     memo will now reschedule only 1 cycle of a repeating memo after
     memo -on is given.
  2) change(88-04-30,GDixon), approve(88-05-26,MCR7900),
     audit(88-07-28,Lippard), install(88-08-02,MR12.2-1075):
      Change the way the -repeat interval is applied, so that the interval is
      applied relative to the memo maturity_time (or to the current time if
      -repeat_when_processed was given), rather than relative to a zero clock
      reading (Jan 1, 1901 0000.  gmt.).  If application of one interval still
      leaves a maturity date in the past, reapply the interval relative to the
      previously computed maturity_time, as the date may affect the meaning of
      the repeat interval.  For example, "-repeat 1 year" corresponds to a
      different number of days depending upon whether the maturity_time falls
      in a leap year or not.  In another example,
        -repeat "fri before 2mo this mo 1 this yr"
      has a varying meaning depending upon the month/year of the maturity_time.
     
      Processing of frequently-encountered, fixed-length repeat intervals such
      as "15 minutes" is optimized by having an internal interface into
      convert_date_to_binary_ analyze the time_string to determine if it
      consists only of fixed-length offsets.  If so, then memo_repeat_ can
      add the repeat interval directly to the prior maturity_time iteratively
      until a time in the future is obtained. (phx21094)
                                                   END HISTORY COMMENTS */

/* ************************************************************************* */
/*							       */
/* At the point in memo where this subroutine is called, any memos which     */
/* have matured have been run.  Now if the memo was a repeating memo, this   */
/* program will reschedule a new memo for the next interval in the future    */
/* which was given with -repeat.  If -repeat_when_processed was given, the   */
/* interval is added to to current P_memo_time_now value.  Note that the     */
/* memo interval will not be set in relation to the -time value if           */
/* -repeat_when_processed is given.				       */
/*							       */
/* If the more than one occurrence of the interval has passed since the memo */
/* has matured, then the interval will be added to the last time the memo    */
/* was scheduled to mature (which is in the current memo_entry) until the    */
/* maturity time of is greater than the time_now.  Then a new memo entry     */
/* is given and its index is returned to the caller.		       */
/*							       */
/* ************************************************************************* */
%page;
memo_repeat_: proc (P_msp,		/* (input) points to the memo seg.   */
	          P_idx,		/* (input) index of mature memo entry*/
		P_memo_time_now,	/* (input) match time for maturity   */
		P_code)		/* (output) error code	       */
              returns (fixed bin);      /* (output) index of new memo entry  */


/*     PARAMETERS                                                            */

       dcl P_msp			pointer        parameter,
	 P_idx			fixed bin      parameter,
	 P_memo_time_now		fixed bin (35) parameter,
	 P_code			fixed bin (35) parameter;

/*     AUTOMATIC                                                             */

       dcl current_mature_memo_idx fixed bin,
	 current_time		fixed bin (71),
	 fixed_length_interval	bit(1) aligned,
	 interval			fixed bin (71),
	 maturity_memo_time		fixed bin (35),
	 maturity_time		fixed bin (71),
	 future_mature_memo_idx	fixed bin;

/*     EXTERNAL ENTRIES                                                      */

       dcl convert_date_to_binary_$analyze
				entry (char(*) aligned, fixed bin(71),
				      fixed bin(71), bit(1) aligned,
				      fixed bin(35)),
	 convert_date_to_binary_$relative
				entry (char (*) aligned, 
				      fixed bin (71), fixed bin (71),
				      fixed bin (35)),
           memo_set_		entry (ptr, char (*) aligned,
				      bit (36) aligned, fixed bin (35),
				      fixed bin (35), char (*) aligned)
				      returns (fixed bin),
           memo_util_$from_gmt	entry (fixed bin (71))
				      returns (fixed bin (35)),
           memo_util_$to_gmt		entry (fixed bin (35))
				      returns (fixed bin (71));

/*     EXTERNAL STATIC                                                       */

       dcl error_table_$action_not_performed
				fixed bin (35) external static;

/*     BUILTINS                                                              */

       dcl  string builtin;

%page;
       P_code = 0;
       current_mature_memo_idx = P_idx;
       current_time = 0;
       interval = 0;
       maturity_memo_time = 0;
       maturity_time = 0;       
       future_mature_memo_idx = 0; 
       memo_segment_ptr = P_msp;

       if memo_entry (current_mature_memo_idx).flags.per_process then
	maturity_memo_time = P_memo_time_now;
       else
	maturity_memo_time = memo_entry (current_mature_memo_idx).time;

       if maturity_memo_time <= P_memo_time_now then do;

	maturity_time = memo_util_$to_gmt (maturity_memo_time); 
	current_time = memo_util_$to_gmt (P_memo_time_now);

	call convert_date_to_binary_$analyze
	   (memo_entry (current_mature_memo_idx).repeat, maturity_time,
	   interval, fixed_length_interval, P_code);	/* Repeat interval length (in microseconds) */
	if P_code ^= 0 then;			/* may depend on maturity_time it is computed */
	else if fixed_length_interval then do;		/* relative to.  If it is fixed length,  */
	   interval = interval - maturity_time;		/*   remember fixed interval, and add it */
	   maturity_time = maturity_time + interval;	/*   to maturity_time (perhaps more than once). */
	   end;
	else					/* If not fixed length, then interval */
	   maturity_time = interval;			/*   is first new maturity_time. */

	do while (P_code = 0 & maturity_time <= current_time);
						/* Keep applying repeat interval until */
						/*   a time in future is reached. */
	   if fixed_length_interval then		/* Fixed-length (unchanging) intervals can */
	      maturity_time = maturity_time + interval;	/*   simply be added to prior maturity_time. */
	   else do;				/* Changable intervals (eg, 1 month) must be */
	      call convert_date_to_binary_$relative	/*   recomputed relative to the prior        */
	         (memo_entry (current_mature_memo_idx).repeat, interval,
	         maturity_time, P_code);		/*   maturity_time.  */
	      maturity_time = interval;
	      end;
	   end;
	
	maturity_memo_time = memo_util_$from_gmt (maturity_time);
       
	if P_code = 0 then
	future_mature_memo_idx = memo_set_ (P_msp,
	   memo_entry (current_mature_memo_idx).data,
	   string (memo_entry (current_mature_memo_idx).flags),
	   maturity_memo_time,
	   memo_entry (current_mature_memo_idx).exp_delta,
	   memo_entry (current_mature_memo_idx).repeat);

	memo_entry (current_mature_memo_idx).flags.repeatsw = "0"b;
	end;
       else
	P_code = error_table_$action_not_performed;
       

       return (future_mature_memo_idx);
%page; %include memo_segment;

       end memo_repeat_;




		    memo_set_.pl1                   11/04/82  1917.3rew 11/04/82  1615.0       16992



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


memo_set_: proc (P_msp, P_message, P_flags, P_time, P_exp_delta, P_repeat) returns (fixed bin);

/* *	Ths procedure finds a new memo slot, and sets the memo in that slot, returning the slot number
   *
   *	June, 1979, W. Olin Sibert
   */

dcl (P_msp pointer,
     P_message char (*),				/* what the memo-to-be-set's data entry will be */
     P_flags bit (36) aligned,			/* string of flag bits */
     P_time fixed bin (35),				/* the time field of the new memo */
     P_exp_delta fixed bin (35),
     P_repeat char (*)) parameter;			/* the repeat string */

dcl  idx fixed bin;

dcl (stac, string, addr, max) builtin;

/*  */

	memo_segment_ptr = P_msp;
	idx = 0;

LOOP:	idx = idx + 1;				/* look at next entry */
	if ^stac (addr (memo_entry (idx)), "1"b) then goto LOOP; /* if it's not free (i.e. "0"b) then get next entry */

	string (memo_entry (idx).flags) = P_flags;	/* stac sets taken, this sets flags to flags desired */
	memo_entry (idx).time = P_time; 		/* set the rest of the fields */
	memo_entry (idx).data = P_message;
	memo_entry (idx).exp_delta = P_exp_delta;
	memo_entry (idx).repeat = P_repeat;
	memo_segment.max_number_used = max (idx, memo_segment.max_number_used);
						/* remember the furthest we went in the seg */

	return (idx);				/* return the number of the new entry */
%page; %include memo_segment;

	end;					/* external procedure memo_set_ */




		    memo_timer_set_.pl1             11/04/82  1917.3rew 11/04/82  1615.0       18072



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


memo_timer_set_: proc (P_msp, P_alarm_entry);

/* *	This entry sets up a timer for the next memo to go off, which will call P_alarm_entry
   *
   *	June, 1979, W. Olin Sibert
   */

dcl (P_msp pointer,
     P_alarm_entry entry ()) parameter;

dcl  time fixed bin (35);
dcl  idx fixed bin;

dcl  large fixed bin (35) internal static init (0);

dcl  memo_util_$to_gmt entry (fixed bin (35)) returns (fixed bin (71));
dcl  timer_manager_$alarm_call entry (fixed bin (71), bit (2) aligned, entry);

dcl  ABSOLUTE_MICROSECONDS bit (2) aligned internal static options (constant) init ("00"b);

dcl (max, min, unspec) builtin;

/*  */

	memo_segment_ptr = P_msp;

	if large = 0 then				/* initialize static variable, cause pl1 has no facility for */
	     unspec (large) = "377777777777"b3; 	/* doing this sort of useful thing */

	time = large;				/* look for earliest time */

	do idx = 1 to memo_segment.max_number_used;	/* go through all entries that may be memos */
	     if memo_entry (idx).taken ^= "0"b then	/* if not taken then entry is free, and ignore it */
		if memo_entry (idx).flags.alarm then	/* it must be an alarm entry */
		     time = min (time, memo_entry (idx).time); /* check for earliest time */
	     end; 				/* of loop through memos */

	if time < large then			/* we found one.... */
	     call timer_manager_$alarm_call (memo_util_$to_gmt (time), ABSOLUTE_MICROSECONDS, P_alarm_entry);

	return;
%page; %include memo_segment;

	end;					/* external procedure memo_timer_set_ */




		    memo_upgrade_memo_segment_.pl1  11/04/82  1917.3rew 11/04/82  1615.1        8586



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


memo_upgrade_memo_segment_: proc (P_memo_segment_ptr);

/* *	This procedure is used (someday) to upgrade an old version memo segment
   *	to the current version. Currently, it does nothing.
   *
   *	June, 1980, W. Olin Sibert
   */

dcl  P_memo_segment_ptr pointer;

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

/*  */

	return;					/* do nothing.... for now */
	end;					/* external procedure memo_upgrade_memo_segment_ */




		    memo_util_.pl1                  11/04/82  1917.3rew 11/04/82  1615.1       26802



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


memo_util_: proc ();

	return;

/* *	This procedure exists to perform various utility functions for the memo command,
   *	primarily concerned with the maintenance of memo vs. GMT times. The procedures
   *	for converting to/from GMT are DUPLICATED here and in the procedure memo.pl1
   *	itself, for efficiency reasons. */

dcl (P_memo_time fixed bin (35),
     P_clock_value fixed bin (71)) parameter;

dcl  end_of_memo_time fixed bin (35);
dcl  end_of_time fixed bin (71);
dcl  clock_value fixed bin (71);
dcl  memo_time fixed bin (35);

dcl  sys_info$time_correction_constant fixed bin (71) external static;

dcl  convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35));

dcl (multiply, divide) builtin;

/*  */

memo_util_$end_of_time: entry () returns (fixed bin (71));

/* *	This returns a GMT clock value corresponding to the "End of Time". */

/*
   call convert_date_to_binary_ ("12/31/99 2359.9 gmt", end_of_time, (0));
   end_of_memo_time = memo_util_$from_gmt (end_of_time);
   */

/* *	This implementation of end_of_time is somewhat deficient. The old version of memo used
   *	an inline constant for the value, which happened to be 12/30/99 1859.9 est Thursday.
   *	However, this turns out to be someewhat inconvenient to use elsewhere. Since we are
   *	only using it as the date value for invisible memos, however, this inconvenience can
   *	be put up with until we have a better implementation (a flag, rather than a random date
   *	value) for detecting invisibility. Hence, the above code for setting end_of_time is not
   *	presently used, and instead we depend on the silly inline constant, copied directly from
   *	the previous version of the program. */

	end_of_memo_time = 3124051200;		/* KLUDGE! */
	end_of_time = memo_util_$to_gmt (end_of_memo_time);

	return (end_of_time);



memo_util_$end_of_memo_time: entry () returns (fixed bin (35));

/* *	This is just like the above, but returns the end of "memo" time. */

	end_of_memo_time = 3124051200;		/* KLUDGE! (copied from above) */

	return (end_of_memo_time);

/*  */

memo_util_$to_gmt: entry (P_memo_time) returns (fixed bin (71));

	clock_value = 1000000 * P_memo_time + sys_info$time_correction_constant;

	return (clock_value);



memo_util_$from_gmt: entry (P_clock_value) returns (fixed bin (35));

	memo_time = divide ((P_clock_value - sys_info$time_correction_constant), 1000000, 35, 0);

	return (memo_time);

	end;					/* external procedure memo_util_ */





		    bull_copyright_notice.txt       08/30/05  1008.4r   08/30/05  1007.3    00020025

                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for 
managing computer hardware properly and for executing programs. Many subsequent operating systems
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by Bull HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved
