COMPILATION LISTING OF SEGMENT dm_set_free_area Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/24/85 0832.4 mst Wed Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1985 * 4* * * 5* *********************************************************** */ 6 /* DESCRIPTION: 7* 8*This command sets the directory in which the dm_free_area is placed. If there 9*is an existing dm_free_area known to the process (ie, get_dm_free_area_ has 10*been called already by the process), then it can be released. 11**/ 12 13 /* HISTORY: 14* 15*Written by Lindsey L. Spratt, 02/07/85. 16*Modified: 17*04/16/85 by Lindsey L. Spratt: Added a pnotice. 18**/ 19 /* format: style2,ind3 */ 20 21 dm_set_free_area: 22 proc (); 23 24 /* START OF DECLARATIONS */ 25 /* Automatic */ 26 27 dcl accept_control_argument 28 bit (1) aligned init ("0"b); 29 dcl area_directory char (168) init (UNSET_DIRECTORY); 30 dcl arg_idx fixed bin; 31 dcl arg_len fixed bin (21); 32 dcl arg_list_ptr ptr init (null); 33 dcl arg_ptr ptr; 34 dcl code fixed bin (35); 35 dcl control_argument_idx fixed bin; 36 dcl force_interpretation_as_argument 37 bit (1) aligned init (NO); 38 dcl is_active_function bit (1) aligned init (NO); 39 dcl number_of_args fixed bin; 40 dcl release_old_area bit (1) aligned init (NO); 41 dcl return_arg_len fixed bin (21) init (0); 42 dcl return_arg_ptr ptr init (null); 43 dcl sci_ptr ptr init (null); 44 dcl this_is_a_standalone_invocation 45 bit (1) aligned init (YES); 46 47 /* Based */ 48 49 dcl arg char (arg_len) based (arg_ptr); 50 51 /* Builtin */ 52 53 dcl cleanup condition; 54 55 /* Constant */ 56 57 dcl UNSET_DIRECTORY init (">NO DIR<") char (8) internal static options (constant); 58 59 dcl ( 60 YES init ("1"b), 61 NO init ("0"b) 62 ) bit (1) aligned internal static options (constant); 63 dcl myname init ("dm_set_free_area") char (16) internal static options (constant); 64 65 dcl ARGUMENT_TYPE (6) internal static options (constant) char (64) varying 66 init ("pathname of the directory to contain dm free area", 67 "pathname of the directory to contain dm free area", "", "", "", ""); 68 dcl CONTROL_ARGUMENT (6) internal static options (constant) char (64) varying 69 init ("-area_directory", "-adr", "-release_old_area", "-roa", "-no_release_old_area", 70 "-nroa"); 71 72 /* Entry */ 73 74 dcl absolute_pathname_ entry (char (*), char (*), fixed bin (35)); 75 dcl cu_$arg_list_ptr entry (ptr); 76 dcl get_dm_free_area_$set entry (char (*), bit (1) aligned, ptr); 77 dcl ssu_$abort_line entry () options (variable); 78 dcl ssu_$arg_count entry (ptr, fixed bin); 79 dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin (21)); 80 dcl ssu_$destroy_invocation 81 entry (ptr); 82 dcl ssu_$return_arg entry (ptr, fixed bin, bit (1) aligned, ptr, fixed bin (21)); 83 dcl ssu_$standalone_invocation 84 entry (ptr, char (*), char (*), ptr, entry, fixed bin (35)); 85 86 /* External */ 87 88 dcl ( 89 error_table_$active_function, 90 error_table_$bad_arg, 91 error_table_$badopt, 92 error_table_$noarg 93 ) fixed bin (35) external; 94 95 /* END OF DECLARATIONS */ 96 call cu_$arg_list_ptr (arg_list_ptr); 97 call ssu_$standalone_invocation (sci_ptr, myname, "", arg_list_ptr, ABORT_ENTRY, code); 98 99 on cleanup call CLEANUP (); 100 101 call ssu_$arg_count (sci_ptr, number_of_args); 102 103 accept_control_argument = YES; 104 control_argument_idx = -1; 105 106 ARG_PROCESSING_LOOP: 107 do arg_idx = 1 to number_of_args; 108 call ssu_$arg_ptr (sci_ptr, arg_idx, arg_ptr, arg_len); 109 if index (arg, "-") ^= 1 | force_interpretation_as_argument = YES 110 then call PROCESS_ARGUMENT (arg, control_argument_idx, accept_control_argument); 111 else if accept_control_argument = YES 112 then call PROCESS_CONTROL_ARGUMENT (arg, control_argument_idx, accept_control_argument, 113 force_interpretation_as_argument); 114 else call REPORT_MISSING_ARGUMENT (control_argument_idx); 115 end ARG_PROCESSING_LOOP; 116 117 if control_argument_idx >= 0 & accept_control_argument = NO 118 then call REPORT_MISSING_ARGUMENT (control_argument_idx); 119 120 121 if area_directory = UNSET_DIRECTORY 122 then call ssu_$abort_line (sci_ptr, error_table_$noarg, "^/An area directory pathname must be specified."); 123 124 call get_dm_free_area_$set (area_directory, release_old_area, null ()); 125 126 127 MAIN_RETURN: 128 return; 129 130 ABORT_ENTRY: 131 procedure (); 132 call CLEANUP (); 133 go to MAIN_RETURN; 134 end ABORT_ENTRY; 135 136 137 138 CLEANUP: 139 procedure (); 140 call FINISH (); 141 end CLEANUP; 142 143 FINISH: 144 proc (); 145 call ssu_$destroy_invocation (sci_ptr); 146 end FINISH; 147 148 PROCESS_ARGUMENT: 149 proc (pa_p_arg, pa_p_control_argument_idx, pa_p_accept_control_argument); 150 151 dcl pa_p_arg char (*) parm; 152 dcl pa_p_control_argument_idx 153 fixed bin parm; 154 dcl pa_p_accept_control_argument 155 bit (1) aligned parm; 156 157 dcl pa_code fixed bin (35); 158 159 pa_code = 0; 160 161 goto ARGUMENT (pa_p_control_argument_idx); 162 ARGUMENT (-1): 163 call ssu_$abort_line (sci_ptr, error_table_$bad_arg, "^/The argument ""^a"" is out of place.", arg); 164 return; 165 166 ARGUMENT (1): /* -area_directory */ 167 ARGUMENT (2): /* -adr */ 168 call absolute_pathname_ (arg, area_directory, code); 169 if code ^= 0 170 then call ssu_$abort_line (sci_ptr, code, 171 "^/Unable to convert the -area_directory option's argument ""^a"" to an absolute pathname.", arg); 172 pa_p_accept_control_argument = YES; 173 pa_p_control_argument_idx = -1; 174 175 end PROCESS_ARGUMENT; 176 177 PROCESS_CONTROL_ARGUMENT: 178 proc (pca_p_arg, pca_p_control_argument_idx, pca_p_accept_control_argument, pca_p_force_interpretation_as_argument); 179 180 181 dcl pca_p_arg char (*) parm; 182 dcl pca_p_control_argument_idx 183 fixed bin parm; 184 dcl pca_p_accept_control_argument 185 bit (1) aligned parm; 186 dcl pca_p_force_interpretation_as_argument 187 bit (1) aligned parm; 188 189 pca_p_control_argument_idx = CONTROL_ARGUMENT_INDEX (pca_p_arg); 190 pca_p_accept_control_argument = YES; 191 pca_p_force_interpretation_as_argument = NO; 192 193 go to CONTROL_ARGUMENT (pca_p_control_argument_idx); 194 195 CONTROL_ARGUMENT (-1): /* not a control argument */ 196 call ssu_$abort_line (sci_ptr, error_table_$badopt, pca_p_arg); 197 198 CONTROL_ARGUMENT (1): /* -area_directory */ 199 CONTROL_ARGUMENT (2): /* -adr */ 200 pca_p_accept_control_argument = NO; 201 return; 202 203 204 CONTROL_ARGUMENT (3): /* -release_old_area */ 205 CONTROL_ARGUMENT (4): /* -roa */ 206 release_old_area = YES; 207 208 pca_p_control_argument_idx = -1; 209 pca_p_accept_control_argument = YES; 210 return; 211 212 213 CONTROL_ARGUMENT (5): /* -no_release_old_area */ 214 CONTROL_ARGUMENT (6): /* -nroa */ 215 release_old_area = NO; 216 217 pca_p_control_argument_idx = -1; 218 pca_p_accept_control_argument = YES; 219 return; 220 221 222 end PROCESS_CONTROL_ARGUMENT; 223 224 225 CONTROL_ARGUMENT_INDEX: 226 proc (cai_p_arg) returns (fixed bin); 227 228 dcl cai_p_arg char (*); 229 dcl cai_control_argument_idx 230 fixed bin; 231 232 do cai_control_argument_idx = 1 to hbound (CONTROL_ARGUMENT, 1) 233 while (CONTROL_ARGUMENT (cai_control_argument_idx) ^= cai_p_arg); 234 end; 235 if cai_control_argument_idx > hbound (CONTROL_ARGUMENT, 1) 236 then return (-1); 237 else return (cai_control_argument_idx); 238 239 end CONTROL_ARGUMENT_INDEX; 240 241 REPORT_MISSING_ARGUMENT: 242 proc (rma_p_control_argument_idx); 243 dcl rma_p_control_argument_idx 244 fixed bin parm; 245 246 call ssu_$abort_line (sci_ptr, error_table_$noarg, "^a must be followed by a^[n^] ^a.", 247 CONTROL_ARGUMENT (rma_p_control_argument_idx), 248 (index ("aeiouh", substr (ARGUMENT_TYPE (rma_p_control_argument_idx), 1, 1)) > 0), 249 ARGUMENT_TYPE (rma_p_control_argument_idx)); 250 end REPORT_MISSING_ARGUMENT; 251 252 end dm_set_free_area; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/24/85 0803.1 dm_set_free_area.pl1 >spec>on>41-21>dm_set_free_area.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. ARGUMENT_TYPE 000162 constant varying char(64) initial array dcl 65 set ref 246 246* CONTROL_ARGUMENT 000014 constant varying char(64) initial array dcl 68 set ref 232 232 235 246* NO constant bit(1) initial dcl 59 ref 36 38 40 117 191 198 213 UNSET_DIRECTORY 000334 constant char(8) initial unaligned dcl 57 ref 29 121 YES constant bit(1) initial dcl 59 ref 44 103 109 111 172 190 204 209 218 absolute_pathname_ 000010 constant entry external dcl 74 ref 166 accept_control_argument 000100 automatic bit(1) initial dcl 27 set ref 27* 103* 109* 111 111* 117 area_directory 000101 automatic char(168) initial unaligned dcl 29 set ref 29* 121 124* 166* arg based char unaligned dcl 49 set ref 109 109* 111* 162* 166* 169* arg_idx 000153 automatic fixed bin(17,0) dcl 30 set ref 106* 108* arg_len 000154 automatic fixed bin(21,0) dcl 31 set ref 108* 109 109 109 111 111 162 162 166 166 169 169 arg_list_ptr 000156 automatic pointer initial dcl 32 set ref 32* 96* 97* arg_ptr 000160 automatic pointer dcl 33 set ref 108* 109 109 111 162 166 169 cai_control_argument_idx 000234 automatic fixed bin(17,0) dcl 229 set ref 232* 232* 235 237 cai_p_arg parameter char unaligned dcl 228 ref 225 232 cleanup 000200 stack reference condition dcl 53 ref 99 code 000162 automatic fixed bin(35,0) dcl 34 set ref 97* 166* 169 169* control_argument_idx 000163 automatic fixed bin(17,0) dcl 35 set ref 104* 109* 111* 114* 117 117* cu_$arg_list_ptr 000012 constant entry external dcl 75 ref 96 error_table_$bad_arg 000030 external static fixed bin(35,0) dcl 88 set ref 162* error_table_$badopt 000032 external static fixed bin(35,0) dcl 88 set ref 195* error_table_$noarg 000034 external static fixed bin(35,0) dcl 88 set ref 121* 246* force_interpretation_as_argument 000164 automatic bit(1) initial dcl 36 set ref 36* 109 111* get_dm_free_area_$set 000014 constant entry external dcl 76 ref 124 is_active_function 000165 automatic bit(1) initial dcl 38 set ref 38* myname 000330 constant char(16) initial unaligned dcl 63 set ref 97* number_of_args 000166 automatic fixed bin(17,0) dcl 39 set ref 101* 106 pa_code 000216 automatic fixed bin(35,0) dcl 157 set ref 159* pa_p_accept_control_argument parameter bit(1) dcl 154 set ref 148 172* pa_p_arg parameter char unaligned dcl 151 ref 148 pa_p_control_argument_idx parameter fixed bin(17,0) dcl 152 set ref 148 161 173* pca_p_accept_control_argument parameter bit(1) dcl 184 set ref 177 190* 198* 209* 218* pca_p_arg parameter char unaligned dcl 181 set ref 177 189* 195* pca_p_control_argument_idx parameter fixed bin(17,0) dcl 182 set ref 177 189* 193 208* 217* pca_p_force_interpretation_as_argument parameter bit(1) dcl 186 set ref 177 191* release_old_area 000167 automatic bit(1) initial dcl 40 set ref 40* 124* 204* 213* return_arg_len 000170 automatic fixed bin(21,0) initial dcl 41 set ref 41* return_arg_ptr 000172 automatic pointer initial dcl 42 set ref 42* rma_p_control_argument_idx parameter fixed bin(17,0) dcl 243 ref 241 246 246 246 sci_ptr 000174 automatic pointer initial dcl 43 set ref 43* 97* 101* 108* 121* 145* 162* 169* 195* 246* ssu_$abort_line 000016 constant entry external dcl 77 ref 121 162 169 195 246 ssu_$arg_count 000020 constant entry external dcl 78 ref 101 ssu_$arg_ptr 000022 constant entry external dcl 79 ref 108 ssu_$destroy_invocation 000024 constant entry external dcl 80 ref 145 ssu_$standalone_invocation 000026 constant entry external dcl 83 ref 97 this_is_a_standalone_invocation 000176 automatic bit(1) initial dcl 44 set ref 44* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. error_table_$active_function external static fixed bin(35,0) dcl 88 ssu_$return_arg 000000 constant entry external dcl 82 NAMES DECLARED BY EXPLICIT CONTEXT. ABORT_ENTRY 001013 constant entry internal dcl 130 ref 97 97 ARGUMENT 000000 constant label array(-1:2) dcl 162 set ref 161 ARG_PROCESSING_LOOP 000600 constant label dcl 106 CLEANUP 001031 constant entry internal dcl 138 ref 99 132 CONTROL_ARGUMENT 000004 constant label array(-1:6) dcl 195 ref 193 CONTROL_ARGUMENT_INDEX 001306 constant entry internal dcl 225 ref 189 FINISH 001040 constant entry internal dcl 143 ref 140 MAIN_RETURN 001011 constant label dcl 127 ref 133 PROCESS_ARGUMENT 001052 constant entry internal dcl 148 ref 109 PROCESS_CONTROL_ARGUMENT 001212 constant entry internal dcl 177 ref 111 REPORT_MISSING_ARGUMENT 001353 constant entry internal dcl 241 ref 114 117 dm_set_free_area 000451 constant entry external dcl 21 NAMES DECLARED BY CONTEXT OR IMPLICATION. hbound builtin function ref 232 235 index builtin function ref 109 246 null builtin function ref 32 42 43 124 124 substr builtin function ref 246 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1630 1666 1440 1640 Length 2062 1440 36 157 167 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME dm_set_free_area 330 external procedure is an external procedure. on unit on line 99 64 on unit ABORT_ENTRY 64 internal procedure is assigned to an entry variable. CLEANUP 74 internal procedure is called by several nonquick procedures. FINISH internal procedure shares stack frame of internal procedure CLEANUP. PROCESS_ARGUMENT internal procedure shares stack frame of external procedure dm_set_free_area. PROCESS_CONTROL_ARGUMENT internal procedure shares stack frame of external procedure dm_set_free_area. CONTROL_ARGUMENT_INDEX internal procedure shares stack frame of external procedure dm_set_free_area. REPORT_MISSING_ARGUMENT internal procedure shares stack frame of external procedure dm_set_free_area. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME dm_set_free_area 000100 accept_control_argument dm_set_free_area 000101 area_directory dm_set_free_area 000153 arg_idx dm_set_free_area 000154 arg_len dm_set_free_area 000156 arg_list_ptr dm_set_free_area 000160 arg_ptr dm_set_free_area 000162 code dm_set_free_area 000163 control_argument_idx dm_set_free_area 000164 force_interpretation_as_argument dm_set_free_area 000165 is_active_function dm_set_free_area 000166 number_of_args dm_set_free_area 000167 release_old_area dm_set_free_area 000170 return_arg_len dm_set_free_area 000172 return_arg_ptr dm_set_free_area 000174 sci_ptr dm_set_free_area 000176 this_is_a_standalone_invocation dm_set_free_area 000216 pa_code PROCESS_ARGUMENT 000234 cai_control_argument_idx CONTROL_ARGUMENT_INDEX THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a call_ext_out_desc call_ext_out call_int_other return tra_ext enable ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. absolute_pathname_ cu_$arg_list_ptr get_dm_free_area_$set ssu_$abort_line ssu_$arg_count ssu_$arg_ptr ssu_$destroy_invocation ssu_$standalone_invocation THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$badopt error_table_$noarg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 21 000450 27 000456 29 000457 32 000462 36 000464 38 000465 40 000466 41 000467 42 000470 43 000471 44 000472 96 000474 97 000502 99 000541 101 000563 103 000574 104 000576 106 000600 108 000607 109 000624 111 000670 114 000723 115 000725 117 000727 121 000736 124 000766 127 001011 130 001012 132 001020 133 001025 138 001030 140 001036 141 001037 143 001040 145 001041 146 001051 148 001052 159 001063 161 001064 162 001067 164 001122 166 001123 169 001147 172 001204 173 001207 175 001211 177 001212 189 001223 190 001241 191 001244 193 001245 195 001247 198 001271 201 001273 204 001274 208 001275 209 001277 210 001300 213 001301 217 001302 218 001304 219 001305 225 001306 232 001317 234 001337 235 001341 237 001350 241 001353 246 001355 250 001432 ----------------------------------------------------------- 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