COMPILATION LISTING OF SEGMENT cobol_SET_ 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 1027.9 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 cobol_SET_.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* format: style3 */ 23 cobol_SET_: 24 proc; /* Versiin 2. */ 25 /* Set or print control variables for SORTM_. */ 26 Lp = addrel (addr (L), 1); 27 call cu_$arg_count (i); 28 if i < 1 29 then do; 30 L = "cobol_SET_ S S ... 31 Each S is a string: name=value (no spaces). 32 Name from {sort_dir,disaster1,disaster2,SIi,SSi,MIi,max1,max2,max3,max4}. 33 Value is an integer except for sort_dir it is a string."; 34 L = L || " 35 If S is ""default"" (only) the values are set to their default values. 36 If S is ""print"" (only) the current values are printed. 37 "; /* call ios_$write_ptr(Lp,0,length(L)); */ 38 return; 39 end; 40 41 do j = 1 to i; 42 call cu_$arg_ptr (j, p, l, e); 43 if e > 0 44 then do; 45 call com_err_ (e, "cobol_SET_", " Could not obtain parameter ^d.", j); 46 return; 47 end; 48 49 50 if arg = "print" 51 then do; 52 L = " SORTM_ values " || substr (L, 2, 24) || " 53 sort_dir=""" || cobol_SM_$sort_dir || """ 54 "; 55 L = L || "disaster1=" || cobol_NUMS_ (cobol_SM_$disaster1) || " disaster2=" 56 || cobol_NUMS_ (cobol_SM_$disaster2) || " SIi=" || cobol_NUMS_ (cobol_SM_$SIi) || " SSi=" 57 || cobol_NUMS_ (cobol_SM_$SSi) || " MIi=" || cobol_NUMS_ (cobol_SM_$MIi) || " TSIi=" 58 || cobol_NUMS_ (cobol_SM_$TSIi) || " LTSIi=" || cobol_NUMS_ (cobol_SM_$LTSIi) || " max1=" 59 || cobol_NUMS_ (cobol_SM_$max1) || " max2=" || cobol_NUMS_ (cobol_SM_$max2) || " max3=" 60 || cobol_NUMS_ (cobol_SM_$max3) || " max4=" || cobol_NUMS_ (cobol_SM_$max4) || " 61 "; 62 call FME (cobol_SM_$cmp, "cmp"); 63 call FME (cobol_SM_$mcp, "mcp"); 64 L = L || "SIp=" || cobol_FP_ (cobol_SM_$SIp) || " SRp=" || cobol_FP_ (cobol_SM_$SRp) 65 || " SSp=" || cobol_FP_ (cobol_SM_$SSp) || " MIp=" || cobol_FP_ (cobol_SM_$MIp) || " 66 "; /* call ios_$write_ptr(Lp,0,length(L)); */ 67 end; 68 else if arg = "default" 69 then do; 70 cobol_SM_$sort_dir = ""; 71 cobol_SM_$disaster1 = 0; 72 cobol_SM_$disaster2 = 0; 73 cobol_SM_$SSi = 0; 74 cobol_SM_$SIi = 0; 75 cobol_SM_$MIi = 0; 76 cobol_SM_$max1 = 64 * 1024 * 36; 77 cobol_SM_$max2 = cobol_SM_$max1; 78 cobol_SM_$max3 = 30000; 79 cobol_SM_$max4 = 1000; 80 end; 81 else do; 82 83 k = index (arg, "="); 84 if k < 1 85 then call err ("contains no ""=""."); 86 else do; 87 m = index (/* 88*. 1 2 3 4 5 6 7 8 9 89*.1 9 18 27 30 33 36 40 44 48 */ 90 "sort_dirdisaster1disaster2SIiSSiMIimax1max2max3max4", substr (arg, 1, (k - 1))); 91 if m < 1 92 then call err ("not a known name."); 93 else do; 94 if m = 1 95 then cobol_SM_$sort_dir = substr (arg, (k + 1), (l - k)); 96 else call set_val; 97 end; 98 end; 99 end; 100 end; 101 return; 102 103 CPP: 104 entry (PT, PT2); /* Save the pointer, "p", to the comparison procedure. */ 105 call cu_$arg_count (i); 106 if (i < 1) | (i > 2) 107 then do; 108 call com_err_ (0, "CPP", " Pointer to comparison procedure required."); 109 return; 110 end; 111 112 cobol_SM_$cmp = PT; 113 if i = 2 114 then cobol_SM_$mcp = PT2; 115 cobol_SM_$sort_dir = ""; 116 cobol_SM_$disaster1 = 0; 117 cobol_SM_$disaster2 = 0; 118 cobol_SM_$SSi = 0; 119 cobol_SM_$SIi = 0; 120 cobol_SM_$MIi = 0; 121 cobol_SM_$max1 = 64 * 1024 * 36; 122 cobol_SM_$max2 = cobol_SM_$max1; 123 cobol_SM_$max3 = 30000; 124 cobol_SM_$max4 = 1000; 125 return; 126 127 128 FME: 129 proc (e, n); /* Format entry "e" named "n". */ 130 if p2 = null () 131 then do; 132 L = L || n || "=(ext proc)" || cobol_FP_ (p1) || " "; 133 end; 134 else do; 135 L = L || n || "=(int proc)" || cobol_FP_ (p1) || "(in)" || cobol_FP_ (p2) || " "; 136 end; 137 return; 138 dcl e entry parm, 139 n char (*) parm, 140 1 E aligned based (addr (e)), 141 2 p1 ptr, 142 2 p2 ptr, 143 null builtin; 144 end FME; 145 146 set_val: 147 proc; /* Convert the "value" part of the argument and load 148* the specified variable. */ 149 150 /* Convert the numeric string (unsigned). */ 151 v = 0; 152 do k = (k + 1) to l; 153 c = substr (arg, k, 1); 154 if (c < "0") | (c > "9") 155 then do; 156 call err ("contains non-numeric character """ || c || """ in the numeric value field."); 157 return; 158 end; 159 v = (v * 10) + fixed (c, 9) - 0; 160 end; 161 162 /* Load the value. */ 163 goto set (red (m)); 164 set (0): 165 call err ("unknown name."); 166 return; 167 set (1): 168 cobol_SM_$disaster1 = v; 169 return; 170 set (2): 171 cobol_SM_$disaster2 = v; 172 return; 173 set (3): 174 cobol_SM_$SIi = v; 175 return; 176 set (4): 177 cobol_SM_$SSi = v; 178 return; 179 set (5): 180 cobol_SM_$MIi = v; 181 return; 182 set (6): 183 cobol_SM_$max1 = v; 184 return; 185 set (7): 186 cobol_SM_$max2 = v; 187 return; 188 set (8): 189 cobol_SM_$max3 = v; 190 return; 191 set (9): 192 cobol_SM_$max4 = v; 193 return; 194 end set_val; 195 196 err: 197 proc (message); 198 L = "cobol_SET_: Parameter " || cobol_NUMS_ (j) || ", """ || arg || """, " || message || " 199 "; /* call ios_$write_ptr(Lp,0,length(L)); */ 200 return; 201 dcl message char (*); 202 end err; 203 204 dcl (PT, PT2) entry parm, 205 (Lp, p) ptr, 206 L char (1000) var, 207 cu_$arg_count entry (fixed bin (35)) ext, 208 cu_$arg_ptr entry (fixed bin (35), ptr, fixed bin (35), fixed bin (35)) ext, 209 /* ios_$write_ptr entry(ptr,fixed bin(35),fixed bin(35)) ext, */ 210 com_err_ entry options (variable) ext, 211 cobol_NUMS_ entry (fixed bin (35)) ext returns (char (13) var), 212 cobol_FP_ entry (ptr) ext returns (char (16) var), 213 (i, j, k, m, l, e, v) 214 fixed bin (35), 215 red (51) fixed bin (35) static internal 216 init ((8) 0, 1, (8) 0, 2, (8) 0, 3, (2) 0, 4, (2) 0, 5, (2) 0, 6, (3) 0, 7, (3) 0, 8, (3) 0, 217 9, (3) 0), 218 arg char (l) unaligned based (p), 219 c char (1) aligned, 220 (unspec, substr, index, length) 221 builtin, /* Static external (bindable as internal). */ 222 ( 223 cobol_SM_$cmp, 224 cobol_SM_$mcp 225 ) entry variable ext, 226 ( 227 cobol_SM_$SIp, 228 cobol_SM_$SRp, 229 cobol_SM_$SSp, 230 cobol_SM_$MIp 231 ) ptr ext, 232 ( 233 cobol_SM_$SIi, 234 cobol_SM_$SSi, 235 cobol_SM_$MIi, 236 cobol_SM_$TSIi, 237 cobol_SM_$LTSIi, 238 cobol_SM_$max1, 239 cobol_SM_$max2, 240 cobol_SM_$max3, 241 cobol_SM_$max4, 242 cobol_SM_$disaster2, 243 cobol_SM_$disaster1 244 ) fixed bin (35) ext, 245 cobol_SM_$sort_dir char (168) var ext; 246 end cobol_SET_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0837.1 cobol_SET_.pl1 >spec>install>MR12.3-1048>cobol_SET_.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. E based structure level 1 dcl 138 L 000104 automatic varying char(1000) dcl 204 set ref 26 30* 34* 34 52* 52 55* 55 64* 64 132* 132 135* 135 198* Lp 000100 automatic pointer dcl 204 set ref 26* PT parameter entry variable dcl 204 ref 103 112 PT2 parameter entry variable dcl 204 ref 103 113 arg based char packed unaligned dcl 204 ref 50 68 83 87 94 153 198 c 000506 automatic char(1) dcl 204 set ref 153* 154 154 156 159 cobol_FP_ 000020 constant entry external dcl 204 ref 64 64 64 64 132 135 135 cobol_NUMS_ 000016 constant entry external dcl 204 ref 55 55 55 55 55 55 55 55 55 55 55 198 cobol_SM_$LTSIi 000046 external static fixed bin(35,0) dcl 204 set ref 55* cobol_SM_$MIi 000042 external static fixed bin(35,0) dcl 204 set ref 55* 75* 120* 179* cobol_SM_$MIp 000034 external static pointer dcl 204 set ref 64* cobol_SM_$SIi 000036 external static fixed bin(35,0) dcl 204 set ref 55* 74* 119* 173* cobol_SM_$SIp 000026 external static pointer dcl 204 set ref 64* cobol_SM_$SRp 000030 external static pointer dcl 204 set ref 64* cobol_SM_$SSi 000040 external static fixed bin(35,0) dcl 204 set ref 55* 73* 118* 176* cobol_SM_$SSp 000032 external static pointer dcl 204 set ref 64* cobol_SM_$TSIi 000044 external static fixed bin(35,0) dcl 204 set ref 55* cobol_SM_$cmp 000022 external static entry variable dcl 204 set ref 62* 112* cobol_SM_$disaster1 000062 external static fixed bin(35,0) dcl 204 set ref 55* 71* 116* 167* cobol_SM_$disaster2 000060 external static fixed bin(35,0) dcl 204 set ref 55* 72* 117* 170* cobol_SM_$max1 000050 external static fixed bin(35,0) dcl 204 set ref 55* 76* 77 121* 122 182* cobol_SM_$max2 000052 external static fixed bin(35,0) dcl 204 set ref 55* 77* 122* 185* cobol_SM_$max3 000054 external static fixed bin(35,0) dcl 204 set ref 55* 78* 123* 188* cobol_SM_$max4 000056 external static fixed bin(35,0) dcl 204 set ref 55* 79* 124* 191* cobol_SM_$mcp 000024 external static entry variable dcl 204 set ref 63* 113* cobol_SM_$sort_dir 000064 external static varying char(168) dcl 204 set ref 52 70* 94* 115* com_err_ 000014 constant entry external dcl 204 ref 45 108 cu_$arg_count 000010 constant entry external dcl 204 ref 27 105 cu_$arg_ptr 000012 constant entry external dcl 204 ref 42 e parameter entry variable dcl 138 in procedure "FME" set ref 128 130 132 135 135 e 000504 automatic fixed bin(35,0) dcl 204 in procedure "cobol_SET_" set ref 42* 43 45* i 000477 automatic fixed bin(35,0) dcl 204 set ref 27* 28 41 105* 106 106 113 index builtin function dcl 204 ref 83 87 j 000500 automatic fixed bin(35,0) dcl 204 set ref 41* 42* 45* 198* k 000501 automatic fixed bin(35,0) dcl 204 set ref 83* 84 87 94 94 152* 152* 153* l 000503 automatic fixed bin(35,0) dcl 204 set ref 42* 50 68 83 87 94 94 152 153 198 m 000502 automatic fixed bin(35,0) dcl 204 set ref 87* 91 94 163 message parameter char packed unaligned dcl 201 ref 196 198 n parameter char packed unaligned dcl 138 ref 128 132 135 null builtin function dcl 138 ref 130 p 000102 automatic pointer dcl 204 set ref 42* 50 68 83 87 94 153 198 p1 based pointer level 2 dcl 138 set ref 132* 135* p2 2 based pointer level 2 dcl 138 set ref 130 135* red 000012 constant fixed bin(35,0) initial array dcl 204 ref 163 substr builtin function dcl 204 ref 52 87 94 153 v 000505 automatic fixed bin(35,0) dcl 204 set ref 151* 159* 159 167 170 173 176 179 182 185 188 191 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. length builtin function dcl 204 unspec builtin function dcl 204 NAMES DECLARED BY EXPLICIT CONTEXT. CPP 001677 constant entry external dcl 103 FME 002005 constant entry internal dcl 128 ref 62 63 cobol_SET_ 000434 constant entry external dcl 23 err 002423 constant entry internal dcl 196 ref 84 91 156 164 set 000000 constant label array(0:9) dcl 164 ref 163 set_val 002244 constant entry internal dcl 146 ref 96 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 26 130 132 135 135 addrel builtin function ref 26 fixed builtin function ref 159 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3016 3104 2601 3026 Length 3332 2601 66 212 215 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_SET_ 670 external procedure is an external procedure. FME internal procedure shares stack frame of external procedure cobol_SET_. set_val internal procedure shares stack frame of external procedure cobol_SET_. err internal procedure shares stack frame of external procedure cobol_SET_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_SET_ 000100 Lp cobol_SET_ 000102 p cobol_SET_ 000104 L cobol_SET_ 000477 i cobol_SET_ 000500 j cobol_SET_ 000501 k cobol_SET_ 000502 m cobol_SET_ 000503 l cobol_SET_ 000504 e cobol_SET_ 000505 v cobol_SET_ 000506 c cobol_SET_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out return_mac shorten_stack ext_entry set_chars_eis index_chars_eis any_to_any_truncate_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_FP_ cobol_NUMS_ com_err_ cu_$arg_count cu_$arg_ptr THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_SM_$LTSIi cobol_SM_$MIi cobol_SM_$MIp cobol_SM_$SIi cobol_SM_$SIp cobol_SM_$SRp cobol_SM_$SSi cobol_SM_$SSp cobol_SM_$TSIi cobol_SM_$cmp cobol_SM_$disaster1 cobol_SM_$disaster2 cobol_SM_$max1 cobol_SM_$max2 cobol_SM_$max3 cobol_SM_$max4 cobol_SM_$mcp cobol_SM_$sort_dir LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 23 000433 26 000441 27 000445 28 000454 30 000457 34 000464 38 000476 41 000477 42 000505 43 000522 45 000524 46 000560 50 000561 52 000567 55 000636 62 001317 63 001337 64 001356 67 001551 68 001553 70 001557 71 001561 72 001562 73 001563 74 001564 75 001565 76 001566 77 001570 78 001571 79 001573 80 001575 83 001576 84 001607 87 001621 91 001632 94 001646 96 001664 100 001665 101 001672 103 001673 105 001704 106 001713 108 001720 109 001747 112 001750 113 001760 115 001767 116 001770 117 001771 118 001772 119 001773 120 001774 121 001775 122 001777 123 002000 124 002002 125 002004 128 002005 130 002016 132 002025 133 002115 135 002117 136 002242 137 002243 146 002244 151 002245 152 002246 153 002257 154 002264 156 002272 157 002313 159 002315 160 002337 163 002344 164 002347 166 002356 167 002357 169 002362 170 002363 172 002366 173 002367 175 002372 176 002373 178 002376 179 002377 181 002402 182 002403 184 002406 185 002407 187 002412 188 002413 190 002416 191 002417 193 002422 196 002423 198 002434 200 002544 ----------------------------------------------------------- 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