COMPILATION LISTING OF SEGMENT index_set Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 03/01/89 1358.1 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull 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-01-16,TLNguyen), approve(89-01-27,MCR8053), 17* audit(89-02-23,RBarstad), install(89-03-01,MR12.3-1018): 18* 1. Modify "Syntax" portion in comment lines stated at the beginning 19* of the source program to provide more information for usage. 20* 21* 2. Fix stringrange condition raised at the run time during testing 22* period. 23* 24* 3. Fix the bug occured when given L <= U and -I. For examples: 25* index_set 1 1 -1; index_set -7 -5 -2 26* END HISTORY COMMENTS */ 27 28 29 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 30 /* */ 31 /* index_set active function & command */ 32 /* */ 33 /* Function: returns/prints one or more sets of numbers. Numbers are separated from */ 34 /* one another by a space. Each set contains numbers in the sequence: */ 35 /* */ 36 /* L, L+I, L+2I, L+3I, ... L+kI */ 37 /* */ 38 /* where k is the largest integer such that L+kI<=U. L, U, and I are integers (either */ 39 /* positive or negative) representing the lowest number of each set, an upper bound */ 40 /* on set elements, and an increment between numbers of the set. */ 41 /* */ 42 /* Syntax: */ 43 /* case 1: [index_set U] is equivalent to [index_set 1 U 1] */ 44 /* */ 45 /* case 2: [index_set L U] */ 46 /* is equivalent to [index_set L U 1] if L <= U */ 47 /* is equivalent to [index_set L U -1] if L > U */ 48 49 /* */ 50 /* case 3: [index_set L U -I] */ 51 /* is treated as [index_set L U I] if L <= U */ 52 /* */ 53 /* case 4: [index_set L U I] */ 54 /* is treated as [index_set L U -I] if L > U */ 55 /* */ 56 /* case 5: [index_set L1 U1 I1 ... Ln Un In] */ 57 /* */ 58 /* Status: */ 59 /* 0) Recoded by Gary Dixon, June 1978. */ 60 /* */ 61 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 62 /* Fixed to handle "index_set 0 0" and reject increments of 0 - 07/07/81 S. Herbst */ 63 64 index_set: procedure; /* This active function returns a string of no. */ 65 66 dcl (Larg, Lret, Ls) fixed bin(21), 67 (Nargs, Ngroups) fixed bin, 68 (Parg, Parg_list, Pret) ptr, 69 Scommand bit(1) aligned, 70 code fixed bin(35), 71 (conversion, size) condition, 72 err entry options(variable) variable, 73 get_arg entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr) variable, 74 (i, j, k) fixed bin, 75 Npic pic "---------9"; 76 77 dcl arg char(Larg) based(Parg), 78 ret char(Lret) varying based(Pret); 79 80 dcl (abs, addr, convert, divide, length, log10, ltrim, maxlength, mod, substr) 81 builtin; 82 83 dcl (active_fnc_err_, 84 com_err_) entry options(variable), 85 (cu_$af_arg_ptr_rel, 86 cu_$arg_ptr_rel) entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr), 87 cu_$af_return_arg entry (fixed bin, ptr, fixed bin(21), fixed bin(35)), 88 cu_$arg_list_ptr entry returns(ptr), 89 iox_$put_chars entry (ptr, ptr, fixed bin(21), fixed bin(35)); 90 91 dcl (FALSE init("0"b), 92 TRUE init("1"b)) bit(1) aligned int static options(constant), 93 NL char(1) aligned int static options(constant) init(" 94 "), 95 (error_table_$bad_conversion, 96 error_table_$not_act_fnc, 97 error_table_$out_of_bounds, 98 error_table_$wrong_no_of_args) fixed bin(35) ext static, 99 iox_$user_output ptr ext static; 100 101 call cu_$af_return_arg (Nargs, Pret, Lret, code); /* See if invoked as command of af. Get af ret. */ 102 if code = error_table_$not_act_fnc then do; /* Invoked as a command. */ 103 err = com_err_; 104 get_arg = cu_$arg_ptr_rel; /* Report errors/get args accordingly. */ 105 Scommand = TRUE; 106 Lret = 100000; /* Limit printed output to 100000 chars. */ 107 end; /* per invocation of the command. */ 108 else if code = 0 then do; /* Invoked as an active function. */ 109 err = active_fnc_err_; 110 get_arg = cu_$af_arg_ptr_rel; 111 Scommand = FALSE; 112 end; 113 else go to BAD_INVOKE; /* Invoked without argument descriptors. */ 114 115 if Nargs = 0 then go to WNOA; /* Must be called with 1, 2, or 3 args, or */ 116 else if Nargs < 3 then; /* with a multiple of three args. */ 117 else if mod(Nargs,3) ^= 0 then go to WNOA; 118 119 if Nargs < 3 then /* When called with 3 or less args, output only */ 120 Ngroups = 1; /* one set of numbers. */ 121 else Ngroups = divide(Nargs,3,17,0); /* Otherwise output one set or group per triplet */ 122 Parg_list = cu_$arg_list_ptr(); /* of input args. Remember args before entering */ 123 /* begin block to get space for set boundaries. */ 124 125 begin; /* Start of BEGIN BLOCK for group boundary store */ 126 127 dcl 1 group (Ngroups), /* space for set boundaries. */ 128 2 (lb, ub, incr) fixed bin(34), /* lower bound, upper bound, increment. */ 129 vector (3 * Ngroups) fixed bin(34) based(addr(group)); 130 131 on conversion, size go to BAD_BOUND; 132 if Nargs = 1 then do; /* If only 1 arg, fake a lower bound of 1. */ 133 group(1).lb = 1; 134 group(1).incr = 1; 135 i = 2; /* 1st arg is the upper bound. */ 136 call get_arg (1, Parg, Larg, 0, Parg_list); /* get 1st arg and store it. */ 137 group(1).ub = convert(group(1).ub, arg); 138 if abs(group(1).ub) > 1000000000 then /* All lower/upper bounds <= one billion. */ 139 go to BAD_BOUND; 140 end; 141 else do; /* More than 1 arg. Process in triplets. */ 142 if Nargs = 2 then /* If only 2 args, fake third arg of 1 for incr. */ 143 group(1).incr = 1; 144 j = 0; /* Initialize triplet counter. */ 145 do i = 1 to Nargs; /* 1st args of triplet is L; 2nd is U; 3rd is I. */ 146 call get_arg (i, Parg, Larg, 0, Parg_list); 147 vector(i) = convert(vector(i), arg); 148 if abs(vector(i)) > 1000000000 then /* All lower/upper bounds <= one billion. */ 149 go to BAD_BOUND; 150 j = j + 1; 151 if j = 3 then do; /* Triplet complete? */ 152 if vector (i) = 0 then do; /* increment value cannot be zero. */ 153 call err (error_table_$bad_conversion, "index_set", 154 "Increment cannot be zero (Argument ^d)", i); 155 return; 156 end; 157 else if vector(i) > 1000000 then /* Increments <= one million. */ 158 go to BAD_BOUND; 159 else; /* otherwise, either negative or position increment value is ok */ 160 161 j = 0; /* reset triplet counter; prepare for next triple.*/ 162 end; 163 end; 164 end; 165 revert conversion; 166 167 Ls = 0; /* Compute length of string needed to return all */ 168 do i = 1 to Ngroups; /* sets of numbers. */ 169 Ls = Ls + s_length(group(i)); 170 end; 171 if Ls > Lret then do; /* Complain if return string is too long. */ 172 call err (error_table_$out_of_bounds, "index_set", 173 "Return string of ^d chars is longer than ^d.", 174 Ls, Lret); 175 go to RETURN; 176 end; 177 178 if ^Scommand then Ls = 0; /* If invoked as active function, use af return */ 179 /* arg to hold string; as command, allocate */ 180 /* storage via begin block (below) to hold string.*/ 181 182 183 184 begin; /* Start of BEGIN BLOCK for result string storage.*/ 185 186 dcl s char (Ls) varying; /* the returned integers are hold in an automatic character string */ 187 188 189 if Scommand then do; 190 Pret = addr (s); 191 Lret = maxlength (s); 192 end; 193 194 ret = ""; 195 196 do i = 1 to Ngroups; /* For each set (group) of numbers to be returned,*/ 197 if group(i).lb <= group(i).ub then do; /* if L < = U and I is negative, then I is assumed to be positive */ 198 if group (i).incr < 0 then 199 group (i).incr = abs (group (i).incr); 200 end; 201 else do; /* if L > U and I is positive, then I is assumed to be negative */ 202 if group (i).incr > 0 then 203 group (i).incr = - (group (i).incr); 204 end; 205 206 do j = group(i).lb to group(i).ub by group(i).incr; 207 Npic = j; /* compute group elements; store in result str. */ 208 209 if (i = 1) & (j = group (i).lb) then /* if this is the first time in both loops */ 210 ret = ltrim (Npic); /* then get the returned integer */ 211 else ret = ret || ltrim(Npic); /* append the returned integer to the already string of returned integers */ 212 213 ret = ret || " "; /* each returned integer is separated by a white space */ 214 end; 215 end; 216 if Scommand then do; /* Print result string when invoked as a command */ 217 substr(ret, length (ret), 1) = NL; /* add the Newline character in place of a white space at the end */ 218 219 call iox_$put_chars (iox_$user_output, addr (substr (ret, 1)), length (ret), code); 220 end; 221 else ret = substr (ret, 1, length (ret) - 1); /* Return af result (except for extra space */ 222 /* at end of string). */ 223 224 225 end; /* End of BEGIN BLOCK for result string storage. */ 226 227 s_length: procedure (g) returns (fixed bin(21)); /* This internal proc computes APPROXIMATE length */ 228 /* of result string needed for 1 group (set) of */ 229 /* numbers. The guess is always guaranteed to be */ 230 /* >= the storage actually required. */ 231 232 dcl 1 g, 233 2 (l, u, i) fixed bin(34), 234 (lb, ub) fixed bin(34), 235 (i, j) fixed bin, 236 len fixed bin(71); 237 238 239 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 240 /* */ 241 /* A set of numbers is defined by a triplet (L U I) where L is lower bound, U is upper */ 242 /* bound, I is increment between numbers. */ 243 /* */ 244 /* s_length(L U I) can be found by the following procedure: */ 245 /* 1) Start out by assuming an increment of 1 (L U 1). */ 246 /* 2) Break apart (L U 1) into one or more intervals, each of whose L is 1, -1, or 0. */ 247 /* For example, */ 248 /* (1 10 1) ==> stays unbroken */ 249 /* (5 10 1) ==> (1 10 1) - (1 4 1) (ie, {1 2 3 4 5 6 7 8 9 10} - {1 2 3 4} */ 250 /* (-7 -1 1)==> (-1 -7 1) */ 251 /* (-4 5 1) ==> (-1 -4 1) + (0 0 1) + (1 5 1) */ 252 /* 3) s_length(0 0 1) is 2. */ 253 /* 4) s_length(-|L| -|U| 1) = s_length(|L| |U| 1) + n_elements(|L| |U| 1) */ 254 /* For example, s_length(-1 -7 1) = s_length(1 7 1) + 7, because a - sign precedes */ 255 /* each element of (-1 -7 1). */ 256 /* 5) At this point, any s_length(L U 1) can be computed as sum or difference of some */ 257 /* s_length(1 Ui 1). */ 258 /* */ 259 /* To compute s_length(1 U 1), do the following. */ 260 /* 6) Determine how many chars required to output U followed by a space. */ 261 /* n_chars(U) = log10(U)+2 */ 262 /* In all uses of log10(U) in this algorithm, we are interested only in the integer */ 263 /* part of the value. For example, log10(250) = 2 and 4 chars are req'd to output 250.*/ 264 /* These are the longest numbers of the set. */ 265 /* 7) Determine how many of these longest numbers there are. */ 266 /* n_longest(U) = U - (10**log10(U) - 1) */ 267 /* For example, n_longest(110) = 110 - (10**log10(110) - 1) */ 268 /* = 110 - (10**2 - 1) = 110 - 99 = 11 */ 269 /* The table subtrahend(0:8) contains the values of (10**log10(U) - 1) for values of */ 270 /* log10(U) from 0 to 8. */ 271 /* 8) From (6) and (7) we have: */ 272 /* s_length( 10**log10(U) U 1) = n_chars(U) * n_longest(U) */ 273 /* For example, s_length(100 110 1) = n_chars(110) * n_longest(110) */ 274 /* = (log10(110)+2) * (110 - 99) */ 275 /* = 4 * 11 = 44 */ 276 /* 9) Since s_length(1 U 1) = s_length(1 10**log10(U)-1 1) + */ 277 /* s_length(10**log10(U) U 1) */ 278 /* we can compute s_length(1 U 1) from (8) above and s_length(1 10**log10(U)-1 1). */ 279 /* s_length(1 10**log10(U)-1 1) is stored in the addend(0:8) table below for */ 280 /* values of log10(U) from 0 to 8. Values of s_length(-1 -(10**log10(U)-1) 1) are */ 281 /* stored in neg_addend(0:8) below. */ 282 283 /* Thus, we have from the above: */ 284 /* s_length(1 U 1) = s_length(10**log10(U) U 1) + s_length(1 10**log10(U)-1 1) */ 285 /* = n_chars(U) * n_longest(U) + addend(log10(U)) */ 286 /* = log10(U)+2 * (U - subtrahend(log10(U))) + addend(log10(U)) */ 287 /* and s_length(-1 -|U| 1) = */ 288 /* = log10(|U|)+3 * (|U| - subtrahend(log10(|U|))) + */ 289 /* neg_addend(log10(|U|)) */ 290 /* */ 291 /* At this point, we can compute s_length(L U 1) for any integer L and U. */ 292 /* The value computed by the above formula is exact! We provide the following */ 293 /* approximation for handling integer increments > 1. */ 294 /* s_length(1 U I) = */ 295 /* log10(U) */ 296 /* ________ */ 297 /* \ */ 298 /* \ */ 299 /* s_length(1 U 1) \ */ 300 /* --------------- + > (k+2) */ 301 /* I / */ 302 /* / */ 303 /* /________ */ 304 /* k = 0 */ 305 /* The rational is that only every Ith number of the set will be output, so the */ 306 /* result string need be only 1/I as long, approximately. The approximation comes from */ 307 /* the fact that I probably does not evenly divide the number of elements of any given */ 308 /* length in the set of numbers. To compensate, we add room for one number of each length*/ 309 /* to the result string (the summation does this). If for shorthand we write the */ 310 /* summation above as sum(k+2, k=0 to log10(U)), then we have */ 311 /* s_length(-1 -|U| |I|) = s_length(-1 -|U| 1) / I + sum(k+3, k = 0 to log10(|U|)) */ 312 /* */ 313 /* By the rules of algebra, we have */ 314 /* sum(k+2, k = 0 to log10(U)) = sum(k, k = 0 to log10(U)) + 2*(log10(U)+1) */ 315 /* = (log10(U)*(log10(U)+1)) / 2 + 2*(log10(U)+1) */ 316 /* This result is used in the equations below. */ 317 /* */ 318 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 319 320 321 dcl addend (0:8) fixed bin(71) int static options(constant) init( 322 0, 323 18, 324 288, 325 3888, 326 48888, 327 588888, 328 6888888, 329 78888888, 330 888888888), 331 neg_addend (0:8) fixed bin(71) int static options(constant) init( 332 0, 333 27, 334 387, 335 4887, 336 58887, 337 688887, 338 7888887, 339 88888887, 340 988888887), 341 subtrahend (0:8) fixed bin(71) int static options(constant) init( 342 0, 343 9, 344 99, 345 999, 346 9999, 347 99999, 348 999999, 349 9999999, 350 99999999); 351 352 if g.l > g.u then do; /* Treat (12 5 1) as (5 12 1), etc. */ 353 lb = g.u; /* Swap upper and lower bounds. */ 354 ub = g.l; 355 end; 356 else do; /* Copy upper and lower bounds without swap. */ 357 lb = g.l; 358 ub = g.u; 359 end; 360 if (lb>=0) & (ub>=0) then do; /* All numbers in set are nonnegative. */ 361 if ub = 0 then i = 0; 362 else i = log10(ub); /* This number is used everywhere. */ 363 364 len = addend(i) + (i+2)*(ub-subtrahend(i)); /* compute s_length(1 U 1). */ 365 366 if lb = 1 then; 367 else if lb = 0 then /* add 2 to handle "0 " if present. */ 368 len = len + 2; 369 else do; /* s_length(L U 1) = s_length(1 U 1) - */ 370 lb = lb - 1; /* s_length(1 L-1 1) */ 371 if lb = 0 then j = 0; 372 else j = log10(lb); 373 374 len = len - (addend(j) + (j+2)*(lb-subtrahend(j))); 375 end; 376 377 if g.i ^= 1 then /* s_length(L U I) = s_length(L U 1)/I + */ 378 /* sum(k+2, k = 0 to i) */ 379 len = divide (len, abs (g.i), 35, 0) + divide (i * (i + 1), 2, 35, 0) + 2 * (i + 1); 380 end; 381 else if (lb<=0) & (ub<=0) then do; /* All numbers of set are nonpositive. */ 382 k = lb; /* Treat (-5 -2 1) as (2 5 1) from counting */ 383 lb = -ub; /* standpoint. */ 384 ub = -k; 385 if ub = 0 then i = 0; 386 else i = log10(ub); /* Compute s_length(1 |U| 1) */ 387 388 len = neg_addend(i) + (i+3)*(ub-subtrahend(i)); 389 390 if lb = 1 then; 391 else if lb = 0 then /* add 2 to handle "0 " if present. */ 392 len = len + 2; 393 else do; /* s_length(|L| |U| 1) = s_length(1 |U| 1) - */ 394 lb = lb - 1; /* s_length(1 |L|-1 1) */ 395 if lb = 0 then j = 0; 396 else j = log10(lb); 397 398 len = len - (neg_addend(j) + (j+3)*(lb-subtrahend(j))); 399 end; 400 401 if g.i ^= 1 then /* s_length(L U I) = s_length(L U 1)/I + */ 402 /* sum(k+3, k = 0 to i) */ 403 len = divide (len, abs (g.i), 35, 0) + divide (i * (i + 1), 2, 35, 0) + 3 * (i + 1); 404 end; 405 else do; /* Sets contains both positive and negative numbers*/ 406 /* so use a combination of 2 cases above. */ 407 lb = -lb; /* lb < 0; invert its sign. */ 408 if lb = 0 then i = 0; 409 else i = log10(lb); 410 411 len = neg_addend(i) + (i+3)*(lb-subtrahend(i)); 412 len = len + 2; /* Account for the 0 between neg. lower bound */ 413 /* and pos. upper bound. */ 414 415 if ub = 0 then j = 0; 416 else j = log10(ub); 417 418 len = len + (addend(j) + (j+2)*(ub-subtrahend(j))); 419 420 if g.i ^= 1 then 421 len = divide (len, abs (g.i), 35, 0) + divide ((i + j) * (i + j + 1), 2, 35, 0) + 3 * (i + 1) + 2 * (j + 1); 422 end; 423 424 if len > Lret then do; /* If return string too long, report it now when */ 425 call err (error_table_$out_of_bounds, "index_set", " 426 String needed to return numbers from ^d to ^d is too long.", g.l, g.u); 427 go to RETURN; /* we know which set is too big. */ 428 end; /* Check for sum of all sets is done by caller. */ 429 430 return (len); 431 432 end s_length; 433 434 435 end; /* End of BEGIN BLOCK for group boundary store. */ 436 437 438 RETURN: return; 439 440 WNOA: call err (error_table_$wrong_no_of_args, "index_set", 441 "^/Usage: ^[^;[^]index_set first1 bound1 increment1 ... firstN boundN incrementN^[^;]^] 442 or: ^[^;[^]index_set first bound^[^;]^] 443 or: ^[^;[^]index_set bound^[^;]^]", Scommand, Scommand, Scommand, Scommand, Scommand, Scommand); 444 445 return; 446 447 BAD_BOUND: 448 call err (error_table_$bad_conversion, "index_set", " ^a is an invalid ^[increment^;first number^;bound^]. 449 Argument must satisfy the condition: 450 ^[-1000000^;-1000000000^;-1000000000^] <= ^[increment^;first number^;bound^] <= ^[1000000^;1000000000^;1000000000^]", 451 arg, mod(i,3)+1, mod(i,3)+1, mod(i,3)+1, mod(i,3)+1); 452 453 return; 454 455 BAD_INVOKE: 456 call active_fnc_err_ (code, "index_set"); 457 458 return; 459 460 end index_set; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 03/01/89 1357.1 index_set.pl1 >spec>install>1018>index_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. FALSE constant bit(1) initial dcl 91 ref 111 Larg 000100 automatic fixed bin(21,0) dcl 66 set ref 136* 137 146* 147 447 447 Lret 000101 automatic fixed bin(21,0) dcl 66 set ref 101* 106* 171 172* 191* 194 209 211 213 221 424 Ls 000102 automatic fixed bin(21,0) dcl 66 set ref 167* 169* 169 171 172* 178* 186 NL constant char(1) initial dcl 91 ref 217 Nargs 000103 automatic fixed bin(17,0) dcl 66 set ref 101* 115 116 117 119 121 132 142 145 Ngroups 000104 automatic fixed bin(17,0) dcl 66 set ref 119* 121* 127 168 196 Npic 000131 automatic picture(10) packed unaligned dcl 66 set ref 207* 209 211 Parg 000106 automatic pointer dcl 66 set ref 136* 137 146* 147 447 Parg_list 000110 automatic pointer dcl 66 set ref 122* 136* 146* Pret 000112 automatic pointer dcl 66 set ref 101* 190* 194 209 211 211 213 213 217 217 219 219 219 219 221 221 221 Scommand 000114 automatic bit(1) dcl 66 set ref 105* 111* 178 189 216 440* 440* 440* 440* 440* 440* TRUE constant bit(1) initial dcl 91 ref 105 abs builtin function dcl 80 ref 138 148 198 377 401 420 active_fnc_err_ 000010 constant entry external dcl 83 ref 109 455 addend 000044 constant fixed bin(71,0) initial array dcl 321 ref 364 374 418 addr builtin function dcl 80 ref 147 147 148 152 157 190 219 219 arg based char packed unaligned dcl 77 set ref 137 147 447* code 000115 automatic fixed bin(35,0) dcl 66 set ref 101* 102 108 219* 455* com_err_ 000012 constant entry external dcl 83 ref 103 conversion 000000 stack reference condition dcl 66 ref 131 165 convert builtin function dcl 80 ref 137 147 cu_$af_arg_ptr_rel 000014 constant entry external dcl 83 ref 110 cu_$af_return_arg 000020 constant entry external dcl 83 ref 101 cu_$arg_list_ptr 000022 constant entry external dcl 83 ref 122 cu_$arg_ptr_rel 000016 constant entry external dcl 83 ref 104 divide builtin function dcl 80 ref 121 377 377 401 401 420 420 err 000116 automatic entry variable dcl 66 set ref 103* 109* 153 172 425 440 447 error_table_$bad_conversion 000026 external static fixed bin(35,0) dcl 91 set ref 153* 447* error_table_$not_act_fnc 000030 external static fixed bin(35,0) dcl 91 ref 102 error_table_$out_of_bounds 000032 external static fixed bin(35,0) dcl 91 set ref 172* 425* error_table_$wrong_no_of_args 000034 external static fixed bin(35,0) dcl 91 set ref 440* g parameter structure level 1 unaligned dcl 232 set ref 227 get_arg 000122 automatic entry variable dcl 66 set ref 104* 110* 136 146 group 000100 automatic structure array level 1 unaligned dcl 127 set ref 147 147 148 152 157 169* i 000126 automatic fixed bin(17,0) dcl 66 in procedure "index_set" set ref 135* 145* 146* 147 147 148 152 153* 157* 168* 169* 196* 197 197 198 198 198 202 202 202 206 206 206 209 209* 447 447 447 447 i 000132 automatic fixed bin(17,0) dcl 232 in procedure "s_length" set ref 361* 362* 364 364 364 377 377 377 385* 386* 388 388 388 401 401 401 408* 409* 411 411 411 420 420 420 i 2 parameter fixed bin(34,0) level 2 in structure "g" dcl 232 in procedure "s_length" ref 377 377 401 401 420 420 incr 2 000100 automatic fixed bin(34,0) array level 2 dcl 127 set ref 134* 142* 198 198* 198 202 202* 202 206 iox_$put_chars 000024 constant entry external dcl 83 ref 219 iox_$user_output 000036 external static pointer dcl 91 set ref 219* j 000127 automatic fixed bin(17,0) dcl 66 in procedure "index_set" set ref 144* 150* 150 151 161* 206* 207 209* j 000133 automatic fixed bin(17,0) dcl 232 in procedure "s_length" set ref 371* 372* 374 374 374 395* 396* 398 398 398 415* 416* 418 418 418 420 420 420 k 000130 automatic fixed bin(17,0) dcl 66 set ref 382* 384 l parameter fixed bin(34,0) level 2 dcl 232 set ref 352 354 357 425* lb 000130 automatic fixed bin(34,0) dcl 232 in procedure "s_length" set ref 353* 357* 360 366 367 370* 370 371 372 374 381 382 383* 390 391 394* 394 395 396 398 407* 407 408 409 411 lb 000100 automatic fixed bin(34,0) array level 2 in structure "group" dcl 127 in begin block on line 125 set ref 133* 197 206 209 len 000134 automatic fixed bin(71,0) dcl 232 set ref 364* 367* 367 374* 374 377* 377 388* 391* 391 398* 398 401* 401 411* 412* 412 418* 418 420* 420 424 430 length builtin function dcl 80 ref 217 219 219 221 log10 builtin function dcl 80 ref 362 372 386 396 409 416 ltrim builtin function dcl 80 ref 209 211 maxlength builtin function dcl 80 ref 191 mod builtin function dcl 80 ref 117 447 447 447 447 neg_addend 000022 constant fixed bin(71,0) initial array dcl 321 ref 388 398 411 ret based varying char dcl 77 set ref 194* 209* 211* 211 213* 213 217 217* 219 219 219 219 221* 221 221 s 000100 automatic varying char dcl 186 set ref 190 191 size 000000 stack reference condition dcl 66 ref 131 substr builtin function dcl 80 set ref 217* 219 219 221 subtrahend 000000 constant fixed bin(71,0) initial array dcl 321 ref 364 374 388 398 411 418 u 1 parameter fixed bin(34,0) level 2 dcl 232 set ref 352 353 358 425* ub 1 000100 automatic fixed bin(34,0) array level 2 in structure "group" dcl 127 in begin block on line 125 set ref 137* 137 138 197 206 ub 000131 automatic fixed bin(34,0) dcl 232 in procedure "s_length" set ref 354* 358* 360 361 362 364 381 383 384* 385 386 388 415 416 418 vector based fixed bin(34,0) array dcl 127 set ref 147* 147 148 152 157 NAMES DECLARED BY EXPLICIT CONTEXT. BAD_BOUND 002054 constant label dcl 447 ref 131 138 148 157 BAD_INVOKE 002150 constant label dcl 455 ref 108 RETURN 002005 constant label dcl 438 set ref 175 427 WNOA 002006 constant label dcl 440 set ref 115 117 index_set 000322 constant entry external dcl 64 s_length 001274 constant entry internal dcl 227 ref 169 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2362 2422 2201 2372 Length 2614 2201 40 156 160 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME index_set 240 external procedure is an external procedure. begin block on line 125 366 begin block uses auto adjustable storage, and enables or reverts conditions. on unit on line 131 64 on unit begin block on line 184 88 begin block uses auto adjustable storage. s_length internal procedure shares stack frame of begin block on line 125. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME begin block on line 125 000100 group begin block on line 125 000130 lb s_length 000131 ub s_length 000132 i s_length 000133 j s_length 000134 len s_length begin block on line 184 000100 s begin block on line 184 index_set 000100 Larg index_set 000101 Lret index_set 000102 Ls index_set 000103 Nargs index_set 000104 Ngroups index_set 000106 Parg index_set 000110 Parg_list index_set 000112 Pret index_set 000114 Scommand index_set 000115 code index_set 000116 err index_set 000122 get_arg index_set 000126 i index_set 000127 j index_set 000130 k index_set 000131 Npic index_set THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 enter_begin_block leave_begin_block call_ent_var_desc call_ent_var call_ext_out_desc call_ext_out begin_return_mac return_mac fl2_to_fx1 tra_ext_1 alloc_auto_adj mpfx2 mdfx1 enable_op ext_entry int_entry any_to_any_truncate_ divide_fx3 double_log_base_10_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ cu_$af_arg_ptr_rel cu_$af_return_arg cu_$arg_list_ptr cu_$arg_ptr_rel iox_$put_chars THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_conversion error_table_$not_act_fnc error_table_$out_of_bounds error_table_$wrong_no_of_args iox_$user_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 64 000321 101 000327 102 000343 103 000347 104 000353 105 000356 106 000360 107 000362 108 000363 109 000365 110 000371 111 000374 115 000375 116 000377 117 000402 119 000405 121 000413 122 000415 125 000423 127 000426 131 000434 132 000460 133 000464 134 000466 135 000470 136 000472 137 000513 138 000525 140 000537 142 000540 144 000545 145 000546 146 000556 147 000575 148 000610 150 000624 151 000626 152 000631 153 000635 155 000671 157 000673 161 000700 163 000702 165 000704 167 000705 168 000707 169 000720 170 000735 171 000737 172 000742 175 001001 178 001004 184 001010 186 001013 189 001025 190 001030 191 001032 194 001034 196 001035 197 001047 198 001057 200 001065 202 001066 206 001072 207 001116 209 001127 211 001164 213 001214 214 001224 215 001227 216 001231 217 001234 219 001241 220 001262 221 001263 225 001271 435 001272 227 001274 352 001276 353 001302 354 001304 355 001306 357 001307 358 001310 360 001312 361 001316 362 001321 364 001326 366 001342 367 001346 370 001354 371 001356 372 001362 374 001367 377 001405 380 001443 381 001444 382 001450 383 001453 384 001455 385 001457 386 001462 388 001467 390 001503 391 001507 394 001515 395 001517 396 001523 398 001530 401 001546 404 001604 407 001605 408 001607 409 001612 411 001617 412 001633 415 001635 416 001641 418 001646 420 001663 424 001732 425 001737 427 001777 430 002002 438 002005 440 002006 445 002053 447 002054 453 002147 455 002150 458 002170 ----------------------------------------------------------- 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