COMPILATION LISTING OF SEGMENT gtss_dump_kin_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 12/10/84 1302.0 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 gtss_dump_kin_: proc (il); 10 11 /* Store caller's kin input line on Multics file. 12* 13* Author: Dave Ward 12/05/80 14**/ 15 dcl il aligned char(*) parm; 16 lc = lc+1; /* Line count. */ 17 p6 = lc; /* Count of lines. */ 18 p3 = length (il); /* Length of kin line. */ 19 prefix = NL||"<<"||char (p6)||":"||char (p3)||">>"; 20 tl = prefix||il; 21 n = length (tl); 22 k = 0; 23 if (l+length (tl)) > (255*1024*4) then do; /* Complete segment. */ 24 k = (255*1024*4)-l; 25 substr (p (c) -> S, l+1, k) = substr (tl, 1, k); 26 c = c+1; 27 if c>hbound (p, 1) then do; 28 call com_err_ ( 29 0 30 , "gtss_dump_kin_" 31 , "Exhausted ^i segments for kin dump file, reusing." 32 , hbound (p, 1) 33 ); 34 c = 0; 35 end; 36 else do; /* Open next MSF component. */ 37 call msf_manager_$get_ptr ( /* Obtain next msf component. */ 38 fcbp /* (input) mfs control block pointer. */ 39 , c /* (input) component number. */ 40 , "1"b /* (input) create component if necessary. */ 41 , p (c) /* (output) pointer to component. */ 42 , (0) /* (output) bit count [not of interest]. */ 43 , code /* (ourtput) status code. */ 44 ); 45 if code ^= 0 then do; 46 if (code ^= error_table_$namedup) 47 & (code ^= error_table_$segknown) then 48 call com_err_ ( /* msf get_ptr failure. */ 49 code 50 , "gtss_dump_kin_" 51 , "Attempting to open component ^i of" 52 ||"^/^a>^a" 53 , c 54 , dir 55 , ent 56 ); 57 if p (c) = null () then signal cond (gtss_fail); 58 end; 59 end; 60 l = 0; 61 n = length (tl)-k; 62 end; 63 substr (p (c) -> S, l+1, n) = substr (tl, k+1, n); 64 l = l+n; 65 return; 66 67 init: entry returns (bit (1)); 68 69 /* Query caller for file to store 70* kin lines in. 71**/ 72 73 /* Ask caller for name of file in which 74* kin lines can be stored. 75**/ 76 dir, ent = " "; 77 fcbp, aclp, p = null (); 78 lc, l, c = 0; 79 yes_or_no_sw = "0"b; /* Not requesting yes or no. */ 80 suppress_name_sw = "0"b; /* Print caller's name. */ 81 status_code = 0; 82 call command_query_ ( 83 addr (query_info) 84 , ans 85 , "gtss" 86 , "Name of file to dump kin lines to? " 87 ); 88 89 /* Obtain directory and entry. */ 90 call expand_pathname_ ( 91 (ans) /* (input) dump file pathname. */ 92 , dir /* (output) directory. */ 93 , ent /* (output) entry. */ 94 , code /* (output) status code. */ 95 ); 96 if code ^= 0 then do; 97 call com_err_ ( /* pathname failed. */ 98 code 99 , "gtss_dump_kin_" 100 , "Can not expand ""^a""" 101 , ans 102 ); 103 return ("1"b); /* Fail. */ 104 end; 105 106 /* Obtain multi-segment file. */ 107 call tssi_$get_file ( /* Obtain dump file. */ 108 dir /* (input) directory. */ 109 , ent /* (input) entry name. */ 110 , p (0) /* (output) component 0. */ 111 , aclp /* (output) ACL info. */ 112 , fcbp /* (output) msf control block pointer. */ 113 , code /* (output) status. */ 114 ); 115 if code ^= 0 then do; 116 call com_err_ ( /* tssi failed. */ 117 code 118 , "gtss_dump_kin_" 119 , "^/^a>^a" 120 , dir 121 , ent 122 ); 123 return ("1"b); /* Failed. */ 124 end; 125 126 return ("0"b); /* Successful. */ 127 128 fin: entry; 129 130 /* Close the collection file. */ 131 call tssi_$finish_file ( 132 fcbp /* (input) msf control block pointer. */ 133 , c /* (input) component. */ 134 , l*9 /* (input) bit count (9 times # characters. */ 135 , "101"b /* (input) read and write access. */ 136 , aclp /* (input) pointer to ACL info. */ 137 , code /* (output). */ 138 ); 139 if code ^= 0 then 140 call com_err_ ( /* close failed. */ 141 code 142 , "gtss_dump_kin_" 143 , "^/^a>^a" 144 ||"^/fcb-ptr=^p acl-info-ptr=^p" 145 , dir 146 , ent 147 , fcbp 148 , aclp 149 ); 150 dir, ent = " "; 151 fcbp, aclp, p = null (); 152 lc, l, c = 0; 153 return; 154 155 clean: entry; 156 157 /* For cleanup condition processing. */ 158 call tssi_$clean_up_file (fcbp, aclp); 159 return; 160 161 /* IDENTIFIER ATTRIBUTES */ 162 /* Variables for gtss_dump_kin_ */ 163 dcl aclp ptr static int; 164 dcl ans char(256)var; 165 dcl c fixed bin static int; 166 dcl char builtin; 167 dcl code fixed bin(35); 168 dcl command_query_ entry() options(variable); 169 dcl com_err_ entry() options(variable); 170 dcl dir char(168) static int; 171 dcl ent char(32) static int; 172 dcl error_table_$namedup fixed bin(35) ext static; 173 dcl error_table_$segknown fixed bin(35) ext static; 174 dcl expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35)); 175 dcl fcbp ptr static int; 176 dcl gtss_fail condition ext; 177 dcl ioa_ entry() options(variable); 178 dcl k fixed bin(24); 179 dcl l fixed bin(24)static int; 180 dcl lc fixed bin(24)static int; 181 dcl length builtin; 182 dcl msf_manager_$get_ptr entry (ptr, fixed bin, bit(1), ptr, fixed bin(24), fixed bin(35)); 183 dcl n fixed bin(24); 184 dcl p (0:9)ptr static int; 185 dcl p3 pic "(3)9"; 186 dcl p6 pic "(6)9"; 187 dcl prefix char(15); 188 dcl S char(1044480)aligned based; 189 dcl tl char(400)var; 190 dcl tssi_$clean_up_file entry (ptr, ptr); 191 dcl tssi_$finish_file entry (ptr, fixed bin, fixed bin(24), bit(36) aligned, ptr, fixed bin(35)); 192 dcl tssi_$get_file entry (char(*), char(*), ptr, ptr, ptr, fixed bin(35)); 193 194 dcl NL char(1)static int options(constant) init(" 195 "); 196 1 1 /* BEGIN INCLUDE FILE query_info.incl.pl1 TAC June 1, 1973 */ 1 2 /* Renamed to query_info.incl.pl1 and cp_escape_control added, 08/10/78 WOS */ 1 3 /* version number changed to 4, 08/10/78 WOS */ 1 4 /* Version 5 adds explanation_(ptr len) 05/08/81 S. Herbst */ 1 5 /* Version 6 adds literal_sw, prompt_after_explanation switch 12/15/82 S. Herbst */ 1 6 1 7 dcl 1 query_info aligned, /* argument structure for command_query_ call */ 1 8 2 version fixed bin, /* version of this structure - must be set, see below */ 1 9 2 switches aligned, /* various bit switch values */ 1 10 3 yes_or_no_sw bit (1) unaligned init ("0"b), /* not a yes-or-no question, by default */ 1 11 3 suppress_name_sw bit (1) unaligned init ("0"b), /* do not suppress command name */ 1 12 3 cp_escape_control bit (2) unaligned init ("00"b), /* obey static default value */ 1 13 /* "01" -> invalid, "10" -> don't allow, "11" -> allow */ 1 14 3 suppress_spacing bit (1) unaligned init ("0"b), /* whether to print extra spacing */ 1 15 3 literal_sw bit (1) unaligned init ("0"b), /* ON => do not strip leading/trailing white space */ 1 16 3 prompt_after_explanation bit (1) unaligned init ("0"b), /* ON => repeat question after explanation */ 1 17 3 padding bit (29) unaligned init (""b), /* pads it out to t word */ 1 18 2 status_code fixed bin (35) init (0), /* query not prompted by any error, by default */ 1 19 2 query_code fixed bin (35) init (0), /* currently has no meaning */ 1 20 1 21 /* Limit of data defined for version 2 */ 1 22 1 23 2 question_iocbp ptr init (null ()), /* IO switch to write question */ 1 24 2 answer_iocbp ptr init (null ()), /* IO switch to read answer */ 1 25 2 repeat_time fixed bin (71) init (0), /* repeat question every N seconds if no answer */ 1 26 /* minimum of 30 seconds required for repeat */ 1 27 /* otherwise, no repeat will occur */ 1 28 /* Limit of data defined for version 4 */ 1 29 1 30 2 explanation_ptr ptr init (null ()), /* explanation of question to be printed if */ 1 31 2 explanation_len fixed bin (21) init (0); /* user answers "?" (disabled if ptr=null or len=0) */ 1 32 1 33 dcl query_info_version_3 fixed bin int static options (constant) init (3); 1 34 dcl query_info_version_4 fixed bin int static options (constant) init (4); 1 35 dcl query_info_version_5 fixed bin int static options (constant) init (5); 1 36 dcl query_info_version_6 fixed bin int static options (constant) init (6); /* the current version number */ 1 37 1 38 /* END INCLUDE FILE query_info.incl.pl1 */ 197 198 end gtss_dump_kin_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 12/10/84 1043.9 gtss_dump_kin_.pl1 >spec>on>7105>gtss_dump_kin_.pl1 197 1 03/11/83 1204.3 query_info.incl.pl1 >ldd>include>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. NL constant char(1) initial unaligned dcl 194 ref 19 S based char(1044480) dcl 188 set ref 25* 63* aclp 000010 internal static pointer dcl 163 set ref 77* 107* 131* 139* 151* 158* ans 000100 automatic varying char(256) dcl 164 set ref 82* 90 97* answer_iocbp 6 000370 automatic pointer initial level 2 dcl 1-7 set ref 1-7* c 000012 internal static fixed bin(17,0) dcl 165 set ref 25 26* 26 27 34* 37* 37 46* 57 63 78* 131* 152* char builtin function dcl 166 ref 19 19 code 000201 automatic fixed bin(35,0) dcl 167 set ref 37* 45 46 46 46* 90* 96 97* 107* 115 116* 131* 139 139* com_err_ 000130 constant entry external dcl 169 ref 28 46 97 116 139 command_query_ 000126 constant entry external dcl 168 ref 82 cp_escape_control 1(02) 000370 automatic bit(2) initial level 3 packed unaligned dcl 1-7 set ref 1-7* dir 000013 internal static char(168) unaligned dcl 170 set ref 46* 76* 90* 107* 116* 139* 150* ent 000065 internal static char(32) unaligned dcl 171 set ref 46* 76* 90* 107* 116* 139* 150* error_table_$namedup 000132 external static fixed bin(35,0) dcl 172 ref 46 error_table_$segknown 000134 external static fixed bin(35,0) dcl 173 ref 46 expand_pathname_ 000136 constant entry external dcl 174 ref 90 explanation_len 14 000370 automatic fixed bin(21,0) initial level 2 dcl 1-7 set ref 1-7* explanation_ptr 12 000370 automatic pointer initial level 2 dcl 1-7 set ref 1-7* fcbp 000076 internal static pointer dcl 175 set ref 37* 77* 107* 131* 139* 151* 158* gtss_fail 000202 stack reference condition dcl 176 ref 57 il parameter char dcl 15 ref 9 18 20 k 000210 automatic fixed bin(24,0) dcl 178 set ref 22* 24* 25 25 61 63 l 000100 internal static fixed bin(24,0) dcl 179 set ref 23 24 25 60* 63 64* 64 78* 131 152* lc 000101 internal static fixed bin(24,0) dcl 180 set ref 16* 16 17 78* 152* length builtin function dcl 181 ref 18 21 23 61 literal_sw 1(05) 000370 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* msf_manager_$get_ptr 000140 constant entry external dcl 182 ref 37 n 000211 automatic fixed bin(24,0) dcl 183 set ref 21* 61* 63 63 64 p 000102 internal static pointer array dcl 184 set ref 25 27 28 28 37* 57 63 77* 107* 151* p3 000212 automatic picture(3) unaligned dcl 185 set ref 18* 19 p6 000214 automatic picture(6) unaligned dcl 186 set ref 17* 19 padding 1(07) 000370 automatic bit(29) initial level 3 packed unaligned dcl 1-7 set ref 1-7* prefix 000216 automatic char(15) unaligned dcl 187 set ref 19* 20 prompt_after_explanation 1(06) 000370 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* query_code 3 000370 automatic fixed bin(35,0) initial level 2 dcl 1-7 set ref 1-7* query_info 000370 automatic structure level 1 dcl 1-7 set ref 82 82 question_iocbp 4 000370 automatic pointer initial level 2 dcl 1-7 set ref 1-7* repeat_time 10 000370 automatic fixed bin(71,0) initial level 2 dcl 1-7 set ref 1-7* status_code 2 000370 automatic fixed bin(35,0) initial level 2 dcl 1-7 set ref 81* 1-7* suppress_name_sw 1(01) 000370 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 80* 1-7* suppress_spacing 1(04) 000370 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* switches 1 000370 automatic structure level 2 dcl 1-7 tl 000222 automatic varying char(400) dcl 189 set ref 20* 21 23 25 61 63 tssi_$clean_up_file 000142 constant entry external dcl 190 ref 158 tssi_$finish_file 000144 constant entry external dcl 191 ref 131 tssi_$get_file 000146 constant entry external dcl 192 ref 107 yes_or_no_sw 1 000370 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 79* 1-7* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ioa_ 000000 constant entry external dcl 177 query_info_version_3 internal static fixed bin(17,0) initial dcl 1-33 query_info_version_4 internal static fixed bin(17,0) initial dcl 1-34 query_info_version_5 internal static fixed bin(17,0) initial dcl 1-35 query_info_version_6 internal static fixed bin(17,0) initial dcl 1-36 NAMES DECLARED BY EXPLICIT CONTEXT. clean 001260 constant entry external dcl 155 fin 001105 constant entry external dcl 128 gtss_dump_kin_ 000164 constant entry external dcl 9 init 000544 constant entry external dcl 67 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 82 82 hbound builtin function ref 27 28 28 null builtin function ref 57 77 151 1-7 1-7 1-7 substr builtin function set ref 25 25 63* 63 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1470 1640 1322 1500 Length 2064 1322 150 207 145 116 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME gtss_dump_kin_ 362 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 aclp gtss_dump_kin_ 000012 c gtss_dump_kin_ 000013 dir gtss_dump_kin_ 000065 ent gtss_dump_kin_ 000076 fcbp gtss_dump_kin_ 000100 l gtss_dump_kin_ 000101 lc gtss_dump_kin_ 000102 p gtss_dump_kin_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME gtss_dump_kin_ 000100 ans gtss_dump_kin_ 000201 code gtss_dump_kin_ 000210 k gtss_dump_kin_ 000211 n gtss_dump_kin_ 000212 p3 gtss_dump_kin_ 000214 p6 gtss_dump_kin_ 000216 prefix gtss_dump_kin_ 000222 tl gtss_dump_kin_ 000370 query_info gtss_dump_kin_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out return signal shorten_stack ext_entry ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ command_query_ expand_pathname_ msf_manager_$get_ptr tssi_$clean_up_file tssi_$finish_file tssi_$get_file THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$namedup error_table_$segknown LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1 7 000127 9 000161 16 000202 17 000204 18 000214 19 000224 20 000260 21 000304 22 000307 23 000310 24 000314 25 000317 26 000327 27 000330 28 000333 34 000373 35 000375 37 000376 45 000422 46 000424 57 000476 60 000510 61 000512 63 000515 64 000530 65 000532 67 000541 76 000553 77 000562 78 000601 79 000604 80 000606 81 000610 82 000611 90 000644 96 000701 97 000704 103 000742 107 000756 115 001011 116 001013 123 001054 126 001070 128 001104 131 001115 139 001143 150 001216 151 001225 152 001245 153 001250 155 001257 158 001270 159 001301 ----------------------------------------------------------- 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