COMPILATION LISTING OF SEGMENT gcos_print_file Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/19/82 1014.6 mst Fri 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 gcos_print_file: gpf: proc; 12 13 14 /* DECLARATIONS */ 15 /* ------------ */ 16 17 18 19 /* fixed bin */ 20 /* ----- --- */ 21 22 dcl ( 23 al, /* argument length */ 24 arg_count, /* argument count */ 25 i, /* loop index */ 26 line_length /* length of line read */ 27 ) fixed bin aligned; 28 29 dcl ( 30 bitcnt /* bit count returned from status_mins */ 31 ) fixed bin (24) aligned; 32 33 dcl ( 34 code, /* error code */ 35 error_table_$noarg ext, 36 error_table_$badopt ext 37 ) fixed bin (35) aligned; 38 39 40 /* bit strings */ 41 /* --- ------- */ 42 43 dcl ( 44 brief init ("0"b), /* ON if brief option specified */ 45 data_type, /* from gcos_read_line_: "1"b = bcd, "0"b = binary */ 46 end_of_input, /* ON when end of input is read */ 47 input_is_a_file init ("1"b), /* ON if input is from a file */ 48 input_is_attached init ("0"b), /* ON if input device is attached */ 49 nine_track_read_wanted init ("0"b), /* ON if nine-track tape is to be read */ 50 no_arguments_were_found init ("1"b), /* ON until a non-option argument is found */ 51 input_was_read init ("0"b), /* ON after first successful write call */ 52 read_init_was_called init ("0"b) /* ON after gsr_read_init is called */ 53 ) bit (1) aligned; 54 55 dcl ( 56 status_bits /* returned status from ios_ calls */ 57 ) bit (72) aligned; 58 59 dcl ( 60 line /* bit equivalent of line read by gcos_read_line_ */ 61 ) bit (980) aligned; 62 63 64 /* character strings */ 65 /* --------- ------- */ 66 67 dcl ( 68 option /* fixed location for option arguments */ 69 ) char (4) aligned; 70 71 dcl ( 72 device_name init ("file_") /* attach name for input device */ 73 ) char (8) aligned; 74 75 dcl ( 76 input_pn /* input path-name or tape label */ 77 ) char (168) aligned; 78 79 80 /* pointers */ 81 /* -------- */ 82 83 dcl ( 84 ap, /* argument pointer */ 85 line_ptr, /* pointer to bit string read by gcos_read_line_ */ 86 sp /* pointer to returned status bits from ios_ */ 87 ) ptr aligned; 88 89 90 /* conditions */ 91 /* ---------- */ 92 93 dcl ( 94 cleanup 95 ) condition; 96 97 98 /* built in functions */ 99 /* ----- -- --------- */ 100 101 dcl ( 102 addr, 103 null, 104 substr 105 ) builtin; 106 107 108 /* masks */ 109 /* ----- */ 110 111 dcl arg_mask char (al) unaligned based (ap); /* argument mask */ 112 113 dcl 1 status aligned based (sp), /* for checking returned status from ios_ calls */ 114 2 scode fixed bin (35) aligned; /* error code portion of status */ 115 116 117 /* external entries */ 118 /* -------- ------- */ 119 120 dcl com_err_ ext entry 121 options (variable); 122 123 dcl cu_$arg_count ext entry 124 (fixed bin aligned); 125 126 dcl cu_$arg_ptr ext entry 127 (fixed bin aligned, ptr aligned, fixed bin aligned, fixed bin (35) aligned); 128 129 dcl gcos_read_line_ ext entry 130 (ptr aligned, fixed bin aligned, bit (1) aligned, bit (1) aligned, fixed bin (35) aligned); 131 132 dcl gcos_read_line_$read_line_init ext entry 133 (bit (1) aligned, fixed bin (35) aligned); 134 135 dcl gcos_write_line_ ext entry 136 (ptr aligned, bit (1) aligned, bit (1) aligned, fixed bin (35) aligned); 137 138 dcl gcos_gsr_read_$gsr_read_close ext entry 139 (char (*) aligned, fixed bin (35) aligned); 140 141 dcl ios_$attach ext entry 142 (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); 143 144 dcl ios_$detach ext entry 145 (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); 146 147 dcl ios_$setsize ext entry 148 (char (*) aligned, fixed bin aligned, bit (72) aligned); 149 150 /* */ 151 line_ptr = addr (line); /* pointer to bit string read by gcos_read_line_ */ 152 sp = addr (status_bits); /* pointer to returned status bits from ios_ */ 153 154 on condition (cleanup) /* establish cleanup handler */ 155 call detach_input; 156 157 call cu_$arg_count (arg_count); /* get number of arguments */ 158 if arg_count = 0 /* error, no arguments */ 159 then do; 160 call com_err_ (error_table_$noarg, "gcos_print_file", ""); 161 return; 162 end; 163 164 165 /* */ 166 167 do i = 1 to arg_count; /* ARGUMENT LOOP */ 168 169 call cu_$arg_ptr (i, ap, al, code); /* fetch an argument */ 170 if code ^= 0 /* fatal error */ 171 then do; 172 call com_err_ (code, "gcos_print_file", "Error fetching argument (^d)", i); 173 call detach_input; 174 return; 175 end; 176 177 if substr (arg_mask, 1, 1) = "-" /* argument is an option */ 178 then do; 179 180 option = arg_mask; /* fix the argument */ 181 182 if option = "-ti" /* input is from tape */ 183 then do; 184 input_is_a_file = "0"b; 185 device_name = "nstd_"; 186 end; 187 188 else 189 if option = "-fi" /* input is from a file */ 190 then do; 191 input_is_a_file = "1"b; 192 device_name = "file_"; 193 end; 194 195 else 196 if option = "-9" /* request to read nine-track tape */ 197 then nine_track_read_wanted = "1"b; 198 199 else 200 if option = "-7" /* request to read seven-track tape */ 201 then nine_track_read_wanted = "0"b; 202 203 else 204 if option = "-bf" /* brief option */ 205 then brief = "1"b; /* remember */ 206 207 else 208 if option = "-lg" /* long option */ 209 then brief = "0"b; /* remember */ 210 211 else /* unrecognized option */ 212 do; 213 call com_err_ (error_table_$badopt, "gcos_print_file", option); 214 return; 215 end; 216 217 end; 218 219 else /* argument is not an option */ 220 do; 221 222 no_arguments_were_found = "0"b; 223 224 call detach_input; 225 if input_is_a_file 226 then do; 227 if nine_track_read_wanted /* error, tape option on file request */ 228 then do; 229 call com_err_ (0, "gcos_print_file", "Nine track read specified for file input: ^a", input_pn); 230 go to END_LOOP; 231 end; 232 input_pn = arg_mask; /* set path-name of input file */ 233 234 end; 235 236 else /* tape input */ 237 do; 238 input_pn = arg_mask||",7track"; /* make up tape label */ 239 if nine_track_read_wanted 240 then substr (input_pn, al+2, 1) = "9"; 241 end; 242 243 call ios_$attach ("input_stream", device_name, input_pn, "r", status_bits); 244 if scode ^= 0 /* error attaching input stream */ 245 then do; 246 call com_err_ (scode, "gcos_print_file", "Error attaching ^a", input_pn); 247 return; 248 end; 249 else /* input stream attached */ 250 input_is_attached = "1"b; /* remember */ 251 252 if input_is_a_file /* input is from a file */ 253 then do; 254 call ios_$setsize ("input_stream", 36, status_bits); /* set input size to full word */ 255 if scode ^= 0 /* error setting input size */ 256 then do; 257 call com_err_ (scode, "gcos_print_file", "Error setting element size on input_stream"); 258 call detach_input; 259 return; 260 end; 261 end; 262 263 call gcos_read_line_$read_line_init (input_is_a_file, code); /* initialization for reads */ 264 if code ^= 0 265 then do; 266 call com_err_ (0, "gcos_print_file", "Error in read initialization call"); 267 call detach_input; 268 return; 269 end; 270 read_init_was_called = "1"b; /* remember call was made */ 271 272 end_of_input = "0"b; 273 do while (^end_of_input); 274 275 call gcos_read_line_ (line_ptr, line_length, data_type, end_of_input, code); 276 /* read a line of output */ 277 if code ^= 0 /* error reading line */ 278 then do; 279 call com_err_ (code, "gcos_print_file", "Error reading from ^a", input_pn); 280 call detach_input; 281 return; 282 end; 283 284 if line_length ^= 0 /* something was read */ 285 then do; 286 input_was_read = "1"b; /* remember */ 287 288 call gcos_write_line_ (line_ptr, data_type, brief, code); /* write the line */ 289 if code > 1 /* error writing line */ 290 then do; 291 call com_err_ (code, "gcos_print_file", "Error writing into user_output"); 292 call detach_input; 293 return; 294 end; 295 296 end; 297 298 end; 299 300 if ^input_was_read /* implies no input was read */ 301 then call com_err_ (0, "gcos_print_file", "Zero length input: ^a", input_pn); 302 303 end; 304 305 END_LOOP: 306 307 end; /* END OF ARGUMENT LOOP */ 308 309 if no_arguments_were_found /* all arguments were options */ 310 then call com_err_ (error_table_$noarg, "gcos_print_file", ""); 311 312 call detach_input; 313 314 return; 315 316 /* */ 317 318 /* INTERNAL PROCEDURES */ 319 320 321 322 detach_input: proc; 323 324 if input_is_attached 325 then do; 326 327 call ios_$detach ("input_stream", input_pn, "", status_bits); 328 if scode ^= 0 329 then call com_err_ (scode, "gcos_print_file", "Error detaching ^a", input_pn); 330 331 end; 332 333 input_is_attached = "0"b; 334 335 if read_init_was_called 336 then do; 337 call gcos_gsr_read_$gsr_read_close ("input_stream", code); 338 read_init_was_called = "0"b; 339 end; 340 341 return; 342 343 end detach_input; 344 345 346 347 end gcos_print_file; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/19/82 0934.2 gcos_print_file.pl1 >spec>on>11/19/82>gcos_print_file.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 101 ref 151 152 al 000100 automatic fixed bin(17,0) dcl 22 set ref 169* 177 180 232 238 239 ap 000232 automatic pointer dcl 83 set ref 169* 177 180 232 238 arg_count 000101 automatic fixed bin(17,0) dcl 22 set ref 157* 158 167 arg_mask based char unaligned dcl 111 ref 177 180 232 238 brief 000105 automatic bit(1) initial dcl 43 set ref 43* 203* 207* 288* cleanup 000240 stack reference condition dcl 93 ref 154 code 000104 automatic fixed bin(35,0) dcl 33 set ref 169* 170 172* 263* 264 275* 277 279* 288* 289 291* 337* com_err_ 000014 constant entry external dcl 120 ref 160 172 213 229 246 257 266 279 291 300 309 328 cu_$arg_count 000016 constant entry external dcl 123 ref 157 cu_$arg_ptr 000020 constant entry external dcl 126 ref 169 data_type 000106 automatic bit(1) dcl 43 set ref 275* 288* device_name 000156 automatic char(8) initial dcl 71 set ref 71* 185* 192* 243* end_of_input 000107 automatic bit(1) dcl 43 set ref 272* 273 275* error_table_$badopt 000012 external static fixed bin(35,0) dcl 33 set ref 213* error_table_$noarg 000010 external static fixed bin(35,0) dcl 33 set ref 160* 309* gcos_gsr_read_$gsr_read_close 000030 constant entry external dcl 138 ref 337 gcos_read_line_ 000022 constant entry external dcl 129 ref 275 gcos_read_line_$read_line_init 000024 constant entry external dcl 132 ref 263 gcos_write_line_ 000026 constant entry external dcl 135 ref 288 i 000102 automatic fixed bin(17,0) dcl 22 set ref 167* 169* 172* input_is_a_file 000110 automatic bit(1) initial dcl 43 set ref 43* 184* 191* 225 252 263* input_is_attached 000111 automatic bit(1) initial dcl 43 set ref 43* 249* 324 333* input_pn 000160 automatic char(168) dcl 75 set ref 229* 232* 238* 239* 243* 246* 279* 300* 327* 328* input_was_read 000114 automatic bit(1) initial dcl 43 set ref 43* 286* 300 ios_$attach 000032 constant entry external dcl 141 ref 243 ios_$detach 000034 constant entry external dcl 144 ref 327 ios_$setsize 000036 constant entry external dcl 147 ref 254 line 000120 automatic bit(980) dcl 59 set ref 151 line_length 000103 automatic fixed bin(17,0) dcl 22 set ref 275* 284 line_ptr 000234 automatic pointer dcl 83 set ref 151* 275* 288* nine_track_read_wanted 000112 automatic bit(1) initial dcl 43 set ref 43* 195* 199* 227 239 no_arguments_were_found 000113 automatic bit(1) initial dcl 43 set ref 43* 222* 309 option 000154 automatic char(4) dcl 67 set ref 180* 182 188 195 199 203 207 213* read_init_was_called 000115 automatic bit(1) initial dcl 43 set ref 43* 270* 335 338* scode based fixed bin(35,0) level 2 dcl 113 set ref 244 246* 255 257* 328 328* sp 000236 automatic pointer dcl 83 set ref 152* 244 246 255 257 328 328 status based structure level 1 dcl 113 status_bits 000116 automatic bit(72) dcl 55 set ref 152 243* 254* 327* substr builtin function dcl 101 set ref 177 239* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. bitcnt automatic fixed bin(24,0) dcl 29 null builtin function dcl 101 NAMES DECLARED BY EXPLICIT CONTEXT. END_LOOP 001307 constant label dcl 305 ref 230 detach_input 001350 constant entry internal dcl 322 ref 154 173 224 258 267 280 292 312 gcos_print_file 000200 constant entry external dcl 11 gpf 000170 constant entry external dcl 11 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1672 1732 1502 1702 Length 2130 1502 40 162 170 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME gpf 228 external procedure is an external procedure. on unit on line 154 64 on unit detach_input 110 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME gpf 000100 al gpf 000101 arg_count gpf 000102 i gpf 000103 line_length gpf 000104 code gpf 000105 brief gpf 000106 data_type gpf 000107 end_of_input gpf 000110 input_is_a_file gpf 000111 input_is_attached gpf 000112 nine_track_read_wanted gpf 000113 no_arguments_were_found gpf 000114 input_was_read gpf 000115 read_init_was_called gpf 000116 status_bits gpf 000120 line gpf 000154 option gpf 000156 device_name gpf 000160 input_pn gpf 000232 ap gpf 000234 line_ptr gpf 000236 sp gpf THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return enable shorten_stack ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_ptr gcos_gsr_read_$gsr_read_close gcos_read_line_ gcos_read_line_$read_line_init gcos_write_line_ ios_$attach ios_$detach ios_$setsize THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$noarg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 43 000153 71 000163 11 000167 151 000206 152 000210 154 000212 157 000234 158 000243 160 000245 161 000274 167 000275 169 000303 170 000320 172 000322 173 000360 174 000364 177 000365 180 000372 182 000376 184 000403 185 000404 186 000406 188 000407 191 000414 192 000416 193 000420 195 000421 199 000431 203 000440 207 000450 213 000457 214 000506 217 000507 222 000510 224 000511 225 000515 227 000520 229 000522 230 000561 232 000562 234 000567 238 000570 239 000606 243 000615 244 000654 246 000656 247 000717 249 000720 252 000722 254 000725 255 000754 257 000756 258 001010 259 001014 263 001015 264 001026 266 001030 267 001063 268 001067 270 001070 272 001072 273 001073 275 001076 277 001115 279 001117 280 001155 281 001161 284 001162 286 001164 288 001166 289 001203 291 001206 292 001240 293 001244 298 001245 300 001246 305 001307 309 001311 312 001342 314 001346 322 001347 324 001355 327 001360 328 001410 333 001451 335 001453 337 001455 338 001476 341 001500 ----------------------------------------------------------- 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