COMPILATION LISTING OF SEGMENT accounts_overseer_ Compiled by: Multics PL/I Compiler, Release 30, of February 16, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 08/29/88 0920.1 mst Mon Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 /* format: style4 */ 13 accounts_overseer_: proc; 14 15 /* Special login responder for user accounts */ 16 /* modified July 1972 by J.Phillipps to get ready for v2 pl/1 */ 17 /* iox'ed and cleaned up August 1981 by E. N. Kittlitz */ 18 /* master_ec_error_ added as synonym for program_interrupt, September 1982, E. N. Kittlitz. */ 19 20 21 /****^ HISTORY COMMENTS: 22* 1) change(87-08-25,GDixon), approve(88-08-15,MCR7969), 23* audit(88-08-04,Lippard), install(88-08-29,MR12.2-1093): 24* Avoid doing iox_$control quit_enable when running as absentee; abs_io_ 25* does not implement this control so we produce an unnecessary error 26* message. (phx16088) 27* END HISTORY COMMENTS */ 28 29 30 dcl cl_safe_intermediary entry variable; 31 dcl code fixed bin (35); 32 dcl command char (32) defined (whole_line) pos (1); 33 dcl i fixed bin; 34 dcl input_line char (224) defined (whole_line) pos (33); 35 dcl k fixed bin; 36 dcl ll fixed bin (21); 37 dcl m fixed bin; 38 dcl ml fixed bin; 39 dcl mp ptr; 40 dcl path char (168); 41 dcl sp ptr; 42 dcl whole_line char (256); 43 44 dcl setup_handlers bit (1) int static init ("0"b); 45 dcl testmode bit (1) int static init ("0"b); 46 47 dcl change_wdir_ entry (char (168) aligned, fixed bin (35)); 48 dcl com_err_ entry options (variable); 49 dcl condition_ entry (char (*), entry); 50 dcl condition_interpreter_ entry (ptr, ptr, fixed bin, fixed bin, ptr, char (*), ptr, ptr); 51 dcl cu_$cp entry (ptr, fixed bin (21), fixed bin (35)); 52 dcl cu_$get_cl_intermediary entry (entry); 53 dcl cu_$ready_proc entry; 54 dcl cu_$set_cl_intermediary entry (entry); 55 dcl cu_$stack_frame_ptr entry (ptr); 56 dcl debug entry; 57 dcl get_system_free_area_ entry (ptr); 58 dcl ioa_ entry options (variable); 59 dcl ioa_$ioa_switch_nnl entry () options (variable); 60 dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); 61 dcl iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 62 dcl iox_$user_input ptr external static; 63 dcl iox_$user_io ptr external static; 64 dcl program_interrupt entry; 65 dcl trace_stack_ entry (ptr, fixed bin, fixed bin, char (32) aligned); 66 dcl user_info_$homedir entry (char (*)); 67 dcl user_info_$process_type entry returns (fixed bin); 68 69 dcl (addr, index, length, null, search, substr, verify) builtin; 70 71 dcl ncoms fixed bin int static init (36), 72 comnam (36) char (32) aligned int static init 73 ("list", "mail", "status", "listacl", "who", 74 "ls", "ml", "st", "la", "", 75 "enter_abs_request", "value$set", "value$dump", "getquota", "movequota", 76 "ear", "", "", "gq", "mq", 77 "logout", "list_abs_requests", "cancel_abs_request", "setacl", "deleteacl", 78 "", "lar", "car", "sa", "da", 79 "y0", "y1", "y2", "y3", "y4", "y5"); 80 81 dcl INTERACTIVE init(1) fixed bin int static options(constant); 82 dcl NL char (1) aligned int static init (" 83 "); 84 85 dcl berrm char (ml) based (mp) unaligned; 86 87 88 /* ============================================================================== */ 89 90 91 start: 92 call cu_$get_cl_intermediary (cl_safe_intermediary); 93 call cu_$set_cl_intermediary (quit); 94 setup_handlers = "1"b; 95 call condition_ ("any_other", ucs); 96 call condition_ ("master_ec_error_", pi_h); 97 call condition_ ("program_interrupt", pi_h); 98 call condition_ ("quit", quit); 99 if user_info_$process_type() = INTERACTIVE then do; 100 call iox_$control (iox_$user_io, "quit_enable", null, code); 101 if code ^= 0 then 102 call com_err_ (code, "accounts_overseer_", ""); 103 end; /* don't enable quits in absentee, abs_io_ complains */ 104 105 if ^testmode then do; 106 call user_info_$homedir (path); 107 call change_wdir_ ((path), code); 108 if code ^= 0 then do; 109 call com_err_ (code, "accounts_overseer_", "Unable to set working directory ^a.", path); 110 return; 111 end; 112 end; 113 114 command = "exec_com start_up"; 115 call cu_$cp (addr (command), length (command), code); 116 if code ^= 0 then call com_err_ (code, "accounts_overseer_", ""); 117 118 restart: call cu_$ready_proc; 119 restart1: 120 call iox_$get_line (iox_$user_input, addr (input_line), length (input_line), ll, code); 121 if code ^= 0 then call com_err_ (code, "accounts_overseer_", ""); 122 if ll <= 1 then go to restart1; 123 substr (input_line, ll) = ""; 124 if index (substr (input_line, 1, ll), ";") ^= 0 then do; 125 call ioa_ ("Illegal syntax"); 126 go to restart; 127 end; 128 i = verify (substr (input_line, 1, ll), " "); /* Strip leading blanks and tabs. */ 129 if i = 0 then go to restart1; /* If all blanks */ 130 k = search (substr (input_line, i, ll - i + 1), " "); /* Find end of command. */ 131 if k = 0 then command = substr (input_line, i, ll - i + 1); 132 else command = substr (input_line, i, k - 1); 133 if command = "" then go to restart1; 134 135 do i = 1 to ncoms; 136 if command = comnam (i) then do; 137 call cu_$cp (addr (input_line), ll, code); 138 if code ^= 0 then call com_err_ (code, "accounts_overseer_", ""); 139 go to restart; 140 end; 141 end; 142 143 if testmode then do; 144 if (command = "debug" | command = "db") then do; 145 call debug; 146 go to restart; 147 end; 148 else if command = "quit" | command = "q" | command = "exit" then do; 149 if setup_handlers then 150 call cu_$set_cl_intermediary (cl_safe_intermediary); 151 return; 152 end; 153 end; /* testmode */ 154 155 command = "exec_com master"; 156 call cu_$cp (addr (command), ll + 32, code); 157 if code ^= 0 then call com_err_ (code, "accounts_overseer_", ""); 158 159 go to restart; 160 161 test: entry; 162 163 testmode = "1"b; 164 setup_handlers = "0"b; 165 go to restart; 166 167 test_with_handlers: entry; 168 169 testmode = "1"b; 170 go to start; 171 172 /* ============================================================================== */ 173 174 ucs: proc (mcptr, cname, coptr, infoptr, contin); 175 176 dcl (mcptr, coptr, infoptr, areap) ptr, 177 contin bit (1), 178 cname char (*); 179 180 dcl k fixed bin, 181 i fixed bin; 182 183 if cname = "cleanup" then return; 184 if cname = "finish" then return; 185 if cname = "mme2" then do; contin = "1"b; return; end; 186 if cname = "command_error" then return; 187 if cname = "command_query" then return; 188 if cname = "command_question" then return; 189 190 call get_system_free_area_ (areap); 191 call condition_interpreter_ (areap, mp, ml, 3, mcptr, cname, coptr, infoptr); 192 k = 1; 193 do i = 1 to ml; 194 if substr (berrm, i, 1) = NL then do; 195 if i - k > 0 then call ioa_ ("^a", substr (berrm, k, i - k)); 196 k = k + i; 197 end; 198 end; 199 free berrm; 200 201 202 quit: entry; 203 204 queep: 205 call iox_$control (iox_$user_input, "resetread", null, code); 206 if code ^= 0 then call com_err_ (code, "accounts_overseer_", "performing resetread"); 207 call ioa_$ioa_switch_nnl (iox_$user_io, "^/^B??? "); 208 m = 0; 209 call iox_$control (iox_$user_io, "start", null, code); 210 if code ^= 0 then call com_err_ (code, "accounts_overseer_", ""); 211 call iox_$get_line (iox_$user_input, addr (input_line), length (input_line), ll, code); 212 if code ^= 0 then call com_err_ (code, "accounts_overseer_", ""); 213 substr (input_line, ll) = ""; /* clear rest of line */ 214 if substr (input_line, 1, 2) = "db" | 215 substr (input_line, 1, 5) = "debug" then 216 if testmode then call debug; 217 else do; 218 call cu_$stack_frame_ptr (sp); 219 call trace_stack_ (sp, 1, -1, "error_output"); 220 go to queep; 221 end; 222 else if substr (input_line, 1, 2) = "sr" then go to do_sr; 223 else if substr (input_line, 1, 5) = "start" then do; 224 do_sr: return; 225 end; 226 else if substr (input_line, 1, 2) = "pi" then call program_interrupt; /* the auditor said I could */ 227 else go to queep; 228 229 end ucs; 230 231 pi_h: proc; 232 233 call iox_$control (iox_$user_input, "resetread", null, code); 234 if code ^= 0 then call com_err_ (code, "accounts_overseer_", "performing resetread"); 235 go to restart; 236 237 end pi_h; 238 239 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 08/29/88 0856.3 accounts_overseer_.pl1 >spec>install>1093>accounts_overseer_.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. INTERACTIVE constant fixed bin(17,0) initial dcl 81 ref 99 NL 003163 constant char(1) initial dcl 82 ref 194 addr builtin function dcl 69 ref 115 115 119 119 137 137 156 156 211 211 areap 000100 automatic pointer dcl 176 set ref 190* 191* berrm based char packed unaligned dcl 85 ref 194 195 195 199 change_wdir_ 000012 constant entry external dcl 47 ref 107 cl_safe_intermediary 000100 automatic entry variable dcl 30 set ref 91* 149* cname parameter char packed unaligned dcl 176 set ref 174 183 184 185 186 187 188 191* code 000104 automatic fixed bin(35,0) dcl 31 set ref 100* 101 101* 107* 108 109* 115* 116 116* 119* 121 121* 137* 138 138* 156* 157 157* 204* 206 206* 209* 210 210* 211* 212 212* 233* 234 234* com_err_ 000014 constant entry external dcl 48 ref 101 109 116 121 138 157 206 210 212 234 command defined char(32) packed unaligned dcl 32 set ref 114* 115 115 115 115 131* 132* 133 136 144 144 148 148 148 155* 156 156 comnam 000000 constant char(32) initial array dcl 71 ref 136 condition_ 000016 constant entry external dcl 49 ref 95 96 97 98 condition_interpreter_ 000020 constant entry external dcl 50 ref 191 contin parameter bit(1) packed unaligned dcl 176 set ref 174 185* coptr parameter pointer dcl 176 set ref 174 191* cu_$cp 000022 constant entry external dcl 51 ref 115 137 156 cu_$get_cl_intermediary 000024 constant entry external dcl 52 ref 91 cu_$ready_proc 000026 constant entry external dcl 53 ref 118 cu_$set_cl_intermediary 000030 constant entry external dcl 54 ref 93 149 cu_$stack_frame_ptr 000032 constant entry external dcl 55 ref 218 debug 000034 constant entry external dcl 56 ref 145 214 get_system_free_area_ 000036 constant entry external dcl 57 ref 190 i 000105 automatic fixed bin(17,0) dcl 33 in procedure "accounts_overseer_" set ref 128* 129 130 130 131 131 132 135* 136* i 000103 automatic fixed bin(17,0) dcl 180 in procedure "ucs" set ref 193* 194 195 195 195 196* index builtin function dcl 69 ref 124 infoptr parameter pointer dcl 176 set ref 174 191* input_line defined char(224) packed unaligned dcl 34 set ref 119 119 119 119 123* 124 128 130 131 132 137 137 211 211 211 211 213* 214 214 222 223 226 ioa_ 000040 constant entry external dcl 58 ref 125 195 ioa_$ioa_switch_nnl 000042 constant entry external dcl 59 ref 207 iox_$control 000044 constant entry external dcl 60 ref 100 204 209 233 iox_$get_line 000046 constant entry external dcl 61 ref 119 211 iox_$user_input 000050 external static pointer dcl 62 set ref 119* 204* 211* 233* iox_$user_io 000052 external static pointer dcl 63 set ref 100* 207* 209* k 000106 automatic fixed bin(17,0) dcl 35 in procedure "accounts_overseer_" set ref 130* 131 132 k 000102 automatic fixed bin(17,0) dcl 180 in procedure "ucs" set ref 192* 195 195 195 195 195 196* 196 length builtin function dcl 69 ref 115 115 119 119 211 211 ll 000107 automatic fixed bin(21,0) dcl 36 set ref 119* 122 123 124 128 130 131 137* 156 211* 213 m 000110 automatic fixed bin(17,0) dcl 37 set ref 208* mcptr parameter pointer dcl 176 set ref 174 191* ml 000111 automatic fixed bin(17,0) dcl 38 set ref 191* 193 194 195 195 199 199 mp 000112 automatic pointer dcl 39 set ref 191* 194 195 195 199 ncoms constant fixed bin(17,0) initial dcl 71 ref 135 null builtin function dcl 69 ref 100 100 204 204 209 209 233 233 path 000114 automatic char(168) packed unaligned dcl 40 set ref 106* 107 109* program_interrupt 000054 constant entry external dcl 64 ref 226 search builtin function dcl 69 ref 130 setup_handlers 000010 internal static bit(1) initial packed unaligned dcl 44 set ref 94* 149 164* sp 000166 automatic pointer dcl 41 set ref 218* 219* substr builtin function dcl 69 set ref 123* 124 128 130 131 132 194 195 195 213* 214 214 222 223 226 testmode 000011 internal static bit(1) initial packed unaligned dcl 45 set ref 105 143 163* 169* 214 trace_stack_ 000056 constant entry external dcl 65 ref 219 user_info_$homedir 000060 constant entry external dcl 66 ref 106 user_info_$process_type 000062 constant entry external dcl 67 ref 99 verify builtin function dcl 69 ref 128 whole_line 000170 automatic char(256) packed unaligned dcl 42 set ref 114* 114 115 115 115 115 115 115 115 115 119 119 119 119 119 119 119 119 123 123 124 124 128 128 130 130 131* 131 131 131 132* 132 132 132 133 133 136 136 137 137 137 137 144 144 144 144 148 148 148 148 148 148 155* 155 156 156 156 156 211 211 211 211 211 211 211 211 213 213 214 214 214 214 222 222 223 223 226 226 NAMES DECLARED BY EXPLICIT CONTEXT. accounts_overseer_ 000606 constant entry external dcl 13 do_sr 002445 constant label dcl 224 ref 222 pi_h 002460 constant entry internal dcl 231 ref 96 96 97 97 queep 002066 constant label dcl 204 ref 220 226 quit 002061 constant entry internal dcl 202 ref 93 93 98 98 restart 001214 constant label dcl 118 ref 126 139 146 159 165 235 restart1 001221 constant label dcl 119 ref 122 129 133 start 000613 constant label dcl 91 set ref 170 test 001620 constant entry external dcl 161 test_with_handlers 001633 constant entry external dcl 167 ucs 001645 constant entry internal dcl 174 ref 95 95 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3466 3552 3166 3476 Length 4006 3166 64 220 277 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME accounts_overseer_ 276 external procedure is an external procedure. ucs 136 internal procedure is assigned to an entry variable. pi_h 108 internal procedure is assigned to an entry variable. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 setup_handlers accounts_overseer_ 000011 testmode accounts_overseer_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME accounts_overseer_ 000100 cl_safe_intermediary accounts_overseer_ 000104 code accounts_overseer_ 000105 i accounts_overseer_ 000106 k accounts_overseer_ 000107 ll accounts_overseer_ 000110 m accounts_overseer_ 000111 ml accounts_overseer_ 000112 mp accounts_overseer_ 000114 path accounts_overseer_ 000166 sp accounts_overseer_ 000170 whole_line accounts_overseer_ ucs 000100 areap ucs 000102 k ucs 000103 i ucs THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_out_desc call_ext_out return_mac tra_ext_1 shorten_stack ext_entry int_entry int_entry_desc op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. change_wdir_ com_err_ condition_ condition_interpreter_ cu_$cp cu_$get_cl_intermediary cu_$ready_proc cu_$set_cl_intermediary cu_$stack_frame_ptr debug get_system_free_area_ ioa_ ioa_$ioa_switch_nnl iox_$control iox_$get_line program_interrupt trace_stack_ user_info_$homedir user_info_$process_type THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. iox_$user_input iox_$user_io LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 13 000605 91 000613 93 000622 94 000634 95 000637 96 000663 97 000707 98 000732 99 000754 100 000766 101 001020 105 001051 106 001054 107 001064 108 001100 109 001102 110 001140 114 001141 115 001144 116 001163 118 001214 119 001221 121 001244 122 001275 123 001300 124 001310 125 001321 126 001336 128 001337 129 001351 130 001352 131 001371 132 001377 133 001403 135 001407 136 001417 137 001425 138 001442 139 001473 141 001474 143 001476 144 001501 145 001511 146 001515 148 001516 149 001532 151 001542 155 001543 156 001546 157 001565 159 001616 161 001617 163 001625 164 001630 165 001631 167 001632 169 001640 170 001643 174 001644 183 001660 184 001666 185 001672 185 001676 185 001702 186 001703 187 001707 188 001713 190 001717 191 001725 192 001772 193 001774 194 002005 195 002013 196 002044 198 002047 199 002051 202 002057 204 002066 206 002122 207 002162 208 002201 209 002203 210 002233 211 002265 212 002312 213 002344 214 002356 218 002402 219 002410 220 002435 221 002436 222 002437 223 002442 224 002445 226 002446 229 002456 231 002457 233 002465 234 002520 235 002560 ----------------------------------------------------------- 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