COMPILATION LISTING OF SEGMENT tolts_ 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.8 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 /* Rewritten 6/78 by J. A. Bush to conform to Multics programming standards 13* Modified 79/02/08 by J. A. Bush to call the Multics T & D Slave Interface 14* Module (mtdsim_) for Molts and Polts 15* Modified 80/02/06 by J. A. Bush to handle the sus_ condition 16* Modified 80/12/08 by R. E. Fakoury to handle a colts request. 17* Modified 03/83 by Rick Fakoury to change the msg1 to msg and to call tolts_util_$opr_msg. Also added a 18* check for user access to system data_bases and gates. 19* Modified 10/83 to use access_mode_values.incl as recommended by the auditor. 20* Modified 01/84 by R Fakoury to support new tolts debugger call. 21* Modified 01/85 by R Fakoury to change the check for tandd.acs. 22**/ 23 24 25 26 27 28 29 /****^ HISTORY COMMENTS: 30* 1) change(85-10-21,Fakoury), approve(86-08-21,MCR7514), 31* audit(86-12-01,Martinson), install(86-12-09,MR12.0-1235): 32* to check for user access to mca gate & system mca data segs. 33* END HISTORY COMMENTS */ 34 35 36 37 38 39 /* tolts_ - this is the TOLTS executive that controls execution of POLTS, MOLTS, COLTS, and ISOLTS */ 40 41 42 /* format: style4,ifthenstmt,ifthen,ind3,ll125,lineconind1 */ 43 tolts_: proc; 44 45 /* AUTOMATIC */ 46 47 dcl c_args (32) char (28) varying; 48 dcl c_len fixed bin; 49 dcl cardp ptr init (null); 50 dcl code fixed bin (35); 51 dcl com_string char (132) aligned; 52 dcl cmd_cnt fixed bin; 53 dcl entry_var entry variable; 54 dcl tandd_ok bit (1); 55 dcl term bit (1); 56 dcl ttl_date char (6); 57 dcl user_access fixed bin (5); 58 59 60 /* BUILTINS */ 61 62 dcl null builtin; 63 64 /* CONDITIONS */ 65 66 dcl linkage_error condition; 67 68 69 /* CONSTANTS */ 70 71 dcl current_ring fixed bin int static options (constant) init (-1); 72 dcl no_error_expected fixed bin (35) int static options (constant) init (0); 73 dcl pname char (6) static options (constant) init ("tolts_"); 74 dcl ring_1 fixed bin int static options (constant) init (1); 75 dcl sl_dir char (4) int static options (constant) init (">sl1"); 76 dcl sc_admin_dir char (14) int static options (constant) init (">sc1>admin_acs"); 77 dcl sc_dir char (4) int static options (constant) init (">sc1"); 78 79 80 /* ENTRIES */ 81 82 dcl com_err_ entry () options (variable); 83 dcl hcs_$get_user_effmode entry (char (*), char (*), char (*), fixed bin, fixed bin (5), fixed bin (35)); 84 dcl ioa_ entry options (variable); 85 dcl isolts_ entry; 86 dcl mca_$attach_mca entry; 87 dcl mtdsim_ entry options (variable); 88 dcl no_save_on_disconnect entry; 89 dcl save_on_disconnect entry; 90 dcl tandd_$ring_0_message entry; 91 dcl tolts_util_$get_ttl_date entry (entry, char (6)); 92 dcl tolts_util_$on_off entry (char (6), char (3), char (6)); 93 dcl tolts_util_$opr_msg entry; 94 dcl tolts_util_$query entry (char (*), char (132) aligned, fixed bin, (32) char (28) varying, fixed bin); 95 96 97 /* EXTERNAL */ 98 99 dcl error_table_$moderr fixed bin (35) ext static; 100 dcl error_table_$noentry fixed bin (35) ext static; 101 102 103 104 105 106 call no_save_on_disconnect; /* do not want process saved on terminal disconnect */ 107 call tolts_util_$get_ttl_date (tolts_, ttl_date); 108 call tolts_util_$on_off ("tolts", "on", ttl_date); /* signon */ 109 110 111 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 112 /* */ 113 /* Verify user access to system data and system gates. */ 114 /* */ 115 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 116 117 118 call check_access (sc_dir, "opr_query_data", 119 RW_ACCESS_BIN, no_error_expected, current_ring); 120 121 call check_access (sc_admin_dir, "tandd.acs", 122 RW_ACCESS_BIN, no_error_expected, current_ring); 123 124 call check_access (sc_dir, "cdt", 125 R_ACCESS_BIN, no_error_expected, current_ring); 126 127 call check_access (sl_dir, "mca_data_seg", 128 RW_ACCESS_BIN, error_table_$noentry, ring_1); 129 130 131 on linkage_error begin; 132 call com_err_ (error_table_$moderr, pname, "^[mca_^;tandd_^]", tandd_ok); 133 goto t_off; /* exit */ 134 end; 135 136 tandd_ok = "0"b; 137 entry_var = tandd_$ring_0_message; 138 tandd_ok = "1"b; 139 entry_var = mca_$attach_mca; 140 revert linkage_error; 141 142 143 144 145 146 /* Now loop until user quits */ 147 148 term = "0"b; /* reset terminate condition */ 149 do while (^term); 150 call ioa_ (" ^/***enter ""polts"", ""molts"", ""colts"", ""isolts"", ""quit"", or ""msg"""); 151 call tolts_util_$query ("??? ", com_string, c_len, c_args, cmd_cnt); 152 153 /* Now see what user wants to do */ 154 155 if c_args (1) = "quit" 156 | c_args (1) = "q" then /* user wants to quit */ 157 term = "1"b; 158 else if c_args (1) = "polts" then /* user wants to run polts */ 159 call mtdsim_ ("polt"); 160 else if c_args (1) = "molts" then /* user wants to run molts */ 161 call mtdsim_ ("molt"); 162 else if c_args (1) = "colts" then /* user wants to run colts */ 163 call mtdsim_ ("colt"); 164 else if c_args (1) = "isolts" then /* user wants to run isolts */ 165 call isolts_; 166 else if c_args (1) = "msg" then /* user wants to send message to operator */ 167 call tolts_util_$opr_msg; 168 else call ioa_ ("^/invalid response - ^a", com_string); 169 end; 170 171 /* User is all done, output Tolts wrap up message */ 172 173 t_off: call tolts_util_$on_off ("tolts", "off", ttl_date); /* signoff */ 174 call save_on_disconnect; /* restore users save on disconnect state */ 175 176 return; 177 178 179 180 /* check_access - int proc that will check the user's access to system gates & data bases */ 181 182 check_access: proc (dir, entry, lowest_access, error_expected, ring); 183 184 dcl error_expected fixed bin (35); 185 dcl dir char (*); 186 dcl entry char (*); 187 dcl lowest_access fixed bin (5); 188 dcl ring fixed bin; 189 190 call hcs_$get_user_effmode (dir, entry, "", ring, user_access, code); 191 if code ^= 0 then do; 192 if code = error_expected then return; 193 call com_err_ (code, pname, "attemping to get user access to ^a>^a.", 194 dir, entry); 195 go to t_off; /* exit */ 196 end; 197 198 if user_access >= lowest_access then return; 199 200 call com_err_ (error_table_$moderr, pname, "^a>^a", dir, entry); 201 goto t_off; /* exit */ 202 203 end check_access; 204 205 206 1 1 /* BEGIN INCLUDE FILE ... access_mode_values.incl.pl1 1 2* 1 3* Values for the "access mode" argument so often used in hardcore 1 4* James R. Davis 26 Jan 81 MCR 4844 1 5* Added constants for SM access 4/28/82 Jay Pattin 1 6* Added text strings 03/19/85 Chris Jones 1 7**/ 1 8 1 9 1 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 1 11 dcl ( 1 12 N_ACCESS init ("000"b), 1 13 R_ACCESS init ("100"b), 1 14 E_ACCESS init ("010"b), 1 15 W_ACCESS init ("001"b), 1 16 RE_ACCESS init ("110"b), 1 17 REW_ACCESS init ("111"b), 1 18 RW_ACCESS init ("101"b), 1 19 S_ACCESS init ("100"b), 1 20 M_ACCESS init ("010"b), 1 21 A_ACCESS init ("001"b), 1 22 SA_ACCESS init ("101"b), 1 23 SM_ACCESS init ("110"b), 1 24 SMA_ACCESS init ("111"b) 1 25 ) bit (3) internal static options (constant); 1 26 1 27 /* The following arrays are meant to be accessed by doing either 1) bin (bit_value) or 1 28* 2) divide (bin_value, 2) to come up with an index into the array. */ 1 29 1 30 dcl SEG_ACCESS_MODE_NAMES (0:7) init ("null", "W", "E", "EW", "R", "RW", "RE", "REW") char (4) internal 1 31 static options (constant); 1 32 1 33 dcl DIR_ACCESS_MODE_NAMES (0:7) init ("null", "A", "M", "MA", "S", "SA", "SM", "SMA") char (4) internal 1 34 static options (constant); 1 35 1 36 dcl ( 1 37 N_ACCESS_BIN init (00000b), 1 38 R_ACCESS_BIN init (01000b), 1 39 E_ACCESS_BIN init (00100b), 1 40 W_ACCESS_BIN init (00010b), 1 41 RW_ACCESS_BIN init (01010b), 1 42 RE_ACCESS_BIN init (01100b), 1 43 REW_ACCESS_BIN init (01110b), 1 44 S_ACCESS_BIN init (01000b), 1 45 M_ACCESS_BIN init (00010b), 1 46 A_ACCESS_BIN init (00001b), 1 47 SA_ACCESS_BIN init (01001b), 1 48 SM_ACCESS_BIN init (01010b), 1 49 SMA_ACCESS_BIN init (01011b) 1 50 ) fixed bin (5) internal static options (constant); 1 51 1 52 /* END INCLUDE FILE ... access_mode_values.incl.pl1 */ 207 208 209 210 end tolts_; /* thats it */ SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 12/09/86 1521.8 tolts_.pl1 >special_ldd>install>MR12.0-1235>tolts_.pl1 207 1 04/11/85 1452.6 access_mode_values.incl.pl1 >ldd>include>access_mode_values.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. RW_ACCESS_BIN 000000 constant fixed bin(5,0) initial dcl 1-36 set ref 118* 121* 127* R_ACCESS_BIN constant fixed bin(5,0) initial dcl 1-36 set ref 124* c_args 000100 automatic varying char(28) array dcl 47 set ref 151* 155 155 158 160 162 164 166 c_len 000500 automatic fixed bin(17,0) dcl 48 set ref 151* cardp 000502 automatic pointer initial dcl 49 set ref 49* cmd_cnt 000546 automatic fixed bin(17,0) dcl 52 set ref 151* code 000504 automatic fixed bin(35,0) dcl 50 set ref 190* 191 192 193* com_err_ 000010 constant entry external dcl 82 ref 132 193 200 com_string 000505 automatic char(132) dcl 51 set ref 151* 168* current_ring 000010 constant fixed bin(17,0) initial dcl 71 set ref 118* 121* 124* dir parameter char unaligned dcl 185 set ref 182 190* 193* 200* entry parameter char unaligned dcl 186 set ref 182 190* 193* 200* entry_var 000550 automatic entry variable dcl 53 set ref 137* 139* error_expected parameter fixed bin(35,0) dcl 184 ref 182 192 error_table_$moderr 000042 external static fixed bin(35,0) dcl 99 set ref 132* 200* error_table_$noentry 000044 external static fixed bin(35,0) dcl 100 set ref 127* hcs_$get_user_effmode 000012 constant entry external dcl 83 ref 190 ioa_ 000014 constant entry external dcl 84 ref 150 168 isolts_ 000016 constant entry external dcl 85 ref 164 linkage_error 000562 stack reference condition dcl 66 ref 131 140 lowest_access parameter fixed bin(5,0) dcl 187 ref 182 198 mca_$attach_mca 000020 constant entry external dcl 86 ref 139 mtdsim_ 000022 constant entry external dcl 87 ref 158 160 162 no_error_expected constant fixed bin(35,0) initial dcl 72 set ref 118* 121* 124* no_save_on_disconnect 000024 constant entry external dcl 88 ref 106 null builtin function dcl 62 ref 49 pname 000006 constant char(6) initial unaligned dcl 73 set ref 132* 193* 200* ring parameter fixed bin(17,0) dcl 188 set ref 182 190* ring_1 000044 constant fixed bin(17,0) initial dcl 74 set ref 127* save_on_disconnect 000026 constant entry external dcl 89 ref 174 sc_admin_dir 000001 constant char(14) initial unaligned dcl 76 set ref 121* sc_dir constant char(4) initial unaligned dcl 77 set ref 118* 124* sl_dir 000005 constant char(4) initial unaligned dcl 75 set ref 127* tandd_$ring_0_message 000030 constant entry external dcl 90 ref 137 tandd_ok 000554 automatic bit(1) unaligned dcl 54 set ref 132* 136* 138* term 000555 automatic bit(1) unaligned dcl 55 set ref 148* 149 155* tolts_util_$get_ttl_date 000032 constant entry external dcl 91 ref 107 tolts_util_$on_off 000034 constant entry external dcl 92 ref 108 173 tolts_util_$opr_msg 000036 constant entry external dcl 93 ref 166 tolts_util_$query 000040 constant entry external dcl 94 ref 151 ttl_date 000556 automatic char(6) unaligned dcl 56 set ref 107* 108* 173* user_access 000560 automatic fixed bin(5,0) dcl 57 set ref 190* 198 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. A_ACCESS internal static bit(3) initial unaligned dcl 1-11 A_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 DIR_ACCESS_MODE_NAMES internal static char(4) initial array unaligned dcl 1-33 E_ACCESS internal static bit(3) initial unaligned dcl 1-11 E_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 M_ACCESS internal static bit(3) initial unaligned dcl 1-11 M_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 N_ACCESS internal static bit(3) initial unaligned dcl 1-11 N_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 REW_ACCESS internal static bit(3) initial unaligned dcl 1-11 REW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RE_ACCESS internal static bit(3) initial unaligned dcl 1-11 RE_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RW_ACCESS internal static bit(3) initial unaligned dcl 1-11 R_ACCESS internal static bit(3) initial unaligned dcl 1-11 SA_ACCESS internal static bit(3) initial unaligned dcl 1-11 SA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SEG_ACCESS_MODE_NAMES internal static char(4) initial array unaligned dcl 1-30 SMA_ACCESS internal static bit(3) initial unaligned dcl 1-11 SMA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SM_ACCESS internal static bit(3) initial unaligned dcl 1-11 SM_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 S_ACCESS internal static bit(3) initial unaligned dcl 1-11 S_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 W_ACCESS internal static bit(3) initial unaligned dcl 1-11 W_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 NAMES DECLARED BY EXPLICIT CONTEXT. check_access 000643 constant entry internal dcl 182 ref 118 121 124 127 t_off 000616 constant label dcl 173 set ref 133 195 201 tolts_ 000154 constant entry external dcl 43 ref 107 107 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1340 1406 1135 1350 Length 1630 1135 46 206 202 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME tolts_ 482 external procedure is an external procedure. on unit on line 131 86 on unit check_access internal procedure shares stack frame of external procedure tolts_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME tolts_ 000100 c_args tolts_ 000500 c_len tolts_ 000502 cardp tolts_ 000504 code tolts_ 000505 com_string tolts_ 000546 cmd_cnt tolts_ 000550 entry_var tolts_ 000554 tandd_ok tolts_ 000555 term tolts_ 000556 ttl_date tolts_ 000560 user_access tolts_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return_mac tra_ext_1 enable_op ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ hcs_$get_user_effmode ioa_ isolts_ mca_$attach_mca mtdsim_ no_save_on_disconnect save_on_disconnect tandd_$ring_0_message tolts_util_$get_ttl_date tolts_util_$on_off tolts_util_$opr_msg tolts_util_$query THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$moderr error_table_$noentry LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 43 000153 49 000161 106 000163 107 000167 108 000204 118 000223 121 000232 124 000242 127 000247 131 000304 132 000320 133 000351 136 000354 137 000356 138 000363 139 000365 140 000371 148 000372 149 000373 150 000376 151 000412 155 000444 158 000461 160 000502 162 000523 164 000544 166 000557 168 000572 169 000615 173 000616 174 000635 176 000642 182 000643 190 000661 191 000720 192 000722 193 000726 195 000763 198 000764 200 000771 201 001025 ----------------------------------------------------------- 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