



		    operator_display.pl1            02/14/84  1605.9rew 01/21/84  1733.1       95742



/*  OPERATOR DISPLAY SUBSYSTEM.				  */
/*    This proc is the command interface.  Our mandate is to supply	  */
/*    pertinent per-invocation information as given by the user.  Some  */
/*    fields of "odis_info" ("odi") are assigned values, then	  */
/*    "operator_display_" is invoked to get things rolling.		  */

/*  Written  82-09-10 by A.G. Haggett (unca). */
/*  Modified 82-11-09 by A.G. Haggett (unca) for "test" entry and "odst" segment.
	Per-site information is kept in a segment created by the "cv_odsf" command.
	This, by default, resides in >sc1>odst. The "test" entry of this module can
	be used to specify another "odst" segment. The include "opr_display_site_table"
	is used to look at this data segment. */

operator_display: odis:
     proc;

     /* AUTOMATIC */
	dcl   code	         fixed bin (35) init (0);
	dcl   1 odi	         like odis_info aligned;
	dcl   (arg_idx, arg_cnt)     fixed bin;
	dcl   arg_len	         fixed bin (21);
	dcl   arg_ptr	         pointer;
	dcl   reset_ttp_name         char (32) unal init (""); /* should we reset. */

     /* BASED */
	dcl   arg		         char (arg_len) based (arg_ptr);

     /* STATIC */
	dcl   odis_cds_$command_name char (32) external static;
	dcl   odis_cds_$site_table_dirname char (168) external static;
	dcl   odis_cds_$site_table_entname char (32) external static;
	dcl   ME		         char (32) based (addr (odis_cds_$command_name));
	dcl   USAGE_MSG	         char (80) init ("^/  Usage: ^a -ttp TERMINAL_TYPE {-mode ""operator""|""dispatch""}") static options (constant);
	dcl   OPERATOR	         char (8) init ("operator") static options (constant);
	dcl   DISPATCH	         char (8) init ("dispatch") static options (constant);
	dcl   LOWER_ALPHA	         char (126) static options (constant)
			         init ("abcdefghijklmnopqrstuvwxyz");
	dcl   UPPER_ALPHA	         char (126) static options (constant)
			         init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ");

     /* EXTERNAL/ENTRIES */
	dcl   com_err_	         entry options (variable);
	dcl   cu_$arg_count	         entry (fixed bin, fixed bin (35));
	dcl   cu_$arg_ptr	         entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
	dcl   hcs_$terminate_noname  entry (ptr, fixed bin (35));
	dcl   initiate_file_         entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));
	dcl   iox_$user_io	         pointer external static;
	dcl   iox_$control	         entry (ptr, char (*), ptr, fixed bin (35));
	dcl   odis_cds_$operator_mode fixed bin external static;
	dcl   odis_cds_$dispatch_mode fixed bin external static;

	dcl   operator_display_      entry (ptr);

	dcl   (error_table_$badopt, error_table_$bad_arg, error_table_$unimplemented_version) fixed bin (35) ext static;

	dcl   cleanup	         condition;
	dcl   (addr, string, translate) builtin;

%page;

	call init_operator_display_info;

	call cu_$arg_count (arg_cnt, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME);
	     return;
	end;

     /* This proc will report errors. "code" tells us to return. */
	if arg_cnt > 0 then
	     call process_command_line (code);
	if code ^= 0 then return;		     /* Told user, so we punt. */

	on cleanup call cleaner;

     /*  Get a pointer to the site data segment. */
	call get_site_table (code);
	if code ^= 0 then return;

     /* This proc will report errors... */
	call establish_terminal_type (odi.ttp, code);
	if code ^= 0 then return;

     /* OK, call subsystem. */

	call operator_display_ (addr (odi));

     /*  If the subsystem was aborted after the video system was called */
     /*  then odi.abort_XXX will indicate. The reason we look for it    */
     /*  here, rather than spill the message earlier, is because when   */
     /*  the video system is revoked, the screen will be cleared. One   */
     /*  would need incredibly fast oculars to catch the message.       */

	if odi.abort_code ^= 0 | odi.abort_reason ^= "" then
	     call com_err_ (odi.abort_code, ME, "^/Subsystem aborted - ^a", odi.abort_reason);

	call cleaner;
	return;




     /*  cleanup handler */
cleaner: proc;

	if reset_ttp_name ^= "" then
	     call set_ttp (reset_ttp_name, (0));

	if odi.site_table_ptr ^= null() then
	     call hcs_$terminate_noname (odi.site_table_ptr, code);

     end cleaner;

%page;
/****^ * * * * * * * * * *  INIT_OPERATOR_DISPLAY_INFO  * * * * * * * * * * */

init_operator_display_info: proc;


	odi.display_mode = odis_cds_$operator_mode;  /* default for now */
	odi.ttp = "";			     /* change if -ttp used */
	odi.abort_code = 0;			     /* see operator_display_ */
	odi.abort_reason = "";		     /* ... */
	odi.site_table_ptr = null();
	return;

     end init_operator_display_info;
%page;
/****^ * * * * * * * * * *  PROCESS_COMMAND_LINE  * * * * * * * * * * */

process_command_line:
     proc (a_code);

	dcl   a_code	         fixed bin (35);

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							   *
 *   We are only called if there are arguments to be processed.	   *
 *   Be sure to keep this procedure "quick". The arg's we know about:	   *
 *   							   *
 *   	-terminal_type STR,   -ttp STR			   *
 *							   *
 *	-mode dispatch|operator				   *
 *   							   *
 *   If "-ttp" is used, remember old one so we can reset it when done.   *
 *							   *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */


	do arg_idx = 1 to arg_cnt;
	     call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, a_code);

	     if arg = "-ttp" | arg = "-terminal_type" then do;
		call get_next_arg ((arg), a_code);
		if a_code ^= 0 then return;
		odi.ttp = translate (arg, UPPER_ALPHA, LOWER_ALPHA);
	     end;
	     else if arg = "-mode" | arg = "-md" then do;
		call get_next_arg ((arg), a_code);
		if a_code ^= 0 then return;
		if arg = OPERATOR then odi.display_mode = odis_cds_$operator_mode;
		else if arg = DISPATCH then odi.display_mode = odis_cds_$dispatch_mode;
		else do;
		     a_code = error_table_$bad_arg;
		     call com_err_ (a_code, ME, "Expecting ""operator"" or ""dispatch"".");
		     return;
		end;
	     end;
	     else do;
		a_code = error_table_$badopt;
		call com_err_ (a_code, ME, USAGE_MSG, ME);
		return;
	     end;

	end;

	return;


     /*  Internal proc for "process_command_line". Keep it quick. */
get_next_arg:
	proc (p_arg, p_code);

	     dcl	 p_arg		    char (32); /* current arg */
	     dcl	 p_code		    fixed bin (35); /* status */

	     arg_idx = arg_idx + 1;		     /* Adjust control variable. */
	     call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, p_code);
	     if p_code ^= 0 then
		call com_err_ (p_code, ME, "After ^a", p_arg);
	     return;

	end get_next_arg;


     end process_command_line;
%page;
/****^ * * * * * * * * * *  GET_SITE_TABLE  * * * * * * * * * * */
get_site_table:
     proc (a_code);

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							     *
 *   Get a pointer to the Operator Display Site Table. We use the values   *
 *   odis_cds_$site_table_(dirname entname) which by default reference     *
 *   >sc1>odst.  These values may have been changed by the entry	     *
 *   operator_display$test.					     *
 *							     *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	dcl a_code fixed bin (35);

	a_code = 0;

	call initiate_file_ (odis_cds_$site_table_dirname, odis_cds_$site_table_entname, R_ACCESS, odi.site_table_ptr, (0), a_code);
	if a_code ^= 0 then do;
	     call com_err_ (a_code, ME, "^a>^a", odis_cds_$site_table_dirname, odis_cds_$site_table_entname);
	     return;
	end;

      /* Check the version sentinel. */
	if odi.site_table_ptr -> odst.version ^= ODST_VERSION_1 then do;
	     call com_err_ (error_table_$unimplemented_version, ME, "^a>^a",  odis_cds_$site_table_dirname, odis_cds_$site_table_entname);
	     return;
	end;

	return;

end get_site_table;
%page;
/****^ * * * * * * * * * *  ESTABLISH_TERMINAL_TYPE  * * * * * * * * * * */

establish_terminal_type:
     proc (a_ttp, a_code);

     /* If a -ttp was specified, try to use it. Otherwise roll with current   */
     /* entry. NOTE: If we set the terminal type, then set reset_ttp_name     */
     /* appropriately. Param. a_ttp will be non-null if -ttp used. */

	dcl   a_ttp	         char (32) parameter;
	dcl   a_code	         fixed bin (35);
	dcl   1 term_info	         like terminal_info;
	a_code = 0;

	term_info.version = terminal_info_version;
	call iox_$control (iox_$user_io, "terminal_info", addr (term_info), a_code);
	if a_code ^= 0 then do;
	     call com_err_ (a_code, ME, "Getting your terminal type. ");
	     return;
	end;

     /* Was a -ttp specified and is does it differ from current ttp? */
	if a_ttp ^= "" & a_ttp ^= term_info.term_type then do;
	     call set_ttp (a_ttp, a_code);
	     if a_code ^= 0 then do;
		call com_err_ (a_code, ME, "Setting terminal type ^a.", a_ttp);
		return;
	     end;

	     reset_ttp_name = term_info.term_type;
	end;
	else a_ttp = term_info.term_type;
	return;

     end establish_terminal_type;
%page;
/****^ * * * * * * * * * *  SET_TTP  * * * * * * * * * * */

set_ttp: proc (s_ttp, s_code);
	dcl   s_ttp	         char (32);
	dcl   s_code	         fixed bin (35);
	dcl   1 stti	         like set_term_type_info aligned;

	stti.version = stti_version_1;
	string (stti.flags) = ""b;
	stti.flags.set_modes, stti.flags.send_initial_string = "1"b;
	stti.name = s_ttp;
	call iox_$control (iox_$user_io, "set_term_type", addr (stti), s_code);
	return;

     end set_ttp;
%page;
test:	entry ();

	/* Usage: operator_display$test {path} */

	dcl dirname char (168);
	dcl entname char (32);
	dcl ioa_ entry options (variable);
	dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));

	call cu_$arg_count (arg_cnt, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME);
	     return;
	end;

	if arg_cnt > 1 then do;
	     call com_err_ (0, ME, "Usage: operator_display$test {path}");
	     return;
	end;

	if arg_cnt < 1 then
	     call ioa_ ("Site data segment is ""^a>^a""", odis_cds_$site_table_dirname, odis_cds_$site_table_entname);
	else do;				     /* there is a path */
	     call cu_$arg_ptr (1, arg_ptr, arg_len, code);
	     call expand_pathname_ (arg, dirname, entname, code);
	     if code ^= 0 then call com_err_ (code, ME, arg);
	     else do;			     /* set new data */
		odis_cds_$site_table_dirname = dirname;
		odis_cds_$site_table_entname = entname;
	     end;
	end;

	return;
%page;
%include opr_display_info;
%page;
%include opr_display_site_table;
%page;
%include access_mode_values;
%page;
%include terminal_info;
%include set_term_type_info;



     end operator_display;




		    operator_display_.pl1           02/14/84  1605.9rew 01/21/84  1733.1      154773



/* OPERATOR DISPLAY SUBSYSTEM INVOCATION			      */
/*							      */
/*   We are called by "operator_display" with a pointer to our subsystem    */
/*   info structure as defined in operator_display_info.incl.pl1.  We have  */
/*   to set up video, create/initialize ssu_ invocation, and init the	      */
/*   redisplay (ie.  set up screen).				      */
/*							      */
/*   There are some issues to be resolved, some of which are due to the     */
/*   fact that ssu_ and window_ are not fully compatible bedfellows.  Some  */
/*   necessary choices were made due to this fact.  For instance, ALL the   */
/*   info files for the subsystem are non-standard.  They do not contain    */
/*   any 'breaks' (a la help).  We simply cannot have the user answer a     */
/*   "More help?" question on line 17 say, and the a "MORE?" question on    */
/*   line 18.  ...sigh					      */
/*							      */
/*   If the subsystem needs to be aborted, the reason is recorded in	      */
/*   odis_info.abort_(code reason). The abort is performed and the command  */
/*   interface reports the error. If this were not done, then the error     */
/*   would be reported, followed instantly by video clearing the screen.    */
/*   This method of aborting must be used if the video system is active.    */
/*							      */
/*   When the user issues the "quit" request, a non-local goto is performed */
/*   by "odis_requests_$quit" to SUBSYSTEM_RETURNS in this procedure.	      */
/*							      */
/*   Some issues to be resolved:				      */
/*							      */
/*	o  the resetting of the terminal type, and resetting of the tty_  */
/*	   world is not at all perfect. Partly this is video's short-     */
/*	   coming, but odis, for instance, simply resets the ttp if one   */
/*	   was specified on the command line. This is not good, as modes  */
/*	   get reset to the ttp's initial modes per the TTF. What is      */
/*	   really needed as a general solution, are primitives such as    */
/*	   'save_tty_state_' and 'restore_tty_state_' which would save    */
/*	   and restore such things as flow control, eop sequence, and     */
/*	   anything else which was not restored by default.	      */
/*          o  the video system is not quite up to par. As of the time this */
/*   	   was written, it was under active development. Aside from the   */
/*   	   unexpected (undocumented) quirks, the video system is SLOW.    */
/*							      */
/*							      */
/*   The subsystem requires certain accesses to run various pieces of code. */
/*   The particular modules or requests and the accesses needed are:	      */
/*							      */
/*     1.  "r" extended access to queues     --  for "scan_queues" request  */
/*     2.  "r" access on absentee_user_table --  for "abs_status" request   */
/*     3.  "re" to rcp_priv_		     --  for operator mode ONLY     */
/*							      */
/*   The subsystem handles cases where no access is forthcoming.	      */
/*							      */
/*   There are the following entry points:			      */
/*							      */
/*	operator_display_	  -- create subsystem invocation.	      */
/*							      */
/*	abort_subsystem	  -- 'goto odis_info.abort_label after we set */
/*			     odis_info.abort_(code reason). These     */
/*			     values are checked by command proc..     */
/*							      */
%page;

/* Written September, 82 by A.G. Haggett (unca). */

operator_display_:
     proc (a_odis_info_ptr);

	dcl   a_odis_info_ptr        pointer parameter;


     /* AUTOMATIC */
	dcl   code	         fixed bin (35);

     /* EXTERNAL/ENTRIES */
	dcl   com_err_	         entry options (variable);
	dcl   continue_to_signal_    entry (fixed bin (35));
	dcl   iox_$control	         entry (ptr, char (*), ptr, fixed bin (35));
	dcl   iox_$user_io	         pointer external static;
	dcl   odis_cds_$command_name char (32) external static;
	dcl   odis_cds_$subsystem_name char (32) external static;
	dcl   odis_cds_$needed_screen_lines fixed bin external static;
	dcl   odis_cds_$needed_screen_width fixed bin external static;
	dcl   odis_cds_$info_prefix  char (32) external static;
	dcl   odis_cds_$info_dir     char (168) external static;
	dcl   odis_cds_$static_odi_ptr pointer external static;
	dcl   odis_execute_line_$odis_execute_line_ entry (ptr, ptr, fixed bin (21), fixed bin (35));
	dcl   odis_redisplay_$cleanup entry (ptr);
	dcl   odis_redisplay_$full_redisplay entry (ptr);
	dcl   odis_redisplay_$initialize entry (ptr, fixed bin (35));
	dcl   odis_redisplay_$prompt entry (ptr);
	dcl   odis_redisplay_$shutdown entry (ptr);
	dcl   odis_request_table_$odis_request_table_ external;
	dcl   odis_window_$create_windows entry (ptr, fixed bin (35));
	dcl   odis_window_$destroy_windows entry (ptr);
	dcl   odis_window_$disconnect entry (ptr);
	dcl   odis_window_$reconnect entry (ptr);
	dcl   odis_window_$no_video_cleanup entry (ptr);
	dcl   odis_requests_$cpescape entry (ptr, ptr, fixed bin (21), fixed bin (35));
	dcl   operator_display_$abort_subsystem entry (ptr, fixed bin (35), char (*));
	dcl   (operator_display_$pre_request_proc,
	      operator_display_$post_request_proc) entry (ptr);
	dcl   ssu_$create_invocation entry (char (*), char (*), ptr, ptr, char (*), ptr, fixed bin (35));
	dcl   ssu_$destroy_invocation entry (ptr);
	dcl   ssu_$abort_subsystem   entry () options (variable);
	dcl   ssu_$get_info_ptr      entry (ptr) returns (ptr);
	dcl   ssu_$get_invocation_count entry (ptr, fixed bin, fixed bin);
	dcl   ssu_$listen	         entry (ptr, ptr, fixed bin (35));
	dcl   ssu_$print_message     entry () options (variable);
	dcl   ssu_$set_procedure     entry (ptr, char (*), entry, fixed bin (35));
	dcl   ssu_$set_info_prefix   entry (ptr, char (32));
	dcl   ssu_$set_prompt_mode   entry (ptr, bit (*));
	dcl   video_data_$terminal_iocb ext static pointer;
	dcl   video_utils_$turn_on_login_channel entry (fixed bin (35), char (*));
	dcl   video_utils_$turn_off_login_channel entry (fixed bin (35));

	dcl   (error_table_$invalid_device, error_table_$no_table) fixed bin (35) ext static;
	dcl   (ssu_et_$subsystem_aborted) fixed bin (35) external static;
	dcl   (odis_et_$no_room_for_windows) fixed bin (35) ext static;

	dcl   (addr, null, ltrim, rtrim, char) builtin;

	dcl   (cleanup, program_interrupt, quit) condition;
%page;

	odis_info_ptr = a_odis_info_ptr;

     /* All happens in odis_info... */
	odis_info.quit_pending, odis_info.quit_restart = "0"b;
	odis_info.ssu.abort_label = SUBSYSTEM_RETURNS;
	odis_info.video.video_on = "0"b;
	odis_info.executing_request = "0"b;

     /* Initialize all pointers in structure to null. */
	odis_info.ssu.sci_ptr,
	odis_info.sci_ptr,
	odis_info.saved_user_io_ptr,
	odis_info.saved_err_output_ptr,
	odis_info.dis_window_iocb,
	odis_info.mini_window_iocb,
	odis_info.display_data_ptr = null ();

	code = 0;

	on cleanup call cleaner;

	call instate_subsystem (code);	     /* must be ssu_ first */
	if code ^= 0 then goto SUBSYSTEM_RETURNS;

	call instate_video_system (code);	     /* get videoish now */
	if code ^= 0 then goto SUBSYSTEM_RETURNS;

	call instate_display (code);
	if code ^= 0 then goto SUBSYSTEM_RETURNS;

	on program_interrupt begin;
		odis_info.quit_restart = "1"b;
		goto SUBSYSTEM_LISTEN;
	     end;


SUBSYSTEM_LISTEN:
	if odis_info.quit_pending then do;	     /* SIGNAL QUIT ? */
	     odis_info.quit_pending = "0"b;
	     call quit_prologue ();
	     revert quit;			     /* Allow it to... */
	     signal quit;			     /* ...happen.	   */
	     odis_info.quit_restart = "1"b;
	end;


     /* Set up subsystem handler for "quit" */
	on quit begin;
		odis_info.quit_pending = "1"b;
		goto SUBSYSTEM_LISTEN;
	     end;

	if odis_info.quit_restart then do;	     /* from QUIT */
	     odis_info.quit_restart = "0"b;
	     call quit_restart ();
	end;


       /* The root! This proc never returns. User may QUIT or "quit". */

	call ssu_$listen (odis_info.sci_ptr, odis_info.mini_window_iocb, code);


	if code = ssu_et_$subsystem_aborted then ;   /* This is expected. */
	else do;
	     odis_info.abort_code = code;
	     odis_info.abort_reason = "Error encountered in listener.";
	end;



     /*  This is the normal way to return, a la "quit" request. */
SUBSYSTEM_RETURNS:
	call cleaner;
	return;

%page;
abort_subsystem:
     entry (a_odis_info_ptr, fatal_code, fatal_reason);

	dcl   fatal_code	         fixed bin (35) parameter;
	dcl   fatal_reason	         char (*);

     /*  This entry is externally available so that the various */
     /*  modules have a place to abort through.		*/

	odis_info_ptr = a_odis_info_ptr;
	odis_info.abort_code = fatal_code;
	odis_info.abort_reason = fatal_reason;
	goto odis_info.ssu.abort_label;	     /* SHUT */

%page;
/****^ * * * * * * * * * *  INSTATE_SUBSYSTEM  * * * * * * * * * * */

instate_subsystem: proc (a_code);

	dcl   a_code	         fixed bin (35);
	dcl   ssu_level	         fixed bin;

	dcl   odis_cds_$subsystem_version char (8) external static;

     /*  Fire up ssu_ and make "operator_display" a subsystem. */

	a_code = 0;


	call ssu_$create_invocation
	     (odis_cds_$subsystem_name,
	     odis_cds_$subsystem_version,
	     addr (odis_info),		     /* Per invocation data */
	     addr (odis_request_table_$odis_request_table_),
	     odis_cds_$info_dir,		     /* Our .info files. */
	     odis_info.sci_ptr,		     /* Transparent ssu_ data. */
	     a_code);
	if a_code ^= 0 then do;
	     odis_info.abort_reason = "Call to ssu_$create_invocation failed.";
	     goto SSU_ERROR;
	end;

      /* These next ssu_ calls tailor our subsystem. The first 2 are standard. */
	call ssu_$set_info_prefix (odis_info.sci_ptr, odis_cds_$info_prefix);
	call ssu_$set_prompt_mode (odis_info.sci_ptr, DONT_PROMPT);

       /* Replace the default parameters a la param 2 in the calls. */
	odis_info.abort_reason = "Cannot set ssu_ procedures."; /* Just in case. */
	call ssu_$set_procedure (odis_info.sci_ptr, "pre_request_line", odis_redisplay_$prompt, a_code);
	if a_code ^= 0 then goto SSU_ERROR;
	call ssu_$set_procedure (odis_info.sci_ptr, "cpescape", odis_requests_$cpescape, a_code);
	if a_code ^= 0 then goto SSU_ERROR;
	call ssu_$set_procedure (odis_info.sci_ptr, "execute_line", odis_execute_line_$odis_execute_line_, a_code);
	if a_code ^= 0 then do;
SSU_ERROR:
	     odis_info.abort_code = a_code;
	     return;
	end;
	odis_info.abort_reason = "";		     /* Whew; we made it. */

     /*  Get a character string rep of our invocation level. */
     /*  See window/switch creation in odis_window_. */
	call ssu_$get_invocation_count (odis_info.sci_ptr, ssu_level, (0));
	odis_info.invocation_level_c = ltrim (rtrim (char (ssu_level)));

     /*  We handle prompting in "odis_redisplay_" */
	odis_info.prompt = rtrim (odis_cds_$subsystem_name);
	if ssu_level > 1 then odis_info.prompt = odis_info.prompt || " (" || invocation_level_c || ")";
	odis_info.prompt = odis_info.prompt || ":";

     /*  Complication 183:  Record our info pointer  in  the per    */
     /*  process variable (static) odis_cds_$static_odi_ptr.  We    */
     /*  need this because async called entries must be able to     */
     /*  get information about the subsystem. This MUST be kept     */
     /*  accurate. The cleanup handler get previous. This variable  */
     /*  is the only subsystem data used which is not a per	        */
     /*  invocation managed value.			        */
     /*						        */

	odis_cds_$static_odi_ptr = odis_info_ptr;

	return;

     end instate_subsystem;
%page;
/****^ * * * * * * * * * *  INSTATE_VIDEO_SYSTEM  * * * * * * * * * * */

instate_video_system:
     proc (a_code);

     /*  Fire up the video system and set video information in "odis_info".  */
     /*  We are called after ssu_ has created an invocation. If there are    */
     /*  errors AFTER the video system is invoked, do not report them	       */
     /*  directly, but set odis_info.abort_(code reason).		       */

	dcl   a_code	         fixed bin (35);
	dcl   reason	         char (128) init ("");

	a_code = 0;

	if video_data_$terminal_iocb = null () then do; /* NO VIDEO. */
	     call video_utils_$turn_on_login_channel (a_code, reason);
	     if a_code ^= 0 then do;

                    /* Interpret silly code. */
		if a_code = error_table_$no_table then
		     call com_err_ (error_table_$invalid_device, odis_cds_$command_name,
			"^/^-The terminal type ^a is not supported by the video system.", odis_info.ttp);
		else call com_err_ (a_code, odis_cds_$command_name, "^/^a ^a", reason, "Invoking the video system.");
		return;
	     end;

	     /* User was not in the video system when we were called. */
	     odis_info.was_in_video = "0"b;
	end;
	else odis_info.was_in_video = "1"b;

	odis_info.video_on = "1"b;		     /* VIDEO ACTIVE. */

     /* Create subsystem windows. */
	call odis_window_$create_windows (odis_info_ptr, a_code);
	if a_code ^= 0 then
	     if a_code = odis_et_$no_room_for_windows then do;
		odis_info.abort_code = odis_et_$no_room_for_windows;
		odis_info.abort_reason =	     /* build string. */
		     "This program requires the following screen size: Lines= "
		     || ltrim (char (odis_cds_$needed_screen_lines))
		     || ", Columns= "
		     || ltrim (char (odis_cds_$needed_screen_width));
	     end;
	     else do;
		odis_info.abort_code = a_code;
		odis_info.abort_reason = "Cannot create required windows.";
	     end;


	return;

     end instate_video_system;

%page;
/****^ * * * * * * * * * *  INSTATE_DISPLAY  * * * * * * * * * * */
instate_display: proc (a_code);

	dcl   a_code	         fixed bin (35) parameter;

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   						     *
 *   Call the redisplay initilization procedure and then paint   *
 *   the first display with "odis_redisplay_$full_redisplay.     *
 *						     *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	a_code = 0;

	call odis_redisplay_$initialize (odis_info_ptr, a_code);
	if a_code = 0 then
	     call odis_redisplay_$full_redisplay (odis_info_ptr);


     end instate_display;

%page;
/****^ * * * * * * * * * *  QUIT_PROLOGUE  * * * * * * * * * * */
quit_prologue: proc;

     /* Things to be done before we allow Multics to exists. */

	call odis_redisplay_$shutdown (odis_info_ptr);
	call odis_window_$destroy_windows (odis_info_ptr);
	call clear_screen ();

     /*  If she was in video when we were called, leave it that way for Mult */
	if ^odis_info.was_in_video then
	     call video_utils_$turn_off_login_channel ((0));

	return;
     end quit_prologue;




/****^ * * * * * * * * * *  QUIT_RESTART  * * * * * * * * * * */
quit_restart: proc;

     /* Things to be done after we are started up from QUIT.	   */
     /*							   */
     /* Change in tactics.... It used to be the case that if she revoked */
     /* the video system while in the Multics world, we would crash the  */
     /* subsystem - this is silly. We now re-invoke the video system.	   */

	dcl   saved_was_in_video     bit (1);	     /* cause this should not change. */

	odis_info.abort_code = 0;		     /* start fresh. */
	odis_info.abort_reason = "";		     /*  ...  */
					     /* instate_video_system will walk on this bit. */
	saved_was_in_video = odis_info.was_in_video;

     /* If video still there, then this proc will handle it. */
	call instate_video_system (code);	     /* ...and create windows. */

	if code ^= 0 then goto odis_info.abort_label;/* abort cruft is set up. */

	odis_info.was_in_video = saved_was_in_video; /* restore. */

	call odis_redisplay_$full_redisplay (odis_info_ptr);
	return;

     end quit_restart;
%page;
/****^ * * * * * * * * * *  CLEAR_SCREEN  * * * * * * * * * * */

clear_screen: proc ();

	call iox_$control (video_data_$terminal_iocb, "clear_screen", null (), (0));
	return;

     end clear_screen;
%page;
/****^ * * * * * * * * * *  CLEANER  * * * * * * * * * * */
cleaner: proc;

	dcl   bit_bucket	         pointer;
	dcl   ssu_$get_prev_sci_ptr  entry (ptr, ptr, ptr);

     /*  Cannot report ANY errors from cleanup activity. We may have  */
     /*  come here because of some other error, hence we cannot walk  */
     /*  on odis_info.abort_(code reason), so why look for error?     */

	if odis_info.ssu.sci_ptr = null () then return;  /* nothing done. */

	call odis_redisplay_$cleanup (odis_info_ptr);

	if odis_info.video_on then

	/* This little check is necessary because if the video */
	/* system was pulled out from under us, there may be   */
	/* some cleanup which must be done anyway.	     */
	     if video_data_$terminal_iocb = null () then
		call odis_window_$no_video_cleanup (odis_info_ptr);
	     else do;			     /* clean up video */
		if odis_info.windows_made then call odis_window_$destroy_windows (odis_info_ptr);

		call clear_screen ();

		if ^odis_info.was_in_video then
		     call video_utils_$turn_off_login_channel ((0));
	     end;

     /*  Clean up ssu_ invocation and update static sci_ptr of possible previous active invocation. */
	call ssu_$get_prev_sci_ptr (odis_info.sci_ptr, bit_bucket, odis_cds_$static_odi_ptr);
	call ssu_$destroy_invocation (odis_info.sci_ptr);

     end cleaner;

%page;
%include opr_display_info;
%include ssu_prompt_modes;
%include "_ssu_sci";

     end operator_display_;




		    odis_et_.alm                    01/05/83  1407.5rew 01/05/83  1330.6        9234



" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"	ERROR TABLE FOR "operator_display" subsystem.
"
"
"	Some of these are here in an effort to keep nomenclature
"	consistent. The use of standard et_ entries does not
"	do the trick sometimes.
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

"  September, 82 by A.G. Haggett (unca).

	include		et_macros

	et		odis_et_

ec	no_room_for_windows,^room,
	(There is insufficient room to create the specified window.)

ec	video_revoked,^video,
	(Video system revoked while subsystem was active.)

ec	request_recurse,^recurse,
	(Programming error - A request line may not invoke a second request.)

ec	accept_no_args,0args,
	(This request does not accept any arguments.)

ec	bad_arg,badarg,
	(Bad argument for this request.)

ec	bad_opt,badopt,
	(Bad control argument for this request.)

ec	wrong_no_of_args,badargno,
	(Wrong number of arguments for this request.)

ec	driver_not_found,^maj_dev,
	(Driver not found in IO daemon tables.)

end




		    odis_request_table_.alm         01/05/83  1407.5rew 01/05/83  1330.5       18936



" " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"  Request table (ssu_) for operator_display subsystem.
"
"  Written  82-09-10 by A.G. Haggett (unca).
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

"  Modified 82-12-29 by A.G. Haggett (unca) for "list_devices".

	include		ssu_request_macros

"
	begin_table	odis_request_table_


	request	?,
		 ssu_requests_$summarize_requests,
		 (),
		 (Produce a list of the most commonly used requests.),
		 flags.allow_command+flags.dont_summarize

	request	.,
		 odis_requests_$self_identify,
		 (),
		 (Identify the subsystem.),
		 flags.allow_command+flags.dont_summarize+flags.dont_list

	request	abs_status,
		 odis_requests_$abs_status,
		 (as),
		 (Display status of running absentees.),
		 flags.allow_command

	request	driver_status,
		 odis_requests_$driver_status,
		 (ds),
		 (Display status of central/remote devices and queues.),
		 flags.allow_command

	request	help,
		 ssu_requests_$help,
		 (),
		 (Obtain detailed information on the subsystem.)

	request	list_devices,
		 odis_requests_$list_devices,
		 (ld),
		 (Display status of devices such as tape drives.),
		 flags.allow_command

	request	list_help,
		 ssu_requests_$list_help,
		 (lh),
		 (List topics for which help is available.)

	request	list_requests,
		 ssu_requests_$list_requests,
		 (lr),
		 (List brief information on subsystem requests.)

	request	mode,
		 odis_requests_$mode,
		 (),
		 (Change mode to operator or dispatch.),
		 flags.allow_command

	request	quit,
		 odis_requests_$quit_subsystem,
		 (q),
		 (Leave the subsystem.),
		 flags.allow_command

	request	redisplay,
		 odis_requests_$redisplay,
		 (r),
		 (Redisplay/resume the default display.),
		 flags.allow_command

	request	scan_queues,
		 odis_requests_$scan_queues,
		 (sq),
		 (Cycle through queues displaying detailed information.),
		 flags.allow_command

	request	debug_mode,
		 ssu_requests_$debug_mode,
		 (debug),
 		 (Enable/disable subsystem debugging facilities.),
		 flags.allow_command+flags.dont_summarize+flags.dont_list


	end_table		odis_request_table_
	end




		    odis_requests_.pl1              02/14/84  1605.8rew 01/21/84  1733.1      220086



/*  There is an entry for each request defined in the ssu_ request table  */
/*  odis_request_table_.					    */

/* Written  82-09-10 by A.G. Haggett (unca). */
/* Modified 82-10-28 by A.G. Haggett (unca) to:
	o purge "driver_status_epilogue" subr. from "driver_status" request.
	o use new site data segment ("odst" structure).
	o use new odis_iod_$driver_status call.  */
/* Modified 82-12-22 by A.G. Haggett (unca) for "list_devices" request. */

odis_requests_:
     proc ();
	return;


     /* PARAMETERS */
	dcl   (P_sci_ptr, P_odis_info_ptr) pointer parameter;
	dcl   P_line_ptr	         pointer parameter;
	dcl   P_line_len	         fixed bin (21) parameter;
	dcl   P_code	         fixed bin (35) parameter;

     /* BASED */
	dcl   arg		         char (al) based (ap);

     /* AUTOMATIC */
	dcl   ap		         pointer;
	dcl   al		         fixed bin (21);
	dcl   (arg_cnt, arg_idx)     fixed bin;
	dcl   code	         fixed bin (35);
	dcl   driver_names_given     bit (1);
	dcl   driver_status_current_line fixed bin;  /* see driver_status */
	dcl   (have_tried_again, no_indent) bit (1); /* see abs_status */
	dcl   i		         fixed bin;	     /* loop var. */
	dcl   (rqt_name_len, max_rqt_name_len) fixed bin;
	dcl   rqt_first_scan_sw      bit (1);
	dcl   (save_l, save_c, save_l_for_break_msg)
			         fixed bin;	     /* save cursor pos. */
	dcl   sci_ptr	         pointer;	     /* copy of parameter */
	dcl   sq_temp_seg_ptr        pointer;	     /* scan_queues req. */
	dcl   unca_option	         char (32);	     /* for as_who command */

     /* CONSTANT */
	dcl   DISPATCH	         char (8) init ("dispatch") static options (constant);
	dcl   DRIVER_HEADER_CS       char (40) static options (constant)
			         init ("^/* ^a *^[    Default rqt is ""^a"".^]");
	dcl   MODE_USAGE	         char (32) init (" Usage: mode {operator|dispatch}") static options (constant);
	dcl   OPERATOR	         char (8) init ("operator") static options (constant);
	dcl   QUEUE_COUNT_CS         char (40) static options (constant)
			         init ("^a:^13tq1= ^d, q2= ^d, q3= ^d, q4= ^d");
	dcl   RELATIVE_SECONDS       bit (2) init ("11"b) static options (constant);
	dcl   SCAN_QUEUES_HEADER_LINE char (51) static options (constant)
			         init ("^/Scanning the following request types (queues) ...");

     /* ENTRIES/EXTERNAL */
	dcl   as_who	         entry options (variable);
	dcl   cu_$cp	         entry (ptr, fixed bin (21), fixed bin (35));
	dcl   (ioa_, ioa_$nnl)       entry options (variable);
	dcl   iox_$control	         entry (ptr, char (*), ptr, fixed bin (35));
	dcl   odis_iod_$driver_info_index entry (fixed bin, char (*), char (*), char (*), fixed bin (35));
	dcl   odis_iod_$driver_info_name entry (char (*), char (*), char (*), fixed bin (35));
	dcl   odis_queue_$display_rqt_info entry (ptr, ptr, char (*), char (*));
	dcl   odis_queue_$get_queue_counts entry (char (*), char (*), (4) fixed bin);
	dcl   odis_rcp_$list_tape_drives entry (ptr, fixed bin (35));
	dcl   odis_redisplay_$change_mode entry (ptr, fixed bin, fixed bin (35));
	dcl   odis_redisplay_$full_redisplay entry (ptr);
	dcl   odis_iod_$driver_status entry (char (*), char (*), char (*), char (*), char (*), char (*), fixed bin,
			         char (*));
	dcl   (odis_window_$open_mini_window,
	      odis_window_$shut_mini_window) entry (ptr);
	dcl   ssu_$abort_line        entry () options (variable);
	dcl   ssu_$arg_count         entry (ptr, fixed bin);
	dcl   ssu_$arg_ptr	         entry (ptr, fixed bin, ptr, fixed bin (21));
	dcl   ssu_$get_info_ptr      entry (ptr) returns (ptr);
	dcl   ssu_$get_temp_segment  entry (ptr, char (*), ptr);
	dcl   ssu_$release_temp_segment entry (ptr, ptr);
	dcl   ssu_$print_message     entry () options (variable);
	dcl   timer_manager_$sleep   entry (fixed bin (71), bit (2));
	dcl   window_$clear_to_end_of_window entry (ptr, fixed bin (35));
	dcl   window_$clear_window   entry (ptr, fixed bin (35));
	dcl   window_$get_cursor_position entry (ptr, fixed bin, fixed bin, fixed bin (35));
	dcl   window_$overwrite_text entry (ptr, char (*), fixed bin (35));
	dcl   window_$position_cursor entry (ptr, fixed bin, fixed bin, fixed bin (35));


	dcl   (odis_cds_$operator_mode, odis_cds_$dispatch_mode) fixed bin external static;
	dcl   video_data_$terminal_iocb pointer external static;


	dcl   error_table_$end_of_info fixed bin (35) ext static;
	dcl   error_table_$moderr      fixed bin (35) ext static;
	dcl   odis_et_$accept_no_args fixed bin (35) external static;
	dcl   odis_et_$wrong_no_of_args fixed bin (35) external static;
	dcl   odis_et_$bad_arg       fixed bin (35) ext static;

     /* CONDITIONS */
	dcl   (quit, cleanup, command_error, no_read_permission) condition;

	dcl   (addr, null, rtrim, min, substr, index, length) builtin;
%page;
/****^ * * * * * * * * * *  ABS_STATUS  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
abs_status: entry (P_sci_ptr, P_odis_info_ptr);


/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							     *
 *   Use the "as_who" command to obtain status of running absentees. We    *
 *   try to use the "-limit" option (U. of C. specific), but we handle     *
 *   the error if "-limit" not supported.			     *
 *							     *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	call odis_request_prologue ();

	if arg_cnt > 0 then goto NO_ARGS_PLEASE;

     /* Yes I know as_who catches this today. */
	on no_read_permission begin;
	     call ssu_$abort_line (sci_ptr, error_table_$moderr, "Cannot read absentee table.");
	end;

     /*  Watch out for command_error. At the UofC we have an option     */
     /*  for 'as_who' of '-limit'. This will not exists at other sites. */
	unca_option = "-limit";		     /* UNCA specific. */
	have_tried_again = "0"b;

	on command_error begin;
	     if have_tried_again then
		call ssu_$abort_line (sci_ptr, 0, "Unable to get absentee status.");

	     have_tried_again = "1"b;		     /* avoid inf. loop. */
	     unca_option = "-lg";		     /* harmless? */
	     goto ABS_STATUS_TRY_AGAIN;
	end;

ABS_STATUS_TRY_AGAIN:			     /* -limit non-quick. */
	call as_who ("-as", "-cpu", "-lg", unca_option);

	return;


	/* Various requests may come here to abort for this reason. */
NO_ARGS_PLEASE:
	call ssu_$abort_line (sci_ptr, odis_et_$accept_no_args);
	return;				     /* should never. */

%page;
/****^ * * * * * * * * * *   ..   * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

cpescape: entry (P_sci_ptr, P_line_ptr, P_line_len, P_code);

	odis_info_ptr = ssu_$get_info_ptr (P_sci_ptr);
	call cu_$cp (P_line_ptr, P_line_len, (0));
	P_code = 0;
	return;


%page;
/****^ * * * * * * * * * *  DRIVER_STATUS  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

driver_status:
     entry (P_sci_ptr, P_odis_info_ptr);
/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							       *
 *   Display information about configured IO devices. We call the entry      *
 *   odis_iod_$driver_info_index to return the major device name, minor      *
 *   device name, and the default rqt. The first parameter to this entry     *
 *   is an index used internally by it. We set it to 0 for the first 	       *
 *   call. This implementation of this request assumes that there is	       *
 *   only one minor device for each major device. The odis_iod_ entry	       *
 *   only returns the name of 1 minor device.			       *
 *   							       *
 *   For "driver_status dev1...devN" use "odis_iod_$driver_info_name" to get *
 *   information for a specific driver (major name).		       *
 *							       *
 *   The entry "odis_iod_$driver_status" returns information	       *
 *   from a driver status segment (ie. >ddd>idd>prta>prta) and takes a       *
 *   major and minor name as input.				       *
 *   							       *
 *   The queue counts of the default request type, as provided by the	       *
 *   odis_iod_ entry, are secured from "odis_queue_$get_queue_counts".       *
 *   							       *
 *   There are 3 possible outputs for a device:			       *
 *     1.  An error message					       *
 *     2.  A status line (ie. "Device is idle.") and queue counts.	       *
 *     3.  The works := 3 lines of driver info and line of queue counts.     *
 *   							       *
 *   The internal subr "driver_status_more_check" is called to be sure       *
 *   that we do not spread a single driver's output across a MORE? break.    *
 *   This must be called before doing output. This subr. keeps track of      *
 *   "driver_status_current_line".				       *
 *   							       *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */


	call odis_request_prologue ();

	if arg_cnt > 0 then driver_names_given = "1"b;
	else driver_names_given = "0"b;

DRIVER_STATUS_BEGIN_BLOCK:
	begin;

	     dcl	 (ds_major, ds_minor, ds_rqt) char (32);
	     dcl	 ds_index		    fixed bin;

	     dcl	 1 ds,			     /* driver status info */
		   2 busy_id	    char (32), /* group id. */
		   2 dir		    char (168),/* dir of print seg. */
		   2 entry	    char (32), /* segment name. */
		   2 rqt		    char (27), /* request type. */
		   2 queue	    fixed bin, /* processing this one */
		   2 status	    char (60); /* If "", then all is well. */

	/* To return counts in queues... */
	     dcl	 q_tt		    (4) fixed bin;
	     dcl   needed_lines_delta	    fixed bin;

	/* We want to print absolute path but can only use screen width. */
	     dcl	 short_path	    char (odis_info.dis_window_info.width);

	/* This bit is passed to ioa_. It says there is another value for the control string: the default rqt.. */
	     dcl	 rqt_message_sw	    bit (1) init ("1"b);


	/* Set up for loop. "ds_index" is used for all display and arg_idx will pick off args if supplied. */
	     ds_index = -1;
	     arg_idx = 0;

	     driver_status_current_line = 1;	     /* init for MORE? check subr. */
%page;
	/* Loop through drivers specified on command line or ALL. */
	     do while ("1"b);		     /* goto will punt */

	     /* Are we using name lookup or indexing through DB ?? */
		if driver_names_given then do;     /*** USING NAMES */
		     arg_idx = arg_idx + 1;
		     if arg_idx > arg_cnt then goto DRIVER_STATUS_RETURNS;
		     call ssu_$arg_ptr (sci_ptr, arg_idx, ap, al);
		     ds_major = arg;	     /* 32 char trunc. */
		     call odis_iod_$driver_info_name (ds_major, ds_minor, ds_rqt, code);
		     if code ^= 0 then do;
			call ds_print_error (code, ds_major);
			goto NEXT_DRIVER;
		     end;
		end;
		else do;		               /*** INDEXING THROUGH */
		     ds_index = ds_index + 1;
		     call odis_iod_$driver_info_index (ds_index, ds_major, ds_minor, ds_rqt, code);

		     if code ^= 0 then	     /* check for expected code. */
			if code = error_table_$end_of_info then goto DRIVER_STATUS_RETURNS;
			else do;
			     call ds_print_error (code, ""); /* bad code report */
			     goto DRIVER_STATUS_RETURNS; /* fatal. Why would next call work? */
			end;
		end;

	     /*  Good code so push on and display our stuff. */
	     /*  NOTE:  The default request type is returned in "ds_rqt" by  */
	     /*  "odis_iod_$driver_info_index". The rqt currently being      */
	     /*  processed by a driver is returned in "ds.rqt" by the entry  */
	     /*  "odis_iod_$driver_status".			    */

		call odis_iod_$driver_status
		     (ds_major,		     /* INPUT */
		     ds_minor,		     /* INPUT; rest are OUTPUT */
		     ds.busy_id,		     /* Pers.Proj.t */
		     ds.dir,		     /* dir of entry */
		     ds.entry,		     /* entry printing now */
		     ds.rqt,		     /* rqt processing */
		     ds.queue,		     /* queue processing */
		     ds.status);		     /* "" is all is well */

	     /* Now get queue counts for default request type. */
		call odis_queue_$get_queue_counts ("", ds_rqt, q_tt);


	     /* If ds.status ^= "" then just report status. (ie. "Device is idle.") */
		if ds.status ^= "" then do;	     /* 4 line output. */

		/* Output the header (2 lines), the status, and the queue counts. */
		/* If the default queue contains the string "dummy" do not print counts. */
		     if index (ds_rqt, "dummy") > 0 then
			needed_lines_delta = 0;  /* no need for line */
		     else needed_lines_delta = 1;  /* output rqt counts */

		     call driver_status_more_check (3 + needed_lines_delta);
		     call ioa_ (DRIVER_HEADER_CS, ds_major, rqt_message_sw, ds_rqt);
		     call ioa_ ("^a", ds.status);
		     if needed_lines_delta > 0 then
			call ioa_ (QUEUE_COUNT_CS, ds_rqt, q_tt (*));
		end;
		else do;			     /* the works. */
		     call driver_status_more_check (6);
		     call ioa_ (DRIVER_HEADER_CS, ds_major, rqt_message_sw, ds_rqt);
		     call ioa_ ("Processing: queue ^d; request type ""^a"".", ds.queue, ds.rqt);
		     short_path = rtrim (ds.dir) || ">" || ds.entry;
		     i = index (short_path, ">user_dir_dir");
		     if i > 0 then
			short_path = ">udd" || substr (short_path, (length (">user_dir_dir") + 1));
		     call ioa_ ("Printing:   ^a", short_path);
		     call ioa_ ("Requester:  ^a", ds.busy_id);
		     call ioa_ (QUEUE_COUNT_CS, ds_rqt, q_tt (*));
		end;

NEXT_DRIVER:
	     end;

	end DRIVER_STATUS_BEGIN_BLOCK;

DRIVER_STATUS_RETURNS:

	return;
%page;
/****^ * * * * * * * * * *  LIST_DEVICES  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

list_devices:
	entry (P_sci_ptr, P_odis_info_ptr);

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							 *
 *   Usage:  list_devices					 *
 *   							 *
 *   List the status of devices of interest to operators. Currently	 *
 *   only tape drives are listed via "odis_rcp_$list_tape_drives".	 *
 *   Although we could list disk information, it is simply too easy	 *
 *   to do a "..list_vols" to get the job done.			 *
 *							 *
 *   If you add other devices to this request, it would be right to	 *
 *   add the proper control arguments (ie. -tape/-disk). 		 *
 *							 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	call odis_request_prologue ();

	if arg_cnt ^= 0 then goto NO_ARGS_PLEASE;

       /****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
       *   						  *
       *  The output is done by "odis_rcp_$list_tape_drives".  Note	  *
       *  that we turn off the switch "odis_info.rcp_sys_moderr" to	  *
       *  force "odis_rcp_" to try again to use "rcp_sys_", even if	  *
       *  the last time he failed.  See "odis_rcp_" for more info on	  *
       *  this bit.						  *
       * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/

	odis_info.rcp_sys_moderr = "0"b;

	call odis_rcp_$list_tape_drives (odis_info_ptr, code);
	if code ^= 0 then
	     call ssu_$abort_line (sci_ptr, code, "Cannot get tape_drive info.");

	return;
%page;
/****^ * * * * * * * * * *  MODE  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

mode: entry (P_sci_ptr, P_odis_info_ptr);

	call odis_request_prologue ();

	if arg_cnt > 1 then
	     call ssu_$abort_line (sci_ptr, odis_et_$wrong_no_of_args, MODE_USAGE);

	if arg_cnt = 0 then do;		     /* Print mode. */
	     call ssu_$print_message (sci_ptr, 0, "Mode is ""^[operator^;dispatch^]"".",
	     (odis_info.display_mode = odis_cds_$operator_mode));
	     return;
	end;

	call ssu_$arg_ptr (sci_ptr, 1, ap, al);
	if arg = OPERATOR then
	     call odis_redisplay_$change_mode (odis_info_ptr, odis_cds_$operator_mode, code);
	else if arg = DISPATCH then
	     call odis_redisplay_$change_mode (odis_info_ptr, odis_cds_$dispatch_mode, code);
	else call ssu_$abort_line (sci_ptr, odis_et_$bad_arg, MODE_USAGE);

     /* Check mode from "change_mode". */
	if code ^= 0 then
	     call ssu_$abort_line (sci_ptr, code, "Mode is ""^[operator^;dispatch^]"".",
	     (odis_info.display_mode = odis_cds_$operator_mode));

	return;
%page;
/****^ * * * * * * * * * *  QUIT  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
quit_subsystem:
quit: entry (P_sci_ptr, P_odis_info_ptr);

	call odis_request_prologue ();

	if arg_cnt > 0 then goto NO_ARGS_PLEASE;

	goto odis_info.ssu.abort_label;

%page;
/****^ * * * * * * * * * *  REDISPLAY  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

redisplay: entry (P_sci_ptr, P_odis_info_ptr);

	call odis_request_prologue ();

	if arg_cnt ^= 0 then goto NO_ARGS_PLEASE;

	call odis_redisplay_$full_redisplay (odis_info_ptr);
	return;

%page;
/****^ * * * * * * * * * *   .   * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

self_identify:
dot: entry (P_sci_ptr, P_odis_info_ptr);

	dcl   odis_cds_$command_name char (32) external static;
	dcl   odis_cds_$subsystem_version char (8) external static;
	dcl   ioa_$ioa_switch        entry options (variable);

	call odis_request_prologue ();
	if arg_cnt > 0 then goto NO_ARGS_PLEASE;

     /*  We display info in mini window. */
	call ioa_$ioa_switch (odis_info.mini_window_iocb, "^a, ^a (^[operator^;dispatch^] mode)",
	     odis_cds_$command_name, odis_cds_$subsystem_version, odis_info.display_mode);


	return;

%page;
/****^ * * * * * * * * * *  SCAN_QUEUES  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

scan_queues:
     entry (P_sci_ptr, P_odis_info_ptr);

	call odis_request_prologue ();
	if arg_cnt > 0 then goto NO_ARGS_PLEASE;

	if odst.tot_scan_rqts = 0 then do;
	     call ssu_$print_message (sci_ptr, 0, "There are no queues specified for scanning. Contact programming staff.");
	     return;
	end;

	sq_temp_seg_ptr = null ();

     /* Release temp and fix windows. */
	on cleanup call scan_queues_cleanup;

	call ssu_$get_temp_segment (sci_ptr, "scan_queues", sq_temp_seg_ptr);

     /*  Save the line number of the last line of the display line before we grow the display window. See SCAN_QUEUES_USER_QUIT. */
	save_l_for_break_msg = odis_info.dis_window_info.height;

     /*  QUIT is how one stops this request. */
	on quit goto SCAN_QUEUES_USER_QUIT;


     /*  Now grow the display to maximum size for displaying the    */
     /*  detailed queue info. We restore display window on way out. */
	call odis_window_$shut_mini_window (odis_info_ptr);

     /* Before we loop on each request type, display what we are up to. */
     /* Calculate longest rqt name for 2 column output. */
	max_rqt_name_len = 0;		     /* set in loop */
	do i = 1 to odst.tot_scan_rqts;
	     rqt_name_len = length (rtrim (odst.scan_rqt.request_name (i)));
	     if rqt_name_len > max_rqt_name_len then max_rqt_name_len = rqt_name_len;
	end;

	max_rqt_name_len = max_rqt_name_len + 6;     /* spacing */

	rqt_first_scan_sw = "1"b;		     /* first time through loop switch */

	do while ("1"b);			     /* QUIT quits. */

	/* Before entering the loop which displays info for each  */
	/* request type, inform interested parties what we are    */
	/* scanning. If this is our first trip through, then tell */
	/* the user how to stop the scan.			   */
	     call iox_$control (video_data_$terminal_iocb, "clear_screen", null (), code);
	     call window_$position_cursor (odis_info.dis_window_iocb, 1, 1, code);
	     if rqt_first_scan_sw then do;
		call ioa_ ("Press BREAK key to return to the request loop.");
		rqt_first_scan_sw = ^rqt_first_scan_sw; /* not any more */
	     end;

	/* Display what we will scan, and sleep for a bit. */
	     call ioa_$nnl (SCAN_QUEUES_HEADER_LINE);

	/* Save cursor location so we can re-position after "...". */
	     call window_$get_cursor_position (odis_info.dis_window_iocb, save_l, save_c, code);

	     no_indent = "1"b;		     /* start in column 1. */
	     call ioa_ ("^/");		     /* separate from hdr. */

	/* 2 rqt's per line - Whatever we do here, do not cause MORE? break, hence "min" technology. */
	     do i = 1 to min (((odis_info.dis_window_info.height - 4) * 2), odst.tot_scan_rqts);
		call ioa_$nnl ("^[^va^;^s^a^/^]", no_indent, max_rqt_name_len, odst.scan_rqt.request_name (i));
		no_indent = ^no_indent;
	     end;

	/* Re-position to header line to signify we are working. */
	     call window_$position_cursor (odis_info.dis_window_iocb, save_l, save_c, code);

	/* Give oculars a chance. */
	     call timer_manager_$sleep (10, RELATIVE_SECONDS);

	     do i = 1 to odst.tot_scan_rqts;	     /* go through array. */

	     /* Subr. builds display in temp seg and flashes. Subr.  */
	     /* is smart in that it knows about subsys switches, the */
	     /* height of the display window, window operations, and */
	     /* so on. This is better than making it dumb and having  */
	     /* it pass back loads of information.		      */
		call odis_queue_$display_rqt_info
		     (odis_info_ptr,	     /* where to write */
		     sq_temp_seg_ptr,	     /* workspace */
		     odst.scan_rqt.dir (i),	          /* Where to find it. */
		     odst.scan_rqt.request_name (i));	/* The rqt to work on */
	     end;				     /* ... do i = 1   */
	end;				     /* ... do forever */


SCAN_QUEUES_USER_QUIT:			     /* Do NOT come here for other than QUIT return. */

      /* This has the advantage of causing "Use redisplay..." message in any case. */
	call window_$position_cursor (odis_info.dis_window_iocb, save_l_for_break_msg, 1, code);
	call window_$overwrite_text (odis_info.dis_window_iocb, "BREAK.", code);
	call window_$clear_to_end_of_window (odis_info.dis_window_iocb, code);
	

      /* <-- For a regular "crawlout" (if code changed) you would come here. */
	call scan_queues_cleanup ();

      /* Clear any "odis_queue_$display_rqt_info" mini-residue. */
	call window_$clear_window (odis_info.mini_window_iocb, code);
	return;
%page;
/****^ * * * * * * * * * *  SCAN_QUEUES_CLEANUP  * * * * * * * * * * */

scan_queues_cleanup:
     proc ();

	if sq_temp_seg_ptr ^= null () then
	     call ssu_$release_temp_segment (sci_ptr, sq_temp_seg_ptr);

     /* Did we shrink mini window? If so, return to former size. */
	if odis_info.mini_window_shut then
	     call odis_window_$open_mini_window (odis_info_ptr);

	return;

     end scan_queues_cleanup;
%page;
/****^ * * * * * * * * * *  DS_PRINT_ERROR  * * * * * * * * * * */

ds_print_error:
     proc (a_code, a_dev);

	dcl   a_code	         fixed bin (35) parameter;
	dcl   a_dev	         char (32) parameter; /* device name */

	dcl   dev_name	         char (32) varying; /* message prefix */
	dcl   convert_status_code_   entry (fixed bin (35), char (8) aligned, char (100) aligned);
	dcl   long_info	         char (100) aligned init ("");
	dcl   err_msg	         char (err_msg_len) based (addr (long_info));
	dcl   err_msg_len	         fixed bin;

	call convert_status_code_ (a_code, (""), long_info);

	if a_dev = "" then dev_name = "driver_status"; /* not driver specific */
	else dev_name = a_dev;


     /* Make sure it is truncated to 1 line long (hence "length" tech.) */
	err_msg_len = (odis_info.dis_window_info.width - length (dev_name) - 2);

     /* Output a blank line and the error message (:= 2 lines). */
	call driver_status_more_check (2);

	call ioa_ ("^/^a: ^a", dev_name, err_msg);

	return;

     end ds_print_error;




/****^ * * * * * * * * * *  DRIVER_STATUS_MORE_CHECK  * * * * * * * * * * */

driver_status_more_check:
     proc (n_lines_needed);

     /* If n_lines_needed = 0 then output enough to cause MORE? break. */

	dcl   n_lines_needed         fixed bin parameter;
	dcl   n_lines_avail	         fixed bin;
	dcl   n_lines_left	         fixed bin;

	n_lines_left = odis_info.dis_window_info.height - driver_status_current_line;
	n_lines_avail = n_lines_left - 1;	     /* amt he can use */

      /* Force break if n_lines_needed = 0. */
	if n_lines_needed = 0 then n_lines_needed = n_lines_left;
	if n_lines_avail < n_lines_needed then do;    /* cause MORE? break */
	     call ioa_ ("^v/", (n_lines_left - 1));

	/*	< MORE? BREAK >   */

	/* Was written on a new page right! */
	     driver_status_current_line = n_lines_needed + 1;
	end;

     /* Allow output. */
	else driver_status_current_line = driver_status_current_line + n_lines_needed;

	return;

     end driver_status_more_check;
%page;
odis_request_prologue: proc ();

     /* Copy parameters and get arg count. */

	odis_info_ptr = P_odis_info_ptr;
	sci_ptr = P_sci_ptr;
	odst_ptr = odis_info.site_table_ptr;
	call ssu_$arg_count (sci_ptr, arg_cnt);
	return;
     end odis_request_prologue;


%page;
%include opr_display_info;
%page;
%include opr_display_site_table;

     end odis_requests_;




		    odis_window_.pl1                02/14/84  1605.8rew 01/21/84  1733.1      178434



/*  OPERATOR_DISPLAY window management. We know about windows, there size  */
/*  and characteristics, but nothing about there contents. There are the   */
/*  following entrypoints:					     */
/*							     */
/*	create_windows	      -- creates the windows necessary for   */
/*			         the subsystem. We have 2 windows:   */
/*			         DISPLAY WINDOW (top)  --  this is   */
/*			         where the display is handled, and   */
/*			         user_io is processed.	     */
/*			         MINI WINDOW (bottom)  --  this is   */
/*			         where error_output, status messages */
/*			         and interactive messages go.	     */
/*							     */
/*	destroy_windows	      -- destroy the display windows created */
/*			         and reattaches user_io as before.   */
/*							     */
/*	adjust_display_window     -- adjust the size of the display      */
/*			         window, and of course adjust the    */
/*			         mini window appropriately.	     */
/*							     */
/*	shut_mini_window	      -- shrink mini window to 1 line and    */
/*			         set odis_info.mini_window_shut on   */
/*			         and set odis_info.mini_window_open_n */
/*							     */
/*	open_mini_window	      -- grow mini window to former size     */
/*			         set odis_info.mini_window_shut off. */
/*							     */
/*	check_window_status	      -- checks status for windows.	     */
/*							     */
/*	no_video_cleanup	      -- special case hack for the situation */
/*			         where video was revoked while the   */
/*			         subsystem was active, yet some      */
/*			         cleanup on our part is necessary.   */
/*							     */
/*							     */
/*  The window info for both windows is ALWAYS up to date. All orders      */
/*  to change this info use odis_info.XXX_window_info. These values are    */
/*  trusted. This proc is the only one to change window characteristics.   */

/* Written  82-09-11 by A.G. Haggett (unca). */
/* Modified 83-01-03 by A.G. Haggett (unca) to make mode setting smarter. */

odis_window_:
     proc;
	return;


	dcl   a_odis_info_ptr        pointer parameter;
	dcl   a_code	         fixed bin (35) parameter;

     /* AUTOMATIC */
	dcl   code	         fixed bin (35);
	dcl   1 user_io_window_info  aligned like window_position_info;
	dcl   old_modes	         char (256) init ("");     /* Scratch */

     /* STATIC */
	dcl   GET_WINDOW_INFO        char (15) init ("get_window_info") static options (constant);
	dcl   SET_WINDOW_INFO        char (15) init ("set_window_info") static options (constant);
	dcl   GET_WINDOW_STATUS      char (17) init ("get_window_status") static options (constant);

     /* ENTRIES/EXTERNAL */
	dcl   (iox_$user_io, iox_$error_output) pointer external static;
	dcl   iox_$attach_ptr        entry (ptr, char (*), ptr, fixed bin (35));
	dcl   iox_$control	         entry (ptr, char (*), ptr, fixed bin (35));
	dcl   iox_$detach_iocb       entry (ptr, fixed bin (35));
	dcl   iox_$find_iocb         entry (char (*), ptr, fixed bin (35));
	dcl   iox_$modes	         entry (ptr, char (*), char (*), fixed bin (35));
	dcl   iox_$move_attach       entry (ptr, ptr, fixed bin (35));
	dcl   odis_window_$destroy_windows entry ();
	dcl   odis_cds_$needed_screen_lines fixed bin external static;
	dcl   odis_cds_$needed_screen_width fixed bin external static;
	dcl   odis_cds_$initial_display_size fixed bin (17) external static;
	dcl   odis_cds_$min_mini_window_size fixed bin external static;
	dcl   odis_et_$no_room_for_windows fixed bin (35) external static;
	dcl   odis_et_$video_revoked fixed bin (35) external static;
	dcl   odis_window_$adjust_display_window entry (ptr, fixed bin, fixed bin (35));
	dcl   operator_display_$abort_subsystem entry (ptr, fixed bin (35), char (*));
	dcl   ssu_$get_debug_mode    entry (ptr) returns (bit (1) aligned);
	dcl   ssu_$print_message     entry () options (variable);
	dcl   video_data_$terminal_iocb pointer external static;
	dcl   window_$position_cursor entry (ptr, fixed bin, fixed bin, fixed bin (35));
	dcl   window_$destroy        entry (ptr, fixed bin (35));

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

	dcl   (null, rtrim, length, unspec, addr) builtin;
%page;
create_windows: entry (a_odis_info_ptr, a_code);

     /* A window exists, of course, when this program is called. When  */
     /* video was invoked, the user_io window is by default the only   */
     /* one. If we were already in video, then the user_io window must */
     /* have been there. We create 2 windows - "display" and "mini"    */
     /* Note that the user_io window is syn_'ed to the display window. */
     /* After windows are created, we set "odis_info.windows_made".    */
     /* When windows destroyed, we reattach user_io to its old self.   */

	a_code = 0;
	odis_info_ptr = a_odis_info_ptr;

	odis_info.dis_window_iocb,
	     odis_info.mini_window_iocb,
	     odis_info.saved_user_io_ptr,
	     odis_info.saved_err_output_ptr = null ();
	odis_info.mini_window_shut = "0"b;
	odis_info.mini_window_open_n = 0;
	odis_info.windows_made = "0"b;

     /* Find out about user_io and if we have room. */
	user_io_window_info.version = window_position_info_version;
	call iox_$control (iox_$user_io, GET_WINDOW_INFO,
	     addr (user_io_window_info), a_code);
	if a_code ^= 0 then return;		     /* fatal */

	if user_io_window_info.height < odis_cds_$needed_screen_lines
	     | user_io_window_info.width < odis_cds_$needed_screen_width then do;
	     a_code = odis_et_$no_room_for_windows;  /* fatal */
	     return;
	end;

     /* Well we have room, so let's create the display windows. */

	call create_window ("dis_window",	     /* switch name */
	     user_io_window_info.line,	     /* origin */
	     odis_cds_$initial_display_size,	     /* height */
	     user_io_window_info.width,	     /* width */
	     addr (odis_info.dis_window_info),	     /* input/output */
	     odis_info.dis_window_name,	     /* output */
	     odis_info.dis_window_iocb,	     /* output */
	     a_code);
	if a_code ^= 0 then goto CREATE_BACKOUT_RETURN;

	odis_info.windows_made = "1"b;

	call create_window ("mini_window",
	     (user_io_window_info.line + odis_cds_$initial_display_size),
	     (user_io_window_info.height - odis_cds_$initial_display_size),
	     user_io_window_info.width,
	     addr (odis_info.mini_window_info),
	     odis_info.mini_window_name,
	     odis_info.mini_window_iocb,
	     a_code);
	if a_code ^= 0 then goto CREATE_BACKOUT_RETURN;

     /* Set modes for windows. */

	call set_dis_window_modes (code);
	if code ^= 0 then
	     call ssu_$print_message (odis_info.sci_ptr, code, "Warning: Unable to set modes in display window.");

	call set_mini_window_modes (code);
	if code ^= 0 then
	     call ssu_$print_message (odis_info.sci_ptr, code, "Warning: Unable to set modes in mini window.");

	call user_io_swapo_save (a_code);	     /* save user_io and error_output */
	if a_code ^= 0 then goto CREATE_BACKOUT_RETURN;

	return;				     /* Whew! */

CREATE_BACKOUT_RETURN:
	call odis_window_$destroy_windows ();
	return;

%page;
destroy_windows: entry (a_odis_info_ptr);


	odis_info_ptr = a_odis_info_ptr;

     /* Get back regular video user_i/o and error_output. */
	call user_io_swapo_restore ();

	call destroy_window (odis_info.dis_window_iocb);
	call destroy_window (odis_info.mini_window_iocb);

	return;

%page;
adjust_display_window:
     entry (a_odis_info_ptr, a_change, a_code);

	dcl   a_change	         fixed bin;

     
/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   						       *
 *     a_odis_info_ptr  --  (INPUT) points to odis_info	       *
 *     a_change	 --  (INPUT) +N to grow, -N to shrink	       *
 *     a_code	 --  (OUTPUT) 0 or et_$action_not_performed    *
 *						       *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */


	odis_info_ptr = a_odis_info_ptr;
	a_code = 0;
	if a_change = 0 then return;

      /* If we are to grow display window, can we shrink the mini window by the needed amount? */
	if a_change > 0 then do;		     /* GROW	**/
	     if (odis_info.mini_window_info.height - a_change) < odis_cds_$min_mini_window_size
	     then goto ADJUST_CANT_ADJUST;

	     call change_mini_window (-a_change);    /* shrink mini and... */
	     call change_dis_window (a_change);	     /* ...grow dis        */
	end;

     /*  Shring the display window and grow mini window. */
	else do;				     /* SHRINK	**/
	     call change_dis_window (a_change);	     /* shrink dis and... */
	     call change_mini_window (-a_change);    /* ...grow mini      */
	end;

	return;

ADJUST_CANT_ADJUST:
	if ssu_$get_debug_mode (odis_info.sci_ptr) then
	     call ssu_$print_message (odis_info.sci_ptr, a_code, "Adjust cant adjust");
	a_code = error_table_$action_not_performed;
	return;



%page;
change_dis_window: proc (n);

	dcl   n		         fixed bin parameter; /* +/- */
	dcl   wip		         pointer;	     /* window_info_ptr */
	dcl   window_iocbp	         pointer;

	wip = addr (odis_info.dis_window_info);
	window_iocbp = odis_info.dis_window_iocb;
	goto CHANGE_WINDOW_COMMON;

change_mini_window: entry (n);

	wip = addr (odis_info.mini_window_info);
	window_iocbp = odis_info.mini_window_iocb;

     /* Common code will change height, we change origin now. */
	wip -> window_position_info.line = wip -> window_position_info.line - n;

CHANGE_WINDOW_COMMON:			     /* multiplex */
	wip -> window_position_info.height = wip -> window_position_info.height + n;
	call iox_$control (window_iocbp, SET_WINDOW_INFO, wip, a_code);
	if a_code ^= 0 then goto ADJUST_CANT_ADJUST;
	return;

     end change_dis_window;
%page;
shut_mini_window:
     entry (a_odis_info_ptr);

     /*  What is this all about? Well, if a request which wants as  */
     /*  as much of the screen as possible pops up, he calls this   */
     /*  entry. We shrink the mini window as much as we can and     */
     /*  set the var. "odis_info.mini_window_open_n" to the number  */
     /*  of lines we stole from the mini window. We also grow the   */
     /*  display window by this value and set ^more in mini.  We    */
     /*  turn on the bit "odis_info.mini_window_shut" as well.      */

	dcl   change	         fixed bin;

	odis_info_ptr = a_odis_info_ptr;

	if odis_info.mini_window_shut then	     /* !! ALREADY SHUT !! */
	     call operator_display_$abort_subsystem (odis_info_ptr, 0, "Internal error: Call to shut mini window with window already shut.");

     /* Calculate how much we have to shrink it by. */
	change = odis_info.mini_window_info.height - odis_cds_$min_mini_window_size;

     /* If we have to, grow the display window. */
	if change > 0 then do;
	     call odis_window_$adjust_display_window (odis_info_ptr, change, code);
	     if code ^= 0 then
		call operator_display_$abort_subsystem (odis_info_ptr, code, "(shut_mini_window): Cannot grow the display window");
	end;

	odis_info.mini_window_shut = "1"b;	     /* It is shut and we stole   */
	odis_info.mini_window_open_n = change;	     /* this many lines to do it. */
	call set_mini_window_modes ((0));
	return;
%page;
open_mini_window:
     entry (a_odis_info_ptr);

	odis_info_ptr = a_odis_info_ptr;

	if ^odis_info.mini_window_shut then return;  /* !! ALREADY OPEN !! */

	if odis_info.mini_window_open_n > 0 then do; /* we stole some lines */
	     call odis_window_$adjust_display_window (odis_info_ptr, (-odis_info.mini_window_open_n), code);
	     if code ^= 0 then
		call operator_display_$abort_subsystem (odis_info_ptr, code, "(open_mini_window): Cannot restore the display window");
	end;

     /* Restore mini window modes. */
	call set_mini_window_modes ((0));

	odis_info.mini_window_shut = "0"b;
	odis_info.mini_window_open_n = 0;

	return;


%page;
check_window_status:
     entry (a_odis_info_ptr);

	odis_info_ptr = a_odis_info_ptr;
	call clear_window_status ();
	return;

%page;
no_video_cleanup:
     entry (a_odis_info_ptr);

	dcl   iox_$close	         entry (ptr, fixed bin (35));
	dcl   iox_$destroy_iocb      entry (ptr, fixed bin (35));

	odis_info_ptr = a_odis_info_ptr;

     /* If no video system then we do the following:		      */
     /*    o  destroy the saved error_output switch.		      */
     /*    o  destroy the saved user_i/o switch.			      */
     /*    o  reattach error_output as it should be. When we are	      */
     /*       error_output is a syn_ to an old video window!!	      */
     /*    o  destroy the cast off video windows			      */

	if odis_info.saved_user_io_ptr ^= null () then do; /* Orphaned? */
	     call iox_$close (odis_info.saved_user_io_ptr, code);
	     call iox_$detach_iocb (odis_info.saved_user_io_ptr, code);
	     call iox_$destroy_iocb (odis_info.saved_user_io_ptr, code);
	end;

	if odis_info.saved_err_output_ptr ^= null () then do;
	     call iox_$close (odis_info.saved_err_output_ptr, code);
	     call iox_$detach_iocb (odis_info.saved_err_output_ptr, code);
	     call iox_$destroy_iocb (odis_info.saved_err_output_ptr, code);
	end;

     /* Fix up error_output. This fix up should really use the info  */
     /* used by iox_init_. This could easily be done by checking the */
     /* the pointer or name until we matched error_output, then use  */
     /* the attach_description in "iocb_info.attach_description".    */
	call iox_$detach_iocb (iox_$error_output, code);
	call iox_$attach_ptr (iox_$error_output, "syn_ user_i/o -inh close get_chars get_line", null (), code);

     /* Destroy old odis window switches. This is unecessary really. */
	if odis_info.dis_window_iocb ^= null () then
	     call iox_$destroy_iocb (odis_info.dis_window_iocb, code);
	if odis_info.mini_window_iocb ^= null () then
	     call iox_$destroy_iocb (odis_info.mini_window_iocb, code);

	return;
%page;
/****^ * * * * * * * * * *  CREATE_WINDOW  * * * * * * * * * * */

create_window:
     proc (a_name, a_origin_line, a_height, a_width, a_info_ptr, a_window_name, a_iocbp, a_code);

	dcl   a_name	         char (*);	     /* We'll make this unique. */
	dcl   a_origin_line	         fixed bin;	     /* Where it starts. */
	dcl   a_height	         fixed bin;
	dcl   a_width	         fixed bin;
	dcl   a_info_ptr	         pointer;	     /* points to a window_position_info structure (in "odis_info"). */
	dcl   a_window_name	         char (32);	     /* recursion dictate */
	dcl   a_iocbp	         pointer;	     /* we fill this in */
	dcl   a_code	         fixed bin (35);

	dcl   1 wpi	         aligned like window_position_info based (a_info_ptr);
	dcl   window_$create         entry (ptr, ptr, ptr, fixed bin (35));

	a_code = 0; a_iocbp = null ();

	a_window_name = get_unique_switch (a_name);
	wpi.version = window_position_info_version;
	unspec (wpi.mbz) = ""b;
	wpi.line = a_origin_line;
	wpi.height = a_height;
	wpi.width = a_width;

	call iox_$find_iocb (a_window_name, a_iocbp, a_code);
	if a_code ^= 0 then goto CREATE_NULLP_RETURN;

	call window_$create (video_data_$terminal_iocb, a_info_ptr, a_iocbp, a_code);
	if a_code ^= 0 then
CREATE_NULLP_RETURN:
	     a_iocbp = null ();		     /* cleanup flag. */

	return;

     end create_window;

%page;
/****^ * * * * * * * * * *  DESTROY_WINDOW  * * * * * * * * * * */

destroy_window:
     proc (a_iocbp);
	dcl   a_iocbp	         pointer;

	if a_iocbp = null () then return;	     /* this one not made */

	call window_$destroy (a_iocbp, (0));
	call iox_$destroy_iocb (a_iocbp, code);
	a_iocbp = null ();
	return;

     end destroy_window;

%page;
/****^ * * * * * * * * * *  USER_IO_SWAPO_SAVE  * * * * * * * * * * */

user_io_swapo_save:
     proc (a_code);

	dcl   a_code	         fixed bin (35);
	dcl   iocbp	         pointer;

	a_code = 0;

     /*  MOVE_ATTACH USER_IO */
	call iox_$find_iocb (get_unique_switch ("save_user_io"), iocbp, a_code);
	if a_code ^= 0 then call swapo_abort_subsys ("Cannot create save_user_io iocb.");
	call iox_$move_attach (iox_$user_io, iocbp, a_code);
	if a_code ^= 0 then call swapo_abort_subsys ("Cannot move_attach user_io.");
	odis_info.saved_user_io_ptr = iocbp;	     /* static save */
	call iox_$attach_ptr (iox_$user_io, "syn_ " || rtrim (odis_info.dis_window_name), null (), a_code);
	if a_code ^= 0 then call swapo_abort_subsys ("Cannot re-attach user_io.");

     /* MOVE_ATTACH ERROR_OUTPUT */
	call iox_$find_iocb (get_unique_switch ("save_err_output"), iocbp, a_code);
	if a_code ^= 0 then call swapo_abort_subsys ("Cannot create save_err_output iocb.");
	call iox_$move_attach (iox_$error_output, iocbp, a_code);
	if a_code ^= 0 then call swapo_abort_subsys ("Cannot move_attach error_output iocb.");
	odis_info.saved_err_output_ptr = iocbp;	     /* static save */
	call iox_$attach_ptr (iox_$error_output, "syn_ " || rtrim (odis_info.mini_window_name), null (), a_code);
	if a_code ^= 0 then call swapo_abort_subsys ("Cannot re-attach error_output iocb.");
	return;



swapo_abort_subsys: proc (a_reason);

	     dcl	 a_reason		    char (*);

	     call operator_display_$abort_subsystem (odis_info_ptr, a_code, a_reason);
	     return;			     /* Will never... */

	end swapo_abort_subsys;

     end user_io_swapo_save;






/****^ * * * * * * * * * *  USER_IO_SWAPO_RESTORE  * * * * * * * * * * */

user_io_swapo_restore:
     proc ();

	if odis_info.saved_user_io_ptr ^= null () then do;
	     call iox_$detach_iocb (iox_$user_io, (0));
	     call iox_$move_attach (odis_info.saved_user_io_ptr, iox_$user_io, (0));
	     call iox_$destroy_iocb (odis_info.saved_user_io_ptr, code);
	end;

	if odis_info.saved_err_output_ptr ^= null () then do;
	     call iox_$detach_iocb (iox_$error_output, (0));
	     call iox_$move_attach (odis_info.saved_err_output_ptr, iox_$error_output, (0));
	     call iox_$destroy_iocb (odis_info.saved_err_output_ptr, code);
	end;
	return;

     end user_io_swapo_restore;

%page;

/****^ * * * * * * * * * *  GET_UNIQUE_SWITCH  * * * * * * * * * * */

get_unique_switch:
     proc (a_name) returns (char (32));

	dcl   a_name	         char (*);


     /* Switches (windows) are per-invocation so we use invocation level uniqueness. */
     /* Character representation of invocation level in odis_info.invocation_level_c. */
	return ("odis" || odis_info.invocation_level_c || "." || a_name);

     end get_unique_switch;
%page;
/****^ * * * * * * * * * *  SET_DIS_WINDOW_MODES  * * * * * * * * * * */
set_dis_window_modes:
	proc (a_code);

	dcl a_code	fixed bin (35) parameter;

	a_code = 0;

	/* Try "scroll" first. */
	call iox_$modes (odis_info.dis_window_iocb, "more_mode=scroll", old_modes, a_code);
	if a_code ^= 0 then			     /* Settle for "clear". */
	     call iox_$modes (odis_info.dis_window_iocb, "more_mode=clear", old_modes, a_code);

	return;

end set_dis_window_modes;




/****^ * * * * * * * * * *  SET_MINI_WINDOW_MODES  * * * * * * * * * * */
set_mini_window_modes:
	proc (a_code);

	dcl a_code	fixed bin (35) parameter;

	a_code = 0;

	/* "^more" is our only wish. */
	call iox_$modes (odis_info.mini_window_iocb, "^more", old_modes, a_code);

	return;

end set_mini_window_modes;
%page;
/****^ * * * * * * * * * *  CLEAR_WINDOW_STATUS  * * * * * * * * * * */

clear_window_status: proc;

	dcl   1 auto_ws	         aligned like window_status_info;
	dcl   code	         fixed bin (35) init (0);

	auto_ws.version = window_status_version;
	auto_ws.status_string = ""b;

	call iox_$control (odis_info.dis_window_iocb, GET_WINDOW_STATUS, addr (auto_ws), code);
	call iox_$control (odis_info.mini_window_iocb, GET_WINDOW_STATUS, addr (auto_ws), code);
	if code ^= 0 then
	     if video_data_$terminal_iocb = null () then
		call operator_display_$abort_subsystem (odis_info_ptr, odis_et_$video_revoked, "Could not check window status.");
	     else call operator_display_$abort_subsystem (odis_info_ptr, code, "Could not check window status.");

	return;

     end clear_window_status;

%page;
%include opr_display_info;
     end odis_window_;




		    odis_cds_.cds                   01/05/83  1407.5rew 01/05/83  1330.6       29223



/* OPERATOR_DISPLAY data segment for constants and 1 static pointer. */

odis_cds_:
     proc;

/* September, 1982. A.G. Haggett (unca). */
/* Modified 82-11-09 by A.G. Haggett (unca) for "site_table_XXX" values. */
/* Modified 83-01-03 by A.G. Haggett (unca) to purge mode strings. */

%include cds_args;
dcl 1 cdsa		 aligned like cds_args;


dcl create_ips_mask_	 entry (pointer, fixed binary, bit (36) aligned);
dcl create_data_segment_	 entry (pointer, fixed binary (35));
dcl com_err_		 entry () options (variable);

dcl code		 fixed bin (35);

dcl 1 odis_text			aligned,
      2 command_name		char (32) unal,
      2 subsystem_version		char (8) unal,
      2 subsystem_name		char (32) unal,
      2 operator_mode		fixed bin,
      2 dispatch_mode		fixed bin,
      2 needed_screen_lines		fixed bin,
      2 needed_screen_width		fixed bin,
      2 initial_display_size		fixed bin,     /* # of lines */
      2 min_mini_window_size		fixed bin,
      2 timer_interval		fixed bin (71),
      2 info_prefix			char (32) unal,
      2 info_dir			char (168) unal,
      2 enk_only_mask		bit (36) aligned,
      2 word_align_it		bit (0) aligned;


dcl 1 odis_static			aligned,
      2 static_odi_ptr		pointer,
      2 site_table_dirname		char (168),
      2 site_table_entname		char (32);

dcl enk_only_name	 (3) char (32) aligned static options (constant)
		 init ("trm_", "sus_", "neti");

dcl ME			 char (32) init ("odis_cds_") static options (constant);
dcl pad_star		 (1) char (32) init ("pad*") static options (constant);

dcl create_ips_mask_err	 condition;
dcl sys_info$system_control_dir char (168) varying external static;
dcl (addr, currentsize, hbound, null, string, unspec) builtin;
/***^*/

	unspec (odis_text) = ""b;
	odis_text.command_name = "operator_display";
	odis_text.subsystem_version = "1.1a";
	odis_text.subsystem_name = "odis";
	odis_text.operator_mode = 1;
	odis_text.dispatch_mode = 2;
	odis_text.needed_screen_lines = 24;
	odis_text.needed_screen_width = 79;
	odis_text.initial_display_size = 20;	     /* of "dis" window */
	odis_text.min_mini_window_size = 1;	     /* at least 1 line. */
	odis_text.timer_interval = 12;	     /* every 12 seconds */
	odis_text.info_prefix = "odis";
	odis_text.info_dir = ">doc>ss>operator_display";


	on create_ips_mask_err begin;
	     call com_err_ (0, ME, "Cannot generate IPS masks.");
	     go to FATAL;
	end;

	call create_ips_mask_ (addr (enk_only_name), hbound (enk_only_name, 1), odis_text.enk_only_mask);
	odis_text.enk_only_mask = ^odis_text.enk_only_mask;

	unspec (odis_static) = ""b;
	odis_static.static_odi_ptr = null();
	odis_static.site_table_dirname = sys_info$system_control_dir;
	odis_static.site_table_entname = "odst";

	string (cdsa.switches) = ""b;
	cdsa.switches.have_text = "1"b;
	cdsa.switches.have_static = "1"b;

	cdsa.p (1) = addr (odis_text);
	cdsa.len (1) = currentsize (odis_text);
	cdsa.struct_name (1) = "odis_text";
	cdsa.p (2) = addr (odis_static);
	cdsa.len (2) = currentsize (odis_static);
	cdsa.struct_name (2) = "odis_static";

	cdsa.seg_name = ME;
	cdsa.num_exclude_names = 1;
	cdsa.exclude_array_ptr = addr (pad_star);

	call create_data_segment_ (addr (cdsa), code);
	if code ^= 0 then call com_err_ (code, ME);
FATAL:
	return;
end odis_cds_;




		    odis_redisplay_.pl1             02/14/84  1605.8rew 01/21/84  1733.2       78993



/*  OPERATOR_DISPLAY: This proc has entries for managing the contents of    */
/*  windows. We are the sole caller of the redisplay worker/manager called  */
/*  odis_rdis_. Some of the entries in this module are simply transfer      */
/*  calls to odis_rdis_$similar_name. We mask down 'fore calling any of the */
/*  odis_rdis_ entries, using odis_cds_$enk_only_mask (allow AS IPS only).  */
/*  This may not be necessary in all cases, but the general rule is that    */
/*  odis_rdis_ expects to be called with timers/quit masked, as image       */
/*  updating should be atomic. This is the code which runs masked.	      */
/*							      */
/*  The entries in this module are demand called by other modules. Async    */
/*  timer calls are all handled by odis_rdis_$XXXX.  These  async calls     */
/*  update the buffer image and then do a redisplay, but this documentation */
/*  is better left to odis_rdis_.				      */

/* Written 82-09-11 by A.G. Haggett (unca). */
/* Modified 82-11-12 by A.G. Haggett (unca) for "rcp_sys_moderr". See "odis_rcp_" for motivation. */

odis_redisplay_: proc;
	       return;


/* PARAMETERS */
dcl (a_odis_info_ptr, a_sci_ptr) pointer parameter;
dcl a_code fixed bin (35) parameter;
dcl a_new_mode fixed bin parameter;

/* AUTOMATIC */
dcl 1 window_status aligned like window_status_info;
dcl code fixed bin (35);
dcl old_mask bit (36) aligned init (""b);
/* STATIC */
dcl video_et_$cursor_position_undefined fixed bin (35) external static;

/* ENTRIES/EXTERNAL */
dcl hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned);
dcl hcs_$reset_ips_mask entry (bit (36) aligned, bit (36) aligned);
dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35));
dcl odis_cds_$enk_only_mask bit (36) aligned external static;
dcl odis_rdis_$init entry (ptr);
dcl odis_rdis_$cleanup entry (ptr);
dcl odis_rdis_$start entry (ptr);
dcl odis_rdis_$shut entry (ptr);
dcl odis_rdis_$instate_mode entry (ptr, fixed bin);
dcl odis_rdis_$full_redisplay entry (ptr);
dcl operator_display_$abort_subsystem entry (ptr, fixed bin(35), char(*));
dcl window_$clear_to_end_of_window entry (ptr, fixed bin (35));
dcl window_$clear_window entry (ptr, fixed bin (35));
dcl window_$get_cursor_position entry (ptr, fixed bin, fixed bin, fixed bin (35));
dcl window_$overwrite_text entry (ptr, char (*), fixed bin (35));
dcl window_$position_cursor entry (ptr, fixed bin, fixed bin, fixed bin (35));

dcl error_table_$action_not_performed fixed bin(35) ext static;
dcl video_data_$terminal_iocb pointer external static;

dcl (addr, null, max) builtin;
dcl cleanup condition;
%page;
initialize:		entry (a_odis_info_ptr);

	on cleanup call redisplay_cleanup();
	call redisplay_setup ();
	call odis_rdis_$init (odis_info_ptr);	     /* get image buffer */
	goto REDISPLAY_RETURNS;


cleanup:			entry (a_odis_info_ptr);

	on cleanup call redisplay_cleanup ();
	call redisplay_setup ();
	call odis_rdis_$cleanup (odis_info_ptr);
	goto REDISPLAY_RETURNS;


shutdown:			entry (a_odis_info_ptr);

	on cleanup call redisplay_cleanup ();
	call redisplay_setup ();
	odis_info.display_off = "1"b;
	call odis_rdis_$shut (odis_info_ptr);
	goto REDISPLAY_RETURNS;


off:			entry (a_odis_info_ptr);

	/* A call to full_redisplay turns things back on. */

	on cleanup call redisplay_cleanup ();
	call redisplay_setup ();
	odis_info.display_off = "1"b;
	goto REDISPLAY_RETURNS;


change_mode:		entry (a_odis_info_ptr, a_new_mode, a_code);

	on cleanup call redisplay_cleanup();
	call redisplay_setup ();

	a_code = 0;
	if a_new_mode = odis_info.display_mode then do;
	     a_code = error_table_$action_not_performed;
	     goto REDISPLAY_RETURNS;
	end;

	odis_info.rcp_sys_moderr = "0"b;	     /* Clear for re-try maybe. */

	call odis_rdis_$instate_mode (odis_info_ptr, a_new_mode);
	goto REDISPLAY_RETURNS;



full_redisplay:		entry (a_odis_info_ptr);

	on cleanup call redisplay_cleanup();
	call redisplay_setup ();
	
	call iox_$control (video_data_$terminal_iocb, "clear_screen", null(), code);

	/* Without these 2 calls, window_ gets confused about cursor. */
	call window_$position_cursor (odis_info.dis_window_iocb, 1, 1, code);
	call window_$position_cursor (odis_info.mini_window_iocb, 1, 1, code);

	odis_info.display_off, odis_info.rcp_sys_moderr = "0"b;
	call odis_rdis_$full_redisplay (odis_info_ptr);

	goto REDISPLAY_RETURNS;



REDISPLAY_RETURNS:
	call redisplay_cleanup ();
	return;

%page;
redisplay_setup: proc ();

	odis_info_ptr = a_odis_info_ptr;
	call hcs_$set_ips_mask (odis_cds_$enk_only_mask, old_mask);
	return;

end redisplay_setup;





redisplay_cleanup: proc ();

	dcl 1 ips_mask_mask		aligned based (addr (old_mask)),
	      2 ips_bits		bit (35) unaligned,
	      2 masked_down		bit (1)  unaligned;

	if masked_down then		     /* control bit on? */
	     call hcs_$reset_ips_mask (old_mask, old_mask);
	return;

end redisplay_cleanup;


%page;
post_request_line:
	entry (a_odis_info_ptr);

	dcl (l, c)		fixed bin;
	dcl HOW_TO_RESUME_DISPLAY	char (79) static options (constant)
		init ("Use ""redisplay"" (r) request to resume display.");

	/*  Called by:  odis_execute_line_			     */
	/*  This is called imediately after the execution of each user   */
	/*  REQUEST LINE. We have one very important thing to do: if the */
	/*  display has been disrupted by request output, then we turn   */
	/*  the display off and write the line telling the user how to   */
	/*  get redisplay going. Since a redisplay always leaves the     */
	/*  cursor at 1, 1, we know the display has been disrupted if it */
	/*  not at 1, 1.  The only case where it will fail, is if a user */
	/*  request happens to leave the cursor at 1, 1. If however, a   */
	/*  request produced at least a window-full of output, and the   */
	/*  user responded with DEL to the MORE? break, then the redis-  */
	/*  play will resume (as it should in this case) at the next     */
	/*  timer cycle update.				     */

	odis_info_ptr = a_odis_info_ptr;

	call window_$get_cursor_position (odis_info.dis_window_iocb, l, c, code);
	if code ^= 0 then			     /*  fatal??  */
	     if code = video_et_$cursor_position_undefined then do;
		/*  Then define it so we get redisplay message. */
		call window_$position_cursor (odis_info.dis_window_iocb, 11, 1, code);
		call window_$get_cursor_position (odis_info.dis_window_iocb, l, c, code);
	     end;

	/*  If the code was not 'cursor_position_undefined' or it was but  */
	/*  we could not define it in the previous 2 calls, then abort.    */
	if code ^= 0 then
	     call operator_display_$abort_subsystem (odis_info_ptr, code, "Could not get cursor position in the display window.");

	/*  Do a reset_more in any case because we will want the	     */
	/*  redisplay resume message and/or prompt to get to the screen. */
	call iox_$control (odis_info.dis_window_iocb, "reset_more", null(), code);

	if c ^= 1 | l ^= 1 then do;		     /* display screwed */
	     odis_info.display_off = "1"b;
	     call window_$clear_to_end_of_window (odis_info.dis_window_iocb, code);
	     call window_$position_cursor (odis_info.dis_window_iocb, odis_info.dis_window_info.height, 1, code);
	     call window_$overwrite_text (odis_info.dis_window_iocb, HOW_TO_RESUME_DISPLAY, code);
	     call window_$position_cursor (odis_info.dis_window_iocb, 1, 1, code);
	end;

	return;

%page;
prompt:
	entry (a_sci_ptr);

	dcl ioa_$ioa_switch_nnl entry options (variable);
	dcl ssu_$get_info_ptr entry (ptr) returns(ptr);

/*  This entry is called by ssu_ before reading the next user request line. */
/*  We position the cursor to the first line of the mini window and  */
/*  display a prompt.  */

	odis_info_ptr = ssu_$get_info_ptr (a_sci_ptr);

	/* Position to first line. */
	call window_$position_cursor (odis_info.mini_window_iocb, 1, 1, (0));
	call ioa_$ioa_switch_nnl (odis_info.mini_window_iocb, "^a  ", odis_info.prompt);

	return;

%page;
mini_remark:
	entry (a_odis_info_ptr, a_message);

	dcl a_message char (*);
	dcl mini_print_line fixed bin;	     /* 1 if print entry. */

	/*  Print the message on line 1. This will be obliterated by the  */
	/*  next prompt - therefore 'remark'.	*/

	mini_print_line = 1;		     /* For _remark. */
	goto MINI_REMARK_PRINT;		     /* common code. */

mini_print:
	entry (a_odis_info_ptr, a_message);

	/*  Print the message on line 2. It will stay around for awhile.  */
	mini_print_line = 2;

MINI_REMARK_PRINT:
	odis_info_ptr = a_odis_info_ptr;

	call window_$clear_window (odis_info.mini_window_iocb, code);

	/* If we are "mini_print" then line will be 2, else it will be 1. */
	call window_$position_cursor (odis_info.mini_window_iocb, mini_print_line, 1, code);
	call window_$overwrite_text (odis_info.mini_window_iocb, a_message, code);
	return;


%page;

%include opr_display_info;
	 
end odis_redisplay_;




		    odis_rdis_.pl1                  02/14/84  1605.8rew 01/21/84  1733.2      102753



/*   This proc is the real boss for the redisplay. The ONLY procedure which  */
/*   is allowed to call entries in this module is "odis_redisplay_". This is */
/*   because our caller must know about timers and ips masking -	       */
/*   "odis_redisplay_" is blessed with the said intelligence.	       */
/*							       */
/*   All async updating is handled by 1 timer. This timer goes off every     */
/*   odis_cds_$timer_interval. Items can be updated according to the	       */
/*   interation. We cycle from 1 to 6. For instance, time is updated every   */
/*   6 cycles,  while tape mounts are checked every cycle. At last check,    */
/*   the odis_cds_$timer_interval was 12 seconds. The entry called by	       */
/*   timer_manager_ is "timer_cycle_update".			       */
/*							       */
/*   All code in this module expects to be called with at least alrm and     */
/*   quit masked.						       */
/*							       */
/*   We call entries in "odis_rdis_update_" to execute hairy image writing   */
/*   code. We flash his updates on the screen.			       */
/*							       */
/*   The interactive message interceptor in is this module.		       */

/* Written  82-09-11 by A.G. Haggett (unca). */

odis_rdis_: proc;
	return;


     /* PARAMETERS */
	dcl   a_odis_info_ptr        pointer parameter;
	dcl   a_new_mode	         fixed bin parameter;

     /* AUTOMATIC */
	dcl   async_odi_ptr	         pointer;
	dcl   call_was_async         bit (1) init (""b);
	dcl   code	         fixed bin (35);

     /* STATIC */
	dcl   RELATIVE_SECONDS       bit (2) init ("11"b) static options (constant);

     /* ENTRIES/EXTERNAL */
	dcl   accept_messages        entry options (variable);
	dcl   ioa_$ioa_switch_nnl    entry options (variable);
	dcl   iox_$control	         entry (ptr, char (*), ptr, fixed bin (35));
	dcl   operator_display_$abort_subsystem entry (ptr, fixed bin (35), char (*));
	dcl   odis_cds_$static_odi_ptr pointer external static;
	dcl   odis_cds_$timer_interval fixed bin (71) external static;
	dcl   (odis_cds_$operator_mode, odis_cds_$dispatch_mode) fixed bin external static;
	dcl   odis_redisplay_$mini_remark entry (ptr, char (*));
	dcl   odis_rdis_$redisplay   entry (ptr);
	dcl   odis_rdis_update_$clear_image_per_mode entry (ptr);
	dcl   odis_rdis_update_$init entry (ptr);
	dcl   odis_rdis_update_$check_mounts entry (ptr, bit (1));
	dcl   odis_rdis_update_$note_mounts entry (ptr);
	dcl   odis_rdis_update_$printer_status entry (ptr);
	dcl   odis_rdis_update_$queue_info entry (ptr);
	dcl   odis_rdis_update_$sys_info entry (ptr);
	dcl   odis_rdis_$timer_cycle_update entry (ptr, char (*));
	dcl   odis_window_$check_window_status entry (ptr);
	dcl   ssu_$get_temp_segment  entry (ptr, char (*), ptr);
	dcl   ssu_$release_temp_segment entry (ptr, ptr);
	dcl   window_display_        entry (ptr, (*) char (*), fixed bin (35));
	dcl   window_$bell	         entry (ptr, fixed bin (35));
	dcl   window_$clear_to_end_of_window entry (ptr, fixed bin (35));
	dcl   window_$position_cursor entry (ptr, fixed bin, fixed bin, fixed bin (35));

	dcl   (addr, null, substr) builtin;
%page;
init: entry (a_odis_info_ptr);

	call rdis_setup ();

	call ssu_$get_temp_segment (odis_info.sci_ptr, "redisplay", odis_info.display_data_ptr);

	call odis_rdis_update_$init (odis_info_ptr);
	return;

cleanup: entry (a_odis_info_ptr);

	call rdis_setup ();
	call cancel_timer ();
	call accept_messages ("-call");
	if odis_info.display_data_ptr ^= null () then
	     call ssu_$release_temp_segment (odis_info.sci_ptr, odis_info.display_data_ptr);
	return;


shut: entry (a_odis_info_ptr);

     /* This entry is called when we are going to Multics (ie. QUIT) */
	call rdis_setup ();
	call cancel_timer ();
	call accept_messages ("-call");
	return;


redisplay: entry (a_odis_info_ptr);

	call rdis_setup ();
	if odis_info.display_off then return;

	call odis_window_$check_window_status (odis_info_ptr);

	call window_display_ (odis_info.dis_window_iocb, odis_info.display_data_ptr -> odis_display_data.window_image, code);

     /* Woe the man who deletes this positioning code. */

	call window_$position_cursor (odis_info.dis_window_iocb, 1, 1, code);

	if bad_window_code (code) & ^call_was_async then
	     goto REDISPLAY_ERROR_CRASH_SUBSYSTEM;

	return;



full_redisplay: entry (a_odis_info_ptr);

	call rdis_setup ();
	call odis_redisplay_$mini_remark (odis_info_ptr, "Updating...");
	call cancel_timer ();
	call update_image ();
	call odis_rdis_$redisplay (odis_info_ptr);
	call accept_messages ("-call", "odis_message_acceptor");
	odis_info.timer_cycle_n = 0;
	call instate_timer ();
	return;


instate_mode: entry (a_odis_info_ptr, a_new_mode);

	call rdis_setup ();
	odis_info.display_mode = a_new_mode;
	call update_per_mode_info ();
	odis_info.timer_cycle_n = 0;		     /* start cycle over. */
	call odis_rdis_$redisplay (odis_info_ptr);
	return;

rdis_setup: proc;

	odis_info_ptr = a_odis_info_ptr;
	return;
     end rdis_setup;
%page;
update_image: proc ();

	call odis_rdis_update_$sys_info (odis_info_ptr); /* ...fill  */
	call odis_rdis_update_$queue_info (odis_info_ptr); /* ... */

	call update_per_mode_info ();

	return;
     end update_image;
%page;
update_per_mode_info: proc ();

	call odis_rdis_update_$clear_image_per_mode (odis_info_ptr);

     /* The new mode has been set before we are called. */
	if odis_info.display_mode = odis_cds_$operator_mode then
	     call odis_rdis_update_$note_mounts (odis_info_ptr);
	else call odis_rdis_update_$printer_status (odis_info_ptr);

	return;

     end update_per_mode_info;
%page;
cancel_timer: proc;

	dcl   timer_manager_$reset_alarm_call entry (entry);

	call timer_manager_$reset_alarm_call (odis_rdis_$timer_cycle_update);
	return;

     end cancel_timer;




instate_timer: proc;

	dcl   timer_manager_$alarm_call_inhibit entry (fixed bin (71), bit (2), entry);

	call timer_manager_$alarm_call_inhibit (odis_cds_$timer_interval, RELATIVE_SECONDS, odis_rdis_$timer_cycle_update);
	return;

     end instate_timer;
%page;
timer_cycle_update:
     entry (mc_ptr, ips_name);

     /*  NOTE: As we all know, async calls must rtcd to their caller  */
     /*  or the sky falls in.				     	*/
     /*						     	*/
     /*  There are two things we do here, and info for deciding when  */
     /*  one or both are to be done. The first is updating of the     */
     /*  image (buffer), the second is actually slewing it to the crt */

	dcl   mc_ptr	         pointer;
	dcl   ips_name	         char (4);
	dcl   something_to_update    bit (1) init ("0"b);
	dcl   mount_notify	         bit (1);	     /* Ring bell? */

	call async_setup ();

     /* If screen updating is off return without resetting timer */
	if odis_info.display_off then return;

     /* If we are executing a request, reset timer without counting this as a cycle. */
	if odis_info.executing_request then goto TIMER_RESET_RETURN;

	odis_info.timer_cycle_n = odis_info.timer_cycle_n + 1;

     /*  This next test is not used by the current subsystem, but is  */
     /*  here if you decide to exploit it. What it allows, is someone */
     /*  to set the timer_cycle_n value to less than 1 and therefore  */
     /*  have the async updating posponed for X cycles.		*/
	if odis_info.timer_cycle_n ^> 0 then goto TIMER_RESET_RETURN;

	if odis_info.timer_cycle_n > 6 then odis_info.timer_cycle_n = 1;

	call every_1_update ();
	if odis_info.timer_cycle_n = 1 then goto REDISPLAY_RESET;
	if odis_info.timer_cycle_n = 2 then call every_2_update ();
	else if odis_info.timer_cycle_n = 3 then call every_3_update ();
	else if odis_info.timer_cycle_n = 4 then do;
	     call every_2_update ();
	     call every_4_update ();
	end;
	else if odis_info.timer_cycle_n = 5 then call every_5_update ();
	else if odis_info.timer_cycle_n = 6 then do;
	     call every_3_update ();
	     call every_6_update ();
	end;

REDISPLAY_RESET:
					     /* Slew new image to screen. */
	if something_to_update then do;
	     call odis_rdis_$redisplay (odis_info_ptr); /* update screen */
	     call iox_$control (odis_info.mini_window_iocb, "start", null (), code);
	end;

TIMER_RESET_RETURN:
	call instate_timer ();
	return;

%page;
async_setup: proc;

     /*  Kludge perhaps:  This is a critical function of the subsystem  */
     /*  as async events MUST have access to the odis_info structure.   */
     /*  The variable odis_cds_$static_odi_ptr is the ONLY per-process  */
     /*  static value maintained by the subsystem. See the module       */
     /*  operator_display_, which manages it.		       */

	odis_info_ptr = odis_cds_$static_odi_ptr;
	call_was_async = "1"b;
	return;
     end async_setup;




every_1_update: proc;

	if odis_info.display_mode = odis_cds_$dispatch_mode then return;

	call odis_rdis_update_$check_mounts (odis_info_ptr, mount_notify);
	if mount_notify then
	     call window_$bell (odis_info.dis_window_iocb, (0));
	something_to_update = "1"b;


	return;

     end every_1_update;


every_2_update: proc;

	return;

     end every_2_update;


every_3_update: proc;

	if odis_info.display_mode = odis_cds_$operator_mode then
	     call odis_rdis_update_$note_mounts (odis_info_ptr);
	else call odis_rdis_update_$printer_status (odis_info_ptr);

	something_to_update = "1"b;

	return;
     end every_3_update;


every_4_update: proc;

	return;
     end every_4_update;


every_5_update: proc;

	return;
     end every_5_update;


every_6_update: proc;

	call odis_rdis_update_$sys_info (odis_info_ptr);
	call odis_rdis_update_$queue_info (odis_info_ptr);
	something_to_update = "1"b;
	return;
     end every_6_update;

%page;
odis_message_acceptor:
     entry (a_msgno, a_msgsender, a_msgtime, a_msg);

	dcl   a_msgno	         char (*) parameter;
	dcl   a_msgsender	         char (*) parameter;
	dcl   a_msgtime	         char (*) parameter;
	dcl   a_msg	         char (*) parameter;
	dcl   just_time	         char (6);
	dcl   HAVE_MAIL_MESSAGE      char (14) init ("You have mail.") static options (constant);

	call async_setup ();

	if odis_info.mini_window_shut then return;   /* Nowhere to put it. */
	call window_$bell (odis_info.mini_window_iocb, (0));

	just_time = substr (a_msgtime, 11, 6);

	call window_$position_cursor (odis_info.mini_window_iocb, 1, 1, code);

	if a_msg = HAVE_MAIL_MESSAGE then
	     call ioa_$ioa_switch_nnl (odis_info.mini_window_iocb, "You have mail from ^a", a_msgsender);
	else
	     call ioa_$ioa_switch_nnl (odis_info.mini_window_iocb, "From ^a (^a):  ^a",
		a_msgsender, just_time, a_msg);

	call window_$clear_to_end_of_window (odis_info.mini_window_iocb, code);
	call iox_$control (odis_info.mini_window_iocb, "start", null (), code);

	return;

%page;
bad_window_code:
     proc (c) returns (bit (1));

	dcl   c		         fixed bin (35);
	dcl   video_et_$window_status_pending fixed bin (35) external static;
	dcl   1 wsi	         aligned like window_status_info;

	if c = video_et_$window_status_pending then do;
	     wsi.version = window_status_version;
	     call iox_$control (odis_info.dis_window_iocb, "get_window_status", addr (wsi), c);
	end;
	if c ^= 0 then return ("1"b);
	else return ("0"b);
     end bad_window_code;



REDISPLAY_ERROR_CRASH_SUBSYSTEM:

     /* Pseudo-check code. We may come here with an invalid code. */
	if code < 0 then code = 0;
	call operator_display_$abort_subsystem (odis_info_ptr, code, "Redisplay cannot redisplay.");

%page;
%include opr_display_info;

     end odis_rdis_;




		    odis_rdis_update_.pl1           02/14/84  1605.8rew 01/21/84  1733.2      358713



/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  */
/*							  */
/*  Site Dependent Updating of Operator Display Image.		  */
/*							  */
/*  Entries in this module actually write into the image. We do NOT do  */
/*  any I/O. 						  */
/*							  */
/*  We are called from odis_rdis_, and therefore do our work masked.    */
/*							  */
/*  This initial implementation is marginally dynamic. What we really	  */
/*  should have is some kind of site info file in >site or some such.   */
/*  The operator_display.sif would be cv_sif'ed, by an "rd" (ughh.)	  */
/*  program, into operator_display.sit. I wish...			  */
/*							  */
/*  The display....						  */
/*      The display is an array of unaligned characters the size of the */
/*      screen. It is referenced in the code as  *dd.window_image*.     */
/*							  */
/*      The display is broken down logically into three regions:	  */
/*      system info (lines 1-7), queue info (lines 8-?), and per-mode   */
/*      info (lines ?-?). The continuum of static to dynamic holds for  */
/*      the display going from top to bottom. The end of the queue info */
/*      is determined by how many request types the site info module    */
/*      specifies we are to monitor. The per-mode info for "operator"   */
/*      mode is (1) tape drive status and (2) disk/tape mount notifi-   */
/*      cations. The per-mode info for "dispatch" mode is printer	  */
/*      statuses.						  */
/*							  */
/*  Most of the image updating is performed by a call to ioa_$rsnnl to  */
/*  make the string, and a call to UPDATE to install it. Some parts of  */
/*  this module I barely understand.				  */
/*							  */
/*  Limitations:						  */
/*	o  10 tape drives for listing the status of same. This is 2   */
/*	   lines of display at 5 per.				  */
/*	o  assumes that the status returned from odis_rcp_ about tape */
/*	   drives (ie. mounted tapes or free, etc.) concerns a single */
/*	   tape subsystem. We only display a number, not a subsystem  */
/*	   name. NOTE that this does not refer to mount notifications */
/*	   for tapes and packs. These messages are per RCP.	  */
/*	o  we set the limit of 18 for the number of request types we  */
/*	   are willing to monitor. 15 is best maximum though.	  */
/*	o  although we do not have a hard-coded limitation for the    */
/*	   number of tape mount notifications, we will only list up   */
/*	   the number of lines in the display window from where the   */
/*	   drive status is to where the window ends. This will be a   */
/*	   limit of 4 or 5. It would be most unusual for more than    */
/*	   5 tape mounts to be pending I think.			  */
/*	o  this is related to the previous but concerns dispatch mode.*/
/*	   We will use 1 or 2 lines of information per printer,       */
/*	   depending on how tight the space is. Does a site run more  */
/*	   4 or 5 printers??				  */
/*							  */
/*  Thanks to "xmail" for "UPDATE" procedure.			  */
/*							  */
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  */

/*  Written 82-09-** by A.G. Haggett (unca) 'cause odis_rdis_ was becoming obese. */
/*  Modified 82-11-12 by A.G. Haggett (unca) for site data ("odst") segment and new "odis_iod_$printer_names" call. */
/*  Modified 82-12-19 by A.G. Haggett (unca) to fix bug in redisplay when we have > 5 tape drives to "note_mounts" for. */
%page;
odis_rdis_update_:
     proc;
	return;

     /* PARAMETERS */
	dcl   P_odi_ptr	         pointer parameter;
	dcl   P_notify	         bit (1);

     /* AUTOMATIC */
	dcl   buffer_79	         char (79);	     /* from ioa_$rsnnl */
	dcl   buffer_len	         fixed bin (21); /* from ioa_$rsnnl */
	dcl   code	         fixed bin (35); /* ... */
	dcl   dd_ptr	         pointer;	     /* to display_data */
	dcl   device_name_array      (15) char (8);  /* mounted on... */
	dcl   (image_width, image_height) fixed bin;
	dcl   next_down_str	         char (22);	     /* date/time string  */
	dcl   n_drives	         fixed bin;	     /* "note_mounts" entry */
	dcl   volume_name_array  (15) char (32);     /* for "note_mounts" entry */
	dcl   next_shift_str         char (5);	     /* just time string */
	dcl   1 si	         aligned,	     /* These are parameters to odis_system_info_ */
	        2 installation_id    char (32) unal, /* odis_system_info_$init */
	        2 sysid	         char (8) unal,  /* ...$init */
	        2 time_up	         fixed bin (71), /* ...$init */
	        2 current_shift      fixed bin,	     /* ...$shift_info */
	        2 next_shift         fixed bin,	     /* ...$shift_info */
	        2 next_shift_time    fixed bin (71), /* ...$shift_info */
	        2 next_down_time     fixed bin (71), /* ...$next_down_time */
	        2 n_units	         float bin,	     /* ...$users */
	        2 max_units	         float bin,	     /* ...$users */
	        2 n_users	         fixed bin,	     /* ...$users */
	        2 max_users	         fixed bin,	     /* ...$users */
	        2 tty,			     /* about tty processes */
		3 n_procs	         fixed bin,	     /* ...$n_tty_abs_daemon */
	        2 abs,			     /* about abs processes */
		3 n_procs	         fixed bin,	     /* ...$n_tty_abs_daemon */
		3 max_procs        fixed bin,	     /* ...$n_tty_abs_daemon */
		3 n_foreground     fixed bin,	     /* ...$n_tty_abs_daemon */
		3 q_tt	         (6) fixed bin,  /* odis_queue_$absentee_counts */
	        2 daemon,			     /* about daemon processes */
		3 n_procs	         fixed bin,	     /* ...$n_tty_abs_daemon */
		3 n_non_IO_daemons fixed bin,	     /* ...$daemon_names */
		3 non_IO_daemons   (16) char (4) unal;  /* ...$daemon_names */

     /* BASED */
	dcl   1 dd	         aligned like odis_display_data based (dd_ptr);

     /* CONSTANT */

     /*  The following are control strings used to make lines and partial lines   */
     /*  to be displayed. Apologies for these cryptic CS's but they do the job.   */
	dcl   SYS_INFO_LINE_1_CS     char (29) varying static options (constant)
			         init ("^a,^30t^a^43tUp Since:^56t^a");
	dcl   SYS_INFO_LINE_2_CS     char (60) varying static options (constant)
			         init ("Shift: ^d,^13tNext Shift: ^d^28tat ^a^43tNext Down:^56t^a");
	dcl   SYS_INFO_LINE_3_CS     char (64) varying static options (constant)
			         init ("Users: ^d /^d^19tLoad: ^.1f/^.1f^43tCurr Time:^56t^a");
	dcl   SYS_INFO_LINE_5_CS     char (86) varying static options (constant)
			         init ("^2xProcess Types:^23ttty= ^d,   abs= ^d of ^d^[ (^d foreground)^;^s^],   daemons= ^d");
	dcl   SYS_INFO_LINE_6_CS     char (36) varying static options (constant)
			         init ("^2xDaemons (non-IO):^23t^v(^a,^)^a");
	dcl   SYS_INFO_LINE_7_CS     char (76) varying static options (constant)
			         init ("^2xAbsentee Queues:^23tfg= ^d,  q0= ^d,  q1= ^d,  q2= ^d,  q3= ^d,  q4= ^d");
	dcl   DEVICE_AND_VOLUME_CS   char (9) init (" ^2a- ^9a") static options (constant);
	dcl   MOUNTED_SENTINEL       char (10) init ("Mounts:   ") static options (constant);
	dcl   N_DRIVES_WE_CAN_LIST   fixed bin init (10) static options (constant);
	dcl   PENDING_MOUNT_LINE     char (89) varying static options (constant)
			         init ("Mount ^[Reel^;Pack^]  ^[scratch^s^;^a^]  on ^a (^[no^;with^] ^[ring^;protect^]) for ^a");
	dcl   QUEUE_INFO_CS	         char (26) varying static options (constant)
			         init ("^[^s^;^vx^]^12a ^4( ^2d^)");
	dcl   QUEUE_INFO_LENGTH      fixed bin init (27) static options (constant);
	dcl   PRT_STATUS_BF_CS       char (26) varying static options (constant)
			         init ("^4a:  Printing ^a  for  ^a");
	dcl   PRT_STATUS_L1_CS       char (24) varying static options (constant)
	      		         init ("^4a:  ^a^37tPrinting: ^a");
	dcl   PRT_STATUS_L2_CS       char (44) varying static options (constant)
	      		         init ("^7xProcessing q. ^d  of  request type ""^a""");
	dcl   PRT_STATUS_MSG         char (8) varying static options (constant)
			         init ("^a:  ^a");

	dcl   WHERE_QUEUE_INFO_STARTS fixed bin init (9) static options (constant);
	dcl   DOTS	         char (32) init (" " || (31)".") static options (constant);
	dcl   SPACE	         char (1) init ("") static options (constant);
					     /* STATIC */
	dcl   STRING	         static entry variable options (variable); /*  ioa_$rsnnl */

     /* ENTRIES/EXTERNAL */
	dcl   convert_status_code_   entry (fixed bin (35), char (8) aligned, char (100) aligned);
	dcl   cv_entry_	         entry (char (*), ptr, fixed bin (35)) returns (entry);
	dcl   ioa_$rsnnl	         entry options (variable);
	dcl   odis_iod_$driver_status entry (char (*), char (*), char (*), char (*), char (*), char (*), fixed bin, char (*));
	dcl   odis_iod_$printer_names entry ((*) char (*), (*) char (*), fixed bin);
	dcl   odis_rcp_$note_tape_mounts entry (ptr, (*) char (*), (*) char (*), fixed bin, fixed bin (35));
	dcl   odis_rcp_$check_mounts entry (ptr, ptr, fixed bin, fixed bin (35));
	dcl   odis_system_info_$init entry (char (*), char (*), fixed bin (71), fixed bin (35));
	dcl   odis_system_info_$next_down_time entry () returns (fixed bin (71));
	dcl   odis_system_info_$shift_info entry (fixed bin, fixed bin, fixed bin (71));
	dcl   odis_system_info_$users entry (fixed bin, fixed bin, float bin, float bin);
	dcl   odis_system_info_$n_tty_abs_daemon entry (fixed bin, fixed bin, fixed bin, fixed bin, fixed bin);
	dcl   odis_system_info_$daemon_names entry ((*) char (*), fixed bin);
	dcl   odis_queue_$absentee_counts entry ((6) fixed bin);
	dcl   odis_queue_$get_queue_counts entry (char (*), char (*), (4) fixed bin);
	dcl   operator_display_$abort_subsystem entry (ptr, fixed bin (35), char (*));

	dcl   (addr, substr, ltrim, rtrim, index, length, min, mod, codeptr,
	         unspec, maxlength, divide, clock, char) builtin;
%page;
init: entry (P_odi_ptr);

     /* Initialization and setting of per-invocation data in "dd". */
	call update_setup ();
	dd.window_image = SPACE;		     /* clear slate */

	STRING = ioa_$rsnnl;		     /* the string maker. */

     /* Now get per-invocation data line. */
	call odis_system_info_$init (si.installation_id, si.sysid, si.time_up, code);

     /* If we could not get at the info in the 'whotab' then crash. */
	if code ^= 0 then			     /* Will not return */
	     call operator_display_$abort_subsystem (odis_info_ptr, code, "Cannot get 'system_info_' from 'whotab'.");

     /* Note that we do not use "si.installation_id". We may at some time. */
	call STRING (SYS_INFO_LINE_1_CS, buffer_79, buffer_len, /* LINE 1 */
	     odst.site_id, si.sysid, formatted_date (si.time_up));

     /* This line does not change during an invocation. */
	call UPDATE (1, 1, image_width, buffer_79);

	dd.saved_pending_mount_vols (*) = SPACE;     /* see "check_mounts" */
	dd.saved_pending_mount_devs (*) = SPACE;     /*  ...  */
	dd.saved_pending_mount_count = 0;	     /*  ...  */

     /* "odis_rdis_update_$queue_info" has an optimization hook. See the */
     /* code of that entry for its use. We MUST initialize it here.      */

	unspec (dd.saved_queue_data.counts) = ""b;
	unspec (dd.saved_queue_data.skip_update) = ""b;

     /*  These variables are set properly by the "queue_info" entry of  */
     /*  this module. We set them here just because I do not like un-   */
     /*  initialized data to hang around for the "queue_info" call.     */
	dd.first_per_mode_line, dd.mounted_tapes_line = 14; /* a guess. */

	return;

%page;
clear_image_per_mode:
     entry (P_odi_ptr);

	dcl   clearing_row	         fixed bin;	     /* loop var. */

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							 *
 *   This entry is used when a full redisplay or mode switch is 	 *
 *   performed. You can see why we need it - for instance after	 *
 *   a Multics command has been executed (ie. 10 minutes of emacs)	 *
 *   the last thing we want to do when we start up again, is 	 *
 *   display mount info from 10 minutes past. We clear the image	 *
 *   from the start to the per mode (operator/dispatch) information	 *
 *   to the end of the window image.				 *
 *							 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	call update_setup ();

	do clearing_row = dd.first_per_mode_line to image_height;
	     dd.window_image (clearing_row) = SPACE;
	end;

	dd.saved_pending_mount_count = 0;	     /* don't trust it. */

	return;

%page;
sys_info:
     entry (P_odi_ptr);

	call update_setup ();

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							       *
 *   This entry update lines 2, 3, 5, 6, and 7. The data needed for these    *
 *   lines is obtained from calls to odis_system_info_ in "si.XX".	       *
 *							       *
 *   The standard "system_info_" should allow one to get at much more info.  *
 *							       *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */


     /* Line 2 contains the current shift, next shift, shift change time, and the next down time. */
	call odis_system_info_$shift_info (si.current_shift, si.next_shift, si.next_shift_time);
	si.next_down_time = odis_system_info_$next_down_time ();

	next_shift_str = formatted_time (si.next_shift_time);
	if si.next_down_time = 0 then next_down_str = "< none >";
	else next_down_str = formatted_date (si.next_down_time);
	call STRING (SYS_INFO_LINE_2_CS, buffer_79, buffer_len,
	     si.current_shift,		     /*  ...  */
	     si.next_shift,			     /*  no.  */
	     next_shift_str,		     /* time  */
	     next_down_str);		     /* date-time */

	call UPDATE (2, 1, image_width, buffer_79);  /* install in image */

     /* Line 3 contains the user count, the load, and the current time. */
	call odis_system_info_$users (si.n_users, si.max_users, si.n_units, si.max_units);

	call STRING (SYS_INFO_LINE_3_CS, buffer_79, buffer_len,
	     si.n_users,
	     si.max_users,
	     si.n_units,
	     si.max_units,
	     formatted_date (clock ()));

	call UPDATE (3, 1, image_width, buffer_79);  /* install ... */

     /* Line 4 is a blank line. */

     /* Line 5 contains a user count breakdown. */
	call odis_system_info_$n_tty_abs_daemon
	     (si.tty.n_procs, si.abs.n_procs, si.abs.max_procs, si.abs.n_foreground, si.daemon.n_procs);

	call STRING (SYS_INFO_LINE_5_CS, buffer_79, buffer_len,
	     si.tty.n_procs,
	     si.abs.n_procs,
	     si.abs.max_procs,
	     (si.abs.n_foreground ^= 0), si.abs.n_foreground,
	     si.daemon.n_procs);

	call UPDATE (5, 1, image_width, buffer_79);

     /* Line 6 contains daemon information - a string of non IO daemon names. */
	call odis_system_info_$daemon_names (si.daemon.non_IO_daemons (*), si.daemon.n_non_IO_daemons);

	if si.daemon.n_non_IO_daemons = 0 then do;
	     si.daemon.n_non_IO_daemons = 1;
	     si.daemon.non_IO_daemons (1) = "NONE";
	end;

	call STRING (SYS_INFO_LINE_6_CS, buffer_79, buffer_len,
	     (si.daemon.n_non_IO_daemons - 1),
	     si.daemon.non_IO_daemons);

	call UPDATE (6, 1, image_width, buffer_79);

     /* Line 7 contains absentee queue counts. */
	call odis_queue_$absentee_counts (si.abs.q_tt (*));

	call STRING (SYS_INFO_LINE_7_CS, buffer_79, buffer_len,
	     si.abs.q_tt (*));

	call UPDATE (7, 1, image_width, buffer_79);
	return;
%page;
check_mounts:
     entry (P_odi_ptr, P_notify);

	call update_setup ();

     /*  For tape mounts, we keep a per-invocation array of pending   */
     /*  volume names (to be mounted). We check this against our new  */
     /*  RCP data on pending mounts to tell if notification/update is */
     /*  needed. Note that we update for both disk and tape mounts.   */

	begin;
	     dcl	 1 opmd		    (ODIS_PENDING_MOUNT_LIMIT) aligned like odis_pending_mount_data automatic;
	     dcl	 (i, j)		    fixed bin; /* to loop through pending info. */
					     /* This bit says: "No new data, but image is wrong." */
	     dcl	 image_reshuffle	    bit (1);
	     dcl	 (n_lines_to_work_with,	     /* for mount notices. */
		 n_pending_mounts,		     /* as it says. */
		 n_to_list,		     /* of above, how many can we list? */
		 starting_line,		     /* where we can slew. */
		 current_line)	    fixed bin; /* next line to write */


	     P_notify, image_reshuffle = "0"b;	     /* for now anyway. */

	     call odis_rcp_$check_mounts (odis_info_ptr, addr (opmd), n_pending_mounts, code);

	     if code ^= 0 then do;
		dd.saved_pending_mount_count = 0;  /* clear slate. */
		call install_error_msg (code, "Cannot check mounts.");
		goto RETURN_FROM_CHECK_MOUNTS;
	     end;

	/* Mount notifications always begin at the line 2 after the  */
	/* the first line we are listing the mounted tapes on. */

	/* Where we can start out image updating. */
	     starting_line = dd.mounted_tapes_line + 2;

	/* How many can we write? */
	     n_lines_to_work_with = image_height - starting_line + 1;

	/* Are we forced to bit bucket the info. Should not happen. */
	     if n_lines_to_work_with <= 0 then goto RETURN_FROM_CHECK_MOUNTS;

	/* Where are we now? */
	     current_line = starting_line;

	     n_to_list = min (n_lines_to_work_with, n_pending_mounts);
	     if n_to_list = 0 then goto BLANK_OUT_OLD_MOUNTS;

	/*  That the data we were returned by odis_rcp_ is not the  */
	/*  same as it was last time.  It may be exactly the same,  */
	/*  some new info, or some pending mounts may have been     */
	/*  taken care of. We only set "P_notify" (ring bell) if    */
	/*  there is new information.			     */

	/* Outer loop is looping on new data. */
	     do i = 1 to n_to_list while (^P_notify);

		/* Inner loop loops on new saved data. */
		do j = 1 to dd.saved_pending_mount_count
		     while ((opmd.volume_name (i) ^= dd.saved_pending_mount_vols (j))
		     & (opmd.device_name (i) ^= dd.saved_pending_mount_devs (j)));
		end;
					     /* Did this new one have a match? If not, then new data. */
		if j > dd.saved_pending_mount_count then P_notify = "1"b;
		else if j ^= i then image_reshuffle = "1"b;
		else current_line = current_line + i; /* This line is OK. */
	     end;

	/* If P_notify the just fall though to image update loop. If */
	/* not, then decide if the current image is up to date. It   */
	/* will be out of date if old pending mounts were taken care */
	/* of. If old ones were taken care of, then image will need  */
	/* to be redisplayed (reshuffled).			      */

	/* NEEDS REPAINTING? Set where we update line 1. */
	     if P_notify | image_reshuffle then	     /* Yes, repaint. */
		current_line = starting_line;	     /* reset for update. */
					     /* NO CHANGE OR STRIP OLD NEWS  ( TRAILING LINES. ) */
	     else goto BLANK_OUT_OLD_MOUNTS;


	     do i = 1 to n_to_list;		     /* image update loop. */

	     /* Save names for old news check above. */
		dd.saved_pending_mount_vols (i) = opmd.volume_name (i);
		dd.saved_pending_mount_devs (i) = opmd.device_name (i);
		call STRING (PENDING_MOUNT_LINE, buffer_79, buffer_len,
		     opmd.tape_sw (i),	     /* Reel or Pack? */
		     (opmd.volume_name (i) = ""),  /* print 'scratch' */
		     opmd.volume_name (i),	     /* what...  */
		     opmd.device_name (i),	     /* ...where */
		     opmd.protect_sw (i),	     /* 'with' or 'no' */
		     opmd.tape_sw (i),	     /* 'ring' or 'protect' */
		     opmd.for_who (i));	     /* group id. */

		call UPDATE (current_line, 1, image_width, buffer_79);
		current_line = current_line + 1;   /* next write line. */
	     end;


BLANK_OUT_OLD_MOUNTS:
					     /* If we listed less than last time, clear old information. */
	     if n_to_list < dd.saved_pending_mount_count /* don't leave old news in the image. */
	     then do current_line = current_line to image_height;
		     dd.window_image (current_line) = SPACE;
		end;

	     dd.saved_pending_mount_count = n_to_list; /* save valuable info */

	end;				     /* begin block. */


RETURN_FROM_CHECK_MOUNTS:			     /* begin block backout */
	return;

%page;
note_mounts:
     entry (P_odi_ptr);

	call update_setup ();

	/*  The entry "odis_rcp_$note_mounts" returns the status of, or  */
	/* the volume mounted on, each tape drive (up to the "hbound" of */
	/* the arrays we pass. The volume names returned are displayed   */
	/* as "^9a" strings. We do not list the subsystem name for tape  */
	/* drives. We take the last 2 characters (ie. "tapa_01" := "01").*/

	call odis_rcp_$note_tape_mounts (odis_info_ptr, volume_name_array, device_name_array, n_drives, code);
	if code ^= 0 then do;		     /* error */
	     call install_error_msg (code, "Cannot check mounts.");
	     return;
	end;

	if n_drives = 0 then do;		     /* !!No Drives!! */
	     call install_error_msg (0, "No tape drive devices found in ""rcp_data"".");
	     return;
	end;

	call UPDATE (dd.mounted_tapes_line, 1, length (MOUNTED_SENTINEL), MOUNTED_SENTINEL);

	begin;

	     /* We will list up to 10 drives and their status/volumes. */

	     dcl	 device_and_volume	    char (14); /* from ioa_ */
	     dcl   device_number	    char (2);  /* ie. "01" */
	     dcl	 column		    fixed bin;
	     dcl	 line		    fixed bin init (dd.mounted_tapes_line);
	     dcl	 i		    fixed bin;
	     dcl   max_to_put_on_first_line fixed bin;
	     dcl   already_on_second_line bit (1) init (""b);

	     column = length (MOUNTED_SENTINEL);     /* start after "Mounts: " word. */

	  /* How many can we list? */
	     n_drives = min (N_DRIVES_WE_CAN_LIST, n_drives);

	  /* Figure out how many drives to put on first line if we have   */
	  /* more than 5. If n_drives is odd, put more on the first line. */
	     if n_drives > 5 then do;
		max_to_put_on_first_line = n_drives / 2;
		if (max_to_put_on_first_line * 2) ^= n_drives then max_to_put_on_first_line = max_to_put_on_first_line + 1;
	     end;
	     else max_to_put_on_first_line = n_drives;	/* Can all fit on one line. */

	     do i = 1 to n_drives;

		/* We can only take a max of 5 per line, and 2 lines at that. */
		if (i > max_to_put_on_first_line & ^already_on_second_line) then do;
		     already_on_second_line = "1"b;
		     line = line + 1;
		     column = length (MOUNTED_SENTINEL);
		end;

		/* Strip the drive number from the device name. */
		device_number = substr (device_name_array (i), 6, 2);

		call STRING (DEVICE_AND_VOLUME_CS, device_and_volume, (0),
		     device_number,		     /* drive number */
		     volume_name_array (i));	     /* the volume on it. */

		call UPDATE (line, column, length (device_and_volume), device_and_volume);
		column = column + length (device_and_volume); /* next column */
	     end;
	end;				     /* begin block */

	return;
%page;
printer_status:
     entry (P_odi_ptr);

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							 *
 *   This entry is called when we are in "dispatch" mode. We get the	 *
 *   major/minor device names of central (IOM PRPH) printers and	 *
 *   display status of same from their driver_status segments.	 *
 *							 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	call update_setup ();

	/* Arrays for major and minor names of printers. */
	dcl prt_major_array	(8) char (32);	     /* The display can only handle 4 chars. */
	dcl prt_minor_array (8) char (32);
	dcl n_printers	    fixed bin;


	call odis_iod_$printer_names (prt_major_array, prt_minor_array, n_printers);

	if n_printers = 0 then do;
	     call install_error_msg (0, "  ** No printer status information available.");
	     return;
	end;


	/*  We have some printers to print status information about. We  */
	/*  do not know how many lines we have to work with. This value  */
	/*  is "image_height - dd.first_per_mode_line + 1". Printer info */
	/*  can be displayed as 1 or 2 lines of text, corresponding to   */
	/*  "PRT_STATUS_BF_CS" or ("PRT_STATUS_L1_CS" and		     */
	/*  "PRT_STATUS_L2_CS") respectively. The rules are:	     */
	/*						     */
	/*   1. If the number of printers is >= to the number of lines   */
	/*      we have to work with, then use all 1 line info's.	     */
	/*   2. If the number of printers <= (n_lines_to_work_with/2)    */
	/*      then use all 2 line info's.			     */
	/*   3. If n_lines_to_work_with is an odd number, then if we are */
	/*      printing 2 line infos, then leave leave an initial 	     */
	/*      blank line.					     */
	/*   4. If the number of printers is > (n_lines_to_work_with/2)  */
	/*      then leave a blank line and use 1 line format.	     */
	/*						     */
	/*    There is an alternative to 4, which is to display some in  */
	/*   long format and some in short format, but this would lead   */
	/*   to a confusing display.				     */

	begin;

	   dcl i fixed bin;
	   dcl 1 ds,			     /* driver status info */
	         2 busy_id		char (32),     /* group id. */
	         2 dir		char (168),    /* dir of print seg. */
	         2 entry		char (32),     /* segment name. */
	         2 rqt		char (27),     /* request type. */
	         2 queue		fixed bin,     /* processing this one */
	         2 status		char (60);     /* If "", then all is well. */


	   dcl (current_line,		     /* do not drop off. */
	        n_2_lines_to_work_with,	     /* n 2 line groups. */
	        n_lines_to_work_with) fixed bin;     /* as per above.  */

	   dcl two_line_format	bit (1);	     /* 1 or 2 line output */


	   current_line = dd.first_per_mode_line;    /* for now */
	   n_lines_to_work_with = image_height - current_line + 1;
	   n_2_lines_to_work_with = divide (n_lines_to_work_with, 2, 17, 0);

	/* The following should not happen, but we will check anyway. */
	   if n_lines_to_work_with ^> 0 then goto PRINTER_STATUS_RETURNS;

	/* Decide whether we are using 1 or 2 line format. */
	   if n_printers >= n_lines_to_work_with then
	        two_line_format = "0"b;
	   else if n_printers <= n_2_lines_to_work_with then do;
	        two_line_format = "1"b;
	        if (n_2_lines_to_work_with * 2) ^= n_lines_to_work_with  /* odd no? */
	        	   | n_printers < n_2_lines_to_work_with then	     /* excess room? */
		   current_line = current_line + 1;
	   end;
	   else do;			     /* excess room but... */
	        two_line_format = "0"b;	     /* 1 line format...   */
	        current_line = current_line + 1;     /* with a blank line. */
	   end;

	/* If we boosted 'current_line' above then we blank out line(s). */
	   do i = dd.first_per_mode_line to (current_line - 1);
	        dd.window_image (i) = SPACE;
	   end;


	/* We have decided format, so update image. */
	   do i = 1 to n_printers;		     /* loop through printers */

	        /* "current_line" always points to next available line. */
	        if current_line > image_height then goto PRINTER_STATUS_RETURNS;
	        call odis_iod_$driver_status
		   (prt_major_array (i),	     /* Major device name */
		    prt_minor_array (i),	     /* Minor device name */
		    ds.busy_id,		     /* Pers.Proj.t */
		    ds.dir,		     /* dir of entry */
		    ds.entry,		     /* entry printing now */
		    ds.rqt,		     /* rqt processing */
		    ds.queue,		     /* queue processing */
		    ds.status);		     /* "" is all is well */

	        /* If ds.status ^= "" then we have no further info. */
	        if ds.status ^= "" then do;
		   call STRING (PRT_STATUS_MSG, buffer_79, buffer_len, 
		        prt_major_array (i), ds.status);
		   call UPDATE (current_line, 1, image_width, buffer_79);
		   current_line = current_line + 1;

		   if two_line_format then do;     /* leave blank line. */
		        dd.window_image (current_line) = SPACE;
		        current_line = current_line +1;
		   end;
	        end;

	        /* No status message so print information. */
	        else if two_line_format then do;
		   call STRING (PRT_STATUS_L1_CS, buffer_79, buffer_len,
		        prt_major_array (i),
		        ds.busy_id, ds.entry);
		   call UPDATE (current_line, 1, image_width, buffer_79);
		   current_line = current_line + 1;
		   call STRING (PRT_STATUS_L2_CS, buffer_79, buffer_len,
		        ds.queue, ds.rqt);
		   call UPDATE (current_line, 1, image_width, buffer_79);
		   current_line = current_line + 1;
	        end;

	        /* 1 line format. */
	        else do;
		   call STRING (PRT_STATUS_BF_CS, buffer_79, buffer_len,
		        prt_major_array (i), ds.entry, ds.busy_id);
		   call UPDATE (current_line, 1, image_width, buffer_79);
		   current_line = current_line + 1;
	        end;
	   end;				     /* loop through printers */
	/* If we did not use all lines, blank out trailing ones. */
	if current_line ^> image_height then
	   do i = current_line to image_height;
	        dd.window_image (i) = SPACE;
	   end;

	end;				     /* begin block */

PRINTER_STATUS_RETURNS:

	return;

%page;
queue_info:
     entry (P_odi_ptr);

     /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/
     /*							       */
     /* This is the entry which fills in the queue counts lines. There are   */
     /* a maximum of 3 request types per line. Eg:		       */
     /*							       */
     /* rqt_name  00 00 00 00  rqt_name  00 00 00 00  rqt_name  00 00 00 00  */
     /*							       */
     /*  ONE IMPORTANT THING TO NOTE ABOUT THIS ENTRY is the method employed */
     /*  to try and save some vcpu checking all those message segments. The  */
     /*  array "odis_display_data.saved_queue_data" has two level 3 entries  */
     /*  which enable us to skip a request type which had the same queue     */
     /*  counts twice in a row. If we get the queue counts and they are the  */
     /*  same as the last time we came by here, we set the level 3 entry     */
     /*  "skip_update" to -N, where N is the number of updates to skip. This */
     /*  may result in the screen being out of date, but not often I hope.   */
     /*  The array "based_q_array" is an array of 4 fixed bin (17) elements. */
     /*  This is based on "addr (dd.saved_queue_data.counts)", which is      */
     /*  declared as a fixed bin (71) quantity. We never look at it as this. */
     /*							       */
     /*  We use the information in the "odst" segment about display rqt's.   */
     /*  A special entry may have been specified to get the queue counts     */
     /*  and/or a display name may have been specified.		       */
     /*							       *
     /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/

	dcl   qi_current_line        fixed bin;	     /* Where we are updating. */
	dcl   qi_current_col         fixed bin;
	dcl   (rqti, q)	         fixed bin;
	dcl   q_array	         (4) fixed bin;
	dcl   rqt_name	         char (12);
	dcl   rqt_name_len	         fixed bin;
	dcl   first_col_spacing_delta fixed bin;     /* for diff. spacing */
	dcl   space_index	         fixed bin;	     /* for "..." append */
	dcl   skip_update	         bit (1);
	dcl   based_q_array         (4) fixed bin (17) unaligned based (based_q_array_ptr);
	dcl   based_q_array_ptr	pointer;
	dcl   get_queue_counts_entry  entry variable entry (char (*), char (*), (4) fixed bin);

	call update_setup ();

	qi_current_line = WHERE_QUEUE_INFO_STARTS;
	qi_current_col = 1;
	rqt_name_len = maxlength (rqt_name);

	do rqti = 1 to odst.tot_dis_rqts;

	     based_q_array_ptr = addr (dd.saved_queue_data.counts (rqti));

	     /* Check queue update CPU saver. */
	     if dd.saved_queue_data.skip_update (rqti) < 0 then do;
		dd.saved_queue_data.skip_update (rqti) = dd.saved_queue_data.skip_update (rqti) + 1;

		/* Use the saved info from the last call. */
		q_array (*) = based_q_array (*);
		goto SKIP_QUEUE_COUNT_CALL;	     /* save dat vcpu */
	     end;

	     /* Do we have to call a special entry to get queue counts? */
	     if odst.dis_rqt.entry (rqti) ^= "" then do;	/* YES */
		get_queue_counts_entry = cv_entry_ (odst.dis_rqt.entry (rqti), codeptr (odis_rdis_update_), code);
		if code ^= 0 then call operator_display_$abort_subsystem (odis_info_ptr, code,
		     "Cannot convert " || rtrim (odst.dis_rqt.entry (rqti)) || " for queue counts.");
		call get_queue_counts_entry (odst.dis_rqt.dir (rqti), odst.dis_rqt.request_name (rqti), q_array);
	     end;
	     else call odis_queue_$get_queue_counts
		     (odst.dis_rqt.dir (rqti), odst.dis_rqt.request_name (rqti), q_array);

	     skip_update = "1"b;		     /* assume for now */
	     do q = 1 to 4;
		if q_array (q) ^= based_q_array (q) then skip_update = "0"b;
	     end;

	/*  If we are to skip updates, then set skip_update to "N", where "abs (N)" is number of updates to skip. */
	     if skip_update then dd.saved_queue_data.skip_update (rqti) = -1;
	     else do q = 1 to 4;		     /* save for next time */
		based_q_array (q) = q_array (q);   /* ...we check queues */
	     end;

SKIP_QUEUE_COUNT_CALL:
	/*  Now install in display. The value of qi_current_col is  */
	/*  where to write string to image.		     */

	/*  The display cannot handle 3 digit counts, so 99 is the highest count we will display. Enforce it...  */
	     do q = 1 to 4;
		if q_array (q) > 99 then q_array (q) = 99;
	     end;

	/* What name to use. */
	     if odst.dis_rqt.display_name (rqti) = "" then
		rqt_name = odst.dis_rqt.request_name (rqti);
	     else rqt_name = odst.dis_rqt.display_name (rqti);

	/* Append trailing dots to display name if there is room. */
	     space_index = index (rqt_name, SPACE);

	/* If there is space, insist on at least 2 of them. */
	     if space_index > 0 & (rqt_name_len - space_index) > 1 then
		rqt_name = rtrim (rqt_name)
		     || substr (DOTS, 1, (rqt_name_len - space_index + 1));

	/* Do we have to move to a new line. Was our last write in the last column (3)?  */
	     if divide (qi_current_col, QUEUE_INFO_LENGTH, 17, 0) = 3 then do;
		qi_current_col = 1;		     /* reset column */
		qi_current_line = qi_current_line + 1; /* get new line. */
		dd.window_image (qi_current_line) = SPACE;
	     end;

	     if qi_current_col = 1 then first_col_spacing_delta = 2;
	     else first_col_spacing_delta = 0;

	/* Make the string. */
	     call STRING (QUEUE_INFO_CS, buffer_79, buffer_len,
		(qi_current_col = 1),	     /* different spacing? */
		first_col_spacing_delta,
		rqt_name,			     /* the request_type */
		q_array);			     /* the counts */

	/* Install in image. */
	     call UPDATE (qi_current_line, qi_current_col, (QUEUE_INFO_LENGTH - first_col_spacing_delta), buffer_79);


	/* Update column for next write. */
	     qi_current_col = qi_current_col + QUEUE_INFO_LENGTH;
	end;				     /* do rqti */

     /* These next two 'dd' values are:			  */
     /*  mounted_tapes_line:  the line to paint the currently	  */
     /*	mounted tape info on. This is only used when in	  */
     /*	operator mode.				  */
     /*  first_per_mode_line: the first line of per-mode info.. If */
     /* 	the mode changes, we have to know where to start    */
     /*	removing the old mode information. Per-mode info.   */
     /*	is from this line to the last line in the display   */
     /*	window.					  */


	dd.mounted_tapes_line = qi_current_line + 2;
	dd.first_per_mode_line = qi_current_line + 1;
	return;

%page;
update_setup: proc ();

	odis_info_ptr = P_odi_ptr;		     /* odis_info structure */
	/* "dd" structure looks at the "odis_display_data". */
	dd_ptr = odis_info.display_data_ptr;

	/* "opr_display_site_table" from >sc1 segment. */
	odst_ptr = odis_info.site_table_ptr;

	/* Shorthand means of referencing window extents. */
	image_width = odis_info.dis_window_info.width;
	image_height = odis_info.dis_window_info.height;
	return;

     end update_setup;

%page;
install_error_msg: proc (a_code, a_msg);

	/* This proc writes an error msg to the image. It is called by  */
	/* the note_mounts, check_mounts, and printer_status entries.   */
	/* If code is non-zero we convert and write it. We also clear   */
	/* any old per-mode information.			    */

	dcl   a_code	         fixed bin (35) parameter;
	dcl   a_msg	         char (*) parameter;

	dcl   i		         fixed bin;
	dcl   error_long	         char (100) aligned init ("");
	dcl   error_short	         char (8) aligned init ("");

	if a_code ^= 0 then
	     call convert_status_code_ (a_code, error_short, error_long);

      /* Blank first per-mode line. */
	dd.window_image (dd.first_per_mode_line) = SPACE;

      /* Write message in second per-mode line. */
	call UPDATE ((dd.first_per_mode_line + 1), 1, image_width,
	     a_msg || SPACE || rtrim (error_long));

      /* Now clear to end of display window. */
	do i = (dd.first_per_mode_line + 2) to image_height;
	     dd.window_image (i) = SPACE;
	end;

	return;

end install_error_msg;

%page;
UPDATE: proc (line, col, len, new_value);

	dcl   (line, col, len)       fixed bin,
	      new_value	         char (*);
	dcl   short_new_value        defined (new_value) char (len),
	      trunc_new_value        defined (new_value)
			         char (len - length (TRUNCATION_STRING));
	dcl   TRUNCATION_STRING      init (" ...") char (4) static options (constant);
	dcl   (length, rtrim)        builtin;

	if len >= length (new_value)
	then call RAW_UPDATE (line, col, len, new_value);
	else if len <= length (TRUNCATION_STRING) | len >= length (rtrim (new_value))
	then call RAW_UPDATE (line, col, len, short_new_value);
	else do;
	     call RAW_UPDATE (line, col,
		length (trunc_new_value), trunc_new_value);
	     call RAW_UPDATE (line,
		col + length (trunc_new_value),
		length (TRUNCATION_STRING), TRUNCATION_STRING);
	end;

     end UPDATE;




RAW_UPDATE: proc (line, col, len, new_value);

	dcl   (line, col, len)       fixed bin,
	      new_value	         char (*);

	dcl   field_p	         ptr,
	      field_l	         fixed bin,
	      field	         char (field_l) based (field_p);


	dcl   (addr, char, substr)   builtin;

	if line > image_height then return;	     /* nowhere to put it. */
	field_p = addr (substr (dd.window_image (line), col));
	field_l = len;
	if char (new_value, len) ^= field
	then field = new_value;

     end RAW_UPDATE;
%page;
formatted_date: proc (a_time) returns (char (22));

     /* Return "ddd, yy-mm-dd -- hh:mm" */

	dcl   a_time	         fixed bin (71);

	dcl   code	         fixed bin (35);
	dcl   (cyear, cmonth, cday, chour, cmin) char (2);
	dcl   (nyear, nmonth, nday, ndow, nhour, nmin) fixed bin;
	dcl   cdow	         (7) char (3) static options (constant)
			         init ("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun");

	dcl   decode_clock_value_$date_time entry (fixed bin (71), fixed bin, fixed bin, fixed bin, fixed bin,
			         fixed bin, fixed bin, fixed bin (71), fixed bin, char (3), fixed bin (35));
	dcl   time_data_$time_zone   char (3) aligned external;

	call decode_clock_value_$date_time (a_time, nmonth, nday, nyear, nhour, nmin, (0), (0), ndow, (time_data_$time_zone), code);

	if code ^= 0 then return ("<cannot get date>");

	if nhour < 10
	then chour = "0" || ltrim (char (nhour));
	else chour = ltrim (char (nhour));

	if nmin < 10
	then cmin = "0" || ltrim (char (nmin));
	else cmin = ltrim (char (nmin));

	if nmonth < 10
	then cmonth = "0" || ltrim (char (nmonth));
	else cmonth = ltrim (char (nmonth));

	if nday < 10
	then cday = "0" || ltrim (char (nday));
	else cday = ltrim (char (nday));

	nyear = mod (nyear, 100);
	if nyear = 0
	then cyear = "00";
	else if nyear < 10
	then cyear = "0" || ltrim (char (nyear));
	else cyear = ltrim (char (nyear));

	return (cdow (ndow) || ", " || cyear || "-" || cmonth || "-" || cday
	     || " -- " || chour || ":" || cmin);

     end formatted_date;

%page;
formatted_time:
     proc (a_time) returns (char (5));

     /* Return "hh:mm" */

	dcl   a_time	         fixed bin (71);
	dcl   date_time	         char (14);
	dcl   1 time	         based (addr (date_time)),
	        2 pad	         char (10) unal,
	        2 hh	         char (2) unal,
	        2 mm	         char (2) unal;
	dcl   date_time_	         entry (fixed bin (71), char (*));

	call date_time_ (a_time, date_time);

	return (hh || ":" || mm);

     end formatted_time;
%page;
%include opr_display_info;
%page;
%include opr_display_site_table;
     end odis_rdis_update_;




		    odis_execute_line_.pl1          02/14/84  1605.8rew 01/21/84  1733.2       18081



/*  This procedure lives so we can be sure to get the user just before a  */
/*  request is executed, and just after. We pass the request_line on to   */
/*  the default request line executer for ssu_.			    */
/*							    */
/*  This procedure cannot be called recursively. That is, you cannot have */
/*  an "odis" request invoking this procedure to execute another line.    */

/*  Written  82-09-16 by A.G. Haggett (unca). */

odis_execute_line_:
	proc (P_sci_ptr, P_request_line_ptr, P_request_line_len, P_code);

dcl (P_sci_ptr, P_request_line_ptr)	pointer parameter;
dcl P_request_line_len	fixed bin (21);
dcl P_code 		fixed bin (35);

dcl code fixed bin (35);
dcl real_mccoy entry () variable options (variable);


dcl odis_redisplay_$post_request_line entry (ptr);
dcl odis_et_$request_recurse fixed bin (35) external static;
dcl operator_display_$abort_subsystem entry (ptr, fixed bin(35), char(*));
dcl ssu_$abort_line entry() options(variable);
dcl ssu_$get_default_procedure entry (ptr, char(*), entry, fixed bin(35));
dcl ssu_$get_info_ptr entry (ptr) returns(ptr);

dcl cleanup condition;


	odis_info_ptr = ssu_$get_info_ptr (P_sci_ptr);
	if odis_info.executing_request then	     /* ABORT - ABORT */
	     call ssu_$abort_line (P_sci_ptr, odis_et_$request_recurse);

	on cleanup call request_line_epilogue;
	odis_info.executing_request = "1"b;

	/* Do this every time. Could change mid-invocation I guess. */
	call ssu_$get_default_procedure (P_sci_ptr, "execute_line", real_mccoy, code);
	if code ^= 0 then
	     call operator_display_$abort_subsystem (odis_info_ptr, code, "Call to ssu_$get_default_procedure in execute_line failed.");

	call real_mccoy (P_sci_ptr, P_request_line_ptr, P_request_line_len, P_code);

	revert cleanup;
	call request_line_epilogue;




request_line_epilogue:  proc;

	call odis_redisplay_$post_request_line (odis_info_ptr);
	odis_info.executing_request = "0"b;
	return;

    end request_line_epilogue;
%page;
%include opr_display_info;
end odis_execute_line_;




		    odis_system_info_.pl1           02/14/84  1605.8rew 01/21/84  1733.2       53730



/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **
 *   							        *
 *   This module is called by "odis_rdis_update_" to supply information       *
 *   to be installed in the display image. It would be far better if the      *
 *   standard "system_info_" was adequate - it is not. There are the	        *
 *   following entries:					        *
 *   							        *
 *       init	      --  get static pointer to 'whotab' and return       *
 *			installation_id, sysid, and time up.	        *
 *   							        *
 *       daemon_names     --  return idcode's for non-IO daemons.	        *
 *							        *
 *       n_tty_abs_daemon --  return count of tty procs, abs procs, max_abs   *
 *			foregound procs, and daemons.	                  *
 *							        *
 *       next_down_time   --  function to return next_down_time.	        *
 *   							        *
 *       shift_info	      --  return the current shift, next shift, and       *
 *   			time of next shift change.		        *
 *							        *
 *       users	      --  return n_units, max_units, n_users, max_users.  *
 *							        *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/

/* Modified 82-11-29 by A.G. Haggett (unca) to move "driver_status" and "printer_names" entries to "odis_iod_". */

odis_system_info_:
     proc;
	return;



     /* PARAMETERS */
	dcl   a_abs_count	         fixed bin;
	dcl   a_abs_max_count        fixed bin;
	dcl   a_abs_foreground_count fixed bin;
	dcl   a_code	         fixed bin (35);
	dcl   (a_current_shift, a_next_shift) fixed bin;
	dcl   a_daemon_count         fixed bin;
	dcl   a_daemon_name_array    (*) char (*);
	dcl   a_daemon_name_count    fixed bin;
	dcl   a_installation_id      char (32);
	dcl   (a_n_users, a_max_users) fixed bin;
	dcl   (a_n_units, a_max_units) float bin;
	dcl   a_sysid	         char (8);
	dcl   (a_time_up, a_next_shift_time) fixed bin (71);
	dcl   a_tty_count	         fixed bin;

     /* AUTOMATIC */
	dcl   i		         fixed bin;
	dcl   max_names_we_can_return fixed bin;     /* daemon names */

     /* STATIC */
	dcl   whoptr	         pointer internal static init (null ());
	dcl   sysdir	         char (168) internal static init ("");

     /* CONSTANTS */
	dcl   DAEMON_PROCESS         fixed bin init (3) static options (constant);
	dcl   INACTIVE	         fixed bin init (0) static options (constant);
	dcl   IO_PERSONID	         char (2) init ("IO") static options (constant);
	dcl   WHOTAB_SEG_NAME        char (32) init ("whotab") static options (constant);


     /* ENTRIES/EXTERNAL */
	dcl   datebin_$next_shift_change entry (fixed bin (71), fixed bin (71), fixed bin, fixed bin);
	dcl   initiate_file_         entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));
	dcl   sys_info$system_control_dir char (168) varying external static;
	dcl   system_info_$installation_id entry (char (*));

	dcl   error_table_$zero_length_seg fixed bin(35) ext static;
	dcl   (clock, hbound, null)         builtin;
%page;

init: entry (a_installation_id, a_sysid, a_time_up, a_code);


	a_code = 0;

	if whoptr = null () then do;		     /* 1st time? */
	     sysdir = sys_info$system_control_dir;
	     call initiate_file_ (sysdir, WHOTAB_SEG_NAME, R_ACCESS, whoptr, (0), a_code);
	     if a_code ^= 0 then
		if a_code ^= error_table_$zero_length_seg
		     then return;		     /* FATAL */
	          else a_code = 0;
	end;

	/* whotab.installation_id is not maintained by AS. Get it from installation_parms. */
	call system_info_$installation_id (a_installation_id);
	a_sysid = whotab.sysid;
	a_time_up = whotab.timeup;

	return;

%page;
next_down_time:
	entry () returns (fixed bin (71));

	return (whotab.nextsd);

%page;

n_tty_abs_daemon:
     entry (a_tty_count,			     /* N tty processes */
	a_abs_count,			     /* N absentee proc's */
	a_abs_max_count,			     /* max_abs this shift */
	a_abs_foreground_count,		     /* N foreground procs */
	a_daemon_count);			     /* N daemon processes */

	a_abs_count = whotab.abs_users;
	a_abs_max_count = whotab.max_abs_users;
	a_abs_foreground_count = whotab.fg_abs_users;
	a_daemon_count = whotab.n_daemons;
	a_tty_count = whotab.n_users - (a_abs_count + a_abs_foreground_count + a_daemon_count);

	return;
%page;
shift_info:
     entry (a_current_shift, a_next_shift, a_next_shift_time);

	call datebin_$next_shift_change (clock (), a_next_shift_time, a_current_shift, a_next_shift);

	return;

%page;
users: entry (a_n_users, a_max_users, a_n_units, a_max_units);

	a_n_users = whotab.n_users;
	a_max_users = whotab.mxusers;
	a_n_units = whotab.n_units / 10.0e0;
	a_max_units = whotab.mxunits / 10.0e0;
	return;

%page;
daemon_names:
     entry (a_daemon_name_array, a_daemon_name_count);

     /*  This is the only entry to go through the user entries.     */
     /*  We return the idcode's of daemons which do not not have a  */
     /*  personid of IO. We assign names to array elements until    */
     /*  either we fill the array or run out of daemons. In either  */
     /*  case we set 'a_daemon_name_count'.		        */


	a_daemon_name_count = 0;		     /* initialize return */
	a_daemon_name_array (*) = "";		     /* values... 	      */

	/* Respect callers limit. */
	max_names_we_can_return = hbound (a_daemon_name_array, 1);

	do i = 1 to whotab.laste;
	     if whotab.active (i) = INACTIVE then goto NEXT_ENTRY;
	     if whotab.proc_type (i) = DAEMON_PROCESS then  /* A daemon?  */
		if whotab.person (i) ^= IO_PERSONID then  /* Not an IO? */

		     /* Is there room in array for this daemon? */
		     if a_daemon_name_count < max_names_we_can_return then do;
			a_daemon_name_count = a_daemon_name_count + 1;
			a_daemon_name_array (a_daemon_name_count) = whotab.idcode (i);
		     end;
		     else goto RETURN_NOW;	     /* cannot fill any more. */
NEXT_ENTRY:
	end;

RETURN_NOW:
	return;

%page;
%include whotab;
%page;
%include access_mode_values;


     end odis_system_info_;




		    odis_rcp_.pl1                   02/14/84  1605.8rew 01/21/84  1733.3       87507



/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   						         *
 *   This module is our interface to RCP information. The current    *
 *   implementation of the operator_display does not worry about     *
 *   disk_drives (ie. not listed) although disk mounts are handled.  *
 *   We call rcp_sys_$copy to get 'rcp_data'. If the user does not   *
 *   have access, we report same.			         *
 *						         *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

/* Modified 82-11-12 by A.G. Haggett (unca) for "odis_info.rcp_sys_moderr". */
/* Modified 82-12-22 by A.G. Haggett (unca) for "list_tape_drives" entry; used by "list_devices" request. */
/* Modified 83-06-03 by D. A. Fudge (UNCA) to fix disk mount bug -- uoc00048. */
odis_rcp_:
     proc;
	return;


     /* PARAMETERS */
	dcl   a_code	         fixed bin (35) parameter; /* statuc param. */
	dcl   a_number_of_pending_mounts fixed bin parameter; /* as it says. */
	dcl   a_odis_info_ptr        pointer parameter; /* as usual */
	dcl   a_odis_pending_mount_data_ptr pointer parameter; /* see include. */
	dcl   a_volume_array         (*) char (*) parameter; /* volume names. */
	dcl   a_device_array         (*) char (*) parameter; /* ie. "tapa_01" */
	dcl   a_device_count         fixed bin parameter; /* how many returned. */

     /* AUTOMATIC */
	dcl   (i, count)	         fixed bin;
	dcl   max_we_can_return      fixed bin;	     /* hbound of array */
	dcl   device_state_str       char (12);

     /* CONSTANTS */
	dcl   ASSIGNED	         fixed bin init (1) static options (constant);
	dcl   RESERVED	         fixed bin init (4) static options (constant);
	dcl   DEVICE_STATES	         (0:4) char (8) static options (constant) /* 8 char limit */
			         init ("free", "assigned", "deleted", "system", "reserved");
	dcl   TAPE_DRIVE	         char (10) init ("tape_drive") static options (constant);
	dcl   TAPE_DRIVE_TYPE        fixed bin init (1) static options (constant);

     /* ENTRIES/EXTERNAL */
	dcl   ioa_	         entry options (variable);
	dcl   rcp_sys_$copy_data     entry (ptr, fixed bin (19), fixed bin (35));

	dcl   error_table_$moderr    fixed bin (35) ext static;

	dcl   linkage_error	         condition;	     /* no access check */

	dcl   (addr, null, hbound, min)    builtin;
%page;
note_tape_mounts:
     entry (a_odis_info_ptr, a_volume_array, a_device_array, a_device_count, a_code);

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							       *
 *   This entry is called to return the volume names of currently mounted    *
 *   tapes. We return an array of volume names, an array of corresponding    *
 *   devices on which they are mounted, and the number of valid entries we   *
 *   placed in these arrays.					       *
 *							       *
 *   - This entry fills the elements of 'a_volume_array' with the volumes    *
 *     mounted on tape_drive devices. We also fill "a_device_array" with the *
 *     device names. We only list volumes when the device is 'assigned',     *
 *     otherwise we return the state (ie. "free").		       *
 *   							       *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */


	call rcp_setup (a_code);
	if a_code ^= 0 then return;

	a_device_count = 0;

     /* Do not try to return any more than either input array can handle. */
	max_we_can_return = min (hbound (a_volume_array, 1), hbound (a_device_array, 1));

	ddtype_ptr = get_device_type_ptr (TAPE_DRIVE);
	if ddtype_ptr = null() then return;	     /* What to do? */

     /* Process every device entry of this type. */
	do i = ddtype.first_devicex to (ddtype.first_devicex + ddtype.num_devices - 1);
	     ddevice_ptr = addr (rdi.ddevices (i));
	     if i > max_we_can_return then goto RETURN_FROM_NOTE_MOUNTS;

	     a_device_array (i) = ddevice.device_name;

          /* Assign state as volume name for now.*/
	     a_volume_array (i) = DEVICE_STATES (ddevice.state);

	     if ddevice.state = ASSIGNED then
		if ddevice.volume_name ^= ""	     /* something there... */
		& (^ddevice.flags.mounting) then   /* not pending mount.. */
		a_volume_array (i) = ddevice.volume_name;
	end;

RETURN_FROM_NOTE_MOUNTS:
	a_device_count = i - 1;		     /* adjust loop var */

	return;
%page;
check_mounts:
     entry (a_odis_info_ptr, a_odis_pending_mount_data_ptr, a_number_of_pending_mounts, a_code);

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							   *
 *   We return information about pending mounts. Our caller can decide   *
 *   what to do with it (ie. should the Opr be notified 'cause this is   *
 *   a new pending mount). Note also that we return both pending disk	   *
 *   and tape mounts.					   *
 *							   *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	call rcp_setup (a_code);
	if a_code ^= 0 then return;

     /* The redisplay program(s) set this limit. They know the maximum which can be displayed. */
	max_we_can_return = ODIS_PENDING_MOUNT_LIMIT;

     /* Use 'count' in loop and update "a_number_of_pending_mounts" on way out. */
	a_number_of_pending_mounts, count = 0;

	begin;
	     dcl	 1 opmd		    (max_we_can_return) aligned like odis_pending_mount_data based (a_odis_pending_mount_data_ptr);


	     do i = 1 to rdi.tot_ddevices;	     /* check each device */
		ddevice_ptr = addr (rdi.ddevices (i));
		if ddevice.flags.mounting then do; /* got one. */
		     if count >= max_we_can_return
		     then goto RETURN_FROM_CHECK_MOUNTS;
		     count = count + 1;
		     opmd.volume_name (count) = ddevice.volume_name;
		     if opmd.volume_name (count) = "" then opmd.volume_name (count) = "scratch";
		     opmd.device_name (count) = ddevice.device_name;
		     opmd.protect_sw (count) = (^ddevice.flags.writing);
		     opmd.tape_sw (count) = (ddevice.dtypex = TAPE_DRIVE_TYPE);
		     opmd.for_who (count) = ddevice.group_id;
                         if opmd.tape_sw (count) = "0"b then
                         opmd.protect_sw (count) = ddevice.flags.writing;
		end;
	     end;

	end;				     /* begin block. */



RETURN_FROM_CHECK_MOUNTS:

	a_number_of_pending_mounts = count;	     /* Copy temp. */
	return;
%page;
list_tape_drives:
	entry (a_odis_info_ptr, a_code);

	call rcp_setup (a_code);
	if a_code ^= 0 then return;		     /* Cannot go on. */

      /* Note that we are limited to 1 page of output -- not a problem. */
      /* First, let's find devices of type "tape_drive". */
	ddtype_ptr = get_device_type_ptr (TAPE_DRIVE);
	if ddtype_ptr = null() then return;	     /* Can it happen? */

      /* Print header. */
	call ioa_ ("Drive    State     Volume    User^/");

      /* Process and list all tape drives. */
	do i = ddtype.first_devicex to (ddtype.first_devicex + ddtype.num_devices - 1);
	     ddevice_ptr = addr (rdi.ddevices (i));

	     /* Special case when assigned and pending mount. */
	     device_state_str = DEVICE_STATES (ddevice.state);
	     if ddevice.flags.mounting then device_state_str = "mounting";

	     call ioa_ ("^a^10t^a^[^20t^a^;^s^]^[^30t^a^]",
		ddevice.device_name,	     /* tapa_01 */
		device_state_str,		     /* assigned */
		(ddevice.flags.mounting | ddevice.state = ASSIGNED),
		ddevice.volume_name,	     /* sys015 */
		(ddevice.flags.mounting | ddevice.state = ASSIGNED | ddevice.state = RESERVED),
		ddevice.group_id);		     /* Jones.SysAdmin */
	end;

	return;
%page;
get_device_type_ptr:
	proc (a_device_type) returns (pointer);

	dcl a_device_type	char (*) parameter;
	dcl dtype_i	fixed bin;
	dcl dev_ptr	pointer;

	do dtype_i = 1 to rdi.tot_ddtypes;
	     dev_ptr = addr (rdi.ddtypes (dtype_i));
	     if dev_ptr -> ddtype.device_type = a_device_type then return (dev_ptr);
	end;

	return (null ());

end get_device_type_ptr;
%page;
rcp_setup: proc (code);

	dcl   code	         fixed bin (35) parameter;
	dcl   rcp_copy_size	         fixed bin (19); /* for rcp_sys_ */

	code = 0;

     /* Get information structure. */
	odis_info_ptr = a_odis_info_ptr;

     /*************************************************************************
     *                                                                        *
     *  The bit "rcp_sys_moderr" is set if the user does not have access to   *
     *  rcp_sys_. We check this bit and if it is on we do not proceed and we  *
     *  set code to et_$moderr. This prevents us from filling up the error    *
     *  log with moderr messages every timer cycle update. The said bit is    *
     *  cleared by a call to "odis_redisplay_$full_redisplay",	        *
     *  "odis_requests_$list_devices", or "odis_redisplay_$change_mode"       *
     *  (ie. try again to use gate).				        *
     *                                                                        *
     *************************************************************************/

	if odis_info.rcp_sys_moderr then do;
	     code = error_table_$moderr;
	     return;
	end;

     /* Set up for copy. */
	rdi_ptr = addr (odis_info.display_data_ptr -> odis_display_data.rcp_data);
	rdi.version_num = rdi_version_3;

     /* Get size (in words) of the data area we are storing into. */
	rcp_copy_size = hbound (odis_info.display_data_ptr -> odis_display_data.rcp_data, 1);

     /* Does user have access? */
	on linkage_error begin;
		code = error_table_$moderr;	     /* no access to rcp_sys_ */
		odis_info.rcp_sys_moderr = "1"b;
		goto RETURN_FROM_SETUP;
	     end;

	call rcp_sys_$copy_data (rdi_ptr, rcp_copy_size, code); /* ring1 peek */

	revert linkage_error;

RETURN_FROM_SETUP:
	return;				     /* Let caller worry about code. */

     end rcp_setup;
%page;

%include opr_display_info;
%page;

%include rcp_data_info;
     end odis_rcp_;




		    odis_queue_.pl1                 02/14/84  1605.8rew 01/21/84  1733.3      132417



/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   						         *
 *   This proc is the interface used to obtain queue information.    *
 *						         *
 *   There are the following entries:			         *
 *						         *
 *	absentee_counts	 --  get counts for the six absentee's *
 *			     fg -> 4.		         *
 *	get_queue_counts	 --  get counts for standard message   *
 *			     segment queues		         *
 *	display_rqt_info	 --  build a display of detailed queue *
 *			     info for a supplied rqt, and      *
 *			     flash it on the screen This is    *
 *			     called by the "scan_queues" req.. *
 *						         *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

/* Modified 82-11-12 by A.G. Haggett (unca) for new "get_queue_counts" calling sequence. */
/* Modified 83-06-29 by S. G. Harris (UNCA) to flush window for queue display. */

odis_queue_:
	proc;
	return;

/* PARAMETERS */
dcl a_q_array (4) fixed bin parameter;		     /* extents for these */
dcl a_abs_q_array (-1:4) fixed bin parameter;	     /* can be coded.     */
dcl a_rqt char (*) parameter;
dcl a_odis_info_ptr pointer parameter;		     /* "display_rqt_info" */
dcl a_workspace_ptr pointer parameter;		     /* "display_rqt_info" */
dcl a_rqt_name char (*) aligned parameter;	     /* "display_rqt_info" */
dcl a_dir char (*) parameter;

/* AUTOMATIC */
dcl 1 abs_q_entryname unal,			     /* for making entryname qith a queue number. */
      2 pad1		char (9) init ("absentee_"),
      2 number		char (1),		     /* only level 2 needing data. */
      2 pad2		char (3) init (".ms");

dcl code fixed bin (35);
dcl current_line fixed bin;
dcl last_ms_id bit (72) aligned;
dcl ms_entryname char (32);			     /* like "printer_1.ms" */
dcl (q, q_tt, max_queue, mseg_index, current_message) fixed bin;
dcl q_pic pic "9";
dcl q_rqt char (27) varying init ("");		     /* less "_n.ms" */
dcl queue_dir char (168);			     /* either >sc1 or >ddd>idd */
dcl rqt_name char (32);
dcl some_output bit (1);
dcl system_free_area_ptr pointer;		     /* from get_system_free_area_ */

/* BASED */
dcl system_free_area area based (system_free_area_ptr);

/* CONSTANT */
dcl DISPLAY_RQT_HEADING char (48) static options (constant)
	init ("  USER                                 SEGMENT");
dcl IO_DAEMON_DIR char (8) init (">ddd>idd") static options (constant);
dcl MS_SUFFIX char (3) init (".ms") static options (constant);
dcl QUEUE_NUMBER_CHAR (0:4) char (1) static options (constant)
          init ("0", "1", "2", "3", "4") ;
dcl READ_FIRST_MESSAGE  bit (1) init ("0"b)  aligned static options (constant);
dcl READ_NEXT_MESSAGE   bit (2) init ("01"b) aligned static options (constant);
dcl RELATIVE_SECONDS       bit (2) init ("11"b) static options (constant);
dcl THE_WORD_ABSENTEE char (8) init ("absentee") static options (constant);
dcl UNDERSCORE char (1) init ("_") static options (constant);

/* ENTRIES/EXTERNAL */
dcl (ioa_$rsnnl, ioa_$ioa_switch_nnl) entry options (variable);
dcl iod_info_$queue_data entry (char(*), fixed bin, fixed bin, fixed bin(35));
dcl get_system_free_area_ entry () returns (ptr);
dcl message_segment_$close entry (fixed bin, fixed bin (35));
dcl message_segment_$get_message_count_file entry (char (*), char (*), fixed bin, fixed bin (35));
dcl message_segment_$incremental_read_index entry (fixed bin, ptr, bit (2) aligned, bit (72) aligned, ptr, fixed bin (35));
dcl message_segment_$open entry (char (*), char (*), fixed bin, fixed bin (35));
dcl message_segment_$read_index entry (fixed bin, ptr, bit (1) aligned, ptr, fixed bin (35));
dcl sys_info$system_control_dir char (168) varying external static;
dcl window_$clear_window entry (ptr, fixed bin (35));
dcl window_$position_cursor entry (ptr, fixed bin, fixed bin, fixed bin (35));

dcl error_table_$no_message fixed bin(35) ext static;

dcl cleanup condition;

dcl (addr, null, min, max, rtrim, string) builtin;
%page;
absentee_counts: entry (a_abs_q_array);

	a_abs_q_array (*) = 0;		     /* if error, this will be OK. */
	queue_dir = sys_info$system_control_dir;     /* impt. global. */

	/* First get foreground count, then loop on 0 - 4. */
	ms_entryname = THE_WORD_ABSENTEE || UNDERSCORE || "fg" || MS_SUFFIX;

	/* -1th element of array is for foreground. */
	call get_queue_count (ms_entryname, a_abs_q_array (-1));
	
	/* Now get counts for 0 to 4. */
	do q = 0 to 4;
	     abs_q_entryname.number = QUEUE_NUMBER_CHAR (q);   /* make name. */
	     call get_queue_count (string (abs_q_entryname), a_abs_q_array (q));
	end;

	return;
%page;
get_queue_counts:	entry (a_dir, a_rqt, a_q_array);

	/*  We simply return the totals for each of the four queues.    */
	/*  If we encounter any error, we return zero for any remining  */
	/*  queues to be checked. Set the global "queue_dir" which is   */
	/*  used by "get_queue_count" subr..			    */

	if a_dir = "" then queue_dir = IO_DAEMON_DIR;
	else queue_dir = a_dir;
	a_q_array (*) = 0;

	do q = 1 to 4;			     /* assume 4 queues. */
	     q_pic = q;
	     ms_entryname = rtrim (a_rqt) || "_" || q_pic || MS_SUFFIX;
	     call get_queue_count (ms_entryname, a_q_array (q));
	end;

	return;

%page;
display_rqt_info:
	entry (a_odis_info_ptr, a_workspace_ptr, a_dir, a_rqt_name);

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							     *
 *   Get detailed status information for each queue of rqt "a_rqt_name"    *
 *   and flash it on the screen a screen-full at a time. Build the	     *
 *   display in a screen array using the temp segment pointed to by	     *
 *   "a_workspace_ptr". We also write an informative line in the mini	     *
 *   window concerning our activity.				     *
 *							     *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	/* format: off  /* This is the array we will build display in. */
	dcl display_array
		(display_array_nrows)	     /* height */
		char  (display_array_width)	     /* columns */
		based (display_array_ptr) unaligned;
	/* format: on */

	dcl (display_array_nrows,
	     display_array_width)	fixed bin;
	dcl display_array_ptr 	pointer;

	/* This buffer is where ioa_ places the "rsnnl" output. */
	dcl display_array_line	char (display_array_width) unaligned based (display_array_line_ptr);
	dcl display_array_line_ptr	pointer;	     /* points to an element of "display_array". */
	dcl ioa_return_len	fixed bin (21);	     /* from "ioa_$rsnnl" */


	odis_info_ptr = a_odis_info_ptr;
	display_array_ptr = a_workspace_ptr;
	rqt_name = a_rqt_name;

	/* Set extents of "display_array". */
	display_array_width = odis_info.dis_window_info.width;
	display_array_nrows = odis_info.dis_window_info.height;
	display_array (*) = "";

	/* This variable always points to next available line. We start at */
	/* 3 because 1 is a heading and 2 is blank. If we cannot display   */
	/* because of non-zero status, a message goes into this line.      */
	current_line = 3;

	/* Where to find request type queues. */
	if a_dir = "" then queue_dir = IO_DAEMON_DIR;
	else queue_dir = a_dir;

	/* Start out with a clean slate. */
	call window_$clear_window (odis_info.dis_window_iocb, code);

	/* Get information about this request type. */
	call iod_info_$queue_data (rqt_name, (0), max_queue, code);
	if code ^= 0 then do;
	     display_array (current_line) = "** Cannot get queue data for request type: " || rqt_name;
	     call dump_display ();		     /* display and sleep */
	     return;
	end;

	/* Now walk through processing each queue. If there is nothing in  */
	/* any of the queues, then we display a message like "There are no */
	/* requests...". If ^some_output then there were no requests found.*/
	/* We use the system free area to allocate the "dprint_msg".       */

	/* Set state of the world for main loop. */
	some_output = "0"b;			     /* none yet */
	ms_arg_ptr = addr (return_args);	     /* local of mseg_return_args */
	mseg_return_args.ms_ptr = null();	     /* "cleanup" check */
	mseg_index = 0;			     /* nothing opened yet */

	on cleanup call display_rqt_cleanup ();	     /* close file, release info */

	system_free_area_ptr = get_system_free_area_ ();

%page;
	/*  Walk through queues. We always check before trying to write a  */
	/*  line to the image that "current_line < display_array_n_rows".  */
	/*  The last line is always left blank. If this condition arises,  */
	/*  or we have finished building information for a particular      */
	/*  queue, then we call "dump_display" and reset state of things.  */

	do q = 1 to min (4, max_queue);
	     q_pic = q;
	     ms_entryname = rtrim (rqt_name) || "_" || q_pic || MS_SUFFIX;
	     call get_queue_count (ms_entryname, q_tt);
	     if q_tt = 0 then goto PROCESS_NEXT_QUEUE;

	     /* Display info. concerning our activity in mini window. */
	     call window_$position_cursor (odis_info.mini_window_iocb, 1, 1, code);
	     call ioa_$ioa_switch_nnl (odis_info.mini_window_iocb, "Request type:  ""^a"",^33tQueue:  ^d,^51t^d total requests.",
		rqt_name, q, q_tt);

	     /* Now read each request and build display. */
	     call message_segment_$open (queue_dir, ms_entryname, mseg_index, code);
	     if code ^= 0 then do;
		display_array_line_ptr = addr (display_array (current_line));
		call ioa_$rsnnl ("**Cannot open file to check request type ""^a"", queue ^d.",
		     display_array_line, ioa_return_len,
		     rqt_name, q);
		call dump_display ();
		goto PROCESS_NEXT_QUEUE;
	     end;

	     /* Loop through messages. */
	     call message_segment_$read_index (mseg_index, system_free_area_ptr, READ_FIRST_MESSAGE, ms_arg_ptr, code);
	     do current_message = 1 by 1 while (code = 0);

		/* Do we have any room to write this line? */
		if current_line >= display_array_nrows then do;
		     call flash_display ();	     /* slew to screen */
		     current_line = 3;	     /* where we start again */
		     display_array = "";	     /* of course */
		end;

		dmp = mseg_return_args.ms_ptr;     /* dprint_msg struc. */
		display_array_line_ptr = addr (display_array (current_line));
		call ioa_$rsnnl ("^32a ^2d) ^32a^[(running)^]", display_array_line, ioa_return_len,
		     mseg_return_args.sender_id,   /* group id */
		     current_message,	     /* position in queue */
		     dprint_msg.header.ename,	     /* segment entryname */
		     (dprint_msg.header.state = STATE_RUNNING));     /* only status we care about. */
		current_line = current_line + 1;

		free mseg_return_args.ms_ptr -> dprint_msg in (system_free_area);
		mseg_return_args.ms_ptr = null();

		last_ms_id = mseg_return_args.ms_id;	/* set up for read */
		call message_segment_$incremental_read_index
		     (mseg_index, system_free_area_ptr, READ_NEXT_MESSAGE, last_ms_id, ms_arg_ptr, code);
	     end;

	     if code ^= error_table_$no_message then do;
 		display_array_line_ptr = addr (display_array (current_line));
		call ioa_$rsnnl ("**Cannot read segment for request type ""^a"", queue ^d.",
		     display_array_line, ioa_return_len,
		     rqt_name, q);
		call dump_display ();
	     end;

	     /* "code" was good. Did we write into image? */
	     else if current_message > 1 then call flash_display ();

PROCESS_NEXT_QUEUE:
	     if mseg_index ^= 0 then
		call message_segment_$close (mseg_index, code);
	     mseg_index = 0;
	     current_line = 3;		     /* for new queue */
	     display_array (*) = "";		     /* start fresh */
	end;				     /* do q = 1... */
%page;
	/* We beak when all queues of an rqt are empty. */
	if ^some_output then do;
	     call window_$position_cursor (odis_info.mini_window_iocb, 1, 1, code);
	     call ioa_$ioa_switch_nnl (odis_info.mini_window_iocb, "There are no requests in any ""^a"" queue.", rqt_name);
	     call sleep (5);		     /* leave on screen for all to see seconds */
	end;
	return;
%page;
display_rqt_cleanup:
	proc ();

	if mseg_index ^= 0 then do;
	     call message_segment_$close (mseg_index, code);
	     mseg_index = 0;
	end;

	if mseg_return_args.ms_ptr  ^= null() then
	     free mseg_return_args.ms_ptr -> dprint_msg in (system_free_area);

	return;
end display_rqt_cleanup;
%page;
get_queue_count:
	proc (a_ms_segname, a_tt);

	dcl a_ms_segname char (*) parameter;	     /* request type. */
	dcl a_tt fixed bin parameter;		     /* N in queue. */
	dcl code fixed bin (35) init (0);

	/*  NOTE: We use the value of the global "queue_dir" for call. */

	call message_segment_$get_message_count_file (queue_dir, a_ms_segname, a_tt, code);
	if code ^= 0 then a_tt = 0;		     /* best we can do. */

	return;

end get_queue_count;
%page;
flash_display:
	proc ();

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							     *
 *   This is called when we want to display the real mccoy. We write our   *
 *   header into line 1 (line 2 remains blank) and the dump it. The subr   *
 *   "dump_display" is a separate proc. because we may want to call it     *
 *   without having header insertion.				     *
 *							     *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	display_array (1) = DISPLAY_RQT_HEADING;
	call dump_display ();		     /* display and sleep */
	return;

end flash_display;






dump_display:
	proc ();

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							     *
 *   Display the contents of "display_array". We leave it on the screen    *
 *   for "n_sominex" seconds (no less than 5).			     *
 *							     *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	dcl n_sominex	fixed bin (71);

	dcl window_display_ entry (ptr, (*) char(*), fixed bin(35));

	/* Set this important global flag. Avoid empty rqt message. */
	some_output = "1"b;
	/* We trust the value of the outer block var. "current_line" for the following heuristic. */
	n_sominex =  max (5, current_line);

	/* Dump the buffer. */
	call window_display_ (odis_info.dis_window_iocb, display_array, code);

	/* Position cursor at uninteresting place. */
	call window_$position_cursor
	     (odis_info.mini_window_iocb, odis_info.mini_window_info.height, (odis_info.mini_window_info.width - 1), code);
	call ioa_$ioa_switch_nnl (odis_info.mini_window_iocb, "");	/* Use bell to force window display out */
	
	call sleep (n_sominex);
	return;

end dump_display;






sleep:	proc (a_time);

	dcl a_time	fixed bin (71) parameter;
	dcl timer_manager_$sleep entry (fixed bin (71), bit (2));

	/* Sleep to give those interested a chance to read. */
	call timer_manager_$sleep (a_time, RELATIVE_SECONDS);

	return;

end sleep;
%page;
%include mseg_return_args;


dcl 1 return_args like mseg_return_args aligned;
%page;
%include dprint_msg;



%include queue_msg_hdr;
%page;
%include opr_display_info;



end odis_queue_;




		    odis_iod_.pl1                   02/14/84  1605.8rew 01/21/84  1736.4      102357



/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							       *
 *   OPERATOR_DISPLAY interface to iod_working_tables.		       *
 *   							       *
 *   Currently the entries herein are used by the "driver_status" request    *
 *   (odis_requests_$driver_status). We use the segment the copy of the      *
 *   iod_tables at ">ddd>idd>iod_working_tables" to get information.         *
 *   							       *
 *   Entries:						       *
 *   							       *
 *     driver_info_index   --  return information about a driver based on    *
 *   			 an index parameter which we use as input      *
 *   			 and output. An index of zero specifies        *
 *   			 that this is the first call. 	       *
 *							       *
 *     driver_info_name    --  return information about the driver whose     *
 *			 major name (ie. prta) is supplied.	       *
 *							       *
 *     printer_names       --  return major and minor names for printers     *
 *			 using printer_driver_ module (ie. dispatch    *
 *			 printers)			       *
 *							       *
 *     driver_status       --  return information from a driver status       *
 *			 segment (ie. >ddd>idd>prta>prta).             *
 *							       *
 *  This module is not as smart as it should be. The reader is directed to   *
 *  the "print_devices" or "print_iod_tables" to see what we do not handle.  *
 *  The outstanding limitation is that we assume only 1 minor device per     *
 *  major device.						       *
 *							       *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

/* Modified 82-11-29 by A.G. Haggett to install "printer_names" and "driver_status" entries from old home in "odis_system_info_". */

odis_iod_:
     proc;
	return;

     /* PARAMETERS */
	dcl   a_index	         fixed bin parameter; /* input */
	dcl   a_major_name	         char (*) parameter; /* major divice like "prta". */
	dcl   a_minor_name	         char (*) parameter; /* minor device name like "reader". */
	dcl   a_default_rqt	         char (*) parameter; /* default request type handled by this driver. */
	dcl   a_code	         fixed bin (35) parameter;

     /* AUTOMATIC */
	dcl   code	         fixed bin (35);
	dcl   idx		         fixed bin;
	dcl   max_names_we_can_return fixed bin;     /* for printer_names */
	dcl   name_not_found         bit (1);	     /* for name entry */

     /* STATIC */
     /* format: off */			     /* POINTS TO...       */
     dcl  (iodt_ptr,			     /* iod_working_tables */
	 idtp,				     /* iod_device_tab     */
	 mdtp,				     /* minor_device_tab   */
	 qgtp,				     /* q_group_tab	       */
	 dctp)				     /* dev_class_tab      */
		pointer internal static init (null());
/* format: on */

     /* CONSTANT */
	dcl   IOD_DIR	         char (168) init (">ddd>idd") static options (constant);
	dcl   IOD_SEG	         char (32) init ("iod_working_tables") static options (constant);

     /* ENTRIES/EXTERNAL */
	dcl   hcs_$initiate	         entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
	dcl   hcs_$terminate_noname  entry (ptr, fixed bin (35));

	dcl   (error_table_$end_of_info,
	      error_table_$unimplemented_version,
	      odis_et_$driver_not_found) fixed bin (35) ext static;

	dcl   (addr, dimension, min, null, ptr, rtrim)      builtin;
%page;
driver_info_index:
     entry (a_index, a_major_name, a_minor_name, a_default_rqt, a_code);

	if iodt_ptr = null() then call iod_init (a_code); /* static data */

	a_code = 0;

     /* Bump index to return next entry. */
	idx = a_index + 1;			     /* read index right! */

     /* Are there as many devices as our calculated "idx" ? */
	if idx > idtp -> iod_device_tab.n_devices then do;
	     a_code = error_table_$end_of_info;	     /* no more devices */
	     return;
	end;

     /* ... MAJOR NAME ... */
	idtep = addr (idtp -> iod_device_tab.entries (idx));
	a_major_name = idte.dev_id;

     /* ... MINOR NAME ... */
	mdtep = addr (mdtp -> minor_device_tab.entries (idte.first_minor));
	a_minor_name = mdte.dev_id;

     /* ... DEFAULT RQT ... */
	dctep = addr (dctp -> dev_class_tab.entries (mdte.default_dev_class));
	qgtep = addr (qgtp -> q_group_tab.entries (dcte.qgte_index));
	a_default_rqt = qgte.name;


	return;
%page;
driver_info_name:
     entry (a_major_name, a_minor_name, a_default_rqt, a_code);

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   						 *
 *   Return information about the driver specified by the	 *
 *   input parameter "a_major_name". If we do not find it	 *
 *   then return "odis_et_$driver_not_found".		 *
 *						 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	if iodt_ptr = null() then call iod_init (a_code); /* static data */

	a_code = 0;

	a_minor_name, a_default_rqt = "";

	name_not_found = "1"b;		     /* No match found yet */

     /* Loop on devices until name match. */

	do idx = 1 to idtp -> iod_device_tab.n_devices while (name_not_found);
	     idtep = addr (idtp -> iod_device_tab.entries (idx));
	     if a_major_name = idte.dev_id then do;

	     /* ... MINOR NAME ... */
		mdtep = addr (mdtp -> minor_device_tab.entries (idte.first_minor));
		a_minor_name = mdte.dev_id;

	     /* ... DEFAULT RQT ... */
		dctep = addr (dctp -> dev_class_tab.entries (mdte.default_dev_class));
		qgtep = addr (qgtp -> q_group_tab.entries (dcte.qgte_index));
		a_default_rqt = qgte.name;

		name_not_found = "0"b;	     /* STOP LOOP */
	     end;
	end;


	if name_not_found then
	     a_code = odis_et_$driver_not_found;

	return;

%page;
printer_names:
	entry (a_prt_major_array, a_prt_minor_array, a_prt_count);

	dcl   a_prt_major_array      (*) char (*) parameter;   /* major names for IOM printers. */
	dcl   a_prt_minor_array      (*) char (*) parameter;   /* minor names for IOM printers. */
	dcl   a_prt_count	         fixed bin parameter;      /* # of IOM printers returned. */

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							   *
 *   Return major and minor names for printers using "printer_driver_"   *
 *   module. These MUST be IOM connected printers. We return as many as  *
 *   we find until we have walked through tables or reached the limit	   *
 *   set by "max_names_we_can_return".				   *
 *							   *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	if iodt_ptr = null then call iod_init (a_code);

	a_prt_count = 0;
	max_names_we_can_return = min (dimension (a_prt_major_array, 1), dimension (a_prt_minor_array, 1));

	do idx = 1 to idtp -> iod_device_tab.n_devices;

	     /* CHECK DRIVER MODULE */
	     idtep = addr (idtp -> iod_device_tab.entries (idx));
	     if idte.driver_module = "printer_driver_" then    /* A lady. */
		if a_prt_count < max_names_we_can_return then do;
		     a_prt_count = a_prt_count + 1;

		     /* MAJOR NAME */
		     a_prt_major_array (a_prt_count) = idte.dev_id;

		     /* MINOR NAME */
		     mdtep = addr (mdtp -> minor_device_tab.entries (idte.first_minor));
		     a_prt_minor_array (a_prt_count) = mdte.dev_id;
		end;

		else return;		     /* Can not fill any more array elements. */
	end;

	return;
%page;
driver_status:
	entry (a_major_name, a_minor_name, a_group_id, a_dir, a_entry, a_rqt, a_queue, a_status);

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *							     *
 *    Return status information from >ddd>idd>a_major_name>a_minor_name    *
 *    driver status segment. If we cannot return good information, then    *
 *    the parameter "a_status" is assigned a string describing why.  If    *
 *    all is well, then "a_status" = "".  If "a_minor_name" = "" then	     *
 *    use "a_major_name".  This would give us an absolute path like	     *
 *    ">ddd>idd>prta>prta".					     *
 *							     *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	dcl a_group_id	char (*);		     /* OUTPUT */
	dcl a_dir		char (*);		     /*   ""   */
	dcl a_entry	char (*);		     /*   ""   */
	dcl a_rqt		char (*);		     /*   ""   */
	dcl a_queue	fixed bin;	     /*   ""   */
	dcl a_status	char (*);		     /*   ""   */

	dcl driver_segptr	pointer;		     /* to driver segment */
	dcl driver_dir	char (168);	     /* >ddd>idd>???? */
	dcl driver_seg	char (32);

	dcl 1 ds like driver_status aligned based (driver_segptr);

	dcl cleanup condition;

	a_status = "";
	driver_segptr = null();
	driver_dir = rtrim (IOD_DIR) || ">" || a_major_name;   /* ie. >ddd>idd>prta */
	driver_seg = a_minor_name;
	if driver_seg = "" then		     /* ie. >ddd>idd>prta>prta */
	     driver_seg = a_major_name;

	on cleanup call driver_status_cleaner;	     /* terminate seg */

	call hcs_$initiate (driver_dir, driver_seg, "", 0b, 00b, driver_segptr, code);
	if driver_segptr = null() then do;	     /* not there. */
	     a_status = "Information for this device is unavailable.";
	     goto DRIVER_STATUS_RETURNS;
	end;

	if ^ds.status_flags.busy then do;	     /* Not doing a request. */
	     a_status = "Device is idle.";
	     goto DRIVER_STATUS_RETURNS;
	end;
	
	/* It is busy so return other param values. */

	a_group_id = ds.sender_id;		     /* busy for who. */
	a_rqt = ds.req_type_label;		     /* processing rqt. */

	/* Now return info in pertinent "mseg_return_args". */
	ms_arg_ptr = addr (ds.message);

	a_dir   = ms_arg_ptr -> queue_msg_hdr.dirname;
	a_entry = ms_arg_ptr -> queue_msg_hdr.ename;
	a_queue = ms_arg_ptr -> queue_msg_hdr.orig_queue;

DRIVER_STATUS_RETURNS:
	call driver_status_cleaner;
	return;


driver_status_cleaner: proc();

	/* Terminate driver status segment. */
	if driver_segptr ^= null() then
	     call hcs_$terminate_noname (driver_segptr, code);
	return;

end driver_status_cleaner;
%page;
iod_init: proc (a_code);

	dcl   a_code	         fixed bin (35);

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							     *
 *   If per-process pointers are not set, then initiate the "iod_tables"   *
 *   at >ddd>idd>iod_working_tables and set them. Access and iod_tables    *
 *   version are the only things which could cause error return.	     *
 *							     *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	a_code = 0;

     /* Get a pointer to >ddd>idd>iod_working_tables. */
	call hcs_$initiate (IOD_DIR, IOD_SEG, "", 0, 0, iodt_ptr, code);
	if iodt_ptr = null () then		     /* No access? */
	     goto INIT_ERROR_RETURN;
	a_code = 0;			     /* clear residual */
	if iodt_ptr -> iod_tables_hdr.version ^= iodt_version_4 then do;
	     a_code = error_table_$unimplemented_version;
	     goto INIT_ERROR_RETURN;
	end;

	idtp = ptr (iodt_ptr, iodt_ptr -> device_tab_offset);
	mdtp = ptr (iodt_ptr, iodt_ptr -> minor_device_tab_offset);
	dctp = ptr (iodt_ptr, iodt_ptr -> dev_class_tab_offset);
	qgtp = ptr (iodt_ptr, iodt_ptr -> q_group_tab_offset);

     /* The initialization of these variables from the IOD-related */
     /* incl's are bogus. This simply prevents compiler warnings.  */
	idt_size, mdt_size, dct_size, qgt_size = 0;

	return;

     end iod_init;

INIT_ERROR_RETURN:
     return;
%page;
%include iod_tables_hdr;
%page;
%include iod_device_tab;
%page;
%include q_group_tab;
%page;
%include device_class;
%page;
%include driver_status;
%page;
%include request_descriptor;
%page;
%include mseg_return_args;
%page;
%include queue_msg_hdr;

     end odis_iod_;




		    operator_display_site_.pl1      02/14/84  1605.9rew 01/21/84  1736.4       38079



/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							       *
 *   This module contains entries specified in the Operator Display	       *
 *   Site Table segment. There are two entries currently for returning       *
 *   the counts in "special" queues:				       *
 *   							       *
 *   	o  bjp_queue					       *
 *	o  plot_queue					       *
 *   							       *
 *   These entries correspond to an "entry" statement in the data file       *
 *   in >sc1. The entries in the ascii file which is cv_odsf'ed look	       *
 *   something like this:					       *
 *   							       *
 *	display_rqt:	>udd>BJP>tab>bjp_jobs;		       *
 *	  display_name:	  BJP;				       *
 *	  entry:		  operator_display_site_$bjp_queue;	       *
 *							       *
 *   For more info on the statements of an Operator Display Site File	       *
 *   see "cv_odsf.info". Each entry specified for a display rqt has the      *
 *   calling sequence:					       *
 *   							       *
 *	dcl get_queue_counts_ entry (char (*), char (*), (4) fixed bin);   *
 *   							       *
 *        call get_queue_counts_ (dir, rqt_name, q_counts);		       *
 *							       *
 *   where:						       *
 *	dir	  (INPUT)					       *
 *		  is the directory where the queue(s) is/are found.      *
 *	rqt_name	  (INPUT)					       *
 *		  is the name of the request type.		       *
 *	q_counts	  (OUTPUT)				       *
 *		  is a 4 element array in which the queue counts	       *
 *		  are returned.				       *
 *							       *
 *   For example, the operator_display calls the "bjp_queue" entry as:       *
 *							       *
 *   	call operator_display_site_$bjp_queue			       *
 *		(">udd>BJP>tab", "bjp_jobs", q_array);		       *
 *							       *
 *   We assign the count in the queue (there is only 1 BJP queue) to	       *
 *   q_array (1). The elements 2-4 are assigned zero.		       *
 *							       *
 *   Note that we bless the data file with the location intelligence.	       *
 *   Having to modify this module for a new location is not too quick.       *
 *							       *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

/* Written  82-11-14 by A.G. Haggett (unca) as part of the new "odst" solution to achieve better site independence. */
/* Modified 84-01-20 by CAJ (UNCA) to reflect the plotting changes */

operator_display_site_:
	proc ();
	return;

     /* PARAMETERS */
	dcl a_rqt_dir		char (*) parameter;
	dcl a_rqt_name		char (*) parameter;
	dcl a_q_array		(4) fixed bin parameter;

     /* AUTOMATIC */
	dcl code fixed bin (35);
	dcl q_array (4) fixed bin;
	dcl sum_array (4) fixed bin;
	dcl i fixed bin;
	dcl q_tt fixed bin;
	dcl rqt_name char (32);

     /* STATIC */
	dcl plot_rqt (6) char (11) internal static options (constant)
	     init ("cc_1051", "cc_1051/w", "cc_1051/i", "cc_1051/wi", "cc_1051/4i", "cc_1051/4wi");

     /* ENTRIES */
	dcl message_segment_$get_message_count_file entry (char (*), char (*), fixed bin, fixed bin (35));
	dcl odis_queue_$get_queue_counts entry (char (*), char (*), (4) fixed bin);
	dcl (null, rtrim)	builtin;
	dcl cleanup condition;
%page;
bjp_queue:
	entry (a_rqt_dir, a_rqt_name, a_q_array);

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   						   *
 *   This entry requires "s" extended access to the segment	   *
 *   "bjp_jobs.ms". BJP has only 1 queue.		   *
 *						   *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

	a_q_array (*) = 0;

	rqt_name = rtrim (a_rqt_name) || ".ms";
	call message_segment_$get_message_count_file (a_rqt_dir, rqt_name, q_tt, code);
	if code = 0 then a_q_array (1) = q_tt;	     /* A good value? */

	return;
%page;
plot_queue:
	entry (a_rqt_dir, a_rqt_name, a_q_array);

/* There are currently six request types that are for the plotter.  This
   proc returns the sum of all the requests to be found in queue 1 for all
   the request types, and for queue 2 etc. */

	sum_array (*) = 0;
	do i = 1 to 6;
	     call odis_queue_$get_queue_counts (a_rqt_dir, plot_rqt (i), q_array);
	     sum_array (*) = sum_array (*) + q_array (*);
	end;
	
	a_q_array (*) = sum_array (*);
	
	return;
%page;

%include access_mode_values;

end operator_display_site_;




		    display_odst.pl1                02/14/84  1605.8rew 01/21/84  1736.4       47745



/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							     *
 *   Procedure to display the contents of an Operator Display Site Table   *
 *   segment. Usage is:					     *
 *   							     *
 *   	display_odst {-pn path} {-nhe}			     *
 *   							     *
 *   If pathname is not specified then we look for the default in	     *
 *   >sc1>odst.						     *
 *							     *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

/* Written  82-11-08 by A.G. Haggett (unca). */
/* Modified 82-12-18 by A.G. Haggett (unca) for "odst.site_id". */

display_odst:
     proc ();

     /* AUTOMATIC */
	dcl   arg_len	         fixed bin (21);
	dcl   arg_ptr	         pointer;
	dcl   arg_cnt	         fixed bin;
	dcl   arg_idx	         fixed bin;
	dcl   code	         fixed bin (35);
	dcl   date_time_string       char (24);
	dcl   dirname	         char (168);
	dcl   entname	         char (32);
	dcl   print_header_sw        bit (1);

     /* BASED */
	dcl   arg		         char (arg_len) based (arg_ptr);

     /* CONSTANT */
	dcl   ME		         char (12) init ("display_odst") static options (constant);

     /* ENTRIES/EXTERNAL */
	dcl   com_err_	         entry options (variable);
	dcl   cu_$arg_count	         entry (fixed bin, fixed bin (35));
	dcl   cu_$arg_ptr	         entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
	dcl   date_time_	         entry (fixed bin (71), char (*));
	dcl   expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
	dcl   hcs_$terminate_noname  entry (ptr, fixed bin (35));
	dcl   (ioa_, ioa_$nnl)       entry options (variable);
	dcl   initiate_file_         entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));
	dcl   sys_info$system_control_dir char (168) varying external static;

	dcl   (error_table_$noarg, error_table_$unimplemented_version, error_table_$badopt) fixed bin (35) ext static;

	dcl   cleanup	         condition;
	dcl   null	         builtin;
%page;
     /* Initialization and defaults. */
	dirname = sys_info$system_control_dir;
	entname = "odst";
	print_header_sw = "1"b;
	odst_ptr = null ();

	on cleanup call cleaner;

	call cu_$arg_count (arg_cnt, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME);
	     return;
	end;

	arg_idx = 1;

	do while (arg_idx <= arg_cnt);
	     call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, code);

	     if arg = "-nhe" | arg = "-no_header" then print_header_sw = "0"b;
	     else if arg = "-pn" | arg = "-pathname" then do;
		arg_idx = arg_idx + 1;
		if arg_idx > arg_cnt then do;
		     call com_err_ (error_table_$noarg, ME, "After ""^a"".", arg);
		     return;
		end;

		call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, code);

		call expand_pathname_$add_suffix (arg, "odst", dirname, entname, code);
		if code ^= 0 then do;
		     call com_err_ (code, ME, "^a", arg);
		     return;
		end;
	     end;

	     else do;
		call com_err_ (error_table_$badopt, ME, "Usage: ^a {-pn path} {-nhe}", ME);
		return;
	     end;

	     arg_idx = arg_idx + 1;
	end;

	call initiate_file_ (dirname, entname, R_ACCESS, odst_ptr, (0), code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, "^a>^a", dirname, entname);
	     return;
	end;

     /* We have all we need, so display it. Subr. will punt if necessary. */
	call display_table ();

RETURN:					     /* Subroutine exit. */
	call cleaner ();
	return;

%page;
display_table:
     proc ();

	dcl   i		         fixed bin;

     /* Check the version sentinel. */
	if odst.version ^= ODST_VERSION_1 then do;
	     call com_err_ (error_table_$unimplemented_version, ME, "^a>^a", dirname, entname);
	     goto RETURN;
	end;

	if print_header_sw then do;
	     call ioa_ ("/*  Derived from: ^a>^a  */", dirname, entname);
	     call ioa_ ("/*  Created by:   ^a  */", odst.author.proc_group_id);
	     call date_time_ (odst.time_created, date_time_string);
	     call ioa_ ("/*  Created on:   ^a  */^/", date_time_string);
	end;

     /* Display the "site_id" statement with parameter quoted just in case. */
	call ioa_ ("site_id:^2-""^a"";", odst.site_id);

     /* Display "display_rqt" statements. */
	do i = 1 to odst.tot_dis_rqts;
	     call ioa_ ("display_rqt:^-^[^a>^;^s^]^a;",
		(odst.dis_rqt.dir (i) ^= ""),
		odst.dis_rqt.dir (i),
		odst.dis_rqt.request_name (i));
	     if odst.dis_rqt.display_name (i) ^= "" then
		call ioa_ ("  display_name:^-  ^a;", odst.dis_rqt.display_name (i));
	     if odst.dis_rqt.entry (i) ^= "" then
		call ioa_ ("  entry:^2-  ^a;", odst.dis_rqt.entry (i));
	end;

     /* Now the "scan_rqts" statement. */
	if odst.tot_scan_rqts > 0 then do;
	     call ioa_$nnl ("^/scan_rqts:^-");

	     do i = 1 to (odst.tot_scan_rqts - 1);
		call ioa_$nnl ("^[^a>^;^s^]^a,",
		     (odst.scan_rqt.dir (i) ^= ""),
		     odst.scan_rqt.dir (i),
		     odst.scan_rqt.request_name (i));
	     end;

	     call ioa_$nnl ("^[^a>^;^s^]^a;^/",
		(odst.scan_rqt.dir (i) ^= ""),
		odst.scan_rqt.dir (i),
		odst.scan_rqt.request_name (i));

	end;

	call ioa_ ("^/end;");

	return;

     end display_table;
%page;
cleaner: proc;

	if odst_ptr ^= null then
	     call hcs_$terminate_noname (odst_ptr, code);
	return;

     end cleaner;
%page;
%include opr_display_site_table;
%page;
%include access_mode_values;

     end display_odst;




		    cv_odsf.rd                      05/24/83  2232.3rew 05/24/83  2232.3      162918



/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							       *
 *     Compile an ascii "O_perator D_isplay S_ite F_ile" into a binary           *
 *     "O_perator D_isplay S_ite T_able" segment.  We look for the suffix        *
 *     "odsf" and we create a segment with the "odst" suffix. This	       *
 *     segment must be installed in the directory checked by the	       *
 *     "operator_display" (usually >sc1), which can be set by the	       *
 *     "operator_display$test" entry. We accept the following types of       *
 *     statements other than the "end" statement:			       *
 *   							       *
 *	site_id:		SITE_ID;				       *
 *							       *
 *	display_rqt:	RQT_SPEC;				       *
 *	  display_name:	DISPLAY_NAME;			       *
 *	  entry:		ENTRYPOINT;			       *
 *   							       *
 *	scan_rqts:	RQT_SPEC1{,...RQT_SPECn};		       *
 *   							       *
 *     The "display_rqt" statement specifies a request_type which will       *
 *     appear as part of the standard display. The "scan_rqts" statement     *
 *     specifies request types to be checked by the "scan_queues" request.   *
 *							       *
 *							       *
 *     See "cv_odsf.info" for more info.			       *
 *							       *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

/* Written  82-11-08 by A.G. Haggett (unca). */
/* Modified 82-12-18 by A.G. Haggett (unca) for "site_id" statement. */
/* Modified 83-05-24 by S. G. Harris (UNCA) for MR10.1 author incl changes. */

%page;
/*++BEGIN
	/ <no-token>			/ ERROR (1)			/ RETURN \
	/ site_id : <any-token> ;		/ LEX (2) set_site_id NEXT_STMT	/ next_stmt \
	/ site_id :			/ ERROR (4) NEXT_STMT		/ next_stmt \
	/				/ ERROR (14) NEXT_STMT		/ next_stmt \
next_stmt
	/ ;				/ LEX				/ next_stmt \
	/ display_rqt : <valid_rqt_spec>	/ LEX (2) init_display_rqt LEX	/ display_rqt_stmts \
	/ display_rqt :			/ LEX (2) init_display_rqt NEXT_STMT	/ display_rqt_loop \
	/ scan_rqts   :			/ LEX (2) PUSH (next_stmt)		/ get_scan_rqts \
	/ end ;				/ LEX (2)				/ finished \
	/ <any-token> :			/ ERROR (3) NEXT_STMT		/ next_stmt \
	/ <any-token>			/ ERROR (4) NEXT_STMT		/ next_stmt \
unexpected_end
	/ <no-token>			/ ERROR (5)			/ RETURN \


display_rqt_stmts
	\"  Name has been parsed out. We should be looking at a ";"
	/				/ PUSH (display_rqt_loop)		/ semi_colon \
display_rqt_loop
	/ display_name : ;			/ NEXT_STMT			/ display_rqt_loop \
	/ display_name : <new_display_name> 	/ LEX (2) [odst.dis_rqt.display_name (odst.tot_dis_rqts) = token_value] 
					  LEX PUSH (display_rqt_loop)
									/ semi_colon \
	/ display_name :			/ LEX (2) NEXT_STMT			/ display_rqt_loop \
	/ entry : ;			/ NEXT_STMT			/ display_rqt_loop \
	/ entry : <entrypoint> 		/ LEX (2) [odst.dis_rqt.entry (odst.tot_dis_rqts) = token_value]
					  LEX PUSH (display_rqt_loop)
									/ semi_colon \
	/ entry :				/ LEX (2) NEXT_STMT			/ display_rqt_loop \
	/ <any-token>			/				/ next_stmt \
	/ <no-token>			/				/ unexpected_end \


semi_colon
	\"  Subr. to check that current token is (must be) a semi-colon.
	/ ;				/ LEX				/ STACK_POP \
	/ <any-token>			/ ERROR (4)			/ \
	/				/				/ STACK_POP \


get_scan_rqts
	/ ;				/ LEX				/ next_stmt \

scan_rqts_loop
	/ <valid_rqt_spec>			/ add_scan_rqt LEX			/ delim \
	/ <no-token>			/				/ unexpected_end \

delim
	/ ,				/ LEX				/ scan_rqts_loop \
	/ ;				/ LEX				/ STACK_POP \
	/ <any-token>			/ ERROR (12) NEXT_STMT		/ STACK_POP \
	/ <no-token>			/				/ unexpected_end \

finished
	/ <any-token>			/ ERROR (2)			/ RETURN \
	/ <no-token>			/				/ RETURN \

  \" end of reductions.
++*/
%page;
cv_odsf: proc;


     /*  ERROR CONTROL TABLE  */
     /* format: off */

dcl 1 error_control_table (15) aligned int static options (constant),
      2 severity	fixed bin (17) unal init (
	3,		/*  1   */
	2,		/*  2   */
	(2) 2,		/*  3,4 */
	3,		/*  5   */
	(10) 3),		/*  6-15 */

      2 Soutput_stmt bit (1) unal init (
	"0"b,		/*  1   */
	(3)(1) "1"b,	/*  2-4 */
	"0"b,		/*  5   */
	(7)(1) "1"b,	/*  6-12 */
	"0"b,		/*  13  */
          (2)(1) "1"b),	/*  14-15 */

      2 message	char (100) varying init (
	"Source file is empty.",			/*  1  */
	"Text follows the ""end"" statement.",
	"Keyword ""^a"" unrecognized or out of order.",
	"Syntax error.",				/*  4  */
	"Unexpected end of source file. No ""end"" statement encountered.",
	"Request type name is too long.",
	"Display name specified more than once.",
	"Display name is longer than 12 characters.",	/*  8  */
	"Bad absolute pathname specified.",
	"Syntax error in entrypoint name.",
	"Bad request type specification.",
	"Request type delimeter missing at or before ^a", /* 12 */
	"Too many ""display_rqt"" statements specified.",
	"Source file does not begin with a ""site_id"" statement.",
	"The parameter supplied in the ""site_id"" statement is too long."),

      2 brief_message char (30) varying init (
	"",					/*  1  */
	"",
	"^a",
	"",					/*  4  */
	"",
	(7)(1) "^a",			     	/*  5-12 */
	(3)(1)"");				/* 13-15 */


/* format: on */
%page;
     /* AUTOMATIC */
	dcl   arg_len	         fixed bin (21);
	dcl   arg_ptr	         pointer;
	dcl   arg_idx	         fixed bin;
	dcl   arg_cnt	         fixed bin;
	dcl   max_display_rqt_limit_stated
			         bit (1);	     /* Do not repeat this error message. */
	dcl   code	         fixed bin (35);
	dcl   (lex_temp_ptr, lex_stmt_ptr) pointer;

     /* Information about the input (source) segment. */
	dcl   1 odsf,			     /* OperatorDisplaySiteFile */
	        2 dirname	         char (168),
	        2 entname	         char (32),
	        2 bit_count	         fixed bin (24),
	        2 seg_ptr	         pointer;
	dcl   scan_rqt_copy_ptr      pointer;
	dcl   seg_created	         char (32);
	dcl   n_scan_rqts	         fixed bin;
	dcl   rqt_dir	         char (168);
	dcl   rqt_ent	         char (32);
	dcl   wdir	         char (168);

     /* BASED */
	dcl   arg		         char (arg_len) based (arg_ptr);
	dcl   1 scan_rqt_copy        (n_scan_rqts) like scan_rqt_entry based (scan_rqt_copy_ptr);

     /* CONSTANT */
	dcl   ME		         char (8) init ("cv_odsf") int static options (constant);
	dcl   WARNING_SEVERITY       fixed bin init (1) int static options (constant);

     /* STATIC */
	dcl   breaks	         char (39) varying int static;
	dcl   ctl_chars	         char (32) varying int static;
	dcl   first_time_static_sw   bit (1) static init ("1"b);
	dcl   (lexdlm, lexctl)       char (80) varying int static;

     /* ENTRIES */
	dcl   (com_err_, ioa_)       entry options (variable);
	dcl   cu_$arg_count	         entry (fixed bin, fixed bin (35));
	dcl   cu_$arg_ptr	         entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
	dcl   expand_pathname_       entry (char (*), char (*), char (*), fixed bin (35));
	dcl   expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
	dcl   get_group_id_	         entry () returns (char (32));
	dcl   get_process_id_        entry () returns (bit (36));
	dcl   get_temp_segment_      entry (char (*), ptr, fixed bin (35));
	dcl   get_wdir_	         entry () returns (char (168));
	dcl   hcs_$make_seg	         entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
	dcl   hcs_$set_bc_seg        entry (ptr, fixed bin (24), fixed bin (35));
	dcl   hcs_$truncate_seg      entry (ptr, fixed bin (18), fixed bin (35));
	dcl   hcs_$terminate_noname  entry (ptr, fixed bin (35));
	dcl   initiate_file_         entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));
	dcl   lex_string_$init_lex_delims entry (char (*), char (*), char (*), char (*), char (*), bit (*), char (*) varying aligned, char (*) varying aligned, char (*) varying aligned, char (*) varying aligned);
	dcl   lex_string_$lex        entry (ptr, fixed bin (21), fixed bin (21), ptr, bit (*), char (*), char (*), char (*), char (*), char (*), char (*) var aligned, char (*) var aligned, char (*) var aligned, char (*) var aligned, ptr, ptr, fixed bin (35));
	dcl   release_temp_segment_  entry (char (*), ptr, fixed bin (35));
	dcl   suffixed_name_$new_suffix entry (char (*), char (*), char (*), char (32), fixed bin (35));
	dcl   translator_temp_$get_segment entry (char (*) aligned, ptr, fixed bin (35));
	dcl   translator_temp_$release_all_segments entry (ptr, fixed bin (35));

	dcl   (error_table_$badopt, error_table_$translation_failed)
			         fixed bin (35) external static;

	dcl   cleanup	         condition;
	dcl   (clock, collate, currentsize, dimension, divide, index, maxlength, null, rtrim, search, substr, unspec) builtin;
%page;
%include opr_display_site_table;
%page;
%include access_mode_values;
%page;
%include opr_display_info;
%page;

     /* Get arguments. Usage is: cv_odsf path {-bf|-lg} */
	call cu_$arg_count (arg_cnt, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME);
	     return;
	end;

	if arg_cnt < 1 then do;		     /* Need that path. */
	     call com_err_ (0, ME, "Usage: ^a path {-brief|-long}", ME);
	     return;
	end;

     /* Get source segment argument. We expect the "odsf" suffix. */
	call cu_$arg_ptr (1, arg_ptr, arg_len, code);
	call expand_pathname_$add_suffix (arg, "odsf", odsf.dirname, odsf.entname, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, arg);
	     return;
	end;

	if arg_cnt > 1 then do arg_idx = 2 to arg_cnt;
		call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, code);

		if arg = "-bf" | arg = "-brief" then SERROR_CONTROL = "01"b;
		else if arg = "-lg" | arg = "-long" then SERROR_CONTROL = "10"b;

		else do;			     /* bad control arg. */
		     call com_err_ (error_table_$badopt, ME, arg);
		     return;
		end;

	     end;


     /* This points to the source file. */
	odsf.seg_ptr = null ();

     /* This point to the binary we will create -- "OperatorDisplaySiteData". */
	odst_ptr = null ();

     /* This points to a copy of the "scan_rqts" information. We copy it into the real thing on the way out. */
	scan_rqt_copy_ptr = null ();

     /* Translator temp used by "lex_string_". */
	lex_temp_ptr = null ();

	on cleanup call clean_up;		     /* We have to terminate/release segments.  */

     /* Find the source file. */
	call initiate_file_ (odsf.dirname, odsf.entname, R_ACCESS, odsf.seg_ptr, odsf.bit_count, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, "^a^[>^]^a", odsf.dirname, (odsf.dirname ^= ">"), odsf.entname);
	     return;
	end;

     /* All "return" must be done through "CLEAN_UP_RETURN" from now on. */

	call translation_prologue ();		     /* Will punt non-local. */

     /* Lexical analysis of the source. */
	call lex_string_$lex (odsf.seg_ptr, divide (odsf.bit_count, 9, 21, 0), 0, lex_temp_ptr, "1000"b, """", """", "/*", "*/", ";",
	     breaks, ctl_chars, lexdlm, lexctl, lex_stmt_ptr, Pthis_token, code);

	if code ^= 0 then do;
	     call com_err_ (code, ME, "- from lex_string_$lex.");
	     goto CLEAN_UP_RETURN;
	end;

     /* Reductio. */
	call SEMANTIC_ANALYSIS ();

     /* Can we proceed, or was there a fatal error? */
	if MERROR_SEVERITY > WARNING_SEVERITY then do;
	     call com_err_ (error_table_$translation_failed, ME, odsf.entname);
	     goto CLEAN_UP_RETURN;
	end;

     /* This was a "clean" conversion so fixup the binary (ie. relocation). */
	call translation_epilogue ();


CLEAN_UP_RETURN:
	call clean_up ();
	return;
%page;
translation_prologue:
     proc ();

     /* Create null binary segment. */
	wdir = get_wdir_ ();
	call suffixed_name_$new_suffix (odsf.entname, "odsf", "odst", seg_created, code);
	if code ^= 0 then goto CREATE_ERROR;
	call hcs_$make_seg (wdir, seg_created, "", RW_ACCESS_BIN, odst_ptr, code);
	if odst_ptr = null () then do;
CREATE_ERROR:
	     call com_err_ (code, ME, seg_created);
	     goto CLEAN_UP_RETURN;
	end;

	call hcs_$truncate_seg (odst_ptr, 0, code);
	if code ^= 0 then goto CREATE_ERROR;

     /* Get temp segment to place "scan_rqts" in. We copy it when we are fixing up on the way out. */
	call get_temp_segment_ (ME, scan_rqt_copy_ptr, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, "Creating temporary segment.");
	     goto CLEAN_UP_RETURN;
	end;

     /* Fill in what we can of the header information. */
	odst.author.proc_group_id = get_group_id_ ();
	odst.author.lock = "0"b;
	odst.author.last_install_time = clock ();
	odst.author.table = "ODST";
	odst.author.w_dir = wdir;
	odst.time_created = clock ();
	odst.site_id = "Multics";		     /* If we are given "". */
	odst.tot_dis_rqts, odst.tot_scan_rqts, n_scan_rqts = 0;

     /* We have not slewed this fatal error yet. May never... */
	max_display_rqt_limit_stated = "0"b;

     /* Get a segment for "lex_string_" to work with. */
	call translator_temp_$get_segment ((ME), lex_temp_ptr, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, "Creating lex_string_ temporary segment.");
	     goto CLEAN_UP_RETURN;
	end;

	if first_time_static_sw then do;	     /* Once per process. */
	     first_time_static_sw = ^first_time_static_sw;
	     ctl_chars = substr (collate (), 1, 8) || substr (collate (), 10, 24);
	     breaks = ctl_chars || "()*,:;=";
	     call lex_string_$init_lex_delims ("""", """", "/*", "*/", ";", "10"b, breaks, ctl_chars, lexdlm, lexctl);
	end;

	return;

     end translation_prologue;
%page;
translation_epilogue:
     proc ();

     /* Copy "scan_rqts" into table. */
	if n_scan_rqts > 0 then do;		     /* some specified */
	     odst.tot_scan_rqts = n_scan_rqts;
	     unspec (odst.scan_rqt (*)) = unspec (scan_rqt_copy (*));
	end;

     /* The version sentinel says this table converted cleanly. */
	odst.version = ODST_VERSION_1;

     /* Set the bit count. */
	call hcs_$set_bc_seg (odst_ptr, 36 * currentsize (odst), code);
	if code ^= 0 then
	     call com_err_ (code, ME, "Setting bit count of table.");

	return;
     end translation_epilogue;
%page;
clean_up: proc ();

	if lex_temp_ptr ^= null then
	     call translator_temp_$release_all_segments (lex_temp_ptr, code);

	if scan_rqt_copy_ptr ^= null () then
	     call release_temp_segment_ (ME, scan_rqt_copy_ptr, code);

	if odst_ptr ^= null then
	     call hcs_$terminate_noname (odst_ptr, code);

	return;

     end clean_up;
%page;
     /*	SYNTAX FUNCTIONS	   */



/****^ * * * * * * * * * *  NEW_DISPLAY_RQT  * * * * * * * * * * */

valid_rqt_spec:
     proc () returns (bit (1) aligned);

	dcl   i		         fixed bin;

     /* This entry must set the variables "rqt_dir" and "rqt_ent" to be used by action routine. */

	rqt_dir, rqt_ent = "";

     /* We accept an absolute path or a request type name. */
	if substr (token_value, 1, 1) = ">" then do;
	     call expand_pathname_ (token_value, rqt_dir, rqt_ent, code);
	     if code ^= 0 then call error_return (9);/* Bad abs. path */
	     if length (rtrim (rqt_ent)) > 27 then call error_return (6);
	     goto TRUE;
	end;
	else do;				     /* not abs. path */
					     /* request_type name cannot be longer than 27 characters. */
	     if token.Lvalue > 27 then call error_return (6);

	     if search (token_value, ";>") > 0 then call error_return (11);
	     rqt_ent = token_value;
	end;

	goto TRUE;


TRUE:	return ("1"b);
FALSE:	return ("0"b);




error_return:
	proc (err_no);

	     dcl	 err_no		    fixed bin parameter;

	     call ERROR (err_no);
	     goto FALSE;			     /* punt non-local */

	end error_return;





/****^ * * * * * * * * * *  DISPLAY_NAME  * * * * * * * * * * */

new_display_name:
     entry () returns (bit (1) aligned);

     /* Check the name she wishes to appear on the display. */
	if token.Lvalue > maxlength (odst.dis_rqt.display_name (1)) then do;
	     call ERROR (8);		     /* 12 chars. max */
	     goto FALSE;
	end;


	do i = 1 to odst.tot_dis_rqts;	     /* check duplicate */
	     if token_value = odst.dis_rqt.display_name (i) then do;
		call ERROR (7);
		goto FALSE;
	     end;
	end;

     /* Assume it contains window_ acceptable characters. */
	goto TRUE;




/****^ * * * * * * * * * *  ENTRYPOINT  * * * * * * * * * * */

entrypoint:
     entry () returns (bit (1) aligned);

     /* Looking for something we can convert to entry value of the form "segname{$entrypoint}" */
	i = index (token_value, "$");
	if i > 32 | i = 1 | (token.Lvalue - i) > 32 then do;
	     call ERROR (10);
	     goto FALSE;
	end;

	goto TRUE;

     end valid_rqt_spec;
%page;
     /*	ACTION ROUTINES	   */



/****^ * * * * * * * * * *  SET_SITE_ID  * * * * * * * * * * */
     
set_site_id: proc ();

     /*  Check length and "nullness". */
	if token.Lvalue > maxlength (odst.site_id) then do;
	     call ERROR (15);
	     return;
	end;
	if token_value ^= "" then odst.site_id = token_value;

	return;
     end set_site_id;





/****^ * * * * * * * * * *  INIT_DISPLAY_RQT  * * * * * * * * * * */

init_display_rqt:
     proc ();

     /* Set up for the next display rqt entry. The variables "rqt_dir" and "rqt_ent" have been set by action routine. */
	odst.tot_dis_rqts = odst.tot_dis_rqts + 1;

     /* Check that the operator_display can handle this many display_rqt's. */
     /* The value "MAX_REQUEST_TYPES_IN_DISPLAY" comes from the include     */
     /* "opr_display_info". "max_display_rqt_limit_stated" prevents us from */
     /* repeating the error message. */
	if odst.tot_dis_rqts > MAX_REQUEST_TYPES_IN_DISPLAY then
	     if ^max_display_rqt_limit_stated then do;
		call ERROR (13);		     /* "rd" type error. */
		call ioa_ ("The maximum display request types allowed is ^d.", MAX_REQUEST_TYPES_IN_DISPLAY);
		max_display_rqt_limit_stated = "1"b;
	     end;

	odst.dis_rqt.request_name (odst.tot_dis_rqts) = rqt_ent;
	odst.dis_rqt.dir (odst.tot_dis_rqts) = rqt_dir;
	odst.dis_rqt.display_name (odst.tot_dis_rqts) = "";
	odst.dis_rqt.entry (odst.tot_dis_rqts) = "";
	return;

     end init_display_rqt;




/****^ * * * * * * * * * *  ADD_SCAN_RQT  * * * * * * * * * * */

add_scan_rqt:
     proc ();

     /* The variables "rqt_dir" and "rqt_ent" have been set by "valid_rqt_spec". */
	odst.tot_scan_rqts = odst.tot_scan_rqts + 1;
	odst.scan_rqt.request_name (odst.tot_scan_rqts) = rqt_ent;
	odst.scan_rqt.dir (odst.tot_scan_rqts) = rqt_dir;
	return;

     end add_scan_rqt;





		    opr_display_info.incl.pl1       02/14/84  1605.9rew 01/21/84  1741.5       39015



/* BEGIN INCLUDE FILE ... operator_display_info.incl.pl1 */
/* Created 82-09-10 by A.G. Haggett (unca) */
/* Modified 82-11-03 by A.G. Haggett (unca) to move site information into "opr_display_site_table.incl.pl1". */

/* Various structures and data used by the operator display subsystem. */

dcl odis_info_ptr pointer automatic;

dcl 1 odis_info aligned based (odis_info_ptr),
      2 ttp		char (32) unal,	     /* terminal type. */
      2 display_mode	fixed bin,	     /* type of display. */
      2 prompt		char (36) varying,	     /* "odis: "  */
      2 quit_pending	bit (1),		     /* QUIT to handle? */
      2 quit_restart	bit (1),		     /* From QUIT or "pi" */
      2 executing_request	bit (1),		     /* if we are... */
      2 abort_code		fixed bin (35),	     /* these 2 checked... */
      2 abort_reason	char (128),	     /* ...by cmd. module. */
      2 ssu,				     /* Subsys. Util. related. */
        3 sci_ptr		pointer,
        3 invocation_level_c	char (4) varying,	     /* recursion level >= 1 */
        3 abort_label	label,		     /* where does "q" go? */
      2 video,				     /* video related. */
        3 was_in_video	bit (1),		     /* when odis called. */
        3 video_on		bit (1),		     /* do we have it? */
        3 windows_made	bit (1),		     /* are windows created? */
        3 saved_user_io_ptr	pointer,		     /* we move user_i/o  */
        3 saved_err_output_ptr pointer,		     /* and error_output. */
        3 dis_window_info	like window_position_info,
        3 dis_window_iocb	pointer,		     /* iocb pointer. */
        3 dis_window_name	char (32) unal,	     /* "odisN.dis_window" */
        3 mini_window_info	like window_position_info,
        3 mini_window_iocb	pointer,
        3 mini_window_name	char (32) unal,	     /* "odisN.mini_window" */
      2 mini_window_shut	bit (1),		     /* mini window shut? */
      2 mini_window_open_n	fixed bin,	     /* see odis_window_ */
      2 timer_cycle_n	fixed bin,	     /* from 1 to 6. */
      2 display_off		bit (1),		     /* DO NOT REDISPLAY */
      2 rcp_sys_moderr	bit (1),		     /* See "odis_rcp_". */
      2 display_data_ptr	pointer,		     /* "odis_display_data" structure */
      2 site_table_ptr	pointer;		     /* to "odst" segment */


/*  This is the data used by odis_rdis_update_ and friends. */

dcl odis_display_data_ptr	pointer automatic;
dcl 1 odis_display_data	aligned based (odis_display_data_ptr),
      2 first_per_mode_line		fixed bin,     /* from this to end. */
      2 mounted_tapes_line		fixed bin,     /* where is info? */
      2 saved_pending_mount_count	fixed bin,     /* how many last check? */
      2 saved_pending_mount_vols (ODIS_PENDING_MOUNT_LIMIT)
				char (32) unal,	/* volume names */
      2 saved_pending_mount_devs (ODIS_PENDING_MOUNT_LIMIT)
				char (8) unal,	/* device names */
      2 saved_queue_data	(MAX_REQUEST_TYPES_IN_DISPLAY),
        3 counts		fixed bin (71),	     /* array of 4 fb(17) */
        3 skip_update	fixed bin,	     /* do not update ck. */
      2 rcp_data		(48*1024) bit (36) unaligned, /* 48 pages     */
      2 window_image			     /* the actual image  */
	  	  (odis_info.dis_window_info.height)	     /* rows    */
		  char (odis_info.dis_window_info.width)     /* columns */
		  unaligned;


/*  This next structure us used by odis_rcp_ and odis_rdis_update_ to  */
/*  communicate information about pending mounts.			 */
/*							 */
/*  The limit of 8 below refers to the most pending mounts the display */
/*  is ever willing to handle.				 */

dcl ODIS_PENDING_MOUNT_LIMIT fixed bin init (8) static options (constant);
dcl 1 odis_pending_mount_data aligned based,
      2 volume_name		char (32),	     /* ie. VC1981.  */
      2 device_name		char (8),		     /* ie. tapa_01. */
      2 protect_sw		bit (1) unal,	     /* or ring. */
      2 tape_sw		bit (1) unal,	     /* for tape mount. */
      2 pad		bit (34) unal,
      2 for_who		char (32);	     /* group id. */

/* This constant refers to the maximum number of request type we are willing */
/* to display queue counts for (in the display window). This value is used   */
/* by this include and by "cv_odsf" to enforce the limit.		       */
dcl MAX_REQUEST_TYPES_IN_DISPLAY fixed bin init (18) static options (constant);
%page;
%include window_control_info;

/* END INCLUDE FILE ... operator_display_info.incl.pl1 */ 




		    opr_display_site_table.incl.pl1 02/14/84  1605.9rew 01/21/84  1745.8       10845



/*  BEGIN INCLUDE FILE ... opr_display_site_data.incl.pl1 */

/*  Created 82-10-14 by A.G. Haggett (split off from opr_display_info.incl.pl1) for new "cv_odsf" technology. */
/*  Modified 82-12-18 by A.G. Haggett for "odst.site_id". */

dcl ODST_VERSION_1  init ("ODST_1") char (8) int static options (constant);
dcl odst_ptr	pointer;

dcl 1 odst		based (odst_ptr) aligned,
      2 author		like author_dcl.author,
      2 version		char (8),
      2 time_created	fixed bin (71),
      2 site_id		char (27),	/* ie. "University of Calgary" */
      2 tot_dis_rqts	fixed bin,	/* # of display rqt's. */
      2 tot_scan_rqts	fixed bin,	/* # of rqt's scanned by "sq" request. */
      2 dis_rqt		(0 refer (odst.tot_dis_rqts)) like display_rqt_entry,
      2 scan_rqt		(0 refer (odst.tot_scan_rqts)) like scan_rqt_entry;

dcl 1 display_rqt_entry	aligned based,
      2 request_name	char (27) unaligned,
      2 display_name	char (12) unaligned,
      2 dir		char (168) unaligned,
      2 entry		char (65) unaligned;

dcl 1 scan_rqt_entry	aligned based,
      2 request_name	char (27) unaligned,
      2 dir		char (168) unaligned;


%include author_dcl;
/*  END INCLUDE FILE ... opr_display_site_data.incl.pl1 */




		    cv_odsf.pl1                     02/14/84  1605.9r   02/12/84  1958.7      278541





	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*							*/
	/* COMPILED OUTPUT OF SEGMENT  cv_odsf.rd                      	*/
	/* Compiled by:  reduction_compiler, Version 2.3 of July 23, 1983     */
	/* Compiled on:  02/12/84  1958.7 mst Sun        			*/
	/*							*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *   							       *
 *     Compile an ascii "O_perator D_isplay S_ite F_ile" into a binary           *
 *     "O_perator D_isplay S_ite T_able" segment.  We look for the suffix        *
 *     "odsf" and we create a segment with the "odst" suffix. This	       *
 *     segment must be installed in the directory checked by the	       *
 *     "operator_display" (usually >sc1), which can be set by the	       *
 *     "operator_display$test" entry. We accept the following types of       *
 *     statements other than the "end" statement:			       *
 *   							       *
 *	site_id:		SITE_ID;				       *
 *							       *
 *	display_rqt:	RQT_SPEC;				       *
 *	  display_name:	DISPLAY_NAME;			       *
 *	  entry:		ENTRYPOINT;			       *
 *   							       *
 *	scan_rqts:	RQT_SPEC1{,...RQT_SPECn};		       *
 *   							       *
 *     The "display_rqt" statement specifies a request_type which will       *
 *     appear as part of the standard display. The "scan_rqts" statement     *
 *     specifies request types to be checked by the "scan_queues" request.   *
 *							       *
 *							       *
 *     See "cv_odsf.info" for more info.			       *
 *							       *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

/* Written  82-11-08 by A.G. Haggett (unca). */
/* Modified 82-12-18 by A.G. Haggett (unca) for "site_id" statement. */
/* Modified 83-05-24 by S. G. Harris (UNCA) for MR10.1 author incl changes. */

%page;
/*++BEGIN
1	/ <no-token>			/ ERROR (1)			/ RETURN \
2	/ site_id : <any-token> ;		/ LEX (2) set_site_id NEXT_STMT	/ next_stmt \
3	/ site_id :			/ ERROR (4) NEXT_STMT		/ next_stmt \
4	/				/ ERROR (14) NEXT_STMT		/ next_stmt \
next_stmt
5	/ ;				/ LEX				/ next_stmt \
6	/ display_rqt : <valid_rqt_spec>	/ LEX (2) init_display_rqt LEX	/ display_rqt_stmts \
7	/ display_rqt :			/ LEX (2) init_display_rqt NEXT_STMT	/ display_rqt_loop \
8	/ scan_rqts   :			/ LEX (2) PUSH (next_stmt)		/ get_scan_rqts \
9	/ end ;				/ LEX (2)				/ finished \
10	/ <any-token> :			/ ERROR (3) NEXT_STMT		/ next_stmt \
11	/ <any-token>			/ ERROR (4) NEXT_STMT		/ next_stmt \
unexpected_end
12	/ <no-token>			/ ERROR (5)			/ RETURN \


display_rqt_stmts
13	\"  Name has been parsed out. We should be looking at a ";"
	/				/ PUSH (display_rqt_loop)		/ semi_colon \
display_rqt_loop
14	/ display_name : ;			/ NEXT_STMT			/ display_rqt_loop \
15	/ display_name : <new_display_name> 	/ LEX (2) [odst.dis_rqt.display_name (odst.tot_dis_rqts) = token_value] 
					  LEX PUSH (display_rqt_loop)
									/ semi_colon \
16	/ display_name :			/ LEX (2) NEXT_STMT			/ display_rqt_loop \
17	/ entry : ;			/ NEXT_STMT			/ display_rqt_loop \
18	/ entry : <entrypoint> 		/ LEX (2) [odst.dis_rqt.entry (odst.tot_dis_rqts) = token_value]
					  LEX PUSH (display_rqt_loop)
									/ semi_colon \
19	/ entry :				/ LEX (2) NEXT_STMT			/ display_rqt_loop \
20	/ <any-token>			/				/ next_stmt \
21	/ <no-token>			/				/ unexpected_end \


semi_colon
22	\"  Subr. to check that current token is (must be) a semi-colon.
	/ ;				/ LEX				/ STACK_POP \
23	/ <any-token>			/ ERROR (4)			/ \
24	/				/				/ STACK_POP \


get_scan_rqts
25	/ ;				/ LEX				/ next_stmt \

scan_rqts_loop
26	/ <valid_rqt_spec>			/ add_scan_rqt LEX			/ delim \
27	/ <no-token>			/				/ unexpected_end \

delim
28	/ ,				/ LEX				/ scan_rqts_loop \
29	/ ;				/ LEX				/ STACK_POP \
30	/ <any-token>			/ ERROR (12) NEXT_STMT		/ STACK_POP \
31	/ <no-token>			/				/ unexpected_end \

finished
32	/ <any-token>			/ ERROR (2)			/ RETURN \
33	/ <no-token>			/				/ RETURN \

  \" end of reductions.
++*/
%page;
cv_odsf: proc;


     /*  ERROR CONTROL TABLE  */
     /* format: off */

dcl 1 error_control_table (15) aligned int static options (constant),
      2 severity	fixed bin (17) unal init (
	3,		/*  1   */
	2,		/*  2   */
	(2) 2,		/*  3,4 */
	3,		/*  5   */
	(10) 3),		/*  6-15 */

      2 Soutput_stmt bit (1) unal init (
	"0"b,		/*  1   */
	(3)(1) "1"b,	/*  2-4 */
	"0"b,		/*  5   */
	(7)(1) "1"b,	/*  6-12 */
	"0"b,		/*  13  */
          (2)(1) "1"b),	/*  14-15 */

      2 message	char (100) varying init (
	"Source file is empty.",			/*  1  */
	"Text follows the ""end"" statement.",
	"Keyword ""^a"" unrecognized or out of order.",
	"Syntax error.",				/*  4  */
	"Unexpected end of source file. No ""end"" statement encountered.",
	"Request type name is too long.",
	"Display name specified more than once.",
	"Display name is longer than 12 characters.",	/*  8  */
	"Bad absolute pathname specified.",
	"Syntax error in entrypoint name.",
	"Bad request type specification.",
	"Request type delimeter missing at or before ^a", /* 12 */
	"Too many ""display_rqt"" statements specified.",
	"Source file does not begin with a ""site_id"" statement.",
	"The parameter supplied in the ""site_id"" statement is too long."),

      2 brief_message char (30) varying init (
	"",					/*  1  */
	"",
	"^a",
	"",					/*  4  */
	"",
	(7)(1) "^a",			     	/*  5-12 */
	(3)(1)"");				/* 13-15 */


/* format: on */
%page;
     /* AUTOMATIC */
	dcl   arg_len	         fixed bin (21);
	dcl   arg_ptr	         pointer;
	dcl   arg_idx	         fixed bin;
	dcl   arg_cnt	         fixed bin;
	dcl   max_display_rqt_limit_stated
			         bit (1);	     /* Do not repeat this error message. */
	dcl   code	         fixed bin (35);
	dcl   (lex_temp_ptr, lex_stmt_ptr) pointer;

     /* Information about the input (source) segment. */
	dcl   1 odsf,			     /* OperatorDisplaySiteFile */
	        2 dirname	         char (168),
	        2 entname	         char (32),
	        2 bit_count	         fixed bin (24),
	        2 seg_ptr	         pointer;
	dcl   scan_rqt_copy_ptr      pointer;
	dcl   seg_created	         char (32);
	dcl   n_scan_rqts	         fixed bin;
	dcl   rqt_dir	         char (168);
	dcl   rqt_ent	         char (32);
	dcl   wdir	         char (168);

     /* BASED */
	dcl   arg		         char (arg_len) based (arg_ptr);
	dcl   1 scan_rqt_copy        (n_scan_rqts) like scan_rqt_entry based (scan_rqt_copy_ptr);

     /* CONSTANT */
	dcl   ME		         char (8) init ("cv_odsf") int static options (constant);
	dcl   WARNING_SEVERITY       fixed bin init (1) int static options (constant);

     /* STATIC */
	dcl   breaks	         char (39) varying int static;
	dcl   ctl_chars	         char (32) varying int static;
	dcl   first_time_static_sw   bit (1) static init ("1"b);
	dcl   (lexdlm, lexctl)       char (80) varying int static;

     /* ENTRIES */
	dcl   (com_err_, ioa_)       entry options (variable);
	dcl   cu_$arg_count	         entry (fixed bin, fixed bin (35));
	dcl   cu_$arg_ptr	         entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
	dcl   expand_pathname_       entry (char (*), char (*), char (*), fixed bin (35));
	dcl   expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
	dcl   get_group_id_	         entry () returns (char (32));
	dcl   get_process_id_        entry () returns (bit (36));
	dcl   get_temp_segment_      entry (char (*), ptr, fixed bin (35));
	dcl   get_wdir_	         entry () returns (char (168));
	dcl   hcs_$make_seg	         entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
	dcl   hcs_$set_bc_seg        entry (ptr, fixed bin (24), fixed bin (35));
	dcl   hcs_$truncate_seg      entry (ptr, fixed bin (18), fixed bin (35));
	dcl   hcs_$terminate_noname  entry (ptr, fixed bin (35));
	dcl   initiate_file_         entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));
	dcl   lex_string_$init_lex_delims entry (char (*), char (*), char (*), char (*), char (*), bit (*), char (*) varying aligned, char (*) varying aligned, char (*) varying aligned, char (*) varying aligned);
	dcl   lex_string_$lex        entry (ptr, fixed bin (21), fixed bin (21), ptr, bit (*), char (*), char (*), char (*), char (*), char (*), char (*) var aligned, char (*) var aligned, char (*) var aligned, char (*) var aligned, ptr, ptr, fixed bin (35));
	dcl   release_temp_segment_  entry (char (*), ptr, fixed bin (35));
	dcl   suffixed_name_$new_suffix entry (char (*), char (*), char (*), char (32), fixed bin (35));
	dcl   translator_temp_$get_segment entry (char (*) aligned, ptr, fixed bin (35));
	dcl   translator_temp_$release_all_segments entry (ptr, fixed bin (35));

	dcl   (error_table_$badopt, error_table_$translation_failed)
			         fixed bin (35) external static;

	dcl   cleanup	         condition;
	dcl   (clock, collate, currentsize, dimension, divide, index, maxlength, null, rtrim, search, substr, unspec) builtin;
%page;
%include opr_display_site_table;
%page;
%include access_mode_values;
%page;
%include opr_display_info;
%page;

     /* Get arguments. Usage is: cv_odsf path {-bf|-lg} */
	call cu_$arg_count (arg_cnt, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME);
	     return;
	end;

	if arg_cnt < 1 then do;		     /* Need that path. */
	     call com_err_ (0, ME, "Usage: ^a path {-brief|-long}", ME);
	     return;
	end;

     /* Get source segment argument. We expect the "odsf" suffix. */
	call cu_$arg_ptr (1, arg_ptr, arg_len, code);
	call expand_pathname_$add_suffix (arg, "odsf", odsf.dirname, odsf.entname, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, arg);
	     return;
	end;

	if arg_cnt > 1 then do arg_idx = 2 to arg_cnt;
		call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, code);

		if arg = "-bf" | arg = "-brief" then SERROR_CONTROL = "01"b;
		else if arg = "-lg" | arg = "-long" then SERROR_CONTROL = "10"b;

		else do;			     /* bad control arg. */
		     call com_err_ (error_table_$badopt, ME, arg);
		     return;
		end;

	     end;


     /* This points to the source file. */
	odsf.seg_ptr = null ();

     /* This point to the binary we will create -- "OperatorDisplaySiteData". */
	odst_ptr = null ();

     /* This points to a copy of the "scan_rqts" information. We copy it into the real thing on the way out. */
	scan_rqt_copy_ptr = null ();

     /* Translator temp used by "lex_string_". */
	lex_temp_ptr = null ();

	on cleanup call clean_up;		     /* We have to terminate/release segments.  */

     /* Find the source file. */
	call initiate_file_ (odsf.dirname, odsf.entname, R_ACCESS, odsf.seg_ptr, odsf.bit_count, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, "^a^[>^]^a", odsf.dirname, (odsf.dirname ^= ">"), odsf.entname);
	     return;
	end;

     /* All "return" must be done through "CLEAN_UP_RETURN" from now on. */

	call translation_prologue ();		     /* Will punt non-local. */

     /* Lexical analysis of the source. */
	call lex_string_$lex (odsf.seg_ptr, divide (odsf.bit_count, 9, 21, 0), 0, lex_temp_ptr, "1000"b, """", """", "/*", "*/", ";",
	     breaks, ctl_chars, lexdlm, lexctl, lex_stmt_ptr, Pthis_token, code);

	if code ^= 0 then do;
	     call com_err_ (code, ME, "- from lex_string_$lex.");
	     goto CLEAN_UP_RETURN;
	end;

     /* Reductio. */
	call SEMANTIC_ANALYSIS ();

     /* Can we proceed, or was there a fatal error? */
	if MERROR_SEVERITY > WARNING_SEVERITY then do;
	     call com_err_ (error_table_$translation_failed, ME, odsf.entname);
	     goto CLEAN_UP_RETURN;
	end;

     /* This was a "clean" conversion so fixup the binary (ie. relocation). */
	call translation_epilogue ();


CLEAN_UP_RETURN:
	call clean_up ();
	return;
%page;
translation_prologue:
     proc ();

     /* Create null binary segment. */
	wdir = get_wdir_ ();
	call suffixed_name_$new_suffix (odsf.entname, "odsf", "odst", seg_created, code);
	if code ^= 0 then goto CREATE_ERROR;
	call hcs_$make_seg (wdir, seg_created, "", RW_ACCESS_BIN, odst_ptr, code);
	if odst_ptr = null () then do;
CREATE_ERROR:
	     call com_err_ (code, ME, seg_created);
	     goto CLEAN_UP_RETURN;
	end;

	call hcs_$truncate_seg (odst_ptr, 0, code);
	if code ^= 0 then goto CREATE_ERROR;

     /* Get temp segment to place "scan_rqts" in. We copy it when we are fixing up on the way out. */
	call get_temp_segment_ (ME, scan_rqt_copy_ptr, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, "Creating temporary segment.");
	     goto CLEAN_UP_RETURN;
	end;

     /* Fill in what we can of the header information. */
	odst.author.proc_group_id = get_group_id_ ();
	odst.author.lock = "0"b;
	odst.author.last_install_time = clock ();
	odst.author.table = "ODST";
	odst.author.w_dir = wdir;
	odst.time_created = clock ();
	odst.site_id = "Multics";		     /* If we are given "". */
	odst.tot_dis_rqts, odst.tot_scan_rqts, n_scan_rqts = 0;

     /* We have not slewed this fatal error yet. May never... */
	max_display_rqt_limit_stated = "0"b;

     /* Get a segment for "lex_string_" to work with. */
	call translator_temp_$get_segment ((ME), lex_temp_ptr, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, "Creating lex_string_ temporary segment.");
	     goto CLEAN_UP_RETURN;
	end;

	if first_time_static_sw then do;	     /* Once per process. */
	     first_time_static_sw = ^first_time_static_sw;
	     ctl_chars = substr (collate (), 1, 8) || substr (collate (), 10, 24);
	     breaks = ctl_chars || "()*,:;=";
	     call lex_string_$init_lex_delims ("""", """", "/*", "*/", ";", "10"b, breaks, ctl_chars, lexdlm, lexctl);
	end;

	return;

     end translation_prologue;
%page;
translation_epilogue:
     proc ();

     /* Copy "scan_rqts" into table. */
	if n_scan_rqts > 0 then do;		     /* some specified */
	     odst.tot_scan_rqts = n_scan_rqts;
	     unspec (odst.scan_rqt (*)) = unspec (scan_rqt_copy (*));
	end;

     /* The version sentinel says this table converted cleanly. */
	odst.version = ODST_VERSION_1;

     /* Set the bit count. */
	call hcs_$set_bc_seg (odst_ptr, 36 * currentsize (odst), code);
	if code ^= 0 then
	     call com_err_ (code, ME, "Setting bit count of table.");

	return;
     end translation_epilogue;
%page;
clean_up: proc ();

	if lex_temp_ptr ^= null then
	     call translator_temp_$release_all_segments (lex_temp_ptr, code);

	if scan_rqt_copy_ptr ^= null () then
	     call release_temp_segment_ (ME, scan_rqt_copy_ptr, code);

	if odst_ptr ^= null then
	     call hcs_$terminate_noname (odst_ptr, code);

	return;

     end clean_up;
%page;
     /*	SYNTAX FUNCTIONS	   */



/****^ * * * * * * * * * *  NEW_DISPLAY_RQT  * * * * * * * * * * */

valid_rqt_spec:
     proc () returns (bit (1) aligned);

	dcl   i		         fixed bin;

     /* This entry must set the variables "rqt_dir" and "rqt_ent" to be used by action routine. */

	rqt_dir, rqt_ent = "";

     /* We accept an absolute path or a request type name. */
	if substr (token_value, 1, 1) = ">" then do;
	     call expand_pathname_ (token_value, rqt_dir, rqt_ent, code);
	     if code ^= 0 then call error_return (9);/* Bad abs. path */
	     if length (rtrim (rqt_ent)) > 27 then call error_return (6);
	     goto TRUE;
	end;
	else do;				     /* not abs. path */
					     /* request_type name cannot be longer than 27 characters. */
	     if token.Lvalue > 27 then call error_return (6);

	     if search (token_value, ";>") > 0 then call error_return (11);
	     rqt_ent = token_value;
	end;

	goto TRUE;


TRUE:	return ("1"b);
FALSE:	return ("0"b);




error_return:
	proc (err_no);

	     dcl	 err_no		    fixed bin parameter;

	     call ERROR (err_no);
	     goto FALSE;			     /* punt non-local */

	end error_return;





/****^ * * * * * * * * * *  DISPLAY_NAME  * * * * * * * * * * */

new_display_name:
     entry () returns (bit (1) aligned);

     /* Check the name she wishes to appear on the display. */
	if token.Lvalue > maxlength (odst.dis_rqt.display_name (1)) then do;
	     call ERROR (8);		     /* 12 chars. max */
	     goto FALSE;
	end;


	do i = 1 to odst.tot_dis_rqts;	     /* check duplicate */
	     if token_value = odst.dis_rqt.display_name (i) then do;
		call ERROR (7);
		goto FALSE;
	     end;
	end;

     /* Assume it contains window_ acceptable characters. */
	goto TRUE;




/****^ * * * * * * * * * *  ENTRYPOINT  * * * * * * * * * * */

entrypoint:
     entry () returns (bit (1) aligned);

     /* Looking for something we can convert to entry value of the form "segname{$entrypoint}" */
	i = index (token_value, "$");
	if i > 32 | i = 1 | (token.Lvalue - i) > 32 then do;
	     call ERROR (10);
	     goto FALSE;
	end;

	goto TRUE;

     end valid_rqt_spec;
%page;
     /*	ACTION ROUTINES	   */



/****^ * * * * * * * * * *  SET_SITE_ID  * * * * * * * * * * */
     
set_site_id: proc ();

     /*  Check length and "nullness". */
	if token.Lvalue > maxlength (odst.site_id) then do;
	     call ERROR (15);
	     return;
	end;
	if token_value ^= "" then odst.site_id = token_value;

	return;
     end set_site_id;





/****^ * * * * * * * * * *  INIT_DISPLAY_RQT  * * * * * * * * * * */

init_display_rqt:
     proc ();

     /* Set up for the next display rqt entry. The variables "rqt_dir" and "rqt_ent" have been set by action routine. */
	odst.tot_dis_rqts = odst.tot_dis_rqts + 1;

     /* Check that the operator_display can handle this many display_rqt's. */
     /* The value "MAX_REQUEST_TYPES_IN_DISPLAY" comes from the include     */
     /* "opr_display_info". "max_display_rqt_limit_stated" prevents us from */
     /* repeating the error message. */
	if odst.tot_dis_rqts > MAX_REQUEST_TYPES_IN_DISPLAY then
	     if ^max_display_rqt_limit_stated then do;
		call ERROR (13);		     /* "rd" type error. */
		call ioa_ ("The maximum display request types allowed is ^d.", MAX_REQUEST_TYPES_IN_DISPLAY);
		max_display_rqt_limit_stated = "1"b;
	     end;

	odst.dis_rqt.request_name (odst.tot_dis_rqts) = rqt_ent;
	odst.dis_rqt.dir (odst.tot_dis_rqts) = rqt_dir;
	odst.dis_rqt.display_name (odst.tot_dis_rqts) = "";
	odst.dis_rqt.entry (odst.tot_dis_rqts) = "";
	return;

     end init_display_rqt;




/****^ * * * * * * * * * *  ADD_SCAN_RQT  * * * * * * * * * * */

add_scan_rqt:
     proc ();

     /* The variables "rqt_dir" and "rqt_ent" have been set by "valid_rqt_spec". */
	odst.tot_scan_rqts = odst.tot_scan_rqts + 1;
	odst.scan_rqt.request_name (odst.tot_scan_rqts) = rqt_ent;
	odst.scan_rqt.dir (odst.tot_scan_rqts) = rqt_dir;
	return;

     end add_scan_rqt;



     dcl	TRACING			bit(1) aligned int static init("0"b);


%include rdc_start_;

     dcl	DIRECTION			fixed bin init(+1);	/* direction in which tokens compared.		*/
     dcl	STACK (10)   		fixed bin,	/* reduction label stack.			*/
	STACK_DEPTH		fixed bin init (0);	/* index into STACK.			*/


     dcl	1 REDUCTION (33)		unaligned based (addr (REDUCTIONS)),
						/* object reductions.			*/
	  2 TOKEN_REQD,
	    3 IFIRST		fixed bin(17),	/* index of first required token.		*/
	    3 ILAST		fixed bin(17),	/* index of last required token.		*/

	REDUCTIONS  (66)		fixed bin(17) unaligned internal static options(constant) initial (
	         1,     1,	/*     1/  <no-token>                                                           */
	         2,     5,	/*     2/  site_id : <any-token> ;                                              */
	         2,     3,	/*     3/  site_id :                                                            */
	         6,     5,	/*     4/                                                                       */
	         5,     5,	/*     5/  ;                                                                    */
	         6,     8,	/*     6/  display_rqt : <valid_rqt_spec>                                       */
	         6,     7,	/*     7/  display_rqt :                                                        */
	         9,    10,	/*     8/  scan_rqts :                                                          */
	        11,    12,	/*     9/  end ;                                                                */
	        13,    14,	/*    10/  <any-token> :                                                        */
	         4,     4,	/*    11/  <any-token>                                                          */
	         1,     1,	/*    12/  <no-token>                                                           */
	        15,    14,	/*    13/                                                                       */
	        15,    17,	/*    14/  display_name : ;                                                     */
	        18,    20,	/*    15/  display_name : <new_display_name>                                    */
	        15,    16,	/*    16/  display_name :                                                       */
	        21,    23,	/*    17/  entry : ;                                                            */
	        24,    26,	/*    18/  entry : <entrypoint>                                                 */
	        21,    22,	/*    19/  entry :                                                              */
	         4,     4,	/*    20/  <any-token>                                                          */
	         1,     1,	/*    21/  <no-token>                                                           */
	         5,     5,	/*    22/  ;                                                                    */
	         4,     4,	/*    23/  <any-token>                                                          */
	        27,    26,	/*    24/                                                                       */
	         5,     5,	/*    25/  ;                                                                    */
	         8,     8,	/*    26/  <valid_rqt_spec>                                                     */
	         1,     1,	/*    27/  <no-token>                                                           */
	        27,    27,	/*    28/  ,                                                                    */
	         5,     5,	/*    29/  ;                                                                    */
	         4,     4,	/*    30/  <any-token>                                                          */
	         1,     1,	/*    31/  <no-token>                                                           */
	         4,     4,	/*    32/  <any-token>                                                          */
	         1,     1);	/*    33/  <no-token>                                                           */

     dcl	1 TOKEN_REQUIREMENT (27)	unaligned based (addr (TOKEN_REQUIREMENTS)),
						/* object token requirements.			*/
	  2 FORM			fixed bin(17),	/* form of the token requirement:		*/
						/*  -1 = relative token requirement function;	*/
						/*       TYPE = index of the particular token	*/
						/*	      function in the token_fcn array.	*/
						/*   0 = built-in token requirement function;	*/
						/*       TYPE = as defined below.		*/
						/*  >0 = absolute token requirement:		*/
						/*       FORM = index(TOKEN_STRINGS,TOKEN_REQD);	*/
						/*       TYPE = length(TOKEN_REQD);		*/
	  2 TYPE			fixed bin(17) unal,	/* type of the built-in token requirement	*/
						/* function:				*/
						/*   1 = compile test to see if input token 	*/
						/*       chain is exhausted (<no-token>).	*/
						/*   2 = compile test for any token value	*/
						/*       (<any-token>).			*/
						/*   3 = compile test for a PL/I identifier	*/
						/*       (<name>) of 32 or fewer characters.	*/
						/*   4 = compile test for token which is a	*/
						/*       <decimal-integer>.			*/
						/*   5 = compile test for token which is a single	*/
						/*       backspace character (<BS>).		*/
						/*   6 = compile test for a token which is a	*/
						/*       <quoted-string>.			*/

	TOKEN_REQUIREMENTS  (54)	fixed bin(17) unaligned internal static options(constant) initial (
	         0,    1,       1,    7,       8,    1,       0,    2,       9,    1,      10,   11,       8,    1,   
	        -1,    1,      21,    9,       8,    1,      30,    3,       9,    1,       0,    2,       8,    1,   
	        33,   12,       8,    1,       9,    1,      33,   12,       8,    1,      -1,    2,      45,    5,   
	         8,    1,       9,    1,      45,    5,       8,    1,      -1,    3,      50,    1);


     dcl	TOKEN_STRINGS		char(50) aligned based (addr (TOKEN_STRING_ARRAYS)),
						/* object token values.			*/
	TOKEN_STRING_ARRAYS (1)	char(100) aligned internal static options(constant) initial (
	     "site_id:;display_rqtscan_rqtsenddisplay_nameentry,");

	%include rdc_end_;

	     else do;				/* relative syntax function.			*/
		go to RD_TOKEN_FCN(TOKEN_REQD.TYPE);

RD_TOKEN_FCN(1):	STOKEN_FCN = valid_rqt_spec();
		go to RD_TEST_RESULT;
RD_TOKEN_FCN(2):	STOKEN_FCN = new_display_name();
		go to RD_TEST_RESULT;
RD_TOKEN_FCN(3):	STOKEN_FCN = entrypoint();
		go to RD_TEST_RESULT;

RD_TEST_RESULT:	if STOKEN_FCN then go to RD_MATCH;
		else go to RD_NEXT_REDUCTION;
		end;

RD_MATCH:      Ptoken = token.Pnext;
RD_MATCH_NO_TOKEN:
	     end;
	Ptoken = Pthis_token;
	go to RD_ACTION(NRED);

	%include rdc_stack_fcns_;


RD_ACTION(1):					/* /					*/
	call 					     ERROR ( 1 );
	return;					/* / RETURN	\			*/

RD_ACTION(2):					/* /					*/
	call 					     LEX ( 2 );
	call					     set_site_id();
	call					     NEXT_STMT();
	NRED = 5;
	go to RD_TEST_REDUCTION;			/* / next_stmt \                       		*/

RD_ACTION(3):					/* /					*/
	call 					     ERROR ( 4 );
	call					     NEXT_STMT();
	NRED = 5;
	go to RD_TEST_REDUCTION;			/* / next_stmt \                       		*/

RD_ACTION(4):					/* /					*/
	call 					     ERROR ( 14 );
	call					     NEXT_STMT();
	NRED = 5;
	go to RD_TEST_REDUCTION;			/* / next_stmt \                       		*/

RD_ACTION(5):					/* /					*/
	Ptoken, Pthis_token = Pthis_token -> token.Pnext;	/*   LEX					*/
	NRED = 5;
	go to RD_TEST_REDUCTION;			/* / next_stmt \                       		*/

RD_ACTION(6):					/* /					*/
	call 					     LEX ( 2 );
	call					     init_display_rqt();
	Ptoken, Pthis_token = Pthis_token -> token.Pnext;	/*   LEX					*/
	NRED = 13;
	go to RD_TEST_REDUCTION;			/* / display_rqt_stmts \               		*/

RD_ACTION(7):					/* /					*/
	call 					     LEX ( 2 );
	call					     init_display_rqt();
	call					     NEXT_STMT();
	NRED = 14;
	go to RD_TEST_REDUCTION;			/* / display_rqt_loop \                		*/

RD_ACTION(8):					/* /					*/
	call 					     LEX ( 2 );
	call PUSH(5);				/*   PUSH(next_stmt)                              */
	NRED = 25;
	go to RD_TEST_REDUCTION;			/* / get_scan_rqts \                   		*/

RD_ACTION(9):					/* /					*/
	call 					     LEX ( 2 );
	NRED = 32;
	go to RD_TEST_REDUCTION;			/* / finished \                        		*/

RD_ACTION(10):					/* /					*/
	call 					     ERROR ( 3 );
	call					     NEXT_STMT();
	NRED = 5;
	go to RD_TEST_REDUCTION;			/* / next_stmt \                       		*/

RD_ACTION(11):					/* /					*/
	call 					     ERROR ( 4 );
	call					     NEXT_STMT();
	NRED = 5;
	go to RD_TEST_REDUCTION;			/* / next_stmt \                       		*/

RD_ACTION(12):					/* /					*/
	call 					     ERROR ( 5 );
	return;					/* / RETURN	\			*/

RD_ACTION(13):					/* /					*/
	call PUSH(14);				/*   PUSH(display_rqt_loop)                       */
	NRED = 22;
	go to RD_TEST_REDUCTION;			/* / semi_colon \                      		*/

RD_ACTION(14):					/* /					*/
	call					     NEXT_STMT();
	NRED = 14;
	go to RD_TEST_REDUCTION;			/* / display_rqt_loop \                		*/

RD_ACTION(15):					/* /					*/
	call 					     LEX ( 2 );
						     odst.dis_rqt.display_name ( odst.tot_dis_rqts ) = token_value;
	Ptoken, Pthis_token = Pthis_token -> token.Pnext;	/*   LEX					*/
	call PUSH(14);				/*   PUSH(display_rqt_loop)                       */
	NRED = 22;
	go to RD_TEST_REDUCTION;			/* / semi_colon \                      		*/

RD_ACTION(16):					/* /					*/
	call 					     LEX ( 2 );
	call					     NEXT_STMT();
	NRED = 14;
	go to RD_TEST_REDUCTION;			/* / display_rqt_loop \                		*/

RD_ACTION(17):					/* /					*/
	call					     NEXT_STMT();
	NRED = 14;
	go to RD_TEST_REDUCTION;			/* / display_rqt_loop \                		*/

RD_ACTION(18):					/* /					*/
	call 					     LEX ( 2 );
						     odst.dis_rqt.entry ( odst.tot_dis_rqts ) = token_value;
	Ptoken, Pthis_token = Pthis_token -> token.Pnext;	/*   LEX					*/
	call PUSH(14);				/*   PUSH(display_rqt_loop)                       */
	NRED = 22;
	go to RD_TEST_REDUCTION;			/* / semi_colon \                      		*/

RD_ACTION(19):					/* /					*/
	call 					     LEX ( 2 );
	call					     NEXT_STMT();
	NRED = 14;
	go to RD_TEST_REDUCTION;			/* / display_rqt_loop \                		*/

RD_ACTION(20):					/* /					*/
	NRED = 5;
	go to RD_TEST_REDUCTION;			/* / next_stmt \                       		*/

RD_ACTION(21):					/* /					*/
	NRED = 12;
	go to RD_TEST_REDUCTION;			/* / unexpected_end \                  		*/

RD_ACTION(22):					/* /					*/
	Ptoken, Pthis_token = Pthis_token -> token.Pnext;	/*   LEX					*/
	go to RD_STACK_POP;				/* / STACK_POP	\			*/

RD_ACTION(23):					/* /					*/
	call 					     ERROR ( 4 );
	go to RD_NEXT_REDUCTION;			/* /	\				*/

RD_ACTION(24):					/* /					*/
	go to RD_STACK_POP;				/* / STACK_POP	\			*/

RD_ACTION(25):					/* /					*/
	Ptoken, Pthis_token = Pthis_token -> token.Pnext;	/*   LEX					*/
	NRED = 5;
	go to RD_TEST_REDUCTION;			/* / next_stmt \                       		*/

RD_ACTION(26):					/* /					*/
	call					     add_scan_rqt();
	Ptoken, Pthis_token = Pthis_token -> token.Pnext;	/*   LEX					*/
	NRED = 28;
	go to RD_TEST_REDUCTION;			/* / delim \                           		*/

RD_ACTION(27):					/* /					*/
	NRED = 12;
	go to RD_TEST_REDUCTION;			/* / unexpected_end \                  		*/

RD_ACTION(28):					/* /					*/
	Ptoken, Pthis_token = Pthis_token -> token.Pnext;	/*   LEX					*/
	NRED = 26;
	go to RD_TEST_REDUCTION;			/* / scan_rqts_loop \                  		*/

RD_ACTION(29):					/* /					*/
	Ptoken, Pthis_token = Pthis_token -> token.Pnext;	/*   LEX					*/
	go to RD_STACK_POP;				/* / STACK_POP	\			*/

RD_ACTION(30):					/* /					*/
	call 					     ERROR ( 12 );
	call					     NEXT_STMT();
	go to RD_STACK_POP;				/* / STACK_POP	\			*/

RD_ACTION(31):					/* /					*/
	NRED = 12;
	go to RD_TEST_REDUCTION;			/* / unexpected_end \                  		*/

RD_ACTION(32):					/* /					*/
	call 					     ERROR ( 2 );
	return;					/* / RETURN	\			*/

RD_ACTION(33):					/* /					*/
	return;					/* / RETURN	\			*/


	end SEMANTIC_ANALYSIS;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     dcl	SPDL			bit(1) aligned init ("0"b);
						/* off: This compiler parses a non-PUSH DOWN	*/
						/*      LANGUAGE.				*/
	%include rdc_lex_;

	%include rdc_error_;

	%include rdc_next_stmt_;

	end cv_odsf;






		    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
