COMPILATION LISTING OF SEGMENT expand_device_writer Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/23/85 1014.7 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* format: style2,ind3,ll80,dclind4,idind16,comcol41,linecom */ 10 11 expand_device_writer: 12 xdw: 13 proc; 14 me = "xdw"; 15 ME = "XDW"; 16 suffix = ".xdw"; 17 goto start; 18 19 macro: 20 entry; 21 me = "macro"; 22 ME = "MACRO"; 23 suffix = ".macro"; 24 25 dcl version char (6) int static init ("1.2b"); 26 dcl me char (32) var; 27 dcl ME char (8) var; 28 29 start: 30 code = 0; 31 segname = ""; 32 in_p, of_p = null (); 33 in_l, of_l = 0; 34 callp = null (); 35 in_sw, of_sw, pr_sw, long_sw = "0"b; 36 37 argno = 0; 38 argct = 0; 39 do while (code = 0); 40 argno = argno + 1; 41 call cu_$arg_ptr (argno, arg_p, arg_l, code); 42 if (code = 0) 43 then 44 do; 45 if (substr (arg, 1, 1) = "-") 46 then 47 do; 48 if (arg = "-pr") | (arg = "-print") 49 then pr_sw = "1"b; 50 if (arg = "-npr") | (arg = "-no_print") 51 then pr_sw = "0"b; 52 else if (arg = "-call") 53 then 54 do; 55 argno = argno + 1; 56 call cu_$arg_ptr (argno, arg_p, arg_l, code); 57 if (code ^= 0) 58 then 59 do; 60 call com_err_ (code, me, "-call value"); 61 return; 62 end; 63 callp = arg_p; 64 calll = arg_l; 65 end; 66 else if (arg = "-long") | (arg = "-lg") 67 then long_sw = "1"b; 68 else if (arg = "-brief") | (arg = "-bf") 69 then long_sw = "0"b; 70 else if (arg = "-instr") | (arg = "-input_string") 71 then 72 do; 73 if in_sw 74 then 75 do; 76 call com_err_ (0, me, 77 "Multiple input_strings supplied."); 78 return; 79 end; 80 if (in_p ^= null ()) 81 then goto not_both; 82 argno = argno + 1; 83 call cu_$arg_ptr (argno, arg_p, arg_l, code); 84 if (code ^= 0) 85 then 86 do; 87 call com_err_ (0, me, "Value for -in keyword.") 88 ; 89 return; 90 end; 91 in_sw = "1"b; 92 in_p = arg_p; 93 in_l = arg_l; 94 end; 95 else if (arg = "-ag") | (arg = "-arguments") 96 then 97 do; 98 do i = 1 to 25 while (code = 0); 99 argno = argno + 1; 100 call cu_$arg_ptr (argno, arg_p, arg_l, code); 101 if (code = 0) 102 then 103 do; 104 argct = argct + 1; 105 argl.p (argct) = arg_p; 106 argl.l (argct) = arg_l; 107 end; 108 end; 109 end; 110 else if (arg = "-of") | (arg = "-output_file") 111 then 112 do; 113 of_sw = "1"b; 114 argno = argno + 1; 115 call cu_$arg_ptr (argno, arg_p, arg_l, code); 116 if (code ^= 0) 117 then 118 do; 119 call com_err_ (0, me, "Value for -of keyword.") 120 ; 121 return; 122 end; 123 of_p = arg_p; 124 of_l = arg_l; 125 end; 126 else 127 do; 128 call com_err_ (error_table_$badopt, me, "^a", arg); 129 return; 130 end; 131 end; 132 else 133 do; 134 if (segname ^= "") 135 then 136 do; 137 call com_err_ (0, me, 138 "Multiple source names supplied."); 139 return; 140 end; 141 if (substr (arg, 1, 1) = "&") 142 then 143 do; 144 call com_err_ (0, me, 145 "Must now use -input_string to specify string to be expanded." 146 ); 147 return; 148 end; 149 if (in_p ^= null ()) 150 then 151 do; 152 not_both: 153 call com_err_ (0, me, 154 "Cannot supply both string and segment as input." 155 ); 156 return; 157 end; 158 call expand_pathname_ (arg, dname, ename, code); 159 if (code ^= 0) 160 then 161 do; 162 call com_err_ (code, me, "^a", arg); 163 return; 164 end; 165 ename = before (ename, suffix); 166 segname = rtrim (ename); 167 call hcs_$initiate_count (dname, segname || suffix, "", 168 in_l, 0, in_p, code); 169 if (in_p = null ()) 170 then 171 do; 172 call com_err_ (code, me, "^a>^a^a", dname, ename, 173 suffix); 174 return; 175 end; 176 in_l = divide (in_l, 9, 24, 0); 177 code = 0; 178 end; 179 end; 180 181 else if argno = 1 182 then 183 do; 184 call com_err_ (code, ME, 185 "^/Usage is: expand_device_writer {path} {-control_args}"); 186 return; 187 end; 188 end; 189 190 if (segname = "") & (in_p = null ()) | (argno = 1) 191 then 192 do; 193 if (suffix = ".macro") 194 then call com_err_ (0, me, 195 "(^a) Proper usage is: ^a {path} {-control_args}", 196 version, me); 197 return; 198 end; 199 200 if ^of_sw 201 then if in_sw 202 then pr_sw = "1"b; 203 else dname = get_wdir_ (); 204 call get_temp_segments_ ((me), ptra, code); 205 out_ptr = ptra (1); 206 if (code ^= 0) 207 then 208 do; 209 call com_err_ (code, me); 210 return; 211 end; 212 213 out_len = 0; 214 call ioa_ ("^a ^a", ME, version); 215 on condition (cleanup) 216 begin; 217 call xdw_$free (long_sw); 218 call release_temp_segments_ ((me), ptra, code); 219 end; 220 call xdw_$expand (me, segname, "", out_ptr, out_len, addr (argl), (argct), 221 msg, in_p, in_l, code); 222 call xdw_$free (long_sw); 223 if (code ^= 0) 224 then 225 do; 226 if (code = 1) | (code = -1) 227 then icode = 0; 228 else icode = code; 229 call com_err_ (icode, me, "^a", msg); 230 end; 231 if pr_sw 232 then 233 do; 234 call iox_$put_chars (iox_$user_output, out_ptr, out_len, code); 235 end; 236 else if (code = 0) 237 then 238 do; 239 if (of_p ^= null ()) 240 then 241 do; 242 arg_p = of_p; 243 arg_l = of_l; 244 call expand_pathname_ (arg, dname, ename, code); 245 if (code ^= 0) 246 then 247 do; 248 call com_err_ (0, me, "^a", arg); 249 goto done; 250 end; 251 end; 252 call hcs_$make_seg (dname, ename, "", 01010b, out_ptr, code); 253 if (out_ptr = null ()) 254 then call com_err_ (code, me, "^a>^a", dname, ename); 255 else 256 do; 257 substr (out_ptr -> str, 1, out_len) = 258 substr (ptra (1) -> str, 1, out_len); 259 call hcs_$set_bc_seg (out_ptr, out_len * 9, code); 260 call hcs_$terminate_noname (out_ptr, code); 261 if (code ^= 0) 262 then call com_err_ (code, me); 263 if (code = 0) & (callp ^= null ()) 264 then call cu_$cp (callp, calll, 0); 265 end; 266 end; 267 done: 268 call release_temp_segments_ ((me), ptra, code); 269 270 271 dcl 1 argl (25), 272 2 p ptr, 273 2 l fixed bin (24); 274 dcl argct fixed bin (24); 275 276 dcl in_p ptr; 277 dcl in_l fixed bin (24); 278 dcl of_p ptr; 279 dcl of_sw bit (1); 280 dcl in_sw bit (1); 281 dcl of_l fixed bin (24); 282 dcl get_wdir_ entry returns (char (168)); 283 dcl icode fixed bin (35); 284 dcl dname char (168); 285 dcl suffix char (32) var; 286 dcl ename char (32); 287 dcl expand_pathname_ 288 entry (char (*), char (*), char (*), fixed bin (35)); 289 dcl arg char (arg_l) based (arg_p); 290 dcl arg_l fixed bin; 291 dcl arg_p ptr; 292 dcl argno fixed bin; 293 dcl calll fixed bin (24); 294 dcl callp ptr; 295 dcl cleanup condition; 296 dcl code fixed bin (35); 297 dcl com_err_ entry options (variable); 298 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 299 dcl cu_$cp entry (ptr, fixed bin (24), fixed bin (35)); 300 dcl error_table_$badopt 301 fixed bin (35) ext static; 302 dcl get_temp_segments_ 303 entry (char (*), (*) ptr, fixed bin (35)); 304 dcl i fixed bin; 305 dcl ioa_ entry options (variable); 306 dcl iox_$put_chars entry (ptr, ptr, fixed bin (24), fixed bin (35)); 307 dcl iox_$user_output 308 ptr ext static; 309 dcl long_sw bit (1); 310 dcl segname char (32) var; 311 dcl xdw_$expand entry (char (32) var, char (32) var, char (32) var, 312 ptr, fixed bin (24), ptr, fixed bin, char (1000) var, 313 ptr, fixed bin (24), fixed bin (35)); 314 dcl xdw_$free entry (bit (1)); 315 dcl msg char (1000) var; 316 dcl out_len fixed bin (24); 317 dcl out_ptr ptr; 318 dcl pr_sw bit (1); 319 dcl hcs_$initiate_count 320 entry (char (*), char (*), char (*), fixed bin (24), 321 fixed bin (2), ptr, fixed bin (35)); 322 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), 323 ptr, fixed bin (35)); 324 dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); 325 dcl hcs_$terminate_noname 326 entry (ptr, fixed bin (35)); 327 dcl ptra (1) ptr; 328 dcl release_temp_segments_ 329 entry (char (*), (*) ptr, fixed bin (35)); 330 dcl str char (262144) based; 331 end expand_device_writer; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/23/85 0911.5 expand_device_writer.pl1 >spec>online>comp>expand_device_writer.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. ME 000111 automatic varying char(8) dcl 27 set ref 15* 22* 184* 214* arg based char unaligned dcl 289 set ref 45 48 48 50 50 52 66 66 68 68 70 70 95 95 110 110 128* 141 158* 162* 244* 248* arg_l 000367 automatic fixed bin(17,0) dcl 290 set ref 41* 45 48 48 50 50 52 56* 64 66 66 68 68 70 70 83* 93 95 95 100* 106 110 110 115* 124 128 128 141 158 158 162 162 243* 244 244 248 248 arg_p 000370 automatic pointer dcl 291 set ref 41* 45 48 48 50 50 52 56* 63 66 66 68 68 70 70 83* 92 95 95 100* 105 110 110 115* 123 128 141 158 162 242* 244 248 argct 000260 automatic fixed bin(24,0) dcl 274 set ref 38* 104* 104 105 106 220 argl 000114 automatic structure array level 1 unaligned dcl 271 set ref 220 220 argno 000372 automatic fixed bin(17,0) dcl 292 set ref 37* 40* 40 41* 55* 55 56* 82* 82 83* 99* 99 100* 114* 114 115* 181 190 calll 000373 automatic fixed bin(24,0) dcl 293 set ref 64* 263* callp 000374 automatic pointer dcl 294 set ref 34* 63* 263 263* cleanup 000376 stack reference condition dcl 295 ref 215 code 000404 automatic fixed bin(35,0) dcl 296 set ref 29* 39 41* 42 56* 57 60* 83* 84 98 100* 101 115* 116 158* 159 162* 167* 172* 177* 184* 204* 206 209* 218* 220* 223 226 226 228 234* 236 244* 245 252* 253* 259* 260* 261 261* 263 267* com_err_ 000016 constant entry external dcl 297 ref 60 76 87 119 128 137 144 152 162 172 184 193 209 229 248 253 261 cu_$arg_ptr 000020 constant entry external dcl 298 ref 41 56 83 100 115 cu_$cp 000022 constant entry external dcl 299 ref 263 dname 000274 automatic char(168) unaligned dcl 284 set ref 158* 167* 172* 203* 244* 252* 253* ename 000357 automatic char(32) unaligned dcl 286 set ref 158* 165* 165 166 172* 244* 252* 253* error_table_$badopt 000024 external static fixed bin(35,0) dcl 300 set ref 128* expand_pathname_ 000014 constant entry external dcl 287 ref 158 244 get_temp_segments_ 000026 constant entry external dcl 302 ref 204 get_wdir_ 000012 constant entry external dcl 282 ref 203 hcs_$initiate_count 000042 constant entry external dcl 319 ref 167 hcs_$make_seg 000044 constant entry external dcl 322 ref 252 hcs_$set_bc_seg 000046 constant entry external dcl 324 ref 259 hcs_$terminate_noname 000050 constant entry external dcl 325 ref 260 i 000405 automatic fixed bin(17,0) dcl 304 set ref 98* icode 000273 automatic fixed bin(35,0) dcl 283 set ref 226* 228* 229* in_l 000264 automatic fixed bin(24,0) dcl 277 set ref 33* 93* 167* 176* 176 220* in_p 000262 automatic pointer dcl 276 set ref 32* 80 92* 149 167* 169 190 220* in_sw 000271 automatic bit(1) unaligned dcl 280 set ref 35* 73 91* 200 ioa_ 000030 constant entry external dcl 305 ref 214 iox_$put_chars 000032 constant entry external dcl 306 ref 234 iox_$user_output 000034 external static pointer dcl 307 set ref 234* l 2 000114 automatic fixed bin(24,0) array level 2 dcl 271 set ref 106* long_sw 000406 automatic bit(1) unaligned dcl 309 set ref 35* 66* 68* 217* 222* me 000100 automatic varying char(32) dcl 26 set ref 14* 21* 60* 76* 87* 119* 128* 137* 144* 152* 162* 172* 193* 193* 204 209* 218 220* 229* 248* 253* 261* 267 msg 000420 automatic varying char(1000) dcl 315 set ref 220* 229* of_l 000272 automatic fixed bin(24,0) dcl 281 set ref 33* 124* 243 of_p 000266 automatic pointer dcl 278 set ref 32* 123* 239 242 of_sw 000270 automatic bit(1) unaligned dcl 279 set ref 35* 113* 200 out_len 001013 automatic fixed bin(24,0) dcl 316 set ref 213* 220* 234* 257 257 259 out_ptr 001014 automatic pointer dcl 317 set ref 205* 220* 234* 252* 253 257 259* 260* p 000114 automatic pointer array level 2 dcl 271 set ref 105* pr_sw 001016 automatic bit(1) unaligned dcl 318 set ref 35* 48* 50* 200* 231 ptra 001020 automatic pointer array dcl 327 set ref 204* 205 218* 257 267* release_temp_segments_ 000052 constant entry external dcl 328 ref 218 267 segname 000407 automatic varying char(32) dcl 310 set ref 31* 134 166* 167 190 220* str based char(262144) unaligned dcl 330 set ref 257* 257 suffix 000346 automatic varying char(32) dcl 285 set ref 16* 23* 165 167 172* 193 version 000010 internal static char(6) initial unaligned dcl 25 set ref 193* 214* xdw_$expand 000036 constant entry external dcl 311 ref 220 xdw_$free 000040 constant entry external dcl 314 ref 217 222 NAMES DECLARED BY EXPLICIT CONTEXT. done 002356 constant label dcl 267 ref 249 expand_device_writer 000247 constant entry external dcl 11 macro 000271 constant entry external dcl 19 not_both 001131 constant label dcl 152 ref 80 start 000314 constant label dcl 29 ref 17 xdw 000240 constant entry external dcl 11 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 220 220 before builtin function ref 165 divide builtin function ref 176 null builtin function ref 32 34 80 149 169 190 239 253 263 rtrim builtin function ref 166 substr builtin function set ref 45 141 257* 257 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2646 2722 2413 2656 Length 3142 2413 54 204 232 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME xdw 608 external procedure is an external procedure. on unit on line 215 86 on unit STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 version xdw STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME xdw 000100 me xdw 000111 ME xdw 000114 argl xdw 000260 argct xdw 000262 in_p xdw 000264 in_l xdw 000266 of_p xdw 000270 of_sw xdw 000271 in_sw xdw 000272 of_l xdw 000273 icode xdw 000274 dname xdw 000346 suffix xdw 000357 ename xdw 000367 arg_l xdw 000370 arg_p xdw 000372 argno xdw 000373 calll xdw 000374 callp xdw 000404 code xdw 000405 i xdw 000406 long_sw xdw 000407 segname xdw 000420 msg xdw 001013 out_len xdw 001014 out_ptr xdw 001016 pr_sw xdw 001020 ptra xdw THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out return enable shorten_stack ext_entry int_entry set_cs_eis index_before_cs THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_ptr cu_$cp expand_pathname_ get_temp_segments_ get_wdir_ hcs_$initiate_count hcs_$make_seg hcs_$set_bc_seg hcs_$terminate_noname ioa_ iox_$put_chars release_temp_segments_ xdw_$expand xdw_$free THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt iox_$user_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000237 14 000254 15 000260 16 000263 17 000267 19 000270 21 000276 22 000303 23 000307 29 000314 31 000315 32 000316 33 000321 34 000323 35 000325 37 000331 38 000332 39 000333 40 000336 41 000337 42 000354 45 000356 48 000365 50 000400 52 000412 55 000416 56 000417 57 000434 60 000436 61 000463 63 000464 64 000466 65 000470 66 000471 68 000504 70 000517 73 000527 76 000531 78 000556 80 000557 82 000563 83 000564 84 000601 87 000603 89 000633 91 000634 92 000636 93 000640 94 000642 95 000643 98 000653 99 000663 100 000664 101 000701 104 000703 105 000704 106 000710 108 000713 109 000715 110 000716 113 000726 114 000730 115 000731 116 000746 119 000750 121 001000 123 001001 124 001003 125 001005 128 001006 129 001040 131 001041 134 001042 137 001047 139 001074 141 001075 144 001077 147 001124 149 001125 152 001131 156 001156 158 001157 159 001207 162 001211 163 001243 165 001244 166 001255 167 001275 169 001356 172 001363 174 001421 176 001422 177 001425 179 001426 181 001427 184 001432 186 001456 188 001457 190 001460 193 001474 197 001535 200 001536 203 001545 204 001554 205 001605 206 001610 209 001612 210 001627 213 001630 214 001631 215 001654 217 001670 218 001677 219 001731 220 001733 222 001773 223 002002 226 002004 228 002012 229 002013 231 002042 234 002044 235 002061 236 002062 239 002064 242 002070 243 002072 244 002074 245 002123 248 002125 249 002160 252 002161 253 002220 257 002260 259 002266 260 002304 261 002315 263 002334 267 002356 331 002407 ----------------------------------------------------------- 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