COMPILATION LISTING OF SEGMENT tedsort_ Compiled by: Multics PL/I Compiler, Release 30, of February 16, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 10/07/88 1305.3 mst Fri Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 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(88-08-03,RWaters), approve(88-08-03,MCR7950), audit(88-09-29,Huen), 17* install(88-10-07,MR12.2-1146): 18* Bug fixes for MR12.2. 19* END HISTORY COMMENTS */ 20 21 22 /**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16 */ 23 /**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo */ 24 /**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend */ 25 /**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt */ 26 27 /* */ 28 /* _|_ | _|_ */ 29 /* | _ _ | ___ _ _ | */ 30 /* | / \ / \| / _ / \ |/ \ | */ 31 /* | (__/ ( | \_/ \ ( ) | | */ 32 /* \_ \_/ \_/| ___/ \_/ | \_ */ 33 /* ----- */ 34 /* */ 35 36 /**** <<<<----- dcl_tedsort_.incl.pl1 tedsort_ */ 37 tedsort_: /* sort in a buffer */ 38 proc (ain_p, ain_l, adata_p, adata_l, temp_p, out_l, msg, rc); 39 dcl ( 40 ain_p ptr, /* -> key specifications */ 41 ain_l fixed bin (21), /* length thereof */ 42 adata_p ptr, /* -> string to be sorted */ 43 adata_l fixed bin (21), /* length thereof */ 44 temp_p (3) ptr, /* working segments */ 45 /* (1) temp seg */ 46 /* (2) temp seg */ 47 /* (3) output seg */ 48 out_l fixed bin (21), /* length of result [OUT] */ 49 msg char (168) var, /* error details */ 50 rc fixed bin (35) /* return code [OUT] */ 51 ) parm; /* ----->>>> */ 52 53 /**** 03/19/74 Dave Ward initial coding */ 54 /**** 04/09/74 Jim Falksen expanded it */ 55 /**** 02/17/82 jaf reworked for split buffer */ 56 /**** 07/08/88 RW #198 phx20146: infinite loop when given j/1/ */ 57 58 /**** Sort the "records" in a string into a new string. Either a */ 59 /**** "regular" (fast) sort or a "special" (user supplied collating */ 60 /**** sequence) may be specified. Sorting may be on multiple keys */ 61 /**** defined in the specification string. Two temporary segments must */ 62 /**** also be supplied as well as the output segment. */ 63 64 /**** [1] The first string contains the specification of keys. If this */ 65 /**** is a null string then reqular sort is selected with the whole */ 66 /**** record as a key, in ascending order. Syntax of the specification: */ 67 /**** */ 68 /**** ? | {'ooo}{P1{,P2}... } | s={cs} */ 69 /**** */ 70 /**** "?" => display current special collating sequence */ 71 /**** 'ooo => octal specifier of record delimiter. Default is '012 */ 72 /**** Pi => {k}f | ={f} | s */ 73 /**** k => "a" | "A" for ascending sort (default) */ 74 /**** "d" | "D" for descending sort. */ 75 /**** f => m,m 1st m is beginning offset, 2nd is length */ 76 /**** m:m 1st m is beginning offset, 2nd is ending one */ 77 /**** m,- old form for "m:$" */ 78 /**** m => n number, measured from beginning of record */ 79 /**** $ end of record */ 80 /**** $-n number, measured from end of record */ 81 /**** "=" => duplicate record handling (see below) */ 82 /**** "s" => use special collating sequence */ 83 84 /**** "s=" => set special collating sequence to default */ 85 /**** "s=cs" => modify default by specification "cs" (Jset format) */ 86 87 /**** An "=" key indicates that no duplicates are wanted. The last one */ 88 /**** will be kept. The =n1,n2 form defines a field beginning at n1 with */ 89 /**** length of n2. The =n1:n2 form defines a field beginning at n1 and */ 90 /**** ending at n2. The count of how many of this kind of record existed is */ 91 /**** to be placed in this field. */ 92 93 /**** [2] The second string contains the records to be sorted. A */ 94 /**** "record" is a string of characters delimited by the record */ 95 /**** delimiter character on the right, and including this character. If */ 96 /**** the input string does not terminate with a record delimiter it is */ 97 /**** treated as if one follows the last character. The default record */ 98 /**** delimiter is NL. */ 99 100 /**** [3] The caller must set "temp_p(1)" and "temp__p(2)" to two aligned */ 101 /**** areas. The first area must contain atleast as many (36 bit) words */ 102 /**** as the number of records to sort. The second area must be twice */ 103 /**** this length. "temp_p(3)" points to the area to receive the sorted */ 104 /**** string. */ 105 106 /**** [4] The length of the sorted result is returned via "out_l". If the */ 107 /**** "=" specification is not given, the output length will equal the */ 108 /**** input length. Otherwise is could be longer or shorter. */ 109 110 /**** [5} "rc" is a value indicating whether the keys were proper. */ 111 /**** rc=0 => normal completion */ 112 /**** rc=1 => syntax error in specification, expr_l points to it */ 113 /**** rc=2 => only 1 input record, nothing was put in output string */ 114 115 start: 116 if Minit /* if first time into this proc */ 117 then do; /* initialize it */ 118 reset = MASTER; 119 call set; 120 end; 121 rc = 0; /* keys OK. */ 122 eq_field = ""b; 123 no_dupl, spec_sw = "0"b; 124 spec_p = ain_p; 125 spec_i = 1; 126 spec_l = ain_l; 127 call get_delim; 128 call get_keys; 129 nk = max (nk, 1); 130 131 /**** Isolate the "records" in the input. */ 132 Rp = temp_p (1); /* 1st temp segment. */ 133 R (1) = 1; /* first line at beginning */ 134 input_i = 1; 135 input_l = adata_l; 136 input_p = adata_p; 137 num_rec = 1; 138 do while (input_i <= input_l); 139 /* find end of record */ 140 j = index (substr (input, input_i), rec_delim); 141 if (j < 1) 142 then j = input_l - input_i + 1; 143 input_i = input_i + j; 144 num_rec = num_rec + 1; 145 if (num_rec > 65536) 146 then do; /* Segment exceeded. */ 147 num_rec = 65536; 148 input_i = input_l + 1; /* End examination for "records". */ 149 end; 150 else R (num_rec) = input_i; 151 end; 152 153 /* Sort the input. Construct sort index. */ 154 num_rec = num_rec - 1; /* Adjust to actual # of records. */ 155 if (num_rec = 1) /* don't bother if only 1 record */ 156 then do; 157 rc = 2; 158 return; 159 end; 160 SLp = temp_p (2); /* 2nd temp segment. */ 161 162 Op = temp_p (3); /* output string segment */ 163 Oe = 0; 164 165 call SORT; 166 167 out_l = Oe/* - 1*/; 168 rc = 0; 169 return; 170 key_error: 171 ain_l = spec_i; 172 rc = 1; 173 return; 174 /**** <<<<----- dcl_tedsort_.incl.pl1 tedsort_$show */ 175 show: /* print special collating sequence */ 176 entry; 177 /*dcl ( */ 178 /* /* no arguments */ 179 /* ) parm; /* ----->>>> */ 180 181 dcl jnum fixed bin (21), 182 jchar char (4) based (addr (jnum)); 183 184 show: 185 if Minit 186 then do; 187 reset = MASTER; 188 call set; 189 end; 190 Lp = addrel (addr (L), 1); 191 L = " "; 192 do i = 0 to 510; 193 do jnum = 0 to 511; 194 if rank (M (jnum)) = i 195 then do; 196 M1 = substr (jchar, 4, 1); 197 if (M1 < "!") | (M1 > "~") 198 then do; 199 L = L || "\"; 200 L = L || OC (fixed (M11)); 201 L = L || OC (fixed (M12)); 202 L = L || OC (fixed (M13)); 203 end; 204 else L = L || M1; 205 if length (L) > 72 206 then do; 207 call ioa_ (L); 208 L = "\c"; 209 end; 210 end; 211 end; 212 if L = "\c" 213 then L = ""; 214 else if (substr (L, length (L), 1) ^= " ") 215 then L = L || " "; 216 end; 217 call ioa_ (L); 218 return; 219 /**** <<<<----- dcl_tedsort_.incl.pl1 tedsort_$set */ 220 set: /* set special collating sequence */ 221 entry (setting); 222 dcl ( 223 setting char (*) /* user's specification */ 224 ) parm; /* ----->>>> */ 225 226 227 Lp = addrel (addr (L), 1); 228 /* Reset the mapping array (M). */ 229 call cu_$arg_count (ii, 0); 230 reset = MASTER; 231 if ii ^= 0 232 then reset = reset || setting; 233 call set; 234 return; 235 236 set_error: 237 return; 238 set: proc; /* set the mapping array */ 239 240 Minit = "0"b; 241 l = length (reset); 242 NS = 1; 243 if db_sort 244 then call ioa_$ioa_switch (db_output, 245 "^i-->^i",NS,l); 246 do while (pair (ff1, ll1, bb1, ff2, ll2, bb2)); 247 if ((ff2 - ll2) ^= 0) 248 & (abs (ff2 - ll2) ^= abs (ff1 - ll1)) 249 then do; 250 msg = "Jun) Unequal number of range members"; 251 goto set_error; 252 end; 253 if (ff2 = ll2) 254 then bb2 = 0; 255 j = ff2; 256 do i = ff1 to ll1 by bb1; 257 M (i) = byte (j); 258 j = j + bb2; 259 end; 260 if db_sort 261 then call ioa_$ioa_switch (db_output, 262 "^i->^i",NS,l); 263 end; 264 return; 265 266 end set; 267 pair: proc (f1, l1, b1, f2, l2, b2) returns (bit (1)); 268 /* returns 1 if proper pair exists */ 269 270 dcl (f1, /* first "from" value */ 271 f2, /* last "from" value */ 272 l1, /* "from" increment */ 273 l2, /* first "to" value */ 274 b1, /* last "to" value */ 275 b2 /* "to" increment */ 276 ) fixed bin (21) parm; 277 278 if NK (f1, l1, b1) then do; return ("0"b); end; 279 if ^NK (f2, l2, b2) 280 then do; 281 if db_sort 282 then call ioa_$ioa_switch (db_output, 283 "^( ^i,^i,^i^)", f1,l1,b1, f2,l2,b2); 284 return ("1"b); 285 end; 286 msg = "Jnp) Reset string is not pairs."; 287 goto set_error; 288 289 end pair; 290 NK: proc (af, al, ab) returns (bit (1)); 291 /* returns 1 if value ^exist */ 292 293 dcl (af fixed bin (21), /* first pair value */ 294 al fixed bin (21), /* last pair value */ 295 ab fixed bin (21) /* increment value (+1 | -1) */ 296 ) parm; 297 298 if K (af) 299 then return ("1"b); 300 al = af; 301 ab = 1; 302 if (NS < l) 303 then do; 304 if (substr (reset, NS, 2) = "->") 305 then do; 306 NS = NS + 2; 307 if K (al) 308 then do; 309 msg = "Jmv) Missing value after ""->"""; 310 goto set_error; 311 end; 312 if al < af 313 then ab = -1; 314 else ab = 1; 315 end; 316 end; 317 value_present: 318 return ("0"b); 319 320 end NK; 321 K: proc (j) returns (bit (1)); 322 /* returns 1 if no value present */ 323 dcl j fixed bin (21) parm; 324 325 if (NS > l) 326 then goto no_value; 327 if (substr (reset, NS, 1) ^= "'") 328 then do; 329 j = fixed (unspec (substr (reset, NS, 1))); 330 NS = NS + 1; 331 goto value_present; 332 end; 333 /* => Escaped character. */ 334 NS = NS + 1; 335 if (NS+2 > l) 336 then goto no_value; /* not enough left to process */ 337 if (verify (substr (reset, NS, 3), "01234567") = 0) 338 then do; 339 unspec (octals) = unspec (substr (reset, NS, 3)); 340 j = bin (octals (3)||octals (6)||octals(9)); 341 NS = NS + 3; 342 goto value_present; 343 end; 344 no_value: 345 return ("1"b); 346 value_present: 347 return (""b); 348 dcl octals (9) bit (3)unal; 349 350 351 end K; 352 dcl OC (0:7) char (1) int static 353 init ("0", "1", "2", "3", "4", "5", "6", "7"); 354 dcl i1 fixed bin (35); 355 get_delim: proc; 356 357 dcl j fixed bin (21); 358 359 rec_delim = " 360 "; 361 if (spec_l = 0) 362 then return; 363 spec_i = 1; 364 if (spec_c (spec_i) = "s") 365 then do; 366 spec_sw = "1"b; 367 spec_i = spec_i + 1; 368 end; 369 if (spec_c (spec_i) = "'") 370 then do; 371 j = cv_oct_check_ (substr (spec, spec_i+1, 3), i1); 372 if (i1 ^= 0) 373 then do; 374 spec_i = spec_i + i1; 375 msg = "Sno) Non-octal digit in delimiter specification."; 376 goto key_error; 377 end; 378 rec_delim = byte (j); 379 spec_i = spec_i + 4; 380 if (spec_c (spec_i) = ",") 381 then spec_i = spec_i + 1; 382 end; 383 384 end get_delim; 385 get_keys: proc; 386 387 nk = 0; 388 389 do while (spec_i <= spec_l); 390 nk = nk + 1; /* Count the keys. */ 391 keys.order (nk) = "1"b; /* Assume ascending. */ 392 ch = spec_c (spec_i); 393 spec_i = spec_i + 1; 394 if (ch = "s") 395 then do; /* Calling for special sequence */ 396 nk = nk - 1; /* (doesn't count as a key) */ 397 spec_sw = "1"b; 398 end; /* leave do -> last char used */ 399 else do; 400 got_pair = ""b; 401 dcl key_type fixed bin; 402 key_type = index ("=adAD", ch); 403 if (key_type > 3) then key_type = key_type - 2; 404 /* RW 88 */ 405 if (key_type = 0) then do; 406 spec_i = spec_i - 1; 407 if (spec_i = spec_l) then do; /*#198*/ 408 msg = "Jms) Missing 2nd value"; /*#198*/ 409 goto key_error; /*#198*/ 410 end; /*#198*/ 411 end; 412 413 if (spec_i < spec_l) 414 then if (spec_c (spec_i) ^= ",") 415 then do; 416 call get_pair (keys.loc1 (nk), keys.loc2 (nk), keys.n_n (nk)); 417 got_pair = "1"b; 418 end; 419 if (key_type = 1) /* "=" */ 420 then do; 421 eq_field = got_pair; 422 eq_loc = keys.loc1 (nk); 423 eq_leng = keys.loc2 (nk); 424 eq_n_n = keys.n_n (nk); 425 nk = nk - 1; 426 no_dupl = "1"b; 427 if got_pair 428 then do; 429 if eq_n_n & (eq_loc-eq_leng > 11) 430 | ^eq_n_n & (eq_leng > 12) 431 then do; 432 msg = "Jll) = field length > 12"; 433 goto key_error; 434 end; 435 end; 436 got_pair = "1"b; 437 end; 438 else if (key_type = 3) /* "d" */ 439 then keys.order (nk) = "0"b; 440 if ^got_pair 441 then do; 442 keys.loc1 (nk) = 1; /* first char of record */ 443 keys.n_n (nk) = "1"b; /* n:n format */ 444 keys.loc2 (nk) = 0; /* last char of record */ 445 end; 446 if (spec_i < spec_l) 447 then do; 448 if (spec_c (spec_i) = ",") 449 then spec_i = spec_i + 1; 450 else do; 451 msg = "Jmc) Missing comma."; 452 goto key_error; 453 end; 454 end; 455 end; 456 end; 457 if (nk = 0) 458 then do; 459 nk = 1; 460 keys.order (1) = "1"b; /* plug in default values first */ 461 keys.loc1 (1) = 1; /* first char of record */ 462 keys.n_n (1) = "1"b; /* n:n format */ 463 keys.loc2 (1) = 0; /* last char of record */ 464 end; 465 466 dcl ch char (1); 467 dcl got_pair bit (1); 468 get_pair: proc (v1, v2, n_n); 469 470 dcl ((v1, v2) fixed bin (21), 471 n_n bit (1) aligned 472 ) parm; 473 474 475 if ^get_single (v1) 476 then do; 477 msg = "Kuk) Unknown key type"; 478 goto key_error; 479 end; 480 if (spec_c (spec_i) = ":") 481 then do; 482 n_n = "1"b; /* n:n form */ 483 spec_i = spec_i + 1; 484 end; 485 else if (spec_c (spec_i) = ",") 486 then do; 487 spec_i = spec_i + 1; 488 if (spec_c (spec_i) = "$") 489 then do; 490 msg = "Jnd) $ not allowed as a length."; 491 goto key_error; 492 end; 493 n_n = ""b; /* n,l form */ 494 if (spec_c (spec_i) = "-") 495 then do; 496 spec_i = spec_i + 1; 497 v2 = 0; 498 n_n = "1"b; 499 return; 500 end; 501 end; 502 else do; 503 msg = "Jms) Missing 2nd value"; 504 goto key_error; 505 end; 506 if ^get_single (v2) 507 then goto key_error; 508 509 end get_pair; 510 511 512 get_single: proc (v) returns (bit (1)); 513 514 dcl v fixed bin (21); 515 dcl ch char (1); 516 ch = ""; 517 if (spec_c (spec_i) = "$") 518 then do; 519 v = 0; 520 spec_i = spec_i + 1; 521 if (spec_i > spec_l) 522 then return("1"b); 523 if (spec_c (spec_i) ^= "-") 524 then return("1"b); 525 spec_i = spec_i + 1; 526 ch = "-"; 527 end; 528 if ^num (v) 529 then do; 530 msg = "Jmn) Missing number"; 531 return (""b); 532 end; 533 if (ch = "-") 534 then v = -v; 535 return ("1"b); 536 537 end get_single; 538 end get_keys; 539 num: proc (v) returns (bit (1)); 540 /* returns 1 if integer found */ 541 dcl v fixed bin (21) parm; 542 543 i = verify (substr (spec, spec_i), "0123456789"); 544 if (i = 0) 545 then i = spec_l - spec_i + 1; 546 else i = i - 1; 547 v = fixed (substr (spec, spec_i, i)); 548 spec_i = spec_i + i; 549 if v < 1 then do; 550 rc = 1; 551 return ("0"b); 552 end; 553 return ("1"b); 554 555 dcl i fixed bin; 556 557 end num; 558 SORT: proc; 559 560 /**** SL, of length numrec, is the ordering of the data to be sorted. */ 561 /**** Using the comparison procedures Jcmp or jcmp, return SL ordered */ 562 /**** according to the comparisons. */ 563 564 /**** cmp has two input parameters. These are two entries from the lst */ 565 /**** that point to the next two data elements to be sorted. If the */ 566 /**** data element pointed to by the first parameter is "next" then cmp */ 567 /**** returns a zero, 0, else returns a one, 1. */ 568 569 /**** calc lengths of lists and their start pointers in a linear set. */ 570 571 t = 0; 572 l = num_rec; 573 do n = 1 by 1 while (l > 1); 574 s (n) = t; /* start of the next list. */ 575 if mod (l, 2) = 1 576 then l = l + 1; /* make the length even. */ 577 t = t + l; /* accumulate the lengths. */ 578 SL (t) = 0; 579 l = divide (l, 2, 24, 0); /* next list 1/2 length the present */ 580 end; 581 n = n - 1; 582 583 /**** pointers to input list. */ 584 do i = 1 to num_rec; 585 SL (i) = i; 586 end; 587 588 /* fill in all lists. */ 589 do i = 2 to n; 590 if db_sort then call ioa_$ioa_switch_nnl (db_output, 591 "list ^d^/", i); 592 lft = s (i - 1); 593 rit = s (i); 594 do j = 1 by 2 to (rit - lft); 595 x = lft + j; 596 v1 = SL (x); 597 v2 = SL (x + 1); 598 call COMPARE; 599 rit = rit + 1; 600 SL (rit) = v1; 601 if db_sort then call ioa_$ioa_switch_nnl (db_output, 602 "^-SL(^d)=^d^/", rit, v1); 603 end; 604 end; 605 606 607 /* calculate the list of pointers in o */ 608 count = 1; 609 y = s (n) + 1; 610 do i = 1 to num_rec; 611 v1 = SL (y); 612 v2 = SL (y + 1); 613 if (v1 = 0) & (v2 = 0) 614 then i = num_rec; /* End "i" loop. */ 615 else do; 616 call COMPARE; /* next output value. */ 617 if (v1 < 0) 618 then count = count + 1; 619 if (v1 < 0) & no_dupl 620 then do; 621 if db_sort then call ioa_$ioa_switch_nnl (db_output, 622 "^-drop(^d)^d^/", v1, count); 623 end; 624 else do; 625 dcl (tloc, tlen) fixed bin (21); /* field location/length */ 626 dcl (ilen, olen) fixed bin (21); /* input/output lengths */ 627 l = abs (SL (abs (v1))); 628 f = R (l); 629 ilen, olen = R (l + 1) - f; 630 if db_sort then call ioa_$ioa_switch_nnl (db_output, 631 "^-put(^d)^d^/", v1, count); 632 if no_dupl & eq_field 633 then do; /* put count into record */ 634 if (eq_loc < 1) /* figure begin key location */ 635 then tloc = ilen; /* counting from the end */ 636 else tloc = 1; /* counting from the beginnning */ 637 tloc = tloc + eq_loc - 1; /* calc where field starts */ 638 if (tloc < 1) 639 then do; /* falls off the front, increment */ 640 /**** olen = ilen - tloc + 1; /* ..length so will be @1 */ 641 olen = ilen - tloc; /* ..length so will be @1 */ 642 tloc = 1; 643 end; 644 if eq_n_n 645 then do; /* =n:n form */ 646 if (eq_leng+1 > olen)/* is location beyond end? */ 647 then olen = eq_leng + 1; /* push out 'till can fit */ 648 tlen = eq_leng - tloc + 1; /* calc field length */ 649 end; 650 else do; /* =n,l form */ 651 tlen = eq_leng; 652 if (tlen + tloc > olen) 653 then olen = tloc + tlen; 654 end; 655 /* done like this so will be padded */ 656 /* with blanks if necessary. */ 657 /* think about 4 char record with */ 658 /* =3,3 or =$-8,3 */ 659 substr (O, Oe + 1, olen) = substr (input, f, ilen-1); 660 substr (O, Oe + olen, 1) = rec_delim; 661 dcl accum pic "(12)9"; 662 accum = count; 663 substr (O, Oe + tloc, tlen) 664 = substr (accum, 13 - tlen, tlen); 665 end; 666 else substr (O, Oe + 1, olen) = substr (input, f, ilen); 667 668 count = 1; 669 Oe = Oe + olen; 670 end; 671 v1 = abs (v1); 672 SL (v1) = 0; /* delete the last winner. */ 673 do j = 2 to n; /* get the next winner. */ 674 v1 = abs (v1); 675 lft = s (j - 1); 676 if mod (v1, 2) = 1 677 then v2 = v1 + 1; 678 else v2 = v1 - 1; 679 x = divide (v1 + 1, 2, 24, 0); 680 v1 = SL (v1 + lft); 681 v2 = SL (v2 + lft); 682 call COMPARE; 683 SL (x + s (j)) = v1; 684 v1 = x; 685 end; 686 end; 687 end; 688 689 /* declarations. */ 690 dcl t fixed bin (21); 691 dcl n fixed bin (21); 692 dcl v1 fixed bin (21); 693 dcl v2 fixed bin (21); 694 dcl count fixed bin (21); 695 dcl l fixed bin (21); 696 dcl x fixed bin (21); 697 dcl j fixed bin (21); 698 dcl y fixed bin (21); 699 dcl lft fixed bin (21); 700 dcl rit fixed bin (21); 701 dcl i fixed bin (21); 702 /****dcl accum char (12); */ 703 dcl s (36) fixed bin (21);/* Indices to "bottoms" of lists. */ 704 705 706 /* . . . COMPARE . . . */ 707 708 COMPARE: proc; 709 710 if (v1 = 0) 711 then v1 = v2; 712 else do; 713 if (v2 ^= 0) 714 then do; 715 if (Jcmp (SL (abs (v1)), SL (abs (v2))) = 1) 716 /* cv = Jcmp (SL (abs (v1)), SL (abs (v2))); 717* if (cv = 1) */ 718 then v1 = v2; 719 if equal & (v1 > 0) 720 then do; 721 SL (v1) = -v1; 722 v1 = -v1; 723 end; 724 end; 725 end; 726 727 end COMPARE; 728 end SORT; 729 Jcmp: proc (p1, p2) returns (fixed bin (21)); 730 /**** This procedure compares two records on the "nk" key fields. Three */ 731 /**** cases to consider: */ 732 733 /**** I Key fields (partially or all) within both records. */ 734 /**** Compare key fields in both records, but not beyond extent of */ 735 /**** either record, and return record (index to it) according to the */ 736 /**** keys order field. "1"b => ascending "0"b=> descending. */ 737 738 /**** II Key field within one record but outside of the other. Ascending */ 739 /**** order returns the record the key field is outside of. */ 740 /**** Descending the record the key field is inside of. */ 741 742 /**** III Key field outside of both records. Continue comparing on */ 743 /**** remaining key fields. Note that key fields are first "mapped" */ 744 /**** through the array "M". If the value produced is octal 777 then */ 745 /**** the key field character is skipped, otherwise its mapped value */ 746 /**** is compared. */ 747 748 equal = "0"b; 749 Fn (1) = R (abs (p1)); /* 1st char of 1st record. */ 750 Fn (2) = R (abs (p2)); /* 1st char of 2nd record. */ 751 Ln (1) = R (abs (p1) + 1); /* 1st char after 1st record. */ 752 Ln (2) = R (abs (p2) + 1); /* 1st char after 2nd record. */ 753 if db_sort 754 then call ioa_$ioa_switch_nnl (db_output, 755 "^[J^;j^]: ^d(^d:^d):^d(^d:^d)^/", spec_sw, 756 p1, Fn (1), Ln (1), p2, Fn (2), Ln (2)); 757 do i = 1 to nk; /* Compare 1st & 2nd records by each */ 758 /* key. */ 759 f = keys.loc1 (i); /* begin key info */ 760 l = keys.loc2 (i); /* end key info */ 761 nn = keys.n_n (i); /* key form info 1->n:n 0->n,l */ 762 if db_sort 763 then call ioa_$ioa_switch_nnl (db_output, 764 "^2i) f=^i l=^i ^[A^;D^]^[n:n^;n,l^]", i, f, l, 765 keys.order (i), nn); 766 do ii = 1 to 2; 767 if (f < 1) /* figure begin key location */ 768 then fn (ii) = Ln (ii); 769 else fn (ii) = Fn (ii); 770 fn (ii) = fn (ii) + f - 1; 771 if (Fn (ii) > fn (ii)) | (fn (ii) >= Ln (ii)) 772 then do; /* Key does not begin in record, */ 773 fn (ii), ln (ii) = 0; /* ..thus key is null. */ 774 end; 775 else do; 776 if nn /* is it n:n form */ 777 then do; 778 if (l < 1) 779 then ln (ii) = Ln (ii); 780 else ln (ii) = Fn (ii); 781 end; 782 else ln (ii) = fn (ii); /* it is n,l form */ 783 ln (ii) = min (Ln (ii) - 1, ln (ii) + l - 1); 784 ln (ii) = max (Fn (ii) - 1, ln (ii)); 785 end; 786 if db_sort 787 then call ioa_$ioa_switch_nnl (db_output, 788 " (^d,^d)^[^/^]", 789 fn (ii), ln (ii), (ii=2)); 790 end; 791 if (fn (1) > 0) /* key within 1st record? */ 792 then do; 793 if (fn (2) > 0) /* key within 2nd record? */ 794 then do; /* Keys: in 1st, in 2nd */ 795 if spec_sw 796 then do; 797 if keys.order (i) 798 then order_num = 1; /* -- Ascending */ 799 else order_num = 2; /* -- Descending */ 800 r = CC (fn (order_num), ln (order_num)+1, 801 fn (3 - order_num), ln (3 - order_num)+1); 802 if (r < 2) 803 then return (r); 804 end; 805 else do; 806 ln (1) = ln (1) - fn (1) + 1; 807 ln (2) = ln (2) - fn (2) + 1; 808 order_num = fixed (keys.order (i)); /* "1"b-asc "0"b-desc */ 809 if "0"b 810 then call ioa_$ioa_switch (db_output, 811 "^i""^a"":^i""^a""", 812 ln (1), substr (input, fn (1),ln (1)), 813 ln (2), substr (input, fn (2),ln (2))); 814 if substr (input, fn (1), ln (1)) 815 > substr (input, fn (2), ln (2)) 816 then return (order_num); /* 1-asc 0-desc */ 817 if substr (input, fn (1), ln (1)) 818 < substr (input, fn (2), ln (2)) 819 then return (1 - order_num); /* 0-asc 1-desc */ 820 end; 821 end; 822 else do; /* Keys: in 1st, out 2nd */ 823 if keys.order (i) 824 then return (1); /* Ascending => 2nd record first. */ 825 else return (0); /* Descending=> 1st record first. */ 826 end; 827 end; 828 else do; 829 if fn (2) > 0 /* key within 2nd record? */ 830 then do; /* Keys: out 1st, in 2nd */ 831 if keys.order (i) 832 then return (0); /* Ascending => 1st record first. */ 833 else return (1); /* Descending=> 2nd record first. */ 834 end; 835 else do; /* Keys: out 1st, out 2nd */ 836 end; /* Continue with next key */ 837 end; 838 end; 839 840 equal = "1"b; /* ALL keys equal. Return records in */ 841 /* input order. */ 842 if (abs (p1) < abs (p2)) 843 then return (0); 844 return (1); 845 846 dcl (p1, p2) parm fixed bin (21); 847 dcl (Fn, Ln, fn, ln) (2) fixed bin (21); 848 dcl (l, f, i, ii, r) fixed bin (21); 849 dcl nn bit (1); 850 dcl order_num fixed bin; 851 852 /* Procedure internal to Jcmp. */ 853 854 CC: proc (LHE1, RHE1, LHE2, RHE2) returns (fixed bin (21)); 855 856 dcl (LHE1, /* where 1st line begins */ 857 RHE1, /* where 1st line ends */ 858 LHE2, /* where 2nd line begins */ 859 RHE2 /* where 2nd line ends */ 860 ) fixed bin (21) parm; 861 862 /**** Compare "mapped" chars of the key fields left to right. If the mapped */ 863 /**** char equals octal 777 then skip it. */ 864 865 /* Calculate right key field bounds. */ 866 867 do while ((LHE1 < RHE1) & (LHE2 < RHE2)); 868 c1 = M (rank (input_c (LHE1))); 869 if c1 = octal777 870 then LHE1 = LHE1 + 1; 871 else do; 872 c2 = M (rank (input_c (LHE2))); 873 if c2 = octal777 874 then LHE2 = LHE2 + 1; 875 else do; 876 if c1 < c2 then return (0); 877 if c1 > c2 then return (1); 878 LHE1 = LHE1 + 1; 879 LHE2 = LHE2 + 1; 880 end; 881 end; 882 end; 883 do while (LHE1 < RHE1); 884 c1 = M (rank (input_c (LHE1))); 885 if c1 = octal777 886 then LHE1 = LHE1 + 1; 887 else return (1); /* record 1 is longer :: higher */ 888 end; 889 do while (LHE2 < RHE2); 890 c2 = M (rank (input_c (LHE2))); 891 if c2 = octal777 892 then LHE2 = LHE2 + 1; 893 else return (0); /* record 2 is longer :: higher */ 894 end; 895 return (2); /* All chars in key fields equal. */ 896 897 dcl (c1, c2) char (1) aligned; 898 end CC; 899 end Jcmp; 900 901 /* /* . . . TED_JCOMP_ . . */ 902 /**** <<<<----- dcl_tedsort_.incl.pl1 tedsort_$compare */ 903 compare: /* compare strings w/ spec collate */ 904 entry (p1, tp1, rcomp); 905 dcl ( 906 p1 ptr, /* points to seg containin/g strings */ 907 tp1 ptr, /* points to R array */ 908 rcomp bit (3) /* the 3 bits represent <=> */ 909 ) parm; /* ----->>>> */ 910 911 912 /* The caller has initialized the R array 913* R(1) R(2) defining the first field 914* R(3) R(4) defining the second one 915* Both fields are in the segment pointed to by p1 */ 916 917 dcl Jcomp fixed bin (21); 918 919 920 if Minit 921 then do; 922 reset = MASTER; 923 call set; 924 end; 925 Rp = tp1; 926 dcl Ip ptr; 927 Ip = p1; 928 nk = 1; 929 keys.order (1) = "1"b; 930 keys.loc1 (1) = 1; 931 keys.loc2 (1) = 0; 932 Jcomp = Jcmp (1, 3); 933 if equal 934 then rcomp = "010"b; 935 else if Jcomp = 0 936 then rcomp = "100"b; 937 else rcomp = "001"b; 938 return; 939 /* Declarations for Global Variables */ 940 941 dcl no_dupl bit (1); 942 dcl equal bit (1); 943 dcl eq_field bit (1); 944 dcl eq_loc fixed bin (21); 945 dcl eq_leng fixed bin (21); 946 dcl eq_n_n bit (1); 947 dcl reset char (256) var; 948 dcl spec_sw bit (1); 949 950 dcl octal777 char (1) static internal init ("ÿ"); /* Octal 777. */ 951 dcl rec_delim char (1); 952 /**** I char (Il) aligned based (Ip), */ 953 dcl O char (262000) aligned based (Op); 954 955 dcl 1 keys (1000) aligned, 956 2 order bit (1), /* 1- descending */ 957 2 n_n bit (1), /* 1- "n:n" form 0- "n,l" form */ 958 2 loc1 fixed bin (21), /* >=0 => M form <0 => $-M form */ 959 /* loc1 is keybegin-1 */ 960 2 loc2 fixed bin (21); /* n_n=0 => loc2 = actual length */ 961 /* n_n=1 => loc2 = keyend-1 */ 962 /* with M/$-M as above */ 963 dcl input_l fixed bin (21); 964 dcl input_p ptr; 965 dcl input_c (input_l) char (1) based (input_p); 966 dcl input char (input_l) based (input_p); 967 dcl input_i fixed bin (21); 968 dcl nk fixed bin (21); 969 dcl ff1 fixed bin (21); 970 dcl ff2 fixed bin (21); 971 dcl ll1 fixed bin (21); 972 dcl ll2 fixed bin (21); 973 dcl bb1 fixed bin (21); 974 dcl bb2 fixed bin (21); 975 dcl cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 976 dcl j fixed bin (21); 977 dcl ii fixed bin; 978 dcl i fixed bin (21); 979 dcl num_rec fixed bin (21); 980 dcl NS fixed bin (21); 981 dcl f fixed bin (21); 982 dcl l fixed bin (21); 983 984 dcl Op ptr; 985 dcl Rp ptr; 986 dcl Lp ptr; 987 dcl SLp ptr; 988 dcl Oe fixed bin (21); 989 990 dcl M1 char (1) aligned; 991 992 dcl 1 MB based (addr (M1)), 993 2 M11 bit (3), 994 2 M12 bit (3), 995 2 M13 bit (3); 996 997 dcl L char (256) var; 998 dcl ioa_ entry () options (variable); 999 dcl ioa_$ioa_switch entry () options (variable); 1000 dcl ioa_$ioa_switch_nnl entry () options (variable); 1001 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 1002 1003 dcl R (65536) fixed bin (21) based (Rp); 1004 dcl SL (0:65535) fixed bin (21) based (SLp); 1005 dcl spec_l fixed bin (21); 1006 dcl spec_p ptr; 1007 dcl spec_c (spec_l) char (1) based (spec_p); 1008 dcl spec char (spec_l) based (spec_p); 1009 dcl spec_i fixed bin (21); 1010 1011 dcl Minit bit (1) int static init ("1"b); 1012 dcl M (0:511) char (1) static internal; 1013 dcl MASTER char (42) int static 1014 init ("'000->'177'000->'177'200->'777'777a->zA->Z"); 1015 1016 dcl ( 1017 abs, addr, addrel, bin, byte, divide, fixed, index, length, max, min, 1018 mod, rank, substr, unspec, verify 1019 ) builtin; 1 1 /* BEGIN INCLUDE FILE ..... tedbase.incl.pl1 ..... 02/09/82 J Falksen */ 1 2 1 3 dcl NORMAL fixed bin (24) int static init (0), 1 4 SAFE fixed bin (24) int static init (1), 1 5 COM fixed bin (24) int static init (2), 1 6 RESTART fixed bin (24) int static init (3); 1 7 1 8 dcl rc_close fixed bin (24) int static init (100); 1 9 dcl rc_fail fixed bin (24) int static init (10); 1 10 dcl rc_nop fixed bin (24) int static init (2); 1 11 dcl rc_keyerr fixed bin (24) int static init (1); 1 12 1 13 /*** the request line as both string and character */ 1 14 dcl rl_b fixed bin (21); /* where current req begins */ 1 15 dcl rl_i fixed bin (21) defined (dbase.rl.l.le); 1 16 dcl rl_l fixed bin (21) defined (dbase.rl.l.re); 1 17 dcl rl_c (rl_l) char (1) based (dbase.rl.sp); 1 18 dcl rl_s char (rl_l) based (dbase.rl.sp); 1 19 1 20 dcl 1 seg_des based, /* segment descriptor */ 1 21 2 sp ptr, /* -> segment */ 1 22 2 sn fixed bin, /* sequence # in dbase */ 1 23 2 pn fixed bin, /* part #, if in pool */ 1 24 2 ast fixed bin, /* size of aste */ 1 25 2 mbz fixed bin; /* --reserved */ 1 26 1 27 1 28 1 29 dcl dbase_p ptr; 1 30 dcl dbase_vers_3 fixed bin int static init (3); 1 31 dcl 1 dbase based (dbase_p), 1 32 2 version fixed bin, 1 33 2 recurs fixed bin, /* recursion level at which active */ 1 34 2 bwd ptr, /* links active db's together */ 1 35 2 cba_p ptr, /* contains addr (cb (1)) */ 1 36 2 eval_p ptr, /* contains cb (2).sp */ 1 37 2 rl, /* describes the request buffer */ 1 38 3 part1 like seg_des, /* ..its segment */ 1 39 3 part2 like buf_des, /* ..its limits */ 1 40 2 seg_p (-1:72) ptr, /* list of segment pointers */ 1 41 /* seg_p(-1)is a temp for restart */ 1 42 /* seg_p(0) is the database */ 1 43 /* seg_p(1) is the 1K/4K pool */ 1 44 /* seg_p(2) is reserved for 16K pool */ 1 45 /* seg_p(3) is reserved for call_stk */ 1 46 2 inuse_seg bit (72) aligned, /* which segments (1:72) are in use */ 1 47 /* seg_p(0) is ALWAYS in use */ 1 48 2 inuse_1K bit (16) aligned, /* which 1K buffers are in use */ 1 49 2 inuse_4K bit (12) aligned, /* which 4K buffers are in use */ 1 50 2 inuse_16K bit (4) aligned, /* which 16K buffers are in use */ 1 51 2 reset label, /* where to go on a reset condition */ 1 52 2 time fixed bin (71), /* time request id is based on */ 1 53 2 seg_ct fixed bin, /* how many segments in use */ 1 54 /* seg_p (0)--database */ 1 55 /* seg_p (1)--4K pool (64K total) */ 1 56 /* seg_p (2)--16K pool (64K total) */ 1 57 2 argct fixed bin, /* how many args to ted */ 1 58 2 S_count fixed bin, /* # matches on last substitute */ 1 59 2 not_read_ct fixed bin, /* how many "not-read" files */ 1 60 2 at_break fixed bin, /* 1-break pending, 2-break entered */ 1 61 2 bufnum fixed bin, /* how many buffer control blocks */ 1 62 2 lock bit (36), /* to find if active (set LAST!) */ 1 63 2 cb_c_r bit (18) aligned, /* offset of current buffer */ 1 64 2 cb_w_r bit (18) aligned, /* offset of buffer being worked on */ 1 65 2 sws, 1 66 3 flow_sw bit (1) unal, /* -label specified */ 1 67 3 break_sw bit (1) unal, /* -break specified */ 1 68 3 edit_sw bit (1) unal, /* -trace_edit specified */ 1 69 3 input_sw bit (1) unal, /* -trace_input */ 1 70 3 old_style bit (1) unal, /* 1-old-style escapes allowed */ 1 71 3 remote_sw bit (1) unal, /* 1-not in home_dir */ 1 72 3 read_sw bit (1) unal, /* 1-always read files */ 1 73 3 lit_sw bit (1) unal, /* 1-expressions are literal */ 1 74 3 fill bit (28) unal, 1 75 2 tedname char (32) var, /* name under which ted_ was called */ 1 76 2 comment char (256)var, /* user ident of environment */ 1 77 2 err_msg char (168)var, 1 78 2 regexp char (500), /* holds the remembered regular expr */ 1 79 /* is placed here to get word */ 1 80 /* alignment */ 1 81 2 dir_db char (168), /* where work segments live */ 1 82 2 person char (22), /* who started */ 1 83 2 project char (9), /* ...this environment */ 1 84 2 nulreq char (2), /* what is null request (p|P|!p) */ 1 85 2 err_go char (16), /* label to go to on error */ 1 86 2 rq_id char (19), /* request id for this */ 1 87 2 stk_info, 1 88 3 curp ptr, /* pointer to current buffer */ 1 89 3 top ptr, /* pointer to top of stack */ 1 90 3 level fixed bin (21), /* recursion depth */ 1 91 3 next fixed bin (21); 1 92 /* next space available in stack */ 1 93 1 94 1 95 /* END INCLUDE FILE ..... tedbase.incl.pl1 ..... */ 1020 2 1 /* BEGIN INCLUDE FILE ..... tedcommon_.incl.pl1 ..... 02/15/82 J Falksen */ 2 2 2 3 /* ted common data area */ 2 4 2 5 dcl 1 tedcommon_$id ext static, 2 6 2 ted_vers char(12)var; /* version.revision */ 2 7 2 8 dcl 1 tedcommon_$no_data like buf_des ext static; 2 9 dcl 1 tedcommon_$no_seg like seg_des ext static; 2 10 2 11 dcl 1 tedcommon_$etc ext static, 2 12 2 com_blank bit(1)aligned, 2 13 2 com1_blank bit(1)aligned, 2 14 2 caps bit(1)aligned, 2 15 2 reset_read bit(1)aligned, 2 16 2 sws, 2 17 3 (db_ted, lg_ted) bit(1)aligned, 2 18 3 (db_addr, lg_addr) bit(1)aligned, 2 19 3 (db_eval, lg_eval) bit(1)aligned, 2 20 3 (db_sort, lg_sort) bit(1)aligned, 2 21 3 (db_gv, lg_gv) bit(1)aligned, 2 22 3 (db_util, lg_util) bit(1)aligned, 2 23 3 (db_srch, lg_srch) bit(1)aligned, 2 24 3 (db_glob, lg_glob) bit(1)aligned, 2 25 3 (db_trac, lg_sp4) bit(1)aligned, 2 26 3 (db_Ed, lg_sp3) bit(1)aligned, 2 27 3 (db_sp2, lg_sp2) bit(1)aligned, 2 28 3 (db_sp1, lg_sp1) bit(1)aligned, 2 29 3 (db_catch, lg_catch)bit(1)aligned, 2 30 2 db_output ptr; 2 31 2 32 /* END INCLUDE FILE ..... tedcommon_.incl.pl1 ..... */ 1021 3 1 /* BEGIN INCLUDE FILE ..... tedbcb.incl.pl1 ..... 01/29/82 J Falksen */ 3 2 3 3 /* UPDATE HISTORY (finally) */ 3 4 /* EL# date TR comments */ 3 5 /* --- 84-10-19 -------- add sws.INPUT */ 3 6 /* --- 84-10-29 -------- add sws.invoking */ 3 7 3 8 /* if the structure of buf_des changes, tedcommon_.alm and */ 3 9 /* tedcommon.incl.pl1 must be appropriately changed */ 3 10 3 11 dcl 1 buf_des (all_des) based (bp), /* buffer part descriptor */ 3 12 2 l, /* left end (LHE) data (see Note 1) */ 3 13 3 ln fixed bin (21), /* line number */ 3 14 3 le fixed bin (21), /* left end (LE) offset */ 3 15 3 re fixed bin (21), /* right end (RE) offset */ 3 16 2 r like buf_des.l; /* right end (RHE) data */ 3 17 3 18 /* Note1: buf_des describes 2 slightly different things, buffer parts and */ 3 19 /* addresses. These are the circumstances: */ 3 20 /* */ 3 21 /* */ 3 22 /* |.........................................| */ 3 23 /* b.cur.sp| |.....................| | */ 3 24 /* Buffer: xxxxxxxxxxwwwwwwwwwwwww......wwwwwwxxxxxxxxxx */ 3 25 /* | | | | | */ 3 26 /* b.b_.l.le| b.b_.l.re| b.b_.r.le| | maxl| */ 3 27 /* b.b_.l.ln| b.b_.r.le| maxln| */ 3 28 /* b.b_.r.ln| */ 3 29 /* b.b_.l.ln (if known) tells the # of lines in left part of window */ 3 30 /* b.b_.r.ln (if known) tells the # of lines the whole window */ 3 31 /* b.maxln (if known) tells the # of lines in the whole buffer */ 3 32 /* Either left or right part may be null. A ^read file */ 3 33 /* is in the right part. A file is always read at the */ 3 34 /* upper end of the hole. This will usually minimize the */ 3 35 /* amount of data movement during subsequent editing */ 3 36 /* operations. */ 3 37 /* */ 3 38 /* Data movement which occurs within a request, for example substitute, can */ 3 39 /* cause an offset to temporarily point into the hole. This will clear up */ 3 40 /* before the operation is complete. */ 3 41 3 42 /* N */ 3 43 /* Address: ....xxxxxxxxxxsssss -- sssssssxxxxxxxxxxL.... */ 3 44 /* | | | | */ 3 45 /* l.le| l.re| r.le| r.re| */ 3 46 /* l.ln| r.ln| */ 3 47 /* l.re is the beginning of the string addressed. */ 3 48 /* l.le is the beginning of line containing location l.re */ 3 49 /* Thus l.ln is related to both l.re and l.le */ 3 50 /* r.re is the end of the string addressed. */ 3 51 /* r.le is the end of line containing location r.re */ 3 52 /* Thus r.ln is related to both r.re and r.le */ 3 53 /* (l.le and r.le relate to the same line when 1 line is addressed) */ 3 54 /* In line mode each request starts with l.re=l.le & r.re=r.le */ 3 55 /* In string mode a global request forces these conditions. */ 3 56 3 57 /*** b_c/b_s reference the string which represents the buffer data. */ 3 58 dcl b_c (b.maxl) char (1) based (b.cur.sp); 3 59 dcl b_s char (b.maxl) based (b.cur.sp); 3 60 3 61 dcl (live_des init (8), 3 62 all_des init (13), 3 63 reloc_first init (2), /* where to begin minus 1 */ 3 64 reloc_last init (8) /* where to stop */ 3 65 ) fixed bin int static options (constant); 3 66 dcl bp ptr; 3 67 dcl 1 b based (bp), /* ted buffer control block */ 3 68 2 b_ like buf_des, /* defines buffer limits */ 3 69 2 newb like buf_des, /* pending buffer values */ 3 70 2 ex like buf_des, /* execution limits */ 3 71 2 a_ (0:2) like buf_des, /* address data */ 3 72 /* (0) "cur location" */ 3 73 /* (1) 1st addr result */ 3 74 /* (2) 2nd addr result */ 3 75 2 cd like buf_des, /* copy destination */ 3 76 2 gb like buf_des, /* info for global processing */ 3 77 2 newa like buf_des, /* pending address values */ 3 78 /* ----limit of relocation---- */ 3 79 /* these are not relocated because they define the relocation data */ 3 80 2 rel_temp like buf_des, /* hold during relocation */ 3 81 2 temp (0:2) like buf_des, /* hold during [.]addr processing */ 3 82 2 old, /* where string used to be */ 3 83 3 (le,re) fixed bin (21), /* ends of range */ 3 84 2 new like b.old, /* where string has gone to */ 3 85 2 test like b.old, /* allowable relocatable range */ 3 86 /* (may be 1 or 2 larger than b.old) */ 3 87 2 cur like seg_des, /* CURRENT buffer area info */ 3 88 /* (see note 2) */ 3 89 2 pend like seg_des, /* PENDING buffer area info */ 3 90 2 file_d, /* file related data */ 3 91 3 dtcm bit(36), /* when read seg was modified */ 3 92 3 uid bit(36), /* unique ID of segment */ 3 93 3 dname char(168), /* directory of file */ 3 94 3 ename char(32), /* entry of file */ 3 95 3 cname char(32), /* component of file */ 3 96 3 kind char(1)unal, /* kind of component */ 3 97 /* " "-none, ":"-archive */ 3 98 /* "|"-superfile */ 3 99 3 sws unal, 3 100 4 file_sw bit(1), /* 1-file associated */ 3 101 4 trust_sw bit(1), /* 1-file name trustable */ 3 102 4 mod_sw bit(1), /* 1-buffer has been modified */ 3 103 4 terminate bit(1), /* 1-dp points to file, terminate */ 3 104 4 get_bit_count bit(1), /* 1-get_bit_count before using this */ 3 105 /* buffer, it may have been modified by */ 3 106 /* externally via [ted$buffer xx] usage */ 3 107 4 force_name bit(1), /* 1-name has been forced */ 3 108 4 no_io bit(1), /* 1-no r w ^b allowed */ 3 109 /* (external string edit) */ 3 110 4 not_pasted bit(1), /* 1-data was moved into buffer but */ 3 111 /* has not been read anywhere */ 3 112 4 initiate bit(1), /* 1-must initiate on restart */ 3 113 /* (b% and b!) */ 3 114 4 ck_ptr_sw bit(1), /* 1-if segment is external, must */ 3 115 /* check pointer before ref */ 3 116 4 pseudo bit (1), /* 1-^read or read-only buffer */ 3 117 4 INPUT bit (1), /* 1-active INPUT mode on buffer */ 3 118 4 invoking bit (1), /* 1-buffer being invoked */ 3 119 4 fill bit (14), 3 120 2 name char(16), /* buffer name */ 3 121 2 fill char(27), 3 122 2 stackl bit (18)aligned, /* offset of list of stacked data */ 3 123 2 stack_o bit (18)aligned, /* offset of data being relocated */ 3 124 2 present (0:2) bit(1), /* 1 if addr present */ 3 125 2 tw_sw bit(1), /* 1-typewriter buffer */ 3 126 2 bs, /* Old-style escapes in this buffer */ 3 127 3 (c,b,r,f) bit(1), /* 1-\031,\030,\036,\034 found */ 3 128 2 noref bit(1), /* 1-not ref'ed, don't list */ 3 129 2 maxl fixed bin(21), /* max buffer length in this AST */ 3 130 2 maxln fixed bin(21), /* number of lines in buffer */ 3 131 2 state_r fixed bin(21), /* what state is request in */ 3 132 2 (N1,N2,N3) fixed bin(21), /* values kept for -safe_ty */ 3 133 2 state_b fixed bin(21); /* what state is buffer change in */ 3 134 3 135 /* Note2: sn=0 means empty because the database segment will never */ 3 136 /* contain a buffer holder */ 3 137 /* sn=-1 (&^b.terminate) means read-only data, if modification is */ 3 138 /* done, a copy will be made. */ 3 139 /* sn=-1 (& b.terminate) means ^read file, if modification is done */ 3 140 /* the file is read first */ 3 141 /* sn>0 means a buffer holder segment */ 3 142 3 143 /* END INCLUDE FILE ..... tedbcb.incl.pl1 ..... */ 1022 1023 1024 end tedsort_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/07/88 1305.3 tedsort_.pl1 >spec>install>1146>tedsort_.pl1 1020 1 11/23/82 1324.7 tedbase.incl.pl1 >ldd>include>tedbase.incl.pl1 1021 2 12/18/84 0954.3 tedcommon_.incl.pl1 >ldd>include>tedcommon_.incl.pl1 1022 3 12/18/84 0954.3 tedbcb.incl.pl1 >ldd>include>tedbcb.incl.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. Fn 010444 automatic fixed bin(21,0) array dcl 847 set ref 749* 750* 753* 753* 769 771 780 784 Ip 000104 automatic pointer dcl 926 set ref 927* Jcomp 000102 automatic fixed bin(21,0) dcl 917 set ref 932* 935 L 010114 automatic varying char(256) dcl 997 set ref 190 191* 199* 199 200* 200 201* 201 202* 202 204* 204 205 207* 208* 212 212* 214 214 214* 214 217* 227 LHE1 parameter fixed bin(21,0) dcl 856 set ref 854 867 868 869* 869 878* 878 883 884 885* 885 LHE2 parameter fixed bin(21,0) dcl 856 set ref 854 867 872 873* 873 879* 879 889 890 891* 891 Ln 010446 automatic fixed bin(21,0) array dcl 847 set ref 751* 752* 753* 753* 767 771 778 783 Lp 010106 automatic pointer dcl 986 set ref 190* 227* M 000011 internal static char(1) array packed unaligned dcl 1012 set ref 194 257* 868 872 884 890 M1 010113 automatic char(1) dcl 990 set ref 196* 197 197 200 201 202 204 M11 based bit(3) level 2 packed packed unaligned dcl 992 ref 200 M12 0(03) based bit(3) level 2 packed packed unaligned dcl 992 ref 201 M13 0(06) based bit(3) level 2 packed packed unaligned dcl 992 ref 202 MASTER 000000 constant char(42) initial packed unaligned dcl 1013 ref 118 187 230 922 MB based structure level 1 packed packed unaligned dcl 992 Minit 000010 internal static bit(1) initial packed unaligned dcl 1011 set ref 115 184 240* 920 NS 010076 automatic fixed bin(21,0) dcl 980 set ref 242* 243* 260* 302 304 306* 306 325 327 329 330* 330 334* 334 335 337 339 341* 341 O based char(262000) dcl 953 set ref 659* 660* 663* 666* OC 000014 constant char(1) initial array packed unaligned dcl 352 ref 200 201 202 Oe 010112 automatic fixed bin(21,0) dcl 988 set ref 163* 167 659 660 663 666 669* 669 Op 010102 automatic pointer dcl 984 set ref 162* 659 660 663 666 R based fixed bin(21,0) array dcl 1003 set ref 133* 150* 628 629 749 750 751 752 RHE1 parameter fixed bin(21,0) dcl 856 ref 854 867 883 RHE2 parameter fixed bin(21,0) dcl 856 ref 854 867 889 Rp 010104 automatic pointer dcl 985 set ref 132* 133 150 628 629 749 750 751 752 925* SL based fixed bin(21,0) array dcl 1004 set ref 578* 585* 596 597 600* 611 612 627 672* 680 681 683* 715* 715* 721* SLp 010110 automatic pointer dcl 987 set ref 160* 578 585 596 597 600 611 612 627 672 680 681 683 715 715 721 ab parameter fixed bin(21,0) dcl 293 set ref 290 301* 312* 314* abs builtin function dcl 1016 ref 247 247 627 627 671 674 715 715 749 750 751 752 842 842 accum 010340 automatic picture(12) packed unaligned dcl 661 set ref 662* 663 adata_l parameter fixed bin(21,0) dcl 39 ref 37 135 adata_p parameter pointer dcl 39 ref 37 136 addr builtin function dcl 1016 ref 190 196 200 201 202 227 addrel builtin function dcl 1016 ref 190 227 af parameter fixed bin(21,0) dcl 293 set ref 290 298* 300 312 ain_l parameter fixed bin(21,0) dcl 39 set ref 37 126 170* ain_p parameter pointer dcl 39 ref 37 124 al parameter fixed bin(21,0) dcl 293 set ref 290 300* 307* 312 b based structure level 1 unaligned dcl 3-67 b1 parameter fixed bin(21,0) dcl 270 set ref 267 278* 281* b2 parameter fixed bin(21,0) dcl 270 set ref 267 279* 281* bb1 010070 automatic fixed bin(21,0) dcl 973 set ref 246* 256 bb2 010071 automatic fixed bin(21,0) dcl 974 set ref 246* 253* 258 bin builtin function dcl 1016 ref 340 buf_des based structure array level 1 unaligned dcl 3-11 byte builtin function dcl 1016 ref 257 378 c1 010472 automatic char(1) dcl 897 set ref 868* 869 876 877 884* 885 c2 010473 automatic char(1) dcl 897 set ref 872* 873 876 877 890* 891 ch 010275 automatic char(1) packed unaligned dcl 466 in procedure "get_keys" set ref 392* 394 402 ch 010314 automatic char(1) packed unaligned dcl 515 in procedure "get_single" set ref 516* 526* 533 count 010347 automatic fixed bin(21,0) dcl 694 set ref 608* 617* 617 621* 630* 662 668* cu_$arg_count 000222 constant entry external dcl 1001 ref 229 cv_oct_check_ 000212 constant entry external dcl 975 ref 371 db_output 36 000224 external static pointer level 2 dcl 2-11 set ref 243* 260* 281* 590* 601* 621* 630* 753* 762* 786* 809* db_sort 12 000224 external static bit(1) level 3 dcl 2-11 ref 243 260 281 590 601 621 630 753 762 786 divide builtin function dcl 1016 ref 579 679 eq_field 000110 automatic bit(1) packed unaligned dcl 943 set ref 122* 421* 632 eq_leng 000112 automatic fixed bin(21,0) dcl 945 set ref 423* 429 429 646 646 648 651 eq_loc 000111 automatic fixed bin(21,0) dcl 944 set ref 422* 429 634 637 eq_n_n 000113 automatic bit(1) packed unaligned dcl 946 set ref 424* 429 429 644 equal 000107 automatic bit(1) packed unaligned dcl 942 set ref 719 748* 840* 933 f 010077 automatic fixed bin(21,0) dcl 981 in procedure "tedsort_" set ref 628* 629 659 666 f 010455 automatic fixed bin(21,0) dcl 848 in procedure "Jcmp" set ref 759* 762* 767 770 f1 parameter fixed bin(21,0) dcl 270 set ref 267 278* 281* f2 parameter fixed bin(21,0) dcl 270 set ref 267 279* 281* ff1 010064 automatic fixed bin(21,0) dcl 969 set ref 246* 247 256 ff2 010065 automatic fixed bin(21,0) dcl 970 set ref 246* 247 247 253 255 fixed builtin function dcl 1016 ref 200 201 202 329 547 808 fn 010450 automatic fixed bin(21,0) array dcl 847 set ref 767* 769* 770* 770 771 771 773* 782 786* 791 793 800* 800* 806 807 809 809 809 809 814 814 817 817 829 got_pair 010276 automatic bit(1) packed unaligned dcl 467 set ref 400* 417* 421 427 436* 440 i 010074 automatic fixed bin(21,0) dcl 978 in procedure "tedsort_" set ref 192* 194* 256* 257* i 010324 automatic fixed bin(17,0) dcl 555 in procedure "num" set ref 543* 544 544* 546* 546 547 548 i 010356 automatic fixed bin(21,0) dcl 701 in procedure "SORT" set ref 584* 585 585* 589* 590* 592 593* 610* 613* i 010456 automatic fixed bin(21,0) dcl 848 in procedure "Jcmp" set ref 757* 759 760 761 762* 762 797 808 823 831* i1 000101 automatic fixed bin(35,0) dcl 354 set ref 371* 372 374 ii 010457 automatic fixed bin(21,0) dcl 848 in procedure "Jcmp" set ref 766* 767 767 769 769 770 770 771 771 771 771 773 773 778 778 780 780 782 782 783 783 783 784 784 784 786 786 786* ii 010073 automatic fixed bin(17,0) dcl 977 in procedure "tedsort_" set ref 229* 231 ilen 010336 automatic fixed bin(21,0) dcl 626 set ref 629* 634 641 659 666 index builtin function dcl 1016 ref 140 402 input based char packed unaligned dcl 966 ref 140 659 666 809 809 809 809 814 814 817 817 input_c based char(1) array packed unaligned dcl 965 ref 868 872 884 890 input_i 010062 automatic fixed bin(21,0) dcl 967 set ref 134* 138 140 141 143* 143 148* 150 input_l 010057 automatic fixed bin(21,0) dcl 963 set ref 135* 138 140 141 148 659 666 809 809 809 809 814 814 817 817 input_p 010060 automatic pointer dcl 964 set ref 136* 140 659 666 809 809 809 809 814 814 817 817 868 872 884 890 ioa_ 000214 constant entry external dcl 998 ref 207 217 ioa_$ioa_switch 000216 constant entry external dcl 999 ref 243 260 281 809 ioa_$ioa_switch_nnl 000220 constant entry external dcl 1000 ref 590 601 621 630 753 762 786 j 010352 automatic fixed bin(21,0) dcl 697 in procedure "SORT" set ref 594* 595* 673* 675 683* j parameter fixed bin(21,0) dcl 323 in procedure "K" set ref 321 329* 340* j 010072 automatic fixed bin(21,0) dcl 976 in procedure "tedsort_" set ref 140* 141 141* 143 255* 257 258* 258 j 010264 automatic fixed bin(21,0) dcl 357 in procedure "get_delim" set ref 371* 378 jchar based char(4) packed unaligned dcl 181 ref 196 jnum 000100 automatic fixed bin(21,0) dcl 181 set ref 193* 194 196* key_type 010274 automatic fixed bin(17,0) dcl 401 set ref 402* 403 403* 403 405 419 438 keys 000217 automatic structure array level 1 dcl 955 l 6 based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedsort_" l 16 based structure level 4 in structure "dbase" unaligned dcl 1-31 in procedure "tedsort_" l 52 based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedsort_" l 60 based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedsort_" l 22 based structure array level 3 in structure "b" unaligned dcl 3-67 in procedure "tedsort_" l based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedsort_" l 010454 automatic fixed bin(21,0) dcl 848 in procedure "Jcmp" set ref 760* 762* 778 783 l 010350 automatic fixed bin(21,0) dcl 695 in procedure "SORT" set ref 572* 573 575 575* 575 577 579* 579 627* 628 629 l 010100 automatic fixed bin(21,0) dcl 982 in procedure "tedsort_" set ref 241* 243* 260* 302 325 335 l 66 based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedsort_" l 14 based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedsort_" l based structure array level 2 in structure "buf_des" unaligned dcl 3-11 in procedure "tedsort_" l 74 based structure array level 3 in structure "b" unaligned dcl 3-67 in procedure "tedsort_" l internal static structure level 2 in structure "tedcommon_$no_data" unaligned dcl 2-8 in procedure "tedsort_" l 44 based structure level 3 in structure "b" unaligned dcl 3-67 in procedure "tedsort_" l1 parameter fixed bin(21,0) dcl 270 set ref 267 278* 281* l2 parameter fixed bin(21,0) dcl 270 set ref 267 279* 281* length builtin function dcl 1016 ref 205 214 241 lft 010354 automatic fixed bin(21,0) dcl 699 set ref 592* 594 595 675* 680 681 ll1 010066 automatic fixed bin(21,0) dcl 971 set ref 246* 247 256 ll2 010067 automatic fixed bin(21,0) dcl 972 set ref 246* 247 247 253 ln 010452 automatic fixed bin(21,0) array dcl 847 set ref 773* 778* 780* 782* 783* 783 784* 784 786* 800 800 806* 806 807* 807 809* 809 809 809* 809 809 814 814 817 817 loc1 2 000217 automatic fixed bin(21,0) array level 2 dcl 955 set ref 416* 422 442* 461* 759 930* loc2 3 000217 automatic fixed bin(21,0) array level 2 dcl 955 set ref 416* 423 444* 463* 760 931* max builtin function dcl 1016 ref 129 784 min builtin function dcl 1016 ref 783 mod builtin function dcl 1016 ref 575 676 msg parameter varying char(168) dcl 39 set ref 37 250* 286* 309* 375* 408* 432* 451* 477* 490* 503* 530* n 010344 automatic fixed bin(21,0) dcl 691 set ref 573* 574* 581* 581 589 609 673 n_n 1 000217 automatic bit(1) array level 2 in structure "keys" dcl 955 in procedure "tedsort_" set ref 416* 424 443* 462* 761 n_n parameter bit(1) dcl 470 in procedure "get_pair" set ref 468 482* 493* 498* nk 010063 automatic fixed bin(21,0) dcl 968 set ref 129* 129 387* 390* 390 391 396* 396 416 416 416 422 423 424 425* 425 438 442 443 444 457 459* 757 928* nn 010461 automatic bit(1) packed unaligned dcl 849 set ref 761* 762* 776 no_dupl 000106 automatic bit(1) packed unaligned dcl 941 set ref 123* 426* 619 632 num_rec 010075 automatic fixed bin(21,0) dcl 979 set ref 137* 144* 144 145 147* 150 154* 154 155 572 584 610 613 octal777 constant char(1) initial packed unaligned dcl 950 ref 869 873 885 891 octals 010254 automatic bit(3) array packed unaligned dcl 348 set ref 339* 340 340 340 old 116 based structure level 2 unaligned dcl 3-67 olen 010337 automatic fixed bin(21,0) dcl 626 set ref 629* 641* 646 646* 652 652* 659 660 666 669 order 000217 automatic bit(1) array level 2 dcl 955 set ref 391* 438* 460* 762* 797 808 823 831 929* order_num 010462 automatic fixed bin(17,0) dcl 850 set ref 797* 799* 800 800 800 800 808* 814 817 out_l parameter fixed bin(21,0) dcl 39 set ref 37 167* p1 parameter pointer dcl 905 in procedure "tedsort_" ref 903 927 p1 parameter fixed bin(21,0) dcl 846 in procedure "Jcmp" set ref 729 749 751 753* 842 p2 parameter fixed bin(21,0) dcl 846 set ref 729 750 752 753* 842 r 010460 automatic fixed bin(21,0) dcl 848 set ref 800* 802 802 rank builtin function dcl 1016 ref 194 868 872 884 890 rc parameter fixed bin(35,0) dcl 39 set ref 37 121* 157* 168* 172* 550* rcomp parameter bit(3) packed unaligned dcl 905 set ref 903 933* 935* 937* rec_delim 000216 automatic char(1) packed unaligned dcl 951 set ref 140 359* 378* 660 reset 000114 automatic varying char(256) dcl 947 set ref 118* 187* 230* 231* 231 241 304 327 329 337 339 922* rit 010355 automatic fixed bin(21,0) dcl 700 set ref 593* 594 599* 599 600 601* s 010357 automatic fixed bin(21,0) array dcl 703 set ref 574* 592 593 609 675 683 seg_des based structure level 1 unaligned dcl 1-20 setting parameter char packed unaligned dcl 222 ref 220 231 spec based char packed unaligned dcl 1008 ref 371 371 543 547 spec_c based char(1) array packed unaligned dcl 1007 ref 364 369 380 392 413 448 480 485 488 494 517 523 spec_i 010220 automatic fixed bin(21,0) dcl 1009 set ref 125* 170 363* 364 367* 367 369 371 371 374* 374 379* 379 380 380* 380 389 392 393* 393 406* 406 407 413 413 446 448 448* 448 480 483* 483 485 487* 487 488 494 496* 496 517 520* 520 521 523 525* 525 543 544 547 548* 548 spec_l 010215 automatic fixed bin(21,0) dcl 1005 set ref 126* 361 371 371 389 407 413 446 521 543 544 547 spec_p 010216 automatic pointer dcl 1006 set ref 124* 364 369 371 371 380 392 413 448 480 485 488 494 517 523 543 547 spec_sw 000215 automatic bit(1) packed unaligned dcl 948 set ref 123* 366* 397* 753* 795 substr builtin function dcl 1016 set ref 140 196 214 304 327 329 337 339 371 371 543 547 659* 659 660* 663* 663 666* 666 809 809 809 809 814 814 817 817 sws 4 000224 external static structure level 2 unaligned dcl 2-11 t 010343 automatic fixed bin(21,0) dcl 690 set ref 571* 574 577* 577 578 tedcommon_$etc 000224 external static structure level 1 unaligned dcl 2-11 temp_p parameter pointer array dcl 39 ref 37 132 160 162 tlen 010335 automatic fixed bin(21,0) dcl 625 set ref 648* 651* 652 652 663 663 663 tloc 010334 automatic fixed bin(21,0) dcl 625 set ref 634* 636* 637* 637 638 641 642* 648 652 652 663 tp1 parameter pointer dcl 905 ref 903 925 unspec builtin function dcl 1016 set ref 329 339* 339 v parameter fixed bin(21,0) dcl 514 in procedure "get_single" set ref 512 519* 528* 533* 533 v parameter fixed bin(21,0) dcl 541 in procedure "num" set ref 539 547* 549 v1 parameter fixed bin(21,0) dcl 470 in procedure "get_pair" set ref 468 475* v1 010345 automatic fixed bin(21,0) dcl 692 in procedure "SORT" set ref 596* 600 601* 611* 613 617 619 621* 627 630* 671* 671 672 674* 674 676 676 678 679 680* 680 683 684* 710 710* 715 715* 719 721 721 722* 722 v2 010346 automatic fixed bin(21,0) dcl 693 in procedure "SORT" set ref 597* 612* 613 676* 678* 681* 681 710 713 715 715 v2 parameter fixed bin(21,0) dcl 470 in procedure "get_pair" set ref 468 497* 506* verify builtin function dcl 1016 ref 337 543 x 010351 automatic fixed bin(21,0) dcl 696 set ref 595* 596 597 679* 683 684 y 010353 automatic fixed bin(21,0) dcl 698 set ref 609* 611 612 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. COM internal static fixed bin(24,0) initial dcl 1-3 NORMAL internal static fixed bin(24,0) initial dcl 1-3 RESTART internal static fixed bin(24,0) initial dcl 1-3 SAFE internal static fixed bin(24,0) initial dcl 1-3 all_des internal static fixed bin(17,0) initial dcl 3-61 b_c based char(1) array packed unaligned dcl 3-58 b_s based char packed unaligned dcl 3-59 bp automatic pointer dcl 3-66 dbase based structure level 1 unaligned dcl 1-31 dbase_p automatic pointer dcl 1-29 dbase_vers_3 internal static fixed bin(17,0) initial dcl 1-30 live_des internal static fixed bin(17,0) initial dcl 3-61 rc_close internal static fixed bin(24,0) initial dcl 1-8 rc_fail internal static fixed bin(24,0) initial dcl 1-9 rc_keyerr internal static fixed bin(24,0) initial dcl 1-11 rc_nop internal static fixed bin(24,0) initial dcl 1-10 reloc_first internal static fixed bin(17,0) initial dcl 3-61 reloc_last internal static fixed bin(17,0) initial dcl 3-61 rl_b automatic fixed bin(21,0) dcl 1-14 rl_c based char(1) array packed unaligned dcl 1-17 rl_i defined fixed bin(21,0) dcl 1-15 rl_l defined fixed bin(21,0) dcl 1-16 rl_s based char packed unaligned dcl 1-18 tedcommon_$id external static structure level 1 unaligned dcl 2-5 tedcommon_$no_data external static structure level 1 unaligned dcl 2-8 tedcommon_$no_seg external static structure level 1 unaligned dcl 2-9 NAMES DECLARED BY EXPLICIT CONTEXT. CC 004205 constant entry internal dcl 854 ref 800 COMPARE 003305 constant entry internal dcl 708 ref 598 616 682 Jcmp 003360 constant entry internal dcl 729 ref 715 932 K 001472 constant entry internal dcl 321 ref 298 307 NK 001370 constant entry internal dcl 290 ref 278 279 SORT 002473 constant entry internal dcl 558 ref 165 compare 000751 constant entry external dcl 903 get_delim 001577 constant entry internal dcl 355 ref 127 get_keys 001705 constant entry internal dcl 385 ref 128 get_pair 002150 constant entry internal dcl 468 ref 416 get_single 002273 constant entry internal dcl 512 ref 475 506 key_error 000432 constant label dcl 170 ref 376 409 433 452 478 491 504 506 no_value 001565 constant label dcl 344 ref 325 335 num 002377 constant entry internal dcl 539 ref 528 pair 001232 constant entry internal dcl 267 ref 246 set 000665 constant entry external dcl 220 set 001037 constant entry internal dcl 238 in procedure "tedsort_" ref 119 188 233 923 set_error 000744 constant label dcl 236 ref 251 287 310 show 000441 constant entry external dcl 175 show 000446 constant label dcl 184 in procedure "tedsort_" start 000262 constant label dcl 115 tedsort_ 000255 constant entry external dcl 37 value_present 001572 constant label dcl 346 in procedure "K" ref 331 342 value_present 001465 constant label dcl 317 in procedure "NK" THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5132 5360 5021 5142 Length 5622 5021 226 225 111 202 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME tedsort_ 4863 external procedure is an external procedure. set internal procedure shares stack frame of external procedure tedsort_. pair internal procedure shares stack frame of external procedure tedsort_. NK internal procedure shares stack frame of external procedure tedsort_. K internal procedure shares stack frame of external procedure tedsort_. get_delim internal procedure shares stack frame of external procedure tedsort_. get_keys internal procedure shares stack frame of external procedure tedsort_. get_pair internal procedure shares stack frame of external procedure tedsort_. get_single internal procedure shares stack frame of external procedure tedsort_. num internal procedure shares stack frame of external procedure tedsort_. SORT internal procedure shares stack frame of external procedure tedsort_. COMPARE internal procedure shares stack frame of external procedure tedsort_. Jcmp internal procedure shares stack frame of external procedure tedsort_. CC internal procedure shares stack frame of external procedure tedsort_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 Minit tedsort_ 000011 M tedsort_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME tedsort_ 000100 jnum tedsort_ 000101 i1 tedsort_ 000102 Jcomp tedsort_ 000104 Ip tedsort_ 000106 no_dupl tedsort_ 000107 equal tedsort_ 000110 eq_field tedsort_ 000111 eq_loc tedsort_ 000112 eq_leng tedsort_ 000113 eq_n_n tedsort_ 000114 reset tedsort_ 000215 spec_sw tedsort_ 000216 rec_delim tedsort_ 000217 keys tedsort_ 010057 input_l tedsort_ 010060 input_p tedsort_ 010062 input_i tedsort_ 010063 nk tedsort_ 010064 ff1 tedsort_ 010065 ff2 tedsort_ 010066 ll1 tedsort_ 010067 ll2 tedsort_ 010070 bb1 tedsort_ 010071 bb2 tedsort_ 010072 j tedsort_ 010073 ii tedsort_ 010074 i tedsort_ 010075 num_rec tedsort_ 010076 NS tedsort_ 010077 f tedsort_ 010100 l tedsort_ 010102 Op tedsort_ 010104 Rp tedsort_ 010106 Lp tedsort_ 010110 SLp tedsort_ 010112 Oe tedsort_ 010113 M1 tedsort_ 010114 L tedsort_ 010215 spec_l tedsort_ 010216 spec_p tedsort_ 010220 spec_i tedsort_ 010254 octals K 010264 j get_delim 010274 key_type get_keys 010275 ch get_keys 010276 got_pair get_keys 010314 ch get_single 010324 i num 010334 tloc SORT 010335 tlen SORT 010336 ilen SORT 010337 olen SORT 010340 accum SORT 010343 t SORT 010344 n SORT 010345 v1 SORT 010346 v2 SORT 010347 count SORT 010350 l SORT 010351 x SORT 010352 j SORT 010353 y SORT 010354 lft SORT 010355 rit SORT 010356 i SORT 010357 s SORT 010444 Fn Jcmp 010446 Ln Jcmp 010450 fn Jcmp 010452 ln Jcmp 010454 l Jcmp 010455 f Jcmp 010456 i Jcmp 010457 ii Jcmp 010460 r Jcmp 010461 nn Jcmp 010462 order_num Jcmp 010472 c1 CC 010473 c2 CC THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp call_ext_out_desc call_ext_out return_mac mdfx1 shorten_stack ext_entry ext_entry_desc any_to_any_truncate_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cu_$arg_count cv_oct_check_ ioa_ ioa_$ioa_switch ioa_$ioa_switch_nnl THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. tedcommon_$etc LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 37 000246 115 000262 118 000264 119 000271 121 000272 122 000274 123 000275 124 000277 125 000302 126 000304 127 000306 128 000307 129 000310 132 000315 133 000321 134 000323 135 000324 136 000326 137 000331 138 000333 140 000337 141 000356 143 000364 144 000365 145 000366 147 000371 148 000373 149 000376 150 000377 151 000403 154 000404 155 000406 157 000411 158 000414 160 000415 162 000421 163 000423 165 000424 167 000425 168 000430 169 000431 170 000432 172 000435 173 000437 175 000440 184 000446 187 000451 188 000456 190 000457 191 000463 192 000467 193 000474 194 000501 196 000510 197 000513 199 000520 200 000527 201 000542 202 000556 203 000572 204 000573 205 000602 207 000605 208 000615 211 000621 212 000623 214 000632 216 000646 217 000650 218 000661 220 000662 227 000700 229 000704 230 000717 231 000724 233 000742 234 000743 236 000744 903 000745 920 000756 922 000761 923 000766 925 000767 927 000773 928 000776 929 001000 930 001002 931 001003 932 001004 933 001011 935 001021 937 001031 938 001036 238 001037 240 001040 241 001042 242 001044 243 001046 246 001076 247 001103 250 001123 251 001132 253 001133 255 001137 256 001141 257 001162 258 001172 259 001174 260 001177 263 001230 264 001231 267 001232 278 001234 278 001254 279 001262 281 001302 284 001352 286 001360 287 001367 290 001370 298 001372 300 001413 301 001416 302 001420 304 001423 306 001427 307 001431 309 001444 310 001453 312 001454 314 001463 317 001465 321 001472 325 001474 327 001477 329 001503 330 001512 331 001513 334 001514 335 001515 337 001521 339 001534 340 001541 341 001562 342 001564 344 001565 346 001572 355 001577 359 001600 361 001602 363 001605 364 001607 366 001614 367 001616 369 001617 371 001624 372 001652 374 001654 375 001660 376 001667 378 001670 379 001673 380 001675 384 001704 385 001705 387 001706 389 001707 390 001713 391 001714 392 001720 393 001726 394 001727 396 001733 397 001735 398 001737 400 001740 402 001741 403 001752 405 001756 406 001760 407 001762 408 001765 409 001774 413 001775 416 002004 417 002017 419 002021 421 002024 422 002026 423 002033 424 002035 425 002040 426 002042 427 002044 429 002046 432 002061 433 002070 436 002071 437 002073 438 002074 440 002101 442 002103 443 002110 444 002112 446 002113 448 002116 451 002125 452 002134 456 002135 457 002136 459 002140 460 002142 461 002144 462 002145 463 002146 538 002147 468 002150 475 002152 477 002165 478 002174 480 002175 482 002205 483 002210 484 002211 485 002212 487 002214 488 002215 490 002224 491 002233 493 002234 494 002236 496 002240 497 002241 498 002242 499 002244 501 002245 503 002246 504 002255 506 002256 509 002272 512 002273 516 002275 517 002277 519 002305 520 002306 521 002307 523 002317 525 002330 526 002331 528 002333 530 002346 531 002355 533 002363 535 002371 539 002377 543 002401 544 002422 546 002430 547 002432 548 002451 549 002453 550 002456 551 002461 553 002466 558 002473 571 002474 572 002475 573 002477 574 002505 575 002510 577 002516 578 002520 579 002522 580 002524 581 002526 584 002530 585 002537 586 002540 589 002542 590 002551 592 002601 593 002604 594 002606 595 002615 596 002617 597 002621 598 002625 599 002626 600 002627 601 002632 603 002665 604 002670 608 002672 609 002674 610 002700 611 002707 612 002712 613 002715 616 002724 617 002725 619 002730 621 002734 623 002767 627 002770 628 003001 629 003004 630 003011 632 003044 634 003050 636 003056 637 003060 638 003063 641 003065 642 003070 644 003072 646 003074 648 003103 649 003107 651 003110 652 003112 659 003120 660 003141 662 003146 663 003155 665 003166 666 003167 668 003205 669 003207 671 003211 672 003216 673 003217 674 003227 675 003234 676 003237 678 003250 679 003253 680 003257 681 003263 682 003267 683 003270 684 003276 685 003300 687 003302 728 003304 708 003305 710 003306 713 003313 715 003315 719 003346 721 003352 722 003355 727 003357 729 003360 748 003362 749 003363 750 003373 751 003402 752 003405 753 003410 757 003465 759 003475 760 003501 761 003503 762 003506 766 003553 767 003561 769 003570 770 003573 771 003577 773 003603 774 003605 776 003606 778 003611 780 003617 781 003621 782 003622 783 003623 784 003635 786 003643 790 003706 791 003710 793 003712 795 003714 797 003717 799 003727 800 003731 802 003761 804 003767 806 003770 807 003774 808 004000 809 004005 814 004071 817 004116 821 004124 823 004125 825 004136 827 004141 829 004142 831 004144 833 004154 838 004160 840 004162 842 004164 844 004202 854 004205 867 004207 868 004217 869 004232 872 004237 873 004250 876 004255 877 004262 878 004266 879 004267 882 004270 883 004271 884 004276 885 004310 887 004315 888 004320 889 004321 890 004326 891 004340 893 004345 894 004347 895 004350 ----------------------------------------------------------- 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