COMPILATION LISTING OF SEGMENT close_file Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/18/84 1647.7 mst Wed 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 /* modified 03/21/84 by Melanie Weaver to close pascal files */ 11 12 /* format: style3,^indnoniterdo */ 13 close_file: 14 cf: 15 proc; 16 dcl arg char (cnt) based (arg_ptr) unal; 17 dcl (arg_count, cnt, i) fixed bin (17); 18 dcl arg_ptr ptr; 19 dcl code fixed bin (35); 20 dcl com_err_ entry options (variable); 21 dcl (convert, substr, verify) 22 builtin; 23 dcl cu_$arg_count entry (fixed bin), 24 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 25 dcl ( 26 error_table_$noarg, 27 error_table_$badopt, 28 error_table_$no_file 29 ) ext static fixed bin (35); 30 dcl f_file fixed bin; 31 dcl (fortran_code, pl1_code, pascal_code) 32 fixed bin (35); 33 dcl fortran_io_$close_file 34 entry (fixed bin, fixed bin (35)); 35 dcl ft_file char (2); 36 dcl linkage_error condition; 37 dcl msg char (80); 38 dcl plio2_$close_all_ entry, 39 plio2_$close_by_name_sys_ 40 entry (char (*) unal, fixed bin (35)); 41 dcl pascal_io_$close_all 42 entry; 43 dcl pascal_io_$close_by_name 44 entry (char (*), fixed bin (35)); 45 46 call cu_$arg_count (arg_count); 47 if arg_count = 0 48 then do; /* needs args */ 49 code = error_table_$noarg; 50 msg = "argument must be -all, or 1 or more file names."; 51 go to error_return; 52 end; 53 54 else do i = 1 to arg_count; 55 msg = ""; 56 fortran_code, pl1_code, pascal_code = 1; 57 call cu_$arg_ptr (i, arg_ptr, cnt, code); 58 if code ^= 0 59 then do; 60 error_return: 61 call com_err_ (code, "close_file", "^a", msg); 62 return; 63 end; 64 if substr (arg, 1, 1) = "-" 65 then if arg ^= "-all" & arg ^= "-a" 66 then do; /* bad option */ 67 code = error_table_$badopt; 68 msg = arg || "."; 69 go to error_return; 70 end; 71 72 if arg = "-all" | arg = "-a" 73 then do; /* close all of them */ 74 on linkage_error 75 begin; 76 fortran_code = 1; 77 go to SKIP_FORTRAN_ALL; 78 end; 79 call fortran_io_$close_file (-1, fortran_code); 80 SKIP_FORTRAN_ALL: 81 revert linkage_error; 82 83 on linkage_error go to SKIP_PASCAL_ALL; 84 call pascal_io_$close_all; 85 SKIP_PASCAL_ALL: 86 revert linkage_error; 87 88 call plio2_$close_all_; /* close all pl1 files */ 89 return; /* all done */ 90 end; 91 else do; 92 if substr (arg, 1, 4) = "file" 93 then do; /* might be a fortran file */ 94 ft_file = substr (arg, 5, 2); 95 if ft_file ^= "00" 96 then if verify (ft_file, "1234567890") = 0 97 then do; 98 f_file = convert (f_file, ft_file); 99 on linkage_error 100 begin; 101 fortran_code = 1; 102 go to SKIP_FORTRAN_ONE_FILE; 103 end; 104 call fortran_io_$close_file (f_file, fortran_code); 105 SKIP_FORTRAN_ONE_FILE: 106 revert linkage_error; 107 end; 108 else ; 109 else ; 110 end; 111 112 on linkage_error 113 begin; 114 pascal_code = 1; 115 go to SKIP_PASCAL_ONE_FILE; 116 end; 117 call pascal_io_$close_by_name ((arg), pascal_code); 118 SKIP_PASCAL_ONE_FILE: 119 revert linkage_error; 120 121 call plio2_$close_by_name_sys_ ((arg), pl1_code); 122 end; 123 if pl1_code + fortran_code + pascal_code > 2 124 then call com_err_ (error_table_$no_file, "close_file", "^a", arg); 125 end; 126 return; 127 end close_file; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/84 1556.1 close_file.pl1 >spec>on>pascal_c>close_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. arg based char unaligned dcl 16 set ref 64 64 64 68 72 72 92 94 117 121 123* arg_count 000100 automatic fixed bin(17,0) dcl 17 set ref 46* 47 54 arg_ptr 000104 automatic pointer dcl 18 set ref 57* 64 64 64 68 72 72 92 94 117 121 123 cnt 000101 automatic fixed bin(17,0) dcl 17 set ref 57* 64 64 64 68 72 72 92 94 117 121 123 123 code 000106 automatic fixed bin(35,0) dcl 19 set ref 49* 57* 58 60* 67* com_err_ 000010 constant entry external dcl 20 ref 60 123 convert builtin function dcl 21 ref 98 cu_$arg_count 000012 constant entry external dcl 23 ref 46 cu_$arg_ptr 000014 constant entry external dcl 23 ref 57 error_table_$badopt 000020 external static fixed bin(35,0) dcl 25 ref 67 error_table_$no_file 000022 external static fixed bin(35,0) dcl 25 set ref 123* error_table_$noarg 000016 external static fixed bin(35,0) dcl 25 ref 49 f_file 000107 automatic fixed bin(17,0) dcl 30 set ref 98* 98 104* fortran_code 000110 automatic fixed bin(35,0) dcl 31 set ref 56* 76* 79* 101* 104* 123 fortran_io_$close_file 000024 constant entry external dcl 33 ref 79 104 ft_file 000113 automatic char(2) unaligned dcl 35 set ref 94* 95 95 98 i 000102 automatic fixed bin(17,0) dcl 17 set ref 54* 57* linkage_error 000114 stack reference condition dcl 36 ref 74 80 83 85 99 105 112 118 msg 000122 automatic char(80) unaligned dcl 37 set ref 50* 55* 60* 68* pascal_code 000112 automatic fixed bin(35,0) dcl 31 set ref 56* 114* 117* 123 pascal_io_$close_all 000032 constant entry external dcl 41 ref 84 pascal_io_$close_by_name 000034 constant entry external dcl 43 ref 117 pl1_code 000111 automatic fixed bin(35,0) dcl 31 set ref 56* 121* 123 plio2_$close_all_ 000026 constant entry external dcl 38 ref 88 plio2_$close_by_name_sys_ 000030 constant entry external dcl 38 ref 121 substr builtin function dcl 21 ref 64 92 94 verify builtin function dcl 21 ref 95 NAMES DECLARED BY EXPLICIT CONTEXT. SKIP_FORTRAN_ALL 000271 constant label dcl 80 ref 77 SKIP_FORTRAN_ONE_FILE 000415 constant label dcl 105 ref 102 SKIP_PASCAL_ALL 000316 constant label dcl 85 ref 83 SKIP_PASCAL_ONE_FILE 000465 constant label dcl 118 ref 115 cf 000037 constant entry external dcl 13 close_file 000046 constant entry external dcl 13 error_return 000127 constant label dcl 60 ref 51 69 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1172 1230 773 1202 Length 1420 773 36 154 177 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cf 297 external procedure is an external procedure. on unit on line 74 64 on unit on unit on line 83 64 on unit on unit on line 99 64 on unit on unit on line 112 64 on unit STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cf 000100 arg_count cf 000101 cnt cf 000102 i cf 000104 arg_ptr cf 000106 code cf 000107 f_file cf 000110 fortran_code cf 000111 pl1_code cf 000112 pascal_code cf 000113 ft_file cf 000122 msg cf THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out return tra_ext enable shorten_stack ext_entry int_entry any_to_any_tr THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_ptr fortran_io_$close_file pascal_io_$close_all pascal_io_$close_by_name plio2_$close_all_ plio2_$close_by_name_sys_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$no_file error_table_$noarg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 13 000036 46 000053 47 000061 49 000063 50 000066 51 000071 54 000072 55 000101 56 000104 57 000110 58 000125 60 000127 62 000163 64 000164 67 000202 68 000205 69 000221 72 000223 74 000234 76 000250 77 000253 79 000256 80 000271 83 000272 84 000311 85 000316 88 000317 89 000324 92 000325 94 000331 95 000335 98 000352 99 000362 101 000376 102 000401 104 000404 105 000415 112 000416 114 000432 115 000435 117 000440 118 000465 121 000467 122 000514 123 000515 125 000565 126 000567 ----------------------------------------------------------- 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