COMPILATION LISTING OF SEGMENT add_pnotice Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 12/01/87 0914.1 mst Tue Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 6* * * 7* *********************************************************** */ 8 9 10 /****^ HISTORY COMMENTS: 11* 1) change(81-06-01,Stansbury), approve(), audit(), install(): 12* Created. 13* 2) change(82-10-01,Stansbury), approve(), audit(), install(): 14* Modified - Changed the treatment of Lisp comment conventions from 15* use of one semicolon to three semicolons, which is desired by 16* various Lisp language formatters. 17* 3) change(82-11-01,Stansbury), approve(), audit(), install(): 18* Modified - Added functionality to (add display)_pnotice to support 19* public domain notices. This functionality is invoked with the 20* -public_domain control argument for add_pnotice. A public domain 21* pnotice is expected to have the name "public_domain.pnotice". 22* There should only be one such template. 23* 4) change(83-06-01,Stansbury), approve(), audit(), install(): 24* Modified - Made display_pnotice smart enough to find embedded trade 25* secret and public domain pnotices. Fixed miscellaneous bugs. 26* 5) change(85-09-27,LJAdams), approve(85-09-27,MCR7150), 27* audit(86-05-19,Gilcrease), install(86-02-13,MR12.0-1017): 28* - Removed the date from the template names. 29* - Changed add_pnotice to allow multiple component prefixes for template 30* names. 31* - Added the default arguments -dc and -dts. 32* - Default pnotices are no longer automatically applied if there are no 33* existing pnotices. 34* - The -long and -brief arguments have been added; -long is the default 35* as -brief prints nothing. 36* - Two new language types have been added. Type 4 has a /****^ as a 37* comment delimiter; this allows format pl1 to work properly on history 38* comments. Type 5 is for runoff and compose files. Blank lines will 39* not be inserted before and after the history comment as they are 40* interpeted as space blocks by compose. 41* 6) change(86-04-17,LJAdams), approve(86-05-05,MCR7393), 42* audit(86-05-19,Gilcrease), install(86-09-05,MR12.0-1071): 43* Change so that if the -long argument is specified , default copyrights 44* will print if they have been added. 45* 7) change(86-09-05,LJAdams), approve(86-09-05,MCR7526), 46* audit(86-11-05,GDixon), install(86-11-12,MR12.0-1213): 47* Corrected looping problem with pnotices in invalid format. 48* 49* Corrected problem of losing a character when adding pnotice without 50* the -nm option. 51* 52* phx20632 - was not picking up DEFAULT TRADE SECRET pnotices. 53* 54* phx20629 - suggestion was made to use error_table_$bad_file_name 55* instead of error_table_$badstar. 56* 8) change(87-04-17,LJAdams), approve(87-04-20,MCR7674), 57* audit(87-05-04,Gilcrease), install(87-05-08,MR12.1-1031): 58* Add HBULL copyright as the default if the most recent pnotice is HIS, 59* HIS_A, HIS_B, MIT_HIS, or MIT_HIS_A. 60* 9) change(87-11-09,LJAdams), approve(87-11-10,MCR7805), 61* audit(87-11-30,Wallman), install(87-12-01,MR12.2-1007): 62* Do not add blank line after pnotice box for compin or runoff files as they 63* are interpreted as space blocks by compose. 64* END HISTORY COMMENTS */ 65 66 /* format: style2,ind2,ll79,dclind4,idind15,comcol41,linecom,ifthenstmt*/ 67 /* for mat: style2,ind2,ll131,dclind4,idind15,comcol41,linecom,ifthenstmt*/ 68 add_pnotice: 69 proc; 70 71 72 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 73 /* */ 74 /* This command is used to insert software protection copyright or Trade Secret notices */ 75 /* into source programs. The code is entirely new, it replaces the add_copyright and */ 76 /* copyright_archive commands. This command uses the pnotice search list to find the text */ 77 /* of protection notices to add. The default search directory for this search list is */ 78 /* >tools. The command also uses the pnotice_language_info_ database (created by CDS) to */ 79 /* obtain information on the source language segment. */ 80 /* */ 81 /* ENTRY: display_pnotice */ 82 /* */ 83 /* This is the command used to print either the entire text of protection notices, or */ 84 /* their primary names, as found in source programs. Since so much of the code is */ 85 /* shareable, it is a separate external entry in add_pnotice. */ 86 /* */ 87 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 88 89 90 91 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 92 /* */ 93 /* INTERNAL PROCEDURES IN THIS PROGRAM. THESE ARE LISTED IN THE ORDER THAT THEY EXIST */ 94 /* INLINE, AS WELL AS THE MOST FREQUENT PATH OF EXECUTION. */ 95 /* */ 96 /* Name Brief description */ 97 /* init_structures sets variables in the source_info and target_info structures. */ 98 /* process_archive_components */ 99 /* main internal proc to begin archive processing. */ 100 /* process_single_seg main internal proc to begin free standing segment processing. */ 101 /* get_language_info obtains per-language parameters like comment delimiters, etc. */ 102 /* pnotice_parse finds the extents of a notice box, if any. */ 103 /* process_tokens drives the parsing procedures to locate notices. */ 104 /* parse_source_ primitive that provides mechanism for finding source tokens. */ 105 /* parse_templates_ primitive that provides mechanism for finding template tokens. */ 106 /* find_line used by parsing procs for processing line-by-line. */ 107 /* continue_processing function providing testing for further processing. */ 108 /* sort_pnotices sorts >1 notice into proper order. */ 109 /* ok_nine_year_rule enforces LISD rule for new notices. */ 110 /* make_star_box forms text and new star box for insertion. */ 111 /* add_text builds new star box line-by-line. */ 112 /* check_acl provides for possible need to force access. */ 113 /* insert_notice puts new star box into proper place in a segment. */ 114 /* reset_acl provides mechanism to reset any forced access. */ 115 /* report used ONLY by display_pnotice to print output. */ 116 /* clean_up standard clean up proc. */ 117 /* */ 118 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 119 120 121 122 123 124 /* A U T O M A T I C */ 125 dcl current_year fixed bin, 126 current_year_a char (4), 127 DFcopy_right bit (1), /* flag for default copyright */ 128 DFtrade_secret bit (1), /* flag for default trade secret */ 129 Farchive bit (1), /* flag to indicate an archive */ 130 Fdisplay bit (1), /* ON if the display_pnotice entry called */ 131 Fcopy_right bit (1), /* ON if default copyright given */ 132 Fmode_set bit (1), 133 Fmust_reset bit (1), /* ON if access is forced. */ 134 Fname bit (1), /* ON if a copyright template name given */ 135 Fpublic_domain bit (1), /* ON if -public_domain given */ 136 Ftrade_secret bit (1), /* ON if -trade_secret given */ 137 i fixed bin (24), 138 Iarg fixed bin, 139 Idx1 fixed bin (24), 140 Itemplate fixed bin (24), /* index for templates */ 141 Larg fixed bin (21), 142 ME char (32), 143 Nargs fixed bin, 144 Parg ptr, 145 bit_count fixed bin (24), 146 code fixed bin (35), 147 common_archive_name 148 char (32), 149 component char (32), /* component name in archive if any */ 150 doing_all_components 151 bit (1), 152 path char (168), /* pathname input to command */ 153 pdir char (168) var, 154 process_dir char (168), /* used by get_pdir_ */ 155 save_name char (32), /* used to save template name */ 156 save_text char (512) var, /* used to save template text */ 157 seqno fixed bin (18), /* order templates occur in text */ 158 SI_yrno fixed bin (24), /* seq of yr in source */ 159 Sadd_default_pnotice 160 bit (1), 161 Sdfcopyright bit (1), 162 Sno_args_given bit (1), 163 Sold_style_pnotice 164 bit (1), /* cmt_bgn delimiter is a slash/asterick */ 165 Sprt_notice bit (1), /* print notice if -lg and new notices was added */ 166 source_year (10) fixed bin, /* yr in pgm requesing pnotice */ 167 source_year_a (10) char (4), 168 used_old_argument 169 bit (1); /* flag for old arg usage */ 170 171 172 173 /* E X T E R N A L E N T R I E S */ 174 dcl add_char_offset_ 175 entry (ptr, fixed bin (21)) returns (ptr) reducible, 176 archive entry options (variable), 177 archive_$get_component 178 entry (ptr, fixed bin (24), char (*), ptr, 179 fixed bin (24), fixed bin (35)), 180 archive_$next_component 181 entry (ptr, fixed bin (24), ptr, fixed bin (24), 182 char (*), fixed bin (35)), 183 char_offset_ entry (ptr) returns (fixed bin (21)) reducible, 184 check_star_name_$entry 185 entry (char (*), fixed bin (35)), 186 com_err_ entry () options (variable), 187 cu_$arg_count entry (fixed bin, fixed bin (35)), 188 cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)), 189 cu_$generate_call 190 entry (entry, ptr), 191 date_time_$format 192 entry (char (*), fixed bin (71), char (*), char (*)) 193 returns (char (250) var), 194 expand_pathname_$component 195 entry (char (*), char (*), char (*), char (*), 196 fixed bin (35)), 197 get_ec_version_ 198 entry (char (*), char (*), fixed bin, fixed bin (21), 199 fixed bin (35)), 200 get_group_id_ entry () returns (char (32)), 201 get_pdir_ entry () returns (char (168)), 202 get_temp_segment_ 203 entry (char (*), ptr, fixed bin (35)), 204 hcs_$add_acl_entries 205 entry (char (*), char (*), ptr, fixed bin, 206 fixed bin (35)), 207 hcs_$delentry_seg 208 entry (ptr, fixed bin (35)), 209 hcs_$delete_acl_entries 210 entry (char (*), char (*), ptr, fixed bin, 211 fixed bin (35)), 212 hcs_$initiate_count 213 entry (char (*), char (*), char (*), fixed bin (24), 214 fixed bin (2), ptr, fixed bin (35)), 215 hcs_$list_acl entry (char (*), char (*), ptr, ptr, ptr, fixed bin, 216 fixed bin (35)), 217 hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, 218 fixed bin (35)), 219 ioa_ entry () options (variable), 220 pathname_ entry (char (*), char (*)) returns (char (168)), 221 pathname_$component 222 entry (char (*), char (*), char (*)) 223 returns (char (194)), 224 pnotice_mlr_ entry (ptr, fixed bin (21), ptr, fixed bin (21)), 225 pnotice_mrl_ entry (ptr, fixed bin (21), ptr, fixed bin (21)), 226 pnotice_paths_ entry (char (*), bit (*), ptr, fixed bin (35)), 227 release_temp_segment_ 228 entry (char (*), ptr, fixed bin (35)), 229 terminate_file_ 230 entry (ptr, fixed bin (24), bit (*), fixed bin (35)); 231 232 233 /* I N T E R N A L S T A T I C */ 234 dcl Inconsistent_args 235 char (132) varying int static 236 init ( 237 "^/The ""^a"" and ""^a"" may not be used together"), 238 Not_found char (132) varying int static 239 init ( 240 "^/""^a"" not found in the pnotice search list.^/Use list pnotice_names to list valid names." 241 ), 242 True bit (1) int static options (constant) init ("1"b), 243 False bit (1) int static options (constant) init ("0"b), 244 sfx_string char (3) int static options (constant) init (" * 245 "), 246 STAR char (1) int static options (constant) init ("*"), 247 STARS char (200) int static options (constant) 248 init ((200)"*"), 249 SP_STAR char (2) int static options (constant) init (" *"), 250 SP_STAR_SP char (3) int static options (constant) init (" * "), 251 HT_SP_STAR char (3) int static options (constant) init (" *"), 252 HT_SP_NL char (3) int static options (constant) init (" 253 "), 254 SP char (1) int static options (constant) init (" "), 255 SPACES char (200) int static options (constant) 256 init ((200)" "), 257 NL char (1) int static options (constant) init (" 258 "), 259 NL_NL char (2) int static options (constant) init (" 260 261 "), 262 HT_SP_NL_VT_NP char (5) int static options (constant) init (" 263 "); 264 265 266 267 /* E X T E R N A L S T A T I C */ 268 dcl ( 269 error_table_$archive_component_modification, 270 error_table_$badopt, 271 error_table_$bad_file_name, 272 error_table_$improper_data_format, 273 error_table_$inconsistent, 274 error_table_$noarg, 275 error_table_$not_done, 276 error_table_$name_not_found, 277 error_table_$nostars, 278 error_table_$typename_not_found, 279 error_table_$wrong_no_of_args 280 ) fixed bin (35) ext static; 281 282 283 /* B U I L T I N */ 284 dcl (addr, addrel, addcharno, before, char, charno, clock, convert, 285 currentsize, dim, divide, hbound, index, length, lbound, ltrim, max, 286 null, ptr, reverse, rtrim, search, string, substr, verify) 287 builtin; 288 289 290 /* B A S E D */ 291 dcl argument char (Larg) based (Parg); 292 /* used to obtain args */ 293 294 295 /* C O N D I T I O N S */ 296 dcl (cleanup, not_in_write_bracket, no_write_permission) 297 condition; 298 299 300 301 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 302 303 ME = "add_pnotice"; /* the add_pnotice command */ 304 Fdisplay = False; 305 goto COMMON; 306 307 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 308 309 310 display_pnotice: 311 entry; 312 313 ME = "display_pnotice"; /* the display_pnotice command */ 314 Fdisplay = True; 315 316 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 317 318 319 COMMON: 320 arg_list_arg_count = 0; 321 Ppaths = null; 322 Pcomp_info = null; 323 Ptext = null; 324 path = ""; 325 Farchive = False; 326 Sprt_notice = False; 327 current_year_a = date_time_$format ("^9999yc", clock (), "", ""); 328 current_year = convert (current_year, current_year_a); 329 doing_all_components = False; 330 call init_structures (source_info, target_info); 331 /* init source and target info structures */ 332 333 334 on cleanup call clean_up; 335 336 target_info.long_output = True; /* default output */ 337 call init_variables; 338 339 call cu_$arg_count (Nargs, code); 340 if code ^= 0 341 then 342 do; 343 call com_err_ (code, ME, ""); 344 return; 345 end; 346 if Nargs = 0 347 then 348 do; 349 call ioa_ ( 350 "Syntax: ^a path {-control_args} For details, type: help ^a", 351 ME, ME); 352 return; 353 end; 354 do Iarg = 1 to Nargs; 355 call cu_$arg_ptr (Iarg, Parg, Larg, code); 356 if index (argument, "-") ^= 1 357 then 358 do; 359 if path = "" 360 then path = argument; 361 else 362 do; 363 call com_err_ (error_table_$wrong_no_of_args, ME, "^a 364 Multiple pathnames not allowed.", argument); 365 goto FATAL_ERROR; 366 end; 367 end; 368 else if (argument = "-trade_secret" | argument = "-public_domain") 369 then 370 do; 371 used_old_argument = True; 372 if argument = "-trade_secret" & ^Fdisplay then Ftrade_secret = True; 373 else if argument = "-public_domain" & ^Fdisplay 374 then Fpublic_domain = True; 375 end; 376 else if (argument = "-dts" | argument = "-default_trade_secret") 377 & ^Fdisplay 378 then DFtrade_secret = True; 379 else if (argument = "-dc" | argument = "-default_copyright") & ^Fdisplay 380 then DFcopy_right = True; 381 else if (argument = "-name" | argument = "-nm") & ^Fdisplay 382 then 383 do; 384 Iarg = Iarg + 1; 385 call cu_$arg_ptr (Iarg, Parg, Larg, code); 386 if code ^= 0 387 then 388 do; 389 NAME_ERR: 390 call com_err_ (code, ME, " 391 The -name control arg requires a pnotice name operand. 392 Use the list_pnotice_names command to print valid names."); 393 return; 394 end; 395 if index (argument, ".") ^= 0 396 then 397 do; 398 if reverse (before (reverse (argument), ".")) = "pnotice" 399 then 400 do; 401 code = error_table_$improper_data_format; 402 goto NAME_ERR; 403 end; 404 else ; 405 end; 406 if argument = "public_domain" then Fpublic_domain = True; 407 if reverse (before (reverse (argument), ".")) = "trade_secret" 408 then 409 do; 410 Ftrade_secret = True; 411 Fname = True; 412 source_info.notice_to_add.name = argument; 413 end; 414 else 415 do; 416 source_info.notice_to_add.name = argument; 417 Fname = True; 418 end; 419 end; /* argument = -nm */ 420 else if argument = "-long" | argument = "-lg" 421 then target_info.long_output = True; 422 else if argument = "-brief" | argument = "-bf" 423 then target_info.long_output = False; 424 else 425 do; 426 code = error_table_$badopt; 427 call com_err_ (code, ME); 428 goto FATAL_ERROR; 429 end; 430 end; /* Iarg = 1 to Nargs */ 431 432 if Fdisplay 433 then 434 do; /* No pnotices are being added */ 435 call init_variables; 436 goto GET_TEMPLATES; 437 end; 438 439 if used_old_argument & Ftrade_secret & Fname 440 then 441 do; 442 code = error_table_$inconsistent; 443 call com_err_ (code, ME, Inconsistent_args, "-trade_secret", "-name"); 444 goto FATAL_ERROR; 445 end; 446 if DFtrade_secret & Fname 447 then 448 do; 449 code = error_table_$inconsistent; 450 call com_err_ (code, ME, Inconsistent_args, "-default_trade_secret", 451 "-name"); 452 goto FATAL_ERROR; 453 end; 454 if used_old_argument & Fpublic_domain & Fname 455 then 456 do; 457 code = error_table_$inconsistent; 458 call com_err_ (code, ME, Inconsistent_args, "-public_domain", "-name"); 459 goto FATAL_ERROR; 460 end; 461 if Fpublic_domain & (Ftrade_secret | DFtrade_secret) 462 then 463 do; 464 code = error_table_$inconsistent; 465 call com_err_ (code, ME, 466 "The ""-public_domain"" control arg must be used alone."); 467 goto FATAL_ERROR; 468 end; 469 if DFcopy_right & Fname 470 then 471 do; 472 code = error_table_$inconsistent; 473 call com_err_ (code, ME, Inconsistent_args, "-default_copyright", 474 "-name"); 475 goto FATAL_ERROR; 476 end; 477 GET_TEMPLATES: 478 if path = "" 479 then 480 do; 481 call com_err_ (error_table_$noarg, ME, " 482 No pathname specified."); 483 goto FATAL_ERROR; 484 end; 485 486 /* do some data gathering and checking first */ 487 488 489 call pnotice_paths_ (ME, "00"b, Ppaths, code); 490 /* fill in template info */ 491 if code ^= 0 492 then /* pnotice_paths_ will complain for us. */ 493 goto FATAL_ERROR; /* things won't work this way */ 494 495 496 if Fdisplay 497 then /* no pnotices to add */ 498 goto EXPAND_PATH; 499 500 /* find out what notice we should add */ 501 if (Ftrade_secret & ^Fname) | DFtrade_secret 502 then 503 do; 504 do Itemplate = 1 to pnotice_paths.Ntemplates 505 while (^pnotice_paths.templates (Itemplate).defaultTS); 506 end; 507 if Itemplate > pnotice_paths.Ntemplates 508 then 509 do; 510 code = error_table_$name_not_found; 511 call com_err_ (code, ME, Not_found, "default_trade_secret"); 512 goto FATAL_ERROR; 513 end; 514 else source_info.notice_to_add.name = 515 before (pnotice_paths.templates (Itemplate).primary_name, 516 ".pnotice"); 517 source_info.notice_to_add.type = TRADE_SECRET; 518 end; 519 else if Fpublic_domain 520 then 521 do; /* if public domain is desired */ 522 do Itemplate = 1 to pnotice_paths.Ntemplates 523 while (pnotice_paths.templates (Itemplate).type ^= PUBLIC_DOMAIN); 524 end; /* verify that the name is there. */ 525 if Itemplate > pnotice_paths.Ntemplates 526 then 527 do; 528 code = error_table_$name_not_found; 529 call com_err_ (code, ME, Not_found, "public_domain"); 530 goto FATAL_ERROR; 531 end; 532 else source_info.notice_to_add.name = 533 before (pnotice_paths.templates (Itemplate).primary_name, 534 ".pnotice"); 535 source_info.notice_to_add.type = PUBLIC_DOMAIN; 536 end; 537 else if (Fname & Ftrade_secret & ^used_old_argument) 538 | (Fname & ^DFtrade_secret) | (Fname & ^Fpublic_domain) 539 then 540 do; /* if a template name was given, */ 541 do Itemplate = 1 to pnotice_paths.Ntemplates 542 while (source_info.notice_to_add.name 543 ^= 544 before (pnotice_paths.templates (Itemplate).primary_name, 545 ".pnotice")); 546 end; /* verify that the name is there. */ 547 if Itemplate > pnotice_paths.Ntemplates 548 then 549 do; 550 code = error_table_$name_not_found; 551 call com_err_ (code, ME, Not_found, source_info.notice_to_add.name) 552 ; 553 goto FATAL_ERROR; 554 end; 555 if Ftrade_secret 556 then source_info.notice_to_add.type = TRADE_SECRET; 557 else source_info.notice_to_add.type = COPYRIGHT; 558 end; 559 else 560 do; /* use default copyright */ 561 do Itemplate = 1 to pnotice_paths.Ntemplates 562 while (^pnotice_paths.templates (Itemplate).defaultC); 563 end; 564 if Itemplate > pnotice_paths.Ntemplates 565 then 566 do; 567 code = error_table_$name_not_found; 568 call com_err_ (code, ME, Not_found, "default_copyright"); 569 goto FATAL_ERROR; 570 end; 571 else 572 do; /* input name if none of above criteria met */ 573 source_info.notice_to_add.name = 574 before (pnotice_paths.templates (Itemplate).primary_name, 575 ".pnotice"); 576 source_info.notice_to_add.type = COPYRIGHT; 577 if ^DFcopy_right then Sno_args_given = True; 578 Sdfcopyright = True; 579 end; 580 end; /* default copyright */ 581 EXPAND_PATH: /* now work on the path we were given */ 582 call expand_pathname_$component (path, source_info.dir, source_info.entry, 583 component, code); /* xlate the input path into dir, entry and */ 584 /* component */ 585 /* comp is null unless archive component given */ 586 587 588 if code ^= 0 589 then 590 do; 591 call com_err_ (code, ME, path); 592 goto FATAL_ERROR; 593 end; 594 target_info.dir = source_info.dir; /* fill in target info directory name */ 595 if index (source_info.entry, ".") = 0 596 then 597 do; 598 code = error_table_$bad_file_name; 599 if source_info.archive_name ^= "" 600 then call com_err_ (code, ME, 601 "^/Entry must include language suffix. ^a", 602 pathname_$component (source_info.dir, 603 source_info.archive_name, source_info.entry)); 604 else call com_err_ (code, ME, 605 "^/Entry must include language suffix. ^a", 606 pathname_ (source_info.dir, source_info.entry)); 607 goto FATAL_ERROR; 608 end; 609 call check_star_name_$entry (source_info.entry, code); 610 if code ^= 0 611 then 612 do; 613 code = error_table_$nostars; 614 call com_err_ (code, ME, "^/Processing ^a.", 615 pathname_ (source_info.dir, source_info.entry)); 616 goto FATAL_ERROR; 617 end; 618 if component ^= "" 619 then 620 do; 621 call check_star_name_$entry (component, code); 622 if code ^= 0 623 then 624 do; 625 code = error_table_$nostars; 626 call com_err_ (code, ME, "^/Processing ^a.", 627 pathname_$component (source_info.dir, source_info.entry, 628 component)); 629 goto FATAL_ERROR; 630 end; 631 Farchive = True; /* it is an archive */ 632 end; 633 else if component = "" 634 then if reverse (before (reverse (source_info.entry), ".")) = "archive" 635 then Farchive = True; /* we have been given an archive to deal with */ 636 call hcs_$initiate_count (source_info.dir, source_info.entry, "", 637 bit_count, 0, source_info.Pentry, code); 638 /* initiate segment */ 639 if source_info.Pentry = null 640 then 641 do; 642 call com_err_ (code, ME, "^/Initiating ^a.", 643 pathname_ (source_info.dir, source_info.entry)); 644 goto FATAL_ERROR; 645 end; 646 source_info.Lentry = divide (bit_count, 9, 21, 0); 647 /* compute its length */ 648 if Farchive 649 then 650 do; 651 process_dir = get_pdir_ (); /* we need this with archives */ 652 pdir = rtrim (process_dir); 653 source_info.archive_name = source_info.entry; 654 common_archive_name = source_info.archive_name; 655 /* used by display_pnotice */ 656 source_info.entry = component; 657 source_info.Parchive = source_info.Pentry; 658 source_info.Larchive = source_info.Lentry; 659 target_info.archive_name = source_info.archive_name; 660 target_info.Parchive = source_info.Pentry; 661 target_info.Larchive = source_info.Lentry; 662 if Fdisplay 663 then call ioa_ ("^a^[>^]^a:", source_info.dir, source_info.dir ^= ">", 664 source_info.archive_name); 665 call process_archive_components (source_info, target_info); 666 end; 667 else 668 do; 669 source_info.archive_name = ""; 670 source_info.Parchive = null; 671 source_info.Larchive = 0; 672 target_info.archive_name = ""; 673 target_info.Parchive = null; 674 target_info.Larchive = 0; 675 target_info.entry = source_info.entry; 676 target_info.Pentry = source_info.Pentry; 677 target_info.Lentry = source_info.Lentry; 678 call process_single_seg (source_info, target_info); 679 end; 680 NORMAL_EXIT: 681 FATAL_ERROR: 682 call clean_up; 683 return; 684 685 686 687 688 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 689 690 init_structures: 691 proc (SI, TI); 692 693 dcl 1 SI aligned like source_info, 694 1 TI aligned like target_info; 695 696 SI.version = V_source_info_1; 697 TI.version = V_target_info_1; 698 SI.archive_name = ""; 699 700 init_structures$next_component: 701 entry (SI, TI); /* this entry is used when an archive is processed*/ 702 /* to avoid resetting the archive_name */ 703 SI.Pentry = null; 704 SI.ec_version = 0; 705 SI.text_pos = 0; 706 SI.cmt_bgn = ""; 707 SI.cmt_end = ""; 708 SI.Pold_box = null; 709 SI.Lold_box = 0; 710 SI.Nnotices = 0; 711 SI.notice_info (*).notice_name = ""; 712 SI.notice_info (*).notice_date = ""; 713 SI.notice_info (*).notice_type = 0; /* UNDEFINED */ 714 TI.Pnew_box = null; 715 TI.Lnew_box = 0; 716 TI.Pstar_box = null; 717 TI.Lstar_box = 0; 718 TI.Nnotices = 0; 719 seqno = 0; 720 TI.notice (*) = ""; 721 722 end init_structures; 723 724 725 init_variables: 726 proc; 727 Fname = False; /* init vars used in arg processing */ 728 Fcopy_right = False; 729 DFcopy_right = False; 730 DFtrade_secret = False; 731 Sadd_default_pnotice = False; 732 Sdfcopyright = False; 733 Sno_args_given = False; 734 Fpublic_domain = False; 735 Ftrade_secret = False; 736 used_old_argument = False; 737 source_info.notice_to_add.name = ""; 738 source_info.notice_to_add.type = 0; 739 740 end init_variables; 741 742 743 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 744 745 dcl 1 comp_info based (Pcomp_info), 746 /* structure of info on archive */ 747 /* components needing to be updated */ 748 2 Ncomp fixed bin, 749 2 array (0 refer (comp_info.Ncomp)), 750 3 name char (32), 751 3 ptr ptr, 752 3 length fixed bin (21); 753 754 dcl Lcomp fixed bin (21), /* lgth of an archive component */ 755 Pal ptr, /* ptr to argument list when processing archives */ 756 Parchive_paths ptr, /* ptr to archive component paths */ 757 Pcomp_info ptr, 758 Pcomp ptr, /* ptr to an archive component */ 759 Pdesc ptr, /* ptr to descriptors when processing an archive */ 760 comp_bc fixed bin (24), /* archive component's bit_count */ 761 comp_name char (32), /* archive component name */ 762 paths (comp_info.Ncomp + 2) based (Parchive_paths) char (168); 763 764 process_archive_components: 765 proc (SI, TI); 766 767 768 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 769 /* */ 770 /* An internal procedure to provide capability for inserting notices into each component */ 771 /* of an archive, or only a single component. The star name convention is not supported, */ 772 /* and is checked long before this procedure is called. */ 773 /* */ 774 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 775 776 777 dcl 1 SI aligned like source_info, 778 /* IN */ 779 1 TI aligned like target_info; 780 /* IN */ 781 dcl Acode fixed bin (35); 782 dcl COMPONENT char (Lcomp) based (Pcomp); 783 784 if ^Fdisplay 785 then 786 do; /* if this is display_pnotice, skip this stuff */ 787 Fmust_reset = False; 788 Fmode_set = False; 789 on cleanup 790 begin; 791 if Fmust_reset 792 then call check_acl$reset_acl (TI.Pentry, TI.dir, TI.entry, 793 Fmode_set); /* protect against inadvertent ACL changes */ 794 end; 795 call get_temp_segment_ (ME, Pcomp_info, Acode); 796 if Acode ^= 0 797 then 798 do; 799 call com_err_ (Acode, ME, " 800 Obtaining temp seg for archive info."); 801 goto FATAL_ERROR; 802 end; 803 comp_info.Ncomp = 0; 804 end; 805 if SI.entry = "" 806 then /* path like foo.archive given */ 807 goto ALL_COMPONENTS; 808 else goto SINGLE_COMPONENT; /* path like foo::prog.pl1 given */ 809 810 811 ALL_COMPONENTS: 812 doing_all_components = True; /* in case the archive contains a surprise */ 813 Pcomp = null; /* in case all components are processed */ 814 NEXT_COMPONENT: 815 call archive_$next_component (SI.Parchive, bit_count, Pcomp, comp_bc, 816 comp_name, Acode); 817 if Acode ^= 0 818 then 819 do; 820 call com_err_ (Acode, ME, 821 "^/Last component processed: ^a^/Error obtaining next component info.", 822 pathname_$component (SI.dir, SI.archive_name, SI.entry)); 823 goto FATAL_ERROR; 824 end; 825 else if Pcomp = null 826 then /* we are finished */ 827 goto END_OF_COMPONENTS; 828 SI.entry = comp_name; 829 SI.Pentry = Pcomp; 830 TI.entry = comp_name; 831 TI.Pentry = Pcomp; 832 if ^get_language_info (SI) 833 then /* if it is a single component name, skip and */ 834 goto NEXT_COMPONENT; /* go on to the next one. */ 835 Lcomp = divide (comp_bc, 9, 21, 0); 836 SI.Lentry = Lcomp; 837 TI.Lentry = Lcomp; 838 call pnotice_parse (SI); /* parse the component inside the archive. */ 839 if Fdisplay 840 then 841 do; /* if display_pnotice then just report info */ 842 call report (SI, TI); 843 end; 844 else 845 do; 846 if ^continue_processing (SI, TI) 847 then ; /* should we continue? */ 848 else 849 do; /* this component must be processed */ 850 comp_info.Ncomp = comp_info.Ncomp + 1; 851 comp_info.array (Ncomp).length = Lcomp; 852 comp_info.array (Ncomp).name = SI.entry; 853 call hcs_$make_seg (process_dir, comp_info.array (Ncomp).name, "", 854 01010b, comp_info.array (Ncomp).ptr, Acode); 855 /* make a copy in the pdir */ 856 if Acode ^= 0 857 then 858 do; 859 call com_err_ (Acode, ME, " 860 Creating ^a>^a.", pdir, comp_info.array (Ncomp).name); 861 goto FATAL_ERROR; 862 end; 863 comp_info.array (Ncomp).ptr -> COMPONENT = COMPONENT; 864 /* copy the seg contents */ 865 call make_star_box (SI, TI); 866 TI.Pentry = comp_info.array (Ncomp).ptr; 867 /* target is now in the pdir */ 868 TI.Pnew_box = 869 add_char_offset_ (TI.Pentry, 870 char_offset_ (SI.Pold_box) - char_offset_ (SI.Pentry)); 871 /* since the target seg is actually in the pdir, */ 872 /* Pnew_box must point there, and be adjusted */ 873 /* based on where the old box is found by parsing */ 874 /* the seg in the archive. That's what this does. */ 875 TI.Lnew_box = TI.Lstar_box; 876 call insert_notice (SI, TI); 877 if TI.long_output 878 then if SI.archive_name ^= "" 879 then call ioa_ ( 880 "^/The following notice was added to:^a^a^/^a", 881 " ", 882 pathname_$component (SI.dir, SI.archive_name, 883 SI.entry), save_name); 884 else call ioa_ ( 885 "^/The following notice was added to ^a^a^/^a", 886 " ", pathname_ (SI.dir, SI.entry), save_name); 887 end; 888 end; 889 call init_structures$next_component (SI, TI); 890 /* re-set values in the info structures */ 891 goto NEXT_COMPONENT; /* no notices found */ 892 893 894 SINGLE_COMPONENT: 895 call archive_$get_component (SI.Parchive, bit_count, component, Pcomp, 896 comp_bc, Acode); 897 if Acode ^= 0 898 then 899 do; 900 call com_err_ (Acode, ME, "^/Processing ^a.", 901 pathname_$component (SI.dir, SI.archive_name, component)); 902 goto FATAL_ERROR; 903 end; 904 SI.Pentry = Pcomp; 905 TI.entry = component; 906 TI.Pentry = Pcomp; 907 if ^get_language_info (SI) 908 then 909 do; /* if user tried this on a single component name, */ 910 call com_err_ (error_table_$bad_file_name, ME, " 911 Single-component names not permitted. ^a", SI.entry); 912 goto FATAL_ERROR; 913 end; 914 Lcomp = divide (comp_bc, 9, 21, 0); /* get component length */ 915 SI.Lentry = Lcomp; 916 TI.Lentry = Lcomp; 917 call pnotice_parse (SI); 918 if Fdisplay 919 then 920 do; 921 call report (SI, TI); 922 end; 923 else 924 do; 925 if ^continue_processing (SI, TI) 926 then ; /* should we continue? */ 927 else 928 do; /* this component must be processed */ 929 comp_info.Ncomp = comp_info.Ncomp + 1; 930 comp_info.array (Ncomp).length = Lcomp; 931 comp_info.array (Ncomp).name = SI.entry; 932 call hcs_$make_seg (process_dir, comp_info.array (Ncomp).name, "", 933 01010b, comp_info.array (Ncomp).ptr, Acode); 934 /* make a copy in the pdir */ 935 if Acode ^= 0 936 then 937 do; 938 call com_err_ (Acode, ME, " 939 Creating ^a>^a.", pdir, comp_info.array (Ncomp).name); 940 goto FATAL_ERROR; 941 end; 942 comp_info.array (Ncomp).ptr -> COMPONENT = COMPONENT; 943 /* copy the seg contents */ 944 call make_star_box (SI, TI); 945 TI.Pentry = comp_info.array (Ncomp).ptr; 946 /* target is now in the pdir */ 947 TI.Pnew_box = 948 add_char_offset_ (TI.Pentry, 949 char_offset_ (SI.Pold_box) - char_offset_ (SI.Pentry)); 950 TI.Lnew_box = TI.Lstar_box; 951 call insert_notice (SI, TI); 952 if TI.long_output 953 then if SI.archive_name ^= "" 954 then call ioa_ ("The following notice was added to:^a^a^/^a", 955 " ", 956 pathname_$component (SI.dir, SI.archive_name, 957 SI.entry), save_name); 958 else call ioa_ ("The following notice was added to:^a^a^/^a", 959 " ", pathname_ (SI.dir, SI.entry), save_name); 960 end; 961 end; 962 END_OF_COMPONENTS: 963 if Fdisplay 964 then /* if display_pnotice, */ 965 return; /* also exit here */ 966 if comp_info.Ncomp = 0 967 then /* if no components needed anything */ 968 return; /* quietly exit */ 969 970 971 INIT_ARG_LIST: 972 Pal = addrel (Pcomp_info, currentsize (comp_info)); 973 al.header.arg_count = comp_info.Ncomp + 2; 974 al.header.pad1 = "0"b; 975 al.header.call_type = Interseg_call_type; 976 al.header.desc_count = comp_info.Ncomp + 2; 977 al.header.pad2 = "0"b; 978 979 INIT_DESCRIPTOR_VALUES: 980 Pdesc = addrel (Pal, currentsize (al)); 981 desc (*).version2_ = "1"b; 982 desc (*).type_ = char_desc; 983 desc (*).pack_ = "1"b; 984 desc (*).dimension_ = "0"b; 985 desc (*).scale_ = 0; 986 desc (*).precision_ = 0; 987 988 INIT_ARGUMENT_PATHS: 989 Parchive_paths = addrel (Pdesc, currentsize (desc)); 990 paths (1) = "u"; /* we will "update" the archive */ 991 paths (2) = rtrim (TI.dir) || ">" || TI.archive_name; 992 /* the absolute path of the archive */ 993 do Idx1 = 3 to comp_info.Ncomp + 2; 994 paths (Idx1) = pdir || ">" || comp_info.array (Idx1 - 2).name; 995 end; 996 997 FINISH_ARGS_AND_DESCS: 998 do Idx1 = 1 to comp_info.Ncomp + 2; 999 desc (Idx1).precision_ = length (rtrim (paths (Idx1))); 1000 al.ap (Idx1) = addr (paths (Idx1)); 1001 al.dp (Idx1) = addr (desc (Idx1)); 1002 end; 1003 1004 call check_acl (TI.Parchive, TI.dir, TI.archive_name, Fmust_reset); 1005 /* see if proper access */ 1006 call cu_$generate_call (archive, Pal); 1007 /* pass the argument list along to the */ 1008 /* archive command */ 1009 if Fmust_reset 1010 then call check_acl$reset_acl (TI.Parchive, TI.dir, TI.archive_name, 1011 Fmode_set); /* if needed, restore access */ 1012 1013 1014 end process_archive_components; 1015 1016 1017 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1018 1019 1020 process_single_seg: 1021 proc (SI, TI); 1022 dcl 1 SI aligned like source_info, 1023 1 TI aligned like target_info; 1024 1025 Fmust_reset = False; 1026 Fmode_set = False; 1027 on cleanup 1028 begin; 1029 if Fmust_reset 1030 then call check_acl$reset_acl (TI.Pentry, TI.dir, TI.entry, Fmode_set); 1031 /* protect against inadvertent ACL changes */ 1032 end; 1033 if ^get_language_info (SI) 1034 then 1035 do; /* if user tried to pass off a single comp name, */ 1036 call com_err_ (error_table_$bad_file_name, ME, " 1037 Single-component names not permitted. ^a", SI.entry); 1038 goto FATAL_ERROR; 1039 end; 1040 call pnotice_parse (SI); /* parse the segment */ 1041 if Fdisplay 1042 then 1043 do; /* if display_pnotice */ 1044 call report (SI, TI); /* just print info */ 1045 end; 1046 else 1047 do; 1048 if ^continue_processing (SI, TI) then goto FATAL_ERROR; 1049 call make_star_box (SI, TI); /* form the new box with text */ 1050 call check_acl (TI.Pentry, TI.dir, TI.entry, Fmust_reset); 1051 /* if Fmust_reset is set, we forced access */ 1052 TI.Pnew_box = SI.Pold_box; /* the new box begins at the same place as the old*/ 1053 TI.Lnew_box = TI.Lstar_box; /* lgth of new box is lgth of one in temp seg */ 1054 call insert_notice (SI, TI); /* put it into the seg */ 1055 if Fmust_reset 1056 then call check_acl$reset_acl (TI.Pentry, TI.dir, TI.entry, Fmode_set); 1057 /* put the old access back */ 1058 if TI.long_output 1059 then 1060 do; 1061 if ^Sdfcopyright 1062 then call ioa_ ("The following notice was added to:^a^a^/^a", " ", 1063 pathname_ (source_info.dir, source_info.entry), 1064 save_name); 1065 else if Sdfcopyright & Sprt_notice 1066 then call ioa_ ("The following notice was added to:^a^a^/^a", " ", 1067 pathname_ (source_info.dir, source_info.entry), 1068 save_name); 1069 end; 1070 1071 end; 1072 end process_single_seg; 1073 1074 1075 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1076 1077 1078 get_language_info: 1079 proc (SI) returns (bit (1)); 1080 1081 1082 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1083 /* */ 1084 /* This procedure determines the parameters of the language of the source segment. These */ 1085 /* parameters are: type, name, and comment begin and end delimiters. */ 1086 /* If the source is an exec_com or absin, there are two added parameters needed: the */ 1087 /* version (ec_version) and the character position of the first non-version character */ 1088 /* (text_pos). These values are obtained from calling get_ec_version_. */ 1089 /* */ 1090 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1091 1092 1093 dcl 1 SI aligned like source_info; 1094 /* IN/OUT */ 1095 dcl Acode fixed bin (35), 1096 Ilang fixed bin, 1097 language char (8) var; /* language name */ 1 1 /* START OF pnotice_language_info_.incl.pl1 */ 1 2 1 3 1 4 /****^ HISTORY COMMENTS: 1 5* 1) change(81-06-14,Stansbury), approve(), audit(), install(): 1 6* Created May 14, 1981 by JM Stansbury 1 7* 2) change(81-07-30,Stansbury), approve(), audit(), install(): 1 8* Modified - added type 3. 1 9* 3) change(85-08-28,LJAdams), approve(85-10-29,MCR7150), 1 10* audit(86-02-07,Wallman), install(86-02-13,MR12.0-1017): 1 11* Modified - added type 4. 1 12* 4) change(85-10-29,LJAdams), approve(85-10-29,MCR7150), 1 13* audit(86-02-07,Wallman), install(86-02-13,MR12.0-1017): 1 14* Added Type 5 to define runoff and compose files. 1 15* END HISTORY COMMENTS */ 1 16 1 17 1 18 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1 19 /* */ 1 20 /* Structure defining the individual languages known to and processed by the add_pnotice */ 1 21 /* command. A language may be a true programming language, like PL/1, or some */ 1 22 /* other suffixed subsystem, like absin. The following information is kept for each */ 1 23 /* language: */ 1 24 /* 1: name the suffix identifying the language, */ 1 25 /* 2: type one of the currently defined types. See notes. */ 1 26 /* 3: cmt_bgn the delimiter used to begin a comment, */ 1 27 /* 4: cmt_end the delimiter used to end a comment. */ 1 28 /* */ 1 29 /* Notes: There are currently 5 defined types. */ 1 30 /* Type 1: has a comment end delimiter other than a newline character. 1 31* */ 1 32 /* Type 2: has the newline character as the comment end delimiter. */ 1 33 /* Type 3: this type was invented due to the creation of version 1 and version 2 */ 1 34 /* exec_com. These require some extra work to determine comment creation and placement. */ 1 35 /* Type 4: has a /****^ as a comment begin delimiter - pl1. */ 1 36 /* Type 5: this type is used to define compin and runoff files. */ 1 37 /* */ 1 38 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1 39 1 40 1 41 dcl pnotice_language_info_$languages fixed bin ext static; 1 42 1 43 dcl 1 pnotice_language_info aligned based (addr (pnotice_language_info_$languages)), 1 44 2 languages, 1 45 3 N fixed bin, 1 46 3 lang_array (0 refer (pnotice_language_info.N)), 1 47 4 lang_type fixed bin, 1 48 4 lang_name char (8) var, /* i.e., pl1, cobol, fortran... */ 1 49 4 comment_start char (8) var, 1 50 4 comment_end char (8) var; 1 51 1 52 /* END OF pnotice_language_info_.incl.pl1 */ 1098 1099 1100 1101 SI.ec_version = 0; 1102 SI.text_pos = 0; 1103 if index (SI.entry, ".") = 0 1104 then /* primarily for the archive case, if it is a */ 1105 return (False); /* single component name. */ 1106 language = reverse (before (reverse (SI.entry), ".")); 1107 /* determine language name */ 1108 do Ilang = 1 1109 to hbound (pnotice_language_info.languages.lang_array, 1) 1110 while (language 1111 ^= pnotice_language_info.languages.lang_array (Ilang).lang_name); 1112 end; /* look it up in pnotice_language_info_ */ 1113 if Ilang > pnotice_language_info.languages.N 1114 then 1115 do; 1116 Acode = error_table_$typename_not_found; 1117 if doing_all_components 1118 then 1119 do; /* processing an entire archive, don't stop here */ 1120 if SI.archive_name ^= "" 1121 then call com_err_ (Acode, ME, 1122 "^/The ^a suffix is not supported because it is not defined in pnotice_language_info_.^/Entry was skipped: ^a", 1123 language, 1124 pathname_$component (SI.dir, SI.archive_name, SI.entry)); 1125 else call com_err_ (Acode, ME, 1126 "^/The ^a suffix is not supported because it is not defined in pnotice_language_info_.^/Entry was skipped: ^a", 1127 language, pathname_ (SI.dir, SI.entry)); 1128 return (False); 1129 end; 1130 else 1131 do; 1132 if reverse (before (reverse (SI.entry), ".")) = "archive" 1133 then call com_err_ (Acode, ME, 1134 "^/Archived archives are not supported."); 1135 else if SI.archive_name ^= "" 1136 then call com_err_ (Acode, ME, 1137 "^/The ^a suffix is not supported because it is not defined in pnotice_language_info_.^/Entry not processed: ^a", 1138 language, 1139 pathname_$component (SI.dir, SI.archive_name, SI.entry)); 1140 else call com_err_ (Acode, ME, 1141 "^/The ^a suffix is not supported because it is not defined in pnotice_language_info_.^/Entry not processed: ^a", 1142 language, pathname_ (SI.dir, SI.entry)); 1143 goto FATAL_ERROR; 1144 end; 1145 end; 1146 1147 SI.type = pnotice_language_info.languages.lang_array (Ilang).lang_type; 1148 /* type better be 1, 2, 3, 4, or 5 */ 1149 if SI.type < 1 | SI.type > 5 1150 then 1151 do; 1152 Acode = error_table_$typename_not_found; 1153 call com_err_ (Acode, ME, 1154 " 1155 Language type (^d) found for the ^a suffix in pnotice_language_info_ is not implemented.", 1156 SI.type, language); 1157 goto FATAL_ERROR; 1158 end; /* get comment delimiters */ 1159 SI.cmt_bgn = 1160 pnotice_language_info.languages.lang_array (Ilang).comment_start; 1161 SI.cmt_end = 1162 pnotice_language_info.languages.lang_array (Ilang).comment_end; 1163 1164 if SI.type = 3 1165 then 1166 do; 1167 if SI.archive_name ^= "" 1168 then 1169 do; /* can't support archived exec_coms */ 1170 call com_err_ (error_table_$archive_component_modification, ME, 1171 "^/^a^/Processing of archived exec_coms is not supported.", 1172 pathname_ (SI.dir, SI.archive_name)); 1173 goto FATAL_ERROR; 1174 end; 1175 call get_ec_version_ (SI.dir, SI.entry, SI.ec_version, SI.text_pos, 1176 Acode); 1177 if Acode ^= 0 1178 then 1179 do; 1180 call com_err_ (Acode, ME, "^/Getting ec version."); 1181 goto FATAL_ERROR; 1182 end; 1183 if SI.text_pos < 1 1184 then /* prevent invalid subscripting */ 1185 SI.text_pos = 1; 1186 if SI.ec_version = 1 1187 then SI.cmt_bgn = SI.cmt_bgn || SP; 1188 else SI.cmt_bgn = SI.cmt_bgn || "-"; 1189 end; 1190 1191 return (True); 1192 1193 end get_language_info; 1194 1195 1196 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1197 1198 1199 pnotice_parse: 1200 proc (SI); 1201 1202 1203 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1204 /* */ 1205 /* This procedure determines the extents of what appears to be a valid protection notice */ 1206 /* comment. This determination is somewhat different for the three types of defined */ 1207 /* languages. Once this is done, these extents are then used by the process_tokens and */ 1208 /* parse_source_ procedures to actually see if a match can be found within these extents. */ 1209 /* */ 1210 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1211 1212 1213 dcl 1 SI aligned like source_info; 1214 /* IN */ 1215 1216 1217 dcl rest char (Lrest) based (Prest), 1218 Prest ptr, 1219 Lrest fixed bin (21), 1220 Icmt fixed bin (21), 1221 rest_ch (Lrest) char (1) based (Prest), 1222 cmt_bgn_length fixed bin (21), 1223 save_length fixed bin (21), 1224 save_ptr ptr, 1225 save_Prest ptr, 1226 Spnotice bit (1), 1227 Sstar_line bit (1); 1228 1229 dcl Pcomment ptr, 1230 Lcomment fixed bin (21), 1231 comment char (Lcomment) based (Pcomment), 1232 comment_chr (Lcomment) char (1) based (Pcomment), 1233 Pcomment_line ptr, 1234 Lcomment_line fixed bin (21), 1235 comment_line char (Lcomment_line) based (Pcomment_line); 1236 1237 dcl Ppnotice ptr, 1238 Lpnotice fixed bin (21), 1239 pnotice char (Lpnotice) based (Ppnotice), 1240 pnotice_chr (Lpnotice) char (1) based (Ppnotice), 1241 Ppnotice_line ptr, 1242 Lpnotice_line fixed bin (21), 1243 pnotice_line char (Lpnotice_line) based (Ppnotice_line); 1244 1245 dcl 1 pnotices based (Ppnotices), 1246 2 Nwords fixed bin (24), 1247 2 pword (0 refer (Nwords)) char (80) var, 1248 Ppnotices ptr; 1249 1250 1251 dcl 1 template based (Ptemplate), 1252 2 Twords fixed bin (24), 1253 2 tword (0 refer (Twords)) char (80) var, 1254 Ptemplate ptr; 1255 1256 dcl Ntemplates_parsed 1257 fixed bin; 1258 1259 dcl Ibreak fixed bin (21), 1260 Inonwhite fixed bin (21), 1261 Iskip fixed bin (21), 1262 Lword_text fixed bin (21), 1263 Pword_text ptr; 1264 1265 dcl word_text char (Lword_text) based (Pword_text), 1266 word_text_arr (Lword_text) char (1) based (Pword_text); 1267 1268 1269 dcl WORD_BREAKS char (30) var, 1270 SKIP_CHRS char (30) var; 1271 1272 dcl Acode fixed bin (35); 1273 1274 1275 SI.Pold_box = SI.Pentry; 1276 SI.Lold_box = 0; 1277 Prest = SI.Pentry; 1278 Lrest = SI.Lentry; 1279 Sold_style_pnotice = False; 1280 source_year (*) = 0; 1281 source_year_a (*) = " "; 1282 cmt_bgn_length = length (SI.cmt_bgn); 1283 goto TYPE (SI.type); 1284 1285 TYPE (1): 1286 TYPE (4): 1287 Icmt = verify (rest, HT_SP_NL_VT_NP); 1288 /* disregard white space at front. */ 1289 if Icmt = 0 1290 then /* an empty seg */ 1291 goto end_parse1; 1292 else 1293 do; 1294 Prest = addr (rest_ch (Icmt)); 1295 Lrest = Lrest - (Icmt - 1); 1296 end; 1297 1298 if length (SI.cmt_bgn) > length (rest) then goto end_parse1; 1299 /* no room left for comments */ 1300 1301 if SI.type = 4 & substr (rest, 1, length (SI.cmt_bgn)) ^= SI.cmt_bgn 1302 & substr (rest, 1, 2) = "/*" 1303 then Sold_style_pnotice = True; 1304 if ^Sold_style_pnotice 1305 & substr (rest, 1, length (SI.cmt_bgn)) ^= SI.cmt_bgn 1306 then goto end_parse1; 1307 1308 save_length = 0; 1309 save_ptr = Prest; 1310 Icmt = 0; 1311 1312 do while (pnotice_found ()); /* check for multiple pnotices */ 1313 if (index (comment, "PROPRIETARY") > 0 1314 | index (comment, "PUBLIC DOMAIN") > 0 1315 | index (comment, "Copyright") > 0) 1316 then save_length = save_length + Lcomment; 1317 end; 1318 1319 if save_length = 0 1320 then /* not a pnotice */ 1321 goto end_parse1; 1322 1323 Pcomment = save_ptr; 1324 Lcomment = save_length; 1325 1326 if ^valid_format () 1327 then 1328 do; 1329 call com_err_ (error_table_$improper_data_format, ME, 1330 "^/^a^/^3xPnotice begin delimiters may not be on a line by themselves.", 1331 pathname_ (SI.dir, SI.entry)); 1332 goto FATAL_ERROR; 1333 end; 1334 SI.Lold_box = Lcomment; 1335 call process_tokens; 1336 1337 end_parse1: 1338 goto PARSE_CLEANUP; 1339 1340 1341 TYPE (3): /* adjust things for ec's and absin */ 1342 Prest = addr (rest_ch (SI.text_pos)); 1343 /* adjust to avoid any "&version" lines */ 1344 Lrest = Lrest - (SI.text_pos - 1); 1345 SI.Pold_box = Prest; /* after this, type 3 is just like type 2 */ 1346 TYPE (2): 1347 TYPE (5): /* runoff and compint files */ 1348 Icmt = verify (rest, HT_SP_NL_VT_NP); 1349 /* remove white space */ 1350 if Icmt = 0 1351 then /* empty seg */ 1352 goto end_parse2; 1353 1354 if (Icmt - 1) + length (SI.cmt_bgn) > length (rest) 1355 then /* no room left for any comments */ 1356 goto end_parse2; 1357 1358 Prest = addr (rest_ch (Icmt)); 1359 Lrest = Lrest - (Icmt - 1); 1360 1361 if substr (rest, 1, length (SI.cmt_bgn)) ^= SI.cmt_bgn 1362 then /* if first non-white ^= comment, */ 1363 goto end_parse2; 1364 1365 Spnotice = True; 1366 save_ptr = Prest; 1367 1368 do while (Spnotice); 1369 Pcomment, save_Prest = Prest; 1370 Lcomment = Lrest; 1371 save_length = 0; 1372 Sstar_line = False; 1373 1374 if substr (comment, 1, length (SI.cmt_bgn)) ^= SI.cmt_bgn 1375 then Spnotice = False; 1376 else 1377 do; 1378 if (substr (comment, length (SI.cmt_bgn) + length (" "), 1379 length ("**********")) = "**********" 1380 | substr (comment, 1, length (SI.cmt_bgn)) = SI.cmt_bgn) & 1381 /* pnotices begin with a star line */ 1382 (index (comment, "PROPRIETARY") > 0 1383 | index (comment, "PUBLIC DOMAIN") > 0 1384 | index (comment, "Copyright") > 0) 1385 then 1386 do; 1387 do while (Lcomment > 0); /* check for multiple pnotices */ 1388 Pcomment_line = Pcomment; 1389 Lcomment_line = index (comment, NL); 1390 if Lcomment_line = 0 then Lcomment_line = Lcomment; 1391 Pcomment = addcharno (addr (comment_chr (Lcomment_line)), 1); 1392 Lcomment = Lcomment - Lcomment_line; 1393 save_length = save_length + Lcomment_line; 1394 if Lcomment_line 1395 > length (SI.cmt_bgn) + length (" ") 1396 + length ("**********") 1397 then if substr (comment_line, 1398 length (SI.cmt_bgn) + length (" "), 1399 length ("**********")) = "**********" 1400 then 1401 do; 1402 if ^Sstar_line 1403 then Sstar_line = True; 1404 else 1405 do; 1406 Prest = 1407 addcharno (addr (rest_ch (save_length)), 1); 1408 Lrest = Lrest - save_length; 1409 Lcomment = 0; 1410 end; 1411 end; 1412 end; 1413 if Prest = save_Prest 1414 then /* nothing has changed so no pnotices found */ 1415 Spnotice = False; 1416 Icmt = verify (rest, HT_SP_NL_VT_NP); 1417 Prest = addr (rest_ch (Icmt)); 1418 Lrest = Lrest - (Icmt - 1); 1419 if (substr (rest, length (SI.cmt_bgn) + length (" "), 1420 length ("**********")) ^= "**********" 1421 & substr (rest, 1, length (SI.cmt_bgn)) ^= SI.cmt_bgn) 1422 | Lrest = 0 1423 then Spnotice = False; 1424 end; 1425 else /* no pnotices present */ 1426 Spnotice = False; 1427 end; 1428 end; 1429 1430 Pcomment = save_ptr; 1431 Lcomment = charno (Prest) - charno (Pcomment) - 1; 1432 if Lcomment <= 0 1433 then /* not a pnotice */ 1434 goto end_parse2; 1435 1436 SI.Lold_box = Lcomment; 1437 call process_tokens; 1438 1439 end_parse2: 1440 PARSE_CLEANUP: 1441 if Ptemplate ^= null then call release_temp_segment_ (ME, Ptemplate, code); 1442 1443 if Ppnotices ^= null then call release_temp_segment_ (ME, Ppnotices, code); 1444 1445 return; 1446 1447 1448 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 1449 pnotice_found: 1450 proc returns (bit (1)); 1451 1452 dcl Inl fixed bin (21); 1453 1454 Icmt = verify (rest, HT_SP_NL_VT_NP); 1455 if Icmt > 0 1456 then 1457 do; 1458 Prest = addr (rest_ch (Icmt)); 1459 Lrest = Lrest - (Icmt - 1); 1460 end; 1461 1462 Pcomment = Prest; 1463 1464 if Sold_style_pnotice & substr (rest, 1, 2) ^= "/*" then return (False); 1465 else if ^Sold_style_pnotice 1466 & substr (rest, 1, length (SI.cmt_bgn)) ^= SI.cmt_bgn 1467 then return (False); 1468 else 1469 do; /* see if line starts with cmt_bgn and has stars */ 1470 Inl = index (rest, NL); 1471 if Inl < length (cmt_bgn) + length (" ") + length ("**********") 1472 then return (False); 1473 if substr (rest, length (cmt_bgn) + length (" "), 1474 length ("**********")) ^= "**********" 1475 then return (False); 1476 end; 1477 1478 if (SI.cmt_bgn = SI.cmt_end) & ^Sold_style_pnotice 1479 then /* TECO */ 1480 Lcomment = 1481 index (substr (rest, length (SI.cmt_bgn) + 1), SI.cmt_end) 1482 + length (SI.cmt_end); 1483 else Lcomment = index (rest, SI.cmt_end) - 1 + length (SI.cmt_end); 1484 1485 Lcomment = Lcomment + Icmt; /* include any intervening ctl chars and white */ 1486 /* space if there are multiple pnotices */ 1487 1488 Prest = addcharno (addr (rest_ch (Lcomment)), 1); 1489 Lrest = Lrest - Lcomment; 1490 1491 return (True); 1492 1493 end pnotice_found; /* * * * * * * * * * * * * * * * * * * * * * * * * */ 1494 1495 valid_format: 1496 proc returns (bit (1)); 1497 1498 i = index (comment, NL); 1499 if i <= cmt_bgn_length + length (" ") + length ("**********") 1500 then return (False); 1501 if index ( 1502 substr (comment, cmt_bgn_length + length (" "), 1503 length ("**********")), "**********") = 0 1504 then return (False); 1505 1506 return (True); 1507 end valid_format; 1508 1509 1510 1511 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1512 1513 process_tokens: 1514 proc; 1515 1516 1517 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1518 /* */ 1519 /* This procedure is the driver for the parse_source_ and parse_templates_ primitives. */ 1520 /* */ 1521 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1522 1523 dcl Scontinue bit (1), 1524 Sfound bit (1), 1525 Snomatch bit (1); 1526 1527 1528 call parse_source_init; 1529 call parse_templates_$init; 1530 if SI.type = 1 | SI.type = 4 1531 then /* pl1 progs */ 1532 WORD_BREAKS = HT_SP_STAR; 1533 else WORD_BREAKS = SI.cmt_bgn || HT_SP_STAR; 1534 1535 do while (Lcomment > 0); 1536 if get_pnotice_block () 1537 then 1538 do; /* check for multile pnotice blocks */ 1539 do while (parse_pnotice_$block ()); 1540 Ntemplates_parsed = 0; 1541 Scontinue, Snomatch = True; 1542 do while (Scontinue); 1543 if parse_templates_$get_next () 1544 then 1545 do; 1546 call parse_templates_$line; 1547 if Nwords ^= Twords 1548 then ; 1549 else 1550 do; 1551 Sfound = True; 1552 do i = 1 to Nwords while (Sfound); 1553 if pnotices.pword (i) = template.tword (i) then ; 1554 else if template.tword (i) = "" 1555 & verify (pnotices.pword (i), "0123456789") = 0 1556 & length (pnotices.pword (i)) = length ("1986") 1557 then ; 1558 else if template.tword (i) = "." 1559 & length (pnotices.pword (i)) = length ("1986.") 1560 & 1561 verify ( 1562 substr (pnotices.pword (i), 1, length ("1986")), 1563 "0123456789") = 0 1564 & 1565 substr (pnotices.pword (i), length ("1986."), 1566 length (".")) = "." 1567 then ; 1568 else Sfound = False; 1569 end; 1570 if Sfound 1571 then if i - 1 = Nwords then Scontinue, Snomatch = False; 1572 end; 1573 end; 1574 else Scontinue = False; 1575 end; 1576 1577 if Snomatch 1578 then 1579 do; 1580 if SI.archive_name ^= "" 1581 then call com_err_ (error_table_$not_done, ME, 1582 "^/^a contains an unknown or illegal notice.", 1583 pathname_$component (SI.dir, SI.archive_name, 1584 SI.entry)); 1585 else call com_err_ (error_table_$not_done, ME, 1586 "^/^a contains an unknown or illegal notice.", 1587 pathname_ (SI.dir, SI.entry)); 1588 goto FATAL_ERROR; 1589 end; 1590 else call template_matched; 1591 end; 1592 end; 1593 else Lcomment = 0; 1594 end; 1595 1596 end process_tokens; 1597 1598 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1599 1600 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1601 1602 get_pnotice_block: 1603 proc returns (bit (1)); 1604 1605 Spnotice = True; 1606 Sstar_line = False; 1607 Ppnotice = null; 1608 Lpnotice = 0; 1609 save_ptr = Pcomment; 1610 save_length = Lcomment; 1611 1612 do while (Spnotice); 1613 Pcomment_line = Pcomment; 1614 Lcomment_line = index (comment, NL); 1615 if Lcomment_line = 0 1616 then 1617 do; 1618 Lcomment_line = Lcomment; 1619 Lcomment = 0; 1620 end; 1621 else 1622 do; 1623 Pcomment = addcharno (addr (comment_chr (Lcomment_line)), 1); 1624 Lcomment = Lcomment - Lcomment_line; 1625 end; 1626 if Lcomment_line 1627 > cmt_bgn_length + length (" ") + length ("**********") 1628 then if substr (comment_line, cmt_bgn_length + length (" "), 1629 length ("**********")) = "**********" 1630 then 1631 do; 1632 if ^Sstar_line 1633 then 1634 do; 1635 Ppnotice = Pcomment_line; 1636 Sstar_line = True; 1637 end; 1638 else 1639 do; 1640 Sstar_line = False; 1641 Spnotice = False; 1642 end; 1643 end; 1644 if Ppnotice ^= null then Lpnotice = Lpnotice + Lcomment_line; 1645 end; 1646 1647 if Lpnotice > 0 1648 then 1649 do; 1650 if Lcomment > 0 1651 then 1652 do; 1653 Icmt = verify (comment, HT_SP_NL_VT_NP); 1654 if Icmt > 0 1655 then 1656 do; 1657 Pcomment = addr (comment_chr (Icmt)); 1658 Lcomment = Lcomment - (Icmt - 1); 1659 end; 1660 else Lcomment = 0; 1661 end; 1662 return (True); 1663 end; 1664 1665 return (False); 1666 1667 end get_pnotice_block; 1668 1669 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1670 1671 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1672 1673 parse_source_init: 1674 proc; 1675 1676 SI_yrno = 0; /* Initialize date seq counter */ 1677 1678 call get_temp_segment_ (ME, Ppnotices, Acode); 1679 /* get area for pnotice_arr */ 1680 if Acode ^= 0 1681 then 1682 do; 1683 call com_err_ (Acode, ME, " 1684 Obtaining temp seg for pnotice parse."); 1685 goto FATAL_ERROR; 1686 end; 1687 1688 SKIP_CHRS = SI.cmt_bgn || SI.cmt_end || STAR || HT_SP_NL; 1689 1690 end parse_source_init; 1691 1692 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1693 1694 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1695 1696 template_matched: 1697 proc; 1698 1699 SI.Nnotices = SI.Nnotices + 1; 1700 if SI.Nnotices > dim (SI.notice_info, 1) 1701 then 1702 do; 1703 if SI.archive_name ^= "" 1704 then call ioa_ ( 1705 "^a^/Has more notices than this procedure currently implements.^/Only ^d are allowed.", 1706 pathname_$component (SI.dir, SI.archive_name, SI.entry), 1707 dim (SI.notice_info, 1)); 1708 else call ioa_ ( 1709 "^a^/Has more notices than this procdure currently implements.^/Only ^d are allowed.", 1710 pathname_ (SI.dir, SI.entry), dim (SI.notice_info, 1)); 1711 goto FATAL_ERROR; 1712 end; 1713 SI.notice_info (SI.Nnotices) = parse_templates_$get_template_pnotice (); 1714 1715 end template_matched; 1716 1717 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1718 1719 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1720 1721 parse_pnotice_: 1722 proc; 1723 1724 parse_pnotice_$block: 1725 entry returns (bit (1)); 1726 1727 pnotices.Nwords = 0; 1728 1729 if verify (pnotice, SKIP_CHRS) = 0 1730 then /* if only blank and stars left */ 1731 Lpnotice = 0; 1732 1733 if Lpnotice = 0 then return (False); 1734 1735 do while (parse_pnotice_$get_line ()); 1736 if verify (pnotice_line, SKIP_CHRS) = 0 1737 then 1738 do; /* blank line */ 1739 if pnotices.Nwords = 0 1740 then ; /* no pnotices parsed yet */ 1741 else return (True); 1742 end; 1743 else call parse_pnotice_$line; 1744 end; 1745 1746 return (True); 1747 1748 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1749 1750 parse_pnotice_$get_line: 1751 entry returns (bit (1)); 1752 1753 dcl Iline fixed bin (24); 1754 1755 if length (pnotice) = 0 then return (False); 1756 1757 Iline = index (pnotice, NL); 1758 if Iline = 0 | Lpnotice - Iline = 0 1759 then 1760 do; 1761 Ppnotice_line = Ppnotice; 1762 Lpnotice_line = length (pnotice); 1763 Lpnotice = 0; 1764 end; 1765 else 1766 do; 1767 Ppnotice_line = Ppnotice; 1768 Lpnotice_line = Iline - 1; 1769 Ppnotice = addcharno (addr (pnotice_chr (Iline)), 1); 1770 Lpnotice = Lpnotice - Iline; 1771 end; 1772 1773 return (True); 1774 1775 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1776 1777 parse_pnotice_$line: 1778 entry; 1779 1780 Pword_text = Ppnotice_line; 1781 Lword_text = Lpnotice_line; 1782 Inonwhite = verify (word_text, WORD_BREAKS); 1783 /* skip over cmt_bgn & white space */ 1784 if Inonwhite = 0 then Lword_text = 0; 1785 else if Inonwhite > 1 1786 then 1787 do; 1788 Pword_text = addr (word_text_arr (Inonwhite)); 1789 Lword_text = length (word_text) - (Inonwhite - 1); 1790 end; 1791 1792 do while (Lword_text > 0); 1793 Ibreak = search (word_text, WORD_BREAKS); 1794 if Ibreak = 0 then Ibreak = length (word_text) + 1; 1795 if Ibreak > 1 1796 then 1797 do; 1798 pnotices.Nwords = pnotices.Nwords + 1; 1799 pnotices.pword (Nwords) = substr (word_text, 1, Ibreak - 1); 1800 if length (pnotices.pword (Nwords)) >= length ("1986") 1801 then if verify (substr (pnotices.pword (Nwords), 1, 4), "0123456789") 1802 = 0 1803 then /* store date for future use */ 1804 call store_date; 1805 Pword_text = addr (word_text_arr (Ibreak)); 1806 Lword_text = length (word_text) - (Ibreak - 1); 1807 end; 1808 Iskip = verify (word_text, WORD_BREAKS); 1809 /* skip over all consecutive breaks chars */ 1810 if Iskip > 0 1811 then 1812 do; 1813 Pword_text = addr (word_text_arr (Iskip)); 1814 Lword_text = length (word_text) - (Iskip - 1); 1815 end; 1816 else Lword_text = 0; /* nothing but break characters remain */ 1817 end; 1818 1819 return; 1820 1821 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 1822 1823 store_date: 1824 proc; 1825 1826 if length (pnotices.pword (Nwords)) = length ("1986.") 1827 then if substr (pnotices.pword (Nwords), length ("1986."), length (".")) 1828 ^= "." 1829 then goto RETURN; 1830 1831 SI_yrno = SI_yrno + 1; 1832 source_year_a (SI_yrno) = substr (pnotices.pword (Nwords), 1, 4); 1833 source_year (SI_yrno) = 1834 convert (source_year (SI_yrno), source_year_a (SI_yrno)); 1835 1836 RETURN: 1837 end store_date; 1838 1839 1840 end parse_pnotice_; 1841 1842 1843 1844 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1845 1846 1847 dcl Ltline fixed bin (21), /* lgth of a template */ 1848 Ptline ptr, /* ptr to template notice */ 1849 tline char (Ltline) based (Ptline); 1850 /* a template line of text */ 1851 1852 parse_templates_: 1853 proc; 1854 1855 1856 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1857 /* */ 1858 /* This internal procedure provides the primitive operations necessary for obtaining a */ 1859 /* token (word) from a pnotice template, resetting to parse a new template, and */ 1860 /* initially preparing for parsing. */ 1861 /* */ 1862 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1863 1864 parse_templates_$init: 1865 entry; 1866 1867 call get_temp_segment_ (ME, Ptemplate, Acode); 1868 if Acode ^= 0 1869 then 1870 do; 1871 call com_err_ (Acode, ME, " 1872 Obtaining temp seg for template parse."); 1873 goto FATAL_ERROR; 1874 end; 1875 1876 return; 1877 1878 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1879 1880 parse_templates_$get_next: 1881 entry returns (bit (1)); 1882 1883 Ntemplates_parsed = Ntemplates_parsed + 1; 1884 1885 if Ntemplates_parsed <= pnotice_paths.Ntemplates 1886 then 1887 do; 1888 Ptline = pnotice_paths.templates (Ntemplates_parsed).Ptemplate; 1889 Ltline = 1890 pnotice_paths.templates (Ntemplates_parsed).Ltemplate 1891 - length (NL); 1892 return (True); 1893 end; 1894 1895 return (False); 1896 1897 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1898 1899 1900 parse_templates_$line: 1901 entry; 1902 1903 template.Twords = 0; 1904 Pword_text = Ptline; 1905 Lword_text = Ltline; 1906 WORD_BREAKS = WORD_BREAKS || NL; 1907 1908 Inonwhite = verify (tline, HT_SP_NL); 1909 /* remove "white space" */ 1910 if Inonwhite = 0 1911 then /* zero means there is nothing but white space */ 1912 Lword_text = 0; 1913 else if Inonwhite > 1 1914 then 1915 do; 1916 Pword_text = addr (word_text_arr (Inonwhite)); 1917 Lword_text = length (word_text) - (Inonwhite - 1); 1918 end; 1919 1920 do while (Lword_text > 0); 1921 template.Twords = template.Twords + 1; 1922 Ibreak = search (word_text, WORD_BREAKS); 1923 if Ibreak = 0 1924 then 1925 do; 1926 template.tword (Twords) = substr (word_text, 1, length (word_text)); 1927 Lword_text = 0; 1928 end; 1929 else 1930 do; 1931 template.tword (Twords) = substr (word_text, 1, Ibreak - 1); 1932 Pword_text = addr (word_text_arr (Ibreak)); 1933 Lword_text = length (word_text) - (Ibreak - 1); 1934 Iskip = verify (word_text, WORD_BREAKS); 1935 /* skip over all consecutive breaks chars */ 1936 if Iskip > 0 1937 then 1938 do; 1939 Pword_text = addr (word_text_arr (Iskip)); 1940 Lword_text = length (word_text) - (Iskip - 1); 1941 end; 1942 else Lword_text = 0; /* nothing but break characters remain */ 1943 end; 1944 end; 1945 1946 return; 1947 1948 1949 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1950 1951 1952 parse_templates_$get_template_pnotice: 1953 entry returns (1 aligned, 2 char (32), 2 char (4), 2 fixed bin, 2 fixed bin); 1954 1955 dcl 1 ret aligned, 1956 2 Aname char (32), 1957 2 Adate char (4), 1958 2 Atype fixed bin, 1959 2 Aseq fixed bin; 1960 1961 1962 ret.Aname = 1963 before (pnotice_paths.templates (Ntemplates_parsed).primary_name, 1964 ".pnotice"); 1965 if SI_yrno > 0 1966 then ret.Adate = source_year_a (SI_yrno); 1967 else ret.Adate = ""; 1968 ret.Atype = pnotice_paths.templates (Ntemplates_parsed).type; 1969 seqno = seqno + 1; 1970 ret.Aseq = seqno; 1971 return (ret); 1972 1973 end parse_templates_; 1974 1975 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1976 1977 1978 1979 end pnotice_parse; 1980 1981 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1982 1983 1984 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1985 1986 continue_processing: 1987 proc (SI, TI) returns (bit (1)); 1988 1989 1990 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1991 /* */ 1992 /* This internal procedure must do some necessary checking on any notices found in */ 1993 /* source already and the notice that would be added. Specifically, checks must be made */ 1994 /* for duplicate notices already in the source. If this is found, only one copy is */ 1995 /* retained. A check must be made to see if the notice to add is already in the source. */ 1996 /* If it is, then an error message is produced, and nothing is done. Checks must be made */ 1997 /* to see if the source has mixed Trade Secret notices and copyrights. If this is so, an */ 1998 /* error message is produced, and nothing is done. */ 1999 /* Checks are also made for mixed public domain and copyright or trade secret notices in */ 2000 /* the source. A check is made to see if the action the user wants would be inconsistent */ 2001 /* with the notice(s) already in the source. */ 2002 /* */ 2003 /* */ 2004 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2005 2006 2007 dcl 1 SI aligned like source_info, 2008 /* IN */ 2009 1 TI aligned like target_info; 2010 /* OUT */ 2011 2012 2013 dcl Iname fixed bin, 2014 Idx1 fixed bin, 2015 Idx2 fixed bin, 2016 Acode fixed bin (35), 2017 match bit (1), 2018 addC bit (1), 2019 addTS bit (1), 2020 addPD bit (1), 2021 foundPD bit (1), 2022 foundC bit (1), 2023 foundTS bit (1); 2024 2025 2026 Acode = 0; 2027 addC = False; 2028 addTS = False; 2029 addPD = False; 2030 foundPD = False; 2031 foundC = False; 2032 match = False; 2033 Iname = 1; 2034 2035 if SI.Nnotices = 0 2036 then 2037 do; /* if the source had no notices, */ 2038 if ^Fname & ^Ftrade_secret & ^DFtrade_secret & ^Fcopy_right 2039 & ^DFcopy_right & ^Fpublic_domain 2040 then 2041 do; 2042 call com_err_ (0, ME, " 2043 No protection notices were found in ^a ^a^[>^]^[^a::^;^s^]^a^a", " ", 2044 SI.dir, SI.dir ^= ">", SI.archive_name ^= "", SI.archive_name, 2045 SI.entry, "."); 2046 return (False); 2047 end; 2048 2049 TI.Nnotices = 1; /* we must add the requested notice */ 2050 TI.notice (TI.Nnotices).name = SI.notice_to_add.name; 2051 TI.notice (TI.Nnotices).date = current_year_a; 2052 seqno = seqno + 1; 2053 TI.notice (TI.Nnotices).seq = ltrim (char (seqno)); 2054 if Sdfcopyright then Sprt_notice = True; 2055 return (True); /* nothing remains to be done */ 2056 end; 2057 2058 2059 /* CHECK FOR MIXED NOTICE TYPES, ILLEGAL MULTIPLE NOTICES */ 2060 if SI.notice_to_add.type = TRADE_SECRET then addTS = True; 2061 else if SI.notice_to_add.type = PUBLIC_DOMAIN then addPD = True; 2062 else addC = True; 2063 do Idx1 = 1 to SI.Nnotices; /* now look at notices found */ 2064 if SI.notice_info (Idx1).notice_type = TRADE_SECRET then foundTS = True; 2065 else if SI.notice_info (Idx1).notice_type = PUBLIC_DOMAIN 2066 then foundPD = True; 2067 else foundC = True; 2068 end; 2069 if foundC & foundTS 2070 then 2071 do; /* source had copyright and T. S. somehow */ 2072 Acode = error_table_$not_done; 2073 if SI.archive_name ^= "" 2074 then call com_err_ (Acode, ME, 2075 "^/Processing ^a. The module has mixed copyright and trade secret notices.", 2076 pathname_$component (SI.dir, SI.archive_name, SI.entry)); 2077 else call com_err_ (Acode, ME, 2078 "^/Processing ^a. The module has mixed copyright and trade secret notices.", 2079 pathname_ (SI.dir, SI.entry)); 2080 return (False); 2081 end; 2082 if foundC & foundPD 2083 then 2084 do; /* source had copyright and public domain */ 2085 Acode = error_table_$not_done; 2086 if SI.archive_name ^= "" 2087 then call com_err_ (Acode, ME, 2088 "^/Processing ^a. The module has mixed copyright and public domain notices.", 2089 pathname_$component (SI.dir, SI.archive_name, SI.entry)); 2090 else call com_err_ (Acode, ME, 2091 "^/Processing ^a. The module has mixed copyright and public domain notices.", 2092 pathname_ (SI.dir, SI.entry)); 2093 return (False); 2094 end; 2095 if foundTS & foundPD 2096 then 2097 do; /* source had trade secret and public domain */ 2098 Acode = error_table_$not_done; 2099 if SI.archive_name ^= "" 2100 then call com_err_ (Acode, ME, 2101 "^/Processing ^a. The module has mixed trade secret and public domain notices.", 2102 pathname_$component (SI.dir, SI.archive_name, SI.entry)); 2103 else call com_err_ (Acode, ME, 2104 "^/Processing ^a. The module has mixed trade secret and public domain notices.", 2105 pathname_ (SI.dir, SI.entry)); 2106 return (False); 2107 end; 2108 if addTS & foundTS 2109 then 2110 do; 2111 do Idx1 = 1 to SI.Nnotices 2112 while (SI.notice_to_add.name ^= SI.notice_info (Idx1).notice_name) 2113 ; 2114 end; 2115 if Idx1 ^> SI.Nnotices 2116 then 2117 do; 2118 Acode = error_table_$not_done; 2119 if SI.archive_name ^= "" 2120 then call com_err_ (Acode, ME, 2121 "^/Processing ^a.^/Duplicate Trade Secret notices not allowed.", 2122 pathname_$component (SI.dir, SI.archive_name, SI.entry)); 2123 else call com_err_ (Acode, ME, 2124 "^/Processing ^a.^/Duplicate Trade Secret notices are not allowed.", 2125 pathname_ (SI.dir, SI.entry)); 2126 return (False); 2127 end; 2128 end; 2129 else if addPD & foundPD 2130 then 2131 do; 2132 Acode = error_table_$not_done; 2133 if SI.archive_name ^= "" 2134 then call com_err_ (Acode, ME, 2135 "^/Processing ^a.^/Multiple Public Domain notices not allowed.", 2136 pathname_$component (SI.dir, SI.archive_name, SI.entry)); 2137 else call com_err_ (Acode, ME, 2138 "^/Processing ^a.^/Multiple Public Domain notices not allowed.", 2139 pathname_ (SI.dir, SI.entry)); 2140 return (False); 2141 end; 2142 else if addC & foundC then ; /* the ONLY way to have >1 notice */ 2143 else 2144 do; /* this will abort everything */ 2145 Acode = error_table_$not_done; 2146 if SI.archive_name ^= "" 2147 then call com_err_ (Acode, ME, 2148 "^/Found ^[Copyright^;Trade Secret^;Public Domain^] notice in ^a.^/Cannot add ^a.", 2149 SI.notice_info (1).notice_type, 2150 pathname_$component (SI.dir, SI.archive_name, SI.entry), 2151 SI.notice_to_add.name); 2152 else call com_err_ (Acode, ME, 2153 "^/Found ^[Copyright^;Trade Secret^;Public Domain^] notice in ^a.^/Cannot add ^a.", 2154 SI.notice_info (1).notice_type, pathname_ (SI.dir, SI.entry), 2155 SI.notice_to_add.name); 2156 return (False); 2157 end; 2158 2159 /* VALIDATE THE TEN-YEAR RULE FOR COPYRIGHTS */ 2160 TI.Nnotices = 0; 2161 if ^Ftrade_secret & ^Fpublic_domain 2162 then /* if we are working on a copyright... */ 2163 if ok_nine_year_rule (SI) 2164 then 2165 do; /* the new notice may be added. */ 2166 do Idx1 = 1 to SI.Nnotices while 2167 /* check to see if new name being added or same */ 2168 /* name with a new date. */ 2169 ((SI.notice_to_add.name ^= SI.notice_info (Idx1).notice_name) 2170 | (SI.notice_to_add.name = SI.notice_info (Idx1).notice_name 2171 & current_year ^= source_year (Idx1))); 2172 end; 2173 if Idx1 > SI.Nnotices 2174 then 2175 do; 2176 TI.Nnotices = 1; 2177 TI.notice (1).name = SI.notice_to_add.name; 2178 /* shall be first */ 2179 TI.notice (1).date = current_year_a; 2180 /* new notice yr */ 2181 seqno = seqno + 1; 2182 TI.notice (1).seq = ltrim (char (seqno)); 2183 if Sdfcopyright then Sprt_notice = True; 2184 end; 2185 end; 2186 2187 2188 if Sno_args_given 2189 then if ^Sadd_default_pnotice /* if already there dont try to readd */ 2190 then return (False); 2191 2192 if Fname & Ftrade_secret 2193 then 2194 do; 2195 TI.Nnotices = 1; 2196 TI.notice (1).name = SI.notice_to_add.name; 2197 seqno = seqno + 1; 2198 TI.notice (1).seq = ltrim (char (seqno)); 2199 end; 2200 2201 /* CHECK FOR DUPS IN THE SOURCE ALREADY */ 2202 do Idx1 = 1 to SI.Nnotices - 1; 2203 do Idx2 = Idx1 + 1 to SI.Nnotices; 2204 if SI.notice_info (Idx1).notice_name 2205 = SI.notice_info (Idx2).notice_name 2206 & SI.notice_info (Idx1).notice_date 2207 = SI.notice_info (Idx2).notice_date 2208 then /* if a dup is found, only one will be retained */ 2209 SI.notice_info (Idx2).notice_name = ""; 2210 end; 2211 end; 2212 2213 /* FILL IN TARGET PNOTICE NAMES */ 2214 do Idx1 = 1 to SI.Nnotices; 2215 if SI.notice_info (Idx1).notice_name ^= "" 2216 then 2217 do; 2218 TI.Nnotices = TI.Nnotices + 1;/* the target structure contains notices */ 2219 /* that will be put into the source. */ 2220 TI.notice (TI.Nnotices).name = SI.notice_info (Idx1).notice_name; 2221 TI.notice (TI.Nnotices).date = SI.notice_info (Idx1).notice_date; 2222 TI.notice (TI.Nnotices).seq = 2223 ltrim (char (SI.notice_info (Idx1).seq)); 2224 end; 2225 end; 2226 2227 /* SORT IF THERE IS MORE THAN ONE */ 2228 if TI.Nnotices > 1 then call sort_pnotices (TI); 2229 do Idx1 = 1 to dim (SI.notice_info, 1) 2230 while (SI.notice_info (Idx1).notice_name ^= "" 2231 & SI.notice_info (Idx1).notice_name = TI.notice (Idx1).name 2232 & SI.notice_info (Idx1).notice_date = TI.notice (Idx1).date); 2233 end; 2234 if Idx1 - 1 > dim (SI.notice_info, 1) 2235 then /* there is no change, do nothing. */ 2236 return (False); 2237 else return (True); 2238 2239 2240 end continue_processing; 2241 2242 2243 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2244 2245 sort_pnotices: 2246 proc (TI); 2247 2248 2249 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2250 /* */ 2251 /* This procedure is called upon to sort multiple copyright notices into the proper */ 2252 /* order. The order must be "most recent first", i.e., the notice containing the most */ 2253 /* recent date must show up as the first notice in the comment box. Descending collating */ 2254 /* order, if you will. */ 2255 /* */ 2256 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2257 2258 2259 2260 dcl 1 V aligned, /* sort vector of pointers */ 2261 2 N fixed bin (18), 2262 2 vector (dim (TI.notice, 1)) ptr unaligned; 2263 2264 dcl 1 TI aligned like target_info; 2265 /* IN/OUT */ 2266 dcl Idx1 fixed bin, 2267 Idx2 fixed bin; 2268 dcl 1 notice aligned like target_info.notice based; 2269 dcl 1 sorted_data (dim (TI.notice, 1)) aligned like target_info.notice; 2270 dcl sort_items_$char 2271 entry (ptr, fixed bin (24)); 2272 2273 V.N = TI.Nnotices; 2274 do Idx1 = 1 to TI.Nnotices; 2275 V.vector (Idx1) = addr (TI.notice.sort_field (Idx1)); 2276 /* get ptr value to it */ 2277 end; 2278 call sort_items_$char (addr (V), 2279 length (string (TI.notice.sort_field (1)))); 2280 /* sort on sort field */ 2281 2282 2283 Idx2 = 1; 2284 do Idx1 = V.N to 1 by -1; 2285 sorted_data (Idx2) = V.vector (Idx1) -> notice; 2286 Idx2 = Idx2 + 1; 2287 end; 2288 do Idx2 = Idx2 to dim (sorted_data, 1); 2289 string (sorted_data (Idx2)) = ""; 2290 end; 2291 2292 TI.notice (*) = sorted_data (*); 2293 2294 end sort_pnotices; 2295 2296 2297 2298 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2299 2300 2301 ok_nine_year_rule: 2302 proc (SI) returns (bit (1)); 2303 2304 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2305 /* */ 2306 /* This internal procedure enforces the rule promulgated by Honeywell LISD management */ 2307 /* that consists of the following: */ 2308 /* If a source program already has one (or more) copyright notice(s), and this program */ 2309 /* is invoked to insert another one, then no notice need be added if there is already a */ 2310 /* notice which is within nine years of the date of the new notice AND both notices are */ 2311 /* duplicates, with exception of the date. This rule does NOT apply to Trade Secret */ 2312 /* notices. */ 2313 /* If no -nm arg is given the most recent pnotice will have the nine-year rule applied */ 2314 /* */ 2315 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2316 2317 dcl 1 SI aligned like source_info; 2318 /* IN */ 2319 dcl continue bit (1), 2320 new_pnotice_vers 2321 char (32) var, 2322 new_pnotice_date 2323 char (4), 2324 current_pnotice_vers 2325 char (32) var, 2326 current_pnotice_date 2327 char (4); 2328 2329 dcl HBull_name_array 2330 (5) char (80) varying int static options (constant) 2331 init ("HIS", "HIS_A", "HIS_B", "MIT_HIS", "MIT_HIS_A"); 2332 2333 dcl most_recent_date 2334 char (4), 2335 Idx2 fixed bin; 2336 2337 continue = True; 2338 new_pnotice_vers = before (SI.notice_to_add.name, "."); 2339 new_pnotice_date = current_year_a; 2340 most_recent_date = ""; 2341 2342 if Sno_args_given 2343 then 2344 do Idx1 = 1 to SI.Nnotices; 2345 if SI.notice_info (Idx1).notice_name = new_pnotice_vers 2346 /* default already exists so exit */ 2347 then 2348 do; 2349 Sadd_default_pnotice = False; 2350 return (Sadd_default_pnotice); 2351 end; 2352 if most_recent_date < SI.notice_info (Idx1).notice_date 2353 then most_recent_date = SI.notice_info (Idx1).notice_date; 2354 end; 2355 2356 do Idx1 = 1 to SI.Nnotices while (continue); 2357 /* go thru all notices in the segment */ 2358 current_pnotice_vers = SI.notice_info (Idx1).notice_name; 2359 current_pnotice_date = SI.notice_info (Idx1).notice_date; 2360 2361 if Sno_args_given 2362 then 2363 do; 2364 if SI.notice_info (Idx1).notice_date = most_recent_date 2365 then 2366 do Idx2 = lbound (HBull_name_array, 1) 2367 to hbound (HBull_name_array, 1); 2368 if SI.notice_info (Idx1).notice_name = HBull_name_array (Idx2) 2369 /* if a match is found exit & add HBull notice */ 2370 then Sadd_default_pnotice = True; 2371 end; 2372 else Sadd_default_pnotice = False; 2373 2374 return (Sadd_default_pnotice); 2375 end; 2376 2377 if current_pnotice_vers = new_pnotice_vers 2378 then 2379 do; /* if a matching version is found, */ 2380 if current_year <= source_year (Idx1) + 9 2381 then /* the new notice date must be more than */ 2382 /* nine years newer, else no need to add it. */ 2383 continue = False; 2384 end; 2385 end; 2386 return (continue); 2387 2388 end ok_nine_year_rule; 2389 2390 2391 2392 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2393 2394 2395 dcl Lmax_line fixed bin (21), /* lgth of longest line in notice(s) */ 2396 Lmove fixed bin (21), 2397 Lsave fixed bin (21), 2398 Ltext fixed bin (21), 2399 Psave ptr, 2400 Ptext ptr, 2401 move char (Lmove) based, 2402 /* used to obtain template text */ 2403 save_chr (Lsave) char (1) based (Psave), 2404 star_box char (target_info.Lstar_box) 2405 based (target_info.Pstar_box); 2406 2407 make_star_box: 2408 proc (SI, TI); 2409 2410 2411 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2412 /* */ 2413 /* This procedure obtains a temporary segment, gets the text of all notices to put into */ 2414 /* the source segment, and then forms the star comment box. */ 2415 /* */ 2416 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2417 2418 dcl 1 SI aligned like source_info, 2419 /* IN */ 2420 1 TI aligned like target_info; 2421 /* IN/OUT */ 2422 dcl box_line char (128) var, 2423 Idate fixed bin, 2424 Inotice fixed bin, 2425 Nnotices_in_box 2426 fixed bin; 2427 2428 box_line = ""; 2429 Nnotices_in_box = 0; 2430 Ltext = 0; 2431 Lmove = 0; 2432 if Ptext = null 2433 then 2434 do; 2435 call get_temp_segment_ (ME, Ptext, code); 2436 /* temp seg for text and star box */ 2437 if code ^= 0 2438 then 2439 do; 2440 call com_err_ (code, ME, " 2441 Obtaining temp seg for text and star box."); 2442 goto FATAL_ERROR; 2443 end; 2444 end; 2445 else Ptext = ptr (Ptext, 0); /* incase of multiple archive components */ 2446 /* don't want to get another temp seg, */ 2447 /* just start over. */ 2448 Psave = Ptext; /* Psave will be moved along thru text */ 2449 /* get text of notices. */ 2450 do Inotice = 1 to TI.Nnotices; /* for each notice */ 2451 do Itemplate = 1 to pnotice_paths.Ntemplates; 2452 /* search the template names */ 2453 if TI.notice (Inotice).name 2454 = 2455 before (pnotice_paths.templates (Itemplate).primary_name, 2456 ".pnotice") 2457 then 2458 do; /* if a matching name is found, */ 2459 Lmove = pnotice_paths.templates (Itemplate).Ltemplate + 1; 2460 Psave -> move = 2461 pnotice_paths.templates (Itemplate).Ptemplate -> move; 2462 /* get the text of that template. */ 2463 substr (Psave -> move, Lmove, 1) = NL; 2464 /* add a NL */ 2465 /* put the dates in template text */ 2466 Idate = 0; 2467 Idate = index (Psave -> move, ""); 2468 if Idate ^= 0 2469 then substr (Psave -> move, Idate, 4) = TI.notice (Inotice).date; 2470 Ltext = Ltext + Lmove; 2471 if Inotice = 1 2472 then 2473 do; /* save data for print */ 2474 save_text = substr (Psave -> move, 1, Ltext); 2475 save_name = SI.notice_to_add.name; 2476 end; 2477 Lsave = Lmove + 1; 2478 Psave = addr (save_chr (Lsave)); 2479 Nnotices_in_box = Nnotices_in_box + 1; 2480 2481 end; 2482 end; 2483 end; 2484 if Nnotices_in_box ^= TI.Nnotices 2485 then 2486 do; 2487 if SI.archive_name ^= "" 2488 then call com_err_ (0, ME, 2489 "^/A programming error has occurred while processing ^a.^/Total number of notices (^d) is inconsistent with target information (^d).^/Operation not performed.", 2490 pathname_$component (SI.dir, SI.archive_name, SI.entry), 2491 Nnotices_in_box, TI.Nnotices); 2492 else call com_err_ (0, ME, 2493 "^/A programming error has occurred while processing ^a.^/Total number of notices (^d) is inconsistent with target information (^d).^/Operation not performed.", 2494 pathname_ (SI.dir, SI.entry), Nnotices_in_box, TI.Nnotices); 2495 goto FATAL_ERROR; 2496 end; /* now find the longest line */ 2497 call find_line$init (Ptext, Ltext); /* set find_line */ 2498 Lmax_line = 0; 2499 do while (find_line ()); 2500 Lmax_line = max (Lmax_line, length (line)); 2501 /* longest line */ 2502 end; 2503 2504 TI.Pstar_box = Psave; /* from here, Pstar_box marks the beginning of */ 2505 /* the new box */ 2506 TI.Lstar_box = 0; 2507 call add_text$init (addr (TI)); /* set up add_text */ 2508 goto TYPE (SI.type); 2509 2510 TYPE (1): /* cds */ 2511 TYPE (4): /* pl1 */ 2512 /* first line made up of stars */ 2513 call add_text$var (SI.cmt_bgn); 2514 call add_text$fixed (SP); 2515 call add_text$substr (STARS, Lmax_line + length ("* *")); 2516 call add_text$fixed (NL); /* second line is for looks */ 2517 call add_text$substr (SPACES, length (SI.cmt_bgn) + length (SP)); 2518 call add_text$fixed (STAR); 2519 call add_text$substr (SPACES, Lmax_line + length (" ")); 2520 call add_text$fixed (STAR); 2521 call add_text$fixed (NL); 2522 2523 call find_line$init (Ptext, Ltext); /* set up for find_line */ 2524 do while (find_line ()); /* get lines of text */ 2525 call add_text$substr (SPACES, length (SI.cmt_bgn) + length (SP)); 2526 call add_text$fixed (STAR); 2527 call add_text$fixed (SP); 2528 call add_text$fixed (line); 2529 call add_text$substr (SPACES, Lmax_line - length (line)); 2530 call add_text$fixed (sfx_string); 2531 end; 2532 call add_text$substr (SPACES, length (SI.cmt_bgn) + length (SP)); 2533 call add_text$substr (STARS, Lmax_line + length ("* *")); 2534 call add_text$fixed (SP); 2535 call add_text$var (SI.cmt_end); 2536 if SI.Nnotices = 0 2537 then /* only do first time any notice was added */ 2538 call add_text$fixed (NL_NL); 2539 else call add_text$fixed (NL); 2540 2541 return; 2542 2543 TYPE (2): /*cobol*/ 2544 TYPE (3): /*exec_com*/ 2545 TYPE (5): /*compin, runoff*/ 2546 /* first line made up of stars */ 2547 call add_text$var (SI.cmt_bgn); 2548 call add_text$fixed (SP); 2549 call add_text$substr (STARS, Lmax_line + 4); 2550 call add_text$fixed (NL); /* next line is for readability */ 2551 call add_text$var (SI.cmt_bgn); 2552 call add_text$fixed (SP_STAR); 2553 call add_text$substr (SPACES, Lmax_line + 2); 2554 call add_text$fixed (STAR); 2555 call add_text$fixed (NL); 2556 2557 call find_line$init (Ptext, Ltext); /* set up for find_line */ 2558 do while (find_line ()); 2559 call add_text$var (SI.cmt_bgn); 2560 call add_text$fixed (SP_STAR_SP); 2561 call add_text$fixed (line); 2562 call add_text$substr (SPACES, Lmax_line - length (line)); 2563 call add_text$fixed (sfx_string); 2564 end; 2565 call add_text$var (SI.cmt_bgn); 2566 call add_text$fixed (SP); 2567 call add_text$substr (STARS, Lmax_line + 4); 2568 if SI.type ^= 5 2569 then call add_text$fixed (NL); 2570 return; 2571 end make_star_box; 2572 2573 2574 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2575 2576 add_text: 2577 proc; 2578 2579 2580 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2581 /* */ 2582 /* This procedure forms the text of a star comment box, one line at a time. It is called */ 2583 /* from the procedure make_star_box. */ 2584 /* */ 2585 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2586 2587 dcl Lold_text fixed bin (21); 2588 dcl TIptr ptr; 2589 dcl 1 TI aligned like target_info based (TIptr); 2590 2591 add_text$init: 2592 entry (Aptr); 2593 dcl Aptr ptr; 2594 2595 TIptr = Aptr; 2596 return; 2597 2598 add_text$fixed: 2599 entry (new_text); 2600 2601 dcl new_text char (*); /* IN */ 2602 2603 2604 Lold_text = TI.Lstar_box; 2605 TI.Lstar_box = TI.Lstar_box + length (new_text); 2606 substr (star_box, Lold_text + 1) = new_text; 2607 return; 2608 2609 add_text$var: 2610 entry (new_var_text); 2611 2612 dcl new_var_text char (*) var; /* IN */ 2613 2614 2615 Lold_text = TI.Lstar_box; 2616 TI.Lstar_box = TI.Lstar_box + length (new_var_text); 2617 substr (star_box, Lold_text + 1) = new_var_text; 2618 return; 2619 2620 add_text$substr: 2621 entry (Astring, Alength); 2622 2623 dcl Astring char (*), /* IN */ 2624 Alength fixed bin (21); 2625 2626 Lold_text = TI.Lstar_box; 2627 TI.Lstar_box = TI.Lstar_box + Alength; 2628 substr (star_box, Lold_text + 1) = substr (Astring, 1, Alength); 2629 return; 2630 2631 end add_text; 2632 2633 2634 2635 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2636 2637 2638 check_acl: 2639 proc (Aptr, Adir, Aentry, Amust_reset); 2640 2641 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2642 /* */ 2643 /* A procedure to check for validation level problems, as well as access so that the */ 2644 /* notices can be written into the segment. If proper access is not there, this */ 2645 /* procedure will try to force access. The reset_acl procedure will then restore things */ 2646 /* the way they were. */ 2647 /* */ 2648 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2649 2650 2651 dcl Aptr ptr, /* IN */ 2652 Adir char (*), /* IN */ 2653 Aentry char (*), /* IN */ 2654 Amode_set bit (1), /* IN */ 2655 Amust_reset bit (1); /* OUT */ 2656 dcl Acode fixed bin (35), 2657 old_mode bit (36) aligned;/* original access to a seg, if acl forced */ 2658 2659 2660 dcl 1 acle (1), /* structure for the list_acl and */ 2661 /* add_acl_entries calls */ 2662 2 name char (32) aligned, 2663 2 mode bit (36) aligned, 2664 2 mbz bit (36) aligned, 2665 2 code fixed bin (35); 2666 2667 dcl 1 del_acl (1), /* structure for the delete_acl_entries call */ 2668 2 name char (32) aligned, 2669 2 code fixed bin (35); 2670 2671 dcl one_word char (4) based, 2672 error_table_$lower_ring 2673 fixed bin (35) ext static, 2674 error_table_$user_not_found 2675 fixed bin (35) ext static; 2676 2677 Amust_reset = False; /* we've done nothing yet. */ 2678 on not_in_write_bracket 2679 begin; 2680 call com_err_ (error_table_$lower_ring, ME, " 2681 Writing ^a>^a.", Adir, Aentry); 2682 goto FATAL_ERROR; /* non-local goto out of this mess */ 2683 end; 2684 2685 on no_write_permission goto FORCE_ACL; 2686 Aptr -> one_word = Aptr -> one_word;/* try to write the first word of the seg. */ 2687 return; /* no need to go further if it worked. */ 2688 2689 2690 FORCE_ACL: 2691 acle (1).name = get_group_id_ (); 2692 acle (1).mode = "0"b; 2693 acle (1).mbz = "0"b; 2694 acle (1).code = 0; 2695 call hcs_$list_acl (Adir, Aentry, null, null, addr (acle), 1, Acode); 2696 if acle (1).code ^= 0 2697 then if acle (1).code = error_table_$user_not_found 2698 then /* this user not in ACL */ 2699 Amode_set = False; 2700 else goto ERROR; 2701 else 2702 do; 2703 if Acode ^= 0 2704 then 2705 do; 2706 acle (1).code = Acode; 2707 goto ERROR; 2708 end; 2709 Amode_set = True; /* this user was in ACL */ 2710 old_mode = acle (1).mode; /* save current mode for restoring */ 2711 end; 2712 acle (1).mode = "101"b; /* we need rw access */ 2713 acle (1).mbz = "0"b; 2714 acle (1).code = 0; 2715 call hcs_$add_acl_entries (Adir, Aentry, addr (acle), 1, Acode); 2716 if Acode ^= 0 2717 then 2718 do; 2719 call com_err_ (Acode, ME, " 2720 Unable to force write access for ^a to ^a>^a.", acle (1).name, Adir, Aentry); 2721 goto FATAL_ERROR; 2722 end; 2723 Amust_reset = True; /* we will have to reset access. */ 2724 return; 2725 ERROR: 2726 call com_err_ (acle (1).code, ME, " 2727 When listing ^a's access to ^a>^a", acle (1).name, Adir, Aentry); 2728 goto FATAL_ERROR; 2729 2730 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2731 2732 2733 check_acl$reset_acl: 2734 entry (Aptr, Adir, Aentry, Amode_set); 2735 2736 acle (1).name = get_group_id_ (); /* this proc has its own stack frame, so don't */ 2737 /* rely on earlier name being there... */ 2738 if Amode_set 2739 then 2740 do; /* we must restore old mode */ 2741 acle (1).mode = old_mode; 2742 acle (1).mbz = "0"b; 2743 acle (1).code = 0; 2744 call hcs_$add_acl_entries (Adir, Aentry, addr (acle), 1, Acode); 2745 if acle (1).code ^= 0 2746 then 2747 do; 2748 call com_err_ (Acode, ME, " 2749 Restoring access for ^a to ^a>^a.", acle (1).name, Adir, Aentry); 2750 return; 2751 end; 2752 end; 2753 else 2754 do; 2755 del_acl (1).name = acle (1).name; 2756 del_acl (1).code = 0; 2757 call hcs_$delete_acl_entries (Adir, Aentry, addr (del_acl), 1, Acode); 2758 if Acode ^= 0 then call com_err_ (Acode, ME, " 2759 Removing access for ^a to ^a>^a.", del_acl (1).name, Adir, Aentry); 2760 return; 2761 end; 2762 return; 2763 2764 end check_acl; 2765 2766 2767 2768 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2769 2770 2771 dcl Lline fixed bin (21), 2772 Ltemp fixed bin (21), /* lgth string searched by find_line */ 2773 Pline ptr, 2774 Ptemp ptr, /* ptr to string used by find_line */ 2775 line char (Lline) based (Pline), 2776 /* a line of notice text to be added */ 2777 temp char (Ltemp) based (Ptemp), 2778 /* string searched by find_line */ 2779 temp_chr (Ltemp) char (1) based (Ptemp); 2780 2781 find_line: 2782 proc returns (bit (1)); 2783 2784 2785 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2786 /* */ 2787 /* This internal procedure is used to obtain the text of pnotice templates, line by */ 2788 /* line, as they were built by the first half of the star_box internal procedure. These */ 2789 /* lines are used with format characters to build the actual comment box containing the */ 2790 /* notices. */ 2791 /* */ 2792 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2793 2794 2795 if Ltemp <= 0 2796 then return (False); 2797 else 2798 do; 2799 Pline = Ptemp; 2800 Lline = search (temp, NL); /* find end of this line */ 2801 Ptemp = addcharno (addr (temp_chr (Lline)), 1); 2802 Ltemp = Ltemp - Lline; 2803 Lline = Lline - 1; /* remove the NL */ 2804 end; 2805 return (True); 2806 2807 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2808 2809 2810 find_line$init: 2811 entry (Pstr, Lstr); 2812 dcl Pstr ptr, 2813 Lstr fixed bin (21); 2814 Ptemp = Pstr; 2815 Ltemp = Lstr; 2816 return; 2817 2818 find_line$remainder_length: 2819 entry returns (fixed bin (21)); 2820 2821 return (Ltemp); 2822 2823 end find_line; 2824 2825 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2826 2827 2828 2829 2830 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2831 dcl new_box char (target_info.Lnew_box) 2832 based (target_info.Pnew_box); 2833 2834 insert_notice: 2835 proc (SI, TI); 2836 2837 2838 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2839 /* */ 2840 /* This procedure adds the notice to a segment. In the case of free-standing segments, */ 2841 /* the target is the segment itself, but for archives, the target is a copy of the */ 2842 /* archive component in the process dir. The archive command then will update the */ 2843 /* archive via process_archive_components. */ 2844 /* */ 2845 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2846 2847 2848 dcl 1 SI aligned like source_info, 2849 /* IN */ 2850 1 TI aligned like target_info; 2851 /* IN */ 2852 2853 2854 dcl Psource ptr, 2855 Ptarget ptr; 2856 2857 Psource = addcharno (TI.Pnew_box, SI.Lold_box); 2858 Ptarget = addcharno (TI.Pnew_box, TI.Lnew_box); 2859 /* determine proper size hole for append */ 2860 /* if new box is same size, we go by this. */ 2861 if TI.Lnew_box > SI.Lold_box 2862 then /* new notice box larger than old */ 2863 call pnotice_mrl_ (Psource, SI.Lentry - SI.Lold_box, Ptarget, 2864 SI.Lentry - SI.Lold_box); /* append seg */ 2865 else if TI.Lnew_box < SI.Lold_box 2866 then /* new notice box smaller than old */ 2867 /* this may happen if source had >1 box in it */ 2868 call pnotice_mlr_ (Psource, SI.Lentry - SI.Lold_box, Ptarget, 2869 SI.Lentry - SI.Lold_box); 2870 2871 TI.Lentry = (SI.Lentry - SI.Lold_box) + TI.Lnew_box; 2872 2873 new_box = star_box; /* obtain new box from the temp seg */ 2874 /* copy box back from temp storage */ 2875 /* For an archive, the archive command will be */ 2876 /* used to update the archive after all components*/ 2877 /* have been processed */ 2878 call terminate_file_ (TI.Pentry, TI.Lentry * 9, TERM_FILE_TRUNC_BC, code); 2879 /* set the bit count. */ 2880 /* THIS IS THE ONLY PLACE WHERE BIT COUNTS ARE SET*/ 2881 2882 2883 end insert_notice; 2884 2885 2886 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2887 2888 dcl Lt fixed bin (21), /* used by display_pnotice for template lgth */ 2889 Pt ptr, 2890 template char (Lt) based, /* used by display_pnotice */ 2891 dt char (4); 2892 2893 2894 report: 2895 proc (SI, TI); 2896 2897 2898 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2899 /* */ 2900 /* An internal procedure that is used ONLY by display_pnotice to report on the */ 2901 /* protection notices found in a source program. */ 2902 /* */ 2903 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2904 2905 2906 dcl 1 SI aligned like source_info; 2907 dcl 1 TI aligned like target_info; 2908 dcl Inotice fixed bin, 2909 Itemplate fixed bin; 2910 dcl pnames (SI.Nnotices) char (32); 2911 dcl Iyr fixed bin (24); 2912 2913 2914 if SI.Nnotices = 0 2915 then 2916 do; /* NO NOTICE */ 2917 if ^imbedded_notices (SI) 2918 then if SI.archive_name ^= "" 2919 then call ioa_ ("Warning: ^a has no protection notice.", 2920 pathname_$component (SI.dir, SI.archive_name, SI.entry)) 2921 ; 2922 else call ioa_ ("Warning: ^a has no protection notice.", 2923 pathname_ (SI.dir, SI.entry)); 2924 else if SI.archive_name ^= "" 2925 then call ioa_ ("Warning: ^a has an imbedded notice.", 2926 pathname_$component (SI.dir, SI.archive_name, SI.entry)); 2927 else call ioa_ ("Warning: ^a has an imbedded notice.", 2928 pathname_ (SI.dir, SI.entry)); 2929 return; 2930 end; 2931 if TI.long_output 2932 then 2933 do; /* LONG OUTPUT */ 2934 call ioa_ ("^[^5x^a^2s^;^s^a>^a^/^]", SI.archive_name ^= "", SI.entry, 2935 SI.dir, SI.entry); 2936 do Inotice = 1 to SI.Nnotices; 2937 do Itemplate = 1 to pnotice_paths.Ntemplates; 2938 if (SI.notice_info (Inotice).notice_name 2939 = 2940 before (pnotice_paths.templates (Itemplate).primary_name, 2941 ".pnotice")) 2942 then 2943 do; 2944 Lt = pnotice_paths.templates (Itemplate).Ltemplate; 2945 Pt = pnotice_paths.templates (Itemplate).Ptemplate; 2946 2947 if index (Pt -> template, "") = 0 2948 then call ioa_ ("^a^/", Pt -> template); 2949 else 2950 do; 2951 Iyr = index (Pt -> template, ""); 2952 dt = SI.notice_info (Inotice).notice_date; 2953 call print_template (Pt, Lt, Iyr, dt); 2954 end; 2955 Itemplate = pnotice_paths.Ntemplates; 2956 end; 2957 end; 2958 end; 2959 end; 2960 else 2961 do; /* SHORT OUTPUT */ 2962 do Idx1 = 1 to SI.Nnotices; 2963 pnames (Idx1) = SI.notice_info (Idx1).notice_name; 2964 end; 2965 call ioa_ ("^[^5x^a^2s^;^s^a>^a^/^]^(^40t^a^/^)", 2966 SI.archive_name ^= "", SI.entry, SI.dir, SI.entry, pnames); 2967 end; 2968 end report; 2969 2970 print_template: 2971 proc (Ppt, Plt, Pyr, Pdt); 2972 2973 dcl Ppt ptr, /* pointer to template */ 2974 Plt fixed bin (21), /* length of template */ 2975 Pyr fixed bin (24), /* position of in template */ 2976 Pdt char (4), /* source date */ 2977 store_template char (Plt), 2978 store_templateb 2979 char (Plt) based; 2980 2981 2982 2983 2984 /************************************************************************/ 2985 /* */ 2986 /* Procedure to print the template with the date in source */ 2987 /* */ 2988 /************************************************************************/ 2989 2990 store_template = Ppt -> store_templateb; 2991 substr (store_template, Pyr, 4) = Pdt; 2992 call ioa_ ("^a^/", store_template); 2993 return; 2994 2995 end print_template; 2996 2997 2998 2999 3000 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 3001 3002 3003 imbedded_notices: 3004 proc (SI) returns (bit (1)); 3005 3006 3007 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 3008 /* */ 3009 /* This procedure will check for 60 lines into the source looking for any imbedded */ 3010 /* protection notices. It is used by display_pnotice to provide a warning message about */ 3011 /* such notices. */ 3012 /* */ 3013 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 3014 3015 3016 dcl 1 SI aligned like source_info; 3017 dcl sub_seg char (Lsub) based (Psub), 3018 Iseg fixed bin, 3019 Lseg fixed bin (21), 3020 Lsub fixed bin (21), 3021 Pseg ptr, 3022 Psub ptr; 3023 3024 Pseg = SI.Pentry; 3025 Lseg = SI.Lentry; 3026 Psub = Pseg; 3027 Lsub = 0; 3028 call find_line$init (Pseg, Lseg); 3029 do Iseg = 1 to 60 while (find_line ()); 3030 /* for 60 lines */ 3031 Lsub = Lsub + length (line) + length (NL); 3032 end; 3033 if (index (sub_seg, "Copyright") = 0 & index (sub_seg, "PROPRIETARY") = 0 3034 & index (sub_seg, "PUBLIC") = 0) 3035 then return (False); 3036 else return (True); /* something hidden */ 3037 end imbedded_notices; 3038 3039 3040 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 3041 3042 clean_up: 3043 proc; 3044 3045 3046 if ^Farchive 3047 then 3048 do; /* this is a free standing segment. */ 3049 if source_info.Pentry ^= null 3050 then call terminate_file_ (source_info.Pentry, bit_count, 3051 TERM_FILE_TERM, code);/* terminate seg. Don't set bit count. */ 3052 end; 3053 else 3054 do; /* this was an archive */ 3055 if Pcomp_info ^= null 3056 then 3057 do; 3058 do Idx1 = 1 to comp_info.Ncomp; 3059 /* delete any component copies in pdir */ 3060 if comp_info.array (Idx1).ptr ^= null 3061 then 3062 do; 3063 call hcs_$delentry_seg (comp_info.array (Idx1).ptr, code); 3064 end; 3065 end; 3066 call release_temp_segment_ (ME, Pcomp_info, code); 3067 /* now release the component temp seg */ 3068 end; 3069 if source_info.archive_name ^= "" 3070 then call terminate_file_ (source_info.Parchive, bit_count, 3071 TERM_FILE_TERM, code); 3072 else if source_info.Pentry ^= null 3073 then call terminate_file_ (source_info.Pentry, bit_count, 3074 TERM_FILE_TERM, code);/* terminate the archive, don't set bit count */ 3075 end; 3076 3077 /* pnotice templates info */ 3078 if Ppaths ^= null 3079 then 3080 do; 3081 do Itemplate = 1 to dim (pnotice_paths.templates, 1); 3082 call terminate_file_ (pnotice_paths.templates (Itemplate).Ptemplate, 3083 pnotice_paths.templates (Itemplate).Ltemplate * 9, 3084 TERM_FILE_TERM, code); 3085 end; 3086 call release_temp_segment_ (ME, Ppaths, code); 3087 end; 3088 3089 3090 if Ptext ^= null then call release_temp_segment_ (ME, Ptext, code); 3091 /* notice text and star box */ 3092 3093 3094 end clean_up; 3095 3096 3097 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 3098 2 1 /* BEGIN INCLUDE FILE ... arg_list.incl.pl1 2 2* 2 3* James R. Davis 10 May 79 */ 2 4 2 5 2 6 2 7 /****^ HISTORY COMMENTS: 2 8* 1) change(86-05-15,DGHowe), approve(86-05-15,MCR7375), 2 9* audit(86-07-15,Schroth): 2 10* added command_name_arglist declaration to allow the storage of the 2 11* command name given to the command processor 2 12* END HISTORY COMMENTS */ 2 13 2 14 dcl 1 arg_list aligned based, 2 15 2 header, 2 16 3 arg_count fixed bin (17) unsigned unal, 2 17 3 pad1 bit (1) unal, 2 18 3 call_type fixed bin (18) unsigned unal, 2 19 3 desc_count fixed bin (17) unsigned unal, 2 20 3 pad2 bit (19) unal, 2 21 2 arg_ptrs (arg_list_arg_count refer (arg_list.arg_count)) ptr, 2 22 2 desc_ptrs (arg_list_arg_count refer (arg_list.arg_count)) ptr; 2 23 2 24 2 25 dcl 1 command_name_arglist aligned based, 2 26 2 header, 2 27 3 arg_count fixed bin (17) unsigned unal, 2 28 3 pad1 bit (1) unal, 2 29 3 call_type fixed bin (18) unsigned unal, 2 30 3 desc_count fixed bin (17) unsigned unal, 2 31 3 mbz bit(1) unal, 2 32 3 has_command_name bit(1) unal, 2 33 3 pad2 bit (17) unal, 2 34 2 arg_ptrs (arg_list_arg_count refer (command_name_arglist.arg_count)) ptr, 2 35 2 desc_ptrs (arg_list_arg_count refer (command_name_arglist.arg_count)) ptr, 2 36 2 name, 2 37 3 command_name_ptr pointer, 2 38 3 command_name_length fixed bin (21); 2 39 2 40 2 41 2 42 dcl 1 arg_list_with_envptr aligned based, /* used with non-quick int and entry-var calls */ 2 43 2 header, 2 44 3 arg_count fixed bin (17) unsigned unal, 2 45 3 pad1 bit (1) unal, 2 46 3 call_type fixed bin (18) unsigned unal, 2 47 3 desc_count fixed bin (17) unsigned unal, 2 48 3 pad2 bit (19) unal, 2 49 2 arg_ptrs (arg_list_arg_count refer (arg_list_with_envptr.arg_count)) ptr, 2 50 2 envptr ptr, 2 51 2 desc_ptrs (arg_list_arg_count refer (arg_list_with_envptr.arg_count)) ptr; 2 52 2 53 2 54 dcl ( 2 55 Quick_call_type init (0), 2 56 Interseg_call_type init (4), 2 57 Envptr_supplied_call_type 2 58 init (8) 2 59 ) fixed bin (18) unsigned unal int static options (constant); 2 60 2 61 /* The user must declare arg_list_arg_count - if an adjustable automatic structure 2 62* is being "liked" then arg_list_arg_count may be a parameter, in order to allocate 2 63* an argument list of the proper size in the user's stack 2 64* 2 65**/ 2 66 /* END INCLUDE FILE ... arg_list.incl.pl1 */ 3099 3100 dcl arg_list_arg_count 3101 fixed bin; 3102 dcl 1 al aligned based (Pal), 3103 /* argument list passed to cu_$generate_call */ 3104 2 header like arg_list.header, 3105 2 ap (0 refer (al.header.arg_count)) ptr, 3106 /* argument pointers */ 3107 2 dp (0 refer (al.header.desc_count)) ptr; 3108 /* descriptor pointers */ 3109 3 1 /* BEGIN INCLUDE FILE ... descriptor.incl.pl1 */ 3 2 3 3 dcl 1 desc_ aligned, 3 4 2 version2_ bit(1) unal, 3 5 2 type_ fixed bin(6) unsigned unal, 3 6 2 pack_ bit(1) unal, 3 7 2 dimension_ bit(4) unal, 3 8 2 scale_ fixed bin(11) unal, 3 9 2 precision_ fixed bin(11) unal; 3 10 3 11 /* END INCLUDE FILE ... descriptor.incl.pl1 */ 3110 3111 dcl 1 desc (comp_info.Ncomp + 2) aligned based (Pdesc) like desc_; 3112 3113 4 1 dcl ( s_fixed_real_desc init( 1), 4 2 d_fixed_real_desc init( 2), 4 3 s_float_real_desc init( 3), 4 4 d_float_real_desc init( 4), 4 5 s_fixed_cplx_desc init( 5), 4 6 d_fixed_cplx_desc init( 6), 4 7 s_float_cplx_desc init( 7), 4 8 d_float_cplx_desc init( 8), 4 9 4 10 D_fixed_real_desc init( 9), 4 11 D_float_real_desc init(10), 4 12 D_fixed_cplx_desc init(11), 4 13 D_float_cplx_desc init(12), 4 14 4 15 pointer_desc init(13), 4 16 offset_desc init(14), 4 17 label_desc init(15), 4 18 entry_desc init(16), 4 19 structure_desc init(17), 4 20 area_desc init(18), 4 21 4 22 bit_desc init(19), 4 23 v_bit_desc init(20), 4 24 4 25 char_desc init(21), 4 26 v_char_desc init(22), 4 27 4 28 file_desc init(23) 4 29 ) fixed bin int static options(constant); 3114 3115 5 1 /* START OF: pnotice_paths.incl.pl1 * * * * * * * * * * * * * * * * */ 5 2 5 3 5 4 5 5 /****^ HISTORY COMMENTS: 5 6* 1) change(86-01-28,LJAdams), approve(86-01-28,MCR7150), 5 7* audit(86-02-07,Wallman), install(86-02-13,MR12.0-1017): 5 8* Changed attributes of constants from automatic to internal static options 5 9* constant. Removed all initialization of automatic variables. 5 10* END HISTORY COMMENTS */ 5 11 5 12 5 13 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 14 /* */ 5 15 /* This include file defines the structure that the software protection tools fill in */ 5 16 /* with information on the proper search paths for notice templates, primary names of */ 5 17 /* these templates, their lengths, pointers to each, and whether or not they are the */ 5 18 /* default notice. There are only two defined default notices, one for copyright (named */ 5 19 /* "default.pnotice" as an add_name), and Trade Secret (named */ 5 20 /* "default_trade_secret.pnotice" as an add_name). */ 5 21 /* */ 5 22 /* Created: April 1981 by JM Stansbury */ 5 23 /* Modified: November 1981 by JM Stansbury */ 5 24 /* added Isearch_dir index to allow for >1 search path in search segment. */ 5 25 /* added Ifirst_template and Ilast_template to aid in sort for multiple directories */ 5 26 /* in the search list. */ 5 27 /* Modified: December 10, 1981 by JM Stansbury */ 5 28 /* added duplicate bit to provide list_pnotice_names with capability of flagging */ 5 29 /* and explaining same in its output. */ 5 30 /* Modified: December 7, 1982 by JM Stansbury */ 5 31 /* added type field to indicate whether a notice is copyright, trade secret or */ 5 32 /* public domain. */ 5 33 /* */ 5 34 /* */ 5 35 /* */ 5 36 /* */ 5 37 /* */ 5 38 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 39 5 40 5 41 dcl 1 pnotice_paths aligned based (Ppaths), 5 42 2 Ndirs fixed bin, /* no. of search dirs */ 5 43 2 Ntemplates fixed bin, /* no. of pnotice templates */ 5 44 2 dirs (0 refer (pnotice_paths.Ndirs)), 5 45 3 dir_path char (168) unal, 5 46 3 Ifirst_template fixed bin, /* index of first template in this dir */ 5 47 3 Ilast_template fixed bin, /* index of last template in this dir */ 5 48 2 templates (0 refer (pnotice_paths.Ntemplates)), 5 49 3 primary_name char (32), 5 50 3 Ptemplate ptr, /* ptr to each template */ 5 51 3 Ltemplate fixed bin, /* lgth of each template */ 5 52 3 type fixed bin, /* copyright, trade secret, and */ 5 53 /* public domain */ 5 54 3 Isearch_dir fixed bin, /* index of dir that this template is in */ 5 55 3 defaultC bit (1) unal, /* this bit is ON if the template is a default */ 5 56 /* copyright, i.e. "default.pnotice" */ 5 57 3 defaultTS bit (1) unal, /* this bit is ON if the template is a default */ 5 58 /* trade secret notice, */ 5 59 3 duplicate bit (1) unal, /* this bit is ON if an earlier template in the */ 5 60 /* search list had the same name, and thus */ 5 61 /* would be used instead of this one. */ 5 62 3 pad bit (33) unal; 5 63 5 64 5 65 dcl Ppaths ptr; 5 66 /* types */ 5 67 dcl UNDEFINED fixed bin int static options (constant) init (0); 5 68 dcl COPYRIGHT fixed bin int static options (constant) init (1); 5 69 dcl TRADE_SECRET fixed bin int static options (constant) init (2); 5 70 dcl PUBLIC_DOMAIN fixed bin int static options (constant) init (3); 5 71 5 72 /* END OF: pnotice_paths.incl.pl1 * * * * * * * * * * * * * * * * */ 3116 3117 6 1 /* START OF: pnotice_source_info.incl.pl1 * * * * * * * * * * * * * * * * */ 6 2 6 3 6 4 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 6 5 /* */ 6 6 /* This include file is used by the software protection tools. It describes information */ 6 7 /* that is needed from a source segment, and information needed to insert new notices */ 6 8 /* into the segment. */ 6 9 /* STATUS: */ 6 10 /* 0) Created August 1981 by JM Stansbury */ 6 11 /* 1) Modified December 1982 by JM Stansbury */ 6 12 /* added notice_type and notice_to_add.(name type). */ 6 13 /* */ 6 14 /* */ 6 15 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 6 16 6 17 6 18 /****^ HISTORY COMMENTS: 6 19* 1) change(85-09-27,LJAdams), approve(85-09-27,MCR7150), 6 20* audit(86-02-07,Wallman), install(86-02-13,MR12.0-1017): 6 21* added notice_date and seq to notice_info. 6 22* END HISTORY COMMENTS */ 6 23 6 24 6 25 dcl 1 source_info aligned, 6 26 2 version fixed bin, 6 27 2 archive_name char (32) unal, /* name of the archive if one being processed. */ 6 28 2 Parchive ptr, /* pointer to archive or null. */ 6 29 2 Larchive fixed bin (21), /* length of archive or zero. */ 6 30 2 dir char (168) unal, /* containing directory */ 6 31 2 entry char (32) unal, /* entry name of a source segment */ 6 32 2 Pentry ptr, /* pointer to the entry */ 6 33 2 Lentry fixed bin (21), /* length of the entry */ 6 34 2 type fixed bin, /* the language type of the entry */ 6 35 2 ec_version fixed bin, /* if type is 3 (an exec_com), this will be its version, */ 6 36 /* as obtained from calling get_ec_version_ */ 6 37 2 text_pos fixed bin (21), /* this will be the char pos of the first */ 6 38 /* non-version char in an exec_com. */ 6 39 2 cmt_bgn char (8) var, /* comment begin character(s) */ 6 40 2 cmt_end char (8) var, /* comment end character(s) */ 6 41 2 Pold_box ptr, /* pointer to beginning of existing star box */ 6 42 2 Lold_box fixed bin (21), /* length of the star box */ 6 43 2 notice_to_add, 6 44 3 name char (32) var, /* primary name */ 6 45 3 type fixed bin, /* copyright, trade_secret or public_domain */ 6 46 2 Nnotices fixed bin, /* number of notices in the segment */ 6 47 2 notice_info (10), 6 48 3 notice_name char (32) unal, /* primary name */ 6 49 3 notice_date char (4), 6 50 3 notice_type fixed bin, /* 1=copyright,2=trade secret, 3=public domain */ 6 51 3 seq fixed bin; 6 52 dcl V_source_info_1 fixed bin int static options (constant) init (1); 6 53 6 54 6 55 /* END OF: pnotice_source_info.incl.pl1 * * * * * * * * * * * * * * * * */ 3118 3119 7 1 /* START OF: pnotice_target_info.incl.pl1 * * * * * * * * * * * * * * * * */ 7 2 7 3 7 4 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 7 5 /* */ 7 6 /* This include file is used by the software protection tools. It describes a source */ 7 7 /* segment in terms of a target where a new comment box containing software protection */ 7 8 /* notices will be placed. */ 7 9 /* STATUS: */ 7 10 /* 0) Created August 1981 by JM Stansbury */ 7 11 /* */ 7 12 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 7 13 7 14 7 15 /****^ HISTORY COMMENTS: 7 16* 1) change(85-09-27,LJAdams), approve(85-09-27,MCR7150), 7 17* audit(86-02-07,Wallman), install(86-02-13,MR12.0-1017): 7 18* Added sort_field, date ,seq, and name to notice. 7 19* END HISTORY COMMENTS */ 7 20 7 21 7 22 dcl 1 target_info aligned, 7 23 2 version fixed bin, 7 24 2 long_output bit (1), /* used by display_pnotice to decide output format */ 7 25 2 archive_name char (32) unal, /* name of an archive, if one being processed. */ 7 26 2 Parchive ptr, /* pointer to archive, or null. */ 7 27 2 Larchive fixed bin (21), /* length of archive or zero. */ 7 28 2 dir char (168) unal, /* containing directory */ 7 29 2 entry char (32) unal, /* name of the source segment */ 7 30 2 Pentry ptr, /* pointer to the source segment */ 7 31 2 Lentry fixed bin (21), /* length of the source segment, */ 7 32 /* including the new comment box */ 7 33 2 Pnew_box ptr, /* pointer to beginning of the new comment box */ 7 34 2 Lnew_box fixed bin (21), /* length of new comment box */ 7 35 2 Pstar_box ptr, /* pointer to temporary box */ 7 36 2 Lstar_box fixed bin (21), /* length of the temporary box */ 7 37 2 Nnotices fixed bin, /* number of notices going into target segment */ 7 38 2 notice (10), 7 39 3 sort_field unal, 7 40 4 date char (4), 7 41 4 seq char (2), 7 42 3 name char (32) unal; 7 43 dcl V_target_info_1 fixed bin int static options (constant) init (1); 7 44 7 45 7 46 /* END OF: pnotice_target_info.incl.pl1 * * * * * * * * * * * * * * * * */ 3121 8 1 /* BEGIN INCLUDE FILE ... terminate_file.incl.pl1 */ 8 2 /* format: style2,^inddcls,idind32 */ 8 3 8 4 declare 1 terminate_file_switches based, 8 5 2 truncate bit (1) unaligned, 8 6 2 set_bc bit (1) unaligned, 8 7 2 terminate bit (1) unaligned, 8 8 2 force_write bit (1) unaligned, 8 9 2 delete bit (1) unaligned; 8 10 8 11 declare TERM_FILE_TRUNC bit (1) internal static options (constant) initial ("1"b); 8 12 declare TERM_FILE_BC bit (2) internal static options (constant) initial ("01"b); 8 13 declare TERM_FILE_TRUNC_BC bit (2) internal static options (constant) initial ("11"b); 8 14 declare TERM_FILE_TERM bit (3) internal static options (constant) initial ("001"b); 8 15 declare TERM_FILE_TRUNC_BC_TERM bit (3) internal static options (constant) initial ("111"b); 8 16 declare TERM_FILE_FORCE_WRITE bit (4) internal static options (constant) initial ("0001"b); 8 17 declare TERM_FILE_DELETE bit (5) internal static options (constant) initial ("00001"b); 8 18 8 19 /* END INCLUDE FILE ... terminate_file.incl.pl1 */ 3122 3123 3124 end add_pnotice; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 12/01/87 0913.1 add_pnotice.pl1 >spec>install>1007>add_pnotice.pl1 1098 1 02/13/86 1340.2 pnotice_language_info_.incl.pl1 >ldd>include>pnotice_language_info_.incl.pl1 3099 2 08/05/86 0856.8 arg_list.incl.pl1 >ldd>include>arg_list.incl.pl1 3110 3 11/30/78 1227.5 descriptor.incl.pl1 >ldd>include>descriptor.incl.pl1 3114 4 01/12/79 1059.7 desc_types.incl.pl1 >ldd>include>desc_types.incl.pl1 3116 5 02/13/86 1340.2 pnotice_paths.incl.pl1 >ldd>include>pnotice_paths.incl.pl1 3118 6 02/13/86 1340.2 pnotice_source_info.incl.pl1 >ldd>include>pnotice_source_info.incl.pl1 3120 7 02/13/86 1340.2 pnotice_target_info.incl.pl1 >ldd>include>pnotice_target_info.incl.pl1 3122 8 04/06/83 1239.4 terminate_file.incl.pl1 >ldd>include>terminate_file.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. Acode 000100 automatic fixed bin(35,0) dcl 2656 in procedure "check_acl" set ref 2695* 2703 2706 2715* 2716 2719* 2744* 2748* 2757* 2758 2758* Acode 000100 automatic fixed bin(35,0) dcl 1095 in procedure "get_language_info" set ref 1116* 1120* 1125* 1132* 1135* 1140* 1152* 1153* 1175* 1177 1180* Acode 000103 automatic fixed bin(35,0) dcl 2013 in procedure "continue_processing" set ref 2026* 2072* 2073* 2077* 2085* 2086* 2090* 2098* 2099* 2103* 2118* 2119* 2123* 2132* 2133* 2137* 2145* 2146* 2152* Acode 000100 automatic fixed bin(35,0) dcl 781 in procedure "process_archive_components" set ref 795* 796 799* 814* 817 820* 853* 856 859* 894* 897 900* 932* 935 938* Acode 000172 automatic fixed bin(35,0) dcl 1272 in procedure "pnotice_parse" set ref 1678* 1680 1683* 1867* 1868 1871* Adate 10 000260 automatic char(4) level 2 dcl 1955 set ref 1965* 1967* Adir parameter char unaligned dcl 2651 set ref 2638 2680* 2695* 2715* 2719* 2725* 2733 2744* 2748* 2757* 2758* Aentry parameter char unaligned dcl 2651 set ref 2638 2680* 2695* 2715* 2719* 2725* 2733 2744* 2748* 2757* 2758* Alength parameter fixed bin(21,0) dcl 2623 ref 2620 2627 2628 Amode_set parameter bit(1) unaligned dcl 2651 set ref 2696* 2709* 2733 2738 Amust_reset parameter bit(1) unaligned dcl 2651 set ref 2638 2677* 2723* Aname 000260 automatic char(32) level 2 dcl 1955 set ref 1962* Aptr parameter pointer dcl 2651 in procedure "check_acl" ref 2638 2686 2686 2733 Aptr parameter pointer dcl 2593 in procedure "add_text" ref 2591 2595 Aseq 12 000260 automatic fixed bin(17,0) level 2 dcl 1955 set ref 1970* Astring parameter char unaligned dcl 2623 ref 2620 2628 Atype 11 000260 automatic fixed bin(17,0) level 2 dcl 1955 set ref 1968* COMPONENT based char unaligned dcl 782 set ref 863* 863 942* 942 COPYRIGHT constant fixed bin(17,0) initial dcl 5-68 ref 557 576 DFcopy_right 000102 automatic bit(1) unaligned dcl 125 set ref 379* 469 577 729* 2038 DFtrade_secret 000103 automatic bit(1) unaligned dcl 125 set ref 376* 446 461 501 537 730* 2038 False 025552 constant bit(1) initial unaligned dcl 234 ref 304 325 326 329 422 727 728 729 730 731 732 733 734 735 736 787 788 1025 1026 1103 1128 1279 1372 1374 1413 1419 1425 1464 1465 1471 1473 1499 1501 1568 1570 1574 1606 1640 1641 1665 1733 1755 1895 2027 2028 2029 2030 2031 2032 2046 2080 2093 2106 2126 2140 2156 2188 2234 2349 2372 2380 2677 2696 2795 3033 Farchive 000104 automatic bit(1) unaligned dcl 125 set ref 325* 631* 633* 648 3046 Fcopy_right 000106 automatic bit(1) unaligned dcl 125 set ref 728* 2038 Fdisplay 000105 automatic bit(1) unaligned dcl 125 set ref 304* 314* 372 373 376 379 381 432 496 662 784 839 918 962 1041 Fmode_set 000107 automatic bit(1) unaligned dcl 125 set ref 788* 791* 1009* 1026* 1029* 1055* Fmust_reset 000110 automatic bit(1) unaligned dcl 125 set ref 787* 791 1004* 1009 1025* 1029 1050* 1055 Fname 000111 automatic bit(1) unaligned dcl 125 set ref 411* 417* 439 446 454 469 501 537 537 537 727* 2038 2192 Fpublic_domain 000112 automatic bit(1) unaligned dcl 125 set ref 373* 406* 454 461 519 537 734* 2038 2161 Ftrade_secret 000113 automatic bit(1) unaligned dcl 125 set ref 372* 410* 439 461 501 537 555 735* 2038 2161 2192 HBull_name_array 000012 constant varying char(80) initial array dcl 2329 ref 2364 2364 2368 HT_SP_NL 000172 constant char(3) initial unaligned dcl 234 ref 1688 1908 HT_SP_NL_VT_NP 000166 constant char(5) initial unaligned dcl 234 ref 1285 1346 1416 1454 1653 HT_SP_STAR 000173 constant char(3) initial unaligned dcl 234 ref 1530 1533 Iarg 000115 automatic fixed bin(17,0) dcl 125 set ref 354* 355* 384* 384 385* Ibreak 000141 automatic fixed bin(21,0) dcl 1259 set ref 1793* 1794 1794* 1795 1799 1805 1806 1922* 1923 1931 1932 1933 Icmt 000103 automatic fixed bin(21,0) dcl 1217 set ref 1285* 1289 1294 1295 1310* 1346* 1350 1354 1358 1359 1416* 1417 1418 1454* 1455 1458 1459 1485 1653* 1654 1657 1658 Idate 000141 automatic fixed bin(17,0) dcl 2422 set ref 2466* 2467* 2468 2468 Idx1 000100 automatic fixed bin(17,0) dcl 2266 in procedure "sort_pnotices" set ref 2274* 2275 2275* 2284* 2285* Idx1 000116 automatic fixed bin(24,0) dcl 125 in procedure "add_pnotice" set ref 993* 994 994* 997* 999 999 1000 1000 1001 1001* 2342* 2345 2352 2352* 2356* 2358 2359 2364 2368 2380* 2962* 2963 2963* 3058* 3060 3063* Idx1 000101 automatic fixed bin(17,0) dcl 2013 in procedure "continue_processing" set ref 2063* 2064 2065* 2111* 2111* 2115 2166* 2166 2166 2166* 2173 2202* 2203 2204 2204* 2214* 2215 2220 2221 2222* 2229* 2229 2229 2229 2229 2229* 2234 Idx2 000156 automatic fixed bin(17,0) dcl 2333 in procedure "ok_nine_year_rule" set ref 2364* 2368* Idx2 000102 automatic fixed bin(17,0) dcl 2013 in procedure "continue_processing" set ref 2203* 2204 2204 2204* Idx2 000101 automatic fixed bin(17,0) dcl 2266 in procedure "sort_pnotices" set ref 2283* 2285 2286* 2286 2288* 2288* 2289* Ilang 000101 automatic fixed bin(17,0) dcl 1095 set ref 1108* 1108* 1113 1147 1159 1161 Iline 000100 automatic fixed bin(24,0) dcl 1753 set ref 1757* 1758 1758 1768 1769 1770 Iname 000100 automatic fixed bin(17,0) dcl 2013 set ref 2033* Inconsistent_args 000010 internal static varying char(132) initial dcl 234 set ref 443* 450* 458* 473* Inl 000206 automatic fixed bin(21,0) dcl 1452 set ref 1470* 1471 Inonwhite 000142 automatic fixed bin(21,0) dcl 1259 set ref 1782* 1784 1785 1788 1789 1908* 1910 1913 1916 1917 Inotice 000100 automatic fixed bin(17,0) dcl 2908 in procedure "report" set ref 2936* 2938 2952* Inotice 000142 automatic fixed bin(17,0) dcl 2422 in procedure "make_star_box" set ref 2450* 2453 2468 2471* Interseg_call_type constant fixed bin(18,0) initial unsigned unaligned dcl 2-54 ref 975 Iseg 000126 automatic fixed bin(17,0) dcl 3017 set ref 3029* Iskip 000143 automatic fixed bin(21,0) dcl 1259 set ref 1808* 1810 1813 1814 1934* 1936 1939 1940 Itemplate 000117 automatic fixed bin(24,0) dcl 125 in procedure "add_pnotice" set ref 504* 504* 507 514 522* 522* 525 532 541* 541* 547 561* 561* 564 573 2451* 2453 2459 2460* 3081* 3082 3082* Itemplate 000101 automatic fixed bin(17,0) dcl 2908 in procedure "report" set ref 2937* 2938 2944 2945 2955* Iyr 000102 automatic fixed bin(24,0) dcl 2911 set ref 2951* 2953* Larchive 14 000710 automatic fixed bin(21,0) level 2 in structure "source_info" dcl 6-25 in procedure "add_pnotice" set ref 658* 671* Larchive 14 001220 automatic fixed bin(21,0) level 2 in structure "target_info" dcl 7-22 in procedure "add_pnotice" set ref 661* 674* Larg 000120 automatic fixed bin(21,0) dcl 125 set ref 355* 356 359 363 363 368 368 372 373 376 376 379 379 381 381 385* 395 398 406 407 412 416 420 420 422 422 Lcomment 000116 automatic fixed bin(21,0) dcl 1229 set ref 1313 1313 1313 1313 1324* 1334 1370* 1374 1378 1378 1378 1378 1378 1387 1389 1390 1392* 1392 1409* 1431* 1432 1436 1478* 1483* 1485* 1485 1488 1489 1498 1501 1535 1593* 1610 1614 1618 1619* 1624* 1624 1650 1653 1658* 1658 1660* Lcomment_line 000122 automatic fixed bin(21,0) dcl 1229 set ref 1389* 1390 1390* 1391 1392 1393 1394 1394 1614* 1615 1618* 1623 1624 1626 1626 1644 Lcomp 000632 automatic fixed bin(21,0) dcl 754 set ref 835* 836 837 851 863 863 914* 915 916 930 942 942 Lentry 102 parameter fixed bin(21,0) level 2 in structure "SI" dcl 3016 in procedure "imbedded_notices" ref 3025 Lentry 102 parameter fixed bin(21,0) level 2 in structure "TI" dcl 777 in procedure "process_archive_components" set ref 837* 916* Lentry 102 001220 automatic fixed bin(21,0) level 2 in structure "target_info" dcl 7-22 in procedure "add_pnotice" set ref 677* Lentry 102 000710 automatic fixed bin(21,0) level 2 in structure "source_info" dcl 6-25 in procedure "add_pnotice" set ref 646* 658 661 677 Lentry 102 parameter fixed bin(21,0) level 2 in structure "SI" dcl 777 in procedure "process_archive_components" set ref 836* 915* Lentry 102 parameter fixed bin(21,0) level 2 in structure "SI" dcl 2848 in procedure "insert_notice" ref 2861 2861 2865 2865 2871 Lentry 102 parameter fixed bin(21,0) level 2 in structure "SI" dcl 1213 in procedure "pnotice_parse" ref 1278 Lentry 102 parameter fixed bin(21,0) level 2 in structure "TI" dcl 2848 in procedure "insert_notice" set ref 2871* 2878 Lline 000670 automatic fixed bin(21,0) dcl 2771 set ref 2500 2528 2528 2529 2561 2561 2562 2800* 2801 2802 2803* 2803 3031 Lmax_line 000657 automatic fixed bin(21,0) dcl 2395 set ref 2498* 2500* 2500 2515 2519 2529 2533 2549 2553 2562 2567 Lmove 000660 automatic fixed bin(21,0) dcl 2395 set ref 2431* 2459* 2460 2460 2463 2463 2467 2468 2470 2474 2477 Lnew_box 106 001220 automatic fixed bin(21,0) level 2 in structure "target_info" dcl 7-22 in procedure "add_pnotice" set ref 2873 Lnew_box 106 parameter fixed bin(21,0) level 2 in structure "TI" dcl 777 in procedure "process_archive_components" set ref 875* 950* Lnew_box 106 parameter fixed bin(21,0) level 2 in structure "TI" dcl 2848 in procedure "insert_notice" ref 2858 2861 2865 2871 Lnew_box 106 parameter fixed bin(21,0) level 2 in structure "TI" dcl 1022 in procedure "process_single_seg" set ref 1053* Lold_box 116 parameter fixed bin(21,0) level 2 in structure "SI" dcl 1213 in procedure "pnotice_parse" set ref 1276* 1334* 1436* Lold_box 116 parameter fixed bin(21,0) level 2 in structure "SI" dcl 693 in procedure "init_structures" set ref 709* Lold_box 116 parameter fixed bin(21,0) level 2 in structure "SI" dcl 2848 in procedure "insert_notice" ref 2857 2861 2861 2861 2865 2865 2865 2871 Lold_text 000154 automatic fixed bin(21,0) dcl 2587 set ref 2604* 2606 2615* 2617 2626* 2628 Lpnotice 000126 automatic fixed bin(21,0) dcl 1237 set ref 1608* 1644* 1644 1647 1729 1729* 1733 1755 1757 1758 1762 1763* 1770* 1770 Lpnotice_line 000132 automatic fixed bin(21,0) dcl 1237 set ref 1736 1762* 1768* 1781 Lrest 000102 automatic fixed bin(21,0) dcl 1217 set ref 1278* 1285 1295* 1295 1298 1301 1301 1304 1344* 1344 1346 1354 1359* 1359 1361 1370 1408* 1408 1416 1418* 1418 1419 1419 1419 1454 1459* 1459 1464 1465 1470 1473 1478 1483 1489* 1489 Lsave 000661 automatic fixed bin(21,0) dcl 2395 set ref 2477* 2478 Lseg 000127 automatic fixed bin(21,0) dcl 3017 set ref 3025* 3028* Lstar_box 112 parameter fixed bin(21,0) level 2 in structure "TI" dcl 2418 in procedure "make_star_box" set ref 2506* Lstar_box 112 based fixed bin(21,0) level 2 in structure "TI" dcl 2589 in procedure "add_text" set ref 2604 2605* 2605 2615 2616* 2616 2626 2627* 2627 Lstar_box 112 001220 automatic fixed bin(21,0) level 2 in structure "target_info" dcl 7-22 in procedure "add_pnotice" set ref 2606 2617 2628 2873 Lstar_box 112 parameter fixed bin(21,0) level 2 in structure "TI" dcl 1022 in procedure "process_single_seg" set ref 1053 Lstar_box 112 parameter fixed bin(21,0) level 2 in structure "TI" dcl 777 in procedure "process_archive_components" set ref 875 950 Lstr parameter fixed bin(21,0) dcl 2812 ref 2810 2815 Lsub 000130 automatic fixed bin(21,0) dcl 3017 set ref 3027* 3031* 3031 3033 3033 3033 Lt 000676 automatic fixed bin(21,0) dcl 2888 set ref 2944* 2947 2947 2947 2951 2953* Ltemp 000671 automatic fixed bin(21,0) dcl 2771 set ref 2795 2800 2802* 2802 2815* 2821 Ltemplate based fixed bin(17,0) array level 3 dcl 5-41 ref 1889 2459 2944 3082 Ltext 000662 automatic fixed bin(21,0) dcl 2395 set ref 2430* 2470* 2470 2474 2497* 2523* 2557* Ltline 000173 automatic fixed bin(21,0) dcl 1847 set ref 1889* 1905 1908 Lword_text 000144 automatic fixed bin(21,0) dcl 1259 set ref 1781* 1782 1784* 1789* 1789 1792 1793 1794 1799 1806* 1806 1808 1814* 1814 1816* 1905* 1910* 1917* 1917 1920 1922 1926 1926 1927* 1931 1933* 1933 1934 1940* 1940 1942* ME 000121 automatic char(32) unaligned dcl 125 set ref 303* 313* 343* 349* 349* 363* 389* 427* 443* 450* 458* 465* 473* 481* 489* 511* 529* 551* 568* 591* 599* 604* 614* 626* 642* 795* 799* 820* 859* 900* 910* 938* 1036* 1120* 1125* 1132* 1135* 1140* 1153* 1170* 1180* 1329* 1439* 1443* 1580* 1585* 1678* 1683* 1867* 1871* 2042* 2073* 2077* 2086* 2090* 2099* 2103* 2119* 2123* 2133* 2137* 2146* 2152* 2435* 2440* 2487* 2492* 2680* 2719* 2725* 2748* 2758* 3066* 3086* 3090* N based fixed bin(17,0) level 3 in structure "pnotice_language_info" dcl 1-43 in procedure "get_language_info" ref 1108 1113 N 000100 automatic fixed bin(18,0) level 2 in structure "V" dcl 2260 in procedure "sort_pnotices" set ref 2273* 2284 NL 000171 constant char(1) initial unaligned dcl 234 set ref 1389 1470 1498 1614 1757 1889 1906 2463 2516* 2521* 2539* 2550* 2555* 2568* 2800 3031 NL_NL 000170 constant char(2) initial unaligned dcl 234 set ref 2536* Nargs 000131 automatic fixed bin(17,0) dcl 125 set ref 339* 346 354 Ncomp based fixed bin(17,0) level 2 dcl 745 set ref 803* 850* 850 851 852 853 853 859 863 866 929* 929 930 931 932 932 938 942 945 966 971 973 976 981 982 983 984 985 986 988 993 997 3058 Ndirs based fixed bin(17,0) level 2 dcl 5-41 ref 504 514 522 532 541 561 573 1888 1889 1962 1968 2453 2459 2460 2938 2944 2945 3081 3082 3082 Nnotices 131 parameter fixed bin(17,0) level 2 in structure "SI" dcl 2418 in procedure "make_star_box" ref 2536 Nnotices 131 parameter fixed bin(17,0) level 2 in structure "SI" dcl 2906 in procedure "report" set ref 2910 2914 2936 2962 Nnotices 113 parameter fixed bin(17,0) level 2 in structure "TI" dcl 2264 in procedure "sort_pnotices" ref 2273 2274 Nnotices 131 parameter fixed bin(17,0) level 2 in structure "SI" dcl 1213 in procedure "pnotice_parse" set ref 1699* 1699 1700 1713 1713 1713 1713 Nnotices 131 parameter fixed bin(17,0) level 2 in structure "SI" dcl 2007 in procedure "continue_processing" set ref 2035 2063 2111 2115 2166 2173 2202 2203 2214 Nnotices 113 parameter fixed bin(17,0) level 2 in structure "TI" dcl 2007 in procedure "continue_processing" set ref 2049* 2050 2051 2053 2160* 2176* 2195* 2218* 2218 2220 2221 2222 2228 Nnotices 113 parameter fixed bin(17,0) level 2 in structure "TI" dcl 2418 in procedure "make_star_box" set ref 2450 2484 2487* 2492* Nnotices 131 parameter fixed bin(17,0) level 2 in structure "SI" dcl 693 in procedure "init_structures" set ref 710* Nnotices 131 parameter fixed bin(17,0) level 2 in structure "SI" dcl 2317 in procedure "ok_nine_year_rule" ref 2342 2356 Nnotices_in_box 000143 automatic fixed bin(17,0) dcl 2422 set ref 2429* 2479* 2479 2484 2487* 2492* Not_found 000052 internal static varying char(132) initial dcl 234 set ref 511* 529* 551* 568* Ntemplates 1 based fixed bin(17,0) level 2 dcl 5-41 ref 504 507 522 525 541 547 561 564 1885 2451 2937 2955 3081 Ntemplates_parsed 000140 automatic fixed bin(17,0) dcl 1256 set ref 1540* 1883* 1883 1885 1888 1889 1962 1968 Nwords based fixed bin(24,0) level 2 dcl 1245 set ref 1547 1552 1570 1727* 1739 1798* 1798 1799 1800 1800 1826 1826 1832 PUBLIC_DOMAIN constant fixed bin(17,0) initial dcl 5-70 ref 522 535 2061 2065 Pal 000634 automatic pointer dcl 754 set ref 971* 973 974 975 976 977 979 979 1000 1001 1006* Parchive 12 parameter pointer level 2 in structure "TI" dcl 777 in procedure "process_archive_components" set ref 1004* 1009* Parchive 12 000710 automatic pointer level 2 in structure "source_info" dcl 6-25 in procedure "add_pnotice" set ref 657* 670* 3069* Parchive 12 parameter pointer level 2 in structure "SI" dcl 777 in procedure "process_archive_components" set ref 814* 894* Parchive 12 001220 automatic pointer level 2 in structure "target_info" dcl 7-22 in procedure "add_pnotice" set ref 660* 673* Parchive_paths 000636 automatic pointer dcl 754 set ref 988* 990 991 994 999 1000 Parg 000132 automatic pointer dcl 125 set ref 355* 356 359 363 368 368 372 373 376 376 379 379 381 381 385* 395 398 406 407 412 416 420 420 422 422 Pcomment 000114 automatic pointer dcl 1229 set ref 1313 1313 1313 1323* 1369* 1374 1378 1378 1378 1378 1378 1388 1389 1391* 1391 1430* 1431 1462* 1498 1501 1609 1613 1614 1623* 1623 1653 1657* 1657 Pcomment_line 000120 automatic pointer dcl 1229 set ref 1388* 1394 1613* 1626 1635 Pcomp 000642 automatic pointer dcl 754 set ref 813* 814* 825 829 831 863 894* 904 906 942 Pcomp_info 000640 automatic pointer dcl 754 set ref 322* 795* 803 850 850 851 851 852 852 853 853 853 853 859 859 863 863 866 866 929 929 930 930 931 931 932 932 932 932 938 938 942 942 945 945 966 971 971 973 976 981 982 983 984 985 986 988 993 994 997 3055 3058 3060 3063 3066* Pdesc 000644 automatic pointer dcl 754 set ref 979* 981 982 983 984 985 986 988 988 999 1001 Pdt parameter char(4) unaligned dcl 2973 ref 2970 2991 Pentry 100 parameter pointer level 2 in structure "SI" dcl 3016 in procedure "imbedded_notices" ref 3024 Pentry 100 parameter pointer level 2 in structure "TI" dcl 777 in procedure "process_archive_components" set ref 791* 831* 866* 868* 906* 945* 947* Pentry 100 parameter pointer level 2 in structure "SI" dcl 693 in procedure "init_structures" set ref 703* Pentry 100 parameter pointer level 2 in structure "SI" dcl 777 in procedure "process_archive_components" set ref 829* 868* 904* 947* Pentry 100 001220 automatic pointer level 2 in structure "target_info" dcl 7-22 in procedure "add_pnotice" set ref 676* Pentry 100 parameter pointer level 2 in structure "SI" dcl 1213 in procedure "pnotice_parse" ref 1275 1277 Pentry 100 parameter pointer level 2 in structure "TI" dcl 2848 in procedure "insert_notice" set ref 2878* Pentry 100 000710 automatic pointer level 2 in structure "source_info" dcl 6-25 in procedure "add_pnotice" set ref 636* 639 657 660 676 3049 3049* 3072 3072* Pentry 100 parameter pointer level 2 in structure "TI" dcl 1022 in procedure "process_single_seg" set ref 1029* 1050* 1055* Pline 000672 automatic pointer dcl 2771 set ref 2500 2528 2529 2561 2562 2799* 3031 Plt parameter fixed bin(21,0) dcl 2973 ref 2970 2973 2990 Pnew_box 104 001220 automatic pointer level 2 in structure "target_info" dcl 7-22 in procedure "add_pnotice" set ref 2873 Pnew_box 104 parameter pointer level 2 in structure "TI" dcl 2848 in procedure "insert_notice" ref 2857 2858 Pnew_box 104 parameter pointer level 2 in structure "TI" dcl 777 in procedure "process_archive_components" set ref 868* 947* Pnew_box 104 parameter pointer level 2 in structure "TI" dcl 1022 in procedure "process_single_seg" set ref 1052* Pold_box 114 parameter pointer level 2 in structure "SI" dcl 1213 in procedure "pnotice_parse" set ref 1275* 1345* Pold_box 114 parameter pointer level 2 in structure "SI" dcl 693 in procedure "init_structures" set ref 708* Pold_box 114 parameter pointer level 2 in structure "SI" dcl 777 in procedure "process_archive_components" set ref 868* 947* Pold_box 114 parameter pointer level 2 in structure "SI" dcl 1022 in procedure "process_single_seg" set ref 1052 Ppaths 000706 automatic pointer dcl 5-65 set ref 321* 489* 504 504 507 514 522 522 525 532 541 541 547 561 561 564 573 1885 1888 1889 1962 1968 2451 2453 2459 2460 2937 2938 2944 2945 2955 3078 3081 3082 3082 3086* Ppnotice 000124 automatic pointer dcl 1237 set ref 1607* 1635* 1644 1729 1755 1757 1761 1762 1767 1769* 1769 Ppnotice_line 000130 automatic pointer dcl 1237 set ref 1736 1761* 1767* 1780 Ppnotices 000134 automatic pointer dcl 1245 set ref 1443 1443* 1547 1552 1553 1554 1554 1558 1558 1558 1570 1678* 1727 1739 1798 1798 1799 1799 1800 1800 1800 1800 1826 1826 1826 1826 1832 1832 Ppt parameter pointer dcl 2973 ref 2970 2990 Prest 000100 automatic pointer dcl 1217 set ref 1277* 1285 1294* 1294 1298 1301 1301 1304 1309 1341* 1341 1345 1346 1354 1358* 1358 1361 1366 1369 1406* 1406 1413 1416 1417* 1417 1419 1419 1431 1454 1458* 1458 1462 1464 1465 1470 1473 1478 1483 1488* 1488 Psave 000664 automatic pointer dcl 2395 set ref 2448* 2460 2463 2467 2468 2474 2478* 2478 2504 Pseg 000132 automatic pointer dcl 3017 set ref 3024* 3026 3028* Psource 000100 automatic pointer dcl 2854 set ref 2857* 2861* 2865* Pstar_box 110 001220 automatic pointer level 2 in structure "target_info" dcl 7-22 in procedure "add_pnotice" set ref 2606 2617 2628 2873 Pstar_box 110 parameter pointer level 2 in structure "TI" dcl 2418 in procedure "make_star_box" set ref 2504* Pstr parameter pointer dcl 2812 ref 2810 2814 Psub 000134 automatic pointer dcl 3017 set ref 3026* 3033 3033 3033 Pt 000700 automatic pointer dcl 2888 set ref 2945* 2947 2947 2951 2953* Ptarget 000102 automatic pointer dcl 2854 set ref 2858* 2861* 2865* Ptemp 000674 automatic pointer dcl 2771 set ref 2799 2800 2801* 2801 2814* Ptemplate based pointer array level 3 in structure "pnotice_paths" dcl 5-41 in procedure "add_pnotice" set ref 1888 2460 2945 3082* Ptemplate 000136 automatic pointer dcl 1251 in procedure "pnotice_parse" set ref 1439 1439* 1547 1553 1554 1558 1867* 1903 1921 1921 1926 1926 1931 1931 Ptext 000666 automatic pointer dcl 2395 set ref 323* 2432 2435* 2445* 2445 2448 2497* 2523* 2557* 3090 3090* Ptline 000174 automatic pointer dcl 1847 set ref 1888* 1904 1908 Pword_text 000146 automatic pointer dcl 1259 set ref 1780* 1782 1788* 1788 1789 1793 1794 1799 1805* 1805 1806 1808 1813* 1813 1814 1904* 1916* 1916 1917 1922 1926 1926 1931 1932* 1932 1933 1934 1939* 1939 1940 Pyr parameter fixed bin(24,0) dcl 2973 ref 2970 2991 SI parameter structure level 1 dcl 2848 in procedure "insert_notice" ref 2834 SI parameter structure level 1 dcl 2906 in procedure "report" set ref 2894 2917* SI parameter structure level 1 dcl 1022 in procedure "process_single_seg" set ref 1020 1033* 1040* 1044* 1048* 1049* 1054* SI parameter structure level 1 dcl 2317 in procedure "ok_nine_year_rule" ref 2301 SI parameter structure level 1 dcl 777 in procedure "process_archive_components" set ref 764 832* 838* 842* 846* 865* 876* 889* 907* 917* 921* 925* 944* 951* SI parameter structure level 1 dcl 2007 in procedure "continue_processing" set ref 1986 2161* SI parameter structure level 1 dcl 1093 in procedure "get_language_info" set ref 1078 SI parameter structure level 1 dcl 3016 in procedure "imbedded_notices" ref 3003 SI parameter structure level 1 dcl 693 in procedure "init_structures" set ref 690 700 SI parameter structure level 1 dcl 1213 in procedure "pnotice_parse" set ref 1199 SI parameter structure level 1 dcl 2418 in procedure "make_star_box" set ref 2407 SI_yrno 000570 automatic fixed bin(24,0) dcl 125 set ref 1676* 1831* 1831 1832 1833 1833 1833 1965 1965 SKIP_CHRS 000161 automatic varying char(30) dcl 1269 set ref 1688* 1729 1736 SP 000264 constant char(1) initial unaligned dcl 234 set ref 1186 2514* 2517 2525 2527* 2532 2534* 2548* 2566* SPACES 025406 constant char(200) initial unaligned dcl 234 set ref 2517* 2519* 2525* 2529* 2532* 2553* 2562* SP_STAR 000175 constant char(2) initial unaligned dcl 234 set ref 2552* SP_STAR_SP 000174 constant char(3) initial unaligned dcl 234 set ref 2560* STAR 000176 constant char(1) initial unaligned dcl 234 set ref 1688 2518* 2520* 2526* 2554* STARS 025470 constant char(200) initial unaligned dcl 234 set ref 2515* 2533* 2549* 2567* Sadd_default_pnotice 000571 automatic bit(1) unaligned dcl 125 set ref 731* 2188 2349* 2350 2368* 2372* 2374 Scontinue 000224 automatic bit(1) unaligned dcl 1523 set ref 1541* 1542 1570* 1574* Sdfcopyright 000572 automatic bit(1) unaligned dcl 125 set ref 578* 732* 1061 1065 2054 2183 Sfound 000225 automatic bit(1) unaligned dcl 1523 set ref 1551* 1552 1568* 1570 Sno_args_given 000573 automatic bit(1) unaligned dcl 125 set ref 577* 733* 2188 2342 2361 Snomatch 000226 automatic bit(1) unaligned dcl 1523 set ref 1541* 1570* 1577 Sold_style_pnotice 000574 automatic bit(1) unaligned dcl 125 set ref 1279* 1301* 1304 1464 1465 1478 Spnotice 000112 automatic bit(1) unaligned dcl 1217 set ref 1365* 1368 1374* 1413* 1419* 1425* 1605* 1612 1641* Sprt_notice 000575 automatic bit(1) unaligned dcl 125 set ref 326* 1065 2054* 2183* Sstar_line 000113 automatic bit(1) unaligned dcl 1217 set ref 1372* 1402 1402* 1606* 1632 1636* 1640* TERM_FILE_TERM 000163 constant bit(3) initial unaligned dcl 8-14 set ref 3049* 3069* 3072* 3082* TERM_FILE_TRUNC_BC 000164 constant bit(2) initial unaligned dcl 8-13 set ref 2878* TI parameter structure level 1 dcl 2007 in procedure "continue_processing" set ref 1986 2228* TI parameter structure level 1 dcl 2418 in procedure "make_star_box" set ref 2407 2507 2507 TI parameter structure level 1 dcl 1022 in procedure "process_single_seg" set ref 1020 1044* 1048* 1049* 1054* TI parameter structure level 1 dcl 2264 in procedure "sort_pnotices" set ref 2245 TI parameter structure level 1 dcl 2907 in procedure "report" ref 2894 TI parameter structure level 1 dcl 693 in procedure "init_structures" set ref 690 700 TI based structure level 1 dcl 2589 in procedure "add_text" TI parameter structure level 1 dcl 777 in procedure "process_archive_components" set ref 764 842* 846* 865* 876* 889* 921* 925* 944* 951* TI parameter structure level 1 dcl 2848 in procedure "insert_notice" set ref 2834 TIptr 000156 automatic pointer dcl 2588 set ref 2595* 2604 2605 2605 2615 2616 2616 2626 2627 2627 TRADE_SECRET constant fixed bin(17,0) initial dcl 5-69 ref 517 555 2060 2064 True 025553 constant bit(1) initial unaligned dcl 234 ref 314 336 371 372 373 376 379 406 410 411 417 420 577 578 631 633 811 1191 1301 1365 1402 1491 1506 1541 1551 1605 1636 1662 1741 1746 1773 1892 2054 2055 2060 2061 2062 2064 2065 2067 2183 2237 2337 2368 2709 2723 2805 3036 Twords based fixed bin(24,0) level 2 dcl 1251 set ref 1547 1903* 1921* 1921 1926 1931 V 000100 automatic structure level 1 dcl 2260 set ref 2278 2278 V_source_info_1 constant fixed bin(17,0) initial dcl 6-52 ref 696 V_target_info_1 constant fixed bin(17,0) initial dcl 7-43 ref 697 WORD_BREAKS 000150 automatic varying char(30) dcl 1269 set ref 1530* 1533* 1782 1793 1808 1906* 1906 1922 1934 acle 000102 automatic structure array level 1 unaligned dcl 2660 set ref 2695 2695 2715 2715 2744 2744 addC 000105 automatic bit(1) unaligned dcl 2013 set ref 2027* 2062* 2142 addPD 000107 automatic bit(1) unaligned dcl 2013 set ref 2029* 2061* 2129 addTS 000106 automatic bit(1) unaligned dcl 2013 set ref 2028* 2060* 2108 add_char_offset_ 000114 constant entry external dcl 174 ref 868 947 addcharno builtin function dcl 284 ref 1391 1406 1488 1623 1769 2801 2857 2858 addr builtin function dcl 284 ref 1000 1001 1108 1108 1113 1147 1159 1161 1294 1341 1358 1391 1406 1417 1458 1488 1623 1657 1769 1788 1805 1813 1916 1932 1939 2275 2278 2278 2478 2507 2507 2695 2695 2715 2715 2744 2744 2757 2757 2801 addrel builtin function dcl 284 ref 971 979 988 al based structure level 1 dcl 3102 set ref 979 ap 2 based pointer array level 2 dcl 3102 set ref 1000* archive 000116 constant entry external dcl 174 ref 1006 1006 archive_$get_component 000120 constant entry external dcl 174 ref 894 archive_$next_component 000122 constant entry external dcl 174 ref 814 archive_name 2 001220 automatic char(32) level 2 in structure "target_info" packed unaligned dcl 7-22 in procedure "add_pnotice" set ref 659* 672* archive_name 1 parameter char(32) level 2 in structure "SI" packed unaligned dcl 2418 in procedure "make_star_box" set ref 2487 2487* 2487* archive_name 1 parameter char(32) level 2 in structure "SI" packed unaligned dcl 2007 in procedure "continue_processing" set ref 2042 2042* 2073 2073* 2073* 2086 2086* 2086* 2099 2099* 2099* 2119 2119* 2119* 2133 2133* 2133* 2146 2146* 2146* archive_name 1 parameter char(32) level 2 in structure "SI" packed unaligned dcl 1213 in procedure "pnotice_parse" set ref 1580 1580* 1580* 1703 1703* 1703* archive_name 1 000710 automatic char(32) level 2 in structure "source_info" packed unaligned dcl 6-25 in procedure "add_pnotice" set ref 599 599* 599* 653* 654 659 662* 669* 3069 archive_name 1 parameter char(32) level 2 in structure "SI" packed unaligned dcl 1093 in procedure "get_language_info" set ref 1120 1120* 1120* 1135 1135* 1135* 1167 1170* 1170* archive_name 2 parameter char(32) level 2 in structure "TI" packed unaligned dcl 777 in procedure "process_archive_components" set ref 991 1004* 1009* archive_name 1 parameter char(32) level 2 in structure "SI" packed unaligned dcl 777 in procedure "process_archive_components" set ref 820* 820* 877 877* 877* 900* 900* 952 952* 952* archive_name 1 parameter char(32) level 2 in structure "SI" packed unaligned dcl 693 in procedure "init_structures" set ref 698* archive_name 1 parameter char(32) level 2 in structure "SI" packed unaligned dcl 2906 in procedure "report" set ref 2917 2917* 2917* 2924 2924* 2924* 2934 2965 arg_count based fixed bin(17,0) level 3 packed unsigned unaligned dcl 3102 set ref 973* 979 1001 arg_list based structure level 1 dcl 2-14 arg_list_arg_count 000703 automatic fixed bin(17,0) dcl 3100 set ref 319* argument based char unaligned dcl 291 set ref 356 359 363* 368 368 372 373 376 376 379 379 381 381 395 398 406 407 412 416 420 420 422 422 array 2 based structure array level 2 unaligned dcl 745 before builtin function dcl 284 ref 398 407 514 532 541 573 633 1106 1132 1962 2338 2453 2938 bit_count 000134 automatic fixed bin(24,0) dcl 125 set ref 636* 646 814* 894* 3049* 3069* 3072* box_line 000100 automatic varying char(128) dcl 2422 set ref 2428* call_type 0(18) based fixed bin(18,0) level 3 packed unsigned unaligned dcl 3102 set ref 975* char builtin function dcl 284 ref 2053 2182 2198 2222 char_desc constant fixed bin(17,0) initial dcl 4-1 ref 982 char_offset_ 000124 constant entry external dcl 174 ref 868 868 947 947 charno builtin function dcl 284 ref 1431 1431 check_star_name_$entry 000126 constant entry external dcl 174 ref 609 621 cleanup 000624 stack reference condition dcl 296 ref 334 789 1027 clock builtin function dcl 284 ref 327 327 cmt_bgn 106 parameter varying char(8) level 2 in structure "SI" dcl 693 in procedure "init_structures" set ref 706* cmt_bgn 106 parameter varying char(8) level 2 in structure "SI" dcl 2418 in procedure "make_star_box" set ref 2510* 2517 2525 2532 2543* 2551* 2559* 2565* cmt_bgn 106 parameter varying char(8) level 2 in structure "SI" dcl 1213 in procedure "pnotice_parse" ref 1282 1298 1301 1301 1304 1304 1354 1361 1361 1374 1374 1378 1378 1378 1394 1394 1419 1419 1419 1465 1465 1471 1473 1478 1478 1533 1688 cmt_bgn 106 parameter varying char(8) level 2 in structure "SI" dcl 1093 in procedure "get_language_info" set ref 1159* 1186* 1186 1188* 1188 cmt_bgn_length 000104 automatic fixed bin(21,0) dcl 1217 set ref 1282* 1499 1501 1626 1626 cmt_end 111 parameter varying char(8) level 2 in structure "SI" dcl 693 in procedure "init_structures" set ref 707* cmt_end 111 parameter varying char(8) level 2 in structure "SI" dcl 1213 in procedure "pnotice_parse" ref 1478 1478 1478 1483 1483 1688 cmt_end 111 parameter varying char(8) level 2 in structure "SI" dcl 1093 in procedure "get_language_info" set ref 1161* cmt_end 111 parameter varying char(8) level 2 in structure "SI" dcl 2418 in procedure "make_star_box" set ref 2535* code 12 000102 automatic fixed bin(35,0) array level 2 in structure "acle" dcl 2660 in procedure "check_acl" set ref 2694* 2696 2696 2706* 2714* 2725* 2743* 2745 code 10 000115 automatic fixed bin(35,0) array level 2 in structure "del_acl" dcl 2667 in procedure "check_acl" set ref 2756* code 000135 automatic fixed bin(35,0) dcl 125 in procedure "add_pnotice" set ref 339* 340 343* 355* 385* 386 389* 401* 426* 427* 442* 443* 449* 450* 457* 458* 464* 465* 472* 473* 489* 491 510* 511* 528* 529* 550* 551* 567* 568* 581* 588 591* 598* 599* 604* 609* 610 613* 614* 621* 622 625* 626* 636* 642* 1439* 1443* 2435* 2437 2440* 2878* 3049* 3063* 3066* 3069* 3072* 3082* 3086* 3090* com_err_ 000130 constant entry external dcl 174 ref 343 363 389 427 443 450 458 465 473 481 511 529 551 568 591 599 604 614 626 642 799 820 859 900 910 938 1036 1120 1125 1132 1135 1140 1153 1170 1180 1329 1580 1585 1683 1871 2042 2073 2077 2086 2090 2099 2103 2119 2123 2133 2137 2146 2152 2440 2487 2492 2680 2719 2725 2748 2758 comment based char unaligned dcl 1229 ref 1313 1313 1313 1374 1378 1378 1378 1378 1378 1389 1498 1501 1614 1653 comment_chr based char(1) array unaligned dcl 1229 set ref 1391 1623 1657 comment_end 10 based varying char(8) array level 4 dcl 1-43 ref 1161 comment_line based char unaligned dcl 1229 ref 1394 1626 comment_start 5 based varying char(8) array level 4 dcl 1-43 ref 1159 common_archive_name 000136 automatic char(32) unaligned dcl 125 set ref 654* comp_bc 000646 automatic fixed bin(24,0) dcl 754 set ref 814* 835 894* 914 comp_info based structure level 1 unaligned dcl 745 set ref 971 comp_name 000647 automatic char(32) unaligned dcl 754 set ref 814* 828 830 component 000146 automatic char(32) unaligned dcl 125 set ref 581* 618 621* 626* 626* 633 656 894* 900* 900* 905 continue 000130 automatic bit(1) unaligned dcl 2319 set ref 2337* 2356 2380* 2386 convert builtin function dcl 284 ref 328 1833 cu_$arg_count 000132 constant entry external dcl 174 ref 339 cu_$arg_ptr 000134 constant entry external dcl 174 ref 355 385 cu_$generate_call 000136 constant entry external dcl 174 ref 1006 current_pnotice_date 000154 automatic char(4) unaligned dcl 2319 set ref 2359* current_pnotice_vers 000143 automatic varying char(32) dcl 2319 set ref 2358* 2377 current_year 000100 automatic fixed bin(17,0) dcl 125 set ref 328* 328 2166 2380 current_year_a 000101 automatic char(4) unaligned dcl 125 set ref 327* 328 2051 2179 2339 currentsize builtin function dcl 284 ref 971 979 988 date 114 parameter char(4) array level 4 in structure "TI" packed unaligned dcl 2007 in procedure "continue_processing" set ref 2051* 2179* 2221* 2229 date 114 parameter char(4) array level 4 in structure "TI" packed unaligned dcl 2418 in procedure "make_star_box" set ref 2468 date_time_$format 000140 constant entry external dcl 174 ref 327 defaultC based bit(1) array level 3 packed unaligned dcl 5-41 ref 561 defaultTS based bit(1) array level 3 packed unaligned dcl 5-41 ref 504 del_acl 000115 automatic structure array level 1 unaligned dcl 2667 set ref 2757 2757 desc based structure array level 1 dcl 3111 set ref 988 1001 desc_ 000704 automatic structure level 1 dcl 3-3 desc_count 1 based fixed bin(17,0) level 3 packed unsigned unaligned dcl 3102 set ref 976* 979 dim builtin function dcl 284 ref 1700 1703 1703 1708 1708 2229 2234 2260 2269 2288 3081 dimension_ 0(08) based bit(4) array level 2 packed unaligned dcl 3111 set ref 984* dir 15 parameter char(168) level 2 in structure "TI" packed unaligned dcl 777 in procedure "process_archive_components" set ref 791* 991 1004* 1009* dir 15 parameter char(168) level 2 in structure "SI" packed unaligned dcl 2906 in procedure "report" set ref 2917* 2917* 2922* 2922* 2924* 2924* 2927* 2927* 2934* 2965* dir 15 parameter char(168) level 2 in structure "TI" packed unaligned dcl 1022 in procedure "process_single_seg" set ref 1029* 1050* 1055* dir 15 parameter char(168) level 2 in structure "SI" packed unaligned dcl 1093 in procedure "get_language_info" set ref 1120* 1120* 1125* 1125* 1135* 1135* 1140* 1140* 1170* 1170* 1175* dir 15 parameter char(168) level 2 in structure "SI" packed unaligned dcl 777 in procedure "process_archive_components" set ref 820* 820* 877* 877* 884* 884* 900* 900* 952* 952* 958* 958* dir 15 parameter char(168) level 2 in structure "SI" packed unaligned dcl 2007 in procedure "continue_processing" set ref 2042* 2042 2073* 2073* 2077* 2077* 2086* 2086* 2090* 2090* 2099* 2099* 2103* 2103* 2119* 2119* 2123* 2123* 2133* 2133* 2137* 2137* 2146* 2146* 2152* 2152* dir 15 001220 automatic char(168) level 2 in structure "target_info" packed unaligned dcl 7-22 in procedure "add_pnotice" set ref 594* dir 15 parameter char(168) level 2 in structure "SI" packed unaligned dcl 2418 in procedure "make_star_box" set ref 2487* 2487* 2492* 2492* dir 15 000710 automatic char(168) level 2 in structure "source_info" packed unaligned dcl 6-25 in procedure "add_pnotice" set ref 581* 594 599* 599* 604* 604* 614* 614* 626* 626* 636* 642* 642* 662* 662 1061* 1061* 1065* 1065* dir 15 parameter char(168) level 2 in structure "SI" packed unaligned dcl 1213 in procedure "pnotice_parse" set ref 1329* 1329* 1580* 1580* 1585* 1585* 1703* 1703* 1708* 1708* divide builtin function dcl 284 ref 646 835 914 doing_all_components 000156 automatic bit(1) unaligned dcl 125 set ref 329* 811* 1117 dp based pointer array level 2 dcl 3102 set ref 1001* dt 000702 automatic char(4) unaligned dcl 2888 set ref 2952* 2953* ec_version 104 parameter fixed bin(17,0) level 2 in structure "SI" dcl 693 in procedure "init_structures" set ref 704* ec_version 104 parameter fixed bin(17,0) level 2 in structure "SI" dcl 1093 in procedure "get_language_info" set ref 1101* 1175* 1186 entry 67 000710 automatic char(32) level 2 in structure "source_info" packed unaligned dcl 6-25 in procedure "add_pnotice" set ref 581* 595 599* 599* 604* 604* 609* 614* 614* 626* 626* 633 636* 642* 642* 653 656* 675 1061* 1061* 1065* 1065* entry 67 parameter char(32) level 2 in structure "SI" packed unaligned dcl 1022 in procedure "process_single_seg" set ref 1036* entry 67 parameter char(32) level 2 in structure "SI" packed unaligned dcl 777 in procedure "process_archive_components" set ref 805 820* 820* 828* 852 877* 877* 884* 884* 910* 931 952* 952* 958* 958* entry 67 parameter char(32) level 2 in structure "TI" packed unaligned dcl 1022 in procedure "process_single_seg" set ref 1029* 1050* 1055* entry 67 parameter char(32) level 2 in structure "SI" packed unaligned dcl 2418 in procedure "make_star_box" set ref 2487* 2487* 2492* 2492* entry 67 parameter char(32) level 2 in structure "SI" packed unaligned dcl 1213 in procedure "pnotice_parse" set ref 1329* 1329* 1580* 1580* 1585* 1585* 1703* 1703* 1708* 1708* entry 67 parameter char(32) level 2 in structure "SI" packed unaligned dcl 2007 in procedure "continue_processing" set ref 2042* 2073* 2073* 2077* 2077* 2086* 2086* 2090* 2090* 2099* 2099* 2103* 2103* 2119* 2119* 2123* 2123* 2133* 2133* 2137* 2137* 2146* 2146* 2152* 2152* entry 67 001220 automatic char(32) level 2 in structure "target_info" packed unaligned dcl 7-22 in procedure "add_pnotice" set ref 675* entry 67 parameter char(32) level 2 in structure "SI" packed unaligned dcl 1093 in procedure "get_language_info" set ref 1103 1106 1120* 1120* 1125* 1125* 1132 1135* 1135* 1140* 1140* 1175* entry 67 parameter char(32) level 2 in structure "TI" packed unaligned dcl 777 in procedure "process_archive_components" set ref 791* 830* 905* entry 67 parameter char(32) level 2 in structure "SI" packed unaligned dcl 2906 in procedure "report" set ref 2917* 2917* 2922* 2922* 2924* 2924* 2927* 2927* 2934* 2934* 2965* 2965* error_table_$archive_component_modification 000210 external static fixed bin(35,0) dcl 268 set ref 1170* error_table_$bad_file_name 000214 external static fixed bin(35,0) dcl 268 set ref 598 910* 1036* error_table_$badopt 000212 external static fixed bin(35,0) dcl 268 ref 426 error_table_$improper_data_format 000216 external static fixed bin(35,0) dcl 268 set ref 401 1329* error_table_$inconsistent 000220 external static fixed bin(35,0) dcl 268 ref 442 449 457 464 472 error_table_$lower_ring 000242 external static fixed bin(35,0) dcl 2671 set ref 2680* error_table_$name_not_found 000226 external static fixed bin(35,0) dcl 268 ref 510 528 550 567 error_table_$noarg 000222 external static fixed bin(35,0) dcl 268 set ref 481* error_table_$nostars 000230 external static fixed bin(35,0) dcl 268 ref 613 625 error_table_$not_done 000224 external static fixed bin(35,0) dcl 268 set ref 1580* 1585* 2072 2085 2098 2118 2132 2145 error_table_$typename_not_found 000232 external static fixed bin(35,0) dcl 268 ref 1116 1152 error_table_$user_not_found 000244 external static fixed bin(35,0) dcl 2671 ref 2696 error_table_$wrong_no_of_args 000234 external static fixed bin(35,0) dcl 268 set ref 363* expand_pathname_$component 000142 constant entry external dcl 174 ref 581 foundC 000111 automatic bit(1) unaligned dcl 2013 set ref 2031* 2067* 2069 2082 2142 foundPD 000110 automatic bit(1) unaligned dcl 2013 set ref 2030* 2065* 2082 2095 2129 foundTS 000112 automatic bit(1) unaligned dcl 2013 set ref 2064* 2069 2095 2108 get_ec_version_ 000144 constant entry external dcl 174 ref 1175 get_group_id_ 000146 constant entry external dcl 174 ref 2690 2736 get_pdir_ 000150 constant entry external dcl 174 ref 651 get_temp_segment_ 000152 constant entry external dcl 174 ref 795 1678 1867 2435 hbound builtin function dcl 284 ref 1108 2364 hcs_$add_acl_entries 000154 constant entry external dcl 174 ref 2715 2744 hcs_$delentry_seg 000156 constant entry external dcl 174 ref 3063 hcs_$delete_acl_entries 000160 constant entry external dcl 174 ref 2757 hcs_$initiate_count 000162 constant entry external dcl 174 ref 636 hcs_$list_acl 000164 constant entry external dcl 174 ref 2695 hcs_$make_seg 000166 constant entry external dcl 174 ref 853 932 header based structure level 2 in structure "arg_list" dcl 2-14 in procedure "add_pnotice" header based structure level 2 in structure "al" dcl 3102 in procedure "add_pnotice" i 000114 automatic fixed bin(24,0) dcl 125 set ref 1498* 1499 1552* 1553 1553 1554 1554 1554 1558 1558 1558 1558* 1570 index builtin function dcl 284 ref 356 395 595 1103 1313 1313 1313 1378 1378 1378 1389 1470 1478 1483 1498 1501 1614 1757 2467 2947 2951 3033 3033 3033 ioa_ 000170 constant entry external dcl 174 ref 349 662 877 884 952 958 1061 1065 1703 1708 2917 2922 2924 2927 2934 2947 2965 2992 lang_array 1 based structure array level 3 dcl 1-43 ref 1108 lang_name 2 based varying char(8) array level 4 dcl 1-43 ref 1108 lang_type 1 based fixed bin(17,0) array level 4 dcl 1-43 ref 1147 language 000102 automatic varying char(8) dcl 1095 set ref 1106* 1108 1120* 1125* 1135* 1140* 1153* languages based structure level 2 dcl 1-43 lbound builtin function dcl 284 ref 2364 length builtin function dcl 284 in procedure "add_pnotice" ref 999 1282 1298 1298 1301 1304 1354 1354 1361 1374 1378 1378 1378 1378 1394 1394 1394 1394 1394 1394 1419 1419 1419 1419 1465 1471 1471 1471 1473 1473 1473 1478 1478 1483 1499 1499 1501 1501 1554 1554 1558 1558 1558 1558 1558 1626 1626 1626 1626 1755 1762 1789 1794 1800 1800 1806 1814 1826 1826 1826 1826 1889 1917 1926 1933 1940 2278 2278 2500 2515 2517 2517 2519 2525 2525 2529 2532 2532 2533 2562 2605 2616 3031 3031 length 14 based fixed bin(21,0) array level 3 in structure "comp_info" dcl 745 in procedure "add_pnotice" set ref 851* 930* line based char unaligned dcl 2771 set ref 2500 2528* 2529 2561* 2562 3031 long_output 1 parameter bit(1) level 2 in structure "TI" dcl 2907 in procedure "report" ref 2931 long_output 1 001220 automatic bit(1) level 2 in structure "target_info" dcl 7-22 in procedure "add_pnotice" set ref 336* 420* 422* long_output 1 parameter bit(1) level 2 in structure "TI" dcl 1022 in procedure "process_single_seg" set ref 1058 long_output 1 parameter bit(1) level 2 in structure "TI" dcl 777 in procedure "process_archive_components" set ref 877 952 ltrim builtin function dcl 284 ref 2053 2182 2198 2222 match 000104 automatic bit(1) unaligned dcl 2013 set ref 2032* max builtin function dcl 284 ref 2500 mbz 11 000102 automatic bit(36) array level 2 dcl 2660 set ref 2693* 2713* 2742* mode 10 000102 automatic bit(36) array level 2 dcl 2660 set ref 2692* 2710 2712* 2741* most_recent_date 000155 automatic char(4) unaligned dcl 2333 set ref 2340* 2352 2352* 2364 move based char unaligned dcl 2395 set ref 2460* 2460 2463* 2467 2468* 2474 name 115(18) parameter char(32) array level 3 in structure "TI" packed unaligned dcl 2418 in procedure "make_star_box" set ref 2453 name 000102 automatic char(32) array level 2 in structure "acle" dcl 2660 in procedure "check_acl" set ref 2690* 2719* 2725* 2736* 2748* 2755 name 2 based char(32) array level 3 in structure "comp_info" packed unaligned dcl 745 in procedure "add_pnotice" set ref 852* 853* 859* 931* 932* 938* 994 name 000115 automatic char(32) array level 2 in structure "del_acl" dcl 2667 in procedure "check_acl" set ref 2755* 2758* name 117 parameter varying char(32) level 3 in structure "SI" dcl 2418 in procedure "make_star_box" ref 2475 name 115(18) parameter char(32) array level 3 in structure "TI" packed unaligned dcl 2007 in procedure "continue_processing" set ref 2050* 2177* 2196* 2220* 2229 name 117 000710 automatic varying char(32) level 3 in structure "source_info" dcl 6-25 in procedure "add_pnotice" set ref 412* 416* 514* 532* 541 551* 573* 737* name 117 parameter varying char(32) level 3 in structure "SI" dcl 2007 in procedure "continue_processing" set ref 2050 2111 2146* 2152* 2166 2166 2177 2196 name 117 parameter varying char(32) level 3 in structure "SI" dcl 2317 in procedure "ok_nine_year_rule" ref 2338 new_box based char unaligned dcl 2831 set ref 2873* new_pnotice_date 000142 automatic char(4) unaligned dcl 2319 set ref 2339* new_pnotice_vers 000131 automatic varying char(32) dcl 2319 set ref 2338* 2345 2377 new_text parameter char unaligned dcl 2601 ref 2598 2605 2606 new_var_text parameter varying char dcl 2612 ref 2609 2616 2617 no_write_permission 000000 stack reference condition dcl 296 ref 2685 not_in_write_bracket 000000 stack reference condition dcl 296 ref 2678 notice 114 parameter structure array level 2 in structure "TI" dcl 2848 in procedure "insert_notice" notice 114 parameter structure array level 2 in structure "TI" dcl 777 in procedure "process_archive_components" notice 114 parameter structure array level 2 in structure "TI" dcl 1022 in procedure "process_single_seg" notice 114 001220 automatic structure array level 2 in structure "target_info" dcl 7-22 in procedure "add_pnotice" notice 114 parameter structure array level 2 in structure "TI" dcl 2007 in procedure "continue_processing" notice 114 parameter structure array level 2 in structure "TI" dcl 2907 in procedure "report" notice based structure level 1 dcl 2268 in procedure "sort_pnotices" ref 2285 notice 114 parameter structure array level 2 in structure "TI" dcl 2264 in procedure "sort_pnotices" set ref 2260 2269 2292* notice 114 based structure array level 2 in structure "TI" dcl 2589 in procedure "add_text" notice 114 parameter structure array level 2 in structure "TI" dcl 2418 in procedure "make_star_box" notice_date 142 parameter char(4) array level 3 in structure "SI" dcl 2906 in procedure "report" set ref 2952 notice_date 142 parameter char(4) array level 3 in structure "SI" dcl 2007 in procedure "continue_processing" set ref 2204 2204 2221 2229 notice_date 142 parameter char(4) array level 3 in structure "SI" dcl 693 in procedure "init_structures" set ref 712* notice_date 142 parameter char(4) array level 3 in structure "SI" dcl 2317 in procedure "ok_nine_year_rule" ref 2352 2352 2359 2364 notice_info 132 parameter structure array level 2 in structure "SI" dcl 1213 in procedure "pnotice_parse" set ref 1700 1703 1703 1708 1708 1713* notice_info 132 parameter structure array level 2 in structure "SI" dcl 2906 in procedure "report" notice_info 132 parameter structure array level 2 in structure "SI" dcl 2317 in procedure "ok_nine_year_rule" notice_info 132 parameter structure array level 2 in structure "SI" dcl 2007 in procedure "continue_processing" set ref 2229 2234 notice_info 132 parameter structure array level 2 in structure "SI" dcl 693 in procedure "init_structures" notice_name 132 parameter char(32) array level 3 in structure "SI" packed unaligned dcl 693 in procedure "init_structures" set ref 711* notice_name 132 parameter char(32) array level 3 in structure "SI" packed unaligned dcl 2007 in procedure "continue_processing" set ref 2111 2166 2166 2204 2204 2204* 2215 2220 2229 2229 notice_name 132 parameter char(32) array level 3 in structure "SI" packed unaligned dcl 2906 in procedure "report" set ref 2938 2963 notice_name 132 parameter char(32) array level 3 in structure "SI" packed unaligned dcl 2317 in procedure "ok_nine_year_rule" ref 2345 2358 2368 notice_to_add 117 000710 automatic structure level 2 in structure "source_info" dcl 6-25 in procedure "add_pnotice" notice_to_add 117 parameter structure level 2 in structure "SI" dcl 2007 in procedure "continue_processing" notice_to_add 117 parameter structure level 2 in structure "SI" dcl 2418 in procedure "make_star_box" notice_to_add 117 parameter structure level 2 in structure "SI" dcl 2317 in procedure "ok_nine_year_rule" notice_type 143 parameter fixed bin(17,0) array level 3 in structure "SI" dcl 2007 in procedure "continue_processing" set ref 2064 2065 2146* 2152* notice_type 143 parameter fixed bin(17,0) array level 3 in structure "SI" dcl 693 in procedure "init_structures" set ref 713* null builtin function dcl 284 ref 321 322 323 639 670 673 703 708 714 716 813 825 1439 1443 1607 1644 2432 2695 2695 2695 2695 3049 3055 3060 3072 3078 3090 old_mode 000101 automatic bit(36) dcl 2656 set ref 2710* 2741 one_word based char(4) unaligned dcl 2671 set ref 2686* 2686 pack_ 0(07) based bit(1) array level 2 packed unaligned dcl 3111 set ref 983* pad1 0(17) based bit(1) level 3 packed unaligned dcl 3102 set ref 974* pad2 1(17) based bit(19) level 3 packed unaligned dcl 3102 set ref 977* path 000157 automatic char(168) unaligned dcl 125 set ref 324* 359 359* 477 581* 591* pathname_ 000172 constant entry external dcl 174 ref 604 604 614 614 642 642 884 884 958 958 1061 1061 1065 1065 1125 1125 1140 1140 1170 1170 1329 1329 1585 1585 1708 1708 2077 2077 2090 2090 2103 2103 2123 2123 2137 2137 2152 2152 2492 2492 2922 2922 2927 2927 pathname_$component 000174 constant entry external dcl 174 ref 599 599 626 626 820 820 877 877 900 900 952 952 1120 1120 1135 1135 1580 1580 1703 1703 2073 2073 2086 2086 2099 2099 2119 2119 2133 2133 2146 2146 2487 2487 2917 2917 2924 2924 paths based char(168) array unaligned dcl 754 set ref 990* 991* 994* 999 1000 pdir 000231 automatic varying char(168) dcl 125 set ref 652* 859* 938* 994 pnames 000102 automatic char(32) array unaligned dcl 2910 set ref 2963* 2965* pnotice based char unaligned dcl 1237 ref 1729 1755 1757 1762 pnotice_chr based char(1) array unaligned dcl 1237 set ref 1769 pnotice_language_info based structure level 1 dcl 1-43 pnotice_language_info_$languages 000236 external static fixed bin(17,0) dcl 1-41 set ref 1108 1108 1113 1147 1159 1161 pnotice_line based char unaligned dcl 1237 ref 1736 pnotice_mlr_ 000176 constant entry external dcl 174 ref 2865 pnotice_mrl_ 000200 constant entry external dcl 174 ref 2861 pnotice_paths based structure level 1 dcl 5-41 pnotice_paths_ 000202 constant entry external dcl 174 ref 489 pnotices based structure level 1 unaligned dcl 1245 precision_ 0(24) based fixed bin(11,0) array level 2 packed unaligned dcl 3111 set ref 986* 999* primary_name based char(32) array level 3 dcl 5-41 ref 514 532 541 573 1962 2453 2938 process_dir 000304 automatic char(168) unaligned dcl 125 set ref 651* 652 853* 932* ptr builtin function dcl 284 in procedure "add_pnotice" ref 2445 ptr 12 based pointer array level 3 in structure "comp_info" dcl 745 in procedure "add_pnotice" set ref 853* 863 866 932* 942 945 3060 3063* pword 1 based varying char(80) array level 2 dcl 1245 set ref 1553 1554 1554 1558 1558 1558 1799* 1800 1800 1826 1826 1832 release_temp_segment_ 000204 constant entry external dcl 174 ref 1439 1443 3066 3086 3090 rest based char unaligned dcl 1217 ref 1285 1298 1301 1301 1304 1346 1354 1361 1416 1419 1419 1454 1464 1465 1470 1473 1478 1483 rest_ch based char(1) array unaligned dcl 1217 set ref 1294 1341 1358 1406 1417 1458 1488 ret 000260 automatic structure level 1 dcl 1955 set ref 1971 reverse builtin function dcl 284 ref 398 398 407 407 633 633 1106 1106 1132 1132 rtrim builtin function dcl 284 ref 652 991 999 save_Prest 000110 automatic pointer dcl 1217 set ref 1369* 1413 save_chr based char(1) array unaligned dcl 2395 set ref 2478 save_length 000105 automatic fixed bin(21,0) dcl 1217 set ref 1308* 1313* 1313 1319 1324 1371* 1393* 1393 1406 1408 1610* save_name 000356 automatic char(32) unaligned dcl 125 set ref 877* 884* 952* 958* 1061* 1065* 2475* save_ptr 000106 automatic pointer dcl 1217 set ref 1309* 1323 1366* 1430 1609* save_text 000366 automatic varying char(512) dcl 125 set ref 2474* scale_ 0(12) based fixed bin(11,0) array level 2 packed unaligned dcl 3111 set ref 985* search builtin function dcl 284 ref 1793 1922 2800 seq 115 parameter char(2) array level 4 in structure "TI" packed unaligned dcl 2007 in procedure "continue_processing" set ref 2053* 2182* 2198* 2222* seq 144 parameter fixed bin(17,0) array level 3 in structure "SI" dcl 2007 in procedure "continue_processing" set ref 2222 seqno 000567 automatic fixed bin(18,0) dcl 125 set ref 719* 1969* 1969 1970 2052* 2052 2053 2181* 2181 2182 2197* 2197 2198 sfx_string 000177 constant char(3) initial unaligned dcl 234 set ref 2530* 2563* sort_field 114 parameter structure array level 3 in structure "TI" packed unaligned dcl 2264 in procedure "sort_pnotices" set ref 2275 2278 2278 sort_field 114 parameter structure array level 3 in structure "TI" packed unaligned dcl 2007 in procedure "continue_processing" sort_field 114 parameter structure array level 3 in structure "TI" packed unaligned dcl 2418 in procedure "make_star_box" sort_items_$char 000240 constant entry external dcl 2270 ref 2278 sorted_data 000102 automatic structure array level 1 dcl 2269 set ref 2285* 2288 2289* 2292 source_info 000710 automatic structure level 1 dcl 6-25 set ref 330* 665* 678* source_year 000576 automatic fixed bin(17,0) array dcl 125 set ref 1280* 1833* 1833 2166 2380 source_year_a 000610 automatic char(4) array unaligned dcl 125 set ref 1281* 1832* 1833 1965 star_box based char unaligned dcl 2395 set ref 2606* 2617* 2628* 2873 store_template 000100 automatic char unaligned dcl 2973 set ref 2990* 2991* 2992* store_templateb based char unaligned dcl 2973 ref 2990 string builtin function dcl 284 set ref 2278 2278 2289* sub_seg based char unaligned dcl 3017 ref 3033 3033 3033 substr builtin function dcl 284 set ref 1301 1301 1304 1361 1374 1378 1378 1394 1419 1419 1464 1465 1473 1478 1501 1558 1558 1626 1799 1800 1826 1832 1926 1931 2463* 2468* 2474 2606* 2617* 2628* 2628 2991* target_info 001220 automatic structure level 1 dcl 7-22 set ref 330* 665* 678* temp based char unaligned dcl 2771 ref 2800 temp_chr based char(1) array unaligned dcl 2771 set ref 2801 template based structure level 1 unaligned dcl 1251 in procedure "pnotice_parse" template based char unaligned dcl 2888 in procedure "add_pnotice" set ref 2947 2947* 2951 templates based structure array level 2 dcl 5-41 set ref 3081 terminate_file_ 000206 constant entry external dcl 174 ref 2878 3049 3069 3072 3082 text_pos 105 parameter fixed bin(21,0) level 2 in structure "SI" dcl 1213 in procedure "pnotice_parse" ref 1341 1344 text_pos 105 parameter fixed bin(21,0) level 2 in structure "SI" dcl 693 in procedure "init_structures" set ref 705* text_pos 105 parameter fixed bin(21,0) level 2 in structure "SI" dcl 1093 in procedure "get_language_info" set ref 1102* 1175* 1183 1183* tline based char unaligned dcl 1847 ref 1908 tword 1 based varying char(80) array level 2 dcl 1251 set ref 1553 1554 1558 1926* 1931* type 103 parameter fixed bin(17,0) level 2 in structure "SI" dcl 2418 in procedure "make_star_box" ref 2508 2568 type 130 parameter fixed bin(17,0) level 3 in structure "SI" dcl 2007 in procedure "continue_processing" set ref 2060 2061 type based fixed bin(17,0) array level 3 in structure "pnotice_paths" dcl 5-41 in procedure "add_pnotice" ref 522 1968 type 103 parameter fixed bin(17,0) level 2 in structure "SI" dcl 1093 in procedure "get_language_info" set ref 1147* 1149 1149 1153* 1164 type 130 000710 automatic fixed bin(17,0) level 3 in structure "source_info" dcl 6-25 in procedure "add_pnotice" set ref 517* 535* 555* 557* 576* 738* type 103 parameter fixed bin(17,0) level 2 in structure "SI" dcl 1213 in procedure "pnotice_parse" ref 1283 1301 1530 1530 type_ 0(01) based fixed bin(6,0) array level 2 packed unsigned unaligned dcl 3111 set ref 982* used_old_argument 000622 automatic bit(1) unaligned dcl 125 set ref 371* 439 454 537 736* vector 1 000100 automatic pointer array level 2 packed unaligned dcl 2260 set ref 2275* 2285 verify builtin function dcl 284 ref 1285 1346 1416 1454 1554 1558 1653 1729 1736 1782 1800 1808 1908 1934 version parameter fixed bin(17,0) level 2 dcl 693 set ref 696* version2_ based bit(1) array level 2 packed unaligned dcl 3111 set ref 981* word_text based char unaligned dcl 1265 ref 1782 1789 1793 1794 1799 1806 1808 1814 1917 1922 1926 1926 1931 1933 1934 1940 word_text_arr based char(1) array unaligned dcl 1265 set ref 1788 1805 1813 1916 1932 1939 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. D_fixed_cplx_desc internal static fixed bin(17,0) initial dcl 4-1 D_fixed_real_desc internal static fixed bin(17,0) initial dcl 4-1 D_float_cplx_desc internal static fixed bin(17,0) initial dcl 4-1 D_float_real_desc internal static fixed bin(17,0) initial dcl 4-1 Envptr_supplied_call_type internal static fixed bin(18,0) initial unsigned unaligned dcl 2-54 Quick_call_type internal static fixed bin(18,0) initial unsigned unaligned dcl 2-54 TERM_FILE_BC internal static bit(2) initial unaligned dcl 8-12 TERM_FILE_DELETE internal static bit(5) initial unaligned dcl 8-17 TERM_FILE_FORCE_WRITE internal static bit(4) initial unaligned dcl 8-16 TERM_FILE_TRUNC internal static bit(1) initial unaligned dcl 8-11 TERM_FILE_TRUNC_BC_TERM internal static bit(3) initial unaligned dcl 8-15 UNDEFINED internal static fixed bin(17,0) initial dcl 5-67 area_desc internal static fixed bin(17,0) initial dcl 4-1 arg_list_with_envptr based structure level 1 dcl 2-42 bit_desc internal static fixed bin(17,0) initial dcl 4-1 command_name_arglist based structure level 1 dcl 2-25 d_fixed_cplx_desc internal static fixed bin(17,0) initial dcl 4-1 d_fixed_real_desc internal static fixed bin(17,0) initial dcl 4-1 d_float_cplx_desc internal static fixed bin(17,0) initial dcl 4-1 d_float_real_desc internal static fixed bin(17,0) initial dcl 4-1 entry_desc internal static fixed bin(17,0) initial dcl 4-1 file_desc internal static fixed bin(17,0) initial dcl 4-1 label_desc internal static fixed bin(17,0) initial dcl 4-1 offset_desc internal static fixed bin(17,0) initial dcl 4-1 pointer_desc internal static fixed bin(17,0) initial dcl 4-1 s_fixed_cplx_desc internal static fixed bin(17,0) initial dcl 4-1 s_fixed_real_desc internal static fixed bin(17,0) initial dcl 4-1 s_float_cplx_desc internal static fixed bin(17,0) initial dcl 4-1 s_float_real_desc internal static fixed bin(17,0) initial dcl 4-1 structure_desc internal static fixed bin(17,0) initial dcl 4-1 terminate_file_switches based structure level 1 packed unaligned dcl 8-4 v_bit_desc internal static fixed bin(17,0) initial dcl 4-1 v_char_desc internal static fixed bin(17,0) initial dcl 4-1 NAMES DECLARED BY EXPLICIT CONTEXT. ALL_COMPONENTS 005430 constant label dcl 811 ref 805 COMMON 002066 constant label dcl 319 ref 305 END_OF_COMPONENTS 007234 constant label dcl 962 ref 825 ERROR 022013 constant label dcl 2725 ref 2696 2707 EXPAND_PATH 004110 constant label dcl 581 ref 496 FATAL_ERROR 005067 constant label dcl 680 ref 365 428 444 452 459 467 475 483 491 512 530 553 569 592 607 616 629 644 801 823 861 902 912 940 1038 1048 1143 1157 1173 1181 1332 1588 1685 1711 1873 2442 2495 2682 2721 2728 FINISH_ARGS_AND_DESCS 007554 constant label dcl 997 FORCE_ACL 021560 constant label dcl 2690 ref 2685 GET_TEMPLATES 003244 constant label dcl 477 ref 436 INIT_ARGUMENT_PATHS 007424 constant label dcl 988 INIT_ARG_LIST 007241 constant label dcl 971 INIT_DESCRIPTOR_VALUES 007270 constant label dcl 979 NAME_ERR 002523 constant label dcl 389 ref 402 NEXT_COMPONENT 005434 constant label dcl 814 ref 832 891 NORMAL_EXIT 005067 constant label dcl 680 PARSE_CLEANUP 012266 constant label dcl 1439 ref 1337 RETURN 014403 constant label dcl 1836 set ref 1826 SINGLE_COMPONENT 006326 constant label dcl 894 ref 808 TYPE 000000 constant label array(5) dcl 1285 in procedure "pnotice_parse" ref 1283 TYPE 000005 constant label array(5) dcl 2510 in procedure "make_star_box" ref 2508 add_pnotice 002041 constant entry external dcl 68 add_text 021271 constant entry internal dcl 2576 add_text$fixed 021302 constant entry internal dcl 2598 ref 2514 2516 2518 2520 2521 2526 2527 2528 2530 2534 2536 2539 2548 2550 2552 2554 2555 2560 2561 2563 2566 2568 add_text$init 021273 constant entry internal dcl 2591 ref 2507 add_text$substr 021371 constant entry internal dcl 2620 ref 2515 2517 2519 2525 2529 2532 2533 2549 2553 2562 2567 add_text$var 021335 constant entry internal dcl 2609 ref 2510 2535 2543 2551 2559 2565 check_acl 021425 constant entry internal dcl 2638 ref 1004 1050 check_acl$reset_acl 022062 constant entry internal dcl 2733 ref 791 1009 1029 1055 clean_up 023730 constant entry internal dcl 3042 ref 334 680 continue_processing 015147 constant entry internal dcl 1986 ref 846 925 1048 display_pnotice 002054 constant entry external dcl 310 end_parse1 011731 constant label dcl 1337 ref 1289 1298 1304 1319 end_parse2 012266 constant label dcl 1439 ref 1350 1354 1361 1432 find_line 022345 constant entry internal dcl 2781 ref 2499 2524 2558 3029 find_line$init 022454 constant entry internal dcl 2810 ref 2497 2523 2557 3028 find_line$remainder_length 022505 constant entry internal dcl 2818 get_language_info 010424 constant entry internal dcl 1078 ref 832 907 1033 get_pnotice_block 013233 constant entry internal dcl 1602 ref 1536 imbedded_notices 023615 constant entry internal dcl 3003 ref 2917 init_structures 005075 constant entry internal dcl 690 ref 330 init_structures$next_component 005115 constant entry internal dcl 700 ref 889 init_variables 005240 constant entry internal dcl 725 ref 337 435 insert_notice 022545 constant entry internal dcl 2834 ref 876 951 1054 make_star_box 017744 constant entry internal dcl 2407 ref 865 944 1049 ok_nine_year_rule 017527 constant entry internal dcl 2301 ref 2161 parse_pnotice_ 013722 constant entry internal dcl 1721 parse_pnotice_$block 013733 constant entry internal dcl 1724 ref 1539 parse_pnotice_$get_line 014054 constant entry internal dcl 1750 ref 1735 parse_pnotice_$line 014160 constant entry internal dcl 1777 ref 1743 parse_source_init 013405 constant entry internal dcl 1673 ref 1528 parse_templates_ 014404 constant entry internal dcl 1852 parse_templates_$get_next 014501 constant entry internal dcl 1880 ref 1543 parse_templates_$get_template_pnotice 015044 constant entry internal dcl 1952 ref 1713 parse_templates_$init 014410 constant entry internal dcl 1864 ref 1529 parse_templates_$line 014656 constant entry internal dcl 1900 ref 1546 pnotice_found 012343 constant entry internal dcl 1449 ref 1312 pnotice_parse 011444 constant entry internal dcl 1199 ref 838 917 1040 print_template 023542 constant entry internal dcl 2970 ref 2953 process_archive_components 005257 constant entry internal dcl 764 ref 665 process_single_seg 007735 constant entry internal dcl 1020 ref 678 process_tokens 012626 constant entry internal dcl 1513 ref 1335 1437 report 022707 constant entry internal dcl 2894 ref 842 921 1044 sort_pnotices 017350 constant entry internal dcl 2245 ref 2228 store_date 014346 constant entry internal dcl 1823 ref 1800 template_matched 013533 constant entry internal dcl 1696 ref 1590 valid_format 012553 constant entry internal dcl 1495 ref 1326 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 26642 27110 25563 26652 Length 27746 25563 246 621 1057 104 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME add_pnotice 1095 external procedure is an external procedure. on unit on line 334 64 on unit init_structures 65 internal procedure is called by several nonquick procedures. init_variables internal procedure shares stack frame of external procedure add_pnotice. process_archive_components 200 internal procedure enables or reverts conditions. on unit on line 789 84 on unit process_single_seg 172 internal procedure enables or reverts conditions. on unit on line 1027 84 on unit get_language_info 249 internal procedure is called by several nonquick procedures. pnotice_parse 685 internal procedure is called by several nonquick procedures. pnotice_found internal procedure shares stack frame of internal procedure pnotice_parse. valid_format internal procedure shares stack frame of internal procedure pnotice_parse. process_tokens internal procedure shares stack frame of internal procedure pnotice_parse. get_pnotice_block internal procedure shares stack frame of internal procedure pnotice_parse. parse_source_init internal procedure shares stack frame of internal procedure pnotice_parse. template_matched internal procedure shares stack frame of internal procedure pnotice_parse. parse_pnotice_ 242 internal procedure calls itself recursively. store_date internal procedure shares stack frame of internal procedure parse_pnotice_. parse_templates_ internal procedure shares stack frame of internal procedure pnotice_parse. continue_processing 273 internal procedure is called by several nonquick procedures. sort_pnotices 84 internal procedure uses auto adjustable storage. ok_nine_year_rule internal procedure shares stack frame of internal procedure continue_processing. make_star_box 283 internal procedure is called by several nonquick procedures. add_text internal procedure shares stack frame of internal procedure make_star_box. check_acl 176 internal procedure enables or reverts conditions. on unit on line 2678 90 on unit on unit on line 2685 64 on unit find_line 68 internal procedure is called by several nonquick procedures. insert_notice 98 internal procedure is called by several nonquick procedures. report 192 internal procedure uses auto adjustable storage. print_template 80 internal procedure uses auto adjustable storage. imbedded_notices internal procedure shares stack frame of internal procedure report. clean_up 89 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 Inconsistent_args add_pnotice 000052 Not_found add_pnotice STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME add_pnotice 000100 current_year add_pnotice 000101 current_year_a add_pnotice 000102 DFcopy_right add_pnotice 000103 DFtrade_secret add_pnotice 000104 Farchive add_pnotice 000105 Fdisplay add_pnotice 000106 Fcopy_right add_pnotice 000107 Fmode_set add_pnotice 000110 Fmust_reset add_pnotice 000111 Fname add_pnotice 000112 Fpublic_domain add_pnotice 000113 Ftrade_secret add_pnotice 000114 i add_pnotice 000115 Iarg add_pnotice 000116 Idx1 add_pnotice 000117 Itemplate add_pnotice 000120 Larg add_pnotice 000121 ME add_pnotice 000131 Nargs add_pnotice 000132 Parg add_pnotice 000134 bit_count add_pnotice 000135 code add_pnotice 000136 common_archive_name add_pnotice 000146 component add_pnotice 000156 doing_all_components add_pnotice 000157 path add_pnotice 000231 pdir add_pnotice 000304 process_dir add_pnotice 000356 save_name add_pnotice 000366 save_text add_pnotice 000567 seqno add_pnotice 000570 SI_yrno add_pnotice 000571 Sadd_default_pnotice add_pnotice 000572 Sdfcopyright add_pnotice 000573 Sno_args_given add_pnotice 000574 Sold_style_pnotice add_pnotice 000575 Sprt_notice add_pnotice 000576 source_year add_pnotice 000610 source_year_a add_pnotice 000622 used_old_argument add_pnotice 000632 Lcomp add_pnotice 000634 Pal add_pnotice 000636 Parchive_paths add_pnotice 000640 Pcomp_info add_pnotice 000642 Pcomp add_pnotice 000644 Pdesc add_pnotice 000646 comp_bc add_pnotice 000647 comp_name add_pnotice 000657 Lmax_line add_pnotice 000660 Lmove add_pnotice 000661 Lsave add_pnotice 000662 Ltext add_pnotice 000664 Psave add_pnotice 000666 Ptext add_pnotice 000670 Lline add_pnotice 000671 Ltemp add_pnotice 000672 Pline add_pnotice 000674 Ptemp add_pnotice 000676 Lt add_pnotice 000700 Pt add_pnotice 000702 dt add_pnotice 000703 arg_list_arg_count add_pnotice 000704 desc_ add_pnotice 000706 Ppaths add_pnotice 000710 source_info add_pnotice 001220 target_info add_pnotice check_acl 000100 Acode check_acl 000101 old_mode check_acl 000102 acle check_acl 000115 del_acl check_acl continue_processing 000100 Iname continue_processing 000101 Idx1 continue_processing 000102 Idx2 continue_processing 000103 Acode continue_processing 000104 match continue_processing 000105 addC continue_processing 000106 addTS continue_processing 000107 addPD continue_processing 000110 foundPD continue_processing 000111 foundC continue_processing 000112 foundTS continue_processing 000130 continue ok_nine_year_rule 000131 new_pnotice_vers ok_nine_year_rule 000142 new_pnotice_date ok_nine_year_rule 000143 current_pnotice_vers ok_nine_year_rule 000154 current_pnotice_date ok_nine_year_rule 000155 most_recent_date ok_nine_year_rule 000156 Idx2 ok_nine_year_rule get_language_info 000100 Acode get_language_info 000101 Ilang get_language_info 000102 language get_language_info insert_notice 000100 Psource insert_notice 000102 Ptarget insert_notice make_star_box 000100 box_line make_star_box 000141 Idate make_star_box 000142 Inotice make_star_box 000143 Nnotices_in_box make_star_box 000154 Lold_text add_text 000156 TIptr add_text parse_pnotice_ 000100 Iline parse_pnotice_ pnotice_parse 000100 Prest pnotice_parse 000102 Lrest pnotice_parse 000103 Icmt pnotice_parse 000104 cmt_bgn_length pnotice_parse 000105 save_length pnotice_parse 000106 save_ptr pnotice_parse 000110 save_Prest pnotice_parse 000112 Spnotice pnotice_parse 000113 Sstar_line pnotice_parse 000114 Pcomment pnotice_parse 000116 Lcomment pnotice_parse 000120 Pcomment_line pnotice_parse 000122 Lcomment_line pnotice_parse 000124 Ppnotice pnotice_parse 000126 Lpnotice pnotice_parse 000130 Ppnotice_line pnotice_parse 000132 Lpnotice_line pnotice_parse 000134 Ppnotices pnotice_parse 000136 Ptemplate pnotice_parse 000140 Ntemplates_parsed pnotice_parse 000141 Ibreak pnotice_parse 000142 Inonwhite pnotice_parse 000143 Iskip pnotice_parse 000144 Lword_text pnotice_parse 000146 Pword_text pnotice_parse 000150 WORD_BREAKS pnotice_parse 000161 SKIP_CHRS pnotice_parse 000172 Acode pnotice_parse 000173 Ltline pnotice_parse 000174 Ptline pnotice_parse 000206 Inl pnotice_found 000224 Scontinue process_tokens 000225 Sfound process_tokens 000226 Snomatch process_tokens 000260 ret parse_templates_ print_template 000100 store_template print_template process_archive_components 000100 Acode process_archive_components report 000100 Inotice report 000101 Itemplate report 000102 Iyr report 000102 pnames report 000126 Iseg imbedded_notices 000127 Lseg imbedded_notices 000130 Lsub imbedded_notices 000132 Pseg imbedded_notices 000134 Psub imbedded_notices sort_pnotices 000100 V sort_pnotices 000100 Idx1 sort_pnotices 000101 Idx2 sort_pnotices 000102 sorted_data sort_pnotices THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this call_int_other_desc call_int_other return_mac tra_ext_1 alloc_auto_adj bound_ck_signal signal_op enable_op shorten_stack ext_entry int_entry int_entry_desc reverse_cs set_chars_eis index_chars_eis verify_eis search_eis any_to_any_truncate_index_before_cs clock_mac THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. add_char_offset_ archive archive_$get_component archive_$next_component char_offset_ check_star_name_$entry com_err_ cu_$arg_count cu_$arg_ptr cu_$generate_call date_time_$format expand_pathname_$component get_ec_version_ get_group_id_ get_pdir_ get_temp_segment_ hcs_$add_acl_entries hcs_$delentry_seg hcs_$delete_acl_entries hcs_$initiate_count hcs_$list_acl hcs_$make_seg ioa_ pathname_ pathname_$component pnotice_mlr_ pnotice_mrl_ pnotice_paths_ release_temp_segment_ sort_items_$char terminate_file_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$archive_component_modification error_table_$bad_file_name error_table_$badopt error_table_$improper_data_format error_table_$inconsistent error_table_$lower_ring error_table_$name_not_found error_table_$noarg error_table_$nostars error_table_$not_done error_table_$typename_not_found error_table_$user_not_found error_table_$wrong_no_of_args pnotice_language_info_$languages LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 68 002040 303 002046 304 002051 305 002052 310 002053 313 002061 314 002064 319 002066 321 002067 322 002071 323 002072 324 002073 325 002076 326 002077 327 002100 328 002140 329 002150 330 002151 334 002161 336 002203 337 002205 339 002206 340 002217 343 002221 344 002242 346 002243 349 002245 352 002267 354 002270 355 002277 356 002314 359 002330 363 002340 365 002373 367 002374 368 002375 371 002413 372 002415 373 002426 375 002434 376 002435 379 002454 381 002471 384 002503 385 002504 386 002521 389 002523 393 002547 395 002550 398 002563 401 002607 402 002613 406 002614 407 002623 410 002647 411 002652 412 002653 413 002663 416 002664 417 002674 419 002676 420 002677 422 002712 426 002724 427 002727 428 002743 430 002744 432 002746 435 002750 436 002751 439 002752 442 002760 443 002763 444 003021 446 003022 449 003026 450 003031 452 003071 454 003072 457 003100 458 003103 459 003141 461 003142 464 003150 465 003153 467 003176 469 003177 472 003203 473 003206 475 003243 477 003244 481 003250 483 003277 489 003300 491 003327 496 003331 501 003333 504 003341 506 003371 507 003373 510 003377 511 003402 512 003434 514 003435 517 003472 518 003474 519 003475 522 003477 524 003524 525 003526 528 003532 529 003535 530 003565 532 003566 535 003623 536 003625 537 003626 541 003644 546 003707 547 003711 550 003715 551 003720 553 003744 555 003745 557 003752 558 003754 561 003755 563 004002 564 004004 567 004010 568 004013 569 004042 573 004043 576 004100 577 004102 578 004106 581 004110 588 004137 591 004141 592 004162 594 004163 595 004166 598 004177 599 004202 604 004262 607 004331 609 004332 610 004347 613 004351 614 004354 616 004424 618 004425 621 004431 622 004446 625 004450 626 004453 629 004527 631 004530 632 004532 633 004533 636 004564 639 004627 642 004633 644 004704 646 004705 648 004710 651 004712 652 004721 653 004741 654 004744 656 004747 657 004752 658 004754 659 004756 660 004761 661 004762 662 004763 665 005024 666 005034 669 005035 670 005040 671 005042 672 005043 673 005046 674 005047 675 005050 676 005053 677 005055 678 005057 680 005067 683 005073 690 005074 696 005102 697 005105 698 005107 700 005113 703 005122 704 005126 705 005127 706 005130 707 005131 708 005132 709 005133 710 005134 711 005135 712 005154 713 005170 714 005203 715 005206 716 005207 717 005210 718 005211 719 005212 720 005214 722 005237 725 005240 727 005241 728 005242 729 005243 730 005244 731 005245 732 005246 733 005247 734 005250 735 005251 736 005252 737 005253 738 005254 740 005255 764 005256 784 005264 787 005267 788 005270 789 005271 791 005305 794 005342 795 005343 796 005365 799 005367 801 005414 803 005417 805 005421 808 005427 811 005430 813 005432 814 005434 817 005473 820 005475 823 005555 825 005560 828 005565 829 005572 830 005574 831 005600 832 005602 835 005616 836 005622 837 005625 838 005627 839 005636 842 005641 843 005653 846 005654 850 005674 851 005676 852 005703 853 005712 856 005756 859 005760 861 006023 863 006026 865 006040 866 006052 868 006062 875 006127 876 006133 877 006144 884 006237 889 006313 891 006325 894 006326 897 006362 900 006364 902 006446 904 006451 905 006456 906 006463 907 006465 910 006501 912 006534 914 006537 915 006543 916 006546 917 006550 918 006557 921 006562 922 006574 925 006575 929 006615 930 006617 931 006624 932 006633 935 006677 938 006701 940 006744 942 006747 944 006761 945 006773 947 007003 950 007050 951 007054 952 007065 958 007160 962 007234 966 007237 971 007241 973 007246 974 007254 975 007256 976 007260 977 007266 979 007270 981 007304 982 007323 983 007344 984 007357 985 007373 986 007410 988 007424 990 007430 991 007433 993 007475 994 007510 995 007551 997 007554 999 007566 1000 007607 1001 007617 1002 007631 1004 007633 1006 007662 1009 007700 1014 007733 1020 007734 1025 007742 1026 007745 1027 007746 1029 007762 1032 010017 1033 010020 1036 010035 1038 010070 1040 010073 1041 010103 1044 010106 1045 010120 1048 010121 1049 010143 1050 010155 1052 010205 1053 010212 1054 010214 1055 010225 1058 010260 1061 010265 1065 010344 1072 010422 1078 010423 1101 010431 1102 010434 1103 010435 1106 010453 1108 010504 1112 010527 1113 010531 1116 010537 1117 010541 1120 010544 1125 010634 1128 010711 1132 010717 1135 010773 1140 011063 1143 011140 1147 011143 1149 011151 1152 011155 1153 011157 1157 011213 1159 011216 1161 011226 1164 011234 1167 011237 1170 011243 1173 011314 1175 011317 1177 011347 1180 011351 1181 011401 1183 011404 1186 011413 1188 011426 1191 011435 1199 011443 1275 011451 1276 011455 1277 011456 1278 011460 1279 011462 1280 011464 1281 011475 1282 011510 1283 011514 1285 011516 1289 011532 1294 011533 1295 011537 1298 011544 1301 011547 1304 011567 1308 011573 1309 011574 1310 011575 1312 011576 1313 011603 1317 011632 1319 011633 1323 011635 1324 011637 1326 011640 1329 011645 1332 011721 1334 011724 1335 011730 1337 011731 1341 011732 1344 011740 1345 011745 1346 011746 1350 011762 1354 011763 1358 011770 1359 011775 1361 011777 1365 012005 1366 012007 1368 012010 1369 012012 1370 012015 1371 012017 1372 012020 1374 012021 1378 012034 1387 012072 1388 012074 1389 012076 1390 012107 1391 012112 1392 012121 1393 012123 1394 012125 1402 012141 1406 012146 1408 012157 1409 012161 1412 012162 1413 012163 1416 012170 1417 012204 1418 012210 1419 012215 1424 012234 1425 012235 1428 012236 1430 012237 1431 012241 1432 012261 1436 012262 1437 012265 1439 012266 1443 012314 1445 012342 1449 012343 1454 012345 1455 012361 1458 012362 1459 012366 1462 012373 1464 012375 1465 012412 1470 012433 1471 012445 1473 012461 1478 012474 1483 012520 1485 012531 1488 012533 1489 012543 1491 012545 1495 012553 1498 012555 1499 012571 1501 012602 1506 012620 1513 012626 1528 012627 1529 012630 1530 012631 1533 012645 1535 012667 1536 012672 1539 012677 1540 012711 1541 012712 1542 012715 1543 012720 1546 012725 1547 012726 1551 012732 1552 012734 1553 012746 1554 012763 1558 013011 1568 013043 1569 013044 1570 013046 1573 013056 1574 013057 1575 013060 1577 013061 1580 013063 1585 013150 1588 013222 1590 013225 1591 013226 1592 013227 1593 013230 1594 013231 1596 013232 1602 013233 1605 013235 1606 013237 1607 013240 1608 013242 1609 013243 1610 013245 1612 013247 1613 013252 1614 013254 1615 013266 1618 013267 1619 013271 1620 013272 1623 013273 1624 013302 1625 013304 1626 013305 1632 013317 1635 013321 1636 013322 1637 013324 1640 013325 1641 013326 1644 013327 1645 013335 1647 013336 1650 013340 1653 013342 1654 013355 1657 013356 1658 013362 1659 013367 1660 013370 1662 013371 1665 013377 1673 013405 1676 013406 1678 013410 1680 013431 1683 013433 1685 013460 1688 013463 1690 013531 1696 013533 1699 013534 1700 013537 1703 013542 1708 013622 1711 013671 1713 013674 1715 013720 1721 013721 1724 013731 1727 013741 1729 013743 1733 013752 1735 013770 1736 014002 1739 014011 1741 014014 1742 014030 1743 014031 1744 014036 1746 014037 1750 014053 1755 014062 1757 014101 1758 014113 1761 014117 1762 014120 1763 014122 1764 014123 1767 014124 1768 014125 1769 014130 1770 014140 1771 014142 1773 014143 1777 014157 1780 014167 1781 014173 1782 014175 1784 014202 1785 014205 1788 014207 1789 014214 1792 014221 1793 014225 1794 014232 1795 014236 1798 014240 1799 014241 1800 014260 1805 014277 1806 014306 1808 014313 1810 014321 1813 014322 1814 014327 1815 014334 1816 014335 1817 014336 1819 014337 1823 014346 1826 014347 1831 014364 1832 014366 1833 014372 1836 014403 1852 014404 1864 014407 1867 014413 1868 014435 1871 014437 1873 014464 1876 014467 1880 014501 1883 014505 1885 014506 1888 014513 1889 014527 1892 014535 1895 014606 1900 014656 1903 014661 1904 014662 1905 014664 1906 014666 1908 014675 1910 014710 1913 014713 1916 014715 1917 014722 1920 014727 1921 014732 1922 014733 1923 014740 1926 014741 1927 014757 1928 014760 1931 014761 1932 015001 1933 015006 1934 015010 1936 015014 1939 015015 1940 015022 1941 015027 1942 015030 1944 015031 1946 015032 1952 015044 1962 015047 1965 015102 1967 015107 1968 015111 1969 015121 1970 015122 1971 015124 1973 015145 1986 015146 2026 015154 2027 015155 2028 015156 2029 015157 2030 015160 2031 015161 2032 015162 2033 015163 2035 015165 2038 015171 2042 015206 2046 015303 2049 015311 2050 015314 2051 015323 2052 015326 2053 015327 2054 015354 2055 015360 2060 015365 2061 015373 2062 015400 2063 015402 2064 015411 2065 015423 2067 015430 2068 015432 2069 015434 2072 015440 2073 015443 2077 015527 2080 015600 2082 015606 2085 015612 2086 015615 2090 015701 2093 015752 2095 015760 2098 015764 2099 015767 2103 016053 2106 016124 2108 016132 2111 016136 2114 016160 2115 016162 2118 016167 2119 016172 2123 016254 2126 016325 2128 016333 2129 016334 2132 016340 2133 016343 2137 016427 2140 016500 2142 016506 2145 016513 2146 016516 2152 016614 2156 016677 2160 016705 2161 016710 2166 016730 2172 016761 2173 016763 2176 016770 2177 016773 2179 016777 2181 017002 2182 017003 2183 017027 2188 017033 2192 017046 2195 017052 2196 017056 2197 017063 2198 017064 2202 017110 2203 017123 2204 017135 2210 017162 2211 017164 2214 017166 2215 017177 2218 017210 2220 017212 2221 017221 2222 017224 2225 017252 2228 017254 2229 017270 2233 017325 2234 017327 2237 017341 2245 017347 2260 017355 2269 017360 2273 017365 2274 017371 2275 017377 2277 017405 2278 017407 2283 017424 2284 017426 2285 017433 2286 017444 2287 017445 2288 017450 2289 017457 2290 017465 2292 017467 2294 017526 2301 017527 2337 017531 2338 017533 2339 017551 2340 017554 2342 017556 2345 017570 2349 017602 2350 017603 2352 017610 2354 017615 2356 017617 2358 017634 2359 017646 2361 017650 2364 017653 2368 017663 2371 017704 2372 017707 2374 017710 2377 017717 2380 017725 2385 017733 2386 017735 2407 017743 2428 017751 2429 017752 2430 017753 2431 017755 2432 017756 2435 017762 2437 020002 2440 020005 2442 020031 2444 020034 2445 020035 2448 020037 2450 020043 2451 020055 2453 020070 2459 020132 2460 020143 2463 020154 2466 020157 2467 020160 2468 020167 2470 020176 2471 020200 2474 020203 2475 020213 2477 020220 2478 020223 2479 020227 2482 020230 2483 020232 2484 020234 2487 020241 2492 020340 2495 020425 2497 020430 2498 020442 2499 020444 2500 020456 2502 020464 2504 020465 2506 020472 2507 020473 2508 020477 2510 020503 2514 020513 2515 020516 2516 020536 2517 020541 2518 020562 2519 020565 2520 020605 2521 020610 2523 020613 2524 020625 2525 020640 2526 020661 2527 020664 2528 020667 2529 020703 2530 020723 2531 020726 2532 020727 2533 020750 2534 020770 2535 020773 2536 021005 2539 021015 2541 021020 2543 021021 2548 021031 2549 021034 2550 021054 2551 021057 2552 021071 2553 021074 2554 021114 2555 021117 2557 021122 2558 021134 2559 021146 2560 021160 2561 021163 2562 021177 2563 021217 2564 021222 2565 021223 2566 021235 2567 021240 2568 021260 2570 021270 2576 021271 2591 021272 2595 021275 2596 021301 2598 021302 2604 021313 2605 021316 2606 021320 2607 021334 2609 021335 2615 021346 2616 021351 2617 021355 2618 021370 2620 021371 2626 021402 2627 021405 2628 021410 2629 021423 2638 021424 2677 021445 2678 021452 2680 021466 2682 021527 2685 021532 2686 021551 2687 021557 2690 021560 2692 021572 2693 021573 2694 021574 2695 021575 2696 021645 2703 021660 2706 021662 2707 021663 2709 021664 2710 021671 2712 021673 2713 021675 2714 021676 2715 021677 2716 021735 2719 021737 2721 022002 2723 022005 2724 022012 2725 022013 2728 022056 2733 022061 2736 022102 2738 022114 2741 022122 2742 022124 2743 022125 2744 022126 2745 022164 2748 022166 2750 022231 2752 022232 2755 022233 2756 022236 2757 022237 2758 022275 2760 022342 2762 022343 2781 022344 2795 022354 2799 022400 2800 022402 2801 022414 2802 022423 2803 022425 2805 022427 2810 022453 2814 022463 2815 022470 2816 022472 2818 022503 2821 022513 2834 022544 2857 022552 2858 022561 2861 022565 2865 022612 2871 022635 2873 022644 2878 022654 2883 022705 2894 022706 2910 022714 2965 022724 2914 022734 2917 022736 2922 023025 2924 023067 2927 023143 2929 023204 2931 023205 2934 023211 2936 023253 2937 023265 2938 023277 2944 023341 2945 023351 2947 023356 2951 023412 2952 023413 2953 023416 2955 023433 2957 023437 2958 023441 2959 023443 2962 023444 2963 023454 2964 023470 2965 023472 2968 023540 2970 023541 2973 023547 2992 023557 2990 023562 2991 023571 2992 023576 2993 023614 3003 023615 3024 023617 3025 023622 3026 023624 3027 023625 3028 023626 3029 023637 3031 023657 3032 023664 3033 023666 3036 023721 3042 023727 3046 023735 3049 023740 3052 023770 3055 023771 3058 023775 3060 024006 3063 024015 3065 024027 3066 024032 3069 024053 3072 024106 3078 024137 3081 024144 3082 024156 3085 024230 3086 024233 3090 024254 3094 024302 ----------------------------------------------------------- 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