COMPILATION LISTING OF SEGMENT cancel_cobol_program Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 1029.0 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8060 cancel_cobol_program.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 10/25/76 by ORN to comply with error message standards */ 23 /* Modified 03/26/76 by ORN to call cobol_control_$cancel and cobol_stop_run_. 24* Change made in conjunction with cobol_control_ modification. */ 25 26 /* format: style3 */ 27 cancel_cobol_program: 28 ccp: 29 proc; 30 31 dcl (i, arglen, nargs) fixed bin; 32 dcl code fixed bin (35); 33 dcl (rdsw, rfsw) fixed bin; 34 35 dcl asw bit (1); 36 dcl found bit (1); 37 38 dcl argptr ptr; 39 dcl arg char (arglen) based (argptr); 40 41 dcl com_err_ entry options (variable); 42 dcl cu_$arg_count entry (fixed bin); 43 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 44 dcl cobol_control_$cancel 45 entry (char (*), fixed bin, fixed bin, fixed bin (35)); 46 dcl cobol_stop_run_ entry (ptr, fixed bin, fixed bin, fixed bin (35)); 47 48 dcl error_table_$noarg fixed bin (35) ext static; 49 dcl error_table_$badopt fixed bin (35) ext static; 50 dcl error_table_$bigarg fixed bin (35) ext static; 51 52 53 /*************************************/ 54 start: 55 asw = "0"b; 56 rdsw, rfsw = 0; 57 call cu_$arg_count (nargs); 58 if nargs < 1 59 then go to no_arg_error; 60 do i = 1 to nargs; 61 call cu_$arg_ptr (i, argptr, arglen, code); 62 if code ^= 0 63 then go to multics_error; 64 if substr (arg, 1, 1) = "-" 65 then do; 66 if arg = "-a" | arg = "-all" 67 then asw = "1"b; 68 else if arg = "-retd" | arg = "-retain_data" 69 then rdsw = 1; 70 else if arg = "-rf" | arg = "-retain_files" 71 then rfsw = 1; 72 else go to control_arg_error; 73 end; 74 end; 75 76 found = "0"b; 77 do i = 1 to nargs; 78 call cu_$arg_ptr (i, argptr, arglen, code); 79 if code ^= 0 80 then go to multics_error; 81 if substr (arg, 1, 1) ^= "-" 82 then do; 83 if asw 84 then do; 85 call com_err_ (0, "cancel_cobol_program", 86 "Redundant names specified with the -all option are ignored."); 87 i = nargs; 88 end; 89 else do; 90 if arglen > 65 91 then go to arg_too_long_error; 92 call cobol_control_$cancel (arg, rdsw, rfsw, code); 93 if code ^= 0 94 then do; 95 if code = -2 96 then go to no_run_error; 97 else if code = -1 98 then go to no_prog_error; 99 else go to multics_arg_error; 100 end; 101 found = "1"b; 102 end; 103 end; 104 end; 105 106 if asw 107 then do; 108 call cobol_stop_run_ (null (), rdsw, rfsw, code); 109 if code ^= 0 110 then go to no_run_error; 111 end; 112 else if ^found 113 then go to no_arg_error; 114 return; 115 116 117 /*************************************/ 118 no_prog_error: 119 call com_err_ (0, "cancel_cobol_program", "The program ^a is not active in the current run-unit.", 120 substr (arg, 1, arglen)); 121 if code > 0 122 then go to multics_error; 123 return; 124 125 arg_too_long_error: 126 call com_err_ (error_table_$bigarg, "cancel_cobol_program", substr (arg, 1, arglen)); 127 return; 128 129 no_run_error: 130 call com_err_ (0, "cancel_cobol_program", "There are no active programs in the current run-unit."); 131 if code > 0 132 then go to multics_error; 133 return; 134 135 no_arg_error: 136 call com_err_ (error_table_$noarg, "cancel_cobol_program"); 137 return; 138 139 control_arg_error: 140 call com_err_ (error_table_$badopt, "cancel_cobol_program", substr (arg, 1, arglen)); 141 return; 142 143 multics_error: 144 call com_err_ (code, "cancel_cobol_program"); 145 return; 146 147 multics_arg_error: 148 call com_err_ (code, "cancel_cobol_program", substr (arg, 1, arglen)); 149 return; 150 151 end cancel_cobol_program; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0837.3 cancel_cobol_program.pl1 >spec>install>MR12.3-1048>cancel_cobol_program.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 packed unaligned dcl 39 set ref 64 66 66 68 68 70 70 81 92* 118 118 125 125 139 139 147 147 arglen 000101 automatic fixed bin(17,0) dcl 31 set ref 61* 64 66 66 68 68 70 70 78* 81 90 92 92 118 118 118 118 125 125 125 125 139 139 139 139 147 147 147 147 argptr 000110 automatic pointer dcl 38 set ref 61* 64 66 66 68 68 70 70 78* 81 92 118 118 125 125 139 139 147 147 asw 000106 automatic bit(1) packed unaligned dcl 35 set ref 54* 66* 83 106 cobol_control_$cancel 000016 constant entry external dcl 44 ref 92 cobol_stop_run_ 000020 constant entry external dcl 46 ref 108 code 000103 automatic fixed bin(35,0) dcl 32 set ref 61* 62 78* 79 92* 93 95 97 108* 109 121 131 143* 147* com_err_ 000010 constant entry external dcl 41 ref 85 118 125 129 135 139 143 147 cu_$arg_count 000012 constant entry external dcl 42 ref 57 cu_$arg_ptr 000014 constant entry external dcl 43 ref 61 78 error_table_$badopt 000024 external static fixed bin(35,0) dcl 49 set ref 139* error_table_$bigarg 000026 external static fixed bin(35,0) dcl 50 set ref 125* error_table_$noarg 000022 external static fixed bin(35,0) dcl 48 set ref 135* found 000107 automatic bit(1) packed unaligned dcl 36 set ref 76* 101* 112 i 000100 automatic fixed bin(17,0) dcl 31 set ref 60* 61* 77* 78* 87* nargs 000102 automatic fixed bin(17,0) dcl 31 set ref 57* 58 60 77 87 rdsw 000104 automatic fixed bin(17,0) dcl 33 set ref 56* 68* 92* 108* rfsw 000105 automatic fixed bin(17,0) dcl 33 set ref 56* 70* 92* 108* NAMES DECLARED BY EXPLICIT CONTEXT. arg_too_long_error 000471 constant label dcl 125 set ref 90 cancel_cobol_program 000115 constant entry external dcl 27 ccp 000106 constant entry external dcl 27 control_arg_error 000601 constant label dcl 139 ref 70 multics_arg_error 000657 constant label dcl 147 ref 99 multics_error 000636 constant label dcl 143 ref 62 79 121 131 no_arg_error 000560 constant label dcl 135 ref 58 112 no_prog_error 000421 constant label dcl 118 ref 97 no_run_error 000525 constant label dcl 129 ref 95 109 start 000122 constant label dcl 54 NAMES DECLARED BY CONTEXT OR IMPLICATION. null builtin function ref 108 108 substr builtin function ref 64 81 118 118 125 125 139 139 147 147 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1042 1072 721 1052 Length 1262 721 30 154 120 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ccp 142 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ccp 000100 i ccp 000101 arglen ccp 000102 nargs ccp 000103 code ccp 000104 rdsw ccp 000105 rfsw ccp 000106 asw ccp 000107 found ccp 000110 argptr ccp THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_out_desc call_ext_out return_mac shorten_stack ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_control_$cancel cobol_stop_run_ com_err_ cu_$arg_count cu_$arg_ptr THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$bigarg error_table_$noarg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 27 000105 54 000122 56 000123 57 000125 58 000133 60 000136 61 000145 62 000162 64 000164 66 000171 68 000205 70 000220 74 000232 76 000234 77 000235 78 000245 79 000262 81 000264 83 000271 85 000273 87 000323 88 000325 90 000326 92 000331 93 000357 95 000361 97 000363 99 000365 101 000366 104 000370 106 000372 108 000374 109 000413 111 000415 112 000416 114 000420 118 000421 121 000465 123 000470 125 000471 127 000523 129 000525 131 000555 133 000557 135 000560 137 000600 139 000601 141 000634 143 000636 145 000656 147 000657 149 000713 ----------------------------------------------------------- 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