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 (""); 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 / / ERROR (1) / RETURN \ / site_id : ; / 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 : / 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 \ / : / ERROR (3) NEXT_STMT / next_stmt \ / / ERROR (4) NEXT_STMT / next_stmt \ unexpected_end / / 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 : / 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 : / 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 \ / / / next_stmt \ / / / unexpected_end \ semi_colon \" Subr. to check that current token is (must be) a semi-colon. / ; / LEX / STACK_POP \ / / ERROR (4) / \ / / / STACK_POP \ get_scan_rqts / ; / LEX / next_stmt \ scan_rqts_loop / / add_scan_rqt LEX / delim \ / / / unexpected_end \ delim / , / LEX / scan_rqts_loop \ / ; / LEX / STACK_POP \ / / ERROR (12) NEXT_STMT / STACK_POP \ / / / unexpected_end \ finished / / ERROR (2) / RETURN \ / / / 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 / / ERROR (1) / RETURN \ 2 / site_id : ; / 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 : / 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 / : / ERROR (3) NEXT_STMT / next_stmt \ 11 / / ERROR (4) NEXT_STMT / next_stmt \ unexpected_end 12 / / 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 : / 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 : / 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 / / / next_stmt \ 21 / / / unexpected_end \ semi_colon 22 \" Subr. to check that current token is (must be) a semi-colon. / ; / LEX / STACK_POP \ 23 / / ERROR (4) / \ 24 / / / STACK_POP \ get_scan_rqts 25 / ; / LEX / next_stmt \ scan_rqts_loop 26 / / add_scan_rqt LEX / delim \ 27 / / / unexpected_end \ delim 28 / , / LEX / scan_rqts_loop \ 29 / ; / LEX / STACK_POP \ 30 / / ERROR (12) NEXT_STMT / STACK_POP \ 31 / / / unexpected_end \ finished 32 / / ERROR (2) / RETURN \ 33 / / / 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/ */ 2, 5, /* 2/ site_id : ; */ 2, 3, /* 3/ site_id : */ 6, 5, /* 4/ */ 5, 5, /* 5/ ; */ 6, 8, /* 6/ display_rqt : */ 6, 7, /* 7/ display_rqt : */ 9, 10, /* 8/ scan_rqts : */ 11, 12, /* 9/ end ; */ 13, 14, /* 10/ : */ 4, 4, /* 11/ */ 1, 1, /* 12/ */ 15, 14, /* 13/ */ 15, 17, /* 14/ display_name : ; */ 18, 20, /* 15/ display_name : */ 15, 16, /* 16/ display_name : */ 21, 23, /* 17/ entry : ; */ 24, 26, /* 18/ entry : */ 21, 22, /* 19/ entry : */ 4, 4, /* 20/ */ 1, 1, /* 21/ */ 5, 5, /* 22/ ; */ 4, 4, /* 23/ */ 27, 26, /* 24/ */ 5, 5, /* 25/ ; */ 8, 8, /* 26/ */ 1, 1, /* 27/ */ 27, 27, /* 28/ , */ 5, 5, /* 29/ ; */ 4, 4, /* 30/ */ 1, 1, /* 31/ */ 4, 4, /* 32/ */ 1, 1); /* 33/ */ 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 (). */ /* 2 = compile test for any token value */ /* (). */ /* 3 = compile test for a PL/I identifier */ /* () of 32 or fewer characters. */ /* 4 = compile test for token which is a */ /* . */ /* 5 = compile test for token which is a single */ /* backspace character (). */ /* 6 = compile test for a token which is a */ /* . */ 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