COMPILATION LISTING OF SEGMENT sort_seg_ Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 10/24/88 1538.2 mst Mon Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 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 /****^ HISTORY COMMENTS: 14* 1) change(74-01-01,Klinger), approve(), audit(), install(): 15* Written 1974 by Ross Klinger. 16* 2) change(75-08-16,Grady), approve(), audit(), install(): 17* Modified by Mike Grady to process -ordered_fields. 18* 3) change(82-05-05,GDixon), approve(), audit(), install(): 19* Modified by Gary Dixon to greatly extend and document the 20* interface. 21* 4) change(83-04-17,Schimke), approve(), audit(), install(): 22* Modified by Dave Schimke to add linus_table entrypoint 23* reorganizing the code into several internal procedures and 24* add numeric sort mode. 25* 5) change(83-07-22,Schimke), approve(), audit(), install(): 26* Modified by Dave Schimke to fix bug in -to regular expression 27* handling, add integer sort and replace calls to search_file_ 28* with calls to search_file_$silent. 29* 6) change(84-12-14,Lippard), approve(85-01-16,MCR7139), 30* audit(85-12-16,GDixon), install(85-12-17,MR12.0-1001): 31* Modified by Jim Lippard to properly initialize case_regexp 32* array and properly sort numeric fields. 33* 7) change(86-09-16,Lippard), approve(86-09-29,MCR7551), 34* audit(86-10-13,Dickson), install(86-10-17,MR12.0-1188): 35* Modified to make sort_seg_$string clean up its temp segments on 36* normal exit. 37* 8) change(87-05-08,Hergert), approve(87-05-08,MCR7671), 38* audit(87-05-08,Dupuis), install(87-05-20),MR12.1-1032): 39* Modified to not miss the last tuple of each component of an MSF. 40* END HISTORY COMMENTS */ 41 42 43 44 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 45 /* */ 46 /* Name: sort_seg_ */ 47 /* */ 48 /* Subroutine for sorting segments or strings, based upon one or more sort fields within */ 49 /* sort units. */ 50 /* */ 51 52 53 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 54 /* */ 55 /* OVERVIEW OF THE SORTING PROCESS: */ 56 /* */ 57 /* Overview: Sorting is performed by dividing the input up into delimited sort strings, */ 58 /* and then blocking some number of strings (1 or more, EXCLUDING the delimiters) */ 59 /* together to form sort units. Sorting is done by comparing these sort units, and then */ 60 /* reordering the delimited sort strings based upon the sort results. The sort units */ 61 /* are compared by identifying one or more sort fields within each sort unit, and then */ 62 /* comparing the contents of sort fields in one unit with corresponding fields in */ 63 /* another unit. A single sort field may encompass the entire sort unit, or only a part */ 64 /* of it. Fields may be compared in ascending or descending order, with or without */ 65 /* sensitivity to letter case. */ 66 /* */ 67 /* To begin the sorting process, the input is divided into delimited strings, and the */ 68 /* strings are blocked into delimited units (du's), which are the sort strings and */ 69 /* delimiters blocked to form the du. It is these delimited units which are reordered */ 70 /* in the sorted output. */ 71 /* */ 72 /* In order to perform a comparison, the delimiter(s) must be removed from the du to */ 73 /* form an undelimited unit (uu). Finally, the sort fields are identified in the uu, */ 74 /* and copied with optional translation to implement non_case_sensitive and descending */ 75 /* sorts. */ 76 /* */ 77 /* The du's are identified by pointer/length pairs (dup/dul) which overlay the actual */ 78 /* input. These are stored in a pair of structures. The uu's (du's with the delimiters */ 79 /* removed) are constructed in a temp seg (uu_str), and identified by pointer/length */ 80 /* pairs (uup/uul). Sort fields from each uu are copied in field order into a temp */ 81 /* segment (sf_str) identified by a pointer (sfp) and a fixed length (Lall_fields). */ 82 /* Each field is translated to lowercase/inverted to implement */ 83 /* non_case_sensitive/descending comparison of a field. Numeric fields are converted to */ 84 /* float dec(59) values, then encoded as character strings for sorting. Similarly, */ 85 /* integer fields are converted to fixed bin(71) values, and then encoded as character */ 86 /* strings for sorting. This grouping of fields allows a single pass sort to perform */ 87 /* multi-field comparison operations. A stability field is added to the end of each */ 88 /* group of sort fields to insure that groups having the same value appear in the output */ 89 /* in their original order. */ 90 /* */ 91 /* Of course, in special cases, some of the steps above can be bypassed for efficiency. */ 92 /* In fact, the most common types of sorts can be special-cased to improve efficiency. */ 93 /* For example, when sort string delimiters are fixed-length and the blocking factor is */ 94 /* 1, there is no need to determine the dul values. These can be computed from uul */ 95 /* plus the length of the fixed delimiter. When blocking factor is 1, copying the */ 96 /* undelimited unit into uu_str can be avoided by treating each du minus the delimiter */ 97 /* as the undelimited unit. Thus dup = uup, so uup need not be set. Several other, */ 98 /* similar special cases are used to further improve efficiency when possible. */ 99 /* */ 100 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 101 102 sort_seg_: 103 procedure; 104 return; 105 106 dcl lcb_ptr ptr, /* linus control block ptr for table entry (In) */ 107 caller char(*), /* name of calling command. (In) */ 108 desc_array (*) ptr, /* descriptors (or place holders) for each sort */ 109 /* field for numeric sort on table entrypoint */ 110 111 in_dir char(*), /* dir part of input seg pathname. (In) */ 112 in_ent char(*), /* entry part of input seg pathname (In) */ 113 in_ptr ptr, /* pointer to the table rows structure (In) */ 114 in_string char(*), /* input string to be sorted. (In) */ 115 out_dir char(*), /* dir part of output seg pathname (In) */ 116 out_ent char(*), /* entry part of output seg pathname (In) */ 117 out_ptr ptr, /* ptr to the sorted table structure (In) */ 118 out_string char(*), /* output string in which sorted results go. (Out)*/ 119 out_len fixed bin(21), /* length (in chars) of sorted output seg. (Out) */ 120 temp_dir char (*), /* pathname of dir to be used for temp segs (In) */ 121 temp_seg_mgr$get entry (ptr, char(*), char(*), ptr, fixed bin(35)), 122 temp_seg_mgr$release entry (ptr, char(*), ptr, fixed bin(35)), 123 undelim_char_index fixed bin(21), /* index in output of first char of an undelimited*/ 124 /* string. Any string not followed by a */ 125 /* delimiter is treated as such an undelimited */ 126 /* string. (Out) */ 127 code fixed bin(35); /* status code. (Out) */ 128 129 dcl Ibk fixed bin(21), /* number of sort strings in this sort unit so far*/ 130 Ichar fixed bin(21), 131 Icomp fixed bin(21), /* index of components being sorted. */ 132 Idu fixed bin(21), /* index in input of start of delimited sort unit */ 133 Iend fixed bin(21), /* index in a sort unit of last char of a field. */ 134 If fixed bin, /* index into field specification array. */ 135 Iline_end fixed bin(21), 136 Imatch fixed bin(21), /* index in input of first char matching delimiter*/ 137 Imatch_end fixed bin(21), /* index in input of last char matching delimiter */ 138 Imerge fixed bin, /* index of the table component to be merged */ 139 Iptr fixed bin(21), /* row ptr index in table ptr seg */ 140 Inl fixed bin(21), 141 Iseg fixed bin, /* index in array of ptr segs of table structure */ 142 Isf_str fixed bin(21), /* index of next, unsused char in sf_str string. */ 143 Iss fixed bin(21), /* index in input of start of next sort string. */ 144 Istart fixed bin(21), /* index in a sort unit of start char of a field. */ 145 Its fixed bin, /* index in array of saved temp segs */ 146 Iu fixed bin(21), /* index of a sort unit. */ 147 Iu_prev fixed bin(21), /* index of sort unit prior to Iu (in sorted ord) */ 148 Iuss fixed bin(21), /* index in input of start of this sort string. */ 149 Iuu fixed bin(21), /* index in uu_str of start of next sort unit. */ 150 Iuu_str fixed bin(21), /* index in uu_str of next, unused character. */ 151 Ix fixed bin(21), /* index into idx array of sorted unit indices. */ 152 Lall_fields fixed bin(24), /* combined length of all sort unit fields. */ 153 Ldelim fixed bin(21), /* length of fixed-sized sort string delims. */ 154 Ldss fixed bin(21), /* length of sort string with its delimiter. */ 155 Ldu fixed bin(21), /* length of delimited sort unit. */ 156 Ldu_prev fixed bin(21), /* length of prior delimited sort unit. */ 157 (Lin, Lout) fixed bin(21), 158 Lmatch fixed bin(21), /* length of part of input matching delimter. */ 159 Luss fixed bin(21), /* length of sort string without its delimiter. */ 160 Luu fixed bin(21), /* length of undelimited sort unit */ 161 Luu_str fixed bin(21), /* length of used portion of uu_str. */ 162 Luu_temp fixed bin(21), /* length of uu_temp (temp copy of uu + NL). */ 163 Ndups fixed bin(21), /* number of duplicate sort units in a row. */ 164 Ndups_prev fixed bin(21), /* value of Ndups when prev sort unit was examined*/ 165 /* 0 = no duplicates */ 166 /* 1 = 1 duplicate, etc */ 167 Nlines fixed bin(21), 168 Nsf_str_array fixed bin, 169 Nu fixed bin(24), /* number of sort units. */ 170 (Oin, Oout) fixed bin(21), /* offsets of input/output strings from start of */ 171 /* their containing segments. */ 172 (Paccess, Pin, Pout) ptr, 173 (Pdul, Pdup, Pidx, Pout_real, Pout_temp, Psf_str, Psfa(64), Psfl, Psfp, Puu_str, Puu_temp, Puul, Puup) 174 ptr, /* ptrs to temp segments. */ 175 (Psave, Pspp, Psup, Psupo, Psppo) 176 ptr, /* ptrs to linus_table structures. */ 177 (Pidx1, Pidx_merge, Psfp1, Psfp_merge, Psf1, Psf_merge) 178 ptr, /* ptrs to merge overlays and sort fields */ 179 180 Psf_str_array (Nsf_str_array) ptr based (addr(Psfa)), 181 Screated_output_seg bit(1), 182 Sblocked bit(1), /* sort strings are blocked several to a sort unit*/ 183 Sdescending_sort bit(1), /* If only one sort field spanning entire unit is */ 184 /* given, descending sort can be implemented */ 185 /* most efficiently as a special case. */ 186 Sfield bit(1), /* sort field(s) include only part of each sort */ 187 /* unit, not 1 field spanning entire unit. */ 188 Snon_case_sensitive_sort bit(1), /* If only one sort field spanning entire unit is */ 189 /* given, non_case_sensitive translating must be*/ 190 /* done as special case. */ 191 Snumeric bit(1), /* Are any sort modes numeric? */ 192 Soverlap bit(1), /* Input and output overlaps, forcing placement */ 193 /* of sort output in a temp seg. */ 194 Stemp_dir bit(1), /* If temp dir is to be used for temp segs. */ 195 Svarying_delimiters bit(1), /* A regular expression delimits records. Since */ 196 /* the strings matching regexp are of varying */ 197 /* length, we must record total length of each */ 198 /* sort unit, including its delimiters. */ 199 Svarying_fields bit(1), /* sort fields have varying widths. */ 200 Syes bit(1), 201 (bc_in, bc_out) fixed bin(24), 202 component_number fixed bin, /* index of table components */ 203 comp_base_number bit(18), 204 encd_len fixed bin(21), 205 encd_str char(256), 206 id char(15) varying, 207 max_Lout fixed bin(21); 208 dcl stable char(4) based(addr(Iu)); 209 210 dcl in char(Lin) based(Pin), 211 in_char (Lin) char(1) based(Pin), 212 out char(max_Lout) based(Pout); 213 214 dcl 1 idx aligned based(Pidx), 215 2 N fixed bin(24), /* array of sorted sort unit indices. */ 216 2 I (Nu) fixed bin(24), 217 du char(Ldu) based(dup.P(Iu)), 218 du_prev char(Ldu_prev) based(dup.P(Iu_prev)), 219 1 dup aligned based(Pdup),/* delimited units - (as in original input) */ 220 2 N fixed bin(24), /* ptrs to original sort units including their */ 221 2 P (Nu) ptr unal, /* delimiters. */ 222 1 dul aligned based(Pdul),/* lengths of original sort units, including */ 223 2 N fixed bin(24), /* their delimiters. */ 224 2 L (Nu) fixed bin(24); 225 226 227 228 /* LINUS_TABLE structures */ 229 dcl 1 idx1 aligned based (Pidx1), 230 2 N fixed bin(24), /* merge sort indices */ 231 2 I (idx1.N) 232 fixed bin(24), 233 234 1 idx_merge aligned based (Pidx_merge), 235 2 N fixed bin(24), /* merge sort indices */ 236 2 I (idx_merge.N) 237 fixed bin(24), 238 239 1 sfp1 aligned based (Psfp1), 240 2 N fixed bin(24), /* merge sort field overlay */ 241 2 P (sfp1.N) 242 ptr unal, 243 244 1 sfp_merge aligned based (Psfp_merge), 245 2 N fixed bin(24), /* merge sort field overlay */ 246 2 P (sfp_merge.N) 247 ptr unal, 248 249 sf1 char(Lall_fields) based (Psf1), 250 sf_merge char(Lall_fields) based (Psf_merge), 251 252 1 supo aligned based (Psupo), 253 2 N fixed bin (21), /* ptrs to the table rows. */ 254 2 P (supo.N) ptr unal, 255 1 sppo based (Psppo), 256 2 N fixed bin, 257 2 P (sppo.N) ptr unal, 258 1 save aligned based (Psave), 259 2 N fixed bin, /* saved ptrs for merging. */ 260 2 Nsf_strs fixed bin, 261 2 dup_ptr (save.N) ptr, /* row ptrs */ 262 2 idx_ptr (save.N) ptr, /* sorted indices */ 263 2 sfp_ptr (save.N) ptr, /* sort fields */ 264 2 sf_str_ptr (save.Nsf_strs) 265 ptr, /* sort strings */ 266 267 1 spp aligned based(Pspp),/* ptrs to the sup segments and msf components. */ 268 2 N fixed bin, 269 2 M fixed bin, 270 2 sorted bit (1), 271 2 P (spp.N) ptr unal, 272 2 C (spp.M) ptr unal, 273 274 1 sup aligned based (Psup),/* ptrs to the table rows */ 275 2 N fixed bin (21), 276 2 P (sup.N) ptr unal; 277 278 279 /* undelimited units */ 280 dcl uu char(uul.L(Iu)) based(uup.P(Iu)), 281 uu_str char(Luu_str) based(Puu_str), 282 uu_str_char (Luu_str) char(1) based(Puu_str), 283 uu_temp char(Luu_temp) based (Puu_temp), 284 1 uup aligned based(Puup),/* ptrs to blocked sort units containing */ 285 2 N fixed bin(24), /* several sort strings without their delimiters*/ 286 2 P (Nu) ptr unal, 287 1 uul aligned based(Puul),/* lengths of undelimited units. */ 288 2 N fixed bin(24), 289 2 L (Nu) fixed bin(24), 290 291 /* sort fields */ 292 sf char(Lall_fields) based(sfp.P(Iu)), 293 sf_ncs char(sfl.L(Iu)) based(sfp.P(Iu)), 294 sf_prev char(Lall_fields) based(sfp.P(Iu_prev)), 295 sf_str char(max_seg_size) based(Psf_str), 296 /* string containing ordered sort fields built */ 297 /* from all sort units. Field groups from all */ 298 /* units have the same length. */ 299 sf_str_char (max_seg_size) char(1) based(Psf_str), 300 1 sfp aligned based(Psfp),/* ptrs to sort fields from each unit. */ 301 2 N fixed bin(24), 302 2 P (Nu) ptr unal, 303 1 sfl aligned based(Psfl), 304 2 N fixed bin(24), 305 2 L (Nu) fixed bin(24); 306 307 dcl search_file_$silent entry (ptr, fixed bin(21), fixed bin(21), ptr, fixed bin(21), 308 fixed bin(21), fixed bin(21), fixed bin(21), fixed bin(35)), 309 sort_items_indirect_$adj_char entry (ptr, ptr, ptr), 310 sort_items_indirect_$char entry (ptr, ptr, fixed bin(24)); 311 312 dcl AZ char(26) int static options(constant) 313 init("ABCDEFGHIJKLMNOPQRSTUVWXYZ"), 314 NL char(1) int static options(constant) init(" 315 "), 316 ZERO char(1) int static options(constant) init("0"), 317 az char(26) int static options(constant) 318 init("abcdefghijklmnopqrstuvwxyz"); 319 320 dcl (addr, baseno, bin, charno, currentsize, dim, divide, fixed, floor, index, 321 length, max, min, mod, null, rtrim, substr, sum, translate, unspec) 322 builtin, 323 cleanup condition, 324 conversion condition; 325 326 dcl access_$reset entry (ptr, fixed bin(35)), 327 access_$set_temporarily entry (char(*), char(*), fixed bin(2), bit(*), ptr, fixed bin(35)), 328 command_query_$yes_no entry() options (variable), 329 hcs_$delentry_seg entry (ptr, fixed bin(35)), 330 hcs_$make_seg entry (char(*), char(*), char(*), fixed bin(5), ptr, fixed bin(35)), 331 initiate_file_ entry (char(*), char(*), bit(*), ptr, fixed bin(24), fixed bin(35)), 332 ioa_ entry options(variable), 333 sub_err_ entry() options(variable), 334 terminate_file_ entry (ptr, fixed bin(24), bit(*), fixed bin(35)); 335 336 dcl (FALSE init("0"b), 337 TRUE init("1"b)) bit(1) int static options(constant), 338 1 FIXED_BIN_71_DESC aligned int static options (constant), 339 2 version bit(1) unal init("1"b), 340 2 type fixed bin(6) unsigned unal init(1), 341 2 packed bit(1) unal init("0"b), 342 2 dimension bit(4) unal init("0"b), 343 2 scale fixed bin(11) unal init(0), 344 2 precision fixed bin(11) unal init(71), 345 1 FLOAT_DEC_59_DESC aligned int static options (constant), 346 2 version bit(1) unal init("1"b), 347 2 type fixed bin(6) unsigned unal init(10), 348 2 packed bit(1) unal init("0"b), 349 2 dimension bit(4) unal init("0"b), 350 2 scale fixed bin(11) unal init(0), 351 2 precision fixed bin(11) unal init(59), 352 SEGMENT fixed bin(2) int static options(constant) init(1), 353 STRING fixed bin(2) int static options (constant) init(2), 354 TABLE fixed bin(2) int static options (constant) init(3), 355 Sdebug bit(1) int static init("0"b), 356 (error_table_$bad_conversion, 357 error_table_$chars_after_delim, 358 error_table_$file_is_full, 359 error_table_$moderr, 360 error_table_$no_delimiter, 361 error_table_$nomatch, 362 error_table_$no_w_permission, 363 error_table_$noentry, 364 error_table_$out_of_bounds, 365 error_table_$unimplemented_version, 366 error_table_$zero_length_seg) fixed bin(35) ext static, 367 max_ptrs_per_seg fixed bin(21) int static init(0), 368 max_seg_size fixed bin(21) int static init(0), 369 sys_info$max_seg_size fixed bin(35) ext static; 370 371 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 372 373 374 seg: entry (caller, ss_info_ptr, in_dir, in_ent, out_dir, out_ent, 375 out_len, undelim_char_index, code); 376 377 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 378 /* */ 379 /* This entry point sorts segments. */ 380 /* */ 381 /* Overview: */ 382 /* 1) Initialize output arguments. */ 383 /* 2) Establish cleanup on unit to terminate segments, restore any changed ACLs, etc. */ 384 /* ORDER OF REMAINING OPERATIONS IS IMPORTANT--- */ 385 /* 3) Try to initiate an existing output segment. If found without access, ask user if */ 386 /* access should be temporarily changed to allow the sort to occur. If segment not */ 387 /* found, create it but mark it for possible deletion should sort fail for other */ 388 /* reasons. Note that, when the output seg replaces the input seg, forcing access */ 389 /* may make it easier to sort the input segment to which you normally have no access. */ 390 /* In this case, it is important to initiate the output segment first, because we only */ 391 /* change access for output segment, never for input segment. */ 392 /* 4) Initiate the input segment. */ 393 /* 5) Invoke internal procedures prepare_to_sort and sort to do the actual sorting. */ 394 /* 6) If sort succeeds, invoke internal procedure output to prepare the output segment. */ 395 /* 7) If sort succeeds, truncate, set bit count and terminate output segment. If it */ 396 /* fails, terminate (or delete if we created) the output segment. Also, terminate */ 397 /* input and restore any ACL changes. */ 398 /* */ 399 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 400 401 out_len = 0; /* Initialize output args. */ 402 undelim_char_index = 0; 403 404 Pin = null; /* Handle unexpected release. */ 405 Pout = null; 406 Paccess = null; 407 Screated_output_seg = FALSE; 408 Stemp_dir = FALSE; 409 410 Pidx = null; /* Be prepared to cleanup temp segments. */ 411 Soverlap = FALSE; 412 Pdup, Pdul = null; 413 Nsf_str_array = dim(Psfa,1); 414 Psf_str_array(*), Psf_str, Psfp, Psfl = null; 415 Nsf_str_array = 1; 416 Puu_str, Puup, Puul, Puu_temp = null; 417 Pout_temp = null; 418 Pout_real = null; 419 on cleanup call seg_janitor(TERM_FILE_TERM, Screated_output_seg); 420 421 RE_INIT_OUTPUT: /* Initiate output segment. */ 422 call initiate_file_ (out_dir, out_ent, W_ACCESS, Pout, bc_out, code); 423 424 if code = error_table_$no_w_permission | 425 code = error_table_$moderr then do; /* It exists, but caller cannot access it. */ 426 call command_query_$yes_no (Syes, code, caller, 427 "Should ^a temporarily set read/write access on the sort output segment 428 ^s(^a^[>^]^a)^[^/^; ^]to allow sorting to proceed?", "^sDo you want to set write access 429 on sort output segment^[^/^; ^](^a^[>^]^a)^s?", caller, 430 length("to allow sorting to proceed") + length(rtrim(out_dir)) + 431 length(">") + length(rtrim(out_ent)) + length("()?") > 76, 432 out_dir, out_dir^=">", out_ent, 433 length("to allow sorting to proceed") + length(rtrim(out_dir)) + 434 length(">") + length(rtrim(out_ent)) + length("()?") > 76); 435 if ^Syes then go to SEG_EXIT; 436 call access_$set_temporarily (out_dir, out_ent, SEGMENT, RW_ACCESS, Paccess, code); 437 if code = 0 then go to RE_INIT_OUTPUT; 438 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 439 "While temporarily setting access on output segment^/(^a^[>^]^a).", out_dir, out_dir^=">", out_ent); 440 go to SEG_EXIT; 441 end; 442 443 if code = error_table_$noentry then do; /* It does not exist. Create it. */ 444 Screated_output_seg = TRUE; 445 call hcs_$make_seg (out_dir, out_ent, "", RW_ACCESS_BIN, Pout, code); 446 if Pout ^= null then code = 0; 447 end; 448 if code ^= 0 then do; /* Error during creation/initiation. */ 449 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 450 "While ^[creating^;initiating^] the sort output segment^/(^a^[>^]^a).", 451 Screated_output_seg, out_dir, out_dir^=">", out_ent); 452 go to SEG_EXIT; 453 end; 454 max_Lout = sys_info$max_seg_size * 4; 455 456 call initiate_file_ (in_dir, in_ent, R_ACCESS, Pin, bc_in, code); 457 if code ^= 0 then do; /* Initiate input segment. */ 458 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 459 "While initiating input segment^/(^a^[>^]^a).", in_dir, in_dir^=">", in_ent); 460 go to SEG_EXIT; 461 end; 462 Lin = divide(bc_in, 9, 21, 0); 463 464 call prepare_to_sort(SEGMENT); /* This internal procedure does the scan work. */ 465 if code ^= 0 then goto SEG_EXIT; 466 467 call sort(SEGMENT); /* This internal procedure does the sort work. */ 468 if code ^= 0 then goto SEG_EXIT; 469 470 call output(); /* This internal procedure prepares the output. */ 471 if code ^= 0 then goto SEG_EXIT; 472 call seg_janitor (TERM_FILE_TRUNC_BC_TERM, FALSE); 473 return; 474 475 SEG_EXIT: call seg_janitor(TERM_FILE_TERM, Screated_output_seg); 476 return; 477 478 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 479 480 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 481 482 483 sort_seg_$string: 484 entry (caller, ss_info_ptr, in_string, out_string, out_len, 485 undelim_char_index, code); 486 487 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 488 /* */ 489 /* This entry point sorts strings. */ 490 /* */ 491 /* Overview: */ 492 /* 1) Initialize output arguments. */ 493 /* 2) Set input and output pointers to identify the input/output character strings parms. */ 494 /* 3) Establish cleanup on unit to release temp segments used for sorting. */ 495 /* 4) Invoke internal prepare_to_sort procedure to scan the input string. */ 496 /* 5) Invoke internal sort procedure to do actual sorting. */ 497 /* 6) Invoke internal output procedure to prepare the output. */ 498 /* */ 499 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 500 501 out_len = 0; 502 undelim_char_index = 0; 503 code = 0; 504 505 Pin = addr(in_string); 506 Lin = length(in_string); 507 Pout = addr(out_string); 508 max_Lout = length(out_string); 509 Stemp_dir = FALSE; 510 511 Pidx = null; /* Be prepared to cleanup temp segments. */ 512 Soverlap = FALSE; 513 Pdup, Pdul = null; 514 Nsf_str_array = dim(Psfa,1); 515 Psf_str_array(*), Psf_str, Psfp, Psfl = null; 516 Nsf_str_array = 1; 517 Puu_str, Puup, Puul, Puu_temp = null; 518 Pout_temp = null; 519 Pout_real = null; 520 on cleanup call sort_janitor(); 521 522 call prepare_to_sort (STRING); 523 if code ^= 0 then goto STRING_EXIT; 524 call sort (STRING); 525 if code ^= 0 then goto STRING_EXIT; 526 call output; 527 528 STRING_EXIT: 529 call sort_janitor(); 530 return; 531 532 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 533 534 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 535 536 linus_table: 537 entry (lcb_ptr, caller, ss_info_ptr, temp_seg_mgr$get, temp_seg_mgr$release, 538 temp_dir, in_ptr, desc_array, out_ptr, code); 539 540 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 541 /* */ 542 /* This entry point sorts the linus table structure. */ 543 /* */ 544 /* Overview: */ 545 /* 1) Scan input into individual components to be sorted. */ 546 /* 2) Establish cleanup on unit to release saved sort results used for merging. */ 547 /* 3) Sort the individual components. */ 548 /* 4) Merge the resulting sorted components. */ 549 /* 5) Cleanup. */ 550 /* */ 551 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 552 553 code = 0; 554 if temp_dir = "" then Stemp_dir = FALSE; 555 else Stemp_dir = TRUE; 556 557 Pout, Pin = null; /* Just to keep the common code happy. */ 558 Psave = null; /* Handle unexpected release. */ 559 560 component_number = 0; 561 Pidx = null; /* Be prepared to cleanup temp segments. */ 562 Soverlap = FALSE; 563 Pdup, Pdul = null; 564 Nsf_str_array = dim(Psfa,1); 565 Psf_str_array(*), Psf_str, Psfp, Psfl = null; 566 Nsf_str_array = 1; 567 Puu_str, Puup, Puul, Puu_temp = null; 568 Pout_temp = null; 569 Pout_real = null; 570 on cleanup call table_janitor (); 571 572 Pspp = in_ptr; 573 Psppo = out_ptr; 574 id = rtrim(caller) || " "; 575 if ^get_temp_seg (id, "saved sort ptrs", Psave) then goto TABLE_EXIT; 576 /* save temp seg */ 577 save.N = spp.M; 578 save.Nsf_strs = 0; 579 580 do Icomp = 1 to spp.M; 581 save.idx_ptr(Icomp) = null; 582 save.sfp_ptr(Icomp) = null; 583 save.dup_ptr(Icomp) = null; 584 component_number = Icomp; 585 call prepare_to_sort (TABLE); 586 if code ^= 0 then goto TABLE_EXIT; 587 call sort (TABLE); /* This internal procedure does the sort */ 588 if code ^= 0 then goto TABLE_EXIT; /* work for one segment's worth of rows. */ 589 590 save.dup_ptr(Icomp) = Pdup; /* save sort info for merging */ 591 Puup = null; 592 Pdup = null; 593 save.idx_ptr(Icomp) = Pidx; 594 Pidx = null; 595 save.sfp_ptr(Icomp) = Psfp; 596 Psfp = null; 597 addr(save.sf_str_ptr(save.Nsf_strs +1)) -> Psf_str_array = Psf_str_array; 598 save.Nsf_strs = save.Nsf_strs + dim(Psf_str_array, 1); 599 Psf_str_array = null; 600 Psf_str = null; 601 call sort_janitor(); 602 end; 603 604 if spp.M = 1 then do; /* short cut if we don't have an msf */ 605 Psupo = sppo.P(1); 606 Pdup = save.dup_ptr(1); 607 Pidx = save.idx_ptr(1); 608 supo.N, Nu = dup.N; 609 do Iu = 1 to supo.N; 610 supo.P (Iu) = dup.P (idx.I(Iu)); 611 end; 612 end; 613 614 else call merge; /* Here is the work of merging the */ 615 /* sorted components */ 616 617 TABLE_EXIT: 618 call table_janitor; 619 620 return; 621 622 623 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 624 625 626 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 627 /* */ 628 /* These two entry points turn special debugging code on/off. It is off by default. */ 629 /* */ 630 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 631 632 debug_on: 633 dbn: entry(); 634 635 Sdebug = TRUE; 636 return; 637 638 debug_off: 639 dbf: entry(); 640 641 Sdebug = FALSE; 642 return; 643 644 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 645 646 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 647 648 649 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 650 /* */ 651 /* I N T E R N A L P R O C E D U R E S */ 652 /* */ 653 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 654 655 656 prepare_to_sort: proc (type ); 657 658 dcl type fixed bin (2); /* 1=seg,2=string,3=linus_table */ 659 dcl found bit(1); 660 661 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 662 /* */ 663 /* INITIALIZATION: */ 664 /* 1) Check version of sort_seg_info structure. */ 665 /* 2) Check for empty input string. */ 666 /* */ 667 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 668 669 if max_seg_size = 0 then max_seg_size = sys_info$max_seg_size*4; 670 671 if ss_info.version ^= SS_info_version_1 then do; /* Validate info structure version. */ 672 code = error_table_$unimplemented_version; 673 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 674 "sort_seg_ does not implement version ^a of the ss_info structure 675 (see sort_seg_info.incl.pl1). It expects version ^a instead.", 676 ss_info.version, SS_info_version_1); 677 return; 678 end; 679 680 if type ^= TABLE then if length (in) = 0 then do; /* Check for no input to be sorted. */ 681 if type = SEGMENT then do; 682 code = error_table_$zero_length_seg; 683 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 684 "The sort input segment is empty^/(^a^[>^]^a).", 685 in_dir, in_dir^=">", in_ent); 686 end; 687 return; 688 end; 689 690 691 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 692 /* */ 693 /* CHECK INPUTS: */ 694 /* 1) Check for input string/seg overlapping output string/seg. This condition requires */ 695 /* that a temp seg be used for preparing the output. The output is then copied from */ 696 /* the temp seg into the output string/seg. */ 697 /* 2) Examine ss_info to determine various sorting cases, including-- */ 698 /* Svarying_delimiters = are sort string delimiters varying length or fixed length? */ 699 /* Sblocked = do sort units consist of several sort strings, or just one? */ 700 /* Snumeric = is any sort field a numeric sort? */ 701 /* Sfield = are one or more specific sort fields identified, or is each sort unit */ 702 /* treated as the only sort field? */ 703 /* Sdescending_sort = if each sort unit is the sort field, is the sort a descending */ 704 /* sort? */ 705 /* Snon_case_sensitive_sort = if each sort unit is the sort field, is the sort */ 706 /* non_case_sensitive? */ 707 /* */ 708 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 709 710 if type = TABLE then Soverlap = FALSE; 711 else if baseno(addr(in)) = baseno(addr(out)) then do; 712 Oin = charno (addr(in)); /* Check for input overlapping output storage. */ 713 Oout = charno (addr(out)); 714 if Oin < Oout then 715 Soverlap = Oin + length(in) > Oout; 716 else if Oin > Oout then 717 Soverlap = Oout + length(out) > Oin; 718 else 719 Soverlap = TRUE; 720 end; 721 else Soverlap = FALSE; 722 723 Svarying_delimiters = (ss_info.delim.type = SS_reg_exp); 724 /* Do sort string delimiters have varying length? */ 725 Sblocked = ss_info.block_size > 1; /* Is each sort unit composed of several strings? */ 726 Snumeric = FALSE; 727 do If = 1 to ss_info.field_count; /* Is any field a numeric sort field? */ 728 if ss_info.field(If).modes.numeric | ss_info.field(If).modes.integer then Snumeric = TRUE; 729 end; 730 Sfield = TRUE; /* Is the only field composed of the entire sort */ 731 Sdescending_sort = FALSE; /* unit? If so, descending and */ 732 Snon_case_sensitive_sort = FALSE; /* non_case_sensitive sorts must be */ 733 if ^Snumeric then /* special-cased, unless the sort is numeric or */ 734 if ss_info.field_count = 1 then /* integer. */ 735 if ss_info.field(1).from.type = SS_index & 736 ss_info.field(1).from.number = 1 & 737 ss_info.field(1).to.type = SS_length & 738 ss_info.field(1).to.number = -1 then do; 739 Sfield = FALSE; 740 Sdescending_sort = ss_info.field(1).modes.descending; 741 Snon_case_sensitive_sort = ss_info.field(1).modes.non_case_sensitive; 742 end; 743 744 745 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 746 /* */ 747 /* GET TEMP SEGMENTS: */ 748 /* */ 749 /* Obtain temp segments to hold the various arrays described in the "OVERVIEW OF THE */ 750 /* SORTING PROCESS" comment. */ 751 /* */ 752 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 753 754 755 id = rtrim(caller) || " "; /* Get necessary temp segments. */ 756 /* required temp segments. */ 757 if ^get_temp_seg (id, "sort indices", Pidx) then goto PREPARE_EXIT; 758 if ^get_temp_seg (id, "delim unit ptrs", Pdup) then goto PREPARE_EXIT; 759 if ^get_temp_seg (id, "undelim unit lths", Puul) then goto PREPARE_EXIT; 760 761 if Sblocked | Svarying_delimiters then 762 if ^get_temp_seg (id, "delim unit lths", Pdul) then goto PREPARE_EXIT; 763 if Sblocked then do; /* sort units without string delimiters */ 764 if ^get_temp_seg (id, "undelim unit strs", Puu_str) then goto PREPARE_EXIT; 765 if ^get_temp_seg (id, "undelim unit ptrs", Puup) then goto PREPARE_EXIT; 766 end; 767 768 if Sfield | Snon_case_sensitive_sort then do; /* combined sort fields for each unit */ 769 if ^get_temp_seg (id, "sort field strs", Psf_str) then goto PREPARE_EXIT; 770 Psf_str_array(Nsf_str_array) = Psf_str; 771 if ^get_temp_seg (id, "sort field ptrs", Psfp) then goto PREPARE_EXIT; 772 end; 773 774 if Snon_case_sensitive_sort then do; 775 if ^get_temp_seg (id, "sort field lths", Psfl) then goto PREPARE_EXIT; 776 end; 777 778 779 if Soverlap then do; 780 if ^get_temp_seg (id, "temp output seg", Pout_temp) then goto PREPARE_EXIT; 781 Pout_real = Pout; 782 Pout = Pout_temp; 783 end; 784 785 if type = TABLE then do; /* Instead of SCANNING */ 786 787 788 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 789 /* */ 790 /* PREPARE COMPONENT: */ 791 /* 1) Step through the row ptrs looking for segment changes. */ 792 /* 2) Put row ptrs into dup.p and set uul.l */ 793 /* */ 794 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 795 796 code = 0; 797 Nu = 0; 798 comp_base_number = baseno (spp.C(component_number)); 799 if spp.sorted then do; /* NORMAL CASE: search all ptrs for matches */ 800 do Iseg = 1 to spp.N; 801 Psup = spp.P(Iseg); 802 do Iptr = 1 to sup.N; 803 if comp_base_number = baseno (sup.P(Iptr)) then do; 804 Nu = Nu + 1; 805 dup.P(Nu) = sup.P(Iptr); 806 uul.L(Nu) = ss_info.delim.number; 807 end; 808 end; 809 end; 810 end; 811 812 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 813 /* */ 814 /* SPECIAL CASE: If the table wasn't previously sorted we can */ 815 /* expect all component ptrs to be contiguous. */ 816 /* */ 817 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 818 819 else do; /* SPECIAL CASE: contiguous ptrs */ 820 found = FALSE; 821 do Iseg = 1 to spp.N; 822 Psup = spp.P(Iseg); 823 do Iptr = 1 to sup.N; 824 if comp_base_number = baseno (sup.P (Iptr)) then do; 825 Nu = Nu + 1; 826 dup.P(Nu) = sup.P(Iptr); 827 uul.L(Nu) = ss_info.delim.number; 828 found = TRUE; 829 end; 830 else if found then goto LOOP_EXIT; 831 end; 832 end; 833 LOOP_EXIT: end; 834 835 dup.N, uul.N = Nu; 836 return; 837 end; /* TABLE */ 838 839 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 840 /* */ 841 /* SCANNING: */ 842 /* 1) Scan input into sort strings. */ 843 /* 2) Block strings into sort units */ 844 /* */ 845 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 846 847 Nu = 0; /* No sort units found so far. */ 848 Iss = 1; /* First sort string begins a char 1 of input. */ 849 850 Idu = 1; /* Initialize index/length pairs for du and uu. */ 851 Ldu = 0; 852 Iuu = 1; 853 Luu = 0; 854 855 Iuu_str = 1; /* Initialize index/length pair for uu_str temp */ 856 Luu_str = max_seg_size; 857 858 do while (Iss <= length(in)); /* Scan until input is exhausted. */ 859 do Ibk = 1 to ss_info.block_size while (Iss <= length(in)); 860 /* Block scanned sort strings into sort units. */ 861 Iuss = Iss; 862 go to FIND_DELIM(ss_info.delim.type); /* Do scanning by delimiter type. */ 863 864 FIND_DELIM(1): if (Iss-1)+ss_info.delim.number > length(in) then 865 go to UNDELIM_CHARS; /* Fixed length sort strings. Check for last */ 866 Ldss, Luss = ss_info.delim.number; /* sort string being too short. */ 867 Iss = Iss + ss_info.delim.number; 868 go to END_FIND_DELIM; 869 870 FIND_DELIM(3): Imatch = index (substr(in, Iss), ss_info.delim.string); 871 if Imatch = 0 then go to UNDELIM_CHARS; /* Sort strings delimited by char strings. */ 872 Luss = Imatch-1; 873 Ldss = Luss + length(ss_info.delim.string); 874 Iss = (Iss-1) + Imatch + length(ss_info.delim.string); 875 go to END_FIND_DELIM; 876 877 FIND_DELIM(4): call search_file_$silent (addr(substr(ss_info.delim.string,1)), 1, 878 length(ss_info.delim.string), /* Sort strings delimited by reg exp. */ 879 addr(in), Iss, length(in), 880 Imatch, Imatch_end, code); 881 if code = 0 then do; 882 Lmatch = Imatch_end - Imatch + 1; 883 if substr(ss_info.delim.string, length(ss_info.delim.string),1) = "$" then 884 Lmatch = Lmatch + 1; 885 Luss = Imatch - Iss; 886 Ldss = Luss + Lmatch; 887 Iss = Imatch + Lmatch; 888 go to END_FIND_DELIM; 889 end; 890 else if code = error_table_$nomatch then do; 891 code = 0; 892 go to UNDELIM_CHARS; 893 end; 894 else do; 895 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 896 "Invalid syntax in regular expression: -delimiter /^a/", 897 ss_info.delim.string); 898 go to PREPARE_EXIT; 899 end; 900 901 END_FIND_DELIM: Ldu = Ldu + Ldss; 902 Luu = Luu + Luss; 903 if Sblocked then do; 904 substr(uu_str, Iuu_str, Luss) = substr(in, Iuss, Luss); 905 Iuu_str = Iuu_str + Luss; 906 end; 907 end; 908 909 Nu = Nu + 1; 910 dup.P(Nu) = addr(in_char(Idu)); 911 uul.L(Nu) = Luu; 912 if Sblocked | Svarying_delimiters then 913 dul.L(Nu) = Ldu; 914 if Sblocked then do; 915 uup.P(Nu) = addr(uu_str_char(Iuu)); 916 Iuu = Iuu + Luu; 917 end; 918 Idu = Idu + Ldu; 919 Ldu, Luu = 0; 920 end; 921 922 UNDELIM_CHARS: /* Check for input chars beyond last sort string. */ 923 if Iss ^= length(in) + 1 then do; /* This is undelimited input which will remain */ 924 undelim_char_index = Iss; /* at end of sorted results. */ 925 Iline_end = 0; 926 do Nlines = 0 by 1 while (Iline_end < Iss); 927 Inl = index(substr(in,Iline_end+1), NL); 928 if Inl = 0 then 929 Inl = length(in) - Iline_end; 930 Iline_end = Iline_end + Inl; 931 end; 932 Ichar = Iss - (Iline_end - Inl); 933 if Soverlap then do; 934 call command_query_$yes_no (Syes, error_table_$chars_after_delim, 935 caller, "The sort input ^[segment^;string^] does not end with a sort delimiter. 936 Instead, characters beginning on line ^d^[ (character ^d)^;^s^] follow 937 the final delimiter in the sort ^[segment 938 (^a^[>^]^a)^;string^3s^]." || " 939 Answer yes if you want to proceed with the sort. The characters 940 following the final delimiter will remain at the end of the sorted results. 941 Proceed with the sort?", " 942 ^sCharacters on line ^d^[ (character ^d)^;^s^] follow final sort delimiter. 943 Do you still want to sort the ^[segment^;string^]?", (type = SEGMENT), Nlines, 944 Ichar>1, Ichar, (type = SEGMENT), in_dir, in_dir^=">", in_ent); 945 if ^Syes then do; 946 code = error_table_$chars_after_delim; 947 go to PREPARE_EXIT; 948 end; 949 end; 950 else do; 951 call sub_err_ (error_table_$chars_after_delim, caller, ACTION_DEFAULT_RESTART, null, 0, " 952 Warning: Characters on line ^d^[ (character ^d)^;^s^] follow final sort delimiter. 953 These characters will appear at end of sorted results. Sorting continues^[ 954 (^a^[>^]^a)^;^3s^].", 955 Nlines, Ichar>1, Ichar, (type = SEGMENT), 956 in_dir, in_dir^=">", in_ent); 957 end; 958 end; 959 if Nu = 0 then do; 960 code = error_table_$no_delimiter; 961 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 962 "No sorting delimiters were found in sort input ^[segment 963 (^a^[>^]^a).^;string.^]", (type = SEGMENT), in_dir, in_dir^=">", in_ent); 964 go to PREPARE_EXIT; 965 end; 966 967 PREPARE_EXIT: 968 if code ^= 0 then call sort_janitor; 969 return; 970 end prepare_to_sort; 971 972 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 973 974 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 975 976 sort: proc (type); 977 dcl Lfield (ss_info.field_count+1) /* length of each field in the sort unit. */ 978 fixed bin(21), 979 case_regexp (ss_info.field_count) /* regexp case for -to regexpr handling */ 980 fixed bin, 981 case_field (ss_info.field_count) /* sort type case for sort mode handling */ 982 fixed bin, 983 type fixed bin (2); /* 1=seg,2=string,3=linus_table */ 984 985 986 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 987 /* */ 988 /* GENERALIZING THE SPECIAL CASES: */ 989 /* 1) When not blocked (ie, block_count = 1), the uu ptrs = the du ptrs and the uu_str */ 990 /* overlays the input. */ 991 /* 2) When not blocked and fixed-length delimiters, the du lengths = the uu lengths plus */ 992 /* the fixed-length of the delimiter. */ 993 /* */ 994 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 995 996 if ^Sblocked then Puup = Pdup; 997 else Luu_str = Iuu_str - 1; 998 999 if ^(Sblocked | Svarying_delimiters) then do; /* This code can never be entered for SS_regexp */ 1000 Pdul = Puul; /* type delimiters */ 1001 if ss_info.delim.type = SS_length then /* For fixed-length sort strings, there is no */ 1002 Ldelim = 0; /* special delimiting character. */ 1003 else /* For fixed string delimiter (SS_string type), */ 1004 Ldelim = length (ss_info.delim.string); /* length of delimiter is fixed and must be */ 1005 end; /* added to dul.L values. */ 1006 else Ldelim = 0; /* For regular expression delimiters (SS_reg_exp */ 1007 /* type), the length of delimiter is already */ 1008 /* included in dul values. */ 1009 1010 1011 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1012 /* */ 1013 /* SPECIAL-CASED FIELD PROCESSING: */ 1014 /* 1 field, which equals the entire sort unit, with non_case_sensitive sorting-- */ 1015 /* 1) Copy each uu into the sf_str temp, translating to lowercase as you go. */ 1016 /* 2) Add a sort stability field to the end of each copied unit. The stability field is */ 1017 /* simply the unit number, treated as a character string. */ 1018 /* 3) Set sf ptr/len pair (sfp/sfl) */ 1019 /* */ 1020 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1021 1022 if Snon_case_sensitive_sort then do; 1023 Isf_str = 1; 1024 do Iu = 1 to Nu; 1025 sfl.L(Iu) = length(uu) + length(stable); 1026 if (Isf_str-1) + sfl.L(Iu) > max_seg_size then do; 1027 Nsf_str_array = Nsf_str_array + 1; 1028 if ^get_temp_seg (id, "sort field strs", Psf_str) then goto SORT_EXIT; 1029 Psf_str_array(Nsf_str_array) = Psf_str; 1030 Isf_str = 1; 1031 end; 1032 (nostrz,nostrg,nosize,nosubrg): /* prefixes due to bug in PL/I */ 1033 sfp.P(Iu) = addr(sf_str_char(Isf_str)); 1034 substr(sf_ncs,1,length(uu)) = translate (uu, az, AZ); 1035 substr(sf_ncs, length(uu)+1) = stable; 1036 Isf_str = Isf_str + length(sf_ncs); 1037 end; 1038 end; 1039 1040 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1041 /* */ 1042 /* NORMAL FIELD PROCESSING: */ 1043 /* Several fields, or 1 field which does NOT span the entire sort unit-- */ 1044 /* 1) Determine whether all of the sort fields are fixed length. */ 1045 /* 2) If so, compute the length of all sort fields, including a stability field. */ 1046 /* (For numeric/integer fields, call encode numeric to determine the field length.) */ 1047 /* Store in Lall_fields. */ 1048 /* 3) If not, scan each sort unit to compute length of sort fields for that unit. For */ 1049 /* numeric fields, call encode numeric to determine the encoded length of the field. */ 1050 /* Then length of all sort fields is sum of max of sort field lengths for each unit. */ 1051 /* Put in Lall_fields. */ 1052 /* */ 1053 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1054 1055 /* Initialize case_regexp array. */ 1056 do If = 1 to ss_info.field_count; 1057 if ss_info.field(If).to.string = "$" then 1058 case_regexp(If) = 1; 1059 else if length (ss_info.field(If).to.string) = 0 then 1060 case_regexp(If) = 4; 1061 else if substr(ss_info.field(If).to.string, length(ss_info.field(If).to.string), length("$")) = "$" 1062 then do; 1063 if ^Sblocked & ss_info.delim.type = SS_string 1064 & ss_info.delim.string = NL then 1065 case_regexp(If) = 2; 1066 else do; 1067 case_regexp(If) = 3; 1068 if Puu_temp = null then if ^get_temp_seg (id, "undelim temp strs", Puu_temp) then goto SORT_EXIT; 1069 end; 1070 end; 1071 else 1072 case_regexp(If) = 4; 1073 end; 1074 1075 if Sfield then do; 1076 Svarying_fields = FALSE; 1077 do If = 1 to ss_info.field_count while (^Svarying_fields); 1078 if ss_info.field(If).to.type = SS_length then 1079 if ss_info.field(If).to.number = -1 then Svarying_fields = TRUE; 1080 else; 1081 else if ss_info.field(If).to.type = SS_index then 1082 if ss_info.field(If).from.type = SS_index then; 1083 else Svarying_fields = TRUE; 1084 else Svarying_fields = TRUE; 1085 end; 1086 if ^Svarying_fields then do; 1087 do If = 1 to ss_info.field_count; /* compute length of each sort field in units. */ 1088 if ss_info.field(If).modes.numeric then do; 1089 if type = TABLE then call encode_numeric (addr(ZERO), length(ZERO), desc_array(If), 1090 addr(encd_str), Lfield(If), code); 1091 else call encode_numeric (addr(ZERO), length(ZERO), addr(FLOAT_DEC_59_DESC), 1092 addr(encd_str), Lfield(If), code); 1093 end; 1094 else if ss_info.field(If).modes.integer 1095 then call encode_numeric (addr(ZERO), length(ZERO), addr(FIXED_BIN_71_DESC), 1096 addr(encd_str), Lfield(If), code); 1097 else if ss_info.field(If).to.type = SS_length then 1098 Lfield(If) = ss_info.field(If).to.number; 1099 else 1100 Lfield(If) = ss_info.field(If).to.number - 1101 ss_info.field(If).from.number + 1; 1102 end; 1103 Lfield(If) = length(stable); /* Include 4 char field for a sort unit number */ 1104 Lall_fields = sum(Lfield); /* to force the sort to be stable. */ 1105 end; 1106 else do; /* Because some sort fields have varying lengths */ 1107 /* depending upon sort unit contents, we must go */ 1108 /* to the expense of pre-scanning all sort units */ 1109 /* to determine longest instance of each field. */ 1110 Lfield(*) = 0; 1111 do Iu = 1 to Nu; 1112 do If = 1 to ss_info.field_count; 1113 if ss_info.field(If).modes.numeric then do; 1114 if type = TABLE then call encode_numeric (addr(ZERO), length(ZERO), desc_array(If), 1115 addr(encd_str), Lfield(If), code); 1116 else call encode_numeric (addr(ZERO), length(ZERO), addr(FLOAT_DEC_59_DESC), 1117 addr(encd_str), Lfield(If), code); 1118 if case_regexp (If) = 2 then uul.L(Iu) = uul.L(Iu) + length(NL); 1119 go to LTH_EMPTY_FIELD; 1120 end; 1121 else if ss_info.field(If).modes.integer then do; 1122 call encode_numeric (addr(ZERO), length(ZERO), addr(FIXED_BIN_71_DESC), 1123 addr(encd_str), Lfield(If), code); 1124 if case_regexp (If) = 2 then uul.L(Iu) = uul.L(Iu) + length(NL); 1125 go to LTH_EMPTY_FIELD; 1126 end; 1127 else go to LTH_FROM_FIELD(ss_info.field(If).from.type); 1128 1129 LTH_FROM_FIELD(2): Istart = ss_info.field(If).from.number; 1130 go to END_LTH_FROM_FIELD; 1131 1132 LTH_FROM_FIELD(3): Istart = index (uu, ss_info.field(If).from.string); 1133 if Istart = 0 then go to LTH_EMPTY_FIELD; 1134 Istart = Istart + length(ss_info.field(If).from.string); 1135 go to END_LTH_FROM_FIELD; 1136 1137 LTH_FROM_FIELD(4): call search_file_$silent (addr(substr(ss_info.field(If).from.string,1)), 1138 1, length(ss_info.field(If).from.string), 1139 addr(uu), 1, length(uu), 1140 Istart, Imatch_end, code); 1141 if code = 0 then do; 1142 Lmatch = Imatch_end - Istart + 1; 1143 Istart = Istart + Lmatch; 1144 go to END_LTH_FROM_FIELD; 1145 end; 1146 else if code = error_table_$nomatch then do; 1147 code = 0; 1148 go to LTH_EMPTY_FIELD; 1149 end; 1150 else do; 1151 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 1152 "Invalid syntax in regular expression: -field -from /^a/", 1153 ss_info.field(If).from.string); 1154 go to SORT_EXIT; 1155 end; 1156 1157 END_LTH_FROM_FIELD: if Istart > length(uu) then go to LTH_EMPTY_FIELD; 1158 go to LTH_TO_FIELD(ss_info.field(If).to.type); 1159 1160 LTH_TO_FIELD(1): if ss_info.field(If).to.number = -1 then 1161 Iend = length(uu); 1162 else 1163 Iend = min (length(uu), (Istart-1) + ss_info.field(If).to.number); 1164 go to END_LTH_TO_FIELD; 1165 1166 LTH_TO_FIELD(2): Iend = min(ss_info.field(If).to.number, length(uu)); 1167 go to END_LTH_TO_FIELD; 1168 1169 LTH_TO_FIELD(3): Iend = index (substr(uu,Istart), ss_info.field(If).to.string); 1170 if Iend = 0 then go to LTH_EMPTY_FIELD; 1171 Iend = Iend + (Istart-1) - 1; 1172 go to END_LTH_TO_FIELD; 1173 1174 LTH_TO_FIELD(4): go to LTH_TO_REGEXP (case_regexp(If)); 1175 1176 LTH_TO_REGEXP(1): Iend = length(uu); 1177 go to END_LTH_TO_FIELD; 1178 1179 LTH_TO_REGEXP(3): Luu_temp = uul.L(If); 1180 uu_temp = uu; 1181 Luu_temp = Luu_temp + length(NL); 1182 substr (uu_temp, length(uu_temp), length(NL)) = NL; 1183 call search_file_$silent (addr(substr(ss_info.field(If).to.string,1)), 1184 1, length(ss_info.field(If).to.string), addr(uu_temp), 1185 Istart, length(uu_temp), Iend, Imatch_end, code); 1186 go to END_LTH_TO_REGEXP; 1187 1188 LTH_TO_REGEXP(2): uul.L(Iu) = uul.L(Iu) + length(NL); 1189 LTH_TO_REGEXP(4): call search_file_$silent (addr(substr(ss_info.field(If).to.string,1)), 1190 1, length(ss_info.field(If).to.string), addr(uu), 1191 Istart, length(uu), Iend, Imatch_end, code); 1192 1193 END_LTH_TO_REGEXP: if code = 0 then do; 1194 Iend = Iend - 1; 1195 go to END_LTH_TO_FIELD; 1196 end; 1197 else if code = error_table_$nomatch then do; 1198 code = 0; 1199 go to LTH_EMPTY_FIELD; 1200 end; 1201 else do; 1202 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 1203 "Invalid syntax in regular expression: -field -to /^a/", 1204 ss_info.field(If).to.string); 1205 go to SORT_EXIT; 1206 end; 1207 1208 END_LTH_TO_FIELD: Lfield(If) = max(Lfield(If), Iend-Istart+1); 1209 LTH_EMPTY_FIELD: end; 1210 end; 1211 Lfield(ss_info.field_count+1) = length(stable); 1212 Lall_fields = sum(Lfield); 1213 end; 1214 1215 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1216 /* */ 1217 /* NORMAL FIELD PROCESSING (cont): */ 1218 /* 4) Copy each sort field from the uu into sf_str temp seg. */ 1219 /* 5) For non_case_sensitive fields, translate to lowercase as copied. */ 1220 /* 6) For descending fields, invert the bit string representation of the field copy. */ 1221 /* 7) For numeric fields, encode the character string representation of the field copy. */ 1222 /* 8) Set the sfp to point to the field. Fields for all units are the same length, */ 1223 /* Lall_fields, as computed above. */ 1224 /* 9) Add a stability field to the end of each copied unit. */ 1225 /* */ 1226 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1227 1228 if Snumeric then do; /* setup to handle a bad numeric conversion. */ 1229 on conversion begin; 1230 code = error_table_$bad_conversion; 1231 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 1232 "^/While encoding field ^d of ^[row^;block^] ^d: ^a^[^/(^a^[>^]^a)^]", If, (type=TABLE), Iu, 1233 substr(uu,Istart,Lmatch), (type = SEGMENT), in_dir, in_dir^=">", in_ent); 1234 go to SORT_EXIT; 1235 end; 1236 1237 on size begin; 1238 code = error_table_$out_of_bounds; 1239 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 1240 "^/While encoding field ^d of ^[row^;block^] ^d: ^a^[^/(^a^[>^]^a)^]", If, (type = TABLE), Iu, 1241 substr(uu,Istart,Lmatch), (type = SEGMENT), in_dir, in_dir^=">", in_ent); 1242 go to SORT_EXIT; 1243 end; 1244 end; 1245 1246 Isf_str = 1; 1247 case_field(*) = 0; 1248 do Iu = 1 to Nu; 1249 if (Isf_str-1) + Lall_fields > max_seg_size then do; 1250 Nsf_str_array = Nsf_str_array + 1; 1251 if ^get_temp_seg (id, "sort field strs", Psf_str) then goto SORT_EXIT; 1252 Psf_str_array(Nsf_str_array) = Psf_str; 1253 Isf_str = 1; 1254 end; 1255 (nostrz,nostrg,nosize,nosubrg): /* prefixes due to bug in PL/I */ 1256 sfp.P(Iu) = addr(sf_str_char(Isf_str)); 1257 do If = 1 to ss_info.field_count; 1258 go to SET_FROM_FIELD(ss_info.field(If).from.type); 1259 1260 SET_FROM_FIELD(2): Istart = ss_info.field(If).from.number; 1261 go to END_SET_FROM_FIELD; 1262 1263 SET_FROM_FIELD(3): Istart = index(uu, ss_info.field(If).from.string); 1264 if Istart = 0 then go to SET_EMPTY_FIELD; 1265 Istart = Istart + length(ss_info.field(If).from.string); 1266 go to END_SET_FROM_FIELD; 1267 1268 SET_FROM_FIELD(4): call search_file_$silent (addr(substr(ss_info.field(If).from.string,1)), 1269 1, length(ss_info.field(If).from.string), 1270 addr(uu), 1, length(uu), 1271 Istart, Imatch_end, code); 1272 if code = 0 then do; 1273 Lmatch = Imatch_end - Istart + 1; 1274 Istart = Istart + Lmatch; 1275 go to END_SET_FROM_FIELD; 1276 end; 1277 else if code = error_table_$nomatch then do; 1278 code = 0; 1279 go to SET_EMPTY_FIELD; 1280 end; 1281 else do; 1282 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 1283 "Invalid syntax in regular expression: -field -from /^a/", 1284 ss_info.field(If).from.string); 1285 go to SORT_EXIT; 1286 end; 1287 1288 END_SET_FROM_FIELD: 1289 if Istart > length(uu) then go to SET_EMPTY_FIELD; 1290 go to SET_TO_FIELD(ss_info.field(If).to.type); 1291 1292 SET_TO_FIELD(1): if ss_info.field(If).to.number = -1 then 1293 Iend = length(uu); 1294 else 1295 Iend = min(length(uu), (Istart-1) + ss_info.field(If).to.number); 1296 go to END_SET_TO_FIELD; 1297 1298 SET_TO_FIELD(2): Iend = min(ss_info.field(If).to.number, length(uu)); 1299 go to END_SET_TO_FIELD; 1300 1301 SET_TO_FIELD(3): Iend = index (substr(uu,Istart), ss_info.field(If).to.string); 1302 if Iend = 0 then go to SET_EMPTY_FIELD; 1303 Iend = Iend + (Istart-1) - 1; 1304 go to END_SET_TO_FIELD; 1305 1306 SET_TO_FIELD(4): go to SET_TO_REGEXP(case_regexp(If)); 1307 1308 SET_TO_REGEXP(1): Iend = length(uu); 1309 go to END_SET_TO_FIELD; 1310 1311 SET_TO_REGEXP(2): call search_file_$silent (addr(substr(ss_info.field(If).to.string,1)), 1312 1, length(ss_info.field(If).to.string), 1313 addr(uu), Istart, length(uu), 1314 Iend, Imatch_end, code); 1315 uul.L(Iu) = uul.L(Iu) - 1; 1316 go to END_SET_TO_REGEXP; 1317 1318 SET_TO_REGEXP(3): Luu_temp = uul.L(If); 1319 uu_temp = uu; 1320 Luu_temp = Luu_temp + length(NL); 1321 substr (uu_temp, length(uu_temp), length(NL)) = NL; 1322 call search_file_$silent (addr(substr(ss_info.field(If).to.string,1)), 1323 1, length(ss_info.field(If).to.string), addr(uu_temp), 1324 Istart, length(uu_temp), Iend, Imatch_end, code); 1325 go to END_SET_TO_REGEXP; 1326 1327 SET_TO_REGEXP(4): call search_file_$silent (addr(substr(ss_info.field(If).to.string,1)), 1328 1, length(ss_info.field(If).to.string), addr(uu), 1329 Istart, length(uu), Iend, Imatch_end, code); 1330 1331 END_SET_TO_REGEXP: if code = 0 then do; 1332 Iend = Iend - 1; 1333 go to END_SET_TO_FIELD; 1334 end; 1335 else if code = error_table_$nomatch then do; 1336 code = 0; 1337 go to SET_EMPTY_FIELD; 1338 end; 1339 else do; 1340 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 1341 "Invalid syntax in regular expression: -field -to /^a/", 1342 ss_info.field(If).to.string); 1343 go to SORT_EXIT; 1344 end; 1345 1346 END_SET_TO_FIELD: Lmatch = Iend-Istart+1; 1347 if Lmatch <= 0 then go to SET_EMPTY_FIELD; 1348 go to FIELD_TYPE(case_field(If)); 1349 1350 FIELD_TYPE(0): if ss_info.field(If).modes.non_case_sensitive & 1351 ^ss_info.field(If).modes.numeric & 1352 ^ss_info.field(If).modes.integer & 1353 ^ss_info.field(If).modes.descending then case_field(If) = 1; 1354 else 1355 if ^ss_info.field(If).modes.non_case_sensitive & 1356 ^ss_info.field(If).modes.numeric & 1357 ^ss_info.field(If).modes.integer & 1358 ss_info.field(If).modes.descending then case_field(If) = 2; 1359 else 1360 if ss_info.field(If).modes.non_case_sensitive & 1361 ^ss_info.field(If).modes.numeric & 1362 ^ss_info.field(If).modes.integer & 1363 ss_info.field(If).modes.descending then case_field(If) = 3; 1364 else 1365 if ss_info.field(If).modes.numeric & 1366 ^ss_info.field(If).modes.integer & 1367 ^ss_info.field(If).modes.descending then case_field(If) = 4; 1368 else 1369 if ss_info.field(If).modes.numeric & 1370 ^ss_info.field(If).modes.integer & 1371 ss_info.field(If).modes.descending then case_field(If) = 5; 1372 else 1373 if ss_info.field(If).modes.integer & 1374 ^ss_info.field(If).modes.numeric & 1375 ^ss_info.field(If).modes.descending then case_field(If) = 6; 1376 else 1377 if ss_info.field(If).modes.integer & 1378 ^ss_info.field(If).modes.numeric & 1379 ss_info.field(If).modes.descending then case_field(If) = 7; 1380 else case_field(If) = 8; 1381 go to FIELD_TYPE(case_field(If)); 1382 1383 FIELD_TYPE(1): substr(sf_str,Isf_str,Lfield(If)) = translate(substr(uu,Istart,Lmatch),az,AZ); 1384 go to NEXT_FIELD; 1385 1386 FIELD_TYPE(2): unspec(substr(sf_str,Isf_str,Lfield(If))) = ^unspec(substr(uu,Istart,Lmatch)); 1387 go to NEXT_FIELD; 1388 1389 FIELD_TYPE(3): substr(sf_str,Isf_str,Lfield(If)) = translate(substr(uu,Istart,Lmatch),az,AZ); 1390 unspec(substr(sf_str,Isf_str,Lfield(If))) = ^unspec(substr(sf_str,Isf_str,Lfield(If))); 1391 go to NEXT_FIELD; 1392 1393 FIELD_TYPE(4): if type = TABLE then call encode_numeric (addr(substr(uu,Istart,Lmatch)), (Lmatch), 1394 desc_array(If), addr(substr(sf_str, Isf_str, Lfield(If))), encd_len, code); 1395 else call encode_numeric (addr(substr(uu,Istart,Lmatch)), (Lmatch), 1396 addr(FLOAT_DEC_59_DESC), addr(substr(sf_str, Isf_str, Lfield(If))), encd_len, code); 1397 if code ^= 0 then do; 1398 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 1399 "^/While encoding field ^d of ^[row^;block^] ^d: ^a^[^/(^a^[>^]^a)^]", If, (type = TABLE), Iu, 1400 substr(uu,Istart,Lmatch), (type = SEGMENT), in_dir, in_dir^=">", in_ent); 1401 go to SORT_EXIT; 1402 end; 1403 go to NEXT_FIELD; 1404 1405 FIELD_TYPE(5): if type = TABLE then call encode_numeric (addr(substr(uu,Istart,Lmatch)), (Lmatch), 1406 desc_array(If), addr(encd_str), encd_len, code); 1407 else call encode_numeric (addr(substr(uu,Istart,Lmatch)), (Lmatch), 1408 addr(FLOAT_DEC_59_DESC), addr(encd_str), encd_len, code); 1409 if code ^= 0 then do; 1410 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 1411 "^/While encoding field ^d of ^[row^;block^] ^d: ^a^[^/(^a^[>^]^a)^]", If, (type = TABLE), Iu, 1412 substr(uu,Istart,Lmatch), (type = SEGMENT), in_dir, in_dir^=">", in_ent); 1413 go to SORT_EXIT; 1414 end; 1415 unspec(substr(sf_str,Isf_str,Lfield(If))) = ^unspec(substr(encd_str, 1, encd_len)); 1416 go to NEXT_FIELD; 1417 1418 FIELD_TYPE(6): call encode_numeric (addr(substr(uu,Istart,Lmatch)), (Lmatch), 1419 addr(FIXED_BIN_71_DESC), addr(substr(sf_str, Isf_str, Lfield(If))), encd_len, code); 1420 if code ^= 0 then do; 1421 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 1422 "^/While encoding field ^d of ^[row^;block^] ^d: ^a^[^/(^a^[>^]^a)^]", If, (type = TABLE), Iu, 1423 substr(uu,Istart,Lmatch), (type = SEGMENT), in_dir, in_dir^=">", in_ent); 1424 go to SORT_EXIT; 1425 end; 1426 go to NEXT_FIELD; 1427 1428 FIELD_TYPE(7): call encode_numeric (addr(substr(uu,Istart,Lmatch)), (Lmatch), 1429 addr(FIXED_BIN_71_DESC), addr(encd_str), encd_len, code); 1430 if code ^= 0 then do; 1431 call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 1432 "^/While encoding field ^d of ^[row^;block^] ^d: ^a^[^/(^a^[>^]^a)^]", If, (type = TABLE), Iu, 1433 substr(uu,Istart,Lmatch), (type = SEGMENT), in_dir, in_dir^=">", in_ent); 1434 go to SORT_EXIT; 1435 end; 1436 unspec(substr(sf_str,Isf_str,Lfield(If))) = ^unspec(substr(encd_str, 1, encd_len)); 1437 go to NEXT_FIELD; 1438 1439 FIELD_TYPE(8): substr(sf_str,Isf_str,Lfield(If)) = substr(uu,Istart,Lmatch); 1440 go to NEXT_FIELD; 1441 1442 SET_EMPTY_FIELD: if ss_info.field(If).modes.numeric then do; 1443 if type = TABLE then call encode_numeric (addr(ZERO), length(ZERO), desc_array(If), 1444 addr(substr(sf_str,Isf_str,Lfield(If))), Lfield(If), code); 1445 else call encode_numeric (addr(ZERO), length(ZERO), addr(FLOAT_DEC_59_DESC), 1446 addr(substr(sf_str,Isf_str,Lfield(If))), Lfield(If), code); 1447 end; 1448 else if ss_info.field(If).modes.integer then call encode_numeric (addr(ZERO), length(ZERO), 1449 addr(FIXED_BIN_71_DESC), addr(substr(sf_str,Isf_str,Lfield(If))), Lfield(If), code); 1450 else substr(sf_str,Isf_str,Lfield(If)) = ""; 1451 if ss_info.field(If).modes.descending then 1452 unspec(substr(sf_str,Isf_str,Lfield(If))) = ^unspec(substr(sf_str,Isf_str,Lfield(If))); 1453 1454 NEXT_FIELD: Isf_str = Isf_str + Lfield(If); 1455 end; 1456 substr(sf_str,Isf_str,Lfield(If)) = stable; 1457 Isf_str = Isf_str + Lfield(If); 1458 end; 1459 end; 1460 if Snumeric then revert conversion, size; /* threat of a bad numeric conversion is over. */ 1461 1462 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1463 /* */ 1464 /* SORT: */ 1465 /* 1) Let sort_items_indirect_ compare sort fields or units, and rearrange unit indices */ 1466 /* (idx). */ 1467 /* */ 1468 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1469 1470 if Sfield then do; /* Sort with fields. */ 1471 sfp.N = Nu; 1472 call sort_items_indirect_$char (addr(sfp), addr(idx), Lall_fields); 1473 end; 1474 else if Snon_case_sensitive_sort then do; /* Simple sort with translation to lower case. */ 1475 sfp.N = Nu; 1476 sfl.N = Nu; 1477 call sort_items_indirect_$adj_char (addr(sfp), addr(idx), addr(sfl)); 1478 end; 1479 else do; /* Sblocked or ^Sblocked (simple sort) */ 1480 uup.N = Nu; 1481 uul.N = Nu; 1482 call sort_items_indirect_$adj_char (addr(uup), addr(idx), addr(uul)); 1483 end; 1484 1485 1486 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1487 /* */ 1488 /* DEBUGGING CODE: */ 1489 /* For each sort unit, print: sort index, unit number, du, uu and sf (if different from */ 1490 /* uu). */ 1491 /* */ 1492 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1493 1494 if Sdebug then do; 1495 if Sfield then do; 1496 call ioa_ ("Lall_fields = ^d, Lfields =^( ^d^)", Lall_fields, Lfield); 1497 Luu_longest = 0; 1498 do Iu = 1 to Nu; 1499 Puu_text = addr(uu); 1500 Luu_text = length(uu); 1501 do while (find_uu_line()); 1502 Luu_longest = max(Luu_longest, length(uu_line)); 1503 end; 1504 end; 1505 end; 1506 Ldu_longest = 0; 1507 do Iu = 1 to Nu; 1508 Ldu = dul.L(Iu) + Ldelim; 1509 if substr(du,Ldu,1) = NL then 1510 Ldu = Ldu - 1; 1511 Pdu_text = addr(du); 1512 Ldu_text = Ldu; 1513 do while (find_du_line()); 1514 Ldu_longest = max(Ldu_longest, length(du_line)); 1515 end; 1516 end; 1517 do Iu = 1 to Nu; 1518 do Ix = 1 to Nu while(idx.I(Ix) ^= Iu); 1519 end; 1520 Ldu = dul.L(Iu) + Ldelim; 1521 if substr(du,Ldu,1) = NL then 1522 Ldu = Ldu - 1; 1523 Idu_nl = index(du, NL); 1524 Iuu_nl = index(uu, NL); 1525 if Sfield then do; 1526 Isf_nl = index(sf, NL); 1527 if Idu_nl + Iuu_nl + Isf_nl = 0 then 1528 call ioa_ ("^4d - ^4d| ""^a""^vx | ""^a""^vx | ""^a""", 1529 Ix, Iu, du, Ldu_longest-Ldu, 1530 uu, Luu_longest-length(uu), 1531 substr(sf,1,Lall_fields-4)); 1532 else do; 1533 Pdu_text = addr(du); 1534 Ldu_text = Ldu; 1535 Puu_text = addr(uu); 1536 Luu_text = length(uu); 1537 Psf_text = addr(sf); 1538 Lsf_text = Lall_fields-4; 1539 Idu, Iuu, Iss = 1; 1540 do while (find_du_line() | find_uu_line() | find_sf_line()); 1541 call ioa_ ("^[^4d - ^4d^;^12t^2s^]^2(| ^[""^; ^]^[^s^a""^vx^;^va ^s^] ^)| ^[""^; ^]^a^[""^]", 1542 Idu = 1, Ix, Iu, 1543 Idu = 1, length(du_line)>0 & length(du_text)=0, 1544 Ldu_longest, du_line, Ldu_longest-length(du_line), 1545 Iuu = 1, length(uu_line)>0 & length(uu_text)=0, 1546 Luu_longest, uu_line, Luu_longest-length(uu_line), 1547 Iss=1, sf_line, length(sf_line)>0 & length(sf_text)=0); 1548 Idu, Iuu, Iss = 0; 1549 end; 1550 end; 1551 end; 1552 else do; 1553 if Idu_nl + Iuu_nl = 0 then 1554 call ioa_ ("^4d - ^4d| ""^a""^vx | ""^a""", 1555 Ix, Iu, du, Ldu_longest - Ldu, uu); 1556 else do; 1557 Pdu_text = addr(du); 1558 Ldu_text = Ldu; 1559 Puu_text = addr(uu); 1560 Luu_text = length(uu); 1561 Idu, Iuu = 1; 1562 do while (find_du_line() | find_uu_line()); 1563 call ioa_ ("^[^4d - ^4d| ""^;^12t| ^2s^]^[^s^a""^vx^;^va ^s^] | ^[""^; ^]^a^[""^]", 1564 Idu = 1, Ix, Iu, 1565 length(du_line)>0 & length(du_text)=0, 1566 Ldu_longest, du_line, Ldu_longest-length(du_line), 1567 Iuu = 1, uu_line, length(uu_line)>0 & length(uu_text)=0); 1568 Idu, Iuu = 0; 1569 end; 1570 end; 1571 end; 1572 end; 1573 end; 1574 SORT_EXIT: 1575 if code ^= 0 then call sort_janitor(); 1576 return; 1577 end sort; 1578 1579 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1580 1581 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1582 1583 merge: proc (); 1584 1585 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1586 /* */ 1587 /* MERGE THE SORTED COMPONENTS: */ 1588 /* */ 1589 /* Initialize Imerge and component_idx array to 1. */ 1590 /* Then until merging is complete (all components are exhausted): */ 1591 /* 1) Compare the sort field at current component_idx for each component to that of */ 1592 /* the Imerge component. Set Imerge to the component number of the lowest. */ 1593 /* 2) Add the row ptr of this component's current component_idx to the output. */ 1594 /* 3) Increment this component's component_idx. */ 1595 /* 4) Find the lowest component which isn't completely merged. Set Imerge. */ 1596 /* 5) Repeat. */ 1597 /* */ 1598 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1599 1600 1601 dcl component_idx (spp.M) fixed bin(21); 1602 1603 Iseg = 1; /* init to first output seg */ 1604 Psupo = sppo.P(1); 1605 supo.N = 0; /* this output seg is empty */ 1606 1607 max_ptrs_per_seg = sys_info$max_seg_size - currentsize(supo); 1608 component_idx(*) = 1; /* set all indices to 1 */ 1609 Imerge = 1; /* assume the first component is lowest to start */ 1610 do while (Imerge <= spp.M); 1611 Pidx_merge = save.idx_ptr(Imerge); 1612 Psfp_merge = save.sfp_ptr(Imerge); 1613 Psf_merge = sfp_merge.P(idx_merge.I(component_idx(Imerge))); 1614 1615 do Iu = Imerge + 1 to spp.M; /* find the next lowest component to merge */ 1616 Pidx1 = save.idx_ptr(Iu); 1617 if (component_idx(Iu) <= idx1.N) then do; 1618 Psfp1 = save.sfp_ptr(Iu); 1619 Psf1 = sfp1.P (idx1.I (component_idx(Iu))); 1620 if sf1 < sf_merge then do; 1621 Pidx_merge = Pidx1; 1622 Psfp_merge = Psfp1; 1623 Psf_merge = Psf1; 1624 Imerge = Iu; 1625 end; 1626 end; 1627 end; 1628 1629 if supo.N = max_ptrs_per_seg then do; /* this output seg is full */ 1630 if Iseg = sppo.N then do; /* whoops, can't have more than we're given */ 1631 code = error_table_$file_is_full; 1632 goto MERGE_EXIT; 1633 end; 1634 Iseg = Iseg + 1; /* start a new output seg */ 1635 Psupo = sppo.P(Iseg); 1636 supo.N = 0; /* this seg is empty */ 1637 end; 1638 1639 supo.N = supo.N + 1; /* put this row in output */ 1640 Pdup = save.dup_ptr(Imerge); 1641 supo.P(supo.N) = dup.P(idx_merge.I(component_idx(Imerge))); 1642 1643 if Sdebug then 1644 call ioa_ ("^2d, ^6d: ^a", Imerge, component_idx(Imerge),sf_merge); 1645 1646 component_idx (Imerge) = 1647 component_idx (Imerge) + 1; /* mark this row as used */ 1648 1649 1650 do Imerge = 1 to spp.M /* find a component which isn't done */ 1651 while (component_idx(Imerge) > save.idx_ptr(Imerge) -> idx_merge.N); 1652 end; 1653 1654 end; 1655 MERGE_EXIT: 1656 end merge; 1657 1658 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1659 output: proc (); 1660 1661 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1662 /* */ 1663 /* COPY SORTED INPUT TO OUTPUT */ 1664 /* 1) Copy du's in sort order into output string. */ 1665 /* 2) As part of copying, take duplicate_mode into account. The mode can be-- */ 1666 /* -duplicates = copy all units in sort order */ 1667 /* -unique = copy all unique units and first copy of each duplicated unit, in sort */ 1668 /* order */ 1669 /* -only_duplicates = copy only first of each set of duplicate units, in sort order. */ 1670 /* Unique units are NOT copied. */ 1671 /* -only_duplicate_keys = copy only units whose sort fields duplicate those of */ 1672 /* another unit. Units with unique sort fields are NOT copied. */ 1673 /* -unique_keys = copy only units whose sort fields do NOT duplicate those oo any */ 1674 /* other unit. */ 1675 /* -only_unique = copy only units which are not duplicated. */ 1676 /* -only_unique_keys = copy only units whose keys are not duplicated in other units. */ 1677 /* */ 1678 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1679 1680 Lout = 0; 1681 Iu_prev = 0; 1682 Ndups = 0; 1683 Ndups_prev = 0; 1684 if Sfield then 1685 Lall_fields = Lall_fields - 4; /* Remove stability indicator. */ 1686 do Ix = 1 to idx.N by 1 while (^Sdescending_sort), 1687 idx.N to 1 by -1 while (Sdescending_sort); 1688 Iu = idx.I(Ix); 1689 Ldu = dul.L(Iu) + Ldelim; 1690 go to DUP(ss_info.duplicate_mode); 1691 1692 DUP(1): substr(out, Lout+1, Ldu) = du; /* SS_duplicate */ 1693 Lout = Lout + Ldu; 1694 go to END_DUP; 1695 1696 DUP(2): if Iu_prev > 0 then /* SS_unique */ 1697 if Ldu_prev = Ldu then 1698 if du_prev = du then go to END_DUP_SET_PREV; 1699 substr(out, Lout+1, Ldu) = du; 1700 Lout = Lout + Ldu; 1701 go to END_DUP_SET_PREV; 1702 1703 DUP(3): if Iu_prev > 0 then do; /* SS_only_duplicates */ 1704 if Snon_case_sensitive_sort then do; 1705 if Ldu_prev = Ldu then 1706 if sfp.P(Iu_prev)->du_prev = sfp.P(Iu)->du then 1707 Ndups = Ndups + 1; 1708 else Ndups = 0; 1709 else Ndups = 0; 1710 end; 1711 else do; 1712 if Ldu_prev = Ldu then 1713 if du_prev = du then Ndups = Ndups + 1; 1714 else Ndups = 0; 1715 else Ndups = 0; 1716 end; 1717 if Ndups = 1 then do; 1718 substr(out, Lout+1, Ldu_prev) = du_prev; 1719 Lout = Lout + Ldu_prev; 1720 end; 1721 end; 1722 go to END_DUP_SET_PREV; 1723 1724 DUP(4): if ^Sfield then go to DUP(3); /* SS_only_duplicate_keys */ 1725 if Iu_prev > 0 then do; 1726 if Sfield then 1727 if sf_prev = sf then Ndups = Ndups + 1; 1728 else Ndups = 0; 1729 else do; 1730 if Snon_case_sensitive_sort then do; 1731 if Ldu_prev = Ldu then 1732 if sfp.P(Iu_prev)->du_prev = sfp.P(Iu)->du then 1733 Ndups = Ndups + 1; 1734 else Ndups = 0; 1735 else Ndups = 0; 1736 end; 1737 else do; 1738 if Ldu_prev = Ldu then 1739 if du_prev = du then Ndups = Ndups + 1; 1740 else Ndups = 0; 1741 else Ndups = 0; 1742 end; 1743 end; 1744 if Ndups = 1 then do; 1745 substr(out, Lout+1, Ldu_prev) = du_prev; 1746 Lout = Lout + Ldu_prev; 1747 end; 1748 if Ndups > 0 then do; 1749 substr(out, Lout+1, Ldu) = du; 1750 Lout = Lout + Ldu; 1751 end; 1752 end; 1753 go to END_DUP_SET_PREV; 1754 1755 DUP(5): if ^Sfield & ^Snon_case_sensitive_sort then go to DUP(2); 1756 if Iu_prev > 0 then do; /* SS_unique_keys */ 1757 if Snon_case_sensitive_sort then do; 1758 if Ldu_prev = Ldu then 1759 if sfp.P(Iu_prev)->du_prev = sfp.P(Iu)->du then 1760 Ndups = Ndups + 1; 1761 else Ndups = 0; 1762 else Ndups = 0; 1763 end; 1764 else do; 1765 if sf_prev = sf then Ndups = Ndups + 1; 1766 else Ndups = 0; 1767 end; 1768 end; 1769 if Ndups = 0 then do; 1770 substr(out, Lout+1, Ldu) = du; 1771 Lout = Lout + Ldu; 1772 end; 1773 go to END_DUP_SET_PREV; 1774 1775 DUP(6): if Iu_prev > 0 then do; /* SS_only_unique */ 1776 if Snon_case_sensitive_sort then do; 1777 if Ldu_prev = Ldu then 1778 if sfp.P(Iu_prev)->du_prev = sfp.P(Iu)->du then 1779 Ndups = Ndups + 1; 1780 else Ndups = 0; 1781 else Ndups = 0; 1782 end; 1783 else do; 1784 if Ldu_prev = Ldu then 1785 if du_prev = du then Ndups = Ndups + 1; 1786 else Ndups = 0; 1787 else Ndups = 0; 1788 end; 1789 if Ndups = 0 & Ndups_prev = 0 then do; 1790 substr(out, Lout+1, Ldu_prev) = du_prev; 1791 Lout = Lout + Ldu_prev; 1792 end; 1793 end; 1794 if Ndups = 0 & ((Ix = idx.N & ^Sdescending_sort) | (Ix = 1 & Sdescending_sort)) then do; 1795 substr(out, Lout+1, Ldu) = du; 1796 Lout = Lout + Ldu; 1797 end; 1798 Ndups_prev = Ndups; 1799 go to END_DUP_SET_PREV; 1800 1801 DUP(7): if ^Sfield then go to DUP(6); /* SS_only_unique_keys */ 1802 if Iu_prev > 0 then do; 1803 if Sfield then 1804 if sf_prev = sf then Ndups = Ndups + 1; 1805 else Ndups = 0; 1806 else do; 1807 if Snon_case_sensitive_sort then do; 1808 if Ldu_prev = Ldu then 1809 if sfp.P(Iu_prev)->du_prev = sfp.P(Iu)->du then 1810 Ndups = Ndups + 1; 1811 else Ndups = 0; 1812 else Ndups = 0; 1813 end; 1814 else do; 1815 if Ldu_prev = Ldu then 1816 if du_prev = du then Ndups = Ndups + 1; 1817 else Ndups = 0; 1818 else Ndups = 0; 1819 end; 1820 end; 1821 if Ndups = 0 & Ndups_prev = 0 then do; 1822 substr(out, Lout+1, Ldu_prev) = du_prev; 1823 Lout = Lout + Ldu_prev; 1824 end; 1825 end; 1826 if Ndups = 0 & ((Ix = idx.N & ^Sdescending_sort) | (Ix = 1 & Sdescending_sort)) then do; 1827 substr(out, Lout+1, Ldu) = du; 1828 Lout = Lout + Ldu; 1829 end; 1830 Ndups_prev = Ndups; 1831 go to END_DUP_SET_PREV; 1832 1833 END_DUP_SET_PREV: 1834 Iu_prev = Iu; 1835 Ldu_prev = Ldu; 1836 1837 END_DUP: end; 1838 1839 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1840 /* */ 1841 /* FINISH PROCESSING: */ 1842 /* 1) If undelimited chars appeared at end of input, copy them exactly to end of output */ 1843 /* segment. Adjust undelimited char index because length of output may be less than */ 1844 /* length of input (due to -unique, etc). */ 1845 /* 2) If input and output strings are overlapping, copy output from temp seg in which we */ 1846 /* placed it originally into the final output string. */ 1847 /* */ 1848 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1849 1850 if undelim_char_index > 0 then do; 1851 substr(out, Lout+1, length(in)-(undelim_char_index-1)) = 1852 substr(in, undelim_char_index); 1853 Lout = Lout + length(in)-(undelim_char_index-1); 1854 undelim_char_index = Lout + 1 - (length(in)-(undelim_char_index-1)); 1855 end; 1856 1857 if Soverlap then do; 1858 substr(Pout_real -> out, 1, Lout) = substr(out, 1, Lout); 1859 Pout = Pout_real; 1860 end; 1861 out_len = Lout; 1862 end output; 1863 1864 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1865 1866 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1867 1868 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1869 /* */ 1870 /* DEBUGGING DECLARATIONS AND FUNCTIONS */ 1871 /* */ 1872 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1873 1874 dcl (Idu_nl, Iuu_nl, Isf_nl) fixed bin(21), 1875 Ldu_line fixed bin(21), 1876 Ldu_longest fixed bin(21), 1877 Ldu_text fixed bin(21), 1878 Lsf_line fixed bin(21), 1879 Lsf_text fixed bin(21), 1880 Luu_line fixed bin(21), 1881 Luu_longest fixed bin(21), 1882 Luu_text fixed bin(21), 1883 Pdu_line ptr, 1884 Pdu_text ptr, 1885 Psf_line ptr, 1886 Psf_text ptr, 1887 Puu_line ptr, 1888 Puu_text ptr, 1889 du_line char(Ldu_line) based(Pdu_line), 1890 du_text char(Ldu_text) based(Pdu_text), 1891 du_text_char (Ldu_text) char(1) based(Pdu_text), 1892 sf_line char(Lsf_line) based(Psf_line), 1893 sf_text char(Lsf_text) based(Psf_text), 1894 sf_text_char (Lsf_text) char(1) based(Psf_text), 1895 uu_line char(Luu_line) based(Puu_line), 1896 uu_text char(Luu_text) based(Puu_text), 1897 uu_text_char (Luu_text) char(1) based(Puu_text); 1898 1899 find_du_line: 1900 proc returns(bit(1)); 1901 1902 Pdu_line = addr(du_text); 1903 Ldu_line = index(du_text, NL); 1904 if Ldu_line = 0 then Ldu_line = length(du_text); 1905 if length(du_line) > 0 then do; 1906 Pdu_text = addr(du_text_char(Ldu_line+1)); 1907 Ldu_text = Ldu_text - Ldu_line; 1908 if substr(du_line,length(du_line),1) = NL then 1909 Ldu_line = Ldu_line - 1; 1910 return(TRUE); 1911 end; 1912 else 1913 return(FALSE); 1914 1915 find_uu_line: 1916 entry returns(bit(1)); 1917 1918 Puu_line = addr(uu_text); 1919 Luu_line = index(uu_text, NL); 1920 if Luu_line = 0 then Luu_line = length(uu_text); 1921 if length(uu_line) > 0 then do; 1922 Puu_text = addr(uu_text_char(Luu_line+1)); 1923 Luu_text = Luu_text - Luu_line; 1924 if substr(uu_line,length(uu_line),1) = NL then 1925 Luu_line = Luu_line - 1; 1926 return(TRUE); 1927 end; 1928 else 1929 return(FALSE); 1930 1931 find_sf_line: 1932 entry returns(bit(1)); 1933 1934 Psf_line = addr(sf_text); 1935 Lsf_line = index(sf_text, NL); 1936 if Lsf_line = 0 then Lsf_line = length(sf_text); 1937 if length(sf_line) > 0 then do; 1938 Psf_text = addr(sf_text_char(Lsf_line+1)); 1939 Lsf_text = Lsf_text - Lsf_line; 1940 if substr(sf_line,length(sf_line),1) = NL then 1941 Lsf_line = Lsf_line - 1; 1942 return(TRUE); 1943 end; 1944 else 1945 return(FALSE); 1946 1947 end find_du_line; 1948 1949 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1950 1951 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1952 1953 1954 get_temp_seg: 1955 proc (caller, seg_id, Ptemp) returns (bit(1) aligned); 1956 1957 dcl caller char(*) varying, 1958 code fixed bin(35), 1959 seg_id char(*), 1960 Ptemp ptr; 1961 1962 dcl get_temp_segment_ entry (char(*), ptr, fixed bin(35)), 1963 release_temp_segment_ entry (char(*), ptr, fixed bin(35)); 1964 1965 if Stemp_dir then call temp_seg_mgr$get (lcb_ptr, caller || "(" || seg_id || ")", temp_dir, Ptemp, code); 1966 else call get_temp_segment_ (caller || "(" || seg_id || ")", Ptemp, code); 1967 1968 if code ^= 0 then call sub_err_ (code, caller, ACTION_DEFAULT_RESTART, null, 0, 1969 "While getting temporary segments for sort workspace."); 1970 return (code = 0); 1971 1972 release_temp_seg: 1973 entry (caller, seg_id, Ptemp); 1974 1975 if Stemp_dir then call temp_seg_mgr$release (lcb_ptr, caller || "(" || seg_id || ")", Ptemp, 0); 1976 else call release_temp_segment_ (caller || "(" || seg_id || ")", Ptemp, 0); 1977 end get_temp_seg; 1978 1979 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1980 1981 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1982 seg_janitor: 1983 proc(termination_mode, Sdelete_output_file); 1984 1985 dcl termination_mode bit(*), 1986 Sdelete_output_file bit(1); 1987 1988 dcl code fixed bin(35); 1989 1990 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1991 /* */ 1992 /* ORDER OF OPERATION IN CLEANUP IS CRITICAL: */ 1993 /* 1) Must first terminate input segment. Since input and output segments may have been */ 1994 /* the same, forcing access to the output segment may have given us r access to input. */ 1995 /* So therefore, input must be terminated before any forced access is removed. */ 1996 /* 2) Then terminate (or delete) output segment, since successful setting of bit count */ 1997 /* and truncation depend upon any forced access. */ 1998 /* 3) Finally, restore any ACL changes made by forcing access. */ 1999 /* */ 2000 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2001 2002 call sort_janitor(); 2003 2004 if Pin ^= null then 2005 call terminate_file_ (Pin, 0, TERM_FILE_TERM, code); 2006 if Pout ^= null then do; 2007 if Sdelete_output_file then /* We created output file and sort failed, so */ 2008 call hcs_$delentry_seg (Pout, code); /* we must delete it. */ 2009 else 2010 call terminate_file_ (Pout, out_len*9, termination_mode, code); 2011 end; 2012 if Paccess ^= null then /* If we created output file and sort failed, */ 2013 call access_$reset (Paccess, code); /* access will never have been forced. */ 2014 2015 end seg_janitor; 2016 2017 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2018 2019 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2020 2021 2022 sort_janitor: 2023 proc(); 2024 2025 if Soverlap then do; 2026 if Pout = Pout_temp then 2027 Pout = Pout_real; 2028 call release_temp_seg (id, "temp output seg", Pout_temp); 2029 end; 2030 if Puup = Pdup then 2031 Puup = null; 2032 if Puu_str = addr(in) then 2033 Puu_str = null; 2034 if Pdul = Puul then 2035 Pdul = null; 2036 call release_temp_seg (id, "sort indices", Pidx); 2037 call release_temp_seg (id, "delim unit ptrs", Pdup); 2038 call release_temp_seg (id, "delim unit lths", Pdul); 2039 if Psf_str_array(Nsf_str_array) = null then 2040 Psf_str_array(Nsf_str_array) = Psf_str; 2041 do Isf_str = 1 to Nsf_str_array; 2042 Psf_str = Psf_str_array(Isf_str); 2043 call release_temp_seg (id, "sort field strs", Psf_str); 2044 end; 2045 call release_temp_seg (id, "sort field ptrs", Psfp); 2046 call release_temp_seg (id, "sort field lths", Psfl); 2047 call release_temp_seg (id, "undelim unit strs", Puu_str); 2048 call release_temp_seg (id, "undelim unit ptrs", Puup); 2049 call release_temp_seg (id, "undelim unit lths", Puul); 2050 call release_temp_seg (id, "undelim temp strs", Puu_temp); 2051 2052 end sort_janitor; 2053 2054 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2055 table_janitor: 2056 proc(); 2057 2058 if Psave ^= null & component_number > 0 then do; 2059 if Pdup = save.dup_ptr(component_number) then 2060 save.dup_ptr (component_number) = null; 2061 if Pidx = save.idx_ptr(component_number) then 2062 save.idx_ptr (component_number) = null; 2063 if Psfp = save.sfp_ptr(component_number) then 2064 save.sfp_ptr (component_number) = null; 2065 do Its = 1 to save.Nsf_strs; 2066 do Isf_str = 1 to Nsf_str_array; 2067 if save.sf_str_ptr(Its) = Psf_str_array(Isf_str) then 2068 save.sf_str_ptr(Its) = null; 2069 end; 2070 end; 2071 end; 2072 2073 call sort_janitor(); 2074 2075 if Psave = null then return; 2076 do Its = 1 to component_number; /* cleanup */ 2077 Pdup = save.dup_ptr(Its); 2078 Pidx = save.idx_ptr(Its); 2079 Psfp = save.sfp_ptr(Its); 2080 call release_temp_seg (id, "delim unit ptrs", Pdup); 2081 call release_temp_seg (id, "sort indices", Pidx); 2082 call release_temp_seg (id, "sort field ptrs", Psfp); 2083 end; 2084 2085 do Its = 1 to save.Nsf_strs; 2086 Psf_str = save.sf_str_ptr(Its); 2087 call release_temp_seg (id, "sort field strs", Psf_str); 2088 end; 2089 2090 call release_temp_seg (id, "saved sort ptrs", Psave); 2091 2092 end table_janitor; 2093 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2094 2095 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2096 2097 encode_numeric: proc (src_ptr, src_len, dp, encd_ptr, encd_len, code); 2098 2099 2100 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2101 /* */ 2102 /* This procedure encodes a source value to form a key. All supported data types are */ 2103 /* encoded in such a fashion that order is preserved. This allows true numeric sorting */ 2104 /* on the resulting key. This code was "borrowed" from mrds mu_encd_key.pl1. */ 2105 /* */ 2106 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2107 2108 2109 dcl dp ptr parm; /* Input: original data descriptor ptr */ 2110 dcl (bit_length, pad_length)fixed bin (35); 2111 dcl code fixed bin (35) parm;/* Output: status code */ 2112 2113 /* max bits allowed in encoded string */ 2114 2115 dcl (src_ptr, /* ptr to a source value */ 2116 cp_ptr) ptr; /* pointer to current position in key */ 2117 2118 dcl (j, /* index */ 2119 offset, /* current bit position in key */ 2120 p) fixed bin; /* precision of value */ 2121 2122 dcl encd_len fixed bin (21); /* char. length of key */ 2123 dcl encd_ptr ptr; /* Output: ptr to encoded value */ 2124 dcl (power_delta, /* increase in exp. for normaliz. */ 2125 shift_delta) fixed bin (7); /* no chars to shift for norm. */ 2126 dcl fb7 fixed bin (7) based unal; /* template */ 2127 dcl fb8 fixed bin (8) based unal unsigned; /* template */ 2128 dcl 1 fxb unal based (src_ptr), /* fixed bin template */ 2129 2 sign bit (1) unal, 2130 2 val bit (p) unal; 2131 2132 dcl 1 flb_src unal based (src_ptr), /* template for source float bin */ 2133 2 esign bit (1) unal, 2134 2 eval bit (7) unal, 2135 2 msign bit (1) unal, 2136 2 mval bit (p) unal; 2137 2138 dcl 1 flb_enc unal based (cp_ptr), /* template for encoded float bin */ 2139 2 msign bit (1) unal, 2140 2 esign bit (1) unal, 2141 2 eval bit (7) unal, 2142 2 mval bit (p) unal; 2143 2144 dcl 1 fxd unal based (src_ptr), /* template for fixed dec. */ 2145 2 sign char (1) unal, 2146 2 digit (p) pic "9" unal; 2147 2148 dcl 1 fld_src unal based (src_ptr), /* template for float dec source */ 2149 2 msign char (1) unal, 2150 2 digit (p) pic "9" unal, 2151 2 epad bit (1) unal, 2152 2 esign bit (1) unal, 2153 2 eval bit (7) unal; 2154 2155 dcl 1 fld_enc unal based (cp_ptr), /* template for float dec encoded */ 2156 2 msign char (1) unal, 2157 2 epad bit (1) unal, 2158 2 esign bit (1) unal, 2159 2 eval bit (7) unal, 2160 2 digit (p) pic "9" unal; 2161 2162 dcl 01 odd_fxd4_src based (src_ptr), 2163 02 pad1 bit (1) unal, 2164 02 sign bit (4) unal, 2165 02 digits bit (digit_len) unal; 2166 2167 dcl 01 even_fxd4_src based (src_ptr), 2168 02 pad1 bit (1) unal, 2169 02 sign bit (4) unal, 2170 02 digits bit (digit_len) unal, 2171 02 pad2 bit (4) unal; 2172 2173 dcl 01 odd_fxd4_enc based (cp_ptr), 2174 02 pad1 bit (1) unal init ("0"b), 2175 02 sign bit (4) unal, 2176 02 digits bit (digit_len) unal; 2177 2178 dcl 01 even_fxd4_enc based (cp_ptr), 2179 02 pad1 bit (1) unal init ("0"b), 2180 02 pad2 bit (4) unal init ("0"b), 2181 02 sign bit (4) unal, 2182 02 digits bit (digit_len) unal; 2183 2184 dcl 01 even_fld4_src based (src_ptr), 2185 02 pad1 bit (1) unal, 2186 02 sign bit (4) unal, 2187 02 digits bit (digit_len) unal, 2188 02 exp, 2189 03 sign bit (1) unal, 2190 03 high bit (3) unal, 2191 03 pad2 bit (1) unal, 2192 03 low bit (4) unal, 2193 03 pad3 bit (4) unal; 2194 2195 dcl 01 odd_fld4_src based (src_ptr), 2196 02 pad1 bit (1) unal, 2197 02 sign bit (4) unal, 2198 02 digits bit (digit_len) unal, 2199 02 exp, 2200 03 pad2 bit (1) unal, 2201 03 sign bit (1) unal, 2202 03 exp bit (7) unal; 2203 2204 dcl 01 odd_fld4_enc based (cp_ptr), 2205 02 pad1 bit (1) unal init ("0"b), 2206 02 pad2 bit (1) unal init ("0"b), 2207 02 sign bit (4) unal, 2208 02 esign bit (1) unal, 2209 02 exp bit (7) unal, 2210 02 digits bit (digit_len) unal; 2211 2212 dcl 01 even_fld4_enc based (cp_ptr), 2213 02 pad1 bit (1) unal init ("0"b), 2214 02 pad2 bit (1) unal init ("0"b), 2215 02 pad3 bit (4) unal init ("0"b), 2216 02 sign bit (4) unal, 2217 02 esign bit (1) unal, 2218 02 exp bit (7) unal, 2219 02 digits bit (digit_len) unal; 2220 2221 dcl digit_len fixed bin; 2222 2223 dcl (mdbm_error_$unsup_type, 2224 mdbm_error_$key_encd_ovfl) fixed bin (35) ext; 2225 2226 dcl valid_decimal_ entry (fixed bin, ptr, fixed bin) returns (bit (1)); 2227 dcl mdbm_error_$invalid_dec_data fixed bin (35) ext; 2228 2229 dcl assign_ entry (ptr, fixed bin, fixed bin(35), ptr, fixed bin, fixed bin(35)); 2230 dcl org_ptr ptr; 2231 dcl org_data fixed dec(59); 2232 dcl org_type fixed bin; 2233 dcl char_type fixed bin init(42) int static options (constant); /* char_dtype * 2 */ 2234 2235 dcl org_len fixed bin (35); 2236 dcl src_len fixed bin (21); 2237 dcl target_len_ptr ptr; 2238 dcl 1 target_len aligned based (target_len_ptr), 2239 2 scale fixed bin(17) unaligned, 2240 2 prec fixed bin(18) unsigned unaligned; 2241 2242 cp_ptr = encd_ptr; 2243 desc_ptr = dp; 2244 2245 /* since we are given only character values, 2246* we must convert back to the original type */ 2247 org_ptr = addr(org_data); 2248 org_type = descriptor.type * 2; 2249 if descriptor.packed then org_type = org_type + 1; 2250 2251 target_len_ptr = addr(org_len); 2252 target_len.prec = fixed(descriptor.size.precision); 2253 target_len.scale = fixed(descriptor.size.scale); 2254 2255 call assign_ (org_ptr, org_type, org_len, 2256 src_ptr, char_type, (src_len)); 2257 2258 src_ptr = org_ptr; 2259 go to encode (descriptor.type); /* go encode this value */ 2260 2261 encode (1): /* fixed bin short */ 2262 if descriptor.packed then p = fixed (descriptor.size.precision); 2263 else p = 35; 2264 call encode_fxb; 2265 go to next; 2266 2267 encode (2): /* fixed bin long */ 2268 if descriptor.packed then p = fixed (descriptor.size.precision); 2269 else p = 71; 2270 call encode_fxb; 2271 go to next; 2272 2273 encode (3): /* float bin short */ 2274 if descriptor.packed then p = fixed (descriptor.size.precision); 2275 else p = 27; 2276 call encode_flb; 2277 go to next; 2278 2279 encode (4): /* float bin long */ 2280 if descriptor.packed then p = fixed (descriptor.size.precision); 2281 else p = 63; 2282 call encode_flb; 2283 go to next; 2284 2285 encode (5): /* complex fixed bin short */ 2286 encode (6): /* complex fixed bin long */ 2287 encode (7): /* complex float bin short */ 2288 encode (8): /* complex float bin long */ 2289 call error (mdbm_error_$unsup_type); 2290 2291 encode (9): /* real fixed decimal */ 2292 p = fixed (descriptor.size.precision); /* will always pack */ 2293 if fxd.sign = "+" then cp_ptr -> fxd.sign = "p"; /* change sign to preserve order */ 2294 else cp_ptr -> fxd.sign = "n"; 2295 if fxd.sign = "-" then /* if negative no, take 9's compl. */ 2296 do j = 1 to p; 2297 cp_ptr -> fxd.digit (j) = 9 - fxd.digit (j); 2298 end; 2299 else do j = 1 to p; /* if positive, just copy digits */ 2300 cp_ptr -> fxd.digit (j) = fxd.digit (j); 2301 end; 2302 offset = 9 * (p + 1); 2303 go to next; 2304 2305 encode (10): /* real float decimal */ 2306 p = fixed (descriptor.size.precision); 2307 call encode_fld; 2308 offset = 9 * (p + 2); 2309 go to next; 2310 2311 encode (11): /* complex fixed decimal */ 2312 encode (12): /* complex float decimal */ 2313 encode (13): /* unsupported types */ 2314 encode (14): 2315 encode (15): 2316 encode (16): 2317 encode (17): 2318 encode (18): 2319 encode (19): /* bit string */ 2320 encode (21): /* char. string */ 2321 encode (22): /* varying char. string */ 2322 encode (23): 2323 encode (24): 2324 encode (25): 2325 encode (26): 2326 encode (27): 2327 encode (28): 2328 encode (29): 2329 encode (30): 2330 encode (31): 2331 encode (32): 2332 encode (33): 2333 encode (34): 2334 encode (35): 2335 encode (36): 2336 encode (37): 2337 encode (38): 2338 encode (39): 2339 encode (40): 2340 encode (41): 2341 encode (42): 2342 call error (mdbm_error_$unsup_type); 2343 2344 encode (43): /* fixed dec 4 */ 2345 call encode_fxd4; 2346 bit_length = 9 * floor ((fixed (descriptor.size.precision) + 2) / 2); 2347 if ^descriptor.packed then if mod (bit_length, 36) ^= 0 then do; 2348 pad_length = (36 - mod (bit_length, 36)); 2349 bit_length = bit_length + pad_length; 2350 end; 2351 offset = bit_length; 2352 go to next; 2353 2354 encode (44): /* float dec 4 */ 2355 call encode_fld4; 2356 bit_length = 9 * floor ((fixed (descriptor.size.precision) + 4) / 2); 2357 if ^descriptor.packed then if mod (bit_length, 36) ^= 0 then do; 2358 pad_length = (36 - mod (bit_length, 36)); 2359 bit_length = bit_length + pad_length; 2360 end; 2361 offset = bit_length; 2362 go to next; 2363 2364 encode (45): /* cmplx float dec packed */ 2365 encode (46): /* cmplx fixed dec packed */ 2366 call error (mdbm_error_$unsup_type); 2367 2368 next: 2369 encd_len = divide (offset + 8, 9, 17, 0); 2370 code = 0; 2371 exit: 2372 return; 2373 2374 2375 encode_fxb: proc; 2376 2377 /* Procedure to encode fixed bin, merely flips sign bit */ 2378 2379 cp_ptr -> fxb.sign = ^fxb.sign; 2380 cp_ptr -> fxb.val = fxb.val; 2381 offset = p + 1; 2382 2383 end encode_fxb; 2384 2385 2386 encode_flb: proc; 2387 2388 /* Procedure to encode float bin, merely transforms so that bit sort will 2389* order correctly. */ 2390 2391 flb_enc.msign = ^flb_src.msign; 2392 flb_enc.mval = flb_src.mval; 2393 if flb_src.msign = "1"b then /* if is neg. no */ 2394 addr (flb_enc.esign) -> fb8 = 128 - addr (flb_src.esign) -> fb8; /* compl. exp. */ 2395 /* CHANGE 81-09-19 */ 2396 else do; /* positive, merely flip sign bit */ 2397 flb_enc.esign = ^flb_src.esign; 2398 flb_enc.eval = flb_src.eval; 2399 end; 2400 offset = p + 9; 2401 2402 end encode_flb; 2403 2404 encode_fld: proc; 2405 if ^valid_decimal_ (bin (descriptor.type), src_ptr, bin (descriptor.size.precision)) 2406 then call error (mdbm_error_$invalid_dec_data); 2407 do j = 1 to p while (fld_src.digit (j) = 0); /* scan for first non-zero digit */ 2408 end; 2409 if j > p then do; /* have zero value */ 2410 fld_enc.msign = "p"; 2411 fld_enc.esign, 2412 fld_enc.epad, 2413 fld_enc.eval = "0"b; 2414 do j = 1 to p; 2415 fld_enc.digit (j) = 0; 2416 end; 2417 end; /* if have zero value */ 2418 else do; /* for non-zero values */ 2419 power_delta = p - j + 1; /* number to add to exponent */ 2420 shift_delta = j - 1; /* no. characters to shift */ 2421 if addr (fld_src.esign) -> fb7 2422 + power_delta > 127 then /* if will overflow */ 2423 call error (mdbm_error_$key_encd_ovfl); 2424 addr (fld_enc.esign) -> fb7 = addr (fld_src.esign) -> fb7 + power_delta; 2425 fld_enc.epad = "0"b; 2426 if fld_src.msign = "-" then do; /* if negative no. */ 2427 fld_enc.msign = "n"; 2428 do j = 1 to p - shift_delta; /* 9's compl. of signif. digits to front */ 2429 fld_enc.digit (j) = 9 - fld_src.digit (j + shift_delta); 2430 end; 2431 do j = p - shift_delta + 1 to p; /* fill in trailing 9's */ 2432 fld_enc.digit (j) = 9; 2433 end; 2434 addr (fld_enc.esign) -> fb7 = 2435 128 - addr (fld_enc.esign) -> fb7; /* complement exp. so will sort right */ 2436 end; /* if negative no. */ 2437 else do; /* if positive no. */ 2438 fld_enc.msign = "p"; 2439 do j = 1 to p - shift_delta; /* move signif. digits to front */ 2440 fld_enc.digit (j) = fld_src.digit (j + shift_delta); 2441 end; 2442 do j = p - shift_delta + 1 to p; /* put in trailing 0's */ 2443 fld_enc.digit (j) = 0; 2444 end; 2445 fld_enc.esign = ^fld_enc.esign; /* flip sign bit so will sort right */ 2446 end; /* if positive no. */ 2447 end; /* if non-zero */ 2448 end encode_fld; 2449 2450 /* Encoding algorithm for fixed and float decimal unaligned 2451* 2452* for a fixed data type just ignore rules about exponent. 2453* 2454* For negative numbers (sign = "1101"b) 2455* 1. set sign to "0000"b 2456* 2. copy sign of exponent 2457* 3. copy complement of exponent 2458* 4. copy complement of number 2459* 2460* For positive numbers (sign = "1101"b) 2461* 1. set sign to "1111"b 2462* 2. copy number 2463* 3. if number is zero 2464* a. set exponent to "0000000"b 2465* b. set sign of exponent to "0"b 2466* 4. if number is not zero 2467* a. copy exponent 2468* b. copy sign of exponent 2469* 2470* Note: zero is normally stored as a positive number with the maximum possible 2471* exponent. 2472**/ 2473 2474 encode_fxd4: proc; 2475 p = fixed (descriptor.size.precision); 2476 if mod (p, 2) = 1 2477 then do; 2478 digit_len = ((p - 1) / 2 * 9) + 4; 2479 if odd_fxd4_src.sign = "1101"b 2480 then do; 2481 odd_fxd4_enc.sign = "0000"b; 2482 odd_fxd4_enc.digits = ^(odd_fxd4_src.digits); 2483 end; 2484 else do; 2485 odd_fxd4_enc.sign = "1111"b; 2486 odd_fxd4_enc.digits = odd_fxd4_src.digits; 2487 end; 2488 end; 2489 else do; 2490 digit_len = (p / 2) * 9; 2491 if even_fxd4_src.sign = "1101"b 2492 then do; 2493 even_fxd4_enc.sign = "0000"b; 2494 even_fxd4_enc.digits = ^(even_fxd4_src.digits); 2495 end; 2496 else do; 2497 even_fxd4_enc.sign = "1111"b; 2498 even_fxd4_enc.digits = even_fxd4_src.digits; 2499 end; 2500 end; 2501 end encode_fxd4; 2502 2503 encode_fld4: proc; 2504 p = fixed (descriptor.size.precision); 2505 if mod (p, 2) = 1 2506 then do; 2507 digit_len = (((p - 1) / 2) * 9) + 4; 2508 if odd_fld4_src.sign = "1101"b 2509 then do; 2510 odd_fld4_enc.sign = "0000"b; 2511 odd_fld4_enc.esign = odd_fld4_src.exp.sign; 2512 odd_fld4_enc.exp = ^(odd_fld4_src.exp.exp); 2513 odd_fld4_enc.digits = ^(odd_fld4_src.digits); 2514 end; 2515 else do; 2516 odd_fld4_enc.sign = "1111"b; 2517 odd_fld4_enc.digits = odd_fld4_src.digits; 2518 if odd_fld4_src.digits = "0"b 2519 then do; 2520 odd_fld4_enc.esign = "0"b; 2521 odd_fld4_enc.exp = "0"b; 2522 end; 2523 else do; 2524 odd_fld4_enc.esign = ^(odd_fld4_src.exp.sign); 2525 odd_fld4_enc.exp = odd_fld4_src.exp.exp; 2526 end; 2527 end; 2528 end; 2529 else do; 2530 digit_len = (p / 2) * 9; 2531 if even_fld4_src.sign = "1101"b 2532 then do; 2533 even_fld4_enc.sign = "0000"b; 2534 even_fld4_enc.esign = even_fld4_src.exp.sign; 2535 even_fld4_enc.exp = ^(even_fld4_src.exp.high) || ^(even_fld4_src.exp.low); 2536 even_fld4_enc.digits = ^(even_fld4_src.digits); 2537 end; 2538 else do; 2539 even_fld4_enc.sign = "1111"b; 2540 even_fld4_enc.digits = even_fld4_src.digits; 2541 if even_fld4_src.digits = "0"b 2542 then do; 2543 even_fld4_enc.esign = "0"b; 2544 even_fld4_enc.exp = "0"b; 2545 end; 2546 else do; 2547 even_fld4_enc.esign = ^(even_fld4_src.exp.sign); 2548 even_fld4_enc.exp = even_fld4_src.exp.high || even_fld4_src.exp.low; 2549 end; 2550 end; 2551 end; 2552 end encode_fld4; 2553 2554 error: proc (cd); 2555 2556 /* error procedure */ 2557 2558 dcl cd fixed bin (35); 2559 2560 code = cd; 2561 go to exit; 2562 2563 end error; 2564 end encode_numeric; 2565 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2566 1 1 /* BEGIN INCLUDE FILE ... access_mode_values.incl.pl1 1 2* 1 3* Values for the "access mode" argument so often used in hardcore 1 4* James R. Davis 26 Jan 81 MCR 4844 1 5* Added constants for SM access 4/28/82 Jay Pattin 1 6* Added text strings 03/19/85 Chris Jones 1 7**/ 1 8 1 9 1 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 1 11 dcl ( 1 12 N_ACCESS init ("000"b), 1 13 R_ACCESS init ("100"b), 1 14 E_ACCESS init ("010"b), 1 15 W_ACCESS init ("001"b), 1 16 RE_ACCESS init ("110"b), 1 17 REW_ACCESS init ("111"b), 1 18 RW_ACCESS init ("101"b), 1 19 S_ACCESS init ("100"b), 1 20 M_ACCESS init ("010"b), 1 21 A_ACCESS init ("001"b), 1 22 SA_ACCESS init ("101"b), 1 23 SM_ACCESS init ("110"b), 1 24 SMA_ACCESS init ("111"b) 1 25 ) bit (3) internal static options (constant); 1 26 1 27 /* The following arrays are meant to be accessed by doing either 1) bin (bit_value) or 1 28* 2) divide (bin_value, 2) to come up with an index into the array. */ 1 29 1 30 dcl SEG_ACCESS_MODE_NAMES (0:7) init ("null", "W", "E", "EW", "R", "RW", "RE", "REW") char (4) internal 1 31 static options (constant); 1 32 1 33 dcl DIR_ACCESS_MODE_NAMES (0:7) init ("null", "A", "M", "MA", "S", "SA", "SM", "SMA") char (4) internal 1 34 static options (constant); 1 35 1 36 dcl ( 1 37 N_ACCESS_BIN init (00000b), 1 38 R_ACCESS_BIN init (01000b), 1 39 E_ACCESS_BIN init (00100b), 1 40 W_ACCESS_BIN init (00010b), 1 41 RW_ACCESS_BIN init (01010b), 1 42 RE_ACCESS_BIN init (01100b), 1 43 REW_ACCESS_BIN init (01110b), 1 44 S_ACCESS_BIN init (01000b), 1 45 M_ACCESS_BIN init (00010b), 1 46 A_ACCESS_BIN init (00001b), 1 47 SA_ACCESS_BIN init (01001b), 1 48 SM_ACCESS_BIN init (01010b), 1 49 SMA_ACCESS_BIN init (01011b) 1 50 ) fixed bin (5) internal static options (constant); 1 51 1 52 /* END INCLUDE FILE ... access_mode_values.incl.pl1 */ 2567 2568 2 1 /* START OF: sort_seg_info.incl.pl1 * * * * * * * * * * * * * * * * */ 2 2 2 3 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2 4 /* */ 2 5 /* This include file declares the information structure for the sort_seg_ subroutine. */ 2 6 /* This structure defines the sort string delimiter, and sort field delimiters for fields */ 2 7 /* to be sorted upon within each sort unit (sort string or block of sort strings). */ 2 8 /* */ 2 9 /* Status */ 2 10 /* 0) Created: May 1, 1982 by G. C. Dixon */ 2 11 /* 1) Modified: July 22, 1982 by DJ Schimke adding numeric and integer sort modes. */ 2 12 /* */ 2 13 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2 14 2 15 dcl 1 ss_info aligned based(ss_info_ptr), 2 16 2 header, 2 17 3 version char(8), /* version of this structure. Set with */ 2 18 /* SS_info_version_1 string constant. */ 2 19 3 block_size fixed bin, /* number of sort strings to be blocked together */ 2 20 /* in each sort unit. */ 2 21 3 field_count fixed bin, /* number of sort fields within eacch sort unit. */ 2 22 3 duplicate_mode fixed bin, /* method of handling duplicate sort units. Set */ 2 23 /* with one of the constants below. */ 2 24 3 mbz1 (3) fixed bin, /* reserved for future use. Set to 0. */ 2 25 3 delim, /* sort string delimiter definition. */ 2 26 4 type fixed bin, /* type of delimiter. Set with one of field */ 2 27 /* constants below. */ 2 28 4 number fixed bin, /* numeric type delimiter value. */ 2 29 4 string char(256) varying, /* string type delimiter value. */ 2 30 2 field (ss_field_count refer (ss_info.field_count)), 2 31 /* sort field definitions */ 2 32 3 from like ss_info.delim, /* start of sort field. */ 2 33 3 to like ss_info.delim, /* end of sort field. */ 2 34 3 modes, /* per-field sort modes. */ 2 35 (4 descending bit(1), /* sort field in descending order */ 2 36 4 non_case_sensitive bit(1), /* translate field to lowercase for sorting. */ 2 37 4 numeric bit(1), /* sort field according to numeric value. */ 2 38 4 integer bit(1), /* sort field according to integer value. */ 2 39 4 mbz2 bit(32)) unal, /* reserved for future use. Set to ""b. */ 2 40 ss_field_count fixed bin, 2 41 ss_info_ptr ptr, 2 42 2 43 SS_info_version_1 char(8) int static options(constant) init("ss_info1"), 2 44 /* string constant which must be used to set */ 2 45 /* structure version. */ 2 46 /* constants for setting duplicate_mode, type(s) */ 2 47 (SS_unset init(0), 2 48 SS_duplicates init(1), /* duplicate modes */ 2 49 SS_unique init(2), 2 50 SS_only_duplicates init(3), 2 51 SS_only_duplicate_keys init(4), 2 52 SS_unique_keys init(5), 2 53 SS_only_unique init(6), 2 54 SS_only_unique_keys init(7), 2 55 SS_length init(1), /* field types */ 2 56 SS_index init(2), 2 57 SS_string init(3), 2 58 SS_reg_exp init(4)) fixed bin int static options(constant); 2 59 2 60 /* END OF: sort_seg_info.incl.pl1 * * * * * * * * * * * * * * * * */ 2569 2570 3 1 /* BEGIN mdbm_descriptor.incl.pl1 -- jaw 5/31/78 */ 3 2 /* modified by Jim Gray - - Nov. 1979, to change type from fixed bin(5) to 3 3* unsigned fixed bin(6), so new packed decimal data types could be handled. 3 4* also the duplicate mrds_descriptor.incl.pl1 was eliminated. */ 3 5 3 6 dcl 1 descriptor based (desc_ptr), /* map of Multics descriptor */ 3 7 2 version bit (1) unal, /* DBM handles vers. 1 only */ 3 8 2 type unsigned fixed bin (6) unal, /* data type */ 3 9 2 packed bit (1) unal, /* on if data item is packed */ 3 10 2 number_dims bit (4) unal, /* dimensions */ 3 11 2 size, /* size for string data */ 3 12 3 scale bit (12) unal, /* scale for num. data */ 3 13 3 precision bit (12) unal, /* prec. for num. data */ 3 14 2 array_info (num_dims), 3 15 3 lower_bound fixed bin (35), /* lower bound of dimension */ 3 16 3 upper_bound fixed bin (35), /* upper bound of dimension */ 3 17 3 multiplier fixed bin (35); /* element separation */ 3 18 3 19 dcl desc_ptr ptr; 3 20 dcl num_dims fixed bin init (0) ; /* more useful form of number_dims */ 3 21 3 22 /* END mdbm_descriptor.incl.pl1 */ 3 23 3 24 2571 2572 4 1 /* BEGIN INCLUDE FILE ... terminate_file.incl.pl1 */ 4 2 /* format: style2,^inddcls,idind32 */ 4 3 4 4 declare 1 terminate_file_switches based, 4 5 2 truncate bit (1) unaligned, 4 6 2 set_bc bit (1) unaligned, 4 7 2 terminate bit (1) unaligned, 4 8 2 force_write bit (1) unaligned, 4 9 2 delete bit (1) unaligned; 4 10 4 11 declare TERM_FILE_TRUNC bit (1) internal static options (constant) initial ("1"b); 4 12 declare TERM_FILE_BC bit (2) internal static options (constant) initial ("01"b); 4 13 declare TERM_FILE_TRUNC_BC bit (2) internal static options (constant) initial ("11"b); 4 14 declare TERM_FILE_TERM bit (3) internal static options (constant) initial ("001"b); 4 15 declare TERM_FILE_TRUNC_BC_TERM bit (3) internal static options (constant) initial ("111"b); 4 16 declare TERM_FILE_FORCE_WRITE bit (4) internal static options (constant) initial ("0001"b); 4 17 declare TERM_FILE_DELETE bit (5) internal static options (constant) initial ("00001"b); 4 18 4 19 /* END INCLUDE FILE ... terminate_file.incl.pl1 */ 2573 2574 5 1 /* BEGIN INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 5 2 5 3 5 4 /****^ HISTORY COMMENTS: 5 5* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 5 6* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1208): 5 7* Added pascal_string_type_dtype descriptor type. Its number is 87. 5 8* Objects of this type are PASCAL string types. 5 9* 2) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 5 10* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 5 11* Added the new C types. 5 12* END HISTORY COMMENTS */ 5 13 5 14 /* This include file defines mnemonic names for the Multics 5 15* standard descriptor types, using both pl1 and cobol terminology. 5 16* PG 780613 5 17* JRD 790530 5 18* JRD 791016 5 19* MBW 810731 5 20* TGO 830614 Add hex types. 5 21* Modified June 83 JMAthane to add PASCAL data types 5 22* TGO 840120 Add float dec extended and generic, float binary generic 5 23**/ 5 24 5 25 dcl (real_fix_bin_1_dtype init (1), 5 26 real_fix_bin_2_dtype init (2), 5 27 real_flt_bin_1_dtype init (3), 5 28 real_flt_bin_2_dtype init (4), 5 29 cplx_fix_bin_1_dtype init (5), 5 30 cplx_fix_bin_2_dtype init (6), 5 31 cplx_flt_bin_1_dtype init (7), 5 32 cplx_flt_bin_2_dtype init (8), 5 33 real_fix_dec_9bit_ls_dtype init (9), 5 34 real_flt_dec_9bit_dtype init (10), 5 35 cplx_fix_dec_9bit_ls_dtype init (11), 5 36 cplx_flt_dec_9bit_dtype init (12), 5 37 pointer_dtype init (13), 5 38 offset_dtype init (14), 5 39 label_dtype init (15), 5 40 entry_dtype init (16), 5 41 structure_dtype init (17), 5 42 area_dtype init (18), 5 43 bit_dtype init (19), 5 44 varying_bit_dtype init (20), 5 45 char_dtype init (21), 5 46 varying_char_dtype init (22), 5 47 file_dtype init (23), 5 48 real_fix_dec_9bit_ls_overp_dtype init (29), 5 49 real_fix_dec_9bit_ts_overp_dtype init (30), 5 50 real_fix_bin_1_uns_dtype init (33), 5 51 real_fix_bin_2_uns_dtype init (34), 5 52 real_fix_dec_9bit_uns_dtype init (35), 5 53 real_fix_dec_9bit_ts_dtype init (36), 5 54 real_fix_dec_4bit_uns_dtype init (38), /* digit-aligned */ 5 55 real_fix_dec_4bit_ts_dtype init (39), /* byte-aligned */ 5 56 real_fix_dec_4bit_bytealigned_uns_dtype init (40), /* COBOL */ 5 57 real_fix_dec_4bit_ls_dtype init (41), /* digit-aligned */ 5 58 real_flt_dec_4bit_dtype init (42), /* digit-aligned */ 5 59 real_fix_dec_4bit_bytealigned_ls_dtype init (43), 5 60 real_flt_dec_4bit_bytealigned_dtype init (44), 5 61 cplx_fix_dec_4bit_bytealigned_ls_dtype init (45), 5 62 cplx_flt_dec_4bit_bytealigned_dtype init (46), 5 63 real_flt_hex_1_dtype init (47), 5 64 real_flt_hex_2_dtype init (48), 5 65 cplx_flt_hex_1_dtype init (49), 5 66 cplx_flt_hex_2_dtype init (50), 5 67 c_typeref_dtype init (54), 5 68 c_enum_dtype init (55), 5 69 c_enum_const_dtype init (56), 5 70 c_union_dtype init (57), 5 71 algol68_straight_dtype init (59), 5 72 algol68_format_dtype init (60), 5 73 algol68_array_descriptor_dtype init (61), 5 74 algol68_union_dtype init (62), 5 75 5 76 cobol_comp_6_dtype init (1), 5 77 cobol_comp_7_dtype init (1), 5 78 cobol_display_ls_dtype init (9), 5 79 cobol_structure_dtype init (17), 5 80 cobol_char_string_dtype init (21), 5 81 cobol_display_ls_overp_dtype init (29), 5 82 cobol_display_ts_overp_dtype init (30), 5 83 cobol_display_uns_dtype init (35), 5 84 cobol_display_ts_dtype init (36), 5 85 cobol_comp_8_uns_dtype init (38), /* digit aligned */ 5 86 cobol_comp_5_ts_dtype init (39), /* byte aligned */ 5 87 cobol_comp_5_uns_dtype init (40), 5 88 cobol_comp_8_ls_dtype init (41), /* digit aligned */ 5 89 real_flt_dec_extended_dtype init (81), /* 9-bit exponent */ 5 90 cplx_flt_dec_extended_dtype init (82), /* 9-bit exponent */ 5 91 real_flt_dec_generic_dtype init (83), /* generic float decimal */ 5 92 cplx_flt_dec_generic_dtype init (84), 5 93 real_flt_bin_generic_dtype init (85), /* generic float binary */ 5 94 cplx_flt_bin_generic_dtype init (86)) fixed bin internal static options (constant); 5 95 5 96 dcl (ft_integer_dtype init (1), 5 97 ft_real_dtype init (3), 5 98 ft_double_dtype init (4), 5 99 ft_complex_dtype init (7), 5 100 ft_complex_double_dtype init (8), 5 101 ft_external_dtype init (16), 5 102 ft_logical_dtype init (19), 5 103 ft_char_dtype init (21), 5 104 ft_hex_real_dtype init (47), 5 105 ft_hex_double_dtype init (48), 5 106 ft_hex_complex_dtype init (49), 5 107 ft_hex_complex_double_dtype init (50) 5 108 ) fixed bin internal static options (constant); 5 109 5 110 dcl (algol68_short_int_dtype init (1), 5 111 algol68_int_dtype init (1), 5 112 algol68_long_int_dtype init (2), 5 113 algol68_real_dtype init (3), 5 114 algol68_long_real_dtype init (4), 5 115 algol68_compl_dtype init (7), 5 116 algol68_long_compl_dtype init (8), 5 117 algol68_bits_dtype init (19), 5 118 algol68_bool_dtype init (19), 5 119 algol68_char_dtype init (21), 5 120 algol68_byte_dtype init (21), 5 121 algol68_struct_struct_char_dtype init (22), 5 122 algol68_struct_struct_bool_dtype init (20) 5 123 ) fixed bin internal static options (constant); 5 124 5 125 dcl (label_constant_runtime_dtype init (24), 5 126 int_entry_runtime_dtype init (25), 5 127 ext_entry_runtime_dtype init (26), 5 128 ext_procedure_runtime_dtype init (27), 5 129 picture_runtime_dtype init (63) 5 130 ) fixed bin internal static options (constant); 5 131 5 132 dcl (pascal_integer_dtype init (1), 5 133 pascal_real_dtype init (4), 5 134 pascal_label_dtype init (24), 5 135 pascal_internal_procedure_dtype init (25), 5 136 pascal_exportable_procedure_dtype init (26), 5 137 pascal_imported_procedure_dtype init (27), 5 138 pascal_typed_pointer_type_dtype init (64), 5 139 pascal_char_dtype init (65), 5 140 pascal_boolean_dtype init (66), 5 141 pascal_record_file_type_dtype init (67), 5 142 pascal_record_type_dtype init (68), 5 143 pascal_set_dtype init (69), 5 144 pascal_enumerated_type_dtype init (70), 5 145 pascal_enumerated_type_element_dtype init (71), 5 146 pascal_enumerated_type_instance_dtype init (72), 5 147 pascal_user_defined_type_dtype init (73), 5 148 pascal_user_defined_type_instance_dtype init (74), 5 149 pascal_text_file_dtype init (75), 5 150 pascal_procedure_type_dtype init (76), 5 151 pascal_variable_formal_parameter_dtype init (77), 5 152 pascal_value_formal_parameter_dtype init (78), 5 153 pascal_entry_formal_parameter_dtype init (79), 5 154 pascal_parameter_procedure_dtype init (80), 5 155 pascal_string_type_dtype init (87)) fixed bin int static options (constant); 5 156 5 157 5 158 /* END INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 2575 2576 6 1 /* BEGIN INCLUDE FILE sub_err_flags.incl.pl1 BIM 11/81 */ 6 2 /* format: style3 */ 6 3 6 4 /* These constants are to be used for the flags argument of sub_err_ */ 6 5 /* They are just "string (condition_info_header.action_flags)" */ 6 6 6 7 declare ( 6 8 ACTION_CAN_RESTART init (""b), 6 9 ACTION_CANT_RESTART init ("1"b), 6 10 ACTION_DEFAULT_RESTART 6 11 init ("01"b), 6 12 ACTION_QUIET_RESTART 6 13 init ("001"b), 6 14 ACTION_SUPPORT_SIGNAL 6 15 init ("0001"b) 6 16 ) bit (36) aligned internal static options (constant); 6 17 6 18 /* End include file */ 2577 2578 2579 end sort_seg_; 2580 SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/24/88 1359.2 sort_seg_.pl1 >special_ldd>install>MR12.2-1184>sort_seg_.pl1 2567 1 04/11/85 1452.6 access_mode_values.incl.pl1 >ldd>include>access_mode_values.incl.pl1 2569 2 05/18/84 0830.8 sort_seg_info.incl.pl1 >ldd>include>sort_seg_info.incl.pl1 2571 3 10/14/83 1608.6 mdbm_descriptor.incl.pl1 >ldd>include>mdbm_descriptor.incl.pl1 2573 4 04/06/83 1239.4 terminate_file.incl.pl1 >ldd>include>terminate_file.incl.pl1 2575 5 10/24/88 1336.9 std_descriptor_types.incl.pl1 >special_ldd>install>MR12.2-1184>std_descriptor_types.incl.pl1 2577 6 04/16/82 0958.1 sub_err_flags.incl.pl1 >ldd>include>sub_err_flags.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. ACTION_DEFAULT_RESTART 000133 constant bit(36) initial dcl 6-7 set ref 438* 449* 458* 673* 683* 895* 951* 961* 1151* 1202* 1231* 1239* 1282* 1340* 1398* 1410* 1421* 1431* 1968* AZ 000151 constant char(26) initial packed unaligned dcl 312 ref 1034 1383 1389 C based pointer array level 2 packed packed unaligned dcl 229 ref 798 FALSE 000234 constant bit(1) initial packed unaligned dcl 336 set ref 407 408 411 472* 509 512 554 562 641 710 721 726 731 732 739 820 1076 1912 1928 1944 FIXED_BIN_71_DESC 000000 constant structure level 1 dcl 336 set ref 1094 1094 1122 1122 1418 1418 1428 1428 1448 1448 FLOAT_DEC_59_DESC 000001 constant structure level 1 dcl 336 set ref 1091 1091 1116 1116 1395 1395 1407 1407 1445 1445 I 1 based fixed bin(24,0) array level 2 in structure "idx" dcl 214 in procedure "sort_seg_" set ref 610 1518 1688 I 1 based fixed bin(24,0) array level 2 in structure "idx_merge" dcl 229 in procedure "sort_seg_" ref 1613 1641 I 1 based fixed bin(24,0) array level 2 in structure "idx1" dcl 229 in procedure "sort_seg_" ref 1619 Ibk 000100 automatic fixed bin(21,0) dcl 129 set ref 859* Ichar 000101 automatic fixed bin(21,0) dcl 129 set ref 932* 934 934* 951 951* Icomp 000102 automatic fixed bin(21,0) dcl 129 set ref 580* 581 582 583 584 590 593 595* Idu 000103 automatic fixed bin(21,0) dcl 129 set ref 850* 910 918* 918 1539* 1541 1541 1548* 1561* 1563 1568* Idu_nl 000572 automatic fixed bin(21,0) dcl 1874 set ref 1523* 1527 1553 Iend 000104 automatic fixed bin(21,0) dcl 129 set ref 1160* 1162* 1166* 1169* 1170 1171* 1171 1176* 1183* 1189* 1194* 1194 1208 1292* 1294* 1298* 1301* 1302 1303* 1303 1308* 1311* 1322* 1327* 1332* 1332 1346 If 000105 automatic fixed bin(17,0) dcl 129 set ref 727* 728 728* 1056* 1057 1057 1059 1059 1061 1061 1063 1067 1071* 1077* 1078 1078 1081 1081* 1087* 1088 1089 1089 1091 1094 1094 1097 1097 1097 1099 1099 1099* 1103 1112* 1113 1114 1114 1116 1118 1121 1121 1122 1124 1129 1132 1134 1137 1137 1137 1137 1151 1158 1160 1162 1166 1169 1174 1179 1183 1183 1183 1183 1189 1189 1189 1189 1202 1208 1208* 1231* 1239* 1257* 1258 1260 1263 1265 1268 1268 1268 1268 1282 1290 1292 1294 1298 1301 1306 1311 1311 1311 1311 1318 1322 1322 1322 1322 1327 1327 1327 1327 1340 1348 1350 1350 1350 1350 1350 1354 1354 1354 1354 1354 1359 1359 1359 1359 1359 1364 1364 1364 1364 1368 1368 1368 1368 1372 1372 1372 1372 1376 1376 1376 1376 1380 1381 1383 1386 1389 1390 1390 1393 1393 1393 1395 1395 1398* 1405 1410* 1415 1418 1418 1421* 1431* 1436 1439 1442 1443 1443 1443 1443 1445 1445 1445 1448 1448 1448 1448 1450 1451 1451 1451 1454* 1456 1457 Iline_end 000106 automatic fixed bin(21,0) dcl 129 set ref 925* 926 927 928 930* 930 932 Imatch 000107 automatic fixed bin(21,0) dcl 129 set ref 870* 871 872 874 877* 882 885 887 Imatch_end 000110 automatic fixed bin(21,0) dcl 129 set ref 877* 882 1137* 1142 1183* 1189* 1268* 1273 1311* 1322* 1327* Imerge 000111 automatic fixed bin(17,0) dcl 129 set ref 1609* 1610 1611 1612 1613 1615 1624* 1640 1641 1643* 1643 1646 1646 1650* 1650 1650* Inl 000113 automatic fixed bin(21,0) dcl 129 set ref 927* 928 928* 930 932 Iptr 000112 automatic fixed bin(21,0) dcl 129 set ref 802* 803 805* 823* 824 826* Iseg 000114 automatic fixed bin(17,0) dcl 129 set ref 800* 801* 821* 822* 1603* 1630 1634* 1634 1635 Isf_nl 000574 automatic fixed bin(21,0) dcl 1874 set ref 1526* 1527 Isf_str 000115 automatic fixed bin(21,0) dcl 129 set ref 1023* 1026 1030* 1032 1036* 1036 1246* 1249 1253* 1255 1383 1386 1389 1390 1390 1393 1393 1395 1395 1415 1418 1418 1436 1439 1443 1443 1445 1445 1448 1448 1450 1451 1451 1454* 1454 1456 1457* 1457 2041* 2042* 2066* 2067* Iss 000116 automatic fixed bin(21,0) dcl 129 set ref 848* 858 859 861 864 867* 867 870 874* 874 877* 885 887* 922 924 926 932 1539* 1541 1548* Istart 000117 automatic fixed bin(21,0) dcl 129 set ref 1129* 1132* 1133 1134* 1134 1137* 1142 1143* 1143 1157 1162 1169 1171 1183* 1189* 1208 1231 1231 1239 1239 1260* 1263* 1264 1265* 1265 1268* 1273 1274* 1274 1288 1294 1301 1303 1311* 1322* 1327* 1346 1383 1386 1389 1393 1393 1395 1395 1398 1398 1405 1405 1407 1407 1410 1410 1418 1418 1421 1421 1428 1428 1431 1431 1439 Its 000120 automatic fixed bin(17,0) dcl 129 set ref 2065* 2067 2067* 2076* 2077 2078 2079* 2085* 2086* Iu 000121 automatic fixed bin(21,0) dcl 129 set ref 609* 610 610* 1024* 1025 1025 1025 1025 1026 1032 1034 1034 1034 1034 1034 1034 1035 1035 1035 1035 1035 1036 1036* 1103 1111* 1118 1118 1124 1124 1132 1132 1137 1137 1137 1137 1137 1137 1137 1137 1157 1157 1160 1160 1162 1162 1166 1166 1169 1169 1176 1176 1180 1180 1188 1188 1189 1189 1189 1189 1189 1189 1189 1189* 1211 1231* 1231 1231 1231 1231 1239* 1239 1239 1239 1239 1248* 1255 1263 1263 1268 1268 1268 1268 1268 1268 1268 1268 1288 1288 1292 1292 1294 1294 1298 1298 1301 1301 1308 1308 1311 1311 1311 1311 1311 1311 1311 1311 1315 1315 1319 1319 1327 1327 1327 1327 1327 1327 1327 1327 1383 1383 1386 1386 1389 1389 1393 1393 1393 1393 1395 1395 1395 1395 1398* 1398 1398 1398 1398 1405 1405 1405 1405 1407 1407 1407 1407 1410* 1410 1410 1410 1410 1418 1418 1418 1418 1421* 1421 1421 1421 1421 1428 1428 1428 1428 1431* 1431 1431 1431 1431 1439 1439 1456* 1498* 1499 1499 1500 1500* 1507* 1508 1509 1511* 1517* 1518 1520 1521 1523 1524 1524 1526 1527* 1527 1527 1527 1527 1527 1527 1527 1527 1533 1535 1535 1536 1536 1537 1541* 1553* 1553 1553 1553 1553 1557 1559 1559 1560 1560 1563* 1615* 1616 1617 1618 1619 1624* 1688* 1689 1692 1696 1699 1705 1712 1726 1731 1738 1749 1758 1765 1770 1777 1784 1795 1803 1808 1815 1827 1833 Iu_prev 000122 automatic fixed bin(21,0) dcl 129 set ref 1681* 1696 1696 1703 1705 1712 1718 1725 1726 1731 1738 1745 1756 1758 1765 1775 1777 1784 1790 1802 1803 1808 1815 1822 1833* Iuss 000123 automatic fixed bin(21,0) dcl 129 set ref 861* 904 Iuu 000124 automatic fixed bin(21,0) dcl 129 set ref 852* 915 916* 916 1539* 1541 1548* 1561* 1563 1568* Iuu_nl 000573 automatic fixed bin(21,0) dcl 1874 set ref 1524* 1527 1553 Iuu_str 000125 automatic fixed bin(21,0) dcl 129 set ref 855* 904 905* 905 997 Ix 000126 automatic fixed bin(21,0) dcl 129 set ref 1518* 1518* 1527* 1541* 1553* 1563* 1686* 1688 1794 1794 1826 1826* L 1 based fixed bin(24,0) array level 2 in structure "sfl" dcl 280 in procedure "sort_seg_" set ref 1025* 1026 1034 1035 1036 L 1 based fixed bin(24,0) array level 2 in structure "uul" dcl 280 in procedure "sort_seg_" set ref 806* 827* 911* 1025 1034 1034 1035 1118* 1118 1124* 1124 1132 1137 1137 1137 1137 1157 1160 1162 1166 1169 1176 1179 1180 1188* 1188 1189 1189 1189 1189 1231 1231 1239 1239 1263 1268 1268 1268 1268 1288 1292 1294 1298 1301 1308 1311 1311 1311 1311 1315* 1315 1318 1319 1327 1327 1327 1327 1383 1386 1389 1393 1393 1395 1395 1398 1398 1405 1405 1407 1407 1410 1410 1418 1418 1421 1421 1428 1428 1431 1431 1439 1499 1500 1524 1527 1527 1527 1535 1536 1553 1553 1559 1560 L 1 based fixed bin(24,0) array level 2 in structure "dul" dcl 214 in procedure "sort_seg_" set ref 912* 1508 1520 1689 Lall_fields 000127 automatic fixed bin(24,0) dcl 129 set ref 1104* 1212* 1249 1472* 1496* 1526 1527 1527 1527 1527 1537 1538 1620 1620 1643 1643 1684* 1684 1726 1726 1765 1765 1803 1803 Ldelim 000130 automatic fixed bin(21,0) dcl 129 set ref 1001* 1003* 1006* 1508 1520 1689 Ldss 000131 automatic fixed bin(21,0) dcl 129 set ref 866* 873* 886* 901 Ldu 000132 automatic fixed bin(21,0) dcl 129 set ref 851* 901* 901 912 918 919* 1508* 1509 1509 1509* 1509 1511 1512 1520* 1521 1521 1521* 1521 1523 1527 1527 1527 1533 1534 1553 1553 1553 1557 1558 1689* 1692 1692 1693 1696 1696 1699 1699 1700 1705 1705 1712 1712 1731 1731 1738 1738 1749 1749 1750 1758 1758 1770 1770 1771 1777 1777 1784 1784 1795 1795 1796 1808 1808 1815 1815 1827 1827 1828 1835 Ldu_line 000575 automatic fixed bin(21,0) dcl 1874 set ref 1514 1541 1541 1541 1541 1563 1563 1563 1563 1903* 1904 1904* 1905 1906 1907 1908 1908 1908* 1908 Ldu_longest 000576 automatic fixed bin(21,0) dcl 1874 set ref 1506* 1514* 1514 1527 1541* 1541 1553 1563* 1563 Ldu_prev 000133 automatic fixed bin(21,0) dcl 129 set ref 1696 1696 1705 1705 1712 1712 1718 1718 1719 1731 1731 1738 1738 1745 1745 1746 1758 1758 1777 1777 1784 1784 1790 1790 1791 1808 1808 1815 1815 1822 1822 1823 1835* Ldu_text 000577 automatic fixed bin(21,0) dcl 1874 set ref 1512* 1534* 1541 1558* 1563 1902 1903 1904 1907* 1907 Lfield 000100 automatic fixed bin(21,0) array dcl 977 set ref 1089* 1091* 1094* 1097* 1099* 1103* 1104 1110* 1114* 1116* 1122* 1208* 1208 1211* 1212 1383 1386 1389 1390 1390 1393 1393 1395 1395 1415 1418 1418 1436 1439 1443 1443 1443* 1445 1445 1445* 1448 1448 1448* 1450 1451 1451 1454 1456 1457 1496* Lin 000134 automatic fixed bin(21,0) dcl 129 set ref 462* 506* 680 711 712 714 858 859 864 870 877 877 877 877 904 922 927 928 1851 1851 1853 1854 2032 Lmatch 000136 automatic fixed bin(21,0) dcl 129 set ref 882* 883* 883 886 887 1142* 1143 1231 1231 1239 1239 1273* 1274 1346* 1347 1383 1386 1389 1393 1393 1393 1395 1395 1395 1398 1398 1405 1405 1405 1407 1407 1407 1410 1410 1418 1418 1418 1421 1421 1428 1428 1428 1431 1431 1439 Lout 000135 automatic fixed bin(21,0) dcl 129 set ref 1680* 1692 1693* 1693 1699 1700* 1700 1718 1719* 1719 1745 1746* 1746 1749 1750* 1750 1770 1771* 1771 1790 1791* 1791 1795 1796* 1796 1822 1823* 1823 1827 1828* 1828 1851 1853* 1853 1854 1858 1858 1861 Lsf_line 000600 automatic fixed bin(21,0) dcl 1874 set ref 1541 1541 1541 1935* 1936 1936* 1937 1938 1939 1940 1940 1940* 1940 Lsf_text 000601 automatic fixed bin(21,0) dcl 1874 set ref 1538* 1541 1934 1935 1936 1939* 1939 Luss 000137 automatic fixed bin(21,0) dcl 129 set ref 866* 872* 873 885* 886 902 904 904 905 Luu 000140 automatic fixed bin(21,0) dcl 129 set ref 853* 902* 902 911 916 919* Luu_line 000602 automatic fixed bin(21,0) dcl 1874 set ref 1502 1541 1541 1541 1541 1563 1563 1563 1919* 1920 1920* 1921 1922 1923 1924 1924 1924* 1924 Luu_longest 000603 automatic fixed bin(21,0) dcl 1874 set ref 1497* 1502* 1502 1527 1541* 1541 Luu_str 000141 automatic fixed bin(21,0) dcl 129 set ref 856* 904 997* Luu_temp 000142 automatic fixed bin(21,0) dcl 129 set ref 1179* 1180 1181* 1181 1182 1182 1183 1183 1183 1183 1318* 1319 1320* 1320 1321 1321 1322 1322 1322 1322 Luu_text 000604 automatic fixed bin(21,0) dcl 1874 set ref 1500* 1536* 1541 1560* 1563 1918 1919 1920 1923* 1923 M 1 based fixed bin(17,0) level 2 dcl 229 ref 577 580 604 1601 1610 1615 1650 N based fixed bin(24,0) level 2 in structure "uup" dcl 280 in procedure "sort_seg_" set ref 1480* N based fixed bin(21,0) level 2 in structure "supo" dcl 229 in procedure "sort_seg_" set ref 608* 609 1605* 1607 1629 1636* 1639* 1639 1641 N based fixed bin(24,0) level 2 in structure "idx1" dcl 229 in procedure "sort_seg_" ref 1617 N based fixed bin(24,0) level 2 in structure "dup" dcl 214 in procedure "sort_seg_" set ref 608 835* N based fixed bin(24,0) level 2 in structure "idx_merge" dcl 229 in procedure "sort_seg_" ref 1650 N based fixed bin(17,0) level 2 in structure "spp" dcl 229 in procedure "sort_seg_" ref 798 800 821 N based fixed bin(21,0) level 2 in structure "sup" dcl 229 in procedure "sort_seg_" ref 802 823 N based fixed bin(24,0) level 2 in structure "idx" dcl 214 in procedure "sort_seg_" set ref 1686 1686 1794 1826 N based fixed bin(17,0) level 2 in structure "save" dcl 229 in procedure "sort_seg_" set ref 577* 581 582 582 593 595 595 597 597 597 607 1611 1612 1612 1616 1618 1618 1650 2061 2061 2063 2063 2063 2063 2067 2067 2067 2067 2067 2067 2078 2079 2079 2086 2086 2086 N based fixed bin(24,0) level 2 in structure "sfp" dcl 280 in procedure "sort_seg_" set ref 1471* 1475* N based fixed bin(24,0) level 2 in structure "uul" dcl 280 in procedure "sort_seg_" set ref 835* 1481* N based fixed bin(24,0) level 2 in structure "sfl" dcl 280 in procedure "sort_seg_" set ref 1476* N based fixed bin(17,0) level 2 in structure "sppo" dcl 229 in procedure "sort_seg_" ref 1630 NL 021740 constant char(1) initial packed unaligned dcl 312 ref 927 1063 1118 1124 1181 1182 1182 1188 1320 1321 1321 1509 1521 1523 1524 1526 1903 1908 1919 1924 1935 1940 Ndups 000143 automatic fixed bin(21,0) dcl 129 set ref 1682* 1705* 1705 1708* 1709* 1712* 1712 1714* 1715* 1717 1726* 1726 1728* 1731* 1731 1734* 1735* 1738* 1738 1740* 1741* 1744 1748 1758* 1758 1761* 1762* 1765* 1765 1766* 1769 1777* 1777 1780* 1781* 1784* 1784 1786* 1787* 1789 1794 1798 1803* 1803 1805* 1808* 1808 1811* 1812* 1815* 1815 1817* 1818* 1821 1826 1830 Ndups_prev 000144 automatic fixed bin(21,0) dcl 129 set ref 1683* 1789 1798* 1821 1830* Nlines 000145 automatic fixed bin(21,0) dcl 129 set ref 926* 934* 951* Nsf_str_array 000146 automatic fixed bin(17,0) dcl 129 set ref 413* 414 415* 514* 515 516* 564* 565 566* 597 598 599 770 1027* 1027 1029 1250* 1250 1252 2039 2039 2041 2066 Nsf_strs 1 based fixed bin(17,0) level 2 dcl 229 set ref 578* 597 598* 598 2065 2085 Nu 000147 automatic fixed bin(24,0) dcl 129 set ref 608* 797* 804* 804 805 806 825* 825 826 827 835 847* 909* 909 910 911 912 915 959 1024 1111 1248 1471 1475 1476 1480 1481 1498 1507 1517 1518 Oin 000150 automatic fixed bin(21,0) dcl 129 set ref 712* 714 714 716 716 Oout 000151 automatic fixed bin(21,0) dcl 129 set ref 713* 714 714 716 716 P 1 based pointer array level 2 in structure "sfp1" packed packed unaligned dcl 229 in procedure "sort_seg_" ref 1619 P 1 based pointer array level 2 in structure "sup" packed packed unaligned dcl 229 in procedure "sort_seg_" ref 803 805 824 826 P 1 based pointer array level 2 in structure "dup" packed packed unaligned dcl 214 in procedure "sort_seg_" set ref 610 805* 826* 910* 1509 1511 1521 1523 1527 1533 1553 1557 1641 1692 1696 1696 1699 1712 1712 1718 1738 1738 1745 1749 1770 1784 1784 1790 1795 1815 1815 1822 1827 P 1 based pointer array level 2 in structure "supo" packed packed unaligned dcl 229 in procedure "sort_seg_" set ref 610* 1641* P 1 based pointer array level 2 in structure "uup" packed packed unaligned dcl 280 in procedure "sort_seg_" set ref 915* 1025 1034 1034 1035 1132 1137 1137 1137 1137 1157 1160 1162 1166 1169 1176 1180 1189 1189 1189 1189 1231 1231 1239 1239 1263 1268 1268 1268 1268 1288 1292 1294 1298 1301 1308 1311 1311 1311 1311 1319 1327 1327 1327 1327 1383 1386 1389 1393 1393 1395 1395 1398 1398 1405 1405 1407 1407 1410 1410 1418 1418 1421 1421 1428 1428 1431 1431 1439 1499 1500 1524 1527 1527 1535 1536 1553 1559 1560 P 3 based pointer array level 2 in structure "spp" packed packed unaligned dcl 229 in procedure "sort_seg_" ref 801 822 P 1 based pointer array level 2 in structure "sfp" packed packed unaligned dcl 280 in procedure "sort_seg_" set ref 1032* 1034 1035 1036 1255* 1526 1527 1527 1537 1705 1705 1726 1726 1731 1731 1758 1758 1765 1765 1777 1777 1803 1803 1808 1808 P 1 based pointer array level 2 in structure "sfp_merge" packed packed unaligned dcl 229 in procedure "sort_seg_" ref 1613 P 1 based pointer array level 2 in structure "sppo" packed packed unaligned dcl 229 in procedure "sort_seg_" ref 605 1604 1635 Paccess 000152 automatic pointer dcl 129 set ref 406* 436* 2012 2012* Pdu_line 000606 automatic pointer dcl 1874 set ref 1514 1541 1541 1541 1563 1563 1563 1902* 1905 1908 1908 Pdu_text 000610 automatic pointer dcl 1874 set ref 1511* 1533* 1541 1557* 1563 1902 1903 1904 1906* 1906 Pdul 000160 automatic pointer dcl 129 set ref 412* 513* 563* 761* 912 1000* 1508 1520 1689 2034 2034* 2038* Pdup 000162 automatic pointer dcl 129 set ref 412* 513* 563* 590 592* 606* 608 610 758* 805 826 835 910 996 1509 1511 1521 1523 1527 1533 1553 1557 1640* 1641 1692 1696 1696 1699 1712 1712 1718 1738 1738 1745 1749 1770 1784 1784 1790 1795 1815 1815 1822 1827 2030 2037* 2059 2077* 2080* Pidx 000164 automatic pointer dcl 129 set ref 410* 511* 561* 593 594* 607* 610 757* 1472 1472 1477 1477 1482 1482 1518 1686 1686 1688 1794 1826 2036* 2061 2078* 2081* Pidx1 000422 automatic pointer dcl 129 set ref 1616* 1617 1619 1621 Pidx_merge 000424 automatic pointer dcl 129 set ref 1611* 1613 1621* 1641 Pin 000154 automatic pointer dcl 129 set ref 404* 456* 505* 557* 680 711 712 714 858 859 864 870 877 877 877 877 904 910 922 927 928 1851 1851 1853 1854 2004 2004* 2032 Pout 000156 automatic pointer dcl 129 set ref 405* 421* 445* 446 507* 557* 711 713 716 781 782* 1692 1699 1718 1745 1749 1770 1790 1795 1822 1827 1851 1858 1859* 2006 2007* 2009* 2026 2026* Pout_real 000166 automatic pointer dcl 129 set ref 418* 519* 569* 781* 1858 1859 2026 Pout_temp 000170 automatic pointer dcl 129 set ref 417* 518* 568* 780* 782 2026 2028* Psave 000410 automatic pointer dcl 129 set ref 558* 575* 577 578 581 581 582 582 582 583 590 593 593 595 595 595 597 597 597 597 597 598 598 606 607 607 1611 1611 1612 1612 1612 1616 1616 1618 1618 1618 1640 1650 1650 2058 2059 2059 2061 2061 2061 2061 2063 2063 2063 2063 2063 2063 2065 2067 2067 2067 2067 2067 2067 2067 2067 2075 2077 2078 2078 2079 2079 2079 2085 2086 2086 2086 2086 2090* Psf1 000432 automatic pointer dcl 129 set ref 1619* 1620 1623 Psf_line 000612 automatic pointer dcl 1874 set ref 1541 1541 1934* 1937 1940 1940 Psf_merge 000434 automatic pointer dcl 129 set ref 1613* 1620 1623* 1643 Psf_str 000172 automatic pointer dcl 129 set ref 414* 515* 565* 600* 769* 770 1028* 1029 1032 1251* 1252 1255 1383 1386 1389 1390 1390 1393 1393 1395 1395 1415 1418 1418 1436 1439 1443 1443 1445 1445 1448 1448 1450 1451 1451 1456 2039 2042* 2043* 2086* 2087* Psf_str_array based pointer array dcl 129 set ref 414* 515* 565* 597* 597 598 599* 770* 1029* 1252* 2039 2039* 2042 2067 Psf_text 000614 automatic pointer dcl 1874 set ref 1537* 1541 1934 1935 1936 1938* 1938 Psfa 000174 automatic pointer array dcl 129 set ref 413 414 514 515 564 565 597 598 599 770 1029 1252 2039 2039 2042 2067 Psfl 000374 automatic pointer dcl 129 set ref 414* 515* 565* 775* 1025 1026 1034 1035 1036 1476 1477 1477 2046* Psfp 000376 automatic pointer dcl 129 set ref 414* 515* 565* 595 596* 771* 1032 1034 1035 1036 1255 1471 1472 1472 1475 1477 1477 1526 1527 1527 1537 1705 1705 1726 1726 1731 1731 1758 1758 1765 1765 1777 1777 1803 1803 1808 1808 2045* 2063 2079* 2082* Psfp1 000426 automatic pointer dcl 129 set ref 1618* 1619 1622 Psfp_merge 000430 automatic pointer dcl 129 set ref 1612* 1613 1622* Pspp 000412 automatic pointer dcl 129 set ref 572* 577 580 604 798 798 799 800 801 821 822 1601 1610 1615 1650 Psppo 000420 automatic pointer dcl 129 set ref 573* 605 1604 1630 1635 Psup 000414 automatic pointer dcl 129 set ref 801* 802 803 805 822* 823 824 826 Psupo 000416 automatic pointer dcl 129 set ref 605* 608 609 610 1604* 1605 1607 1607 1629 1635* 1636 1639 1639 1641 1641 Ptemp parameter pointer dcl 1957 set ref 1954 1965* 1966* 1972 1975* 1976* Puu_line 000616 automatic pointer dcl 1874 set ref 1502 1541 1541 1541 1563 1563 1918* 1921 1924 1924 Puu_str 000400 automatic pointer dcl 129 set ref 416* 517* 567* 764* 904 915 2032 2032* 2047* Puu_temp 000402 automatic pointer dcl 129 set ref 416* 517* 567* 1068 1068* 1180 1182 1182 1183 1183 1183 1183 1319 1321 1321 1322 1322 1322 1322 2050* Puu_text 000620 automatic pointer dcl 1874 set ref 1499* 1535* 1541 1559* 1563 1918 1919 1920 1922* 1922 Puul 000404 automatic pointer dcl 129 set ref 416* 517* 567* 759* 806 827 835 911 1000 1025 1034 1034 1035 1118 1118 1124 1124 1132 1137 1137 1137 1137 1157 1160 1162 1166 1169 1176 1179 1180 1188 1188 1189 1189 1189 1189 1231 1231 1239 1239 1263 1268 1268 1268 1268 1288 1292 1294 1298 1301 1308 1311 1311 1311 1311 1315 1315 1318 1319 1327 1327 1327 1327 1383 1386 1389 1393 1393 1395 1395 1398 1398 1405 1405 1407 1407 1410 1410 1418 1418 1421 1421 1428 1428 1431 1431 1439 1481 1482 1482 1499 1500 1524 1527 1527 1527 1535 1536 1553 1553 1559 1560 2034 2049* Puup 000406 automatic pointer dcl 129 set ref 416* 517* 567* 591* 765* 915 996* 1025 1034 1034 1035 1132 1137 1137 1137 1137 1157 1160 1162 1166 1169 1176 1180 1189 1189 1189 1189 1231 1231 1239 1239 1263 1268 1268 1268 1268 1288 1292 1294 1298 1301 1308 1311 1311 1311 1311 1319 1327 1327 1327 1327 1383 1386 1389 1393 1393 1395 1395 1398 1398 1405 1405 1407 1407 1410 1410 1418 1418 1421 1421 1428 1428 1431 1431 1439 1480 1482 1482 1499 1500 1524 1527 1527 1535 1536 1553 1559 1560 2030 2030* 2048* RW_ACCESS 000240 constant bit(3) initial packed unaligned dcl 1-11 set ref 436* RW_ACCESS_BIN 000217 constant fixed bin(5,0) initial dcl 1-36 set ref 445* R_ACCESS 000160 constant bit(3) initial packed unaligned dcl 1-11 set ref 456* SEGMENT 000245 constant fixed bin(2,0) initial dcl 336 set ref 436* 464* 467* 681 934 934 951 961 1231 1239 1398 1410 1421 1431 SS_index constant fixed bin(17,0) initial dcl 2-15 ref 733 1081 1081 SS_info_version_1 000136 constant char(8) initial packed unaligned dcl 2-15 set ref 671 673* SS_length constant fixed bin(17,0) initial dcl 2-15 ref 733 1001 1078 1097 SS_reg_exp constant fixed bin(17,0) initial dcl 2-15 ref 723 SS_string constant fixed bin(17,0) initial dcl 2-15 ref 1063 STRING 000246 constant fixed bin(2,0) initial dcl 336 set ref 522* 524* Sblocked 000437 automatic bit(1) packed unaligned dcl 129 set ref 725* 761 763 903 912 914 996 999 1063 Screated_output_seg 000436 automatic bit(1) packed unaligned dcl 129 set ref 407* 419* 444* 449* 475* Sdebug 000010 internal static bit(1) initial packed unaligned dcl 336 set ref 635* 641* 1494 1643 Sdelete_output_file parameter bit(1) packed unaligned dcl 1985 ref 1982 2007 Sdescending_sort 000440 automatic bit(1) packed unaligned dcl 129 set ref 731* 740* 1686 1794 1794 1826 1826 1837 Sfield 000441 automatic bit(1) packed unaligned dcl 129 set ref 730* 739* 768 1075 1470 1495 1525 1684 1724 1726 1755 1801 1803 Snon_case_sensitive_sort 000442 automatic bit(1) packed unaligned dcl 129 set ref 732* 741* 768 774 1022 1474 1704 1730 1755 1757 1776 1807 Snumeric 000443 automatic bit(1) packed unaligned dcl 129 set ref 726* 728* 733 1228 1460 Soverlap 000444 automatic bit(1) packed unaligned dcl 129 set ref 411* 512* 562* 710* 714* 716* 718* 721* 779 933 1857 2025 Stemp_dir 000445 automatic bit(1) packed unaligned dcl 129 set ref 408* 509* 554* 555* 1965 1975 Svarying_delimiters 000446 automatic bit(1) packed unaligned dcl 129 set ref 723* 761 912 999 Svarying_fields 000447 automatic bit(1) packed unaligned dcl 129 set ref 1076* 1077 1078* 1083* 1084* 1086 Syes 000450 automatic bit(1) packed unaligned dcl 129 set ref 426* 435 934* 945 TABLE 000242 constant fixed bin(2,0) initial dcl 336 set ref 585* 587* 680 710 785 1089 1114 1231 1239 1393 1398 1405 1410 1421 1431 1443 TERM_FILE_TERM 000140 constant bit(3) initial packed unaligned dcl 4-14 set ref 419* 475* 2004* TERM_FILE_TRUNC_BC_TERM 000134 constant bit(3) initial packed unaligned dcl 4-15 set ref 472* TRUE constant bit(1) initial packed unaligned dcl 336 ref 444 555 635 718 728 730 828 1078 1083 1084 1910 1926 1942 W_ACCESS 000140 constant bit(3) initial packed unaligned dcl 1-11 set ref 421* ZERO 000150 constant char(1) initial packed unaligned dcl 312 set ref 1089 1089 1089 1089 1091 1091 1091 1091 1094 1094 1094 1094 1114 1114 1114 1114 1116 1116 1116 1116 1122 1122 1122 1122 1443 1443 1443 1443 1445 1445 1445 1445 1448 1448 1448 1448 access_$reset 000022 constant entry external dcl 326 ref 2012 access_$set_temporarily 000024 constant entry external dcl 326 ref 436 addr builtin function dcl 320 ref 414 505 507 515 565 597 597 598 599 711 711 712 713 770 877 877 877 877 910 915 1025 1029 1032 1035 1089 1089 1089 1089 1091 1091 1091 1091 1091 1091 1094 1094 1094 1094 1094 1094 1103 1114 1114 1114 1114 1116 1116 1116 1116 1116 1116 1122 1122 1122 1122 1122 1122 1137 1137 1137 1137 1183 1183 1183 1183 1189 1189 1189 1189 1211 1252 1255 1268 1268 1268 1268 1311 1311 1311 1311 1322 1322 1322 1322 1327 1327 1327 1327 1393 1393 1393 1393 1395 1395 1395 1395 1395 1395 1405 1405 1405 1405 1407 1407 1407 1407 1407 1407 1418 1418 1418 1418 1418 1418 1428 1428 1428 1428 1428 1428 1443 1443 1443 1443 1445 1445 1445 1445 1445 1445 1448 1448 1448 1448 1448 1448 1456 1472 1472 1472 1472 1477 1477 1477 1477 1477 1477 1482 1482 1482 1482 1482 1482 1499 1511 1533 1535 1537 1557 1559 1902 1906 1918 1922 1934 1938 2032 2039 2039 2042 2067 2247 2251 2393 2393 2421 2424 2424 2434 2434 assign_ 000110 constant entry external dcl 2229 ref 2255 az 000141 constant char(26) initial packed unaligned dcl 312 ref 1034 1383 1389 baseno builtin function dcl 320 ref 711 711 798 803 824 bc_in 000451 automatic fixed bin(24,0) dcl 129 set ref 456* 462 bc_out 000452 automatic fixed bin(24,0) dcl 129 set ref 421* bin builtin function dcl 320 ref 2405 2405 2405 2405 bit_length 000172 automatic fixed bin(35,0) dcl 2110 set ref 2346* 2347 2348 2349* 2349 2351 2356* 2357 2358 2359* 2359 2361 block_size 2 based fixed bin(17,0) level 3 dcl 2-15 ref 725 859 caller parameter varying char dcl 1957 in procedure "get_temp_seg" set ref 1954 1965 1966 1968* 1972 1975 1976 caller parameter char packed unaligned dcl 106 in procedure "sort_seg_" set ref 374 426* 426* 438* 449* 458* 483 536 574 673* 683* 755 895* 934* 951* 961* 1151* 1202* 1231* 1239* 1282* 1340* 1398* 1410* 1421* 1431* case_field 000100 automatic fixed bin(17,0) array dcl 977 set ref 1247* 1348 1350* 1354* 1359* 1364* 1368* 1372* 1376* 1380* 1381 case_regexp 000100 automatic fixed bin(17,0) array dcl 977 set ref 1057* 1059* 1063* 1067* 1071* 1118 1124 1174 1306 cd parameter fixed bin(35,0) dcl 2558 ref 2554 2560 char_type 000132 constant fixed bin(17,0) initial dcl 2233 set ref 2255* charno builtin function dcl 320 ref 712 713 cleanup 000564 stack reference condition dcl 320 ref 419 520 570 code 000100 automatic fixed bin(35,0) dcl 1957 in procedure "get_temp_seg" set ref 1965* 1966* 1968 1968* 1970 code parameter fixed bin(35,0) dcl 106 in procedure "sort_seg_" set ref 374 421* 424 424 426* 436* 437 438* 443 445* 446* 448 449* 456* 457 458* 465 468 471 483 503* 523 525 536 553* 586 588 672* 673* 682* 683* 796* 877* 881 890 891* 895* 946* 960* 961* 967 1089* 1091* 1094* 1114* 1116* 1122* 1137* 1141 1146 1147* 1151* 1183* 1189* 1193 1197 1198* 1202* 1230* 1231* 1238* 1239* 1268* 1272 1277 1278* 1282* 1311* 1322* 1327* 1331 1335 1336* 1340* 1393* 1395* 1397 1398* 1405* 1407* 1409 1410* 1418* 1420 1421* 1428* 1430 1431* 1443* 1445* 1448* 1574 1631* code 000100 automatic fixed bin(35,0) dcl 1988 in procedure "seg_janitor" set ref 2004* 2007* 2009* 2012* code parameter fixed bin(35,0) dcl 2111 in procedure "encode_numeric" set ref 2097 2370* 2560* command_query_$yes_no 000026 constant entry external dcl 326 ref 426 934 comp_base_number 000454 automatic bit(18) packed unaligned dcl 129 set ref 798* 803 824 component_idx 000100 automatic fixed bin(21,0) array dcl 1601 set ref 1608* 1613 1617 1619 1641 1643* 1646* 1646 1650 component_number 000453 automatic fixed bin(17,0) dcl 129 set ref 560* 584* 798 2058 2059 2059 2061 2061 2063 2063 2076 conversion 000000 stack reference condition dcl 320 ref 1229 1460 cp_ptr 000174 automatic pointer dcl 2115 set ref 2242* 2293 2294 2297 2300 2379 2380 2391 2392 2393 2397 2398 2410 2411 2411 2411 2415 2424 2425 2427 2429 2432 2434 2434 2438 2440 2443 2445 2445 2481 2482 2485 2486 2493 2494 2497 2498 2510 2511 2512 2513 2516 2517 2520 2521 2524 2525 2533 2534 2535 2536 2539 2540 2543 2544 2547 2548 currentsize builtin function dcl 320 ref 1607 delim 10 based structure level 3 dcl 2-15 desc_array parameter pointer array dcl 106 set ref 536 1089* 1114* 1393* 1405* 1443* desc_ptr 000622 automatic pointer dcl 3-19 set ref 2243* 2248 2249 2252 2253 2259 2261 2261 2267 2267 2273 2273 2279 2279 2291 2305 2346 2347 2356 2357 2405 2405 2405 2405 2475 2504 descending 321 based bit(1) array level 4 packed packed unaligned dcl 2-15 ref 740 1350 1354 1359 1364 1368 1372 1376 1451 descriptor based structure level 1 unaligned dcl 3-6 digit 0(18) based picture(1) array level 2 in structure "fld_enc" packed packed unaligned dcl 2155 in procedure "encode_numeric" set ref 2415* 2429* 2432* 2440* 2443* digit 0(09) based picture(1) array level 2 in structure "fxd" packed packed unaligned dcl 2144 in procedure "encode_numeric" set ref 2297* 2297 2300* 2300 digit 0(09) based picture(1) array level 2 in structure "fld_src" packed packed unaligned dcl 2148 in procedure "encode_numeric" ref 2407 2429 2440 digit_len 000203 automatic fixed bin(17,0) dcl 2221 set ref 2478* 2482 2482 2486 2486 2490* 2494 2494 2498 2498 2507* 2511 2512 2513 2513 2517 2517 2518 2524 2525 2530* 2534 2535 2535 2536 2536 2540 2540 2541 2547 2548 2548 digits 0(05) based bit level 2 in structure "even_fxd4_src" packed packed unaligned dcl 2167 in procedure "encode_numeric" ref 2494 2498 digits 0(05) based bit level 2 in structure "odd_fxd4_src" packed packed unaligned dcl 2162 in procedure "encode_numeric" ref 2482 2486 digits 0(09) based bit level 2 in structure "even_fxd4_enc" packed packed unaligned dcl 2178 in procedure "encode_numeric" set ref 2494* 2498* digits 0(05) based bit level 2 in structure "odd_fxd4_enc" packed packed unaligned dcl 2173 in procedure "encode_numeric" set ref 2482* 2486* digits 0(05) based bit level 2 in structure "even_fld4_src" packed packed unaligned dcl 2184 in procedure "encode_numeric" ref 2536 2540 2541 digits 0(18) based bit level 2 in structure "even_fld4_enc" packed packed unaligned dcl 2212 in procedure "encode_numeric" set ref 2536* 2540* digits 0(14) based bit level 2 in structure "odd_fld4_enc" packed packed unaligned dcl 2204 in procedure "encode_numeric" set ref 2513* 2517* digits 0(05) based bit level 2 in structure "odd_fld4_src" packed packed unaligned dcl 2195 in procedure "encode_numeric" ref 2513 2517 2518 dim builtin function dcl 320 ref 413 514 564 598 divide builtin function dcl 320 ref 462 2368 dp parameter pointer dcl 2109 ref 2097 2243 du based char packed unaligned dcl 214 set ref 1509 1511 1521 1523 1527* 1533 1553* 1557 1692 1696 1699 1705 1712 1731 1738 1749 1758 1770 1777 1784 1795 1808 1815 1827 du_line based char packed unaligned dcl 1874 set ref 1514 1541 1541* 1541 1563 1563* 1563 1905 1908 1908 du_prev based char packed unaligned dcl 214 ref 1696 1705 1712 1718 1731 1738 1745 1758 1777 1784 1790 1808 1815 1822 du_text based char packed unaligned dcl 1874 set ref 1541 1563 1902 1903 1904 du_text_char based char(1) array packed unaligned dcl 1874 set ref 1906 dul based structure level 1 dcl 214 dup based structure level 1 dcl 214 dup_ptr 2 based pointer array level 2 dcl 229 set ref 583* 590* 606 1640 2059 2059* 2077 duplicate_mode 4 based fixed bin(17,0) level 3 dcl 2-15 ref 1690 encd_len 000455 automatic fixed bin(21,0) dcl 129 in procedure "sort_seg_" set ref 1393* 1395* 1405* 1407* 1415 1418* 1428* 1436 encd_len parameter fixed bin(21,0) dcl 2122 in procedure "encode_numeric" set ref 2097 2368* encd_ptr parameter pointer dcl 2123 ref 2097 2242 encd_str 000456 automatic char(256) packed unaligned dcl 129 set ref 1089 1089 1091 1091 1094 1094 1114 1114 1116 1116 1122 1122 1405 1405 1407 1407 1415 1428 1428 1436 epad 0(09) based bit(1) level 2 packed packed unaligned dcl 2155 set ref 2411* 2425* error_table_$bad_conversion 000044 external static fixed bin(35,0) dcl 336 ref 1230 error_table_$chars_after_delim 000046 external static fixed bin(35,0) dcl 336 set ref 934* 946 951* error_table_$file_is_full 000050 external static fixed bin(35,0) dcl 336 ref 1631 error_table_$moderr 000052 external static fixed bin(35,0) dcl 336 ref 424 error_table_$no_delimiter 000054 external static fixed bin(35,0) dcl 336 ref 960 error_table_$no_w_permission 000060 external static fixed bin(35,0) dcl 336 ref 424 error_table_$noentry 000062 external static fixed bin(35,0) dcl 336 ref 443 error_table_$nomatch 000056 external static fixed bin(35,0) dcl 336 ref 890 1146 1197 1277 1335 error_table_$out_of_bounds 000064 external static fixed bin(35,0) dcl 336 ref 1238 error_table_$unimplemented_version 000066 external static fixed bin(35,0) dcl 336 ref 672 error_table_$zero_length_seg 000070 external static fixed bin(35,0) dcl 336 ref 682 esign based bit(1) level 2 in structure "fld_src" packed packed unaligned dcl 2148 in procedure "encode_numeric" set ref 2421 2424 esign 0(10) based bit(1) level 2 in structure "even_fld4_enc" packed packed unaligned dcl 2212 in procedure "encode_numeric" set ref 2534* 2543* 2547* esign 0(01) based bit(1) level 2 in structure "flb_enc" packed packed unaligned dcl 2138 in procedure "encode_numeric" set ref 2393 2397* esign 0(10) based bit(1) level 2 in structure "fld_enc" packed packed unaligned dcl 2155 in procedure "encode_numeric" set ref 2411* 2424 2434 2434 2445* 2445 esign based bit(1) level 2 in structure "flb_src" packed packed unaligned dcl 2132 in procedure "encode_numeric" set ref 2393 2397 esign 0(06) based bit(1) level 2 in structure "odd_fld4_enc" packed packed unaligned dcl 2204 in procedure "encode_numeric" set ref 2511* 2520* 2524* eval 0(11) based bit(7) level 2 in structure "fld_enc" packed packed unaligned dcl 2155 in procedure "encode_numeric" set ref 2411* eval 0(02) based bit(7) level 2 in structure "flb_enc" packed packed unaligned dcl 2138 in procedure "encode_numeric" set ref 2398* eval 0(01) based bit(7) level 2 in structure "flb_src" packed packed unaligned dcl 2132 in procedure "encode_numeric" ref 2398 even_fld4_enc based structure level 1 packed packed unaligned dcl 2212 even_fld4_src based structure level 1 packed packed unaligned dcl 2184 even_fxd4_enc based structure level 1 packed packed unaligned dcl 2178 even_fxd4_src based structure level 1 packed packed unaligned dcl 2167 exp 0(07) based bit(7) level 2 in structure "odd_fld4_enc" packed packed unaligned dcl 2204 in procedure "encode_numeric" set ref 2512* 2521* 2525* exp based structure level 2 in structure "even_fld4_src" packed packed unaligned dcl 2184 in procedure "encode_numeric" exp based bit(7) level 3 in structure "odd_fld4_src" packed packed unaligned dcl 2195 in procedure "encode_numeric" ref 2512 2525 exp based structure level 2 in structure "odd_fld4_src" packed packed unaligned dcl 2195 in procedure "encode_numeric" exp 0(11) based bit(7) level 2 in structure "even_fld4_enc" packed packed unaligned dcl 2212 in procedure "encode_numeric" set ref 2535* 2544* 2548* fb7 based fixed bin(7,0) packed unaligned dcl 2126 set ref 2421 2424* 2424 2434* 2434 fb8 based fixed bin(8,0) packed unsigned unaligned dcl 2127 set ref 2393* 2393 field 113 based structure array level 2 dcl 2-15 field_count 3 based fixed bin(17,0) level 3 dcl 2-15 ref 727 733 977 977 977 1056 1077 1087 1112 1211 1257 fixed builtin function dcl 320 ref 2252 2253 2261 2267 2273 2279 2291 2305 2346 2356 2475 2504 flb_enc based structure level 1 packed packed unaligned dcl 2138 flb_src based structure level 1 packed packed unaligned dcl 2132 fld_enc based structure level 1 packed packed unaligned dcl 2155 fld_src based structure level 1 packed packed unaligned dcl 2148 floor builtin function dcl 320 ref 2346 2356 found 000654 automatic bit(1) packed unaligned dcl 659 set ref 820* 828* 830 from 113 based structure array level 3 dcl 2-15 fxb based structure level 1 packed packed unaligned dcl 2128 fxd based structure level 1 packed packed unaligned dcl 2144 get_temp_segment_ 000074 constant entry external dcl 1962 ref 1966 hcs_$delentry_seg 000030 constant entry external dcl 326 ref 2007 hcs_$make_seg 000032 constant entry external dcl 326 ref 445 header based structure level 2 dcl 2-15 high based bit(3) level 3 packed packed unaligned dcl 2184 ref 2535 2548 id 000556 automatic varying char(15) dcl 129 set ref 574* 575* 755* 757* 758* 759* 761* 764* 765* 769* 771* 775* 780* 1028* 1068* 1251* 2028* 2036* 2037* 2038* 2043* 2045* 2046* 2047* 2048* 2049* 2050* 2080* 2081* 2082* 2087* 2090* idx based structure level 1 dcl 214 set ref 1472 1472 1477 1477 1482 1482 idx1 based structure level 1 dcl 229 idx_merge based structure level 1 dcl 229 idx_ptr based pointer array level 2 dcl 229 set ref 581* 593* 607 1611 1616 1650 2061 2061* 2078 in based char packed unaligned dcl 210 set ref 680 711 712 714 858 859 864 870 877 877 877 877 904 922 927 928 1851 1851 1853 1854 2032 in_char based char(1) array packed unaligned dcl 210 set ref 910 in_dir parameter char packed unaligned dcl 106 set ref 374 456* 458* 458 683* 683 934* 934 951* 951 961* 961 1231* 1231 1239* 1239 1398* 1398 1410* 1410 1421* 1421 1431* 1431 in_ent parameter char packed unaligned dcl 106 set ref 374 456* 458* 683* 934* 951* 961* 1231* 1239* 1398* 1410* 1421* 1431* in_ptr parameter pointer dcl 106 ref 536 572 in_string parameter char packed unaligned dcl 106 set ref 483 505 506 index builtin function dcl 320 ref 870 927 1132 1169 1263 1301 1523 1524 1526 1903 1919 1935 initiate_file_ 000034 constant entry external dcl 326 ref 421 456 integer 321(03) based bit(1) array level 4 packed packed unaligned dcl 2-15 ref 728 1094 1121 1350 1354 1359 1364 1368 1372 1376 1448 ioa_ 000036 constant entry external dcl 326 ref 1496 1527 1541 1553 1563 1643 j 000176 automatic fixed bin(17,0) dcl 2118 set ref 2295* 2297 2297* 2299* 2300 2300* 2407* 2407* 2409 2414* 2415* 2419 2420 2428* 2429 2429* 2431* 2432* 2439* 2440 2440* 2442* 2443* lcb_ptr parameter pointer dcl 106 set ref 536 1965* 1975* length builtin function dcl 320 ref 426 426 426 426 426 426 426 426 426 426 506 508 680 714 716 858 859 864 873 874 877 877 877 877 883 922 928 1003 1025 1025 1034 1035 1036 1059 1061 1061 1089 1089 1091 1091 1094 1094 1103 1114 1114 1116 1116 1118 1122 1122 1124 1134 1137 1137 1137 1137 1157 1160 1162 1166 1176 1181 1182 1182 1183 1183 1183 1183 1188 1189 1189 1189 1189 1211 1265 1268 1268 1268 1268 1288 1292 1294 1298 1308 1311 1311 1311 1311 1320 1321 1321 1322 1322 1322 1322 1327 1327 1327 1327 1443 1443 1445 1445 1448 1448 1500 1502 1514 1527 1536 1541 1541 1541 1541 1541 1541 1541 1541 1560 1563 1563 1563 1563 1563 1851 1853 1854 1904 1905 1908 1920 1921 1924 1936 1937 1940 low based bit(4) level 3 packed packed unaligned dcl 2184 ref 2535 2548 max builtin function dcl 320 ref 1208 1502 1514 max_Lout 000563 automatic fixed bin(21,0) dcl 129 set ref 454* 508* 711 713 716 1692 1699 1718 1745 1749 1770 1790 1795 1822 1827 1851 1858 1858 max_ptrs_per_seg 000011 internal static fixed bin(21,0) initial dcl 336 set ref 1607* 1629 max_seg_size 000012 internal static fixed bin(21,0) initial dcl 336 set ref 669 669* 856 1026 1249 1383 1386 1389 1390 1390 1393 1393 1395 1395 1415 1418 1418 1436 1439 1443 1443 1445 1445 1448 1448 1450 1451 1451 1456 mdbm_error_$invalid_dec_data 000106 external static fixed bin(35,0) dcl 2227 set ref 2405* mdbm_error_$key_encd_ovfl 000102 external static fixed bin(35,0) dcl 2223 set ref 2421* mdbm_error_$unsup_type 000100 external static fixed bin(35,0) dcl 2223 set ref 2285* 2311* 2364* min builtin function dcl 320 ref 1162 1166 1294 1298 mod builtin function dcl 320 ref 2347 2348 2357 2358 2476 2505 modes 321 based structure array level 3 dcl 2-15 msign 0(08) based bit(1) level 2 in structure "flb_src" packed packed unaligned dcl 2132 in procedure "encode_numeric" ref 2391 2393 msign based char(1) level 2 in structure "fld_src" packed packed unaligned dcl 2148 in procedure "encode_numeric" ref 2426 msign based bit(1) level 2 in structure "flb_enc" packed packed unaligned dcl 2138 in procedure "encode_numeric" set ref 2391* msign based char(1) level 2 in structure "fld_enc" packed packed unaligned dcl 2155 in procedure "encode_numeric" set ref 2410* 2427* 2438* mval 0(09) based bit level 2 in structure "flb_src" packed packed unaligned dcl 2132 in procedure "encode_numeric" ref 2392 mval 0(09) based bit level 2 in structure "flb_enc" packed packed unaligned dcl 2138 in procedure "encode_numeric" set ref 2392* non_case_sensitive 321(01) based bit(1) array level 4 packed packed unaligned dcl 2-15 ref 741 1350 1354 1359 null builtin function dcl 320 ref 404 405 406 410 412 414 416 417 418 438 438 446 449 449 458 458 511 513 515 517 518 519 557 558 561 563 565 567 568 569 581 582 583 591 592 594 596 599 600 673 673 683 683 895 895 951 951 961 961 1068 1151 1151 1202 1202 1231 1231 1239 1239 1282 1282 1340 1340 1398 1398 1410 1410 1421 1421 1431 1431 1968 1968 2004 2006 2012 2030 2032 2034 2039 2058 2059 2061 2063 2067 2075 num_dims 000624 automatic fixed bin(17,0) initial dcl 3-20 set ref 3-20* number 114 based fixed bin(17,0) array level 4 in structure "ss_info" dcl 2-15 in procedure "sort_seg_" ref 733 1099 1129 1260 number 11 based fixed bin(17,0) level 4 in structure "ss_info" dcl 2-15 in procedure "sort_seg_" ref 806 827 864 866 867 number 217 based fixed bin(17,0) array level 4 in structure "ss_info" dcl 2-15 in procedure "sort_seg_" ref 733 1078 1097 1099 1160 1162 1166 1292 1294 1298 numeric 321(02) based bit(1) array level 4 packed packed unaligned dcl 2-15 ref 728 1088 1113 1350 1354 1359 1364 1368 1372 1376 1442 odd_fld4_enc based structure level 1 packed packed unaligned dcl 2204 odd_fld4_src based structure level 1 packed packed unaligned dcl 2195 odd_fxd4_enc based structure level 1 packed packed unaligned dcl 2173 odd_fxd4_src based structure level 1 packed packed unaligned dcl 2162 offset 000177 automatic fixed bin(17,0) dcl 2118 set ref 2302* 2308* 2351* 2361* 2368 2381* 2400* org_data 000206 automatic fixed dec(59,0) dcl 2231 set ref 2247 org_len 000226 automatic fixed bin(35,0) dcl 2235 set ref 2251 2255* org_ptr 000204 automatic pointer dcl 2230 set ref 2247* 2255* 2258 org_type 000225 automatic fixed bin(17,0) dcl 2232 set ref 2248* 2249* 2249 2255* out based char packed unaligned dcl 210 set ref 711 713 716 1692* 1699* 1718* 1745* 1749* 1770* 1790* 1795* 1822* 1827* 1851* 1858* 1858 out_dir parameter char packed unaligned dcl 106 set ref 374 421* 426 426* 426 426 436* 438* 438 445* 449* 449 out_ent parameter char packed unaligned dcl 106 set ref 374 421* 426 426* 426 436* 438* 445* 449* out_len parameter fixed bin(21,0) dcl 106 set ref 374 401* 483 501* 1861* 2009 out_ptr parameter pointer dcl 106 ref 536 573 out_string parameter char packed unaligned dcl 106 set ref 483 507 508 p 000200 automatic fixed bin(17,0) dcl 2118 set ref 2261* 2263* 2267* 2269* 2273* 2275* 2279* 2281* 2291* 2295 2299 2302 2305* 2308 2380 2380 2381 2392 2392 2400 2407 2409 2414 2419 2421 2424 2428 2431 2431 2439 2442 2442 2475* 2476 2478 2490 2504* 2505 2507 2530 packed 0(07) based bit(1) level 2 packed packed unaligned dcl 3-6 ref 2249 2261 2267 2273 2279 2347 2357 pad_length 000173 automatic fixed bin(35,0) dcl 2110 set ref 2348* 2349 2358* 2359 power_delta 000201 automatic fixed bin(7,0) dcl 2124 set ref 2419* 2421 2424 prec 0(18) based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 2238 set ref 2252* precision 0(24) based bit(12) level 3 packed packed unaligned dcl 3-6 ref 2252 2261 2267 2273 2279 2291 2305 2346 2356 2405 2405 2475 2504 release_temp_segment_ 000076 constant entry external dcl 1962 ref 1976 rtrim builtin function dcl 320 ref 426 426 426 426 574 755 save based structure level 1 dcl 229 scale 0(12) based bit(12) level 3 in structure "descriptor" packed packed unaligned dcl 3-6 in procedure "sort_seg_" ref 2253 scale based fixed bin(17,0) level 2 in structure "target_len" packed packed unaligned dcl 2238 in procedure "encode_numeric" set ref 2253* search_file_$silent 000014 constant entry external dcl 307 ref 877 1137 1183 1189 1268 1311 1322 1327 seg_id parameter char packed unaligned dcl 1957 ref 1954 1965 1966 1972 1975 1976 sf based char packed unaligned dcl 280 set ref 1526 1527 1527 1537 1726 1765 1803 sf1 based char packed unaligned dcl 229 ref 1620 sf_line based char packed unaligned dcl 1874 set ref 1541* 1541 1937 1940 1940 sf_merge based char packed unaligned dcl 229 set ref 1620 1643* sf_ncs based char packed unaligned dcl 280 set ref 1034* 1035* 1036 sf_prev based char packed unaligned dcl 280 ref 1726 1765 1803 sf_str based char packed unaligned dcl 280 set ref 1383* 1386* 1389* 1390* 1390 1393 1393 1395 1395 1415* 1418 1418 1436* 1439* 1443 1443 1445 1445 1448 1448 1450* 1451* 1451 1456* sf_str_char based char(1) array packed unaligned dcl 280 set ref 1032 1255 sf_str_ptr based pointer array level 2 dcl 229 set ref 597 2067 2067* 2086 sf_text based char packed unaligned dcl 1874 set ref 1541 1934 1935 1936 sf_text_char based char(1) array packed unaligned dcl 1874 set ref 1938 sfl based structure level 1 dcl 280 set ref 1477 1477 sfp based structure level 1 dcl 280 set ref 1472 1472 1477 1477 sfp1 based structure level 1 dcl 229 sfp_merge based structure level 1 dcl 229 sfp_ptr based pointer array level 2 dcl 229 set ref 582* 595* 1612 1618 2063 2063* 2079 shift_delta 000202 automatic fixed bin(7,0) dcl 2124 set ref 2420* 2428 2429 2431 2439 2440 2442 sign 0(01) based bit(4) level 2 in structure "odd_fxd4_enc" packed packed unaligned dcl 2173 in procedure "encode_numeric" set ref 2481* 2485* sign 0(01) based bit(4) level 2 in structure "odd_fld4_src" packed packed unaligned dcl 2195 in procedure "encode_numeric" ref 2508 sign based bit(1) level 3 in structure "even_fld4_src" packed packed unaligned dcl 2184 in procedure "encode_numeric" ref 2534 2547 sign 0(06) based bit(4) level 2 in structure "even_fld4_enc" packed packed unaligned dcl 2212 in procedure "encode_numeric" set ref 2533* 2539* sign 0(01) based bit(4) level 2 in structure "even_fxd4_src" packed packed unaligned dcl 2167 in procedure "encode_numeric" ref 2491 sign 0(01) based bit(4) level 2 in structure "even_fld4_src" packed packed unaligned dcl 2184 in procedure "encode_numeric" ref 2531 sign 0(02) based bit(4) level 2 in structure "odd_fld4_enc" packed packed unaligned dcl 2204 in procedure "encode_numeric" set ref 2510* 2516* sign 0(01) based bit(4) level 2 in structure "odd_fxd4_src" packed packed unaligned dcl 2162 in procedure "encode_numeric" ref 2479 sign based bit(1) level 3 in structure "odd_fld4_src" packed packed unaligned dcl 2195 in procedure "encode_numeric" ref 2511 2524 sign 0(05) based bit(4) level 2 in structure "even_fxd4_enc" packed packed unaligned dcl 2178 in procedure "encode_numeric" set ref 2493* 2497* sign based bit(1) level 2 in structure "fxb" packed packed unaligned dcl 2128 in procedure "encode_numeric" set ref 2379* 2379 sign based char(1) level 2 in structure "fxd" packed packed unaligned dcl 2144 in procedure "encode_numeric" set ref 2293 2293* 2294* 2295 size 0(12) based structure level 2 packed packed unaligned dcl 3-6 ref 1237 1460 sort_items_indirect_$adj_char 000016 constant entry external dcl 307 ref 1477 1482 sort_items_indirect_$char 000020 constant entry external dcl 307 ref 1472 sorted 2 based bit(1) level 2 dcl 229 ref 799 spp based structure level 1 dcl 229 sppo based structure level 1 unaligned dcl 229 src_len parameter fixed bin(21,0) dcl 2236 ref 2097 2255 src_ptr parameter pointer dcl 2115 set ref 2097 2255* 2258* 2293 2295 2297 2300 2379 2380 2391 2392 2393 2393 2397 2398 2405* 2407 2421 2424 2426 2429 2440 2479 2482 2486 2491 2494 2498 2508 2511 2512 2513 2517 2518 2524 2525 2531 2534 2535 2535 2536 2540 2541 2547 2548 2548 ss_info based structure level 1 dcl 2-15 ss_info_ptr parameter pointer dcl 2-15 ref 374 483 536 671 673 723 725 727 728 728 733 733 733 733 733 740 741 806 827 859 862 864 866 867 870 873 874 877 877 877 877 883 883 895 977 977 977 1001 1003 1056 1057 1059 1061 1061 1063 1063 1077 1078 1078 1081 1081 1087 1088 1094 1097 1097 1099 1099 1112 1113 1121 1121 1129 1132 1134 1137 1137 1137 1137 1151 1158 1160 1162 1166 1169 1183 1183 1183 1183 1189 1189 1189 1189 1202 1211 1257 1258 1260 1263 1265 1268 1268 1268 1268 1282 1290 1292 1294 1298 1301 1311 1311 1311 1311 1322 1322 1322 1322 1327 1327 1327 1327 1340 1350 1350 1350 1350 1354 1354 1354 1354 1359 1359 1359 1359 1364 1364 1364 1368 1368 1368 1372 1372 1372 1376 1376 1376 1442 1448 1451 1690 stable based char(4) packed unaligned dcl 208 ref 1025 1035 1103 1211 1456 string 12 based varying char(256) level 4 in structure "ss_info" dcl 2-15 in procedure "sort_seg_" set ref 870 873 874 877 877 877 877 883 883 895* 1003 1063 string 115 based varying char(256) array level 4 in structure "ss_info" dcl 2-15 in procedure "sort_seg_" set ref 1132 1134 1137 1137 1137 1137 1151* 1263 1265 1268 1268 1268 1268 1282* string 220 based varying char(256) array level 4 in structure "ss_info" dcl 2-15 in procedure "sort_seg_" set ref 1057 1059 1061 1061 1169 1183 1183 1183 1183 1189 1189 1189 1189 1202* 1301 1311 1311 1311 1311 1322 1322 1322 1322 1327 1327 1327 1327 1340* sub_err_ 000040 constant entry external dcl 326 ref 438 449 458 673 683 895 951 961 1151 1202 1231 1239 1282 1340 1398 1410 1421 1431 1968 substr builtin function dcl 320 set ref 870 877 877 883 904* 904 927 1034* 1035* 1061 1137 1137 1169 1182* 1183 1183 1189 1189 1231 1231 1239 1239 1268 1268 1301 1311 1311 1321* 1322 1322 1327 1327 1383* 1383 1386 1386 1389* 1389 1390 1390 1393 1393 1393 1393 1395 1395 1395 1395 1398 1398 1405 1405 1407 1407 1410 1410 1415 1415 1418 1418 1418 1418 1421 1421 1428 1428 1431 1431 1436 1436 1439* 1439 1443 1443 1445 1445 1448 1448 1450* 1451 1451 1456* 1509 1521 1527 1527 1692* 1699* 1718* 1745* 1749* 1770* 1790* 1795* 1822* 1827* 1851* 1851 1858* 1858 1908 1924 1940 sum builtin function dcl 320 ref 1104 1212 sup based structure level 1 dcl 229 supo based structure level 1 dcl 229 set ref 1607 sys_info$max_seg_size 000072 external static fixed bin(35,0) dcl 336 ref 454 669 1607 target_len based structure level 1 dcl 2238 target_len_ptr 000230 automatic pointer dcl 2237 set ref 2251* 2252 2253 temp_dir parameter char packed unaligned dcl 106 set ref 536 554 1965* temp_seg_mgr$get parameter entry variable dcl 106 ref 536 1965 temp_seg_mgr$release parameter entry variable dcl 106 ref 536 1975 terminate_file_ 000042 constant entry external dcl 326 ref 2004 2009 termination_mode parameter bit packed unaligned dcl 1985 set ref 1982 2009* to 216 based structure array level 3 dcl 2-15 translate builtin function dcl 320 ref 1034 1383 1389 type 10 based fixed bin(17,0) level 4 in structure "ss_info" dcl 2-15 in procedure "sort_seg_" ref 723 862 1001 1063 type 113 based fixed bin(17,0) array level 4 in structure "ss_info" dcl 2-15 in procedure "sort_seg_" ref 733 1081 1121 1258 type parameter fixed bin(2,0) dcl 658 in procedure "prepare_to_sort" ref 656 680 681 710 785 934 934 951 961 type 0(01) based fixed bin(6,0) level 2 in structure "descriptor" packed packed unsigned unaligned dcl 3-6 in procedure "sort_seg_" ref 2248 2259 2405 2405 type 216 based fixed bin(17,0) array level 4 in structure "ss_info" dcl 2-15 in procedure "sort_seg_" ref 733 1078 1081 1097 1158 1290 type parameter fixed bin(2,0) dcl 977 in procedure "sort" ref 976 1089 1114 1231 1231 1239 1239 1393 1398 1398 1405 1410 1410 1421 1421 1431 1431 1443 undelim_char_index parameter fixed bin(21,0) dcl 106 set ref 374 402* 483 502* 924* 1850 1851 1851 1853 1854* 1854 unspec builtin function dcl 320 set ref 1386* 1386 1390* 1390 1415* 1415 1436* 1436 1451* 1451 uu based char packed unaligned dcl 280 set ref 1025 1034 1034 1035 1132 1137 1137 1137 1137 1157 1160 1162 1166 1169 1176 1180 1189 1189 1189 1189 1231 1231 1239 1239 1263 1268 1268 1268 1268 1288 1292 1294 1298 1301 1308 1311 1311 1311 1311 1319 1327 1327 1327 1327 1383 1386 1389 1393 1393 1395 1395 1398 1398 1405 1405 1407 1407 1410 1410 1418 1418 1421 1421 1428 1428 1431 1431 1439 1499 1500 1524 1527* 1527 1535 1536 1553* 1559 1560 uu_line based char packed unaligned dcl 1874 set ref 1502 1541 1541* 1541 1563* 1563 1921 1924 1924 uu_str based char packed unaligned dcl 280 set ref 904* uu_str_char based char(1) array packed unaligned dcl 280 set ref 915 uu_temp based char packed unaligned dcl 280 set ref 1180* 1182 1182* 1183 1183 1183 1183 1319* 1321 1321* 1322 1322 1322 1322 uu_text based char packed unaligned dcl 1874 set ref 1541 1563 1918 1919 1920 uu_text_char based char(1) array packed unaligned dcl 1874 set ref 1922 uul based structure level 1 dcl 280 set ref 1482 1482 uup based structure level 1 dcl 280 set ref 1482 1482 val 0(01) based bit level 2 packed packed unaligned dcl 2128 set ref 2380* 2380 valid_decimal_ 000104 constant entry external dcl 2226 ref 2405 version based char(8) level 3 dcl 2-15 set ref 671 673* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ACTION_CANT_RESTART internal static bit(36) initial dcl 6-7 ACTION_CAN_RESTART internal static bit(36) initial dcl 6-7 ACTION_QUIET_RESTART internal static bit(36) initial dcl 6-7 ACTION_SUPPORT_SIGNAL internal static bit(36) initial dcl 6-7 A_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 A_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 DIR_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 1-33 E_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 E_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 M_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 M_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 N_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 N_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 REW_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 REW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RE_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 RE_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 R_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SA_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SEG_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 1-30 SMA_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SMA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SM_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SM_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SS_duplicates internal static fixed bin(17,0) initial dcl 2-15 SS_only_duplicate_keys internal static fixed bin(17,0) initial dcl 2-15 SS_only_duplicates internal static fixed bin(17,0) initial dcl 2-15 SS_only_unique internal static fixed bin(17,0) initial dcl 2-15 SS_only_unique_keys internal static fixed bin(17,0) initial dcl 2-15 SS_unique internal static fixed bin(17,0) initial dcl 2-15 SS_unique_keys internal static fixed bin(17,0) initial dcl 2-15 SS_unset internal static fixed bin(17,0) initial dcl 2-15 S_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 S_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 TERM_FILE_BC internal static bit(2) initial packed unaligned dcl 4-12 TERM_FILE_DELETE internal static bit(5) initial packed unaligned dcl 4-17 TERM_FILE_FORCE_WRITE internal static bit(4) initial packed unaligned dcl 4-16 TERM_FILE_TRUNC internal static bit(1) initial packed unaligned dcl 4-11 TERM_FILE_TRUNC_BC internal static bit(2) initial packed unaligned dcl 4-13 W_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 algol68_array_descriptor_dtype internal static fixed bin(17,0) initial dcl 5-25 algol68_bits_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_bool_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_byte_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_char_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_compl_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_format_dtype internal static fixed bin(17,0) initial dcl 5-25 algol68_int_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_long_compl_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_long_int_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_long_real_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_real_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_short_int_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_straight_dtype internal static fixed bin(17,0) initial dcl 5-25 algol68_struct_struct_bool_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_struct_struct_char_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_union_dtype internal static fixed bin(17,0) initial dcl 5-25 area_dtype internal static fixed bin(17,0) initial dcl 5-25 bit_dtype internal static fixed bin(17,0) initial dcl 5-25 c_enum_const_dtype internal static fixed bin(17,0) initial dcl 5-25 c_enum_dtype internal static fixed bin(17,0) initial dcl 5-25 c_typeref_dtype internal static fixed bin(17,0) initial dcl 5-25 c_union_dtype internal static fixed bin(17,0) initial dcl 5-25 char_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_char_string_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_5_ts_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_5_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_6_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_7_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_8_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_8_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_ls_overp_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_ts_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_ts_overp_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_structure_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_fix_bin_1_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_fix_bin_2_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_fix_dec_9bit_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_bin_1_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_bin_2_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_dec_9bit_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_dec_generic_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_hex_1_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 5-25 entry_dtype internal static fixed bin(17,0) initial dcl 5-25 ext_entry_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 ext_procedure_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 file_dtype internal static fixed bin(17,0) initial dcl 5-25 ft_char_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_complex_double_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_complex_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_double_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_external_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_hex_complex_double_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_hex_complex_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_hex_double_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_hex_real_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_integer_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_logical_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_real_dtype internal static fixed bin(17,0) initial dcl 5-96 int_entry_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 label_constant_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 label_dtype internal static fixed bin(17,0) initial dcl 5-25 offset_dtype internal static fixed bin(17,0) initial dcl 5-25 pascal_boolean_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_char_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_entry_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_enumerated_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_enumerated_type_element_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_enumerated_type_instance_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_exportable_procedure_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_imported_procedure_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_integer_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_internal_procedure_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_label_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_parameter_procedure_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_procedure_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_real_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_record_file_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_record_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_set_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_string_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_text_file_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_typed_pointer_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_user_defined_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_user_defined_type_instance_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_value_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_variable_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 5-132 picture_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 pointer_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_bin_1_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_bin_1_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_bin_2_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_bin_2_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_bytealigned_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_ts_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_ls_overp_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_ts_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_ts_overp_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_bin_1_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_bin_2_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_dec_4bit_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_dec_9bit_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_dec_generic_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_hex_1_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 5-25 ss_field_count automatic fixed bin(17,0) dcl 2-15 structure_dtype internal static fixed bin(17,0) initial dcl 5-25 terminate_file_switches based structure level 1 packed packed unaligned dcl 4-4 varying_bit_dtype internal static fixed bin(17,0) initial dcl 5-25 varying_char_dtype internal static fixed bin(17,0) initial dcl 5-25 NAMES DECLARED BY EXPLICIT CONTEXT. DUP 000045 constant label array(7) dcl 1692 ref 1690 1724 1755 1801 END_DUP 015414 constant label dcl 1837 ref 1694 END_DUP_SET_PREV 015410 constant label dcl 1833 ref 1696 1701 1722 1753 1773 1799 1831 END_FIND_DELIM 005057 constant label dcl 901 ref 868 875 888 END_LTH_FROM_FIELD 007130 constant label dcl 1157 ref 1130 1135 1144 END_LTH_TO_FIELD 007455 constant label dcl 1208 ref 1164 1167 1172 1177 1195 END_LTH_TO_REGEXP 007365 constant label dcl 1193 ref 1186 END_SET_FROM_FIELD 010406 constant label dcl 1288 ref 1261 1266 1275 END_SET_TO_FIELD 011007 constant label dcl 1346 ref 1296 1299 1304 1309 1333 END_SET_TO_REGEXP 010717 constant label dcl 1331 ref 1316 1325 FIELD_TYPE 000034 constant label array(0:8) dcl 1350 ref 1348 1381 FIND_DELIM 000002 constant label array(4) dcl 864 ref 862 LOOP_EXIT 004602 constant label dcl 833 ref 830 LTH_EMPTY_FIELD 007466 constant label dcl 1209 ref 1119 1125 1133 1148 1157 1170 1199 LTH_FROM_FIELD 000006 constant label array(2:4) dcl 1129 ref 1121 LTH_TO_FIELD 000011 constant label array(4) dcl 1160 ref 1158 LTH_TO_REGEXP 000015 constant label array(4) dcl 1176 ref 1174 MERGE_EXIT 014554 constant label dcl 1655 ref 1632 NEXT_FIELD 013033 constant label dcl 1454 ref 1384 1387 1391 1403 1416 1426 1437 1440 PREPARE_EXIT 005572 constant label dcl 967 ref 757 758 759 761 764 765 769 771 775 780 898 947 964 RE_INIT_OUTPUT 001506 constant label dcl 421 ref 437 SEG_EXIT 002410 constant label dcl 475 ref 435 440 452 460 465 468 471 SET_EMPTY_FIELD 012603 constant label dcl 1442 ref 1264 1279 1288 1302 1337 1347 SET_FROM_FIELD 000021 constant label array(2:4) dcl 1260 ref 1258 SET_TO_FIELD 000024 constant label array(4) dcl 1292 ref 1290 SET_TO_REGEXP 000030 constant label array(4) dcl 1308 ref 1306 SORT_EXIT 014217 constant label dcl 1574 ref 1028 1068 1154 1205 1234 1242 1251 1285 1343 1401 1413 1424 1434 STRING_EXIT 002606 constant label dcl 528 ref 523 525 TABLE_EXIT 003304 constant label dcl 617 ref 575 586 588 UNDELIM_CHARS 005145 constant label dcl 922 ref 864 871 892 dbf 003335 constant entry external dcl 638 dbn 003312 constant entry external dcl 632 debug_off 003345 constant entry external dcl 638 debug_on 003322 constant entry external dcl 632 encode 000054 constant label array(46) dcl 2261 ref 2259 encode_flb 020357 constant entry internal dcl 2386 ref 2276 2282 encode_fld 020443 constant entry internal dcl 2404 ref 2307 encode_fld4 021173 constant entry internal dcl 2503 ref 2354 encode_fxb 020331 constant entry internal dcl 2375 ref 2264 2270 encode_fxd4 021041 constant entry internal dcl 2474 ref 2344 encode_numeric 017706 constant entry internal dcl 2097 ref 1089 1091 1094 1114 1116 1122 1393 1395 1405 1407 1418 1428 1443 1445 1448 error 021501 constant entry internal dcl 2554 ref 2285 2311 2364 2405 2421 exit 020330 constant label dcl 2371 ref 2561 find_du_line 015501 constant entry internal dcl 1899 ref 1513 1540 1562 find_sf_line 015633 constant entry internal dcl 1931 ref 1540 find_uu_line 015556 constant entry internal dcl 1915 ref 1501 1540 1562 get_temp_seg 015711 constant entry internal dcl 1954 ref 575 757 758 759 761 764 765 769 771 775 780 1028 1068 1251 linus_table 002623 constant entry external dcl 536 merge 014231 constant entry internal dcl 1583 ref 614 next 020322 constant label dcl 2368 ref 2265 2271 2277 2283 2303 2309 2352 2362 output 014555 constant entry internal dcl 1659 ref 470 526 prepare_to_sort 003356 constant entry internal dcl 656 ref 464 522 585 release_temp_seg 016200 constant entry internal dcl 1972 ref 2028 2036 2037 2038 2043 2045 2046 2047 2048 2049 2050 2080 2081 2082 2087 2090 seg 001332 constant entry external dcl 374 seg_janitor 016411 constant entry internal dcl 1982 ref 419 472 475 sort 005602 constant entry internal dcl 976 ref 467 524 587 sort_janitor 016562 constant entry internal dcl 2022 ref 520 528 601 967 1574 2002 2073 sort_seg_ 001314 constant entry external dcl 102 sort_seg_$string 002433 constant entry external dcl 483 table_janitor 017256 constant entry internal dcl 2055 ref 570 617 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 22540 22652 21760 22550 Length 23332 21760 112 443 560 4 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME sort_seg_ 834 external procedure is an external procedure. on unit on line 419 76 on unit on unit on line 520 64 on unit on unit on line 570 64 on unit prepare_to_sort internal procedure shares stack frame of external procedure sort_seg_. sort 474 internal procedure uses auto adjustable storage, and enables or reverts conditions. on unit on line 1229 148 on unit on unit on line 1237 148 on unit merge 98 internal procedure uses auto adjustable storage. output internal procedure shares stack frame of external procedure sort_seg_. find_du_line internal procedure shares stack frame of internal procedure sort. get_temp_seg 124 internal procedure is called by several nonquick procedures. seg_janitor 86 internal procedure is called by several nonquick procedures. sort_janitor 104 internal procedure is called by several nonquick procedures. table_janitor 90 internal procedure is called by several nonquick procedures. encode_numeric internal procedure shares stack frame of internal procedure sort. encode_fxb internal procedure shares stack frame of internal procedure sort. encode_flb internal procedure shares stack frame of internal procedure sort. encode_fld internal procedure shares stack frame of internal procedure sort. encode_fxd4 internal procedure shares stack frame of internal procedure sort. encode_fld4 internal procedure shares stack frame of internal procedure sort. error internal procedure shares stack frame of internal procedure sort. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 Sdebug sort_seg_ 000011 max_ptrs_per_seg sort_seg_ 000012 max_seg_size sort_seg_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME get_temp_seg 000100 code get_temp_seg merge 000100 component_idx merge seg_janitor 000100 code seg_janitor sort 000100 case_field sort 000100 case_regexp sort 000100 Lfield sort 000172 bit_length encode_numeric 000173 pad_length encode_numeric 000174 cp_ptr encode_numeric 000176 j encode_numeric 000177 offset encode_numeric 000200 p encode_numeric 000201 power_delta encode_numeric 000202 shift_delta encode_numeric 000203 digit_len encode_numeric 000204 org_ptr encode_numeric 000206 org_data encode_numeric 000225 org_type encode_numeric 000226 org_len encode_numeric 000230 target_len_ptr encode_numeric sort_seg_ 000100 Ibk sort_seg_ 000101 Ichar sort_seg_ 000102 Icomp sort_seg_ 000103 Idu sort_seg_ 000104 Iend sort_seg_ 000105 If sort_seg_ 000106 Iline_end sort_seg_ 000107 Imatch sort_seg_ 000110 Imatch_end sort_seg_ 000111 Imerge sort_seg_ 000112 Iptr sort_seg_ 000113 Inl sort_seg_ 000114 Iseg sort_seg_ 000115 Isf_str sort_seg_ 000116 Iss sort_seg_ 000117 Istart sort_seg_ 000120 Its sort_seg_ 000121 Iu sort_seg_ 000122 Iu_prev sort_seg_ 000123 Iuss sort_seg_ 000124 Iuu sort_seg_ 000125 Iuu_str sort_seg_ 000126 Ix sort_seg_ 000127 Lall_fields sort_seg_ 000130 Ldelim sort_seg_ 000131 Ldss sort_seg_ 000132 Ldu sort_seg_ 000133 Ldu_prev sort_seg_ 000134 Lin sort_seg_ 000135 Lout sort_seg_ 000136 Lmatch sort_seg_ 000137 Luss sort_seg_ 000140 Luu sort_seg_ 000141 Luu_str sort_seg_ 000142 Luu_temp sort_seg_ 000143 Ndups sort_seg_ 000144 Ndups_prev sort_seg_ 000145 Nlines sort_seg_ 000146 Nsf_str_array sort_seg_ 000147 Nu sort_seg_ 000150 Oin sort_seg_ 000151 Oout sort_seg_ 000152 Paccess sort_seg_ 000154 Pin sort_seg_ 000156 Pout sort_seg_ 000160 Pdul sort_seg_ 000162 Pdup sort_seg_ 000164 Pidx sort_seg_ 000166 Pout_real sort_seg_ 000170 Pout_temp sort_seg_ 000172 Psf_str sort_seg_ 000174 Psfa sort_seg_ 000374 Psfl sort_seg_ 000376 Psfp sort_seg_ 000400 Puu_str sort_seg_ 000402 Puu_temp sort_seg_ 000404 Puul sort_seg_ 000406 Puup sort_seg_ 000410 Psave sort_seg_ 000412 Pspp sort_seg_ 000414 Psup sort_seg_ 000416 Psupo sort_seg_ 000420 Psppo sort_seg_ 000422 Pidx1 sort_seg_ 000424 Pidx_merge sort_seg_ 000426 Psfp1 sort_seg_ 000430 Psfp_merge sort_seg_ 000432 Psf1 sort_seg_ 000434 Psf_merge sort_seg_ 000436 Screated_output_seg sort_seg_ 000437 Sblocked sort_seg_ 000440 Sdescending_sort sort_seg_ 000441 Sfield sort_seg_ 000442 Snon_case_sensitive_sort sort_seg_ 000443 Snumeric sort_seg_ 000444 Soverlap sort_seg_ 000445 Stemp_dir sort_seg_ 000446 Svarying_delimiters sort_seg_ 000447 Svarying_fields sort_seg_ 000450 Syes sort_seg_ 000451 bc_in sort_seg_ 000452 bc_out sort_seg_ 000453 component_number sort_seg_ 000454 comp_base_number sort_seg_ 000455 encd_len sort_seg_ 000456 encd_str sort_seg_ 000556 id sort_seg_ 000563 max_Lout sort_seg_ 000572 Idu_nl sort_seg_ 000573 Iuu_nl sort_seg_ 000574 Isf_nl sort_seg_ 000575 Ldu_line sort_seg_ 000576 Ldu_longest sort_seg_ 000577 Ldu_text sort_seg_ 000600 Lsf_line sort_seg_ 000601 Lsf_text sort_seg_ 000602 Luu_line sort_seg_ 000603 Luu_longest sort_seg_ 000604 Luu_text sort_seg_ 000606 Pdu_line sort_seg_ 000610 Pdu_text sort_seg_ 000612 Psf_line sort_seg_ 000614 Psf_text sort_seg_ 000616 Puu_line sort_seg_ 000620 Puu_text sort_seg_ 000622 desc_ptr sort_seg_ 000624 num_dims sort_seg_ 000654 found prepare_to_sort THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_e_as r_ne_as alloc_char_temp alloc_bit_temp cat_realloc_chars call_ent_var_desc call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return_mac tra_ext_1 alloc_auto_adj mpfx2 mdfx1 signal_op enable_op shorten_stack ext_entry ext_entry_desc int_entry int_entry_desc trunc_fx2 set_chars_eis index_chars_eis unpack_picture divide_fx1 divide_fx3 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. access_$reset access_$set_temporarily assign_ command_query_$yes_no get_temp_segment_ hcs_$delentry_seg hcs_$make_seg initiate_file_ ioa_ release_temp_segment_ search_file_$silent sort_items_indirect_$adj_char sort_items_indirect_$char sub_err_ terminate_file_ valid_decimal_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_conversion error_table_$chars_after_delim error_table_$file_is_full error_table_$moderr error_table_$no_delimiter error_table_$no_w_permission error_table_$noentry error_table_$nomatch error_table_$out_of_bounds error_table_$unimplemented_version error_table_$zero_length_seg mdbm_error_$invalid_dec_data mdbm_error_$key_encd_ovfl mdbm_error_$unsup_type sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 3 20 001310 102 001313 104 001322 374 001323 401 001402 402 001403 404 001404 405 001406 406 001407 407 001410 408 001411 410 001412 411 001413 412 001414 413 001417 414 001421 415 001441 416 001443 417 001450 418 001452 419 001453 421 001506 424 001545 426 001553 435 001711 436 001714 437 001753 438 001755 440 002045 443 002046 444 002050 445 002052 446 002110 448 002115 449 002117 452 002213 454 002214 456 002220 457 002256 458 002260 460 002350 462 002351 464 002354 465 002356 467 002360 468 002366 470 002370 471 002371 472 002373 473 002407 475 002410 476 002424 483 002425 501 002471 502 002472 503 002473 505 002474 506 002477 507 002501 508 002503 509 002505 511 002506 512 002510 513 002511 514 002514 515 002516 516 002535 517 002537 518 002544 519 002546 520 002547 522 002571 523 002573 524 002575 525 002603 526 002605 528 002606 530 002612 536 002613 553 002650 554 002651 555 002662 557 002664 558 002667 560 002671 561 002672 562 002673 563 002674 564 002677 565 002701 566 002721 567 002723 568 002730 569 002732 570 002733 572 002755 573 002761 574 002764 575 003024 577 003062 578 003065 580 003067 581 003077 582 003113 583 003121 584 003123 585 003125 586 003127 587 003131 588 003137 590 003141 591 003145 592 003150 593 003151 594 003162 595 003164 596 003172 597 003174 598 003212 599 003214 600 003231 601 003233 602 003237 604 003241 605 003245 606 003250 607 003253 608 003260 609 003263 610 003271 611 003275 612 003277 614 003300 617 003304 620 003310 632 003311 635 003330 636 003333 638 003334 641 003353 642 003355 656 003356 669 003360 671 003366 672 003374 673 003376 677 003450 680 003451 681 003456 682 003461 683 003463 687 003552 710 003553 711 003560 712 003573 713 003602 714 003611 716 003621 718 003627 720 003631 721 003632 723 003633 725 003637 726 003643 727 003644 728 003653 729 003663 730 003665 731 003667 732 003670 733 003671 739 003714 740 003715 741 003720 755 003724 757 003764 758 004021 759 004056 761 004113 763 004154 764 004156 765 004210 768 004245 769 004251 770 004306 771 004312 774 004347 775 004351 779 004406 780 004410 781 004445 782 004447 785 004451 796 004455 797 004456 798 004457 799 004466 800 004470 801 004477 802 004502 803 004511 804 004515 805 004516 806 004521 808 004525 809 004527 810 004531 820 004532 821 004533 822 004543 823 004546 824 004555 825 004561 826 004562 827 004565 828 004571 829 004573 830 004574 831 004576 832 004600 835 004602 836 004605 847 004606 848 004607 850 004611 851 004612 852 004613 853 004614 855 004615 856 004616 858 004621 859 004625 861 004642 862 004643 864 004647 866 004653 867 004656 868 004657 870 004660 871 004676 872 004677 873 004701 874 004703 875 004710 877 004711 881 004752 882 004754 883 004760 885 004770 886 004773 887 004775 888 005000 890 005001 891 005004 892 005005 895 005006 898 005056 901 005057 902 005061 903 005063 904 005065 905 005100 907 005102 909 005104 910 005105 911 005114 912 005116 914 005125 915 005127 916 005135 917 005137 918 005140 919 005142 920 005144 922 005145 924 005151 925 005153 926 005154 927 005161 928 005176 930 005202 931 005203 932 005205 933 005212 934 005214 945 005340 946 005343 947 005346 949 005347 951 005350 959 005465 960 005467 961 005472 964 005571 967 005572 969 005600 976 005601 977 005607 1496 005627 996 005637 997 005644 999 005647 1000 005653 1001 005655 1003 005664 1005 005666 1006 005667 1022 005670 1023 005672 1024 005674 1025 005704 1026 005710 1027 005716 1028 005717 1029 005755 1030 005762 1032 005764 1034 005773 1035 006006 1036 006017 1037 006021 1056 006023 1057 006036 1059 006055 1061 006064 1063 006076 1067 006115 1068 006121 1070 006160 1071 006161 1073 006165 1075 006170 1076 006172 1077 006173 1078 006210 1080 006225 1081 006226 1083 006235 1084 006240 1085 006242 1086 006244 1087 006246 1088 006260 1089 006267 1091 006337 1093 006374 1094 006375 1097 006435 1099 006446 1102 006455 1103 006460 1104 006464 1105 006504 1110 006505 1111 006517 1112 006530 1113 006542 1114 006551 1116 006621 1118 006656 1119 006666 1121 006667 1122 006674 1124 006730 1125 006740 1129 006741 1130 006743 1132 006744 1133 006756 1134 006757 1135 006761 1137 006762 1141 007035 1142 007040 1143 007044 1144 007045 1146 007046 1147 007051 1148 007052 1151 007053 1154 007127 1157 007130 1158 007134 1160 007143 1162 007151 1164 007161 1166 007162 1167 007167 1169 007170 1170 007210 1171 007211 1172 007216 1174 007217 1176 007223 1177 007225 1179 007226 1180 007231 1181 007237 1182 007240 1183 007244 1186 007313 1188 007314 1189 007315 1193 007365 1194 007370 1195 007372 1197 007373 1198 007376 1199 007377 1202 007400 1205 007454 1208 007455 1209 007466 1210 007470 1211 007472 1212 007477 1228 007520 1229 007522 1230 007536 1231 007542 1234 007677 1237 007703 1238 007717 1239 007723 1242 010060 1246 010064 1247 010067 1248 010101 1249 010112 1250 010120 1251 010121 1252 010157 1253 010164 1255 010166 1257 010175 1258 010211 1260 010217 1261 010221 1263 010222 1264 010234 1265 010235 1266 010237 1268 010240 1272 010313 1273 010316 1274 010322 1275 010323 1277 010324 1278 010327 1279 010330 1282 010331 1285 010405 1288 010406 1290 010412 1292 010421 1294 010427 1296 010437 1298 010440 1299 010445 1301 010446 1302 010466 1303 010467 1304 010474 1306 010475 1308 010501 1309 010503 1311 010504 1315 010554 1316 010560 1318 010561 1319 010564 1320 010572 1321 010573 1322 010577 1325 010646 1327 010647 1331 010717 1332 010722 1333 010724 1335 010725 1336 010730 1337 010731 1340 010732 1343 011006 1346 011007 1347 011013 1348 011014 1350 011020 1354 011070 1359 011105 1364 011116 1368 011131 1372 011142 1376 011155 1380 011166 1381 011172 1383 011174 1384 011221 1386 011223 1387 011263 1389 011265 1390 011312 1391 011333 1393 011335 1395 011412 1397 011453 1398 011456 1401 011613 1403 011615 1405 011616 1407 011667 1409 011724 1410 011727 1413 012064 1415 012066 1416 012117 1418 012121 1420 012162 1421 012165 1424 012322 1426 012324 1428 012325 1430 012362 1431 012365 1434 012522 1436 012524 1437 012555 1439 012557 1440 012602 1442 012603 1443 012613 1445 012665 1447 012726 1448 012727 1450 012771 1451 013001 1454 013033 1455 013041 1456 013043 1457 013052 1458 013053 1460 013055 1470 013061 1471 013063 1472 013065 1473 013104 1474 013105 1475 013107 1476 013111 1477 013112 1478 013133 1480 013134 1481 013136 1482 013137 1494 013160 1495 013163 1496 013166 1497 013211 1498 013213 1499 013224 1500 013227 1501 013231 1502 013237 1503 013245 1504 013246 1506 013251 1507 013252 1508 013262 1509 013265 1511 013276 1512 013300 1513 013302 1514 013307 1515 013315 1516 013316 1517 013321 1518 013332 1519 013345 1520 013347 1521 013353 1523 013363 1524 013375 1525 013410 1526 013413 1527 013426 1532 013530 1533 013531 1534 013533 1535 013535 1536 013537 1537 013541 1538 013543 1539 013546 1540 013552 1541 013573 1548 013761 1549 013765 1551 013766 1553 013767 1557 014042 1558 014044 1559 014046 1560 014050 1561 014052 1562 014055 1563 014071 1568 014210 1569 014213 1572 014214 1574 014217 1576 014227 1583 014230 1601 014236 1643 014244 1603 014246 1604 014250 1605 014253 1607 014254 1608 014265 1609 014300 1610 014303 1611 014311 1612 014324 1613 014332 1615 014340 1616 014352 1617 014365 1618 014372 1619 014400 1620 014404 1621 014412 1622 014414 1623 014416 1624 014420 1627 014422 1629 014424 1630 014430 1631 014433 1632 014435 1634 014436 1635 014437 1636 014442 1639 014443 1640 014444 1641 014451 1643 014460 1646 014516 1650 014522 1652 014551 1654 014553 1655 014554 1659 014555 1680 014556 1681 014557 1682 014560 1683 014561 1684 014562 1686 014566 1688 014601 1689 014604 1690 014607 1692 014613 1693 014622 1694 014623 1696 014624 1699 014642 1700 014652 1701 014653 1703 014654 1704 014656 1705 014660 1708 014676 1709 014700 1710 014701 1712 014702 1714 014720 1715 014722 1717 014723 1718 014726 1719 014736 1722 014737 1724 014740 1725 014742 1726 014744 1728 014760 1730 014762 1731 014764 1734 015002 1735 015004 1736 015005 1738 015006 1740 015024 1741 015026 1744 015027 1745 015032 1746 015042 1748 015043 1749 015045 1750 015055 1753 015056 1755 015057 1756 015063 1757 015065 1758 015067 1761 015105 1762 015107 1763 015110 1765 015111 1766 015123 1769 015124 1770 015126 1771 015136 1773 015137 1775 015140 1776 015142 1777 015144 1780 015162 1781 015164 1782 015165 1784 015166 1786 015204 1787 015206 1789 015207 1790 015213 1791 015223 1794 015224 1795 015237 1796 015247 1798 015251 1799 015253 1801 015254 1802 015256 1803 015260 1805 015274 1807 015276 1808 015300 1811 015316 1812 015320 1813 015321 1815 015322 1817 015340 1818 015342 1821 015343 1822 015347 1823 015357 1826 015360 1827 015373 1828 015403 1830 015405 1831 015407 1833 015410 1835 015412 1837 015414 1850 015435 1851 015437 1853 015456 1854 015462 1857 015465 1858 015467 1859 015475 1861 015476 1862 015500 1899 015501 1902 015503 1903 015506 1904 015521 1905 015524 1906 015525 1907 015530 1908 015532 1910 015542 1912 015550 1915 015556 1918 015560 1919 015563 1920 015576 1921 015601 1922 015602 1923 015605 1924 015607 1926 015617 1928 015625 1931 015633 1934 015635 1935 015640 1936 015653 1937 015656 1938 015657 1939 015662 1940 015664 1942 015674 1944 015702 1954 015710 1965 015733 1966 016031 1968 016113 1970 016163 1972 016177 1975 016221 1976 016314 1977 016401 1982 016410 2002 016424 2004 016431 2006 016464 2007 016471 2009 016511 2012 016542 2015 016560 2022 016561 2025 016567 2026 016572 2028 016600 2030 016627 2032 016636 2034 016646 2036 016654 2037 016702 2038 016732 2039 016762 2041 016775 2042 017006 2043 017011 2044 017040 2045 017043 2046 017072 2047 017122 2048 017147 2049 017177 2050 017227 2052 017254 2055 017255 2058 017263 2059 017272 2061 017303 2063 017322 2065 017343 2066 017354 2067 017364 2069 017411 2070 017413 2073 017415 2075 017422 2076 017427 2077 017440 2078 017444 2079 017454 2080 017465 2081 017514 2082 017543 2083 017573 2085 017576 2086 017610 2087 017624 2088 017653 2090 017656 2092 017705 2097 017706 2242 017710 2243 017713 2247 017717 2248 017721 2249 017726 2251 017732 2252 017734 2253 017737 2255 017744 2258 017770 2259 017773 2261 020000 2263 020007 2264 020011 2265 020012 2267 020013 2269 020022 2270 020024 2271 020025 2273 020026 2275 020035 2276 020037 2277 020040 2279 020041 2281 020050 2282 020052 2283 020053 2285 020054 2291 020063 2293 020067 2294 020103 2295 020107 2297 020121 2298 020145 2299 020150 2300 020157 2301 020166 2302 020170 2303 020174 2305 020175 2307 020200 2308 020201 2309 020205 2311 020206 2344 020215 2346 020216 2347 020232 2348 020241 2349 020245 2351 020251 2352 020253 2354 020254 2356 020255 2357 020271 2358 020300 2359 020304 2361 020310 2362 020312 2364 020313 2368 020322 2370 020327 2371 020330 2375 020331 2379 020332 2380 020347 2381 020353 2383 020356 2386 020357 2391 020360 2392 020375 2393 020401 2397 020423 2398 020434 2400 020437 2402 020442 2404 020443 2405 020444 2407 020504 2408 020526 2409 020530 2410 020533 2411 020537 2414 020550 2415 020557 2416 020564 2417 020566 2419 020567 2420 020573 2421 020576 2424 020624 2425 020647 2426 020652 2427 020656 2428 020661 2429 020671 2430 020716 2431 020720 2432 020731 2433 020736 2434 020740 2436 020756 2438 020757 2439 020762 2440 020773 2441 021004 2442 021006 2443 021017 2444 021024 2445 021026 2448 021040 2474 021041 2475 021042 2476 021046 2478 021052 2479 021071 2481 021100 2482 021104 2483 021113 2485 021115 2486 021121 2488 021124 2490 021125 2491 021137 2493 021146 2494 021152 2495 021161 2497 021163 2498 021167 2501 021172 2503 021173 2504 021174 2505 021200 2507 021204 2508 021223 2510 021232 2511 021236 2512 021242 2513 021255 2514 021265 2516 021267 2517 021273 2518 021276 2520 021302 2521 021305 2522 021310 2524 021311 2525 021323 2528 021330 2530 021331 2531 021343 2533 021352 2534 021356 2535 021362 2536 021407 2537 021417 2539 021421 2540 021425 2541 021430 2543 021434 2544 021437 2545 021442 2547 021443 2548 021455 2552 021500 2554 021501 2560 021503 2561 021506 ----------------------------------------------------------- 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