COMPILATION LISTING OF SEGMENT sort_seg Compiled by: Multics PL/I Compiler, Release 32f, of October 9, 1989 Compiled at: Adv Computing Technology Centre Compiled on: 04/19/90 1519.4 mdt Thu Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1990 * 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(85-01-14,MCR7139), 15* audit(85-12-16,GDixon), install(85-12-19,MR12.0-1003): 16* Written 1974 by Ross Klinger. 17* 2) change(75-08-16,Grady), approve(85-01-14,MCR7139), audit(85-12-16,GDixon), 18* install(85-12-19,MR12.0-1003): 19* Modified by Mike Grady to add -ordered_fields. 20* 3) change(82-05-11,GDixon), approve(85-01-14,MCR7139), 21* audit(85-12-16,Unknown), install(85-12-19,MR12.0-1003): 22* Modified by Gary Dixon to generalize -field, allow 23* non_case_sensitive sorting, greater control over handling of 24* duplicates, use of regular expression sort unit/field 25* delimiters, etc. 26* 4) change(83-06-01,Schimke), approve(85-01-14,MCR7139), 27* audit(85-12-16,GDixon), install(85-12-19,MR12.0-1003): 28* Modified to fix an error in the -to regular expression handling code 29* which was not stripping off the delimiters. 30* 5) change(83-08-01,Schimke), approve(85-01-14,MCR7139), 31* audit(85-12-16,GDixon), install(85-12-19,MR12.0-1003): 32* Modified by Dave Schimke to add -numeric and -integer global 33* sort modes. Renamed the -segment and -sm control args to 34* -output_file and -of. 35* 6) change(84-04-05,GDixon), approve(85-01-14,MCR7139), 36* audit(85-12-16,Unknown), install(85-12-19,MR12.0-1003): 37* Modified by Gary Dixon to add the sort_strings (sstr) entrypoint. 38* 7) change(84-12-12,Lippard), approve(85-01-16,MCR7139), 39* audit(85-12-16,GDixon), install(85-12-17,MR12.0-1001): 40* Modified by Jim Lippard to prevent sub_error_handler from 41* terminating execution (sort_seg_ takes care of it) and make 42* multiple -field and -ordered_field control args aggregate 43* instead of overriding. 44* 8) change(85-12-18,Lippard), approve(85-12-19,PBF7139), 45* audit(85-12-19,GDixon), install(85-12-19,MR12.0-1003): 46* Modified to keep proper field count when multiple fields are specified 47* after one -field control arg. 48* 9) change(90-03-15,Vu), approve(90-03-15,MCR8162), audit(90-03-21,Kallstrom): 49* The sstr command fails when one of the strings to be sorted contains a 50* newline character. 51* END HISTORY COMMENTS */ 52 53 54 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 55 /* */ 56 /* */ 57 /* Name: sort_seg */ 58 /* */ 59 /* Command for sorting segments or strings, based upon one or more sort fields within */ 60 /* sort units. */ 61 /* */ 62 63 sort_seg: 64 ss: 65 sort_file: 66 sf: procedure options(variable); 67 68 dcl Ifl fixed bin, /* index into si.field array. */ 69 Itriple fixed bin, 70 Sdescending bit(1), /* on if -descending ctl_arg was given. */ 71 Sinteger bit(1), /* on if -integer ctl_arg given. */ 72 Snon_case_sensitive bit(1), /* on if -non_case_sensitive ctl_arg given. */ 73 Snumeric bit(1), /* on if -numeric ctl_arg given. */ 74 Syes bit(1), 75 bc fixed bin(24), 76 code fixed bin(35), 77 descending_sort fixed bin, /* detect whether -dsc or -asc ctl_args appear. */ 78 /* values: SS_unset, ASCENDING, DESCENDING */ 79 equal_ent char(32), 80 field_sort fixed bin, /* type of sort: -all, -field or -ordered_field */ 81 /* values: ALL, FIELD, ORDERED_FIELD */ 82 in_dir char(168), 83 in_ent char(32), 84 number fixed bin, /* temporary to hold a converted number. */ 85 op_list char(256) varying, 86 out_dir char(168), 87 out_ent char(32), 88 out_len fixed bin(21), 89 q fixed bin, 90 1 si aligned, 91 2 header like ss_info.header, 92 2 field (estimate_fields()) like ss_info.field, 93 sort_output fixed bin, /* Type of output: -replace or -output_file */ 94 /* values: SS_unset, REPLACE, SEGMENT */ 95 type fixed bin(2), 96 undelim_char_index fixed bin(21); 97 98 dcl (addcharno, addr, convert, divide, index, length, 99 max, null, search, substr) 100 builtin; 101 102 dcl cleanup condition, 103 sub_error_ condition; 104 105 dcl command_query_$yes_no entry() options (variable), 106 expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35)), 107 get_equal_name_ entry (char(*), char(*), char(*), fixed bin(35)), 108 hcs_$status_minf entry (char(*), char(*), fixed bin(1), fixed bin(2), fixed bin(24), 109 fixed bin(35)), 110 requote_string_ entry (char(*)) returns(char(*)), 111 sort_seg_$seg entry (char(*), ptr, char(*), char(*), char(*), char(*), fixed bin(21), 112 fixed bin(21), fixed bin(35)), 113 sort_seg_$string entry (char(*), ptr, char(*), char(*), fixed bin(21), fixed bin(21), 114 fixed bin(35)), 115 user_info_$absentee_queue entry (fixed bin); 116 117 dcl (ALL init(1), 118 FIELD init(2), 119 ORDERED_FIELD init(3)) fixed bin int static options(constant), 120 (ASCENDING init(1), 121 DESCENDING init(2)) fixed bin int static options(constant), 122 CHASE init(1) fixed bin(1) int static options(constant), 123 (CHECK_NULLS init("1"b), 124 NO_CHECK_NULLS init("0"b)) bit(1) int static options(constant), 125 (FALSE init("0"b), 126 TRUE init("1"b)) bit(1) int static options(constant), 127 NL char(1) int static options(constant) init(" 128 "), 129 (REPLACE init(2), 130 SEGMENT init(1)) fixed bin int static options(constant), 131 (error_table_$bad_arg, 132 error_table_$badopt, 133 error_table_$data_seq_error, 134 error_table_$dirseg, 135 error_table_$noarg, 136 error_table_$out_of_bounds, 137 error_table_$too_many_args, 138 error_table_$too_many_names, 139 error_table_$wrong_no_of_args, 140 error_table_$zero_length_seg) 141 fixed bin(35) ext static; 142 143 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 144 /* */ 145 /* STATIC ERROR MESSAGE TEXT */ 146 /* */ 147 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 148 149 dcl BAD_DELIM_LENGTH char(153) int static options(constant) init( 150 "^a ^a 151 The delimited string length must be an integer from 1 to 131071. 152 If you wish ^a to be treated as a character string delimiter, use: 153 ^a -string ^a"), 154 BAD_FIELD_START_INDEX char(152) int static options(constant) init( 155 "^a ^a 156 The field_start index must be an integer from 1 to 131071. 157 If you wish ^a to be treated as a character field delimiter, use: 158 ^a ^a -string ^a"), 159 BAD_FIELD_LENGTH char(121) int static options(constant) init( 160 "The field_end length must be an integer from 1 to 131071, or -1 to use a length 161 equal to the remainder of the sort unit."), 162 BAD_FIELD_END_INDEX char(150) int static options(constant) init( 163 "^a ^a 164 The field_end index must be an integer from 1 to 131071. 165 If you wish -a to be treated as a character field delimiter, use: 166 ^a ^a -string -a"), 167 DELIM_SYNTAX char(95) int static options(constant) init( 168 "Allowed syntax is: -delimiter L 169 -delimiter STR 170 -delimiter /REGEXP/ 171 -delimiter -string STR"), 172 FIELD_LENGTH_SYNTAX char(191) int static options(constant) init( 173 "Allowed syntax is: ^a field_start field_length {sort_controls} 174 field_length can be: L (an integer length) 175 -for L 176 -to E (a field end index) 177 -to STR 178 -to /REGEXP/ 179 -to -string STR"), 180 FIELD_MODES_SYNTAX char(224) int static options(constant) init( 181 "Allowed syntax is: ^a field_start field_length {sort_controls} 182 sort_controls can be: ascending, asc 183 descending, dsc 184 case_sensitive, cs 185 non_case_sensitive, ncs 186 character, ch 187 numeric, num 188 integer, int"), 189 FIELD_START_SYNTAX char(163) int static options(constant) init( 190 "Allowed syntax is: ^a field_start field_length {sort_controls} 191 field_start can be: S (field start index) 192 -from S 193 -from STR 194 -from /REGEXP/ 195 -from -string STR"), 196 OFL_SYNTAX char(83) int static options(constant) init( 197 "Allowed syntax is: ^a start_index field_length direction 198 direction can be: asc, dsc"); 199 200 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 201 202 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 203 /* */ 204 /* ENTRYPOINT: sort_seg, ss, sort_file, sf */ 205 /* 1) Get arg count, make sure sort_seg is only invoked as a command. */ 206 /* 2) Prepare to handle in/out pathnames (sort_seg) or input strings (sort_strings). */ 207 /* */ 208 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 209 210 call get_invocation_type ("sort_seg", Saf, Nargs, code); 211 if Saf then do; 212 call ck_err (code, ep); 213 return; 214 end; 215 if Nargs = 0 then do; 216 call ck_err (error_table_$wrong_no_of_args, ep, " 217 Usage: ss sort_input_pathname {-control_args}"); 218 return; 219 end; 220 221 in_dir = ""; /* No input or output pathnames given so far. */ 222 in_ent = ""; 223 out_dir = ""; 224 out_ent = ""; 225 226 go to COMMON; 227 228 229 230 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 231 /* */ 232 /* ENTRYPOINT: sort_strings, sstr */ 233 /* 1) Get arg count. */ 234 /* 2) Get and initialize storage for the strings to be sorted. */ 235 /* */ 236 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 237 238 sort_strings: 239 sstr: entry options(variable); 240 241 call get_invocation_type ("sort_strings", Saf, Nargs, code); 242 if Nargs = 0 then do; 243 call ck_err (error_table_$wrong_no_of_args, ep, " 244 Usage: ^[[^]sstr {-control_args} strings^[]^]", Saf, Saf); 245 return; 246 end; 247 Pstring = null; 248 on cleanup begin; 249 call release_temp_segment_ (ep, Pstring, code); 250 end; 251 call add_to_string$init(); 252 253 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 254 /* */ 255 /* 1) Initialize argument-holding variables prior to parsing arguments. */ 256 /* 2) Set defaults for control arguments. */ 257 /* */ 258 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 259 260 COMMON: si.version = SS_info_version_1; /* Initialize structure passed to sort_seg_ which */ 261 si.block_size = 1; /* defines how sorting will be done. */ 262 si.duplicate_mode = SS_unset; 263 si.mbz1(*) = 0; 264 si.delim.type = SS_unset; 265 si.delim.number = 0; 266 si.delim.string = ""; 267 si.field_count = 0; 268 si.field(*).from.type = SS_unset; 269 si.field(*).from.number = 0; 270 si.field(*).from.string = ""; 271 si.field(*).to.type = SS_unset; 272 si.field(*).to.number = 0; 273 si.field(*).to.string = ""; 274 si.field(*).modes = FALSE; 275 276 field_sort = SS_unset; /* Neither -all, -field or old -order_field given */ 277 sort_output = SS_unset; /* Neither -replace nor -output_file given yet. */ 278 descending_sort = SS_unset; /* Neither -ascending nor -descending given yet. */ 279 280 Snon_case_sensitive = FALSE; /* Initial default settings: -case_sensitive and */ 281 Sdescending = FALSE; /* -ascending */ 282 Snumeric = FALSE; /* Also, -character */ 283 Sinteger = FALSE; 284 285 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 286 /* */ 287 /* ARGUMENT PROCESSING: */ 288 /* Pass 1) Pre-scan all arguments first to determine whether -ascending/-descending and */ 289 /* -case_sensitive/-non_case_sensitive have been specified. The last specified */ 290 /* of either pair will be used as the default setting when setting sort fields. */ 291 /* This pass is only necessary if -field is given. If -field isn't given, then */ 292 /* the arguments are only scanned once, equivalent to pass 2. */ 293 /* Pass 2) Actually process control arguments, include the old -ordered_field control */ 294 /* argument. -ofl was made obsolete when its functionality was added to -field. */ 295 /* The syntax for -ofl is: */ 296 /* -ofl field_start field_length sort_direction */ 297 /* where field_start is a character index, field_length is a character string */ 298 /* length, and sort_direction is asc or dsc. */ 299 /* */ 300 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 301 302 REPROCESS_ARGS: 303 do while (get_arg()); /* Process control arguments */ 304 (nostringsize): 305 if index(arg, "-") ^= 1 then do; /* process non-control args. */ 306 if ep = "sort_seg" then do; /* for sort_seg, it is sort_input_pathname */ 307 if in_dir ^= "" then 308 call ck_err (error_table_$too_many_names, ep, "^a 309 Only one input pathname allowed. To give output path, use: -of out_path", arg); 310 call expand_pathname_ (arg, in_dir, in_ent, code); 311 call ck_err (code, ep, arg); 312 end; 313 314 else do; /* for sort_strings, it is a string. */ 315 call add_to_string (arg); /* All remaining args are strings to be sorted. */ 316 STRING_ARGS: do while (get_arg()); 317 call add_to_string (arg); 318 end; 319 end; 320 end; 321 322 else if (arg = "-string" | arg = "-str") & ep = "sort_strings" then 323 go to STRING_ARGS; 324 325 else if arg = "-all" | arg = "-a" then /* process -all */ 326 field_sort = ALL; 327 328 else if arg = "-field" | arg = "-fl" then do; /* process -field */ 329 field_sort = FIELD; 330 331 do Itriple = 1 to 3; /* Operands of -field come in triples: */ 332 go to FL(Itriple); /* field_start field_length {sort_controls} */ 333 334 FL(1): if get_op (FIELD_START_SYNTAX, arg) then do; 335 Ifl = si.field_count + 1; /* process field_start operands */ 336 if op = "-from" | op = "-fm" then do; 337 if get_op2 (FIELD_START_SYNTAX, arg, NO_CHECK_NULLS) then do; 338 if op2 = "-string" | op2 = "-str" then do; 339 if get_op2 ("Allowed syntax is: ^a -from -string STR", 340 arg, NO_CHECK_NULLS) then do; 341 si.field(Ifl).from.type = SS_string; 342 si.field(Ifl).from.string = op2; 343 end; 344 else Itriple = 4; 345 end; 346 else do; 347 number = cv_num_no_errors (op2, code); 348 if number >= 1 then do; 349 si.field(Ifl).from.type = SS_index; 350 si.field(Ifl).from.number = number; 351 end; 352 else if code = error_table_$out_of_bounds then do; 353 call ck_err (code, ep, BAD_FIELD_START_INDEX, 354 arg, op_list, op2, arg, op, op2); 355 end; 356 else if substr(op2,1,1) = "/" & substr(op2,length(op2),1) = "/" & length(op2)>2 then do; 357 si.field(Ifl).from.type = SS_reg_exp; 358 si.field(Ifl).from.string = substr(op2,2,length(op2)-2); 359 end; 360 else do; 361 si.field(Ifl).from.type = SS_string; 362 si.field(Ifl).from.string = op2; 363 end; 364 end; 365 end; 366 else Itriple = 4; 367 end; 368 else do; 369 number = cv_num_no_errors (op, code); 370 if code = 0 then do; 371 si.field(Ifl).from.type = SS_index; 372 si.field(Ifl).from.number = number; 373 end; 374 else if code = error_table_$out_of_bounds then 375 call ck_err (code, ep, BAD_FIELD_START_INDEX, 376 arg, op_list, op, arg, "-from", op); 377 else 378 call ck_err (code, ep, "^a ^a^/" || 379 FIELD_START_SYNTAX, arg, op_list, arg); 380 end; 381 end; 382 else Itriple = 4; 383 go to END_FL; 384 385 FL(2): if get_op1 (FIELD_LENGTH_SYNTAX, arg) then do; 386 if op = "-for" then do; /* process field_length operands */ 387 if get_op2 (FIELD_LENGTH_SYNTAX, arg, NO_CHECK_NULLS) then do; 388 number = cv_num_no_errors (op2, code); 389 if code = 0 then do; 390 si.field(Ifl).to.number = number; 391 si.field(Ifl).to.type = SS_length; 392 end; 393 else if code = error_table_$out_of_bounds then 394 if number = -1 then do; /* -1 means use rest of sort unit as field. */ 395 si.field(Ifl).to.number = number; 396 si.field(Ifl).to.type = SS_length; 397 end; 398 else 399 call ck_err (code, ep, "^a ^a^/" || 400 BAD_FIELD_LENGTH, arg, op_list); 401 else 402 call ck_err (code, ep, "^a ^a^/" || 403 FIELD_LENGTH_SYNTAX, arg, op_list, arg); 404 end; 405 else Itriple = 4; 406 end; 407 else if op = "-to" then do; 408 if get_op2 (FIELD_LENGTH_SYNTAX, arg, NO_CHECK_NULLS) then do; 409 if op2 = "-string" | op2 = "-str" then do; 410 if get_op2 ("Allowed syntax is: -a -to -string STR", 411 arg, NO_CHECK_NULLS) then do; 412 si.field(Ifl).to.type = SS_string; 413 si.field(Ifl).to.string = op2; 414 end; 415 else Itriple = 4; 416 end; 417 else do; 418 number = cv_num_no_errors (op2, code); 419 if number >= 1 then do; 420 si.field(Ifl).to.type = SS_index; 421 si.field(Ifl).to.number = number; 422 end; 423 else if code = error_table_$out_of_bounds then do; 424 call ck_err (code, ep, BAD_FIELD_END_INDEX, 425 arg, op_list, op2, arg, op, op2); 426 end; 427 else if substr(op2,1,1)="/" & substr(op2,length(op2),1)="/" & length(op2)>2 then do; 428 si.field(Ifl).to.type = SS_reg_exp; 429 si.field(Ifl).to.string = substr(op2,2,length(op2)-2); 430 end; 431 else do; 432 si.field(Ifl).to.type = SS_string; 433 si.field(Ifl).to.string = op2; 434 end; 435 end; 436 end; 437 else Itriple = 4; 438 end; 439 else do; 440 number = cv_num_no_errors (op, code); 441 if code = 0 then do; 442 si.field(Ifl).to.number = number; 443 si.field(Ifl).to.type = SS_length; 444 end; 445 else if code = error_table_$out_of_bounds then 446 if number = -1 then do; /* -1 means use rest of sort unit as field. */ 447 si.field(Ifl).to.number = number; 448 si.field(Ifl).to.type = SS_length; 449 end; 450 else 451 call ck_err (code, ep, "^a ^a^/" || 452 BAD_FIELD_LENGTH, arg, op_list); 453 else 454 call ck_err (code, ep, "^a ^a^/" || 455 FIELD_LENGTH_SYNTAX, arg, op_list, arg); 456 end; 457 end; 458 else Itriple = 4; 459 460 go to END_FL; 461 462 FL(3): si.field(Ifl).modes.descending = Sdescending; 463 si.field(Ifl).modes.non_case_sensitive = Snon_case_sensitive; 464 si.field(Ifl).modes.numeric = Snumeric; 465 si.field(Ifl).modes.integer = Sinteger; 466 467 /* process sort_controls */ 468 FL3_OP: if get_op1 ("", "") then do; 469 if op = "ascending" | op = "asc" then do; 470 si.field(Ifl).modes.descending = FALSE; 471 go to FL3_OP; 472 end; 473 else if op = "descending" | op = "dsc" then do; 474 si.field(Ifl).modes.descending = TRUE; 475 go to FL3_OP; 476 end; 477 else if op = "case_sensitive" | op = "cs" then do; 478 si.field(Ifl).modes.non_case_sensitive = FALSE; 479 go to FL3_OP; 480 end; 481 else if op = "non_case_sensitive" | op = "ncs" then do; 482 si.field(Ifl).modes.non_case_sensitive = TRUE; 483 go to FL3_OP; 484 end; 485 else if op = "character" | op = "ch" then do; 486 si.field(Ifl).modes.numeric = FALSE; 487 si.field(Ifl).modes.integer = FALSE; 488 go to FL3_OP; 489 end; 490 else if op = "numeric" | op = "num" then do; 491 si.field(Ifl).modes.numeric = TRUE; 492 si.field(Ifl).modes.integer = FALSE; 493 go to FL3_OP; 494 end; 495 else if op = "integer" | op = "int" then do; 496 si.field(Ifl).modes.integer = TRUE; 497 si.field(Ifl).modes.numeric = FALSE; 498 go to FL3_OP; 499 end; 500 else if cv_num_no_errors (op, code) >= 1 then do; 501 Iarg = Iarg - 1; 502 Itriple = 0; 503 si.field_count = Ifl; 504 end; 505 else if op = "-from" | op = "-fm" then do; 506 Iarg = Iarg - 1; 507 Itriple = 0; 508 si.field_count = Ifl; 509 end; 510 else if op = "-for" | op = "-to" then do; 511 if get_op2 ("^a requires an operand.", op, NO_CHECK_NULLS) then do; 512 call ck_err (error_table_$data_seq_error, ep, "^a ^a 513 The operands of ^a must be in the order: 514 field_start field_length {sort_controls}", arg, op_list, arg); 515 Iarg = Iarg - 2; 516 Itriple = 1; 517 si.field_count = Ifl; 518 end; 519 else do; 520 call ck_err (error_table_$data_seq_error, ep, "^a ^a 521 The operands of ^a must be in the order: 522 field_start field_length {sort_controls}", arg, op_list, arg); 523 Itriple = 4; 524 end; 525 end; 526 else if index(op,"-") = 1 then do; 527 Iarg = Iarg - 1; 528 Itriple = 4; 529 end; 530 else do; 531 call ck_err (error_table_$bad_arg, ep, "^a ^a 532 " || FIELD_MODES_SYNTAX, arg, op_list, arg); 533 Itriple = 4; 534 end; 535 end; 536 else Itriple = 4; 537 END_FL: end; 538 si.field_count = Ifl; 539 end; 540 541 else if (arg = "-ordered_field" | arg = "-ofl") & 542 ep = "sort_seg" then do; 543 field_sort = ORDERED_FIELD; /* process -ordered_field */ 544 545 do Itriple = 1 to 3; /* Operands of -ordered_field come in triples: */ 546 go to OFL(Itriple); /* field_start field_length sort_direction */ 547 548 OFL(1): if get_op (OFL_SYNTAX, arg) then do; /* process field_start operand */ 549 Ifl = si.field_count + 1; 550 si.field(Ifl).from.number = 551 cv_num (op, "The first operand of ^a is a character index from 1 to 131071.", arg); 552 si.field(Ifl).from.type = SS_index; 553 end; 554 else Itriple = 4; 555 go to END_OFL; 556 557 OFL(2): if get_op2 (OFL_SYNTAX, arg, CHECK_NULLS) then do; 558 si.field(Ifl).to.number = /* process field_length operand */ 559 cv_num (op2, "The second operand of ^a is a field length from 1 to 131071.", arg); 560 si.field(Ifl).to.type = SS_length; 561 end; 562 else Itriple = 4; 563 go to END_OFL; 564 565 OFL(3): si.field(Ifl).modes = FALSE; /* process sort_direction operand */ 566 if get_op2 (OFL_SYNTAX, arg, CHECK_NULLS) then do; 567 if op2 = "dsc" then 568 si.field(Ifl).modes.descending = TRUE; 569 else if op2 = "asc" then; 570 else 571 call ck_err (error_table_$bad_arg, ep, "^a ^a 572 The third operand of ^a must be asc (for ascending) or dsc (for descending).", 573 arg, op_list, arg); 574 end; 575 if get_op ("", "") then do; 576 Iarg = Iarg - 1; 577 if cv_num_no_errors (op, code) >= 1 then 578 Itriple = 0; 579 si.field_count = Ifl; 580 end; 581 END_OFL: end; 582 si.field_count = Ifl; 583 end; 584 585 else if arg = "-ascending" | arg = "-asc" then do; 586 descending_sort = ASCENDING; /* process sort direction/case-sensitivity args */ 587 Sdescending = FALSE; 588 end; 589 else if arg = "-descending" | arg = "-dsc" then do; 590 descending_sort = DESCENDING; 591 Sdescending = TRUE; 592 end; 593 594 else if arg = "-case_sensitive" | arg = "-cs" then 595 Snon_case_sensitive = FALSE; 596 else if arg = "-non_case_sensitive" | arg = "-ncs" then 597 Snon_case_sensitive = TRUE; 598 599 else if arg = "-character" | arg = "-ch" then do; 600 Snumeric = FALSE; 601 Sinteger = FALSE; 602 end; 603 else if arg = "-numeric" | arg = "-num" then do 604 Snumeric = TRUE; 605 Sinteger = FALSE; 606 end; 607 else if arg = "-integer" | arg = "-int" then do 608 Sinteger = TRUE; 609 Snumeric = FALSE; 610 end; 611 612 else if arg = "-duplicates" | arg = "-dup" then 613 si.duplicate_mode = SS_duplicates; /* process duplicate-handling control args. */ 614 615 else if arg = "-only_duplicates" | arg = "-odup" then 616 si.duplicate_mode = SS_only_duplicates; 617 618 else if arg = "-only_duplicate_keys" | arg = "-odupk" then 619 si.duplicate_mode = SS_only_duplicate_keys; 620 621 else if arg = "-unique" | arg = "-uq" then 622 si.duplicate_mode = SS_unique; 623 624 else if arg = "-unique_keys" | arg = "-uqk" then 625 si.duplicate_mode = SS_unique_keys; 626 627 else if arg = "-only_unique" | arg = "-ouq" then 628 si.duplicate_mode = SS_only_unique; 629 630 else if arg = "-only_unique_keys" | arg = "-ouqk" then 631 si.duplicate_mode = SS_only_unique_keys; 632 633 else if arg = "-block" | arg = "-bk" then do; /* process sort string blocking factor arg. */ 634 if get_op ("^a requires a block size operand from 1 to 131071.", arg) then 635 si.block_size = cv_num (op, "^a requires a block size operand from 1 to 131071.", arg); 636 end; 637 638 else if (arg = "-delimiter" | arg = "-dm") & 639 ep = "sort_seg" then do; 640 if get_op (DELIM_SYNTAX, arg) then do; /* process sort string delimiter control arg. */ 641 if op = "-string" | op = "-str" then do; 642 if get_op ("Allowed syntax is: ^a -string STR", arg) then do; 643 si.delim.type = SS_string; 644 si.delim.string = op || NL; 645 end; 646 end; 647 else do; 648 si.delim.number = cv_num_no_errors (op, code); 649 if code = 0 then 650 si.delim.type = SS_length; 651 else if code = error_table_$out_of_bounds then do; 652 call ck_err (code, ep, BAD_DELIM_LENGTH, arg, op, op, arg, op); 653 end; 654 else if substr(op,1,1) = "/" & substr(op,length(op),1) = "/" & length(op)>2 then do; 655 si.delim.type = SS_reg_exp; 656 si.delim.string = substr(op,2,length(op)-2); 657 end; 658 else do; 659 si.delim.type = SS_string; 660 si.delim.string = op || NL; 661 end; 662 end; 663 end; 664 end; 665 666 else if (arg = "-replace" | arg = "-rp") & /* process sort_output_pathname control args. */ 667 ep = "sort_seg" then 668 sort_output = REPLACE; 669 670 else if (arg = "-output_file" | arg = "-of" | 671 arg = "-segment" | arg = "-sm") & 672 ep = "sort_seg" then do; 673 sort_output = SEGMENT; 674 if get_op ("^a requires pathname of output segment as an operand.", arg) then do; 675 call expand_pathname_ (op, out_dir, out_ent, code); 676 call ck_err (code, ep, "^a ^a", arg, op); 677 end; 678 end; 679 680 else /* bad control argument. */ 681 call ck_err (error_table_$badopt, ep, arg); 682 end; 683 684 if Iarg_pass = 1 then do; /* Must reprocess args to correctly apply the */ 685 if Serror then go to RETURN; /* defaults for -asc/-dsc, -cs/-ncs, and */ 686 if field_sort = ALL | si.field_count = 0 | /* -ch/-num/-int to field structure. */ 687 field_sort = ORDERED_FIELD then; /* Of course, if no field structure was built in */ 688 else do; /* first pass, then a second pass isn't needed. */ 689 in_dir = ""; 690 Lstring = 0; 691 call prepare_to_reprocess_args(); 692 si.field_count = 0; /* or else we end up with twice as many */ 693 go to REPROCESS_ARGS; 694 end; 695 end; 696 697 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 698 /* */ 699 /* FINAL STEPS: */ 700 /* 1) Set defaults for args not given by user. */ 701 /* 2) Check consistency of all arguments. Make sure needed info was supplied. */ 702 /* FOR sort_seg: */ 703 /* 3) If neither -replace nor -output_file was given, query user to overwrite segment. */ 704 /* 4) Call sort_seg_ to do the actual sorting. It will report any errors encountered */ 705 /* during the sorting process. It checks access to the segments, creates the output */ 706 /* seg if needed, validates qedx regular expressions, etc. */ 707 /* */ 708 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 709 710 if si.duplicate_mode = SS_unset then /* Set default duplicate mode if user gave none. */ 711 si.duplicate_mode = SS_duplicates; 712 713 if ep = "sort_strings" then do; /* Set delimiter chosen by add_to_string rtn. */ 714 si.delim.type = SS_string; 715 si.delim.string = delimiter; 716 end; 717 else if si.delim.type = SS_unset then do; /* Set default sort string delimiter, a NL */ 718 si.delim.type = SS_string; 719 si.delim.string = NL; 720 end; 721 722 if field_sort = ALL then /* If -all given, or none of -all/-field/-ofl */ 723 si.field_count = 0; /* given, mark that no sort fields were defined.*/ 724 if si.field_count = 0 then do; /* When no sort fields are defined, make one which*/ 725 si.field_count = 1; /* encompasses the entire sort unit. */ 726 si.field(1).from.type = SS_index; 727 si.field(1).from.number = 1; 728 si.field(1).to.type = SS_length; 729 si.field(1).to.number = -1; 730 si.field(1).modes = FALSE; 731 si.field(1).modes.descending = Sdescending; 732 si.field(1).modes.non_case_sensitive = Snon_case_sensitive; 733 si.field(1).modes.numeric = Snumeric; 734 si.field(1).modes.integer = Sinteger; 735 end; 736 else if field_sort = ORDERED_FIELD then do; /* For old -order_field, if -descending is given */ 737 if descending_sort = DESCENDING then /* then invert meaning of all sort_direction */ 738 si.field(*).modes.descending = ^si.field(*).modes.descending; 739 if Snon_case_sensitive then /* switches in sort_info struc, and apply -ncs. */ 740 si.field(*).modes.non_case_sensitive = TRUE; 741 end; 742 743 Serrors_are_fatal = TRUE; /* From this point on, any error aborts command. */ 744 if ep = "sort_strings" then /* Branch to code below for rest of sort_strings */ 745 go to SORT_STRINGS; /* processing. */ 746 747 if in_dir = "" then /* Complain if no sort_input_pathname given. */ 748 call ck_err (error_table_$noarg, ep, "Input pathname required. 749 Usage: ss sort_input_pathname {-control_args}"); 750 call hcs_$status_minf (in_dir, in_ent, CHASE, type, bc, code); 751 if code ^= 0 then 752 call ck_err (code, ep, "^a^[>^]^a", in_dir, in_dir^=">", in_ent); 753 else if type ^= SEGMENT then 754 call ck_err (error_table_$dirseg, ep, "^a^[>^]^a", 755 in_dir, in_dir^=">", in_ent); 756 else if bc = 0 then 757 call ck_err (error_table_$zero_length_seg, ep, "Sort input segment is empty 758 (^a^[>^]^a).", in_dir, in_dir^=">", in_ent); 759 760 if sort_output = REPLACE then do; /* If -replace, sort_output_path = sort_input_path*/ 761 out_dir = in_dir; 762 out_ent = in_ent; 763 end; 764 else if sort_output = SS_unset & ^Serror then do; /* Neither -rp nor -of given? Query to overwrite */ 765 call user_info_$absentee_queue (q); /* if this is an interactive invocation. */ 766 if q = -1 then 767 call command_query_$yes_no (Syes, 0, ep, 768 "If you want to sort ^a^[>^]^a 769 and overwrite the segment with the sorted results, reply yes. 770 Otherwise, reply no. Overwrite the segment?", "Do you want to overwrite segment ^a^[>^]^a?", 771 in_dir, in_dir^=">", in_ent); 772 else Syes = TRUE; /* if absentee, assume user wants to overwrite. */ 773 if ^Syes then /* Don't overwrite? An error has occurred. */ 774 Serror = TRUE; 775 else do; /* Do overwrite? Equate input and output paths. */ 776 out_dir = in_dir; 777 out_ent = in_ent; 778 end; 779 end; 780 else if ^Serror then do; /* If -output_file, apply equal convention to */ 781 call get_equal_name_ (in_ent, out_ent, equal_ent, code); 782 /* make sort_output_pathname. */ 783 call ck_err (code, ep, "^a applied to ^a", 784 out_ent, in_ent); 785 out_ent = equal_ent; 786 end; 787 788 if Serror then go to RETURN; /* An error occurred. Don't do sorting. */ 789 790 on sub_error_ call sub_error_handler; 791 792 call sort_seg_$seg (ep, addr(si), in_dir, in_ent, out_dir, out_ent, 793 out_len, undelim_char_index, code); /* This subr does the work. */ 794 795 RETURN: if ep = "sort_strings" then 796 call release_temp_segment_ (ep, Pstring, code); 797 return; /* Simple, huh? */ 798 799 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 800 /* */ 801 /* FOR sort_strings: */ 802 /* 1) Be sure that an input string was provided. */ 803 /* 2) Create space for output string. If the input string currently fills more than */ 804 /* half of the temp segment, then the output string will overlay the input string and */ 805 /* sort_seg_$string will handle the overlay by sorting into a second temp string and */ 806 /* then copying the sorted result back. */ 807 /* 3) Establish sub_error_ handler to intercept error reports from sort_seg_. */ 808 /* 4) Call sort_seg_$string to process the input string. */ 809 /* 5) For active function output, add sorted string components to AF return arg, */ 810 /* requoting each one to be sure it is treated as an individual value. */ 811 /* 6) For command output, output the sorted string components on a many-per-line basis, */ 812 /* using multiple lines to prevent lines from overflowing. Also, requote components */ 813 /* which contain a SPACE or TAB to prevent them from appearing as multiple components */ 814 /* in the sorted list. */ 815 /* */ 816 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 817 818 SORT_STRINGS: 819 if Lstring = 0 then 820 call ck_err (-1, ep, "No input strings were given."); 821 822 Lout_string = divide (length(string)+3, 4, 21, 0) * 4; 823 if Lout_string + Lout_string <= MLstring then 824 Pout_string = addcharno (Pstring, Lout_string); 825 else do; 826 Pout_string = Pstring; 827 Lout_string = Lstring; 828 end; 829 830 on sub_error_ call sub_error_handler; 831 832 call sort_seg_$string (ep, addr(si), string, out_string, Lout_string, 833 undelim_char_index, code); 834 835 if code = 0 then do; 836 if Saf then do; 837 do while (get_out_string_component()); 838 call add_to_return_arg (out_string_component); 839 end; 840 end; 841 else do; 842 call output_string$init(); 843 do while (get_out_string_component()); 844 call output_string (out_string_component); 845 end; 846 call output_string$term(); 847 end; 848 end; 849 go to RETURN; 850 851 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 852 853 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 854 /* */ 855 /* I N T E R N A L P R O C E D U R E S */ 856 /* */ 857 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 858 859 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 860 861 dcl Lout_string fixed bin(21), 862 Lstring fixed bin(21), 863 Lout_string_component fixed bin(21), 864 MLstring fixed bin(21), 865 Pout_string ptr, 866 Pout_string_component ptr, 867 Pstring ptr, 868 delimiter char(1), 869 (get_temp_segment_, 870 release_temp_segment_) entry (char(*), ptr, fixed bin(35)), 871 possible_delimiters char(512) varying, 872 out_string char(Lout_string) based(Pout_string), 873 out_string_ch (Lout_string) char(1) based(Pout_string), 874 out_string_component char(Lout_string_component) based(Pout_string_component), 875 string char(Lstring) based(Pstring), 876 sys_info$max_seg_size fixed bin(35) ext static; 877 878 add_to_string: 879 proc (arg); 880 881 dcl arg char(*); 882 883 dcl Istring_new fixed bin(21), 884 new_delimiter char(1); 885 886 dcl (collate9, reverse, translate) builtin; 887 888 if index(arg, delimiter) > 0 then do; /* Insure string delimiter does not appear in any */ 889 NEED_NEW_DELIMITER: /* string. */ 890 if possible_delimiters = "" then do; 891 Serrors_are_fatal = TRUE; 892 call ck_err (-1, ep, 893 "The strings to be sorted use every character in the collate9 sequence. 894 Therefore the strings cannot be sorted."); 895 end; 896 new_delimiter = substr(possible_delimiters,1,length(delimiter)); 897 possible_delimiters = substr(possible_delimiters,length(delimiter)+1); 898 if index(string,new_delimiter) + index(arg,new_delimiter) > 0 then 899 go to NEED_NEW_DELIMITER; 900 string = translate (string, new_delimiter, delimiter); 901 delimiter = new_delimiter; 902 end; 903 if length(string) + length(arg) + length(delimiter) > MLstring then do; 904 Serrors_are_fatal = TRUE; 905 call ck_err (error_table_$too_many_args, ep, 906 "The temp segment holding strings to be sorted has overflowed."); 907 end; 908 Istring_new = length(string) + 1; 909 Lstring = length(string) + length(arg) + length(delimiter); 910 substr(string, Istring_new) = arg; 911 substr(string, length(string), 1) = delimiter; 912 return; 913 914 915 add_to_string$init: 916 entry; 917 918 delimiter = NL; 919 possible_delimiters = reverse(collate9()); 920 Lstring = 0; 921 MLstring = sys_info$max_seg_size * 4; 922 call get_temp_segment_ (ep, Pstring, code); 923 if code ^= 0 then do; 924 Serrors_are_fatal = TRUE; 925 call ck_err (code, ep, "Getting a temp segment."); 926 end; 927 return; 928 929 get_out_string_component: 930 entry returns(bit(1)); 931 932 if length(out_string) = 0 then 933 return (FALSE); 934 Lout_string_component = index(out_string, delimiter); 935 Pout_string_component = addr(out_string); 936 if length(out_string) > length(out_string_component) then 937 Pout_string = addr(out_string_ch(length(out_string_component)+1)); 938 Lout_string = length(out_string) - length(out_string_component); 939 Lout_string_component = Lout_string_component - length(delimiter); 940 return (TRUE); 941 942 end add_to_string; 943 944 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 945 946 947 dcl Serror bit(1), /* On if fatal error has occurred. */ 948 Serrors_are_fatal bit(1); /* On if errors are fatal. */ 949 950 ck_err: proc options(variable); /* Procedure to report errors via com_err_ or */ 951 /* active_fnc_err_, as appropriate. This proc */ 952 /* has same calling sequence as com_err_. */ 953 954 dcl code fixed bin(35) based (Pcode), 955 Pcode ptr; 956 957 dcl cu_$arg_list_ptr entry returns(ptr), 958 cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35)), 959 cu_$generate_call entry (entry, ptr); 960 961 call cu_$arg_ptr (1, Pcode, 0, 0); /* Access error table code argument. */ 962 if code = 0 then return; /* If non-zero, this ISN'T an error. */ 963 if code = -1 then code = 0; /* No error table code fits the desired err msg. */ 964 Serror = TRUE; /* Record fact that an error occurred. */ 965 call cu_$generate_call (err, cu_$arg_list_ptr()); /* Actually call com_err_ or active_fnc_err_. */ 966 if Serrors_are_fatal then 967 go to RETURN; 968 969 end ck_err; 970 971 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 972 973 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 974 975 976 cv_num: proc (op, err_msg, arg) returns(fixed bin); /* Number conversion internal proc. Main */ 977 /* entry point calls ck_err if an error occurs. */ 978 979 dcl op char(*), 980 err_msg char(*), 981 arg char(*); 982 983 dcl Ssuppress_error bit(1), 984 code fixed bin(35), 985 conversion condition, 986 n fixed bin, 987 size condition; 988 989 Ssuppress_error = FALSE; 990 go to COMMON; 991 992 cv_num_no_errors: /* Special entry point returns -2 if an error */ 993 entry (op, Acode) returns(fixed bin); /* occurs in conversion, or actual value */ 994 /* if a non-positive number is given. */ 995 996 dcl Acode fixed bin(35); 997 998 Ssuppress_error = TRUE; 999 Acode = 0; 1000 if op = "" then do; 1001 code = error_table_$bad_arg; 1002 go to OP_NOT_NUMERIC; 1003 end; 1004 1005 COMMON: on conversion begin; 1006 code = error_table_$bad_arg; 1007 n = -2; /* Use PL/I to do conversion, check for errors. */ 1008 go to OP_NOT_NUMERIC; 1009 end; 1010 on size begin; 1011 code = error_table_$out_of_bounds; 1012 n = -2; 1013 go to OP_NOT_NUMERIC; 1014 end; 1015 n = convert(n, op); 1016 revert conversion, size; 1017 if n < 1 then do; 1018 code = error_table_$out_of_bounds; 1019 OP_NOT_NUMERIC: 1020 if Ssuppress_error then 1021 Acode = code; 1022 else 1023 call ck_err (code, ep, "^a ^a^/" || err_msg, arg, op_list, arg); 1024 end; 1025 return (n); 1026 1027 end cv_num; 1028 1029 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1030 1031 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1032 1033 1034 estimate_fields: /* Internal proc to estimate number of fields */ 1035 proc returns(fixed bin); /* needed in sort info structure, based upon */ 1036 /* number of arguments given to sort_seg command.*/ 1037 /* It never under-estimates. */ 1038 1039 dcl Nargs fixed bin, /* Use of this procedure allows use to get */ 1040 Nfields fixed bin; /* generation of storage for structure in */ 1041 /* automatic storage of main procedure. */ 1042 1043 dcl cu_$af_arg_count entry (fixed bin, fixed bin(35)); 1044 1045 call cu_$af_arg_count (Nargs, 0); 1046 Nfields = divide(Nargs-2, 2, 17, 0); 1047 Nfields = max (Nfields, 1); 1048 return (Nfields); 1049 1050 end estimate_fields; 1051 1052 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1053 1054 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1055 1056 1057 dcl Iarg fixed bin, /* Current argument being processed. */ 1058 Iarg_pass fixed bin, /* Number of time arg list has been processed. */ 1059 Larg fixed bin(21), /* Length of current argument. */ 1060 Lop fixed bin(21), /* Length of current ctl arg operand. */ 1061 Lop2 fixed bin(21), 1062 Lret fixed bin(21), /* Max length of AF return value. */ 1063 Nargs fixed bin, /* Number of arguments. */ 1064 Parg ptr, /* Ptr to current argument. */ 1065 Parg_list ptr, /* Ptr to command/af's argument list. */ 1066 Pop ptr, /* Ptr to current operand. */ 1067 Pop2 ptr, 1068 Pret ptr, /* Ptr to AF return value. */ 1069 Saf bit(1), /* On if invoked as an active function. */ 1070 arg char(Larg) based(Parg), 1071 ep char(12), 1072 op char(Lop) based(Pop), 1073 op2 char(Lop2) based(Pop2), 1074 ret char(Lret) varying based(Pret), 1075 (arg_ptr variable, 1076 cu_$af_arg_ptr_rel, 1077 cu_$arg_ptr_rel) entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr), 1078 cu_$af_return_arg entry (fixed bin, ptr, fixed bin(21), fixed bin(35)), 1079 cu_$arg_list_ptr entry returns(ptr), 1080 (err variable, 1081 active_fnc_err_, 1082 com_err_) entry() options(variable); 1083 1084 1085 get_invocation_type: /* Were we invoked as command or af? Arg count? */ 1086 proc (entrypoint, Saf, Nargs, code); 1087 1088 dcl entrypoint char(*), 1089 Saf bit(1), 1090 Nargs fixed bin, 1091 code fixed bin(35); 1092 1093 ep = entrypoint; 1094 Serrors_are_fatal = FALSE; 1095 call cu_$af_return_arg (Nargs, Pret, Lret, code); 1096 if code = 0 then do; 1097 Saf = TRUE; 1098 arg_ptr = cu_$af_arg_ptr_rel; 1099 err = active_fnc_err_; 1100 ret = ""; 1101 end; 1102 else do; 1103 Saf = FALSE; 1104 arg_ptr = cu_$arg_ptr_rel; 1105 err = com_err_; 1106 end; 1107 Serror = FALSE; /* No errors so far. */ 1108 Parg_list = cu_$arg_list_ptr(); /* Remember arg list ptr for subrs below. */ 1109 Iarg_pass = 0; 1110 1111 1112 prepare_to_reprocess_args: 1113 entry; 1114 1115 Iarg = 0; /* No args processed so far. */ 1116 Iarg_pass = Iarg_pass + 1; 1117 1118 end get_invocation_type; 1119 1120 1121 get_arg: proc returns(bit(1)); /* Returns TRUE if another argument exists. */ 1122 /* Its value is accessible via arg variable. */ 1123 1124 if Iarg+1 > Nargs then 1125 return(FALSE); 1126 Iarg = Iarg + 1; 1127 call arg_ptr (Iarg, Parg, Larg, code, Parg_list); 1128 return(TRUE); 1129 1130 get_op: entry (err_msg, arg) returns(bit(1)); /* Internal proc to get control arg operands. */ 1131 /* Besides getting the operands, (in op or op2 */ 1132 dcl err_msg char(*), /* variables), it catenates them together in the */ 1133 arg char(*); /* op_list variable for use in error msgs. */ 1134 1135 op_list = ""; /* First operand of a control arg, or first of a */ 1136 /* triplet of operands assoc with -field or -ofl. */ 1137 1138 get_op1: entry (err_msg, arg) returns(bit(1)); /* First of operand group forming second element */ 1139 /* of a -field triplet. */ 1140 1141 if Iarg = Nargs then do; 1142 if err_msg ^= "" then 1143 call ck_err (error_table_$noarg, ep, "^a ^a^/" || 1144 err_msg, arg, op_list, arg); 1145 return (FALSE); 1146 end; 1147 else do; 1148 Iarg = Iarg + 1; 1149 call arg_ptr (Iarg, Pop, Lop, code, Parg_list); 1150 if op = "" then do; 1151 if err_msg ^= "" then 1152 call ck_err (error_table_$bad_arg, ep, "^a^[ ^a^;^s^] ""^va""^/" || 1153 err_msg, arg, op_list^="", op_list, length(op), op, arg); 1154 return (FALSE); 1155 end; 1156 call add_op_to_list (op); 1157 return (TRUE); 1158 end; 1159 1160 1161 get_op2: entry (err_msg, arg, Scheck_nulls) returns(bit(1)); 1162 /* Next of operand group. */ 1163 1164 dcl Scheck_nulls bit(1); 1165 1166 if Iarg = Nargs then do; 1167 call ck_err (error_table_$noarg, ep, "^a ^a^/" || 1168 err_msg, arg, op_list, arg); 1169 return (FALSE); 1170 end; 1171 else do; 1172 Iarg = Iarg + 1; 1173 call arg_ptr (Iarg, Pop2, Lop2, code, Parg_list); 1174 if Scheck_nulls & op2 = "" then do; 1175 call ck_err (error_table_$bad_arg, ep, "^a ^a ""^va""^/" || 1176 err_msg, arg, op_list, length(op), op, arg); 1177 return (FALSE); 1178 end; 1179 call add_op_to_list (op2); 1180 return (TRUE); 1181 end; 1182 1183 add_op_to_list: /* Internal proc of get_op to add new operand to */ 1184 proc (op); /* op_list variable. */ 1185 1186 dcl op char(*); 1187 1188 if length(op) = 0 | search(op, " ""()[]; ") > 0 then 1189 op_list = op_list || requote_string_ (op); 1190 else 1191 op_list = op_list || op; 1192 op_list = op_list || " "; 1193 1194 end add_op_to_list; 1195 1196 1197 add_to_return_arg: 1198 entry (arg); 1199 1200 if ret ^= "" then 1201 ret = ret || " "; 1202 ret = ret || requote_string_ (arg); 1203 1204 end get_arg; 1205 1206 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1207 1208 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1209 1210 1211 dcl Loutput_line fixed bin, 1212 MLoutput_line fixed bin, 1213 get_line_length_$switch entry (ptr, fixed bin(35)) returns(fixed bin); 1214 1215 output_string: 1216 proc (arg); 1217 1218 dcl arg char(*); 1219 1220 dcl IHT_SP fixed bin(21), 1221 HT_SP char(2) int static options(constant) init(" "), 1222 Lrq_arg fixed bin(21), 1223 SP char(1) int static options(constant) init(" "), 1224 ioa_$nnl entry() options(variable); 1225 1226 IHT_SP = search(arg, HT_SP); 1227 if IHT_SP > 0 then 1228 Lrq_arg = length(requote_string_(arg)); 1229 else 1230 Lrq_arg = length(arg); 1231 1232 if Loutput_line = 0 then do; 1233 OUTPUT_AT_BEGINNING_OF_LINE: 1234 if IHT_SP > 0 then 1235 call ioa_$nnl ("^a", requote_string_(arg)); 1236 else 1237 call ioa_$nnl ("^a", arg); 1238 Loutput_line = Lrq_arg; 1239 end; 1240 1241 else if Loutput_line + length(SP) + Lrq_arg <= MLoutput_line then do; 1242 if IHT_SP > 0 then 1243 call ioa_$nnl (" ^a", requote_string_(arg)); 1244 else 1245 call ioa_$nnl (" ^a", arg); 1246 Loutput_line = Loutput_line + length(SP) + Lrq_arg; 1247 end; 1248 1249 else do; 1250 call ioa_$nnl ("^/"); 1251 go to OUTPUT_AT_BEGINNING_OF_LINE; 1252 end; 1253 return; 1254 1255 1256 output_string$init: 1257 entry; 1258 1259 MLoutput_line = get_line_length_$switch (null, code); 1260 if code ^= 0 then MLoutput_line = 136; 1261 Loutput_line = 0; 1262 1263 1264 output_string$term: 1265 entry; 1266 1267 if Loutput_line > 0 then 1268 call ioa_$nnl ("^/"); 1269 1270 end output_string; 1271 1272 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1273 1274 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1275 1276 sub_error_handler: 1277 proc; 1278 1279 /* Sub_error procedure, prints a message and cleans up */ 1280 1281 dcl code fixed bin(35); 1282 dcl 1 cond_info like condition_info; 1283 dcl find_condition_info_ entry (ptr, ptr, fixed bin (35)); 1284 dcl null builtin; 1285 dcl 1 sub_err_info like sub_error_info based (cond_info.info_ptr); 1286 1287 call find_condition_info_ (null(), addr (cond_info), code); 1288 1289 Serrors_are_fatal = FALSE; 1290 1291 call ck_err (sub_err_info.header.status_code, ep, sub_err_info.info_string); 1292 1293 end sub_error_handler; 1294 1295 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1296 1 1 /* START OF: sort_seg_info.incl.pl1 * * * * * * * * * * * * * * * * */ 1 2 1 3 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1 4 /* */ 1 5 /* This include file declares the information structure for the sort_seg_ subroutine. */ 1 6 /* This structure defines the sort string delimiter, and sort field delimiters for fields */ 1 7 /* to be sorted upon within each sort unit (sort string or block of sort strings). */ 1 8 /* */ 1 9 /* Status */ 1 10 /* 0) Created: May 1, 1982 by G. C. Dixon */ 1 11 /* 1) Modified: July 22, 1982 by DJ Schimke adding numeric and integer sort modes. */ 1 12 /* */ 1 13 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1 14 1 15 dcl 1 ss_info aligned based(ss_info_ptr), 1 16 2 header, 1 17 3 version char(8), /* version of this structure. Set with */ 1 18 /* SS_info_version_1 string constant. */ 1 19 3 block_size fixed bin, /* number of sort strings to be blocked together */ 1 20 /* in each sort unit. */ 1 21 3 field_count fixed bin, /* number of sort fields within eacch sort unit. */ 1 22 3 duplicate_mode fixed bin, /* method of handling duplicate sort units. Set */ 1 23 /* with one of the constants below. */ 1 24 3 mbz1 (3) fixed bin, /* reserved for future use. Set to 0. */ 1 25 3 delim, /* sort string delimiter definition. */ 1 26 4 type fixed bin, /* type of delimiter. Set with one of field */ 1 27 /* constants below. */ 1 28 4 number fixed bin, /* numeric type delimiter value. */ 1 29 4 string char(256) varying, /* string type delimiter value. */ 1 30 2 field (ss_field_count refer (ss_info.field_count)), 1 31 /* sort field definitions */ 1 32 3 from like ss_info.delim, /* start of sort field. */ 1 33 3 to like ss_info.delim, /* end of sort field. */ 1 34 3 modes, /* per-field sort modes. */ 1 35 (4 descending bit(1), /* sort field in descending order */ 1 36 4 non_case_sensitive bit(1), /* translate field to lowercase for sorting. */ 1 37 4 numeric bit(1), /* sort field according to numeric value. */ 1 38 4 integer bit(1), /* sort field according to integer value. */ 1 39 4 mbz2 bit(32)) unal, /* reserved for future use. Set to ""b. */ 1 40 ss_field_count fixed bin, 1 41 ss_info_ptr ptr, 1 42 1 43 SS_info_version_1 char(8) int static options(constant) init("ss_info1"), 1 44 /* string constant which must be used to set */ 1 45 /* structure version. */ 1 46 /* constants for setting duplicate_mode, type(s) */ 1 47 (SS_unset init(0), 1 48 SS_duplicates init(1), /* duplicate modes */ 1 49 SS_unique init(2), 1 50 SS_only_duplicates init(3), 1 51 SS_only_duplicate_keys init(4), 1 52 SS_unique_keys init(5), 1 53 SS_only_unique init(6), 1 54 SS_only_unique_keys init(7), 1 55 SS_length init(1), /* field types */ 1 56 SS_index init(2), 1 57 SS_string init(3), 1 58 SS_reg_exp init(4)) fixed bin int static options(constant); 1 59 1 60 /* END OF: sort_seg_info.incl.pl1 * * * * * * * * * * * * * * * * */ 1297 1298 2 1 /* BEGIN INCLUDE FILE ... condition_info.incl.pl1 */ 2 2 2 3 /* Structure for find_condition_info_. 2 4* 2 5* Written 1-Mar-79 by M. N. Davidoff. 2 6**/ 2 7 2 8 /* automatic */ 2 9 2 10 declare condition_info_ptr pointer; 2 11 2 12 /* based */ 2 13 2 14 declare 1 condition_info aligned based (condition_info_ptr), 2 15 2 mc_ptr pointer, /* pointer to machine conditions at fault time */ 2 16 2 version fixed binary, /* Must be 1 */ 2 17 2 condition_name char (32) varying, /* name of condition */ 2 18 2 info_ptr pointer, /* pointer to the condition data structure */ 2 19 2 wc_ptr pointer, /* pointer to wall crossing machine conditions */ 2 20 2 loc_ptr pointer, /* pointer to location where condition occured */ 2 21 2 flags unaligned, 2 22 3 crawlout bit (1), /* on if condition occured in lower ring */ 2 23 3 pad1 bit (35), 2 24 2 pad2 bit (36), 2 25 2 user_loc_ptr pointer, /* ptr to most recent nonsupport loc before condition occurred */ 2 26 2 pad3 (4) bit (36); 2 27 2 28 /* internal static */ 2 29 2 30 declare condition_info_version_1 2 31 fixed binary internal static options (constant) initial (1); 2 32 2 33 /* END INCLUDE FILE ... condition_info.incl.pl1 */ 1299 1300 3 1 /* BEGIN INCLUDE FILE sub_error_info.incl.pl1 */ 3 2 /* format: style2 */ 3 3 3 4 /* The include file condition_info_header must be used with this file */ 3 5 3 6 declare sub_error_info_ptr pointer; 3 7 declare 1 sub_error_info aligned based (sub_error_info_ptr), 3 8 2 header aligned like condition_info_header, 3 9 2 retval fixed bin (35), /* return value */ 3 10 2 name char (32), /* module name */ 3 11 2 info_ptr ptr; 3 12 3 13 declare sub_error_info_version_1 3 14 internal static options (constant) fixed bin init (1); 3 15 3 16 /* END INCLUDE FILE sub_error_info.incl.pl1 */ 1301 1302 4 1 /* BEGIN INCLUDE FILE condition_info_header.incl.pl1 BIM 1981 */ 4 2 /* format: style2 */ 4 3 4 4 declare condition_info_header_ptr 4 5 pointer; 4 6 declare 1 condition_info_header 4 7 aligned based (condition_info_header_ptr), 4 8 2 length fixed bin, /* length in words of this structure */ 4 9 2 version fixed bin, /* version number of this structure */ 4 10 2 action_flags aligned, /* tell handler how to proceed */ 4 11 3 cant_restart bit (1) unaligned, /* caller doesn't ever want to be returned to */ 4 12 3 default_restart bit (1) unaligned, /* caller can be returned to with no further action */ 4 13 3 quiet_restart bit (1) unaligned, /* return, and print no message */ 4 14 3 support_signal bit (1) unaligned, /* treat this signal as if the signalling procedure had the support bit set */ 4 15 /* if the signalling procedure had the support bit set, do the same for its caller */ 4 16 3 pad bit (32) unaligned, 4 17 2 info_string char (256) varying, /* may contain printable message */ 4 18 2 status_code fixed bin (35); /* if^=0, code interpretable by com_err_ */ 4 19 4 20 /* END INCLUDE FILE condition_info_header.incl.pl1 */ 1303 1304 1305 end sort_seg; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/19/90 1519.4 sort_seg.pl1 >spec>install>1005>sort_seg.pl1 1297 1 05/18/84 0930.8 sort_seg_info.incl.pl1 >ldd>include>sort_seg_info.incl.pl1 1299 2 06/28/79 1304.8 condition_info.incl.pl1 >ldd>include>condition_info.incl.pl1 1301 3 07/18/81 1200.0 sub_error_info.incl.pl1 >ldd>include>sub_error_info.incl.pl1 1303 4 03/24/82 1447.2 condition_info_header.incl.pl1 >ldd>include>condition_info_header.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. ALL constant fixed bin(17,0) initial dcl 117 ref 325 686 722 ASCENDING constant fixed bin(17,0) initial dcl 117 ref 586 Acode parameter fixed bin(35,0) dcl 996 set ref 992 999* 1019* BAD_DELIM_LENGTH 000461 constant char(153) initial packed unaligned dcl 149 set ref 652* BAD_FIELD_END_INDEX 000306 constant char(150) initial packed unaligned dcl 149 set ref 424* BAD_FIELD_LENGTH 000354 constant char(121) initial packed unaligned dcl 149 ref 398 450 BAD_FIELD_START_INDEX 000413 constant char(152) initial packed unaligned dcl 149 set ref 353* 374* CHASE 000652 constant fixed bin(1,0) initial dcl 117 set ref 750* CHECK_NULLS 000530 constant bit(1) initial packed unaligned dcl 117 set ref 557* 566* DELIM_SYNTAX 000256 constant char(95) initial packed unaligned dcl 149 set ref 640* DESCENDING constant fixed bin(17,0) initial dcl 117 ref 590 737 FALSE constant bit(1) initial packed unaligned dcl 117 ref 274 280 281 282 283 470 478 486 487 492 497 565 587 594 600 601 605 609 730 932 989 1094 1103 1107 1124 1145 1154 1169 1177 1289 FIELD constant fixed bin(17,0) initial dcl 117 ref 329 FIELD_LENGTH_SYNTAX 000176 constant char(191) initial packed unaligned dcl 149 set ref 385* 387* 401 408* 453 FIELD_MODES_SYNTAX 000106 constant char(224) initial packed unaligned dcl 149 ref 531 FIELD_START_SYNTAX 000035 constant char(163) initial packed unaligned dcl 149 set ref 334* 337* 377 HT_SP constant char(2) initial packed unaligned dcl 1220 ref 1226 IHT_SP 000756 automatic fixed bin(21,0) dcl 1220 set ref 1226* 1227 1233 1242 Iarg 000630 automatic fixed bin(17,0) dcl 1057 set ref 501* 501 506* 506 515* 515 527* 527 576* 576 1115* 1124 1126* 1126 1127* 1141 1148* 1148 1149* 1166 1172* 1172 1173* Iarg_pass 000631 automatic fixed bin(17,0) dcl 1057 set ref 684 1109* 1116* 1116 Ifl 000100 automatic fixed bin(17,0) dcl 68 set ref 335* 341 342 349 350 357 358 361 362 371 372 390 391 395 396 412 413 420 421 428 429 432 433 442 443 447 448 462 463 464 465 470 474 478 482 486 487 491 492 496 497 503 508 517 538 549* 550 552 558 560 565 565 565 565 565 567 579 582 Istring_new 000702 automatic fixed bin(21,0) dcl 883 set ref 908* 910 Itriple 000101 automatic fixed bin(17,0) dcl 68 set ref 331* 332 344* 366* 382* 405* 415* 437* 458* 502* 507* 516* 523* 528* 533* 536* 545* 546 554* 562* 577* Larg 000632 automatic fixed bin(21,0) dcl 1057 set ref 304 307 307 310 310 311 311 315 315 317 317 322 322 325 325 328 328 334 334 337 337 339 339 353 353 353 353 374 374 374 374 377 377 377 377 385 385 387 387 398 398 401 401 401 401 408 408 410 410 424 424 424 424 450 450 453 453 453 453 512 512 512 512 520 520 520 520 531 531 531 531 541 541 548 548 550 550 557 557 558 558 566 566 570 570 570 570 585 585 589 589 594 594 596 596 599 599 603 603 607 607 612 612 615 615 618 618 621 621 624 624 627 627 630 630 633 633 634 634 634 634 638 638 640 640 642 642 652 652 652 652 666 666 670 670 670 670 674 674 676 676 680 680 1127* Lop 000633 automatic fixed bin(21,0) dcl 1057 set ref 336 336 353 353 369 369 374 374 374 374 386 407 424 424 440 440 469 469 473 473 477 477 481 481 485 485 490 490 495 495 500 500 505 505 510 510 511 511 526 550 550 577 577 634 634 641 641 644 648 648 652 652 652 652 652 652 654 654 654 654 656 656 660 675 675 676 676 1149* 1150 1151 1151 1151 1151 1156 1156 1175 1175 1175 1175 Lop2 000634 automatic fixed bin(21,0) dcl 1057 set ref 338 338 342 347 347 353 353 353 353 356 356 356 356 358 358 362 388 388 409 409 413 418 418 424 424 424 424 427 427 427 427 429 429 433 558 558 567 569 1173* 1174 1179 1179 Lout_string 000412 automatic fixed bin(21,0) dcl 861 set ref 822* 823 823 823 827* 832 832 832* 932 934 935 936 938* 938 Lout_string_component 000414 automatic fixed bin(21,0) dcl 861 set ref 838 838 844 844 934* 936 936 938 939* 939 Loutput_line 000666 automatic fixed bin(17,0) dcl 1211 set ref 1232 1238* 1241 1246* 1246 1261* 1267 Lret 000635 automatic fixed bin(21,0) dcl 1057 set ref 1095* 1100 1200 1202 Lrq_arg 000757 automatic fixed bin(21,0) dcl 1220 set ref 1227* 1229* 1238 1241 1246 Lstring 000413 automatic fixed bin(21,0) dcl 861 set ref 690* 818 822 827 832 832 898 900 900 903 908 909* 909 910 911 911 920* MLoutput_line 000667 automatic fixed bin(17,0) dcl 1211 set ref 1241 1259* 1260* MLstring 000415 automatic fixed bin(21,0) dcl 861 set ref 823 903 921* NL 014132 constant char(1) initial packed unaligned dcl 117 ref 644 660 719 918 NO_CHECK_NULLS 000643 constant bit(1) initial packed unaligned dcl 117 set ref 337* 339* 387* 408* 410* 511* Nargs parameter fixed bin(17,0) dcl 1088 in procedure "get_invocation_type" set ref 1085 1095* Nargs 000636 automatic fixed bin(17,0) dcl 1057 in procedure "sf" set ref 210* 215 241* 242 1124 1141 1166 Nargs 000714 automatic fixed bin(17,0) dcl 1039 in procedure "estimate_fields" set ref 1045* 1046 Nfields 000715 automatic fixed bin(17,0) dcl 1039 set ref 1046* 1047* 1047 1048 OFL_SYNTAX 000010 constant char(83) initial packed unaligned dcl 149 set ref 548* 557* 566* ORDERED_FIELD constant fixed bin(17,0) initial dcl 117 ref 543 686 736 Parg 000640 automatic pointer dcl 1057 set ref 304 307 310 311 315 317 322 322 325 325 328 328 334 337 339 353 353 374 374 377 377 385 387 398 401 401 408 410 424 424 450 453 453 512 512 520 520 531 531 541 541 548 550 557 558 566 570 570 585 585 589 589 594 594 596 596 599 599 603 603 607 607 612 612 615 615 618 618 621 621 624 624 627 627 630 630 633 633 634 634 638 638 640 642 652 652 666 666 670 670 670 670 674 676 680 1127* Parg_list 000642 automatic pointer dcl 1057 set ref 1108* 1127* 1149* 1173* Pcode 000100 automatic pointer dcl 954 set ref 961* 962 963 963 Pop 000644 automatic pointer dcl 1057 set ref 336 336 353 369 374 374 386 407 424 440 469 469 473 473 477 477 481 481 485 485 490 490 495 495 500 505 505 510 510 511 526 550 577 634 641 641 644 648 652 652 652 654 654 654 654 656 656 660 675 676 1149* 1150 1151 1151 1151 1156 1175 1175 1175 Pop2 000646 automatic pointer dcl 1057 set ref 338 338 342 347 353 353 356 356 356 356 358 358 362 388 409 409 413 418 424 424 427 427 427 427 429 429 433 558 567 569 1173* 1174 1179 Pout_string 000416 automatic pointer dcl 861 set ref 823* 826* 832 932 934 935 936 936* 936 938 Pout_string_component 000420 automatic pointer dcl 861 set ref 838 844 935* 936 936 938 Pret 000650 automatic pointer dcl 1057 set ref 1095* 1100 1200 1200 1200 1202 1202 Pstring 000422 automatic pointer dcl 861 set ref 247* 249* 795* 822 823 826 832 898 900 900 903 908 909 910 911 911 922* REPLACE constant fixed bin(17,0) initial dcl 117 ref 666 760 SEGMENT constant fixed bin(17,0) initial dcl 117 ref 673 753 SP constant char(1) initial packed unaligned dcl 1220 ref 1241 1246 SS_duplicates constant fixed bin(17,0) initial dcl 1-15 ref 612 710 SS_index constant fixed bin(17,0) initial dcl 1-15 ref 349 371 420 552 726 SS_info_version_1 000006 constant char(8) initial packed unaligned dcl 1-15 ref 260 SS_length constant fixed bin(17,0) initial dcl 1-15 ref 391 396 443 448 560 649 728 SS_only_duplicate_keys constant fixed bin(17,0) initial dcl 1-15 ref 618 SS_only_duplicates constant fixed bin(17,0) initial dcl 1-15 ref 615 SS_only_unique constant fixed bin(17,0) initial dcl 1-15 ref 627 SS_only_unique_keys constant fixed bin(17,0) initial dcl 1-15 ref 630 SS_reg_exp constant fixed bin(17,0) initial dcl 1-15 ref 357 428 655 SS_string constant fixed bin(17,0) initial dcl 1-15 ref 341 361 412 432 643 659 714 718 SS_unique constant fixed bin(17,0) initial dcl 1-15 ref 621 SS_unique_keys constant fixed bin(17,0) initial dcl 1-15 ref 624 SS_unset constant fixed bin(17,0) initial dcl 1-15 ref 262 264 268 271 276 277 278 710 717 764 Saf parameter bit(1) packed unaligned dcl 1088 in procedure "get_invocation_type" set ref 1085 1097* 1103* Saf 000652 automatic bit(1) packed unaligned dcl 1057 in procedure "sf" set ref 210* 211 241* 243* 243* 836 Scheck_nulls parameter bit(1) packed unaligned dcl 1164 ref 1161 1174 Sdescending 000102 automatic bit(1) packed unaligned dcl 68 set ref 281* 462 587* 591* 731 Serror 000626 automatic bit(1) packed unaligned dcl 947 set ref 685 764 773* 780 788 964* 1107* Serrors_are_fatal 000627 automatic bit(1) packed unaligned dcl 947 set ref 743* 891* 904* 924* 966 1094* 1289* Sinteger 000103 automatic bit(1) packed unaligned dcl 68 set ref 283* 465 601* 605* 607* 734 Snon_case_sensitive 000104 automatic bit(1) packed unaligned dcl 68 set ref 280* 463 594* 596* 732 739 Snumeric 000105 automatic bit(1) packed unaligned dcl 68 set ref 282* 464 600* 603* 609* 733 Ssuppress_error 000100 automatic bit(1) packed unaligned dcl 983 set ref 989* 998* 1019 Syes 000106 automatic bit(1) packed unaligned dcl 68 set ref 766* 772* 773 TRUE constant bit(1) initial packed unaligned dcl 117 ref 474 482 491 496 567 591 596 603 607 739 743 772 773 891 904 924 940 964 998 1097 1128 1157 1180 active_fnc_err_ 000072 constant entry external dcl 1057 ref 1099 addcharno builtin function dcl 98 ref 823 addr builtin function dcl 98 ref 792 792 832 832 935 936 1287 1287 arg parameter char packed unaligned dcl 1132 in procedure "get_arg" set ref 1130 1138 1142* 1142* 1151* 1151* 1161 1167* 1167* 1175* 1175* 1197 1202* arg parameter char packed unaligned dcl 1218 in procedure "output_string" set ref 1215 1226 1227* 1229 1233* 1236* 1242* 1244* arg parameter char packed unaligned dcl 979 in procedure "cv_num" set ref 976 1022* 1022* arg based char packed unaligned dcl 1057 in procedure "sf" set ref 304 307* 310* 311* 315* 317* 322 322 325 325 328 328 334* 337* 339* 353* 353* 374* 374* 377* 377* 385* 387* 398* 401* 401* 408* 410* 424* 424* 450* 453* 453* 512* 512* 520* 520* 531* 531* 541 541 548* 550* 557* 558* 566* 570* 570* 585 585 589 589 594 594 596 596 599 599 603 603 607 607 612 612 615 615 618 618 621 621 624 624 627 627 630 630 633 633 634* 634* 638 638 640* 642* 652* 652* 666 666 670 670 670 670 674* 676* 680* arg parameter char packed unaligned dcl 881 in procedure "add_to_string" ref 878 888 898 903 909 910 arg_ptr 000656 automatic entry variable dcl 1057 set ref 1098* 1104* 1127 1149 1173 bc 000107 automatic fixed bin(24,0) dcl 68 set ref 750* 756 block_size 2 000373 automatic fixed bin(17,0) level 3 dcl 68 set ref 261* 634* cleanup 000376 stack reference condition dcl 102 ref 248 code based fixed bin(35,0) dcl 954 in procedure "ck_err" set ref 962 963 963* code 000110 automatic fixed bin(35,0) dcl 68 in procedure "sf" set ref 210* 212* 241* 249* 310* 311* 347* 352 353* 369* 370 374 374* 377* 388* 389 393 398* 401* 418* 423 424* 440* 441 445 450* 453* 500* 577* 648* 649 651 652* 675* 676* 750* 751 751* 781* 783* 792* 795* 832* 835 922* 923 925* 1127* 1149* 1173* 1259* 1260 code parameter fixed bin(35,0) dcl 1088 in procedure "get_invocation_type" set ref 1085 1095* 1096 code 000100 automatic fixed bin(35,0) dcl 1281 in procedure "sub_error_handler" set ref 1287* code 000101 automatic fixed bin(35,0) dcl 983 in procedure "cv_num" set ref 1001* 1006* 1011* 1018* 1019 1022* collate9 builtin function dcl 886 ref 919 com_err_ 000074 constant entry external dcl 1057 ref 1105 command_query_$yes_no 000010 constant entry external dcl 105 ref 766 cond_info 000102 automatic structure level 1 unaligned dcl 1282 set ref 1287 1287 condition_info based structure level 1 dcl 2-14 condition_info_header based structure level 1 dcl 4-6 conversion 000102 stack reference condition dcl 983 ref 1005 1016 convert builtin function dcl 98 ref 1015 cu_$af_arg_count 000106 constant entry external dcl 1043 ref 1045 cu_$af_arg_ptr_rel 000062 constant entry external dcl 1057 ref 1098 cu_$af_return_arg 000066 constant entry external dcl 1057 ref 1095 cu_$arg_list_ptr 000100 constant entry external dcl 957 in procedure "ck_err" ref 965 965 cu_$arg_list_ptr 000070 constant entry external dcl 1057 in procedure "sf" ref 1108 cu_$arg_ptr 000102 constant entry external dcl 957 ref 961 cu_$arg_ptr_rel 000064 constant entry external dcl 1057 ref 1104 cu_$generate_call 000104 constant entry external dcl 957 ref 965 delim 10 000373 automatic structure level 3 in structure "si" dcl 68 in procedure "sf" delim 10 based structure level 3 in structure "ss_info" dcl 1-15 in procedure "sf" delimiter 000424 automatic char(1) packed unaligned dcl 861 set ref 715 888 896 897 900 901* 903 909 911 918* 934 939 descending 321 000373 automatic bit(1) array level 4 packed packed unaligned dcl 68 set ref 462* 470* 474* 567* 731* 737* 737 descending_sort 000111 automatic fixed bin(17,0) dcl 68 set ref 278* 586* 590* 737 divide builtin function dcl 98 ref 822 1046 duplicate_mode 4 000373 automatic fixed bin(17,0) level 3 dcl 68 set ref 262* 612* 615* 618* 621* 624* 627* 630* 710 710* entrypoint parameter char packed unaligned dcl 1088 ref 1085 1093 ep 000653 automatic char(12) packed unaligned dcl 1057 set ref 212* 216* 243* 249* 306 307* 311* 322 353* 374* 377* 398* 401* 424* 450* 453* 512* 520* 531* 541 570* 638 652* 666 670 676* 680* 713 744 747* 751* 753* 756* 766* 783* 792* 795 795* 818* 832* 892* 905* 922* 925* 1022* 1093* 1142* 1151* 1167* 1175* 1291* equal_ent 000112 automatic char(32) packed unaligned dcl 68 set ref 781* 785 err 000662 automatic entry variable dcl 1057 set ref 965* 1099* 1105* err_msg parameter char packed unaligned dcl 1132 in procedure "get_arg" ref 1130 1138 1142 1142 1151 1151 1161 1167 1175 err_msg parameter char packed unaligned dcl 979 in procedure "cv_num" ref 976 1022 error_table_$bad_arg 000030 external static fixed bin(35,0) dcl 117 set ref 531* 570* 1001 1006 1151* 1175* error_table_$badopt 000032 external static fixed bin(35,0) dcl 117 set ref 680* error_table_$data_seq_error 000034 external static fixed bin(35,0) dcl 117 set ref 512* 520* error_table_$dirseg 000036 external static fixed bin(35,0) dcl 117 set ref 753* error_table_$noarg 000040 external static fixed bin(35,0) dcl 117 set ref 747* 1142* 1167* error_table_$out_of_bounds 000042 external static fixed bin(35,0) dcl 117 ref 352 374 393 423 445 651 1011 1018 error_table_$too_many_args 000044 external static fixed bin(35,0) dcl 117 set ref 905* error_table_$too_many_names 000046 external static fixed bin(35,0) dcl 117 set ref 307* error_table_$wrong_no_of_args 000050 external static fixed bin(35,0) dcl 117 set ref 216* 243* error_table_$zero_length_seg 000052 external static fixed bin(35,0) dcl 117 set ref 756* expand_pathname_ 000012 constant entry external dcl 105 ref 310 675 field 113 000373 automatic structure array level 2 in structure "si" dcl 68 in procedure "sf" field 113 based structure array level 2 in structure "ss_info" dcl 1-15 in procedure "sf" field_count 3 000373 automatic fixed bin(17,0) level 3 dcl 68 set ref 267* 335 503* 508* 517* 538* 549 579* 582* 686 692* 722* 724 725* field_sort 000122 automatic fixed bin(17,0) dcl 68 set ref 276* 325* 329* 543* 686 686 722 736 find_condition_info_ 000112 constant entry external dcl 1283 ref 1287 from 113 000373 automatic structure array level 3 dcl 68 get_equal_name_ 000014 constant entry external dcl 105 ref 781 get_line_length_$switch 000076 constant entry external dcl 1211 ref 1259 get_temp_segment_ 000054 constant entry external dcl 861 ref 922 hcs_$status_minf 000016 constant entry external dcl 105 ref 750 header 000373 automatic structure level 2 in structure "si" dcl 68 in procedure "sf" header based structure level 2 in structure "ss_info" dcl 1-15 in procedure "sf" header based structure level 2 in structure "sub_err_info" dcl 1285 in procedure "sub_error_handler" in_dir 000123 automatic char(168) packed unaligned dcl 68 set ref 221* 307 310* 689* 747 750* 751* 751 753* 753 756* 756 761 766* 766 776 792* in_ent 000175 automatic char(32) packed unaligned dcl 68 set ref 222* 310* 750* 751* 753* 756* 762 766* 777 781* 783* 792* index builtin function dcl 98 ref 304 526 888 898 898 934 info_ptr 14 000102 automatic pointer level 2 dcl 1282 set ref 1291 1291 info_string 3 based varying char(256) level 3 dcl 1285 set ref 1291* integer 321(03) 000373 automatic bit(1) array level 4 packed packed unaligned dcl 68 set ref 465* 487* 492* 496* 734* ioa_$nnl 000110 constant entry external dcl 1220 ref 1233 1236 1242 1244 1250 1267 length builtin function dcl 98 ref 356 356 358 427 427 429 654 654 656 822 896 897 903 903 903 908 909 909 909 911 932 936 936 936 938 938 939 1151 1151 1175 1175 1188 1227 1229 1241 1246 max builtin function dcl 98 ref 1047 mbz1 5 000373 automatic fixed bin(17,0) array level 3 dcl 68 set ref 263* modes 321 000373 automatic structure array level 3 dcl 68 set ref 274* 565* 730* n 000110 automatic fixed bin(17,0) dcl 983 set ref 1007* 1012* 1015* 1015 1017 1025 new_delimiter 000703 automatic char(1) packed unaligned dcl 883 set ref 896* 898 898 900 901 non_case_sensitive 321(01) 000373 automatic bit(1) array level 4 packed packed unaligned dcl 68 set ref 463* 478* 482* 732* 739* null builtin function dcl 1284 in procedure "sub_error_handler" ref 1287 1287 null builtin function dcl 98 in procedure "sf" ref 247 1259 1259 number 11 000373 automatic fixed bin(17,0) level 4 in structure "si" dcl 68 in procedure "sf" set ref 265* 648* number 114 000373 automatic fixed bin(17,0) array level 4 in structure "si" dcl 68 in procedure "sf" set ref 269* 350* 372* 550* 727* number 217 000373 automatic fixed bin(17,0) array level 4 in structure "si" dcl 68 in procedure "sf" set ref 272* 390* 395* 421* 442* 447* 558* 729* number 000205 automatic fixed bin(17,0) dcl 68 in procedure "sf" set ref 347* 348 350 369* 372 388* 390 393 395 418* 419 421 440* 442 445 447 numeric 321(02) 000373 automatic bit(1) array level 4 packed packed unaligned dcl 68 set ref 464* 486* 491* 497* 733* op based char packed unaligned dcl 1057 in procedure "sf" set ref 336 336 353* 369* 374* 374* 386 407 424* 440* 469 469 473 473 477 477 481 481 485 485 490 490 495 495 500* 505 505 510 510 511* 526 550* 577* 634* 641 641 644 648* 652* 652* 652* 654 654 654 654 656 656 660 675* 676* 1150 1151 1151 1151* 1156* 1175 1175 1175* op parameter char packed unaligned dcl 979 in procedure "cv_num" ref 976 992 1000 1015 op parameter char packed unaligned dcl 1186 in procedure "add_op_to_list" set ref 1183 1188 1188 1188* 1190 op2 based char packed unaligned dcl 1057 set ref 338 338 342 347* 353* 353* 356 356 356 356 358 358 362 388* 409 409 413 418* 424* 424* 427 427 427 427 429 429 433 558* 567 569 1174 1179* op_list 000206 automatic varying char(256) dcl 68 set ref 353* 374* 377* 398* 401* 424* 450* 453* 512* 520* 531* 570* 1022* 1135* 1142* 1151 1151* 1167* 1175* 1188* 1188 1190* 1190 1192* 1192 out_dir 000307 automatic char(168) packed unaligned dcl 68 set ref 223* 675* 761* 776* 792* out_ent 000361 automatic char(32) packed unaligned dcl 68 set ref 224* 675* 762* 777* 781* 783* 785* 792* out_len 000371 automatic fixed bin(21,0) dcl 68 set ref 792* out_string based char packed unaligned dcl 861 set ref 832* 932 934 935 936 938 out_string_ch based char(1) array packed unaligned dcl 861 set ref 936 out_string_component based char packed unaligned dcl 861 set ref 838* 844* 936 936 938 possible_delimiters 000425 automatic varying char(512) dcl 861 set ref 889 896 897* 897 919* q 000372 automatic fixed bin(17,0) dcl 68 set ref 765* 766 release_temp_segment_ 000056 constant entry external dcl 861 ref 249 795 requote_string_ 000020 constant entry external dcl 105 ref 1188 1202 1227 1233 1242 ret based varying char dcl 1057 set ref 1100* 1200 1200* 1200 1202* 1202 reverse builtin function dcl 886 ref 919 search builtin function dcl 98 ref 1188 1226 si 000373 automatic structure level 1 dcl 68 set ref 792 792 832 832 size 000112 stack reference condition dcl 983 ref 1010 1016 sort_output 000373 automatic fixed bin(17,0) dcl 68 set ref 277* 666* 673* 760 764 sort_seg_$seg 000022 constant entry external dcl 105 ref 792 sort_seg_$string 000024 constant entry external dcl 105 ref 832 ss_info based structure level 1 dcl 1-15 status_code 104 based fixed bin(35,0) level 3 dcl 1285 set ref 1291* string 12 000373 automatic varying char(256) level 4 in structure "si" dcl 68 in procedure "sf" set ref 266* 644* 656* 660* 715* 719* string based char packed unaligned dcl 861 in procedure "sf" set ref 822 832* 898 900* 900 903 908 909 910* 911 911* string 115 000373 automatic varying char(256) array level 4 in structure "si" dcl 68 in procedure "sf" set ref 270* 342* 358* 362* string 220 000373 automatic varying char(256) array level 4 in structure "si" dcl 68 in procedure "sf" set ref 273* 413* 429* 433* sub_err_info based structure level 1 unaligned dcl 1285 sub_error_ 000404 stack reference condition dcl 102 ref 790 830 sub_error_info based structure level 1 dcl 3-7 substr builtin function dcl 98 set ref 356 356 358 427 427 429 654 654 656 896 897 910* 911* sys_info$max_seg_size 000060 external static fixed bin(35,0) dcl 861 ref 921 to 216 000373 automatic structure array level 3 dcl 68 translate builtin function dcl 886 ref 900 type 216 000373 automatic fixed bin(17,0) array level 4 in structure "si" dcl 68 in procedure "sf" set ref 271* 391* 396* 412* 420* 428* 432* 443* 448* 560* 728* type 10 000373 automatic fixed bin(17,0) level 4 in structure "si" dcl 68 in procedure "sf" set ref 264* 643* 649* 655* 659* 714* 717 718* type 000374 automatic fixed bin(2,0) dcl 68 in procedure "sf" set ref 750* 753 type 113 000373 automatic fixed bin(17,0) array level 4 in structure "si" dcl 68 in procedure "sf" set ref 268* 341* 349* 357* 361* 371* 552* 726* undelim_char_index 000375 automatic fixed bin(21,0) dcl 68 set ref 792* 832* user_info_$absentee_queue 000026 constant entry external dcl 105 ref 765 version 000373 automatic char(8) level 3 dcl 68 set ref 260* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. condition_info_header_ptr automatic pointer dcl 4-4 condition_info_ptr automatic pointer dcl 2-10 condition_info_version_1 internal static fixed bin(17,0) initial dcl 2-30 ss_field_count automatic fixed bin(17,0) dcl 1-15 ss_info_ptr automatic pointer dcl 1-15 sub_error_info_ptr automatic pointer dcl 3-6 sub_error_info_version_1 internal static fixed bin(17,0) initial dcl 3-13 NAMES DECLARED BY EXPLICIT CONTEXT. COMMON 002500 constant label dcl 260 in procedure "sf" ref 226 COMMON 011350 constant label dcl 1005 in procedure "cv_num" ref 990 END_FL 005525 constant label dcl 537 ref 383 460 END_OFL 006165 constant label dcl 581 ref 555 563 FL 000000 constant label array(3) dcl 334 ref 332 FL3_OP 005000 constant label dcl 468 ref 471 475 479 483 488 493 498 NEED_NEW_DELIMITER 010576 constant label dcl 889 ref 898 OFL 000003 constant label array(3) dcl 548 ref 546 OP_NOT_NUMERIC 011441 constant label dcl 1019 ref 1002 1008 1013 OUTPUT_AT_BEGINNING_OF_LINE 013100 constant label dcl 1233 ref 1251 REPROCESS_ARGS 002661 constant label dcl 302 ref 693 RETURN 010303 constant label dcl 795 ref 685 788 849 966 SORT_STRINGS 010331 constant label dcl 818 ref 744 STRING_ARGS 003035 constant label dcl 316 ref 322 add_op_to_list 012707 constant entry internal dcl 1183 ref 1156 1179 add_to_return_arg 012612 constant entry internal dcl 1197 ref 838 add_to_string 010547 constant entry internal dcl 878 ref 315 317 add_to_string$init 011013 constant entry internal dcl 915 ref 251 ck_err 011173 constant entry internal dcl 950 ref 212 216 243 307 311 353 374 377 398 401 424 450 453 512 520 531 570 652 676 680 747 751 753 756 783 818 892 905 925 1022 1142 1151 1167 1175 1291 cv_num 011261 constant entry internal dcl 976 ref 550 558 634 cv_num_no_errors 011314 constant entry internal dcl 992 ref 347 369 388 418 440 500 577 648 estimate_fields 011531 constant entry internal dcl 1034 ref 68 get_arg 011666 constant entry internal dcl 1121 ref 302 316 get_invocation_type 011560 constant entry internal dcl 1085 ref 210 241 get_op 011744 constant entry internal dcl 1130 ref 334 548 575 634 640 642 674 get_op1 011770 constant entry internal dcl 1138 ref 385 468 get_op2 012310 constant entry internal dcl 1161 ref 337 339 387 408 410 511 557 566 get_out_string_component 011110 constant entry internal dcl 929 ref 837 843 output_string 013021 constant entry internal dcl 1215 ref 844 output_string$init 013277 constant entry internal dcl 1256 ref 842 output_string$term 013323 constant entry internal dcl 1264 ref 846 prepare_to_reprocess_args 011662 constant entry internal dcl 1112 ref 691 sf 002224 constant entry external dcl 63 sort_file 002234 constant entry external dcl 63 sort_seg 002254 constant entry external dcl 63 sort_strings 002364 constant entry external dcl 238 ss 002244 constant entry external dcl 63 sstr 002354 constant entry external dcl 238 sub_error_handler 013343 constant entry internal dcl 1276 ref 790 830 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 14676 15012 14142 14706 Length 15374 14142 114 346 533 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME sf 954 external procedure is an external procedure. on unit on line 248 78 on unit on unit on line 790 64 on unit on unit on line 830 64 on unit add_to_string internal procedure shares stack frame of external procedure sf. ck_err 82 internal procedure is called during a stack extension, and is declared options(variable). cv_num 248 internal procedure enables or reverts conditions. on unit on line 1005 64 on unit on unit on line 1010 64 on unit estimate_fields internal procedure shares stack frame of external procedure sf. get_invocation_type internal procedure shares stack frame of external procedure sf. get_arg internal procedure shares stack frame of external procedure sf. add_op_to_list internal procedure shares stack frame of external procedure sf. output_string internal procedure shares stack frame of external procedure sf. sub_error_handler 120 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ck_err 000100 Pcode ck_err cv_num 000100 Ssuppress_error cv_num 000101 code cv_num 000110 n cv_num sf 000100 Ifl sf 000101 Itriple sf 000102 Sdescending sf 000103 Sinteger sf 000104 Snon_case_sensitive sf 000105 Snumeric sf 000106 Syes sf 000107 bc sf 000110 code sf 000111 descending_sort sf 000112 equal_ent sf 000122 field_sort sf 000123 in_dir sf 000175 in_ent sf 000205 number sf 000206 op_list sf 000307 out_dir sf 000361 out_ent sf 000371 out_len sf 000372 q sf 000373 si sf 000373 sort_output sf 000374 type sf 000375 undelim_char_index sf 000412 Lout_string sf 000413 Lstring sf 000414 Lout_string_component sf 000415 MLstring sf 000416 Pout_string sf 000420 Pout_string_component sf 000422 Pstring sf 000424 delimiter sf 000425 possible_delimiters sf 000626 Serror sf 000627 Serrors_are_fatal sf 000630 Iarg sf 000631 Iarg_pass sf 000632 Larg sf 000633 Lop sf 000634 Lop2 sf 000635 Lret sf 000636 Nargs sf 000640 Parg sf 000642 Parg_list sf 000644 Pop sf 000646 Pop2 sf 000650 Pret sf 000652 Saf sf 000653 ep sf 000656 arg_ptr sf 000662 err sf 000666 Loutput_line sf 000667 MLoutput_line sf 000702 Istring_new add_to_string 000703 new_delimiter add_to_string 000714 Nargs estimate_fields 000715 Nfields estimate_fields 000756 IHT_SP output_string 000757 Lrq_arg output_string sub_error_handler 000100 code sub_error_handler 000102 cond_info sub_error_handler THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as alloc_char_temp call_ent_var call_ext_out_desc call_ext_out call_int_this_desc call_int_other_desc call_int_other return_mac tra_ext_1 alloc_auto_adj signal_op enable_op shorten_stack ext_entry int_entry int_entry_desc set_chars_eis any_to_any_truncate_translate_3 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ command_query_$yes_no cu_$af_arg_count cu_$af_arg_ptr_rel cu_$af_return_arg cu_$arg_list_ptr cu_$arg_list_ptr cu_$arg_ptr cu_$arg_ptr_rel cu_$generate_call expand_pathname_ find_condition_info_ get_equal_name_ get_line_length_$switch get_temp_segment_ hcs_$status_minf ioa_$nnl release_temp_segment_ requote_string_ sort_seg_$seg sort_seg_$string user_info_$absentee_queue THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$badopt error_table_$data_seq_error error_table_$dirseg error_table_$noarg error_table_$out_of_bounds error_table_$too_many_args error_table_$too_many_names error_table_$wrong_no_of_args error_table_$zero_length_seg sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 68 002211 63 002223 210 002262 211 002267 212 002272 213 002306 215 002307 216 002311 218 002335 221 002336 222 002341 223 002344 224 002347 226 002352 238 002353 241 002372 242 002402 243 002404 245 002436 247 002437 248 002441 249 002455 250 002476 251 002477 260 002500 261 002504 262 002506 263 002510 264 002521 265 002523 266 002524 267 002525 268 002526 269 002542 270 002554 271 002566 272 002602 273 002614 274 002626 276 002651 277 002653 278 002654 280 002655 281 002656 282 002657 283 002660 302 002661 304 002667 306 002703 307 002707 310 002746 311 002776 312 003021 315 003022 316 003035 317 003043 318 003056 320 003057 322 003060 325 003075 328 003110 329 003120 331 003122 332 003127 334 003130 335 003156 336 003162 337 003174 338 003225 339 003237 341 003273 342 003301 343 003313 344 003314 345 003316 347 003317 348 003341 349 003344 350 003352 351 003354 352 003355 353 003361 355 003450 356 003451 357 003466 358 003474 359 003506 361 003507 362 003515 365 003526 366 003527 367 003531 369 003532 370 003555 371 003557 372 003565 373 003567 374 003570 377 003662 381 003732 382 003733 383 003735 385 003736 386 003764 387 003772 388 004023 389 004046 390 004050 391 004056 392 004060 393 004061 395 004067 396 004075 397 004077 398 004100 401 004142 404 004212 405 004213 406 004215 407 004216 408 004222 409 004253 410 004265 412 004321 413 004327 414 004341 415 004342 416 004344 418 004345 419 004367 420 004372 421 004400 422 004402 423 004403 424 004407 426 004476 427 004477 428 004514 429 004522 430 004534 432 004535 433 004543 436 004554 437 004555 438 004557 440 004560 441 004602 442 004604 443 004612 444 004614 445 004615 447 004623 448 004631 449 004633 450 004634 453 004676 457 004746 458 004747 460 004751 462 004752 463 004761 464 004766 465 004773 468 005000 469 005006 470 005020 471 005025 473 005026 474 005036 475 005043 477 005044 478 005054 479 005061 481 005062 482 005072 483 005077 485 005100 486 005110 487 005115 488 005117 490 005120 491 005130 492 005135 493 005137 495 005140 496 005150 497 005155 498 005157 500 005160 501 005205 502 005207 503 005210 504 005213 505 005214 506 005226 507 005230 508 005231 509 005234 510 005235 511 005245 512 005301 515 005347 516 005351 517 005353 518 005356 520 005357 523 005425 525 005427 526 005430 527 005442 528 005444 529 005446 531 005447 533 005520 535 005522 536 005523 537 005525 538 005527 539 005532 541 005533 543 005552 545 005554 546 005561 548 005562 549 005610 550 005614 552 005654 553 005660 554 005661 555 005663 557 005664 558 005715 560 005756 561 005762 562 005763 563 005765 565 005766 566 006003 567 006034 569 006050 570 006055 575 006123 576 006131 577 006133 579 006162 581 006165 582 006167 583 006172 585 006173 586 006204 587 006206 588 006207 589 006210 590 006220 591 006222 592 006224 594 006225 596 006237 599 006252 600 006262 601 006263 602 006264 603 006265 605 006277 606 006300 607 006301 609 006313 610 006314 612 006315 615 006331 618 006345 621 006361 624 006375 627 006411 630 006425 633 006441 634 006451 636 006537 638 006540 640 006552 641 006577 642 006611 643 006642 644 006645 645 006667 646 006670 648 006671 649 006714 651 006722 652 006725 653 007010 654 007011 655 007026 656 007031 657 007042 659 007043 660 007046 661 007067 664 007070 666 007071 670 007106 673 007130 674 007132 675 007163 676 007213 678 007253 680 007254 682 007277 684 007300 685 007303 686 007305 689 007317 690 007322 691 007323 692 007324 693 007326 710 007327 713 007334 714 007340 715 007342 716 007346 717 007347 718 007351 719 007353 722 007357 724 007363 725 007365 726 007367 727 007371 728 007373 729 007375 730 007377 731 007411 732 007415 733 007422 734 007427 735 007434 736 007435 737 007440 739 007464 743 007501 744 007503 747 007507 750 007537 751 007574 753 007645 756 007720 760 007767 761 007772 762 007775 763 010000 764 010001 765 010007 766 010016 772 010103 773 010105 776 010113 777 010116 779 010121 780 010122 781 010124 783 010147 785 010204 788 010207 790 010211 792 010233 795 010303 797 010330 818 010331 822 010360 823 010365 826 010375 827 010377 830 010401 832 010423 835 010473 836 010475 837 010500 838 010505 839 010520 840 010521 842 010522 843 010523 844 010531 845 010544 846 010545 849 010546 878 010547 888 010562 889 010576 891 010603 892 010605 896 010632 897 010635 898 010646 900 010676 901 010713 903 010716 904 010723 905 010725 908 010751 909 010754 910 010760 911 011000 912 011004 915 011013 918 011016 919 011020 920 011025 921 011026 922 011032 923 011052 924 011054 925 011056 927 011101 929 011110 932 011113 934 011131 935 011143 936 011145 938 011152 939 011154 940 011156 950 011172 961 011200 962 011220 963 011222 964 011225 965 011230 966 011251 969 011257 976 011260 989 011311 990 011312 992 011313 998 011332 999 011334 1000 011336 1001 011344 1002 011347 1005 011350 1006 011364 1007 011367 1008 011371 1010 011374 1011 011410 1012 011413 1013 011415 1015 011420 1016 011431 1017 011433 1018 011436 1019 011441 1022 011447 1024 011525 1025 011526 1034 011531 1045 011533 1046 011545 1047 011551 1048 011555 1085 011560 1093 011571 1094 011576 1095 011577 1096 011614 1097 011617 1098 011623 1099 011630 1100 011633 1101 011634 1103 011635 1104 011641 1105 011646 1107 011651 1108 011652 1109 011660 1112 011661 1115 011663 1116 011664 1118 011665 1121 011666 1124 011674 1126 011712 1127 011713 1128 011731 1130 011744 1135 011766 1138 011767 1141 012012 1142 012015 1145 012076 1148 012112 1149 012113 1150 012131 1151 012137 1154 012246 1156 012262 1157 012275 1161 012310 1166 012332 1167 012335 1169 012411 1172 012425 1173 012426 1174 012444 1175 012460 1177 012550 1179 012564 1180 012577 1197 012612 1200 012624 1202 012641 1204 012677 1183 012707 1188 012720 1190 012776 1192 013011 1194 013020 1215 013021 1226 013032 1227 013046 1229 013073 1232 013076 1233 013100 1236 013141 1238 013163 1239 013165 1241 013166 1242 013172 1244 013233 1246 013255 1247 013261 1250 013262 1251 013275 1253 013276 1256 013277 1259 013300 1260 013315 1261 013321 1264 013322 1267 013324 1270 013341 1276 013342 1287 013350 1289 013366 1291 013370 1293 013412 ----------------------------------------------------------- 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