COMPILATION LISTING OF SEGMENT opr_query_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 12/09/86 1529.7 mst Tue Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 12 /* Initial coding by J. A. Bush 10/78. 13* Modified 09/80 to clarify the operator reply expected. - R. Fakoury 14* Modified 12/80 to use set_lock_ primitives - P. B. Kelley 15* Modified 03/83 by Rick Fakoury to restructure the operator message format. 16* Modified 11/83 to correct a bug. 17* Modified 1985-03-08, BIM: phcs_ --> tandd_ 18**/ 19 20 21 22 23 /****^ HISTORY COMMENTS: 24* 1) change(86-08-21,Fakoury), approve(86-08-21,MCR7514), 25* audit(86-11-24,Martinson), install(86-12-04,MR12.0-1235): 26* to correct the alignment of the operator messages. 27* END HISTORY COMMENTS */ 28 29 30 31 32 /* opr_query_ - subroutine to send message to the system operator and wait for his response */ 33 34 35 /* format: style4,ifthenstmt,ifthen,ind3,ll125,lineconind1 */ 36 opr_query_: proc (oqip); 37 38 39 dcl oqip ptr; /* ptr to opr_query_ info structure */ 40 dcl tandd_$ring_0_message entry (char (*)); 41 dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), 42 fixed bin (2), ptr, fixed bin (35)); 43 dcl ipc_$block entry (ptr, ptr, fixed bin (35)); 44 dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); 45 dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)); 46 dcl get_process_id_ entry returns (bit (36) aligned); 47 dcl cu_$arg_list_ptr entry (ptr); 48 dcl cu_$arg_count entry returns (fixed bin); 49 dcl ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin, bit (1) aligned, bit (1) aligned); 50 dcl set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)); 51 dcl set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); 52 dcl (com_err_, ioa_$rsnnl) entry options (variable); 53 dcl (error_table_$invalid_lock_reset, error_table_$locked_by_this_process) ext static fixed bin (35); 54 55 dcl 1 oq_info like opr_query_info based (oqip) aligned; 56 57 dcl 1 event_info aligned, 58 2 cid fixed bin (71), 59 2 message fixed bin (71), 60 2 sender bit (36), 61 2 origin, 62 3 dev_signal bit (18) unaligned, 63 3 ring bit (18) unaligned, 64 2 cx fixed bin; 65 66 dcl argp ptr; 67 dcl code fixed bin (35); 68 dcl mess char (80); 69 dcl len fixed bin; 70 dcl (addr, null) builtin; 71 dcl cleanup condition; 72 dcl sc_dir char (168) static options (constant) init 73 (">system_control_1"); 74 75 on cleanup go to unlock; /* unconditionaly unlock lock on cleanup condition */ 76 if oq_info.q_sw then do; /* if user wants answer from operator */ 77 if oqdp = null then do; /* if first reference in our process */ 78 call hcs_$initiate (sc_dir, "opr_query_data", "", 0, 1, oqdp, code); /* initiate opr_query_data segment */ 79 if oqdp = null then do; /* if we can't initiate, tell user */ 80 call com_err_ (code, "opr_query_", "attempting to initiate ^a>opr_query_data", sc_dir); 81 oq_info.err_code = code; /* return error code to user */ 82 return; 83 end; 84 end; 85 call set_lock_$lock (opr_query_data.lock_id, 60, code); /* set lock */ 86 if code = error_table_$invalid_lock_reset 87 then call com_err_ (code, "opr_query_", "^/(referencing ^a>opr_query_data)", sc_dir); 88 else if code = error_table_$locked_by_this_process 89 then call com_err_ (code, "opr_query_", "^/The lock will remain set by this process."); 90 else if code ^= 0 then do; 91 call com_err_ (code, "opr_query_", "^/The lock cannot be set by this process."); 92 oq_info.err_code = code; /* indicate error to caller */ 93 return; 94 end; 95 opr_query_data.process_id = get_process_id_ (); /* fill in user's process id */ 96 97 call ipc_$create_ev_chn (opr_query_data.event_chan, code); /* create an event chan, for oprs response */ 98 if code ^= 0 then do; /* some error */ 99 call com_err_ (code, "opr_query_", "attempting to create event wait channel"); 100 oq_info.err_code = code; /* copy error code for caller */ 101 go to unlock; /* and go unlock lock */ 102 end; 103 opr_query_data.nchan = 1; /* set number of ipc channels to 1 */ 104 opr_query_data.answer = ""; /* set up the rest of the opr_query data structure */ 105 opr_query_data.prim = oq_info.prim; 106 opr_query_data.alt = oq_info.alt; 107 opr_query_data.q_sw = oq_info.q_sw; 108 opr_query_data.r_comment = oq_info.r_comment; 109 end; 110 call cu_$arg_list_ptr (argp); /* get ptr to our argument list */ 111 if cu_$arg_count () > 1 then do; /* if message is to output to opr */ 112 call ioa_$general_rs (argp, 2, 3, mess, len, "0"b, "0"b); /* format message */ 113 if len > 80 then len = 80; /* max length is 80 chars */ 114 call tandd_$ring_0_message (substr (mess, 1, len));/* and output to operator */ 115 end; 116 if oq_info.q_sw then do; /* if waiting for operator response */ 117 call ioa_$rsnnl (" ^[ ^a^;^s ^/ ^] ^[ ^/^3-respond: x oqr ^a^;^s^]^[ ^/^3-^5xor: x oqr ^a^;^s ^] ", mess, len, 118 (oq_info.r_comment ^= ""), oq_info.r_comment, (oq_info.prim ^= ""), oq_info.prim, (oq_info.alt ^= ""), 119 oq_info.alt); 120 if len > 80 then len = 80; 121 call tandd_$ring_0_message (substr (mess, 1, len));/* output expected response */ 122 call ipc_$block (addr (opr_query_data.wait_list), addr (event_info), code); /* wait */ 123 if code ^= 0 then do; /* if some error */ 124 call com_err_ (code, "opr_query_", "while blocked"); 125 oq_info.err_code = code; /* copy error code for caller */ 126 end; 127 else oq_info.answer = opr_query_data.answer; /* copy operators answer */ 128 call ipc_$delete_ev_chn (opr_query_data.event_chan, code); 129 unlock: 130 call set_lock_$unlock (opr_query_data.lock_id, code); /* unlock our lock */ 131 if code ^= 0 132 then call com_err_ (code, "opr_query_", "Attempting to unlock the opr_query_data lock."); 133 134 end; 135 oq_info.err_code = 0; /* reset error code, and return */ 136 1 1 1 2 /* BEGIN INCLUDE FILE opr_query_data.incl.pl1 */ 1 3 1 4 /* created 10/20/78 by J. A. Bush. 1 5* Modified by Rick Fakoury to increase size of the allowable answer. 1 6**/ 1 7 1 8 dcl oqdp int static ptr init (null); /* ptr to opr_query_data segment in >sc1 */ 1 9 1 10 dcl 1 opr_query_data aligned based (oqdp), /* structure for opr_query_data segment in >sc1 */ 1 11 2 lock_id bit (36), /* lock id of user waiting for operator response */ 1 12 2 process_id bit(36), /* processid of user - used for wakeup call */ 1 13 2 wait_list, /* wait list of channels for operators response */ 1 14 3 nchan fixed bin, /* number of channels, = to 1 */ 1 15 3 pad fixed bin, 1 16 3 event_chan fixed bin (71), /* event channel id of operator wait channel */ 1 17 2 q_sw bit (1) aligned, /* this is a question */ 1 18 2 prim char (8), /* primary expected operators response */ 1 19 2 alt char (8), /* alternate expected operator response */ 1 20 2 r_comment char (64), /* comment with the message */ 1 21 2 answer char (80) varying; /* operators answer */ 1 22 1 23 /* END INCLUDE FILE opr_query_data.incl.pl1 */ 1 24 137 2 1 2 2 /* BEGIN INCLUDE FILE opr_query_info.incl.pl1 */ 2 3 2 4 /* created 10/20/78 by J. A. Bush. 2 5* Modified by Rick Fakoury to increase size of the allowable answer. 2 6**/ 2 7 2 8 dcl 1 opr_query_info aligned, /* info structure for the opr_query_ subroutine */ 2 9 2 version fixed bin, /* version of this structure, currently = to 1 */ 2 10 2 q_sw bit (1) aligned, /* = "1"b if aswer is expected from operator */ 2 11 2 prim char (8), /* primary expected operators response */ 2 12 2 alt char (8), /* alternate expected operator response */ 2 13 2 answer char (80) varying, /* operators answer */ 2 14 2 r_comment char (64), /* comment to be output with respond message */ 2 15 2 err_code fixed bin (35); /* standard system status code */ 2 16 2 17 /* END INCLUDE FILE opr_query_info.incl.pl1 */ 2 18 138 139 140 end opr_query_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 12/09/86 1521.7 opr_query_.pl1 >special_ldd>install>MR12.0-1235>opr_query_.pl1 137 1 06/09/83 1430.8 opr_query_data.incl.pl1 >ldd>include>opr_query_data.incl.pl1 138 2 06/09/83 1430.8 opr_query_info.incl.pl1 >ldd>include>opr_query_info.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. addr builtin function dcl 70 ref 122 122 122 122 alt 4 based char(8) level 2 in structure "oq_info" dcl 55 in procedure "opr_query_" set ref 106 117 117* alt 11 based char(8) level 2 in structure "opr_query_data" dcl 1-10 in procedure "opr_query_" set ref 106* answer 33 based varying char(80) level 2 in structure "opr_query_data" dcl 1-10 in procedure "opr_query_" set ref 104* 127 answer 6 based varying char(80) level 2 in structure "oq_info" dcl 55 in procedure "opr_query_" set ref 127* argp 000110 automatic pointer dcl 66 set ref 110* 112* cleanup 000140 stack reference condition dcl 71 ref 75 code 000112 automatic fixed bin(35,0) dcl 67 set ref 78* 80* 81 85* 86 86* 88 88* 90 91* 92 97* 98 99* 100 122* 123 124* 125 128* 129* 131 131* com_err_ 000040 constant entry external dcl 52 ref 80 86 88 91 99 124 131 cu_$arg_count 000030 constant entry external dcl 48 ref 111 cu_$arg_list_ptr 000026 constant entry external dcl 47 ref 110 err_code 53 based fixed bin(35,0) level 2 dcl 55 set ref 81* 92* 100* 125* 135* error_table_$invalid_lock_reset 000044 external static fixed bin(35,0) dcl 53 ref 86 error_table_$locked_by_this_process 000046 external static fixed bin(35,0) dcl 53 ref 88 event_chan 4 based fixed bin(71,0) level 3 dcl 1-10 set ref 97* 128* event_info 000100 automatic structure level 1 dcl 57 set ref 122 122 get_process_id_ 000024 constant entry external dcl 46 ref 95 hcs_$initiate 000014 constant entry external dcl 41 ref 78 ioa_$general_rs 000032 constant entry external dcl 49 ref 112 ioa_$rsnnl 000042 constant entry external dcl 52 ref 117 ipc_$block 000016 constant entry external dcl 43 ref 122 ipc_$create_ev_chn 000020 constant entry external dcl 44 ref 97 ipc_$delete_ev_chn 000022 constant entry external dcl 45 ref 128 len 000137 automatic fixed bin(17,0) dcl 69 set ref 112* 113 113* 114 114 117* 120 120* 121 121 lock_id based bit(36) level 2 dcl 1-10 set ref 85* 129* mess 000113 automatic char(80) unaligned dcl 68 set ref 112* 114 114 117* 121 121 nchan 2 based fixed bin(17,0) level 3 dcl 1-10 set ref 103* null builtin function dcl 70 ref 77 79 opr_query_data based structure level 1 dcl 1-10 opr_query_info 000146 automatic structure level 1 dcl 2-8 oq_info based structure level 1 dcl 55 oqdp 000010 internal static pointer initial dcl 1-8 set ref 77 78* 79 85 95 97 103 104 105 106 107 108 122 122 127 128 129 oqip parameter pointer dcl 39 ref 36 76 81 92 100 105 106 107 108 116 117 117 117 117 117 117 125 127 135 prim 7 based char(8) level 2 in structure "opr_query_data" dcl 1-10 in procedure "opr_query_" set ref 105* prim 2 based char(8) level 2 in structure "oq_info" dcl 55 in procedure "opr_query_" set ref 105 117 117* process_id 1 based bit(36) level 2 dcl 1-10 set ref 95* q_sw 6 based bit(1) level 2 in structure "opr_query_data" dcl 1-10 in procedure "opr_query_" set ref 107* q_sw 1 based bit(1) level 2 in structure "oq_info" dcl 55 in procedure "opr_query_" ref 76 107 116 r_comment 13 based char(64) level 2 in structure "opr_query_data" dcl 1-10 in procedure "opr_query_" set ref 108* r_comment 33 based char(64) level 2 in structure "oq_info" dcl 55 in procedure "opr_query_" set ref 108 117 117* sc_dir 000000 constant char(168) initial unaligned dcl 72 set ref 78* 80* 86* set_lock_$lock 000034 constant entry external dcl 50 ref 85 set_lock_$unlock 000036 constant entry external dcl 51 ref 129 tandd_$ring_0_message 000012 constant entry external dcl 40 ref 114 121 wait_list 2 based structure level 2 dcl 1-10 set ref 122 122 NAMES DECLARED BY EXPLICIT CONTEXT. opr_query_ 000245 constant entry external dcl 36 unlock 001246 constant label dcl 129 ref 75 101 NAME DECLARED BY CONTEXT OR IMPLICATION. substr builtin function ref 114 114 121 121 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1530 1600 1316 1540 Length 2036 1316 50 222 212 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME opr_query_ 244 external procedure is an external procedure. on unit on line 75 64 on unit STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 oqdp opr_query_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME opr_query_ 000100 event_info opr_query_ 000110 argp opr_query_ 000112 code opr_query_ 000113 mess opr_query_ 000137 len opr_query_ 000146 opr_query_info opr_query_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_ne_as alloc_char_temp call_ext_out_desc call_ext_out return_mac tra_ext_1 enable_op shorten_stack ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_list_ptr get_process_id_ hcs_$initiate ioa_$general_rs ioa_$rsnnl ipc_$block ipc_$create_ev_chn ipc_$delete_ev_chn set_lock_$lock set_lock_$unlock tandd_$ring_0_message THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$invalid_lock_reset error_table_$locked_by_this_process LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 36 000242 75 000252 76 000271 77 000276 78 000303 79 000354 80 000361 81 000414 82 000421 85 000422 86 000436 88 000476 90 000530 91 000532 92 000561 93 000566 95 000567 97 000577 98 000611 99 000613 100 000643 101 000650 103 000651 104 000655 105 000656 106 000665 107 000671 108 000673 110 000676 111 000705 112 000717 113 000764 114 000771 115 001010 116 001011 117 001016 120 001112 121 001117 122 001136 123 001157 124 001161 125 001214 126 001221 127 001222 128 001234 129 001246 131 001257 135 001311 140 001315 ----------------------------------------------------------- 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