COMPILATION LISTING OF SEGMENT xdw_ Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/23/85 1039.8 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* format: style2,ind3,ll80,dclind4,idind16,comcol41,linecom */ 10 11 /* FUTURE &fileout name ... &filend */ 12 13 xdw_: 14 macro_: 15 proc (sl_name, segname, macname, out_ptr, out_len, arglp, argct, msg, refseg, 16 ecode); 17 18 segtype = "MACRO"; 19 if (sl_name = "macro") 20 then who_am_i = "MACRO"; 21 else who_am_i = "EXPANSION"; 22 mac_sw = "1"b; 23 segptr = null (); 24 refp = refseg; 25 goto start; 26 27 expand: 28 entry (sl_name, segname, macname, out_ptr, out_len, arglp, argct, msg, 29 strptr, strlen, ecode); 30 31 if (segname = "") 32 then segtype = "STRING"; 33 else segtype = "SEGMENT"; 34 myname = "source " || segtype; 35 mac_sw = "0"b; 36 refp = null (); 37 segptr = strptr; 38 segi = 1; 39 sege = strlen; 40 goto start; 41 42 dcl sl_name char (32) var,/* search list name */ 43 segname char (32) var,/* name of segment to find */ 44 /* "" -> not specified */ 45 macname char (32) var,/* name of macro to expand */ 46 /* "" -> expanding a string */ 47 out_ptr ptr, /* output string (not aligned) */ 48 out_len fixed bin (24), 49 /* length of output produced (Out) */ 50 arglp ptr, /* pointer to argument list */ 51 argct fixed bin, /* number of arguments */ 52 msg char (1000) var, 53 /* error message text */ 54 refseg ptr, /* pointer to referencing segment */ 55 strptr ptr, /* pointer to string to expand */ 56 strlen fixed bin (24), 57 /* length of string to expand */ 58 ecode fixed bin (35); 59 60 dcl 1 argl (24) based (arglp), 61 2 p ptr, 62 2 l fixed bin (24); 63 dcl arg char (argl.l (num)) based (argl.p (num)); 64 dcl num fixed bin (24); 65 dcl refp ptr; 66 67 start: 68 if free_area_p = null () 69 then call get_area; 70 local_var_ptr, int_var_ptr = null (); 71 msg_etc = ""; 72 73 do num = 1 to argct; 74 if (argl.l (num) < 0) 75 then signal condition (argleng_less_than_zero); 76 if (argl.l (num) > 500) 77 then 78 do; 79 msg = "ARG "; 80 msg = msg || ltrim (char (num)); 81 msg = msg || " >500 characters."; 82 ecode = -1; 83 return; 84 end; 85 end; 86 msg = ""; 87 ecode = 0; 88 macro_nest = macro_nest + 1; 89 90 save_db = db_sw; 91 if (segtype = "STRING") | (segptr ^= null ()) 92 then goto doit; 93 94 /* name = "macro" | "foo$foo" | "foo$bar" */ 95 if mac_sw 96 then 97 do; 98 c32 = segname; 99 if (c32 = "") 100 then 101 do; 102 if db_sw 103 then call ioa_ (""""" ^a", macname); 104 myname = macname; 105 do maclp = macro_list_p repeat (macro_list.next) 106 while (maclp ^= null ()); 107 if macro_list.int_mac 108 then 109 do; 110 if db_sw 111 then call ioa_ (" ^a/^a", 112 substr (macro_list.dname, 1, 1), 113 macro_list.name); 114 if (macro_list.name = macname) 115 then 116 do; 117 segptr = macro_list.ref; 118 segi = macro_list.from; 119 sege = macro_list.to; 120 goto doit; 121 end; 122 end; 123 end; 124 c32 = macname; /* didn't find an imbedded macro by */ 125 end; /* this name, try for macro$macro. */ 126 if db_sw 127 then call ioa_ ("^a$^a", c32, macname); 128 myname = c32; 129 myname = myname || "$"; 130 myname = myname || macname; 131 do maclp = macro_list_p repeat (macro_list.next) 132 while (maclp ^= null ()); 133 if ^macro_list.int_mac 134 then 135 do; 136 if db_sw 137 then call ioa_ (" ^a/^a", macro_list.ename, 138 macro_list.name); 139 if (macro_list.ename = c32) & (macro_list.name = macname) 140 then 141 do; 142 segptr = macro_list.ref; 143 segi = macro_list.from; 144 sege = macro_list.to; 145 goto doit; 146 end; 147 end; 148 end; 149 end; 150 151 call find_macro (refp, segname, sl_name, macname); 152 153 doit: 154 tr_sw = "0"b; 155 if (substr (segment, segi, 7) = "&trace 156 ") 157 then 158 do; 159 segi = segi + 7; 160 tr_sw = "1"b; 161 end; 162 if (substr (segment, segi, 7) = "&debug 163 ") 164 then 165 do; 166 segi = segi + 7; 167 db_sw = "1"b; 168 end; 169 if db_sw | pc_sw | tr_sw | al_sw 170 then 171 do; 172 call ioa_ ("^[EXPAND^s^;^a^](^i) ^a", (who_am_i = "EXPANSION"), 173 segtype, macro_nest, macname); 174 do num = 1 to argct; 175 call ioa_ ("ARG^2i: ""^va""", num, argl.l (num), arg); 176 end; 177 if (argct = 0) 178 then call ioa_ ("ARGs: none"); 179 end; 180 construct_nest = 1; 181 call_err = "0"b; 182 call expand (segptr, segi, sege, out_ptr, out_len, "11"b); 183 quit: 184 if db_sw | pc_sw | tr_sw | al_sw 185 then call ioa_ (" ^[MEND^;EXPEND^](^i) ^a", (who_am_i = "MACRO"), 186 macro_nest, macname); 187 188 if (segi < sege) 189 then 190 do; 191 misplaced: 192 msg = "Misplaced """; 193 msg = msg || c32; 194 msg = msg || """. "; 195 196 add_identification: 197 ecode = error_table_$badsyntax; 198 add_id: 199 if call_err 200 then msg = msg || " 201 from"; 202 if segtype = "MACRO" 203 then 204 do; 205 msg = msg || " "; 206 msg = msg || who_am_i; 207 end; 208 msg = msg || " """; 209 msg = msg || myname; 210 msg = msg || """, line "; 211 msg = msg || lineno (segi); 212 if ^call_err 213 then 214 do; 215 msg = " 216 ERROR SEVERITY 4. " || msg; 217 if (msg_etc ^= "") 218 then 219 do; 220 msg = msg || NL; 221 msg = msg || msg_etc; 222 end; 223 end; 224 end; 225 exit: 226 macro_nest = macro_nest - 1; 227 tptr = local_var_ptr; 228 call free_um ("loc"); 229 if (err_ct (3) ^= 0) & (err_ct (4) = 0) 230 then ecode = error_table_$translation_failed; 231 db_sw = save_db; 232 return; 233 234 235 syntax_err: 236 msg = "Syntax error in " || msg; 237 msg = msg || ". "; 238 goto add_identification; 239 240 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 241 /* */ 242 /* add a macro to the list of known macros */ 243 244 addmacro: 245 proc (dname, segname, macname, int_mac, segp, segi, sege); 246 247 dcl dname char (168), 248 segname char (32) var, 249 macname char (32) var, 250 int_mac bit (1), /* 1- is ¯o/&define */ 251 segp ptr, 252 segi fixed bin (24), 253 sege fixed bin (24); 254 255 if db_sw 256 then call ioa_ ("addmacro ^a > ^a (^p) ^a^[ INTERNAL^]", dname, segname, 257 segp, macname, int_mac); 258 do maclp = macro_list_p repeat (macro_list.next) while (maclp ^= null ()); 259 if (macro_list.ename = segname) & (macro_list.name = macname) 260 & (macro_list.int_mac = int_mac) 261 then 262 do; 263 if (segptr = macro_list.ref) & (segi = macro_list.from) 264 & (sege = macro_list.to) 265 then 266 do; 267 if db_sw 268 then call ioa_ (" already there"); 269 return; 270 end; 271 msg = who_am_i; 272 msg = msg || " already defined."; 273 goto add_identification; 274 end; 275 end; 276 allocate macro_list in (free_area); 277 if al_sw 278 then call ioa_ ("A macro_list ^i ^p", size (macro_list), maclp); 279 macro_list.name = macname; 280 macro_list.ref = segp; 281 macro_list.dname = dname; 282 macro_list.ename = segname; 283 macro_list.from = segi; 284 macro_list.to = sege; 285 macro_list.int_mac = int_mac; 286 macro_list.next = macro_list_p; 287 macro_list_p = maclp; 288 if db_sw 289 then call ioa_ ("addmac ^16a ^p ^i:^i^/^-^a > ^a", macro_list.name, 290 macro_list.ref, macro_list.from, macro_list.to, 291 macro_list.dname, macro_list.ename); 292 293 end addmacro; 294 295 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 296 /* */ 297 /* An ampersand has been found, handle it. */ 298 299 ampersand: 300 proc (ifp, ifi, ife, ofp, ofe, TF, err_sw) recursive; 301 302 dcl ifp ptr, /* pointer to input */ 303 ifi fixed bin (24), 304 /* first char of input to use */ 305 ife fixed bin (24), 306 /* last char of input to use */ 307 ofp ptr, /* pointer to output */ 308 ofe fixed bin (24), 309 /* last char of output used */ 310 TF bit (2), 311 err_sw bit (1); /* 0- misplaced are error */ 312 /* 1- misplaced no sweat */ 313 dcl begl fixed bin (24); 314 dcl inputa (ife) char (1) based (ifp); 315 dcl input char (ife) based (ifp); 316 dcl output char (1044480) based (ofp); 317 dcl (i, j, ii, jj) fixed bin (24); 318 319 320 begl = ifi; 321 if db_sw 322 then call dumper ("ampr", ifp, ifi, ife, ofp, ofe, TF); 323 if (ifi >= ife) 324 then 325 do; 326 msg = "Orphan &."; 327 goto add_identification; 328 end; 329 i = index ("0123456789", inputa (ifi + 1)); 330 if (i ^= 0) 331 then 332 do; 333 num = i - 1; 334 i = index ("0123456789", inputa (ifi + 2)); 335 if (i ^= 0) 336 then 337 do; 338 num = num * 10 + i - 1; 339 ifi = ifi + 1; 340 end; 341 ifi = ifi + 2; 342 if (num <= argct) 343 then 344 do; 345 substr (output, ofe + 1, argl.l (num)) = arg; 346 ofe = ofe + argl.l (num); 347 end; 348 end; 349 else 350 do; 351 ch_2nd = inputa (ifi + 1); 352 if (ch_2nd = "{") 353 then call arg_range (ifp, ifi, ife, ofp, ofe, TF); 354 355 else if (ch_2nd = "*") 356 then 357 do; 358 ifi = ifi + 2; 359 c32 = ltrim (char (argct)); 360 substr (output, ofe + 1, length (c32)) = c32; 361 ofe = ofe + length (c32); 362 end; 363 364 else if (ch_2nd = ".") /* &. null separator */ 365 then ifi = ifi + 2; 366 367 else if (ch_2nd = "+") /* &+ null separator, */ 368 then call strip2 (ifp, ifi, ife); 369 /* grabs trailing space */ 370 371 else if (ch_2nd = "[") 372 then call macro_af (ifp, ifi, ife, ofp, ofe, TF); 373 374 else if (ch_2nd = "(") 375 then call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 376 377 else if (ch_2nd = """") 378 then call protected (ifp, ifi, ife, ofp, ofe); 379 380 else if (ch_2nd = ";") 381 then 382 do; 383 c32 = "&;"; 384 return; 385 end; 386 387 else if (ch_2nd = "&") 388 then 389 do; 390 substr (output, out_len + 1, 1) = "&"; 391 out_len = out_len + 1; 392 ifi = ifi + 2; 393 end; 394 else 395 do; 396 variable: 397 i = verify (substr (input, ifi + 1), token_chars); 398 399 if (i = 0) 400 then i = ife - ifi + 1; 401 if (i > 1) 402 then 403 do; 404 if (i > 26) 405 then 406 do; 407 msg = who_am_i; 408 msg = msg || " name > 26 chars."; 409 goto add_identification; 410 end; 411 c32 = substr (input, ifi + 1, i - 1); 412 c32x = ""; 413 414 if (inputa (ifi + i) = "$") 415 then 416 do; 417 ifi = ifi + i; 418 ii = verify (substr (input, ifi + 1), token_chars) 419 ; 420 if (ii = 0) 421 then i = 0; 422 /* error */ 423 else if (inputa (ifi + ii) = "(") 424 then 425 do; 426 i = ii; 427 c32x = c32; 428 c32 = substr (input, ifi + 1, i - 1); 429 end; 430 end; 431 432 if (inputa (ifi + i) = "(") & (ife > ifi + i) 433 then 434 do; 435 ifi = ifi + i + 1; 436 call macro_call (ifp, ifi, ife, ofp, ofe, TF); 437 end; 438 439 else if (inputa (ifi + i) = "{") & (ife > ifi + i) 440 then 441 do; 442 ifi = ifi + i + 1; 443 call var_range (ifp, ifi, ife, ofp, ofe, TF); 444 end; 445 446 /* arg */ 447 else if (c32 = "lbound") 448 then call var_bound (ifp, ifi, ife, ofp, ofe, TF); 449 else if (c32 = "hbound") 450 then call var_bound (ifp, ifi, ife, ofp, ofe, TF); 451 452 else if (c32 = "empty") 453 then call macro_empty (ifp, ifi, ife, ofp, ofe, TF); 454 455 else if (c32 = "error") 456 then call macro_error (ifp, ifi, ife, ofp, ofe, TF); 457 458 else if (c32 = "comment") 459 then 460 do; 461 i = index (substr (input, ifi), "&;"); 462 if (i = 0) 463 then 464 do; 465 msg = "&;"; 466 call error_missing ("comment", begl, ife); 467 end; 468 ifi = ifi + i + 1; 469 return; 470 end; 471 472 else if (c32 = "usage") 473 then call macro_usage (ifp, ifi, ife, ofp, ofe, TF); 474 475 else if (c32 = "quote") 476 then call macro_quote (ifp, ifi, ife, ofp, ofe, TF); 477 478 else if (c32 = "unquote") 479 then call macro_unquote (ifp, ifi, ife, ofp, ofe, TF); 480 481 else if (c32 = "return") 482 then 483 do; 484 segi = sege + 1; 485 goto quit; 486 end; 487 488 else if (c32 = "scan") 489 then call macro_scan (ifp, ifi, ife, ofp, ofe, TF); 490 491 else if (c32 = "define") 492 then call macro_define (ifp, ifi, ife, ofp, ofe, TF); 493 494 else if (c32 = "substr") 495 then call macro_substr (ifp, ifi, ife, ofp, ofe, TF); 496 497 else if (c32 = "length") 498 then call macro_length (ifp, ifi, ife, ofp, ofe, TF); 499 500 else if (c32 = "let") 501 then call macro_let (ifp, ifi, ife, ofp, ofe, TF, 0); 502 503 else if (c32 = "ext") 504 then call macro_let (ifp, ifi, ife, ofp, ofe, TF, 1); 505 506 else if (c32 = "int") 507 then call macro_let (ifp, ifi, ife, ofp, ofe, TF, 2); 508 509 else if (c32 = "loc") 510 then call macro_let (ifp, ifi, ife, ofp, ofe, TF, 3); 511 512 else if (c32 = "do") 513 then call macro_do (ifp, ifi, ife, ofp, ofe, TF); 514 515 else if (c32 = "if") 516 then call macro_if (ifp, ifi, ife, ofp, ofe, TF); 517 518 else if (c32 = "od") | (c32 = "fi") | (c32 = "then") 519 | (c32 = "else") | (c32 = "elseif") 520 | (c32 = "while") 521 then 522 do; 523 c32 = "&" || c32; 524 if ^err_sw 525 then goto misplaced; 526 return; 527 end; 528 529 else if (c32 = "expand") 530 then 531 do; 532 start_sym = "expand"; 533 end_sym = "expend"; 534 goto macdef; 535 end; 536 else if (c32 = "macro") 537 then 538 do; 539 start_sym = "macro"; 540 end_sym = "mend"; 541 macdef: 542 if construct_nest > 1 543 then 544 do; 545 macnest_err: 546 msg = "&"; 547 msg = msg || start_sym; 548 msg = msg 549 || 550 " may not be nested in any other construct." 551 ; 552 goto add_id; 553 end; 554 ifi = ifi + i; 555 if (substr (input, ifi, 1) ^= " ") 556 then 557 do; 558 macdef_err: 559 call error_syntax ((start_sym), begl, ifi); 560 end; 561 ifi = ifi + 1; 562 i = verify (substr (input, ifi), 563 "abcdefghijklmnopqrstuvwxyz" 564 || "ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"); 565 if (i = 0) 566 then goto macdef_err; 567 if (i < 2) 568 then 569 do; 570 msg = "name"; 571 call error_missing ((start_sym), begl, ifi); 572 end; 573 i = i - 1; 574 c32 = substr (input, ifi, i); 575 ifi = ifi + i; 576 if (inputa (ifi) ^= NL) 577 then goto macdef_err; 578 ifi = ifi + 1; 579 i = index (substr (input, ifi), 580 "&" || end_sym || " 581 "); 582 if (i = 0) 583 then 584 do; 585 no_mend: 586 msg = "&"; 587 msg = msg || end_sym; 588 msg = msg || ""; 589 call error_missing ((start_sym), begl, ife); 590 end; 591 if (index (substr (input, ifi, i - 1), "¯o ") 592 ^= 0) 593 | ( 594 index (substr (input, ifi, i - 1), 595 "&expand ") ^= 0) 596 then goto no_mend; 597 call hcs_$fs_get_path_name (ifp, dname, 0, ename, 598 0); 599 call addmacro (" &" || start_sym || " in " 600 || myname, "", c32, "1"b, ifp, ifi, 601 ifi + i - 2); 602 ifi = ifi + i + length (end_sym) + 1; 603 end; 604 else 605 do; 606 call var_ref (ifp, ifi, ife, ofp, ofe, TF); 607 ifi = ifi + i; 608 end; 609 end; 610 else 611 do; 612 msg = "Unrecognized &control """; 613 msg = msg || c32; 614 msg = msg || """. "; 615 goto add_identification; 616 end; 617 end; 618 end; 619 end ampersand; 620 621 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 622 /* */ 623 /* parse an argument range specification. */ 624 625 arg_range: 626 proc (ifp, ifi, ife, ofp, ofe, TF); 627 628 dcl ifp ptr, /* pointer to input */ 629 ifi fixed bin (24), 630 /* first char of input to use */ 631 ife fixed bin (24), 632 /* last char of input to use */ 633 ofp ptr, /* pointer to output */ 634 ofe fixed bin (24), 635 /* last char of output used */ 636 TF bit (2); 637 dcl begl fixed bin (24); 638 dcl inputa (ife) char (1) based (ifp); 639 dcl input char (ife) based (ifp); 640 dcl output char (1044480) based (ofp); 641 dcl (i, j, ii, jj) fixed bin (24); 642 dcl separator char (150) var; 643 644 /* &{ ARITH } yields argument ARITH */ 645 /* &{ ARITH : ARITH } yields arguments ARITH thru ARITH */ 646 /* separated by a SP */ 647 /* &{ ARITH : ARITH , STRING } yields arguments ARITH thru ARITH */ 648 /* separated by STRING */ 649 650 begl = ifi; 651 ii = ofe; 652 i = 1; 653 j = argct; 654 call get_range (ifp, ifi, ife, ofp, ofe, TF, i, j); 655 separator = " "; 656 if (inputa (ifi) = ",") 657 then 658 do; 659 ifi = ifi + 1; 660 do while ("1"b); 661 jj = search (substr (input, ifi), "&}"); 662 if (jj = 0) 663 then 664 do; 665 msg = "}"; 666 call error_missing ("{", begl, ife); 667 end; 668 if (jj > 1) 669 then 670 do; 671 jj = jj - 1; 672 substr (output, ofe + 1, jj) = substr (input, ifi, jj); 673 ifi = ifi + jj; 674 ofe = ofe + jj; 675 end; 676 if (inputa (ifi) = "}") 677 then 678 do; 679 separator = substr (output, ii + 1, ofe - ii); 680 ofe = ii; 681 goto end_range; 682 end; 683 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 684 end; 685 end; 686 if (inputa (ifi) = "}") 687 then 688 do; 689 end_range: 690 ifi = ifi + 1; 691 if (TF = "00"b) 692 then return; 693 j = min (j, argct); 694 do num = i to j; 695 substr (output, ofe + 1, argl.l (num)) = arg; 696 ofe = ofe + argl.l (num); 697 if (num ^= j) 698 then 699 do; 700 substr (output, ofe + 1, length (separator)) = separator; 701 ofe = ofe + length (separator); 702 end; 703 end; 704 end; 705 else 706 do; 707 call error_syntax ("{", begl, ifi); 708 end; 709 end arg_range; 710 711 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 712 /* */ 713 /* process an arithmetic expression. */ 714 715 arithmetic: 716 proc (ifp, ifi, ife, ofp, ofe, TF); 717 718 dcl ifp ptr, /* pointer to input */ 719 ifi fixed bin (24), 720 /* first char of input to use */ 721 ife fixed bin (24), 722 /* last char of input to use */ 723 ofp ptr, /* pointer to output */ 724 ofe fixed bin (24), 725 /* last char of output used */ 726 TF bit (2); 727 dcl begl fixed bin (24); 728 dcl inputa (ife) char (1) based (ifp); 729 dcl input char (ife) based (ifp); 730 dcl output char (1044480) based (ofp); 731 dcl (i, j, ii, jj) fixed bin (24); 732 dcl level fixed bin (24); 733 dcl (vl, sl) fixed bin (24); 734 dcl val (20) fixed dec (59, 9); 735 dcl stk (20) fixed bin (24); 736 dcl pic60 pic "(49)-9v.(9)9"; 737 dcl ch60 char (60) var; 738 dcl v fixed dec (59, 9); 739 740 ifi, begl = ifi + 2; 741 if db_sw 742 then call dumper ("arth", ifp, ifi, ife, ofp, ofe, TF); 743 ii = ofe; 744 substr (output, ofe + 1, 1) = "("; 745 ofe = ofe + 1; 746 level = 1; 747 construct_nest = construct_nest + 1; 748 loop: 749 i = search (substr (input, ifi), "&(),:}"); 750 if (i = 0) 751 then 752 do; 753 msg = "Missing arithmetic terminator. "; 754 goto add_identification; 755 end; 756 if (i > 1) 757 then 758 do; 759 i = i - 1; 760 substr (output, ofe + 1, i) = substr (input, ifi, i); 761 ofe = ofe + i; 762 ifi = ifi + i; 763 end; 764 goto type (index ("&(),:}", inputa (ifi))); 765 766 type (1): /* & */ 767 /* */ 768 if (substr (input, ifi, 2) = "&;") 769 then goto type (4); /* It stops scan, but is not used up */ 770 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 771 goto loop; 772 773 type (2): /* ( */ 774 /* */ 775 substr (output, ofe + 1, 1) = "("; 776 ofe = ofe + 1; 777 level = level + 1; 778 ifi = ifi + 1; 779 goto loop; 780 781 type (4): /* , */ 782 /* */ 783 type (5): /* : */ 784 /* */ 785 type (6): /* } */ 786 /* */ 787 if (level > 1) 788 then goto arith_err; 789 ifi = ifi - 1; /* don't want to use up this char */ 790 type (3): /* ) */ 791 /* */ 792 substr (output, ofe + 1, 1) = ")"; 793 ofe = ofe + 1; 794 ifi = ifi + 1; 795 level = level - 1; 796 if (level > 0) 797 then goto loop; 798 construct_nest = construct_nest - 1; 799 800 if (TF = "00"b) 801 then 802 do; 803 ofe = ii; 804 return; 805 end; 806 807 sl = 1; 808 vl = 0; 809 stk (1) = 16; 810 811 if db_sw | tr_sw 812 then 813 do; 814 call ioa_$nnl ("#^a:^a^-arith ", lineno (begl), lineno (ifi - 1)); 815 call show_string (substr (output, ii + 1, ofe - ii), " 816 "); 817 end; 818 do i = ii + 1 to ofe; 819 /**** format: off */ 820 /* "---------1111111111222222 22 2 */ 821 /* "---------0123456789012345 67 8 */ 822 dcl arithchar char (28) int static init ("0123456789(=^=<=>=+-*/) ."" 823 "); /**** format: on */ 824 j = index (arithchar, substr (output, i, 1)); 825 if (j = 0) 826 then 827 do; 828 jj = verify (substr (output, i), 829 "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789" 830 ); 831 if (jj = 0) 832 then jj = ife - ifi + 1; 833 if (jj = 1) 834 then goto arith_err; 835 goto arith_err; 836 end; 837 retry: 838 if lg_sw 839 then if db_sw 840 then 841 do; 842 call ioa_ ("^3i :^1a:", i, substr (output, i, 1)); 843 do jj = 1 to sl; 844 call ioa_$nnl (" ^1a", substr (arithchar, stk (jj), 1)); 845 end; 846 call ioa_ ("."); 847 do jj = 1 to vl; 848 call ioa_$nnl (" ^f", val (jj)); 849 end; 850 call ioa_ ("#"); 851 end; 852 if (j > 10) 853 then goto type (j); 854 855 type (26): /* decimal point */ 856 jj = verify (substr (output, i), ".0123456789") - 1; 857 if (jj = 0) 858 then jj = ife - ifi + 1; 859 vl = vl + 1; 860 val (vl) = convert (val (1), substr (output, i, jj)); 861 sl = sl + 1; 862 stk (sl) = 10; 863 i = i + jj - 1; 864 goto endloop; 865 866 type (23): /* ) */ 867 /* */ 868 if (stk (sl) ^= 10) 869 then goto arith_err; 870 goto calc (stk (sl - 1)); 871 872 type (13): /* ^ */ 873 /* */ 874 type (15): /* < */ 875 /* */ 876 type (17): /* > */ 877 /* */ 878 if (substr (output, i + 1, 1) = "=") 879 then 880 do; 881 i = i + 1; 882 j = j + 1; 883 end; 884 if (j = 13) 885 then goto type (11); 886 type (14): /* ^= */ 887 /* */ 888 type (16): /* <= */ 889 /* */ 890 type (18): /* >= */ 891 /* */ 892 type (12): /* = */ 893 /* */ 894 type (21): /* * */ 895 /* */ 896 type (22): /* / */ 897 /* */ 898 if (stk (sl) ^= 10) 899 then 900 do; 901 type (27): /* quoted string not handled yet */ 902 arith_err: 903 msg = "Arithmetic syntax error. "; 904 msg = msg || substr (arithchar, stk (sl), 1); 905 msg = msg || substr (arithchar, j, 1); 906 msg = msg || " """; 907 msg = msg || substr (output, ii + 1, i - ii); 908 msg = msg || """ "; 909 goto add_identification; 910 end; 911 912 type (19): /* + */ 913 /* */ 914 type (20): /* - */ 915 /* */ 916 if (stk (sl) = 21) 917 then goto arith_err; 918 if (stk (sl) = 22) 919 then goto arith_err; 920 if (stk (sl) > 10) 921 then 922 do; 923 vl = vl + 1; 924 val (vl) = 0; 925 sl = sl + 1; 926 stk (sl) = 10; 927 end; 928 if (stk (sl - 1) >= j) 929 then goto calc (stk (sl - 1)); 930 sl = sl + 1; 931 stk (sl) = j; 932 goto endloop; 933 934 type (11): /* ( */ 935 /* */ 936 if (stk (sl) = 10) 937 then goto arith_err; 938 sl = sl + 1; 939 stk (sl) = j; 940 goto endloop; 941 942 calc (12): /* = */ 943 /* */ 944 if (val (vl - 1) = val (vl)) 945 then v = 1; 946 else v = 0; 947 goto calc_common; 948 949 950 calc (13): /* ^ */ 951 /* */ 952 if (val (vl) = 0) 953 then val (vl) = 1; 954 else val (vl) = 0; 955 sl = sl - 1; 956 stk (sl) = 10; 957 goto retry; 958 959 960 calc (14): /* ^= */ 961 /* */ 962 if (val (vl - 1) ^= val (vl)) 963 then v = 1; 964 else v = 0; 965 goto calc_common; 966 967 968 calc (15): /* < */ 969 /* */ 970 if (val (vl - 1) < val (vl)) 971 then v = 1; 972 else v = 0; 973 goto calc_common; 974 975 976 calc (16): /* <= */ 977 /* */ 978 if (val (vl - 1) <= val (vl)) 979 then v = 1; 980 else v = 0; 981 goto calc_common; 982 983 984 calc (17): /* > */ 985 /* */ 986 if (val (vl - 1) > val (vl)) 987 then v = 1; 988 else v = 0; 989 goto calc_common; 990 991 992 calc (18): /* >= */ 993 /* */ 994 if (val (vl - 1) >= val (vl)) 995 then v = 1; 996 else v = 0; 997 goto calc_common; 998 999 1000 1001 calc (19): /* + */ 1002 /* */ 1003 v = val (vl - 1) + val (vl); 1004 goto calc_common; 1005 1006 calc (20): /* - */ 1007 /* */ 1008 v = val (vl - 1) - val (vl); 1009 goto calc_common; 1010 1011 calc (21): /* * */ 1012 /* */ 1013 v = val (vl - 1) * val (vl); 1014 goto calc_common; 1015 1016 calc (22): /* / */ 1017 /* */ 1018 v = val (vl - 1) / val (vl); 1019 calc_common: 1020 vl = vl - 1; 1021 val (vl) = v; 1022 sl = sl - 2; 1023 stk (sl) = 10; 1024 goto retry; 1025 1026 1027 calc (11): /* ( */ 1028 /* */ 1029 if (j = 23) 1030 then 1031 do; 1032 sl = sl - 1; 1033 stk (sl) = 10; 1034 goto endloop; 1035 end; 1036 goto arith_err; 1037 1038 type (24): /* SP */ 1039 /* */ 1040 type (25): /* HT */ 1041 /* */ 1042 type (28): /* NL */ 1043 /* */ 1044 endloop: 1045 end; 1046 ofe = ii; 1047 ch60 = ltrim (rtrim (rtrim (convert (pic60, val (1)), "0"), ".")); 1048 substr (output, ofe + 1, length (ch60)) = ch60; 1049 ofe = ofe + length (ch60); 1050 end arithmetic; 1051 1052 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1053 /* */ 1054 /* convert a text string for debug display. */ 1055 1056 cvt: 1057 proc (ifp, ifi, ife) returns (char (32) var); 1058 1059 dcl res char (32) var; 1060 dcl ifp ptr; 1061 dcl (ifi, ife) fixed bin (24); 1062 dcl i fixed bin (24); 1063 dcl begl fixed bin (24); 1064 dcl inputa (ife) char (1) based (ifp); 1065 dcl ch char (1); 1066 1067 res = """"; 1068 do i = ifi to min (ifi + 15, ife); 1069 ch = inputa (i); 1070 if (ch < " ") 1071 then ch = "~"; 1072 res = res || ch; 1073 end; 1074 res = res || """"; 1075 return (res); 1076 1077 end cvt; 1078 1079 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1080 /* */ 1081 /* show a bunch of debugging information. */ 1082 1083 dumper: 1084 proc (text, ifp, ifi, ife, ofp, ofe, TF); 1085 1086 dcl text char (4), 1087 ifp ptr, 1088 (ifi, ife) fixed bin (24), 1089 ofp ptr, 1090 ofe fixed bin (24), 1091 TF bit (2); 1092 1093 call ioa_ ("^2i.^2i ^4a TF^.1b ^i:^i ^i^-^a - ^a", macro_nest, 1094 construct_nest, text, TF, ifi, ife, ofe, cvt (ifp, ifi, ife), 1095 cvt (ofp, max (1, ofe - 15), ofe)); 1096 1097 end dumper; 1098 1099 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1100 /* */ 1101 /* ERROR MESSAGE procs */ 1102 1103 error_missing: 1104 proc (who, begl, endl); 1105 1106 dcl who char (*), 1107 begl fixed bin (24), 1108 endl fixed bin (24); 1109 1110 dcl hold char (1000) var; 1111 dcl (cline, eline) char (6) var; 1112 1113 hold = "Missing "; 1114 hold = hold || msg; 1115 goto common; 1116 1117 error_syntax: 1118 entry (who, begl, endl); 1119 1120 hold = "Syntax error"; 1121 goto common; 1122 1123 error_misplaced: 1124 entry (who, begl, endl); 1125 1126 hold = "Misplaced "; 1127 hold = hold || msg; 1128 goto common; 1129 1130 error_gen: 1131 entry (who, begl, endl); 1132 1133 hold = msg; 1134 goto common; 1135 1136 error_attempt: 1137 entry (who, begl, endl); 1138 1139 hold = "Attempt to "; 1140 hold = hold || msg; 1141 goto common; 1142 1143 common: 1144 hold = hold || " in """; 1145 cline = lineno (begl); 1146 eline = lineno (endl); 1147 1148 msg = " 1149 ERROR SEVERITY 4. "; 1150 msg = msg || who_am_i; 1151 msg = msg || " """; 1152 msg = msg || myname; 1153 msg = msg || """, line "; 1154 msg = msg || eline; 1155 msg = msg || ". 1156 "; 1157 msg = msg || hold; 1158 msg = msg || "&"; 1159 msg = msg || who; 1160 msg = msg || """"; 1161 if (eline ^= cline) 1162 then 1163 do; 1164 msg = msg || " (on line "; 1165 msg = msg || cline; 1166 msg = msg || ")"; 1167 end; 1168 msg = msg || "."; 1169 ecode = error_table_$badsyntax; 1170 goto exit; 1171 1172 end error_missing; 1173 1174 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1175 /* */ 1176 /* expand a specified string */ 1177 1178 expand: 1179 proc (ifp, ifi, ife, ofp, ofe, tf); 1180 1181 dcl ifp ptr, /* pointer to input */ 1182 ifi fixed bin (24), 1183 /* first char of input to use */ 1184 ife fixed bin (24), 1185 /* last char of input to use */ 1186 ofp ptr, /* pointer to output */ 1187 ofe fixed bin (24), 1188 /* last char of output used */ 1189 tf bit (2); 1190 dcl begl fixed bin (24); 1191 dcl inputa (ife) char (1) based (ifp); 1192 dcl input char (ife) based (ifp); 1193 dcl output char (1044480) based (ofp); 1194 dcl (i, j, ii, jj) fixed bin (24); 1195 1196 1197 if db_sw 1198 then call dumper ("expn", ifp, ifi, ife, ofp, ofe, tf); 1199 do while (ifi <= ife); 1200 i = index (substr (input, ifi), "&"); 1201 if (i = 0) 1202 then i = ife - ifi + 1; 1203 else i = i - 1; 1204 if (i > 0) 1205 then 1206 do; 1207 substr (output, out_len + 1, i) = substr (input, ifi, i); 1208 out_len = out_len + i; 1209 ifi = ifi + i; 1210 end; 1211 if (ifi > ife) 1212 then return; 1213 ii = ifi; 1214 call ampersand (ifp, ifi, ife, ofp, ofe, tf, "1"b); 1215 if (ii = ifi) 1216 then return; 1217 end; 1218 end expand; 1219 1220 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1221 /* */ 1222 /* search for the macro specified */ 1223 1224 find_macro: 1225 proc (refp, segname, suffix, macname); 1226 dcl refp ptr, 1227 segname char (32) var, 1228 suffix char (32) var, 1229 macname char (32) var; 1230 1231 dcl hcs_$initiate_count 1232 entry (char (*), char (*), char (*), fixed bin (24), 1233 fixed bin (2), ptr, fixed bin (35)); 1234 1235 dcl search_paths_$find_dir 1236 entry (char (*), ptr, char (*), char (*), char (*), 1237 fixed bin (35)); 1238 dcl search_for char (35) var; 1239 1240 if (segname = "") 1241 then search_for = macname; 1242 else search_for = segname; 1243 search_for = search_for || "." || suffix; 1244 1245 if (refp = null ()) 1246 then ref_path = ""; 1247 else call hcs_$fs_get_path_name (refp, ref_path, 0, "", 0); 1248 if db_sw 1249 then call ioa_ ("find_macro ^a ^a (^a)", search_for, macname, ref_path); 1250 call search_paths_$find_dir ((suffix), null (), (search_for), ref_path, 1251 dname, ecode); 1252 if (ecode = error_table_$no_search_list) 1253 then 1254 do; 1255 dcl hcs_$make_ptr entry (ptr, char (*), char (*), ptr, 1256 fixed bin (35)); 1257 here: 1258 call hcs_$make_ptr (codeptr (here), suffix || ".search", 1259 suffix || ".search", segptr, ecode); 1260 /* fudge a little */ 1261 if (segptr = null ()) 1262 then call com_err_ (0, (suffix), 1263 "Default search segment not in same directory as object segment." 1264 ); 1265 else call search_paths_$find_dir ((suffix), null (), (search_for), 1266 ref_path, dname, ecode); 1267 end; 1268 if (ecode = 0) 1269 then 1270 do; 1271 call hcs_$initiate_count (dname, (search_for), "", bc, 0, segptr, 1272 ecode); 1273 if (segptr ^= null ()) 1274 then ecode = 0; 1275 end; 1276 if (ecode ^= 0) 1277 then 1278 do; 1279 msg = "No definition segment found. "; 1280 msg = msg || search_for; 1281 msg = msg || "$"; 1282 msg = msg || macname; 1283 ecode = -1; 1284 goto exit; 1285 end; 1286 segi = 1; 1287 sege = divide (bc, 9, 24, 0); 1288 if mac_sw 1289 then 1290 do; 1291 if (suffix = "macro") 1292 then i = index (seg, "¯o " || macname || NL); 1293 else i = index (seg, "&expand " || macname || NL); 1294 if (i = 0) 1295 then 1296 do; 1297 msg = "No definition found for """; 1298 bad_mac: 1299 msg = msg || macname; 1300 msg = msg || """ "; 1301 msg = msg || "in "; 1302 msg = msg || rtrim (dname); 1303 msg = msg || ">"; 1304 msg = msg || search_for; 1305 ecode = -1; 1306 goto exit; 1307 end; 1308 segi = i + length (macname) + 8; 1309 if (suffix = "macro") 1310 then i = index (substr (seg, segi), "&mend 1311 "); 1312 else 1313 do; 1314 segi = segi + 1; /* &expand 1 char>than ¯o */ 1315 i = index (substr (seg, segi), "&expend 1316 "); 1317 end; 1318 1319 if i = 0 1320 then 1321 do; 1322 msg = "&" || end_sym || " missing on """; 1323 goto bad_mac; 1324 end; 1325 1326 sege = segi + i - 2; 1327 call addmacro (dname, before (search_for, "."), (macname), "0"b, 1328 segptr, segi, sege); 1329 if (segname = "") 1330 then 1331 do; 1332 1333 /* now all that is fine and dandy, but we don't want to let &b() find an */ 1334 /* external b$b because nothing has been internally defined and then later */ 1335 /* have the same thing find a different macro because there now has been an */ 1336 /* internal macro/define encountered. So we dummy up a pseudo-internal entry */ 1337 /* to nip such a thing in the bud. */ 1338 1339 call addmacro ("", before (search_for, "."), (macname), "1"b, 1340 segptr, segi, sege); 1341 end; 1342 end; 1343 1344 end find_macro; 1345 1346 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1347 /* */ 1348 /* free all the storage used */ 1349 1350 free_um: 1351 proc (which); 1352 1353 dcl which char (3); 1354 1355 do while (tptr ^= null ()); 1356 var_ptr = tptr; 1357 tptr = var.next; 1358 if (var.type = 0) 1359 then 1360 do; 1361 if db_sw 1362 then 1363 do; 1364 call ioa_ ("^p ^a ^a", var_ptr, which, var.name); 1365 if var.ref ^= null () 1366 then call ioa_ (" ^p ""^a""", var.ref, vartext); 1367 end; 1368 if (var.ref ^= null ()) 1369 then 1370 do; 1371 if al_sw 1372 then call ioa_ ("F ^p ""^a""", var.ref, vartext); 1373 free vartext in (free_area); 1374 end; 1375 end; 1376 if (var.type >= 1) & (var.type <= 5) 1377 then 1378 do; 1379 arr_ptr = var.ref; 1380 if db_sw 1381 then call ioa_ ("^p ^a ^a{^i:^i}", var_ptr, which, var.name, 1382 array.lower, array.lower + var.len - 1); 1383 do arr_elem = 1 to var.len; 1384 if (array.ref (arr_elem) ^= null ()) 1385 then 1386 do; 1387 if al_sw 1388 then call ioa_ ("^p {^i} ""^a""", 1389 array.ref (arr_elem), 1390 -array.lower + arr_elem - 1, arrtext); 1391 free arrtext in (free_area); 1392 end; 1393 end; 1394 end; 1395 if al_sw 1396 then call ioa_ ("F var-^a ^p", var.name, var_ptr); 1397 free var in (free_area); 1398 end; 1399 1400 end free_um; 1401 1402 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1403 /* */ 1404 /* set up an area */ 1405 1406 get_area: 1407 proc; 1408 1409 ai.version = area_info_version_1; 1410 string (ai.control) = "0"b; 1411 ai.extend = "1"b; 1412 ai.owner = sl_name; 1413 ai.size = 261120; 1414 ai.areap = null (); 1415 call define_area_ (addr (ai), ecode); 1416 free_area_p = ai.areap; 1417 1 1 /* BEGIN INCLUDE FILE area_info.incl.pl1 12/75 */ 1 2 1 3 dcl area_info_version_1 fixed bin static init (1) options (constant); 1 4 1 5 dcl area_infop ptr; 1 6 1 7 dcl 1 area_info aligned based (area_infop), 1 8 2 version fixed bin, /* version number for this structure is 1 */ 1 9 2 control aligned like area_control, /* control bits for the area */ 1 10 2 owner char (32) unal, /* creator of the area */ 1 11 2 n_components fixed bin, /* number of components in the area (returned only) */ 1 12 2 size fixed bin (18), /* size of the area in words */ 1 13 2 version_of_area fixed bin, /* version of area (returned only) */ 1 14 2 areap ptr, /* pointer to the area (first component on multisegment area) */ 1 15 2 allocated_blocks fixed bin, /* number of blocks allocated */ 1 16 2 free_blocks fixed bin, /* number of free blocks not in virgin */ 1 17 2 allocated_words fixed bin (30), /* number of words allocated in the area */ 1 18 2 free_words fixed bin (30); /* number of words free in area not in virgin */ 1 19 1 20 dcl 1 area_control aligned based, 1 21 2 extend bit (1) unal, /* says area is extensible */ 1 22 2 zero_on_alloc bit (1) unal, /* says block gets zerod at allocation time */ 1 23 2 zero_on_free bit (1) unal, /* says block gets zerod at free time */ 1 24 2 dont_free bit (1) unal, /* debugging aid, turns off free requests */ 1 25 2 no_freeing bit (1) unal, /* for allocation method without freeing */ 1 26 2 system bit (1) unal, /* says area is managed by system */ 1 27 2 pad bit (30) unal; 1 28 1 29 /* END INCLUDE FILE area_info.incl.pl1 */ 1418 1419 dcl 1 ai like area_info; 1420 1421 end get_area; 1422 1423 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1424 /* */ 1425 /* parse an array range specification. */ 1426 1427 get_range: 1428 proc (ifp, ifi, ife, ofp, ofe, TF, i, j); 1429 1430 dcl ifp ptr, /* pointer to input */ 1431 ifi fixed bin (24), 1432 /* first char of input to use */ 1433 ife fixed bin (24), 1434 /* last char of input to use */ 1435 ofp ptr, /* pointer to output */ 1436 ofe fixed bin (24), 1437 /* last char of output used */ 1438 TF bit (2); 1439 dcl begl fixed bin (24); 1440 dcl inputa (ife) char (1) based (ifp); 1441 dcl input char (ife) based (ifp); 1442 dcl output char (1044480) based (ofp); 1443 dcl (i, j, ii, jj) fixed bin (24); 1444 1445 if (inputa (ifi + 2) = "}") | (inputa (ifi + 2) = ",") 1446 then 1447 do; 1448 ifi = ifi + 2; 1449 return; 1450 end; 1451 ii = ofe; 1452 call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 1453 i, j = fixed (substr (output, ii + 1, ofe - ii)); 1454 ofe = ii; 1455 if (inputa (ifi) = ":") 1456 then 1457 do; 1458 ifi = ifi - 1; 1459 call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 1460 j = fixed (substr (output, ii + 1, ofe - ii)); 1461 ofe = ii; 1462 end; 1463 1464 end get_range; 1465 1466 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1467 /* */ 1468 /* parse the next input token */ 1469 1470 get_token: 1471 proc (ifp, ifi, ife); 1472 1473 dcl ifp ptr, 1474 ifi fixed bin (24), 1475 ife fixed bin (24); 1476 dcl input char (ife) based (ifp); 1477 1478 call strip (ifp, ifi, ife); 1479 if (substr (input, ifi, 1) ^= "&") 1480 then 1481 do; 1482 c32 = ""; 1483 return; 1484 end; 1485 i = verify (substr (input, ifi + 1), "abcdefghijklmnopqrstuvwxyz"); 1486 if (i = 0) 1487 then i = ife - ifi + 1; 1488 else if (i = 1) 1489 then i = 2; 1490 c32 = substr (input, ifi, i); 1491 1492 end get_token; 1493 1494 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1495 /* */ 1496 /* determine and format the line number of a given point in a segment */ 1497 1498 lineno: 1499 proc (segi) returns (char (6) var); 1500 1501 dcl segi fixed bin (24); 1502 1503 dcl c6 pic "zzzzz9"; 1504 dcl cv6 char (6) var; 1505 dcl j fixed bin (24); 1506 dcl line fixed bin (24); 1507 dcl e fixed bin (24); 1508 1509 line = 0; 1510 i = 1; 1511 e = min (segi, sege); 1512 do while (i <= segi); 1513 line = line + 1; 1514 j = index (substr (seg, i), NL); 1515 if (j = 0) 1516 then i = sege + 1; 1517 else i = i + j; 1518 end; 1519 cv6 = ltrim (char (line)); 1520 return (cv6); 1521 1522 end lineno; 1523 1524 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1525 /* */ 1526 /* process a logical expression */ 1527 1528 logical: 1529 proc (ifp, ifi, ife, ofp, ofe, TF); 1530 1531 dcl ifp ptr, /* pointer to input */ 1532 ifi fixed bin (24), 1533 /* first char of input to use */ 1534 ife fixed bin (24), 1535 /* last char of input to use */ 1536 ofp ptr, /* pointer to output */ 1537 ofe fixed bin (24), 1538 /* last char of output used */ 1539 TF bit (2); 1540 dcl begl fixed bin (24); 1541 dcl inputa (ife) char (1) based (ifp); 1542 dcl input char (ife) based (ifp); 1543 dcl output char (1044480) based (ofp); 1544 dcl (i, j, ii, jj, kk) 1545 fixed bin (24); 1546 dcl loc (24) fixed bin (24); 1547 dcl sep_ct fixed bin (24); 1548 dcl argstrl fixed bin (24); 1549 dcl rel fixed bin (24); 1550 1551 jj = ofe; 1552 construct_nest = construct_nest + 1; 1553 call strip (ifp, ifi, ife); 1554 begl = ifi; 1555 loop: 1556 i = search (substr (input, ifi), "&=^<>"); 1557 if (i = 0) 1558 then 1559 do; 1560 log_err: 1561 msg = "Missing termination of logical expression. "; 1562 goto add_identification; 1563 end; 1564 if (i > 1) 1565 then 1566 do; 1567 i = i - 1; 1568 substr (output, ofe + 1, i) = substr (input, ifi, i); 1569 ofe = ofe + i; 1570 ifi = ifi + i; 1571 end; 1572 rel = index ("&=^=<^>=", inputa (ifi)); 1573 goto type (rel); 1574 1575 type (1): /* & */ 1576 /* & */ 1577 if (substr (input, ifi, 5) = "&then") | (substr (input, ifi, 2) = "&;") 1578 then 1579 do; 1580 kk = ofe; 1581 if db_sw | tr_sw 1582 then 1583 do; 1584 call ioa_$nnl ("#^a:^a^-log-^.1b (", lineno (begl), 1585 lineno (ifi - 1), TF); 1586 call show_string (substr (output, jj + 1, kk - jj), ") 1587 "); 1588 end; 1589 ofe = jj; 1590 if (TF = "00"b) 1591 then return; 1592 c32 = translate (substr (output, jj + 1, kk - jj), 1593 " ABCDEFGHIJKLMNOPQRSTUVWXYZ", " 1594 abcdefghijklmnopqrstuvwxyz"); 1595 if (c32 = "0") | (c32 = "FALSE") | (c32 = "F") | (c32 = "NO") 1596 then TF = "01"b; 1597 else TF = "10"b; 1598 return; 1599 end; 1600 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 1601 goto loop; 1602 type (3): /* ^ */ 1603 /* ^ */ 1604 type (5): /* < */ 1605 /* < */ 1606 type (7): /* > */ 1607 /* > */ 1608 if (inputa (ifi + 1) = "=") 1609 then 1610 do; 1611 rel = rel + 1; 1612 ifi = ifi + 1; 1613 end; 1614 else if (rel = 3) 1615 then 1616 do; 1617 ifi = ifi + 1; 1618 substr (output, ofe + 1, 1) = "^"; 1619 ofe = ofe + 1; 1620 goto loop; 1621 end; 1622 type (2): /* = */ 1623 /* = */ 1624 /* 2 = 4 ^= */ 1625 /* 5 < 6 <= */ 1626 /* 7 > 8 >= */ 1627 ifi = ifi + 1; 1628 ii = ofe; 1629 loop1: 1630 call strip (ifp, ifi, ife); 1631 j = index (substr (input, ifi), "&"); 1632 if (j = 0) 1633 then goto log_err; 1634 if (j > 1) 1635 then 1636 do; 1637 j = j - 1; 1638 substr (output, ofe + 1, j) = substr (input, ifi, j); 1639 ifi = ifi + j; 1640 ofe = ofe + j; 1641 end; 1642 if (substr (input, ifi, 5) = "&then") | (substr (input, ifi, 2) = "&;") 1643 then 1644 do; 1645 construct_nest = construct_nest - 1; 1646 kk = ofe; 1647 if db_sw | tr_sw 1648 then 1649 do; 1650 call ioa_$nnl ("#^a:^a^-log-^.1b (", lineno (begl), 1651 lineno (ifi - 1), TF); 1652 call show_string (substr (output, jj + 1, ii - jj), ""); 1653 call ioa_$nnl (")^a(", relat (rel)); 1654 call show_string (substr (output, ii + 1, kk - ii), ") 1655 "); 1656 end; 1657 ofe = jj; 1658 if (TF = "00"b) 1659 then return; 1660 dcl relat (2:8) char (2) int static 1661 init ("=", "!!", "^=", "<", "<=", ">", ">="); 1662 goto comp (rel); 1663 end; 1664 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 1665 goto loop1; 1666 1667 comp (2): 1668 if (substr (output, jj + 1, ii - jj) = substr (output, ii + 1, kk - ii)) 1669 then TF = "10"b; 1670 else TF = "01"b; 1671 return; 1672 1673 comp (4): 1674 if (substr (output, jj + 1, ii - jj) ^= substr (output, ii + 1, kk - ii)) 1675 then TF = "10"b; 1676 else TF = "01"b; 1677 return; 1678 1679 comp (5): 1680 if (substr (output, jj + 1, ii - jj) < substr (output, ii + 1, kk - ii)) 1681 then TF = "10"b; 1682 else TF = "01"b; 1683 return; 1684 1685 comp (6): 1686 if (substr (output, jj + 1, ii - jj) <= substr (output, ii + 1, kk - ii)) 1687 then TF = "10"b; 1688 else TF = "01"b; 1689 return; 1690 1691 comp (7): 1692 if (substr (output, jj + 1, ii - jj) > substr (output, ii + 1, kk - ii)) 1693 then TF = "10"b; 1694 else TF = "01"b; 1695 return; 1696 1697 comp (8): 1698 if (substr (output, jj + 1, ii - jj) >= substr (output, ii + 1, kk - ii)) 1699 then TF = "10"b; 1700 else TF = "01"b; 1701 return; 1702 1703 end logical; 1704 1705 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1706 /* */ 1707 /* look up a specified name in the variable lists */ 1708 1709 lookup: 1710 proc (vname) returns (fixed bin) recursive; 1711 1712 dcl vname char (32) var; 1713 1714 /* first look up local variables */ 1715 1716 var_ptr = local_var_ptr; 1717 do while (var_ptr ^= null ()); 1718 if (var.name = vname) 1719 then return (3); 1720 var_ptr = var.next; 1721 end; 1722 1723 /* then look up internal static variables */ 1724 1725 if (int_var_ptr = null ()) 1726 then 1727 do; 1728 int_var_ptr = int_vars_base; 1729 do while (int_var_ptr ^= null ()); 1730 if (macname = int_vars.macro) 1731 then goto found; 1732 else int_var_ptr = int_vars.next; 1733 end; 1734 allocate int_vars in (free_area); 1735 if al_sw 1736 then call ioa_ ("A int_vars ^a^i ^p", macname, size (int_vars), 1737 int_var_ptr); 1738 int_vars.next = int_vars_base; 1739 int_vars.ref = null (); 1740 int_vars.macro = macname; 1741 int_vars_base = int_var_ptr; 1742 end; 1743 1744 found: 1745 var_ptr = int_vars.ref; 1746 do while (var_ptr ^= null ()); 1747 if (var.name = vname) 1748 then return (2); 1749 var_ptr = var.next; 1750 end; 1751 1752 /* then look up external static variables */ 1753 1754 var_ptr = ext_var_ptr; 1755 do while (var_ptr ^= null ()); 1756 if (var.name = vname) 1757 then return (1); 1758 var_ptr = var.next; 1759 end; 1760 1761 return (0); 1762 end lookup; 1763 1764 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1765 /* */ 1766 /* handle the active function call */ 1767 1768 macro_af: 1769 proc (ifp, ifi, ife, ofp, ofe, TF); 1770 1771 dcl ifp ptr, /* pointer to input */ 1772 ifi fixed bin (24), 1773 /* first char of input to use */ 1774 ife fixed bin (24), 1775 /* last char of input to use */ 1776 ofp ptr, /* pointer to output */ 1777 ofe fixed bin (24), 1778 /* last char of output used */ 1779 TF bit (2); 1780 dcl begl fixed bin (24); 1781 dcl inputa (ife) char (1) based (ifp); 1782 dcl input char (ife) based (ifp); 1783 dcl output char (1044480) based (ofp); 1784 dcl (i, j, ii, jj) fixed bin (24); 1785 dcl level fixed bin (24); 1786 1787 /* &[ ... ] */ 1788 1789 begl = ifi; 1790 ifi = ifi + 2; 1791 call strip (ifp, ifi, ife); 1792 if db_sw 1793 then call dumper ("af..", ifp, ifi, ife, ofp, ofe, TF); 1794 ii = ofe; 1795 level = 1; 1796 construct_nest = construct_nest + 1; 1797 loop: 1798 i = search (substr (input, ifi), "&[]"); 1799 if (i = 0) 1800 then 1801 do; 1802 msg = "]"; 1803 call error_missing ("[", begl, ife); 1804 end; 1805 if (i > 1) 1806 then 1807 do; 1808 i = i - 1; 1809 substr (output, ofe + 1, i) = substr (input, ifi, i); 1810 ofe = ofe + i; 1811 ifi = ifi + i; 1812 end; 1813 goto type (index ("&[]", inputa (ifi))); 1814 1815 type (1): /* & */ 1816 /* */ 1817 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 1818 if (c32 = "&;") 1819 then goto misplaced; 1820 goto loop; 1821 1822 type (2): /* [ */ 1823 /* */ 1824 substr (output, ofe + 1, 1) = "["; 1825 ofe = ofe + 1; 1826 ifi = ifi + 1; 1827 level = level + 1; 1828 goto loop; 1829 1830 type (3): /* ] */ 1831 /* */ 1832 substr (output, ofe + 1, 1) = "]"; 1833 ofe = ofe + 1; 1834 ifi = ifi + 1; 1835 level = level - 1; 1836 if (level > 0) 1837 then goto loop; 1838 1839 construct_nest = construct_nest - 1; 1840 ofe = ofe - 1; 1841 if (TF = "00"b) 1842 then 1843 do; 1844 ofe = ii; 1845 return; 1846 end; 1847 1848 begin; 1849 1850 dcl rval char (500) var; 1851 dcl cu_$evaluate_active_string 1852 entry (ptr, char (*), fixed bin, char (*) var, 1853 fixed bin (35)); 2 1 /* BEGIN INCLUDE FILE ... cp_active_string_types.incl.pl1 */ 2 2 /* Created: 5 May 1980 by G. Palter */ 2 3 2 4 /* Types of active strings recognized by active string evaluation entries of the Multics command processor */ 2 5 2 6 dcl (DEFAULT_ACTIVE_STRING initial (0), /* default type: same as NORMAL_ACTIVE_STRING */ 2 7 NORMAL_ACTIVE_STRING initial (1), /* normal active string: [...] */ 2 8 TOKENS_ONLY_ACTIVE_STRING initial (2), /* rescan active string for whitespace and quotes: |[...] */ 2 9 ATOMIC_ACTIVE_STRING initial (3)) /* do not rescan anything in value: ||[...] */ 2 10 fixed binary static options (constant); 2 11 2 12 /* END INCLUDE FILE ... cp_active_string_types.incl.pl1 */ 1854 1855 1856 call cu_$evaluate_active_string (null (), 1857 substr (output, ii + 1, ofe - ii), ATOMIC_ACTIVE_STRING, rval, 1858 ecode); 1859 if ecode ^= 0 1860 then 1861 do; 1862 err_ct = 0; 1863 msg = "Processing active functtion. "; 1864 msg_etc = substr (output, ii + 1, ofe - ii); 1865 goto add_id; 1866 end; 1867 ofe = ii; 1868 substr (output, ofe + 1, length (rval)) = rval; 1869 ofe = ofe + length (rval); 1870 end; 1871 return; 1872 1873 end macro_af; 1874 1875 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1876 /* */ 1877 /* handle a macro call */ 1878 1879 macro_call: 1880 proc (ifp, ifi, ife, ofp, ofe, TF) recursive; 1881 1882 dcl ifp ptr, /* pointer to input */ 1883 ifi fixed bin (24), 1884 /* first char of input to use */ 1885 ife fixed bin (24), 1886 /* last char of input to use */ 1887 ofp ptr, /* pointer to output */ 1888 ofe fixed bin (24), 1889 /* last char of output used */ 1890 TF bit (2); 1891 dcl begl fixed bin (24); 1892 dcl inputa (ife) char (1) based (ifp); 1893 dcl input char (ife) based (ifp); 1894 dcl output char (1044480) based (ofp); 1895 dcl (i, j, ii, jj) fixed bin (24); 1896 dcl loc (100) fixed bin (24); 1897 dcl (sep_ct, level) fixed bin (24); 1898 dcl argstrl fixed bin (24); 1899 dcl callseg char (32) var; 1900 dcl callmac char (32) var; 1901 1902 /* &xxx( ... , ... , ...) */ 1903 /* &xxx$yy( ... , ... , ...) */ 1904 1905 begl = ifi; 1906 callseg = c32x; 1907 callmac = c32; 1908 call strip (ifp, ifi, ife); 1909 if db_sw 1910 then call dumper ("call", ifp, ifi, ife, ofp, ofe, TF); 1911 ii = ofe; 1912 substr (output, ofe + 1, 1) = "("; 1913 ofe, loc (1) = ofe + 1; 1914 sep_ct = 1; 1915 level = 1; 1916 construct_nest = construct_nest + 1; 1917 loop: 1918 i = search (substr (input, ifi), "&(),"); 1919 if (i = 0) 1920 then 1921 do; 1922 msg = ")"; 1923 call error_missing (callmac || "(", begl, ife); 1924 end; 1925 if (i > 1) 1926 then 1927 do; 1928 i = i - 1; 1929 substr (output, ofe + 1, i) = substr (input, ifi, i); 1930 ofe = ofe + i; 1931 ifi = ifi + i; 1932 end; 1933 goto type (index ("&(),", inputa (ifi))); 1934 1935 type (1): /* & */ 1936 /* */ 1937 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 1938 goto loop; 1939 1940 type (2): /* ( */ 1941 /* */ 1942 substr (output, ofe + 1, 1) = "("; 1943 ofe = ofe + 1; 1944 ifi = ifi + 1; 1945 level = level + 1; 1946 goto loop; 1947 1948 type (3): /* ) */ 1949 /* */ 1950 substr (output, ofe + 1, 1) = ")"; 1951 ofe = ofe + 1; 1952 ifi = ifi + 1; 1953 level = level - 1; 1954 if (level > 0) 1955 then goto loop; 1956 1957 construct_nest = construct_nest - 1; 1958 loc (sep_ct + 1) = ofe; 1959 argstrl = ofe - loc (1) + 1; 1960 if (argstrl > 16384) 1961 then 1962 do; 1963 msg = "&call arg-string > 16384 chrs."; 1964 goto add_identification; 1965 end; 1966 begin; 1967 dcl 1 args (sep_ct) like argl; 1968 dcl argstr (argstrl) char (1) unal; 1969 if db_sw | tr_sw 1970 then 1971 do; 1972 call ioa_$nnl ("#^a:^a^-call ^a$^a ", lineno (begl), 1973 lineno (ifi - 1), callseg, callmac); 1974 call show_string (substr (output, loc (1), argstrl), " 1975 "); 1976 end; 1977 string (argstr) = substr (output, loc (1), argstrl); 1978 ofe = loc (1) - 1; 1979 if (argstrl = 2) 1980 then sep_ct = 0; 1981 do i = 1 to sep_ct; 1982 args.l (i) = loc (i + 1) - loc (i) - 1; 1983 j = loc (i) - ofe + 1; 1984 args.p (i) = addr (argstr (j)); 1985 end; 1986 call macro_ (sl_name, callseg, callmac, ofp, ofe, addr (args), 1987 (sep_ct), msg, ifp, ecode); 1988 if (ecode = -1) 1989 then call error_gen ("call", begl, ifi); 1990 if (ecode ^= 0) 1991 then 1992 do; 1993 ifi = begl; 1994 call_err = "1"b; 1995 goto add_id; 1996 end; 1997 end; 1998 return; 1999 2000 type (4): /* , */ 2001 /* */ 2002 substr (output, ofe + 1, 1) = ","; 2003 ofe = ofe + 1; 2004 ifi = ifi + 1; 2005 if (level = 1) 2006 then 2007 do; 2008 if (sep_ct >= 100) 2009 then 2010 do; 2011 msg = "Cannot handle over 100 "; 2012 msg = msg || who_am_i; 2013 msg = msg || " arguments."; 2014 goto add_identification; 2015 end; 2016 sep_ct = sep_ct + 1; 2017 loc (sep_ct) = ofe; 2018 call strip (ifp, ifi, ife); 2019 end; 2020 goto loop; 2021 end macro_call; 2022 2023 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2024 /* */ 2025 /* dynamically define a macro */ 2026 2027 macro_define: 2028 proc (ifp, ifi, ife, ofp, ofe, TF); 2029 2030 dcl ifp ptr, /* pointer to input */ 2031 ifi fixed bin (24), 2032 /* first char of input to use */ 2033 ife fixed bin (24), 2034 /* last char of input to use */ 2035 ofp ptr, /* pointer to output */ 2036 ofe fixed bin (24), 2037 /* last char of output used */ 2038 TF bit (2); 2039 dcl begl fixed bin (24); 2040 dcl inputa (ife) char (1) based (ifp); 2041 dcl input char (ife) based (ifp); 2042 dcl output char (1044480) based (ofp); 2043 dcl (i, j, ii, jj) fixed bin (24); 2044 dcl loc (24) fixed bin (24); 2045 dcl sep_ct fixed bin (24); 2046 dcl argstrl fixed bin (24); 2047 2048 /* &define ... &dend */ 2049 2050 begl = ifi; 2051 ifi = ifi + 7; 2052 call strip (ifp, ifi, ife); 2053 if db_sw 2054 then call dumper ("defi", ifp, ifi, ife, ofp, ofe, TF); 2055 ii = ofe; 2056 construct_nest = construct_nest + 1; 2057 loop: 2058 i = index (substr (input, ifi), "&"); 2059 if (i = 0) 2060 then 2061 do; 2062 msg = "&dend"; 2063 call error_missing ("define", begl, ife); 2064 end; 2065 if (i > 1) 2066 then 2067 do; 2068 i = i - 1; 2069 substr (output, ofe + 1, i) = substr (input, ifi, i); 2070 ofe = ofe + i; 2071 ifi = ifi + i; 2072 end; 2073 if (substr (input, ifi, 5) = "&dend") 2074 then 2075 do; 2076 ifi = ifi + 5; 2077 call strip (ifp, ifi, ife); 2078 if (TF & "10"b) 2079 then 2080 do; 2081 i = ii + 1; 2082 i = i + verify (substr (output, i, ofe - i + 1), space) - 1; 2083 j = verify (substr (output, i, ofe - i + 1), 2084 "abcdefghijklmnopqrstuvwxyz" 2085 || "ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"); 2086 if (j = 0) 2087 then 2088 do; 2089 def_err: 2090 call error_syntax ("define", begl, ifi); 2091 end; 2092 if (j < 2) 2093 then 2094 do; 2095 msg = "macroname"; 2096 call error_missing ("define", begl, ifi); 2097 end; 2098 j = j - 1; 2099 c32 = substr (output, i, j); 2100 i = i + j; 2101 if (substr (output, i, 1) ^= NL) 2102 then goto def_err; 2103 macro_holder_l = ofe - i; 2104 allocate macro_holder in (free_area); 2105 macro_holder = substr (output, i + 1, macro_holder_l); 2106 if db_sw | tr_sw 2107 then 2108 do; 2109 call ioa_$nnl ("#^a:^a^-&define ^a^/^-", lineno (begl), 2110 lineno (ifi - 1), c32); 2111 call show_string (macro_holder, "&dend 2112 "); 2113 end; 2114 call addmacro (" &define'ed in " || myname || " ", "", c32, 2115 "1"b, macro_holder_p, 1, macro_holder_l); 2116 end; 2117 ofe = ii; 2118 construct_nest = construct_nest - 1; 2119 return; 2120 end; 2121 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 2122 goto loop; 2123 end macro_define; 2124 2125 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2126 /* */ 2127 /* handle the iteration construct */ 2128 2129 macro_do: 2130 proc (ifp, ifi, ife, ofp, ofe, TF); 2131 2132 dcl ifp ptr, /* pointer to input */ 2133 ifi fixed bin (24), 2134 /* first char of input to use */ 2135 ife fixed bin (24), 2136 /* last char of input to use */ 2137 ofp ptr, /* pointer to output */ 2138 ofe fixed bin (24), 2139 /* last char of output used */ 2140 TF bit (2); 2141 dcl begl fixed bin (24); 2142 dcl inputa (ife) char (1) based (ifp); 2143 dcl input char (ife) based (ifp); 2144 dcl output char (1044480) based (ofp); 2145 dcl (i, j, ii, jj) fixed bin (24); 2146 dcl tf bit (2); 2147 2148 /* &do EXPAND &while LOGICAL &; EXPAND &od */ 2149 /* LOGICAL ::= arithmetic | compare */ 2150 2151 begl = ifi; 2152 ifi = ifi + 3; 2153 call strip (ifp, ifi, ife); 2154 if db_sw 2155 then call dumper ("do..", ifp, ifi, ife, ofp, ofe, TF); 2156 if (TF = "00"b) 2157 then goto skip; 2158 ii = ifi; 2159 jj = 0; 2160 construct_nest = construct_nest + 1; 2161 loop: 2162 call expand (ifp, ifi, ife, ofp, ofe, (TF)); 2163 if (c32 = "&while") 2164 then 2165 do; 2166 ifi = ifi + length (c32); 2167 jj = 1; 2168 tf = TF; 2169 call logical (ifp, ifi, ife, ofp, ofe, tf); 2170 call get_token (ifp, ifi, ife); 2171 if (c32 ^= "&;") 2172 then 2173 do; 2174 msg = "&;"; 2175 call error_missing ("while", begl, ifi); 2176 end; 2177 ifi = ifi + length (c32); 2178 call strip (ifp, ifi, ife); 2179 if (tf = "01"b) 2180 then 2181 do; 2182 skip: 2183 i = index (substr (input, ifi), "&"); 2184 if (i = 0) 2185 then 2186 do; 2187 msg = "&od"; 2188 call error_missing ("do", begl, ife); 2189 end; 2190 ifi = ifi + i - 1; 2191 call get_token (ifp, ifi, ife); 2192 if (c32 = "&do") 2193 then call macro_do (ifp, ifi, ife, ofp, ofe, "00"b); 2194 else if (c32 = "&""") 2195 then call protected (ifp, ifi, ife, ofp, (ofe)); 2196 else if (c32 = "&od") 2197 then 2198 do; 2199 jj = 0; 2200 goto od; 2201 end; 2202 else ifi = ifi + 1; 2203 goto skip; 2204 end; 2205 goto loop; 2206 end; 2207 if (c32 = "&od") 2208 then 2209 do; 2210 od: 2211 ifi = ifi + length (c32); 2212 call strip (ifp, ifi, ife); 2213 if (jj = 0) 2214 then 2215 do; 2216 construct_nest = construct_nest - 1; 2217 return; 2218 end; 2219 ifi = ii; 2220 goto loop; 2221 end; 2222 msg = c32; 2223 call error_misplaced ("do", begl, ifi); 2224 end macro_do; 2225 2226 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2227 /* */ 2228 /* make a list or array var be empty again */ 2229 2230 macro_empty: 2231 proc (ifp, ifi, ife, ofp, ofe, TF); 2232 dcl ifp ptr, 2233 ifi fixed bin (24), 2234 ife fixed bin (24), 2235 ofp ptr, 2236 ofe fixed bin (24), 2237 TF bit (2); 2238 dcl begl fixed bin (24); 2239 dcl inputa (ife) char (1) based (ifp); 2240 dcl input char (ife) based (ifp); 2241 dcl output char (1044480) based (ofp); 2242 dcl (i, j, ii, jj) fixed bin (24); 2243 dcl tf bit (2); 2244 dcl vname char (32) var; 2245 2246 /* &empty name &; */ 2247 2248 begl = ifi; 2249 ifi = ifi + 6; 2250 call strip (ifp, ifi, ife); 2251 if db_sw 2252 then call dumper ("empt", ifp, ifi, ife, ofp, ofe, TF); 2253 i = verify (substr (input, ifi), 2254 "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"); 2255 if (i = 0) 2256 then i = ife - ifi + 1; 2257 if (i = 1) 2258 then 2259 do; 2260 msg = "array name"; 2261 call error_missing ("empty", begl, ifi); 2262 end; 2263 vname = substr (input, ifi, i - 1); 2264 if (length (vname) > 16) 2265 then 2266 do; 2267 msg = """"; 2268 msg = msg || vname; 2269 msg = msg || """ > 16 characters."; 2270 call error_gen ("empty", begl, ifi); 2271 end; 2272 ifi = ifi + length (vname); 2273 call strip (ifp, ifi, ife); 2274 if (substr (input, ifi, 2) ^= "&;") 2275 then 2276 do; 2277 msg = "&;"; 2278 call error_missing ("empty", begl, ifi); 2279 end; 2280 call strip2 (ifp, ifi, ife); 2281 i = lookup (vname); 2282 if (i = 0) 2283 then 2284 do; 2285 msg = """"; 2286 msg = msg || vname; 2287 msg = msg || """ undefined."; 2288 call error_gen ("empty", begl, ifi); 2289 end; 2290 if (var.type = 0) 2291 then 2292 do; 2293 msg = """"; 2294 msg = msg || vname; 2295 msg = msg || """ is a scalar."; 2296 call error_gen ("empty", begl, ifi); 2297 end; 2298 arr_ptr = var.ref; /* free any allocated strings */ 2299 if (var.type = 2) 2300 then 2301 do; 2302 array.h_bound = array.lower - 1; 2303 array.l_bound = array.lower + var.len; 2304 end; 2305 if (var.type = 3) 2306 then 2307 do; 2308 array.l_bound = 1; 2309 array.h_bound = 0; 2310 end; 2311 end macro_empty; 2312 2313 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2314 /* */ 2315 /* print a user specified error message */ 2316 2317 macro_error: 2318 proc (ifp, ifi, ife, ofp, ofe, TF); 2319 2320 dcl ifp ptr, /* pointer to input */ 2321 ifi fixed bin (24), 2322 /* first char of input to use */ 2323 ife fixed bin (24), 2324 /* last char of input to use */ 2325 ofp ptr, /* pointer to output */ 2326 ofe fixed bin (24), 2327 /* last char of output used */ 2328 TF bit (2); 2329 dcl begl fixed bin (24); 2330 dcl inputa (ife) char (1) based (ifp); 2331 dcl input char (ife) based (ifp); 2332 dcl output char (1044480) based (ofp); 2333 dcl (i, j, ii, jj) fixed bin (24); 2334 dcl loc (24) fixed bin (24); 2335 dcl sep_ct fixed bin (24); 2336 dcl argstrl fixed bin (24); 2337 dcl ch8 pic "-------9"; 2338 2339 /* &error ARITH , ... &; */ 2340 2341 begl = ifi; 2342 ifi = ifi + 6; 2343 call strip (ifp, ifi, ife); 2344 if db_sw 2345 then call dumper ("err.", ifp, ifi, ife, ofp, ofe, TF); 2346 ii = ofe; 2347 msg = ""; 2348 construct_nest = construct_nest + 1; 2349 ifi = ifi - 2; 2350 call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 2351 2352 if (ofe ^= ii + 1) | (substr (output, ofe, 1) < "0") 2353 | (substr (output, ofe, 1) > "4") 2354 then 2355 do; 2356 substr (output, ii + 1, 38) = 2357 "4(Invalid &error severity, 4 assumed.) "; 2358 ofe = ii + 38; 2359 end; 2360 call strip (ifp, ifi, ife); 2361 if (inputa (ifi) ^= ",") 2362 then 2363 do; 2364 substr (output, ofe + 1, 39) = 2365 "(Missing comma after &error severity.) "; 2366 ofe = ofe + 39; 2367 end; 2368 else ifi = ifi + 1; 2369 loop: 2370 i = index (substr (input, ifi), "&"); 2371 if (i = 0) 2372 then 2373 do; 2374 msg = "&;"; 2375 call error_missing ("error", begl, ife); 2376 end; 2377 if (i > 1) 2378 then 2379 do; 2380 i = i - 1; 2381 substr (output, ofe + 1, i) = substr (input, ifi, i); 2382 ofe = ofe + i; 2383 ifi = ifi + i; 2384 end; 2385 if (substr (input, ifi, 2) = "&;") 2386 then 2387 do; 2388 call strip2 (ifp, ifi, ife); 2389 i = index ("01234", substr (output, ii + 1, 1)) - 1; 2390 err_ct (i) = err_ct (i) + 1; 2391 msg = NL; 2392 if (i = 0) 2393 then msg = msg || "NOTE: "; 2394 else if (i = 1) 2395 then msg = msg || "WARNING. "; 2396 else 2397 do; 2398 msg = msg || "ERROR SEVERITY "; 2399 msg = msg || substr (output, ii + 1, 1); 2400 msg = msg || ". "; 2401 end; 2402 msg = msg || who_am_i; 2403 msg = msg || " """; 2404 msg = msg || macname; 2405 msg = msg || """, line "; 2406 msg = msg || lineno (ifi); 2407 msg = msg || NL; 2408 call iox_$put_chars (iox_$error_output, addrel (addr (msg), 1), 2409 length (msg), 0); 2410 msg = ""; 2411 substr (output, ofe + 1, 1) = NL; 2412 call iox_$put_chars (iox_$error_output, 2413 addr (substr (output, ii + 2, 1)), ofe - ii, 0); 2414 if (i = 4) 2415 then 2416 do; 2417 msg = "Error detected by "; 2418 msg = msg || who_am_i; 2419 msg = msg || " """; 2420 msg = msg || macname; 2421 msg = msg || """."; 2422 ecode = error_table_$translation_aborted; 2423 goto exit; 2424 end; 2425 ofe = ii; 2426 construct_nest = construct_nest - 1; 2427 return; 2428 end; 2429 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 2430 goto loop; 2431 2432 dcl iox_$error_output 2433 ptr ext static; 2434 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 2435 end macro_error; 2436 2437 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2438 /* */ 2439 /* handle the "if then [elseif] ... [else] fi" construct */ 2440 2441 macro_if: 2442 proc (ifp, ifi, ife, ofp, ofe, tf); 2443 2444 dcl ifp ptr, /* pointer to input */ 2445 ifi fixed bin (24), 2446 /* first char of input to use */ 2447 ife fixed bin (24), 2448 /* last char of input to use */ 2449 ofp ptr, /* pointer to output */ 2450 ofe fixed bin (24), 2451 /* last char of output used */ 2452 tf bit (2); /* 1x- process true */ 2453 /* x1- process false */ 2454 /* value not returned (modified) */ 2455 dcl begl fixed bin (24); 2456 dcl beglt fixed bin (24); 2457 dcl skip_sw bit (1); 2458 dcl inputa (ife) char (1) based (ifp); 2459 dcl input char (ife) based (ifp); 2460 dcl output char (1044480) based (ofp); 2461 dcl (i, j, ii, jj) fixed bin (24); 2462 dcl TF bit (2); 2463 dcl if_lineno char (6) var; 2464 dcl elseif bit (1); 2465 2466 2467 /* &if LOGICAL &then EXPAND {&elseif EXPAND} ... {&else EXPAND} &fi */ 2468 2469 begl, beglt = ifi; 2470 ifi = ifi + 3; 2471 call strip (ifp, ifi, ife); 2472 TF = tf; 2473 if db_sw 2474 then call dumper ("if..", ifp, ifi, ife, ofp, ofe, TF); 2475 elseif = "0"b; 2476 if_lineno = lineno (begl); 2477 2478 nother_logical: 2479 call logical (ifp, ifi, ife, ofp, ofe, TF); 2480 if (tf = "00"b) 2481 then TF = "00"b; 2482 if db_sw | tr_sw 2483 then call ioa_ ("#^a:^a^-&^[else^]if (^a) ^[skip^;F^;T^;TF^]", 2484 lineno (beglt), lineno (ifi - 1), elseif, if_lineno, 2485 fixed (TF) + 1); 2486 call get_token (ifp, ifi, ife); 2487 if (c32 ^= "&then") 2488 then 2489 do; 2490 msg = "&then"; 2491 call error_missing ("if", begl, ifi); 2492 end; 2493 beglt = ifi; 2494 ifi = ifi + length (c32); 2495 call strip (ifp, ifi, ife); 2496 construct_nest = construct_nest + 1; 2497 if (TF & "10"b) 2498 then call expand (ifp, ifi, ife, ofp, ofe, (TF)); 2499 else call skipper; 2500 if db_sw | tr_sw 2501 then call ioa_ ("#^a:^a^-&then (^a) ^[done^;skip^]", lineno (beglt), 2502 lineno (ifi - 1), if_lineno, (TF & "10"b)); 2503 skip_again: 2504 beglt = ifi; 2505 if (c32 = "&elseif") 2506 then 2507 do; 2508 ifi = ifi + length (c32); 2509 call strip (ifp, ifi, ife); 2510 if (TF & "01"b) 2511 then 2512 do; 2513 construct_nest = construct_nest - 1; 2514 elseif = "1"b; 2515 goto nother_logical; 2516 end; 2517 call skipper; 2518 if db_sw | tr_sw 2519 then call ioa_ ("#^a:^a^-&elseif (^a) skip", lineno (beglt), 2520 lineno (ifi - 1), if_lineno); 2521 goto skip_again; 2522 end; 2523 if (c32 = "&else") 2524 then 2525 do; 2526 ifi = ifi + length (c32); 2527 call strip (ifp, ifi, ife); 2528 if (TF & "01"b) 2529 then call expand (ifp, ifi, ife, ofp, ofe, (TF)); 2530 else call skipper; 2531 if db_sw | tr_sw 2532 then call ioa_ ("#^a:^a^-&else (^a) ^[done^;skip^]", lineno (beglt), 2533 lineno (ifi - 1), if_lineno, TF & "01"b); 2534 beglt = ifi; 2535 end; 2536 if (c32 ^= "&fi") 2537 then 2538 do; 2539 msg = "&fi"; 2540 call error_missing ("if", begl, ifi); 2541 end; 2542 construct_nest = construct_nest - 1; 2543 ifi = ifi + length (c32); 2544 call strip (ifp, ifi, ife); 2545 if db_sw | tr_sw 2546 then call ioa_ ("#^a:^a^-&fi (^a)", lineno (beglt), lineno (ifi - 1), 2547 if_lineno); 2548 return; 2549 2550 skipper: 2551 proc; 2552 2553 do while ("1"b); 2554 i = index (substr (input, ifi), "&"); 2555 if (i = 0) 2556 then 2557 do; 2558 c32 = ""; 2559 return; 2560 end; 2561 ifi = ifi + i - 1; 2562 call get_token (ifp, ifi, ife); 2563 if (c32 = "&if") 2564 then call macro_if (ifp, ifi, ife, ofp, ofe, "00"b); 2565 else if (c32 = "&fi") 2566 then return; 2567 else if (c32 = "&else") 2568 then return; 2569 else if (c32 = "&elseif") 2570 then return; 2571 else if (c32 = "&""") 2572 then call protected (ifp, ifi, ife, ofp, (ofe)); 2573 else ifi = ifi + 1; 2574 end; 2575 2576 end; 2577 2578 end macro_if; 2579 2580 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2581 /* */ 2582 /* return the length of a string */ 2583 2584 macro_length: 2585 proc (ifp, ifi, ife, ofp, ofe, TF); 2586 2587 dcl ifp ptr, /* pointer to input */ 2588 ifi fixed bin (24), 2589 /* first char of input to use */ 2590 ife fixed bin (24), 2591 /* last char of input to use */ 2592 ofp ptr, /* pointer to output */ 2593 ofe fixed bin (24), 2594 /* last char of output used */ 2595 TF bit (2); 2596 dcl begl fixed bin (24); 2597 dcl inputa (ife) char (1) based (ifp); 2598 dcl input char (ife) based (ifp); 2599 dcl output char (1044480) based (ofp); 2600 dcl (i, j, ii, jj) fixed bin (24); 2601 dcl loc (24) fixed bin (24); 2602 dcl sep_ct fixed bin (24); 2603 dcl argstrl fixed bin (24); 2604 dcl ch8 pic "-------9"; 2605 2606 /* &length ... &; */ 2607 2608 begl = ifi; 2609 ifi = ifi + 7; 2610 call strip (ifp, ifi, ife); 2611 if db_sw 2612 then call dumper ("leng", ifp, ifi, ife, ofp, ofe, TF); 2613 ii = ofe; 2614 construct_nest = construct_nest + 1; 2615 loop: 2616 i = index (substr (input, ifi), "&"); 2617 if (i = 0) 2618 then 2619 do; 2620 msg = "&;"; 2621 call error_missing ("length", begl, ife); 2622 end; 2623 if (i > 1) 2624 then 2625 do; 2626 i = i - 1; 2627 substr (output, ofe + 1, i) = substr (input, ifi, i); 2628 ofe = ofe + i; 2629 ifi = ifi + i; 2630 end; 2631 if (substr (input, ifi, 2) = "&;") 2632 then 2633 do; 2634 call strip2 (ifp, ifi, ife); 2635 ch8 = ofe - ii; 2636 ofe = ii; 2637 i = index (reverse (ch8), " ") - 1; 2638 substr (output, ofe + 1, i) = substr (ch8, 9 - i, i); 2639 ofe = ofe + i; 2640 construct_nest = construct_nest - 1; 2641 return; 2642 end; 2643 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 2644 goto loop; 2645 end macro_length; 2646 2647 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2648 /* */ 2649 /* process loc/int/ext/let statements (they look very much alike */ 2650 2651 macro_let: 2652 proc (ifp, ifi, ife, ofp, ofe, TF, which) recursive; 2653 2654 dcl ifp ptr, /* pointer to input */ 2655 ifi fixed bin (24), 2656 /* first char of input to use */ 2657 ife fixed bin (24), 2658 /* last char of input to use */ 2659 ofp ptr, /* pointer to output */ 2660 ofe fixed bin (24), 2661 /* last char of output used */ 2662 TF bit (2), 2663 which fixed bin (24); 2664 /* 0-let, 1-ext, 2-int, 3-loc */ 2665 dcl begl fixed bin (24); 2666 dcl inputa (ife) char (1) based (ifp); 2667 dcl input char (ife) based (ifp); 2668 dcl output char (1044480) based (ofp); 2669 dcl (i, j, ii, jj) fixed bin (24); 2670 dcl vname char (32) var; 2671 dcl vptr ptr; 2672 dcl found fixed bin (24); 2673 dcl (lower, higher) fixed bin (24); 2674 2675 /* &let var = EXPR &; 2676* &ext var = EXPR &; 2677* &ext var &; 2678* &int var = EXPR &; 2679* &int var &; 2680* &loc var = EXPR &; 2681* &loc var &; */ 2682 /* EXPR ::= arithmetic | string */ 2683 2684 begl = ifi; 2685 ifi = ifi + 4; 2686 call strip (ifp, ifi, ife); 2687 if db_sw 2688 then call dumper (cmd (which), ifp, ifi, ife, ofp, ofe, TF); 2689 i = verify (substr (input, ifi, 1), 2690 "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"); 2691 if (i ^= 0) 2692 then 2693 do; 2694 msg = "Variable name must begin with alphabetic char. "; 2695 call error_gen (cmd (which), begl, ifi); 2696 end; 2697 i = verify (substr (input, ifi), 2698 "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"); 2699 if (i = 0) 2700 then i = ife - ifi + 1; 2701 else i = i - 1; 2702 vname = substr (input, ifi, i); 2703 if (i > 16) 2704 then 2705 do; 2706 msg = "Data name > 16 characters. "; 2707 goto add_identification; 2708 end; 2709 ifi = ifi + i; 2710 dcl reserved (29) char (8) int static 2711 init ("arg", "comment", "define", "dend", "do", 2712 "else", "elseif", "empty", "error", "expand", 2713 "expend", "ext", "fi", "hbound", "if", "int", "let", 2714 "lbound", "length", "loc", "macro", "mend", "quote", 2715 "return", "scan", "substr", "unquote", "usage", 2716 "while"); 2717 do i = 1 to hbound (reserved, 1); 2718 if (vname = reserved (i)) 2719 then 2720 do; 2721 msg = "Attempt to use reserved word """; 2722 msg = msg || vname; 2723 msg = msg || """ as variable. "; 2724 goto add_identification; 2725 end; 2726 end; 2727 found = lookup (vname); 2728 if (found < which) 2729 then 2730 do; 2731 allocate var in (free_area) set (var_ptr); 2732 if al_sw 2733 then call ioa_ ("A var-^a ^i ^p", vname, size (var), var_ptr); 2734 var.name = vname; 2735 var.ref = null (); 2736 var.type = 0; 2737 var.len = 0; 2738 if (which = 1) 2739 then 2740 do; 2741 var.next = ext_var_ptr; 2742 ext_var_ptr = var_ptr; 2743 if db_sw 2744 then call ioa_ ("^p ext ""^a""", var_ptr, var.name); 2745 end; 2746 else if (which = 2) 2747 then 2748 do; 2749 var.next = int_vars.ref; 2750 int_vars.ref = var_ptr; 2751 if db_sw 2752 then call ioa_ ("^p int.^a ""^a""", var_ptr, macname, 2753 var.name); 2754 end; 2755 else 2756 do; 2757 var.next = local_var_ptr; 2758 local_var_ptr = var_ptr; 2759 if db_sw 2760 then call ioa_ ("^p loc ""^a""", var_ptr, var.name); 2761 end; 2762 end; 2763 else if (found = 0) 2764 then 2765 do; 2766 msg = "Attempt to set undeclared variable """; 2767 msg = msg || vname; 2768 msg = msg || """. "; 2769 goto add_identification; 2770 end; 2771 vptr = var_ptr; 2772 call strip (ifp, ifi, ife); 2773 if (which > 0) 2774 then if (substr (input, ifi, 2) = "&;") 2775 then 2776 do; 2777 call strip2 (ifp, ifi, ife); 2778 return; 2779 end; 2780 if (inputa (ifi) = "{") 2781 then 2782 do; 2783 ifi = ifi - 1; 2784 if (var.type = 0) 2785 then 2786 do; 2787 lower, higher = -9999; 2788 end; 2789 else 2790 do; 2791 arr_ptr = var.ref; 2792 lower = array.l_bound; 2793 higher = array.h_bound; 2794 end; 2795 call get_range (ifp, ifi, ife, ofp, ofe, TF, lower, higher); 2796 if (inputa (ifi) ^= "}") 2797 then 2798 do; 2799 msg = "}"; 2800 call error_missing (cmd (which), begl, ifi); 2801 end; 2802 ifi = ifi + 1; 2803 call strip (ifp, ifi, ife); 2804 var_ptr = vptr; 2805 if (which > 0) /* not let */ 2806 then 2807 do; 2808 if (lower = higher) 2809 then 2810 do; 2811 if (lower < 1) 2812 then 2813 do; 2814 msg = "Improper dimension. "; 2815 goto add_identification; 2816 end; 2817 lower = 1; 2818 end; 2819 if (found ^= which) 2820 then 2821 do; 2822 var.type = 1; 2823 var.len = higher - lower + 1; 2824 allocate array in (free_area) set (arr_ptr); 2825 var.ref = arr_ptr; 2826 if al_sw 2827 then call ioa_ ("A^a{^i:^i} ^i ^p", vname, lower, 2828 higher, size (array), var.ref); 2829 do arr_elem = 1 to var.len; 2830 array.ref (arr_elem) = null (); 2831 array.len (arr_elem) = 0; 2832 end; 2833 array.lower = lower; 2834 end; 2835 if (substr (input, ifi, 3) = "var") 2836 then 2837 do; 2838 ifi = ifi + 3; 2839 if (found = which) 2840 then 2841 do; 2842 if (var.type ^= 2) | (array.lower ^= lower) 2843 | (var.len ^= higher - lower + 1) 2844 then 2845 do; 2846 dcl_err: 2847 msg = "Data declaration does not match prior declaration for """ 2848 ; 2849 msg = msg || vname; 2850 msg = msg || """. "; 2851 goto add_identification; 2852 end; 2853 end; 2854 else 2855 do; 2856 var.type = 2; 2857 array.l_bound = higher + 1; 2858 array.h_bound = lower - 1; 2859 end; 2860 end; 2861 else if (substr (input, ifi, 4) = "list") 2862 then 2863 do; 2864 ifi = ifi + 4; 2865 if (found = which) 2866 then 2867 do; 2868 if (var.type ^= 3) | (var.len ^= higher) 2869 then goto dcl_err; 2870 end; 2871 else 2872 do; 2873 var.type = 3; 2874 array.l_bound = 1; 2875 array.h_bound = 0; 2876 end; 2877 end; 2878 else if (substr (input, ifi, 4) = "fifo") 2879 then 2880 do; 2881 ifi = ifi + 4; 2882 if (found = which) 2883 then 2884 do; 2885 if (var.type ^= 4) | (array.l_bound ^= lower) 2886 | (array.h_bound ^= higher) 2887 then goto dcl_err; 2888 end; 2889 else 2890 do; 2891 var.type = 4; 2892 array.l_bound = 1; 2893 array.h_bound = 0; 2894 end; 2895 end; 2896 else if (substr (input, ifi, 4) = "lifo") 2897 then 2898 do; 2899 ifi = ifi + 4; 2900 if (found = which) 2901 then 2902 do; 2903 if (var.type ^= 5) | (array.l_bound ^= lower) 2904 | (array.h_bound ^= higher) 2905 then goto dcl_err; 2906 end; 2907 else 2908 do; 2909 var.type = 5; 2910 array.l_bound = 1; 2911 array.h_bound = 0; 2912 end; 2913 end; 2914 else 2915 do; 2916 if (found = which) 2917 then 2918 do; 2919 if (var.type ^= 1) | (array.l_bound ^= lower) 2920 | (array.h_bound ^= higher) 2921 then goto dcl_err; 2922 end; 2923 else 2924 do; 2925 array.l_bound = lower; 2926 array.h_bound = higher; 2927 end; 2928 end; 2929 call strip (ifp, ifi, ife); 2930 end; 2931 else 2932 do; 2933 if (var.type ^= 1) & (var.type ^= 2) 2934 then 2935 do; 2936 msg = "Attempt to do array assignment to non-array variable. " 2937 ; 2938 goto add_identification; 2939 end; 2940 arr_ptr = var.ref; 2941 if (lower < array.lower) 2942 then 2943 do; 2944 msg = "Attempt to set below lower bound. "; 2945 goto add_identification; 2946 end; 2947 if (higher > array.lower + var.len - 1) 2948 then 2949 do; 2950 msg = "Attempt to set above upper bound. "; 2951 goto add_identification; 2952 end; 2953 end; 2954 call strip (ifp, ifi, ife); 2955 if (which > 0) 2956 then if (substr (input, ifi, 2) = "&;") 2957 then 2958 do; 2959 call strip2 (ifp, ifi, ife); 2960 return; 2961 end; 2962 end; 2963 else 2964 do; 2965 if (var.type = 1) | (var.type = 2) 2966 then 2967 do; 2968 msg = "Attempt to do scalar assignment to array variable. "; 2969 goto add_identification; 2970 end; 2971 if (var.type = 4) /* fifo */ 2972 then 2973 do; 2974 arr_ptr = var.ref; 2975 if (array.l_bound + var.len - 1 > array.h_bound) 2976 then 2977 do; 2978 msg = "Out-of-bounds on fifo """; 2979 msg = msg || vname; 2980 msg = msg || """. "; 2981 goto add_identification; 2982 end; 2983 if (array.l_bound + var.len - 1 = array.h_bound) 2984 then 2985 do; 2986 msg = "Attempt to stack too many elements. "; 2987 goto add_identification; 2988 end; 2989 array.h_bound = array.h_bound + 1; 2990 lower, higher = mod (array.h_bound, var.len) + 1; 2991 end; 2992 if (var.type = 5) 2993 then 2994 do; 2995 arr_ptr = var.ref; 2996 if (var.len < array.h_bound) 2997 then 2998 do; 2999 msg = "Out-of-bounds on lifo """; 3000 msg = msg || vname; 3001 msg = msg || """. "; 3002 goto add_identification; 3003 end; 3004 if (var.len = array.h_bound) 3005 then 3006 do; 3007 msg = "Attempt to stack too many elements. "; 3008 goto add_identification; 3009 end; 3010 array.h_bound, lower, higher = array.h_bound + 1; 3011 end; 3012 end; 3013 if (inputa (ifi) ^= "=") 3014 then 3015 do; 3016 msg = "="; 3017 call error_missing (cmd (which), begl, ifi); 3018 dcl cmd (0:3) char (4) int static 3019 init ("let ", "ext ", "int ", "loc "); 3020 end; 3021 ifi = ifi + 1; 3022 call strip (ifp, ifi, ife); 3023 jj = ofe; 3024 if (inputa (ifi) = "(") 3025 then 3026 do; 3027 msg = "Vector assignment not available yet."; 3028 call error_gen (cmd (which), begl, ifi); 3029 end; 3030 if (substr (input, ifi, 2) = "&(") 3031 then 3032 do; 3033 call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 3034 call strip (ifp, ifi, ife); 3035 end; 3036 else 3037 do; 3038 construct_nest = construct_nest + 1; 3039 loop: 3040 i = index (substr (input, ifi), "&"); 3041 if (i = 0) 3042 then 3043 do; 3044 msg = "&;"; 3045 call error_missing (cmd (which), begl, ife); 3046 end; 3047 if (i > 1) 3048 then 3049 do; 3050 i = i - 1; 3051 substr (output, ofe + 1, i) = substr (input, ifi, i); 3052 ofe = ofe + i; 3053 ifi = ifi + i; 3054 end; 3055 if (substr (input, ifi, 2) ^= "&;") 3056 then 3057 do; 3058 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 3059 goto loop; 3060 end; 3061 construct_nest = construct_nest - 1; 3062 end; 3063 if (substr (input, ifi, 2) ^= "&;") 3064 then 3065 do; 3066 msg = "&;"; 3067 call error_missing (cmd (which), begl, ife); 3068 end; 3069 call strip2 (ifp, ifi, ife); 3070 if (found = 0) | (which = 0) 3071 then 3072 do; 3073 j = ofe - jj; 3074 var_ptr = vptr; 3075 if (var.type = 0) 3076 then 3077 do; 3078 if (var.len ^= j) 3079 then 3080 do; 3081 if (var.len > 0) 3082 then 3083 do; 3084 if al_sw 3085 then call ioa_ ("F ^a ^i ^p", vname, var.len, 3086 var.ref); 3087 free vartext in (free_area); 3088 end; 3089 var.len = j; 3090 allocate vartext in (free_area) set (var.ref); 3091 if al_sw 3092 then call ioa_ ("A ^a ^i ^p", vname, size (vartext), 3093 var.ref); 3094 end; 3095 vartext = substr (output, jj + 1, j); 3096 if db_sw | tr_sw 3097 then 3098 do; 3099 call ioa_$nnl ("#^a:^a^-&^a ^a =", lineno (begl), 3100 lineno (ifi - 1), cmd (which), var.name); 3101 call show_string (vartext, "&; 3102 "); 3103 end; 3104 end; 3105 else 3106 do; 3107 arr_ptr = var.ref; 3108 if (var.type = 2) 3109 then 3110 do; 3111 array.l_bound = min (array.l_bound, lower); 3112 array.h_bound = max (array.h_bound, higher); 3113 end; 3114 if (var.type = 3) 3115 then 3116 do; 3117 do arr_elem = array.l_bound to array.h_bound; 3118 if (arrtext = substr (output, jj + 1, j)) 3119 then 3120 do; 3121 ofe = jj; 3122 return; 3123 end; 3124 end; 3125 if (array.h_bound = var.len) 3126 then 3127 do; 3128 msg = "Attempt to add too many elements to list. " 3129 ; 3130 goto add_identification; 3131 end; 3132 array.h_bound, lower, higher = array.h_bound + 1; 3133 end; 3134 do arr_elem = lower - array.lower + 1 3135 to higher - array.lower + 1; 3136 if (array.len (arr_elem) ^= j) 3137 then 3138 do; 3139 if (array.ref (arr_elem) ^= null ()) 3140 then 3141 do; 3142 if al_sw 3143 then call ioa_ ("F ^a{^i} ^i ^p", vname, 3144 arr_elem, array.len (arr_elem), 3145 array.ref (arr_elem)); 3146 free arrtext in (free_area); 3147 end; 3148 array.len (arr_elem) = j; 3149 allocate arrtext in (free_area) 3150 set (array.ref (arr_elem)); 3151 if al_sw 3152 then call ioa_ ("A ^a{^i} ^i ^p", vname, arr_elem, 3153 size (arrtext), array.ref (arr_elem)); 3154 end; 3155 arrtext = substr (output, jj + 1, j); 3156 end; 3157 if db_sw | tr_sw 3158 then 3159 do; 3160 call ioa_$nnl ("#^a:^a^-&^a ^a{^i:^i} =", lineno (begl), 3161 lineno (ifi - 1), cmd (which), var.name, lower, 3162 higher); 3163 call show_string (substr (output, jj + 1, j), "&; 3164 "); 3165 end; 3166 end; 3167 end; 3168 ofe = jj; 3169 end macro_let; 3170 3171 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3172 /* */ 3173 /* double any quotes in a string */ 3174 3175 macro_quote: 3176 proc (ifp, ifi, ife, ofp, ofe, tf); 3177 3178 dcl ifp ptr, /* pointer to input */ 3179 ifi fixed bin (24), 3180 /* first char of input to use */ 3181 ife fixed bin (24), 3182 /* last char of input to use */ 3183 ofp ptr, /* pointer to output */ 3184 ofe fixed bin (24), 3185 /* last char of output used */ 3186 tf bit (2); /* 1x- process true */ 3187 /* x1- process false */ 3188 dcl begl fixed bin (24); 3189 dcl inputa (ife) char (1) based (ifp); 3190 dcl input char (ife) based (ifp); 3191 dcl output char (1044480) based (ofp); 3192 dcl (i, j, ii, jj) fixed bin (24); 3193 dcl inside bit (1); 3194 dcl ch char (1); 3195 3196 /* "e ... &; */ 3197 3198 begl = ifi; 3199 ifi = ifi + 6; 3200 call strip (ifp, ifi, ife); 3201 ii = ofe; 3202 construct_nest = construct_nest + 1; 3203 loop: 3204 i = index (substr (input, ifi), "&"); 3205 if (i = 0) 3206 then 3207 do; 3208 msg = "&;"; 3209 call error_missing ("quote", begl, ife); 3210 end; 3211 if (i > 1) 3212 then 3213 do; 3214 i = i - 1; 3215 substr (output, ofe + 1, i) = substr (input, ifi, i); 3216 ofe = ofe + 1; 3217 ifi = ifi + 1; 3218 end; 3219 if (substr (input, ifi, 2) ^= "&;") 3220 then 3221 do; 3222 call ampersand (ifp, ifi, ife, ofp, ofe, tf, "0"b); 3223 goto loop; 3224 end; 3225 call strip2 (ifp, ifi, ife); 3226 i = ofe - ii; 3227 if (i > 16384) 3228 then 3229 do; 3230 msg = "Sorry, not yet handling "e strings > 16384 chrs."; 3231 goto add_identification; 3232 end; 3233 construct_nest = construct_nest - 1; 3234 if (index (substr (output, ii + 1, i), """") = 0) 3235 then 3236 do; 3237 return; 3238 end; 3239 begin; 3240 dcl argstr char (i); 3241 argstr = substr (output, ii + 1, i); 3242 ofe = ii; 3243 j = 1; 3244 loop: 3245 ii = index (substr (argstr, j), """"); 3246 if (ii = 0) 3247 then ii = i - j + 1; 3248 substr (output, ofe + 1, ii) = substr (argstr, j, ii); 3249 ofe = ofe + ii; 3250 j = j + ii; 3251 if (substr (output, ofe, 1) = """") 3252 then 3253 do; 3254 substr (output, ofe + 1, 1) = """"; 3255 ofe = ofe + 1; 3256 end; 3257 if (j > i) 3258 then return; 3259 goto loop; 3260 end; 3261 end macro_quote; 3262 3263 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3264 /* */ 3265 /* rescan a result of macro expansion */ 3266 3267 macro_scan: 3268 proc (ifp, ifi, ife, ofp, ofe, TF); 3269 3270 dcl ifp ptr, /* pointer to input */ 3271 ifi fixed bin (24), 3272 /* first char of input to use */ 3273 ife fixed bin (24), 3274 /* last char of input to use */ 3275 ofp ptr, /* pointer to output */ 3276 ofe fixed bin (24), 3277 /* last char of output used */ 3278 TF bit (2); 3279 dcl begl fixed bin (24); 3280 dcl inputa (ife) char (1) based (ifp); 3281 dcl input char (ife) based (ifp); 3282 dcl output char (1044480) based (ofp); 3283 dcl (i, j, ii, jj) fixed bin (24); 3284 dcl loc (24) fixed bin (24); 3285 dcl sep_ct fixed bin (24); 3286 dcl argstrl fixed bin (24); 3287 3288 /* &scan ... &; */ 3289 3290 begl = ifi; 3291 ifi = ifi + 5; 3292 call strip (ifp, ifi, ife); 3293 if db_sw 3294 then call dumper ("scan", ifp, ifi, ife, ofp, ofe, TF); 3295 ii = ofe; 3296 construct_nest = construct_nest + 1; 3297 loop: 3298 i = index (substr (input, ifi), "&"); 3299 if (i = 0) 3300 then 3301 do; 3302 msg = "&;"; 3303 call error_missing ("scan", begl, ife); 3304 end; 3305 if (i > 1) 3306 then 3307 do; 3308 i = i - 1; 3309 substr (output, ofe + 1, i) = substr (input, ifi, i); 3310 ofe = ofe + i; 3311 ifi = ifi + i; 3312 end; 3313 if (substr (input, ifi, 2) = "&;") 3314 then 3315 do; 3316 call strip2 (ifp, ifi, ife); 3317 argstrl = ofe - ii; 3318 if (argstrl > 16384) 3319 then 3320 do; 3321 msg = "&scan string > 16384 chars."; 3322 goto add_identification; 3323 end; 3324 begin; 3325 dcl argstr char (argstrl); 3326 if db_sw | tr_sw 3327 then 3328 do; 3329 call ioa_$nnl ("#^a:^a^-&scan ", lineno (begl), 3330 lineno (ifi - 1)); 3331 call show_string (substr (output, ii + 1, argstrl), "&; 3332 "); 3333 end; 3334 string (argstr) = substr (output, ii + 1, argstrl); 3335 ofe = ii; 3336 call expand (addr (argstr), 1, argstrl, ofp, ofe, (TF)); 3337 construct_nest = construct_nest - 1; 3338 return; 3339 end; 3340 end; 3341 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 3342 goto loop; 3343 end macro_scan; 3344 3345 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3346 /* */ 3347 /* return part of a string with needed padding */ 3348 3349 macro_substr: 3350 proc (ifp, ifi, ife, ofp, ofe, TF); 3351 3352 dcl ifp ptr, /* pointer to input */ 3353 ifi fixed bin (24), 3354 /* first char of input to use */ 3355 ife fixed bin (24), 3356 /* last char of input to use */ 3357 ofp ptr, /* pointer to output */ 3358 ofe fixed bin (24), 3359 /* last char of output used */ 3360 TF bit (2); 3361 dcl begl fixed bin (24); 3362 dcl inputa (ife) char (1) based (ifp); 3363 dcl input char (ife) based (ifp); 3364 dcl output char (1044480) based (ofp); 3365 dcl (i, j, ii, jj) fixed bin (24); 3366 dcl loc (24) fixed bin (24); 3367 dcl sep_ct fixed bin (24); 3368 dcl argstrl fixed bin (24); 3369 3370 /* &substr ... , ARITH , ARITH &; 3371* &substr ... , ARITH &; 3372* &substr ... , ARITH : ARITH &; */ 3373 3374 begl = ifi; 3375 ifi = ifi + 7; 3376 call strip (ifp, ifi, ife); 3377 if db_sw 3378 then call dumper ("subs", ifp, ifi, ife, ofp, ofe, TF); 3379 ii = ofe; 3380 construct_nest = construct_nest + 1; 3381 loop: 3382 i = search (substr (input, ifi), "&,"); 3383 if (i = 0) 3384 then 3385 do; 3386 msg = "&;"; 3387 call error_missing ("substr", begl, ife); 3388 end; 3389 if (i > 1) 3390 then 3391 do; 3392 i = i - 1; 3393 substr (output, ofe + 1, i) = substr (input, ifi, i); 3394 ofe = ofe + i; 3395 ifi = ifi + i; 3396 end; 3397 if (inputa (ifi) = "&") 3398 then 3399 do; 3400 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 3401 goto loop; 3402 end; 3403 argstrl = ofe - ii; 3404 if (argstrl > 16384) 3405 then 3406 do; 3407 msg = "&substr string > 16384 chrs."; 3408 goto add_identification; 3409 end; 3410 begin; 3411 dcl argstr char (argstrl); 3412 dcl sepch char (1); 3413 argstr = substr (output, ii + 1, argstrl); 3414 ofe = ii; 3415 ifi = ifi - 1; 3416 call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 3417 i = fixed (substr (output, ii + 1, ofe - ii)); 3418 sepch = " "; 3419 ofe = ii; 3420 if (inputa (ifi) = ",") | (inputa (ifi) = ":") 3421 then 3422 do; 3423 sepch = inputa (ifi); 3424 ifi = ifi - 1; 3425 call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 3426 j = fixed (substr (output, ii + 1, ofe - ii)); 3427 ofe = ii; 3428 end; 3429 if (substr (input, ifi, 2) ^= "&;") 3430 then goto misplaced; 3431 call strip2 (ifp, ifi, ife); 3432 if (TF ^= "00"b) 3433 then 3434 do; 3435 if (i < 0) 3436 then i = argstrl + i + 1; 3437 if (sepch = " ") 3438 then j = argstrl - i + 1; 3439 if (sepch = ":") 3440 then 3441 do; 3442 if (j < 1) 3443 then 3444 do; 3445 msg = "Substr end location <0. "; 3446 goto add_identification; 3447 end; 3448 if (j < i) 3449 then 3450 do; 3451 msg = "Substr end before begin. "; 3452 goto add_identification; 3453 end; 3454 j = j - i + 1; 3455 end; 3456 if (j < 0) 3457 then 3458 do; 3459 jj = (argstrl - i + 1) + j; 3460 if (jj < 0) 3461 then 3462 do; 3463 substr (output, ofe + 1, -jj) = " "; 3464 ofe = ofe - jj; 3465 j = -j + jj; 3466 end; 3467 else j = -j; 3468 end; 3469 if (i < 1) 3470 then 3471 do; 3472 msg = "Substr before string begin. "; 3473 goto add_identification; 3474 end; 3475 if (i > argstrl) 3476 then 3477 do; 3478 msg = "Substr after string end. "; 3479 msg_etc = ltrim (char (i)); 3480 msg_etc = msg_etc || ","; 3481 msg_etc = msg_etc || ltrim (char (j)); 3482 msg_etc = msg_etc || " of "; 3483 msg_etc = msg_etc || ltrim (char (argstrl)); 3484 msg_etc = msg_etc || """"; 3485 msg_etc = msg_etc || argstr; 3486 msg_etc = msg_etc || """"; 3487 goto add_identification; 3488 end; 3489 substr (output, ofe + 1, j) = substr (argstr, i); 3490 ofe = ofe + j; 3491 end; 3492 end; 3493 construct_nest = construct_nest - 1; 3494 end macro_substr; 3495 3496 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3497 /* */ 3498 /* remove doubled quotes and surrounding quotes (if any) from a string */ 3499 3500 macro_unquote: 3501 proc (ifp, ifi, ife, ofp, ofe, tf); 3502 3503 dcl ifp ptr, /* pointer to input */ 3504 ifi fixed bin (24), 3505 /* first char of input to use */ 3506 ife fixed bin (24), 3507 /* last char of input to use */ 3508 ofp ptr, /* pointer to output */ 3509 ofe fixed bin (24), 3510 /* last char of output used */ 3511 tf bit (2); /* 1x- process true */ 3512 /* x1- process false */ 3513 dcl begl fixed bin (24); 3514 dcl inputa (ife) char (1) based (ifp); 3515 dcl input char (ife) based (ifp); 3516 dcl output char (1044480) based (ofp); 3517 dcl (i, j, ii, jj) fixed bin (24); 3518 dcl inside bit (1); 3519 dcl ch char (1); 3520 3521 /* &unquote ... &; */ 3522 3523 begl = ifi; 3524 ifi = ifi + 8; 3525 call strip (ifp, ifi, ife); 3526 ii = ofe; 3527 construct_nest = construct_nest + 1; 3528 loop: 3529 i = index (substr (input, ifi), "&"); 3530 if (i = 0) 3531 then 3532 do; 3533 msg = "&;"; 3534 call error_missing ("unquote", begl, ife); 3535 end; 3536 if (i > 1) 3537 then 3538 do; 3539 i = i - 1; 3540 substr (output, ofe + 1, i) = substr (input, ifi, i); 3541 ofe = ofe + 1; 3542 ifi = ifi + 1; 3543 end; 3544 if (substr (input, ifi, 2) ^= "&;") 3545 then 3546 do; 3547 call ampersand (ifp, ifi, ife, ofp, ofe, tf, "0"b); 3548 goto loop; 3549 end; 3550 call strip2 (ifp, ifi, ife); 3551 construct_nest = construct_nest - 1; 3552 i = ii; 3553 inside = "0"b; 3554 do ii = ii + 1 to ofe; 3555 ch = substr (output, ii, 1); 3556 if (ch = """") 3557 then 3558 do; 3559 if inside 3560 then 3561 do; 3562 if (substr (output, ii + 1, 1) = """") 3563 then 3564 do; 3565 ii = ii + 1; 3566 goto use_char; 3567 end; 3568 else inside = "0"b; 3569 end; 3570 else inside = "1"b; 3571 end; 3572 else 3573 do; 3574 use_char: 3575 i = i + 1; 3576 substr (output, i, 1) = ch; 3577 end; 3578 end; 3579 ofe = i; 3580 3581 end macro_unquote; 3582 3583 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3584 /* */ 3585 /* show the macros used up to this point */ 3586 3587 macro_usage: 3588 proc (ifp, ifi, ife, ofp, ofe, TF); 3589 3590 dcl ifp ptr, /* pointer to input */ 3591 ifi fixed bin (24), 3592 /* first char of input to use */ 3593 ife fixed bin (24), 3594 /* last char of input to use */ 3595 ofp ptr, /* pointer to output */ 3596 ofe fixed bin (24), 3597 /* last char of output used */ 3598 TF bit (2); 3599 dcl begl fixed bin (24); 3600 dcl inputa (ife) char (1) based (ifp); 3601 dcl input char (ife) based (ifp); 3602 dcl output char (1044480) based (ofp); 3603 dcl (i, j, ii, jj) fixed bin (24); 3604 dcl loc (24) fixed bin (24); 3605 dcl sep_ct fixed bin (24); 3606 dcl argstrl fixed bin (24); 3607 dcl ctl char (100) var; 3608 dcl ret_str char (256); 3609 dcl ret_len fixed bin (24); 3610 dcl ioa_$rsnpnnl entry options (variable); 3611 3612 /* &usage string &; */ 3613 3614 begl = ifi; 3615 ifi = ifi + 6; 3616 call strip (ifp, ifi, ife); 3617 if db_sw 3618 then call dumper ("usag", ifp, ifi, ife, ofp, ofe, TF); 3619 ii = ofe; 3620 construct_nest = construct_nest + 1; 3621 loop: 3622 i = index (substr (input, ifi), "&"); 3623 if (i = 0) 3624 then 3625 do; 3626 msg = "&;"; 3627 call error_missing ("usage", begl, ife); 3628 end; 3629 if (i > 1) 3630 then 3631 do; 3632 i = i - 1; 3633 substr (output, ofe + 1, i) = substr (input, ifi, i); 3634 ofe = ofe + i; 3635 ifi = ifi + i; 3636 end; 3637 if (substr (input, ifi, 2) = "&;") 3638 then 3639 do; 3640 call strip2 (ifp, ifi, ife); 3641 ctl = substr (output, ii + 1, ofe - ii); 3642 ofe = ii; 3643 do maclp = macro_list_p repeat (macro_list.next) 3644 while (maclp ^= null ()); 3645 call ioa_$rsnpnnl (ctl, ret_str, ret_len, macro_list.dname, 3646 macro_list.ename, macro_list.name); 3647 substr (output, ofe + 1, ret_len) = substr (ret_str, 1, ret_len); 3648 ofe = ofe + ret_len; 3649 end; 3650 construct_nest = construct_nest - 1; 3651 return; 3652 end; 3653 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 3654 goto loop; 3655 end macro_usage; 3656 3657 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3658 /* */ 3659 /* process a protected string */ 3660 3661 protected: 3662 proc (ifp, ifi, ife, ofp, ofe); 3663 3664 dcl ifp ptr, /* pointer to input */ 3665 ifi fixed bin (24), 3666 /* first char of input to use */ 3667 ife fixed bin (24), 3668 /* last char of input to use */ 3669 ofp ptr, /* pointer to output */ 3670 ofe fixed bin (24); 3671 /* last char of output used */ 3672 dcl begl fixed bin (24); 3673 dcl inputa (ife) char (1) based (ifp); 3674 dcl input char (ife) based (ifp); 3675 dcl output char (1044480) based (ofp); 3676 dcl (i, j, ii, jj) fixed bin (24); 3677 dcl loc (24) fixed bin (24); 3678 dcl sep_ct fixed bin (24); 3679 dcl argstrl fixed bin (24); 3680 3681 /* &" ... {&"&"} ... &" */ 3682 3683 begl = ifi; 3684 ifi = ifi + 2; 3685 do while ("1"b); 3686 i = index (substr (input, ifi), "&"""); 3687 if (i = 0) 3688 then 3689 do; 3690 msg = "&"""; 3691 call error_missing ("""", begl, ife); 3692 end; 3693 i = i - 1; 3694 substr (output, ofe + 1, i) = substr (input, ifi, i); 3695 ofe = ofe + i; 3696 ifi = ifi + i + 2; 3697 if (substr (input, ifi, 2) ^= "&""") 3698 then return; 3699 substr (output, ofe + 1, 2) = "&"""; 3700 ofe = ofe + 2; 3701 ifi = ifi + 2; 3702 end; 3703 end protected; 3704 3705 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3706 /* */ 3707 /* scan a string and print it indenting 1 HT. */ 3708 3709 show_string: 3710 proc (str1, str2); 3711 3712 dcl (str1, str2) char (*); 3713 dcl (i, j, k) fixed bin (24); 3714 dcl HT_sw bit (1); 3715 3716 i = 1; 3717 do while (i <= length (str1)); 3718 j = index (substr (str1, i), NL); 3719 if (j = 0) 3720 then 3721 do; 3722 j = length (str1) - i + 1; 3723 HT_sw = "0"b; 3724 end; 3725 else HT_sw = "1"b; 3726 k = i + j; 3727 call ioa_$nnl ("^a^[^-^]", substr (str1, i, j), HT_sw); 3728 i = k; 3729 end; 3730 call ioa_$nnl ("^a", str2); 3731 3732 end show_string; 3733 3734 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3735 /* */ 3736 /* skip over whitespace. strip2 moves ahead 2 first */ 3737 3738 strip2: 3739 proc (ifp, ifi, ife); 3740 3741 ifi = ifi + 2; 3742 3743 strip: 3744 entry (ifp, ifi, ife); 3745 3746 dcl ifp ptr, 3747 ifi fixed bin (24), 3748 ife fixed bin (24); 3749 dcl input char (ife) based (ifp); 3750 3751 dcl i fixed bin (24); 3752 3753 loop: 3754 i = verify (substr (input, ifi), space); 3755 if (i = 0) 3756 then ifi = ife + 1; 3757 else ifi = ifi + i - 1; 3758 if (substr (input, ifi, 1) ^= "&") 3759 then return; 3760 i = verify (substr (input, ifi + 1), token_chars); 3761 if (substr (input, ifi + 1, i) ^= "comment") 3762 then return; 3763 i = index (substr (input, ifi), "&;"); 3764 if (i = 0) 3765 then 3766 do; 3767 msg = "&;"; 3768 call error_missing ("comment", ifi, ifi + 8); 3769 end; 3770 ifi = ifi + i + 1; 3771 goto loop; /* keep on stripping */ 3772 3773 end strip2; 3774 3775 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3776 /* */ 3777 /* return the lbound/hbound of an array */ 3778 3779 var_bound: 3780 proc (ifp, ifi, ife, ofp, ofe, TF) recursive; 3781 3782 dcl ifp ptr, /* pointer to input */ 3783 ifi fixed bin (24), 3784 /* first char of input to use */ 3785 ife fixed bin (24), 3786 /* last char of input to use */ 3787 ofp ptr, /* pointer to output */ 3788 ofe fixed bin (24), 3789 /* last char of output used */ 3790 TF bit (2); 3791 dcl begl fixed bin (24); 3792 dcl inputa (ife) char (1) based (ifp); 3793 dcl input char (ife) based (ifp); 3794 dcl output char (1044480) based (ofp); 3795 dcl (i, j, ii, jj) fixed bin (24); 3796 dcl loc (24) fixed bin (24); 3797 dcl (sep_ct, level) fixed bin (24); 3798 dcl argstrl fixed bin (24); 3799 dcl vname char (32) var; 3800 3801 /* &lbound xxx&; 3802* &hbound xxx&; */ 3803 ii = ofe; 3804 call strip (ifp, ifi, ife); 3805 loop: 3806 i = index (substr (input, ifi), "&"); 3807 if (i = 0) 3808 then 3809 do; 3810 msg = "Missing terminator on &"; 3811 msg = msg || c32; 3812 msg = msg || ". "; 3813 goto add_identification; 3814 end; 3815 if (i > 1) 3816 then 3817 do; 3818 i = i - 1; 3819 substr (output, ofe + 1, i) = substr (input, ifi, i); 3820 ofe = ofe + i; 3821 ifi = ifi + i; 3822 end; 3823 if (substr (input, ifi, 2) ^= "&;") 3824 then 3825 do; 3826 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 3827 goto loop; 3828 end; 3829 vname = substr (output, ii + 1, ofe - ii); 3830 ofe = ii; 3831 j = lookup (vname); 3832 if (j = 0) 3833 then 3834 do; 3835 msg = "Attempt to reference undeclared variable """; 3836 msg = msg || vname; 3837 msg = msg || """. "; 3838 goto add_identification; 3839 end; 3840 if (var.type = 0) 3841 then 3842 do; 3843 msg = "Attempt to get "; 3844 msg = msg || c32; 3845 msg = msg || " of a scalar. "; 3846 goto add_identification; 3847 end; 3848 arr_ptr = var.ref; 3849 if (var.type = 1) /* array */ 3850 | (var.type = 2) /* array var */ 3851 | (var.type = 3) /* list */ 3852 then 3853 do; 3854 if (c32 = "lbound") 3855 then i = array.l_bound; 3856 else i = array.h_bound; 3857 end; 3858 if (var.type = 4) /* fifo */ 3859 | (var.type = 5) /* lifo */ 3860 then 3861 do; 3862 msg = "Cannot get "; 3863 msg = msg || c32; 3864 msg = msg || " of "; 3865 if (var.type = 5) 3866 then msg = msg || "l"; 3867 else msg = msg || "f"; 3868 msg = msg || "ifo."; 3869 goto add_identification; 3870 end; 3871 end var_bound; 3872 3873 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3874 /* */ 3875 /* */ 3876 3877 var_range: 3878 proc (ifp, ifi, ife, ofp, ofe, TF); 3879 3880 dcl ifp ptr, /* pointer to input */ 3881 ifi fixed bin (24), 3882 /* first char of input to use */ 3883 ife fixed bin (24), 3884 /* last char of input to use */ 3885 ofp ptr, /* pointer to output */ 3886 ofe fixed bin (24), 3887 /* last char of output used */ 3888 TF bit (2); 3889 dcl begl fixed bin (24); 3890 dcl inputa (ife) char (1) based (ifp); 3891 dcl input char (ife) based (ifp); 3892 dcl output char (1044480) based (ofp); 3893 dcl (i, j, ii, jj) fixed bin (24); 3894 dcl separator char (150) var; 3895 dcl vptr ptr; 3896 dcl limit fixed bin; 3897 3898 /* &var{ ARITH } yields argument ARITH */ 3899 /* &var{ ARITH : ARITH } yields arguments ARITH thru ARITH */ 3900 /* separated by a SP */ 3901 /* &var{ ARITH : ARITH , STRING } yields arguments ARITH thru ARITH */ 3902 /* separated by STRING */ 3903 3904 begl = ifi; 3905 ii = ofe; 3906 i = lookup (c32); 3907 if (i = 0) 3908 then 3909 do; 3910 msg = "Attempt to reference undeclared array. "; 3911 goto add_identification; 3912 end; 3913 if (var.type = 0) 3914 then 3915 do; 3916 msg = "Attempt to make non-scalar ref to scalar variable """; 3917 msg = msg || c32; 3918 msg = msg || """. "; 3919 goto add_identification; 3920 end; 3921 vptr = var_ptr; 3922 arr_ptr = var.ref; 3923 i = array.l_bound; 3924 j = array.h_bound; 3925 ifi = ifi - 2; 3926 call get_range (ifp, ifi, ife, ofp, ofe, TF, i, j); 3927 var_ptr = vptr; 3928 arr_ptr = var.ref; 3929 if (TF ^= "00"b) 3930 then 3931 do; 3932 if (var.type = 4) | (var.type = 5) 3933 then 3934 do; 3935 if (i ^= j) 3936 then 3937 do; 3938 msg = "Attempt to make multiple ref to stack """; 3939 msg = msg || c32; 3940 msg = msg || """. "; 3941 goto add_identification; 3942 end; 3943 if (i > 0) 3944 then 3945 do; 3946 msg = "Attempt to ref positive stack element """; 3947 msg = msg || c32; 3948 msg = msg || """. "; 3949 goto add_identification; 3950 end; 3951 if (var.type = 4) 3952 then 3953 do; 3954 i, j = array.l_bound - i; 3955 if (i > array.h_bound) 3956 then 3957 do; 3958 msg = "Attempt to ref non-existant stack element in """ 3959 ; 3960 msg = msg || c32; 3961 msg = msg || """. "; 3962 goto add_identification; 3963 end; 3964 end; 3965 else 3966 do; 3967 i, j = array.h_bound + i; 3968 if (i < array.l_bound) 3969 then 3970 do; 3971 msg = "Attempt to ref non-existant stack element in """ 3972 ; 3973 msg = msg || c32; 3974 msg = msg || """. "; 3975 goto add_identification; 3976 end; 3977 end; 3978 end; 3979 else 3980 do; 3981 if (i < array.l_bound) 3982 then 3983 do; 3984 msg = "Attempt to reference below lower bound. "; 3985 goto add_identification; 3986 end; 3987 if (j > array.h_bound) 3988 then 3989 do; 3990 msg = "Attempt to reference above upper bound. "; 3991 goto add_identification; 3992 end; 3993 end; 3994 end; 3995 separator = " "; 3996 if (inputa (ifi) = ",") 3997 then 3998 do; 3999 ifi = ifi + 1; 4000 do while ("1"b); 4001 jj = search (substr (input, ifi), "&}"); 4002 if (jj = 0) 4003 then 4004 do; 4005 msg = "}"; 4006 call error_missing ("xxx{", begl, ife); 4007 end; 4008 if (jj > 1) 4009 then 4010 do; 4011 jj = jj - 1; 4012 substr (output, ofe + 1, jj) = substr (input, ifi, jj); 4013 ifi = ifi + jj; 4014 ofe = ofe + jj; 4015 end; 4016 if (inputa (ifi) = "}") 4017 then 4018 do; 4019 separator = substr (output, ii + 1, ofe - ii); 4020 ofe = ii; 4021 goto end_range; 4022 end; 4023 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 4024 end; 4025 end; 4026 if (inputa (ifi) = "}") 4027 then 4028 do; 4029 end_range: 4030 ifi = ifi + 1; 4031 if (TF = "00"b) 4032 then return; 4033 var_ptr = vptr; 4034 arr_ptr = var.ref; 4035 limit = j - array.lower + 1; 4036 do arr_elem = i - array.lower + 1 to limit; 4037 substr (output, ofe + 1, array.len (arr_elem)) = arrtext; 4038 ofe = ofe + array.len (arr_elem); 4039 if (arr_elem ^= limit) 4040 then 4041 do; 4042 substr (output, ofe + 1, length (separator)) = separator; 4043 ofe = ofe + length (separator); 4044 end; 4045 end; 4046 end; 4047 else 4048 do; 4049 msg = "&var{ ... }"; 4050 goto syntax_err; 4051 end; 4052 end var_range; 4053 4054 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 4055 /* */ 4056 /* reference a variable */ 4057 4058 var_ref: 4059 proc (ifp, ifi, ife, ofp, ofe, TF) recursive; 4060 4061 dcl ifp ptr, /* pointer to input */ 4062 ifi fixed bin (24), 4063 /* first char of input to use */ 4064 ife fixed bin (24), 4065 /* last char of input to use */ 4066 ofp ptr, /* pointer to output */ 4067 ofe fixed bin (24), 4068 /* last char of output used */ 4069 TF bit (2); 4070 dcl begl fixed bin (24); 4071 dcl inputa (ife) char (1) based (ifp); 4072 dcl input char (ife) based (ifp); 4073 dcl output char (1044480) based (ofp); 4074 dcl (i, j, ii, jj) fixed bin (24); 4075 dcl loc (24) fixed bin (24); 4076 dcl (sep_ct, level) fixed bin (24); 4077 dcl argstrl fixed bin (24); 4078 4079 /* &xxx */ 4080 /* xxx can be SCALAR, FIFI, or LIFO */ 4081 if (TF = "00"b) 4082 then return; 4083 begl = ifi; 4084 j = lookup (c32); 4085 if (j = 0) 4086 then 4087 do; 4088 msg = "Attempt to reference undeclared variable """; 4089 msg = msg || c32; 4090 msg = msg || """. "; 4091 goto add_identification; 4092 end; 4093 if (var.type = 0) 4094 then 4095 do; 4096 if (c32 = watchword) 4097 then call ioa_ ("^a ^i ""^va""", watchword, var.len, var.len, 4098 vartext); 4099 substr (output, out_len + 1, var.len) = vartext; 4100 out_len = out_len + var.len; 4101 end; 4102 else 4103 do; 4104 arr_ptr = var.ref; 4105 if (var.type = 4) 4106 then 4107 do; 4108 if (array.l_bound > array.h_bound) 4109 then 4110 do; 4111 msg = "Attempt to reference empty fifo """; 4112 msg = msg || c32; 4113 msg = msg || """. "; 4114 goto add_identification; 4115 end; 4116 arr_elem = mod (array.l_bound, var.len) + 1; 4117 if (c32 = watchword) 4118 then call ioa_ ("^a{^i} ^i ""^va""", watchword, arr_elem, 4119 array.len (arr_elem), array.len (arr_elem), arrtext) 4120 ; 4121 substr (output, out_len + 1, array.len (arr_elem)) = arrtext; 4122 out_len = out_len + array.len (arr_elem); 4123 array.l_bound = array.l_bound + 1; 4124 if al_sw 4125 then call ioa_ ("F ^a{^i} ^i ^p", c32, arr_elem, 4126 array.len (arr_elem), array.ref (arr_elem)); 4127 free arrtext in (free_area); 4128 end; 4129 else if (var.type = 5) 4130 then 4131 do; 4132 if (array.l_bound > array.h_bound) 4133 then 4134 do; 4135 msg = "Attempt to reference empty lifo """; 4136 msg = msg || c32; 4137 msg = msg || """. "; 4138 goto add_identification; 4139 end; 4140 arr_elem = array.h_bound; 4141 if (c32 = watchword) 4142 then call ioa_ ("^a{^i} ^i ""^va""", watchword, arr_elem, 4143 array.len (arr_elem), array.len (arr_elem), arrtext) 4144 ; 4145 substr (output, out_len + 1, array.len (arr_elem)) = arrtext; 4146 out_len = out_len + array.len (arr_elem); 4147 array.h_bound = array.h_bound - 1; 4148 if al_sw 4149 then call ioa_ ("F ^a{^i} ^i ^p", c32, arr_elem, 4150 array.len (arr_elem), array.ref (arr_elem)); 4151 free arrtext in (free_area); 4152 end; 4153 else 4154 do; 4155 msg = "Attempt to make scalar reference to non-scalar """; 4156 msg = msg || c32; 4157 msg = msg || """. "; 4158 goto add_identification; 4159 end; 4160 end; 4161 end var_ref; 4162 4163 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 4164 /* */ 4165 /* EXTERNAL entry to cleanup the processing environment */ 4166 4167 dcl ref_path char (168); 4168 free: 4169 entry (pr_sw); 4170 4171 dcl pr_sw bit (1); 4172 4173 dcl define_area_ entry (ptr, fixed bin (35)); 4174 dcl release_area_ entry (ptr); 4175 4176 if free_area_p ^= null () 4177 then 4178 do; 4179 tptr = ext_var_ptr; 4180 call free_um ("ext"); 4181 ext_var_ptr = null (); 4182 do while (int_vars_base ^= null ()); 4183 int_var_ptr = int_vars_base; 4184 if db_sw 4185 then call ioa_ ("^p^-macro ^a", int_var_ptr, int_vars.macro); 4186 int_vars_base = int_vars.next; 4187 tptr = int_vars.ref; 4188 call free_um ("int"); 4189 if al_sw 4190 then call ioa_ ("F int_vars ^p", int_var_ptr); 4191 free int_vars in (free_area); 4192 end; 4193 tptr = macro_list_p; 4194 if (tptr ^= null ()) & pr_sw 4195 then call ioa_ ("^aS USED:", who_am_i); 4196 do while (tptr ^= null ()); 4197 maclp = tptr; 4198 if pr_sw & (macro_list.dname ^= "") 4199 then 4200 do; 4201 call ioa_ ("^i:^i ^a>^a -- (^a.macro)", macro_list.from, 4202 macro_list.to, macro_list.dname, macro_list.ename, 4203 macro_list.name); 4204 end; 4205 tptr = macro_list.next; 4206 macro_holder_p = macro_list.ref; 4207 if (substr (macro_list.dname, 1, 4) = " &") 4208 then 4209 do; 4210 macro_holder_l = macro_list.to; 4211 if al_sw 4212 then call ioa_ ("F macro_holder ^p", macro_holder_p); 4213 free macro_holder in (free_area); 4214 end; 4215 if al_sw 4216 then call ioa_ ("F macro_list ^p", maclp); 4217 free macro_list in (free_area); 4218 end; 4219 call release_area_ (free_area_p); 4220 free_area_p = null (); 4221 end; 4222 macro_list_p = null (); 4223 err_ct (*) = 0; 4224 macro_nest = 0; 4225 return; 4226 4227 dcl dname char (168); 4228 dcl ename char (32); 4229 dcl hcs_$fs_get_path_name 4230 entry (ptr, char (*), fixed bin (24), char (*), 4231 fixed bin (35)); 4232 4233 4234 4235 /* * * * * * * * * * * * * * INTERNAL STATIC DATA * * * * * * * * * * * * * */ 4236 4237 dcl al_sw bit (1) int static init ("0"b); 4238 dcl db_sw bit (1) int static init ("0"b); 4239 dcl end_sym char (8) var; 4240 dcl err_ct (0:4) fixed bin int static init ((5) 0); 4241 dcl ext_var_ptr ptr int static init (null ()); 4242 dcl free_area_p ptr int static init (null ()); 4243 dcl int_vars_base ptr int static init (null ()); 4244 dcl lg_sw bit (1) int static init ("0"b); 4245 dcl macro_list_p ptr int static init (null ()); 4246 dcl macro_nest fixed bin int static init (0); 4247 dcl pc_sw bit (1) int static init ("0"b); 4248 dcl watchword char (32) int static init (""); 4249 dcl who_am_i char (12) var int static; 4250 4251 /* * * * * * * * * * * * * * * * CONSTANTS * * * * * * * * * * * * * * * * */ 4252 4253 dcl NL char (1) int static options (constant) init (" 4254 "); 4255 dcl space char (5) int static options (constant) init (" 4256 "); 4257 4258 /* * * * * * * * * * * * * * * * STRUCTURES * * * * * * * * * * * * * * * * */ 4259 4260 dcl var_ptr ptr; 4261 dcl 1 var based (var_ptr), 4262 2 next ptr, /* next variable in list */ 4263 2 name char (16), 4264 2 type fixed bin, /* 0-scalar 1-array 2-array var */ 4265 /* 3-list 4-fifo 5-lifo */ 4266 2 len fixed bin, /* length of data string */ 4267 2 ref ptr; /* points to data string */ 4268 dcl vartext char (var.len) based (var.ref); 4269 4270 4271 dcl arr_ptr ptr; 4272 dcl 1 array based (arr_ptr), 4273 2 lower fixed bin, 4274 2 l_bound fixed bin, /* defined lower bound */ 4275 2 h_bound fixed bin, /* defined higher bound */ 4276 2 elem (var.len), 4277 3 len fixed bin, /* length of data string */ 4278 3 ref ptr; /* points to data string */ 4279 dcl arrtext char (array.len (arr_elem)) 4280 based (array.ref (arr_elem)); 4281 dcl arr_elem fixed bin (24); 4282 4283 dcl int_var_ptr ptr; 4284 dcl 1 int_vars based (int_var_ptr), 4285 2 next ptr, 4286 2 ref ptr, /* points to variable definition */ 4287 2 macro char (32); /* name of macro owning it */ 4288 4289 dcl maclp ptr; 4290 dcl 1 macro_list based (maclp), 4291 2 next ptr, 4292 2 ref ptr, 4293 2 dname char (168), 4294 2 ename char (32), 4295 2 from fixed bin (24), 4296 2 to fixed bin (24), 4297 2 name char (32), 4298 2 int_mac bit (1); /* 1- ¯o/&define'ed */ 4299 4300 /* * * * * * * * * * * * * LOOSE ARRAYS and SCALARS * * * * * * * * * * * * */ 4301 4302 dcl argleng_less_than_zero 4303 condition; 4304 dcl bc fixed bin (24); 4305 dcl c32 char (32) var; 4306 dcl c32x char (32) var; 4307 dcl call_err bit (1); 4308 dcl ch_2nd char (1); 4309 dcl construct_nest fixed bin (24); 4310 dcl free_area area based (free_area_p); 4311 dcl i fixed bin (24); 4312 dcl jaf fixed bin (24); 4313 dcl local_var_ptr ptr; 4314 dcl macro_holder char (macro_holder_l) based (macro_holder_p); 4315 dcl macro_holder_l fixed bin (24); 4316 dcl macro_holder_p ptr; 4317 dcl msg_etc char (1000) var; 4318 dcl myname char (32) var; 4319 dcl output char (1044480) based (out_ptr); 4320 dcl save_db bit (1); 4321 dcl seg char (sege) based (segptr); 4322 dcl sega (sege) char (1) based (segptr); 4323 dcl sege fixed bin (24); 4324 dcl segi fixed bin (24); 4325 dcl segii fixed bin (24); 4326 dcl segment char (sege) based (segptr); 4327 dcl segptr ptr; 4328 dcl segtype char (8) var; 4329 dcl start_sym char (8) var; 4330 dcl tptr ptr; 4331 dcl token_chars char (63) int static options (constant) 4332 init ("abcdefghijklmnopqrstuvwxyz" 4333 || "ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"); 4334 dcl tr_sw bit (1); 4335 4336 dcl error_table_$action_not_performed 4337 fixed bin (35) ext static; 4338 dcl error_table_$archive_fmt_err 4339 fixed bin (35) ext static; 4340 dcl error_table_$badsyntax 4341 fixed bin (35) ext static; 4342 dcl error_table_$new_search_list 4343 fixed bin (35) ext static; 4344 dcl error_table_$no_search_list 4345 fixed bin (35) ext static; 4346 dcl error_table_$translation_aborted 4347 fixed bin (35) ext static; 4348 dcl error_table_$translation_failed 4349 fixed bin (35) ext static; 4350 4351 dcl ioa_ entry options (variable); 4352 dcl com_err_ entry options (variable); 4353 dcl archive_util_$first_element 4354 entry (ptr, fixed bin (35)); 4355 dcl archive_util_$search 4356 entry (ptr, ptr, char (32), fixed bin (35)); 4357 dcl ioa_$nnl entry options (variable); 4358 dcl hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35)); 4359 dcl hcs_$fs_get_seg_ptr 4360 entry (char (*), ptr, fixed bin (35)); 4361 dcl get_seg_ptr_ entry (char (*), bit (6), fixed bin (24), ptr, 4362 fixed bin (35)); 4363 dcl mac_sw bit (1); 4364 4365 dcl (addr, addrel, char, convert, divide, fixed, hbound, index, length, 4366 ltrim, max, min, mod, null, reverse, rtrim, search, size, string, 4367 substr, translate, verify) 4368 builtin; 4369 dbn: 4370 entry; 4371 db_sw = "1"b; 4372 return; 4373 aln: 4374 entry; 4375 al_sw = "1"b; 4376 return; 4377 pcn: 4378 entry; 4379 pc_sw = "1"b; 4380 return; 4381 lgn: 4382 entry; 4383 lg_sw = "1"b; 4384 return; 4385 lgf: 4386 entry; 4387 lg_sw = "0"b; 4388 return; 4389 pcf: 4390 entry; 4391 pc_sw = "0"b; 4392 return; 4393 alf: 4394 entry; 4395 al_sw = "0"b; 4396 return; 4397 dbf: 4398 entry; 4399 db_sw = "0"b; 4400 return; 4401 4402 watch: 4403 entry (watchfor); 4404 dcl watchfor char (*); 4405 4406 watchword = watchfor; 4407 return; 4408 4409 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/23/85 0911.6 xdw_.pl1 >special_ldd>online>compose-04/17/85>xdw_.pl1 1418 1 06/11/76 1043.4 area_info.incl.pl1 >ldd>include>area_info.incl.pl1 1854 2 09/22/80 1256.7 cp_active_string_types.incl.pl1 >ldd>include>cp_active_string_types.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. ATOMIC_ACTIVE_STRING 000367 constant fixed bin(17,0) initial dcl 2-6 set ref 1856* HT_sw 000103 automatic bit(1) unaligned dcl 3714 set ref 3723* 3725* 3727* NL 041324 constant char(1) initial unaligned dcl 4253 ref 220 576 1291 1293 1514 2101 2391 2407 2411 3718 TF parameter bit(2) unaligned dcl 1430 in procedure "get_range" set ref 1427 1452* 1459* TF parameter bit(2) unaligned dcl 1771 in procedure "macro_af" set ref 1768 1792* 1815* 1841 TF parameter bit(2) unaligned dcl 1086 in procedure "dumper" set ref 1083 1093* TF parameter bit(2) unaligned dcl 718 in procedure "arithmetic" set ref 715 741* 770* 800 TF parameter bit(2) unaligned dcl 4061 in procedure "var_ref" ref 4058 4081 TF parameter bit(2) unaligned dcl 3590 in procedure "macro_usage" set ref 3587 3617* 3653* TF parameter bit(2) unaligned dcl 2132 in procedure "macro_do" set ref 2129 2154* 2156 2161 2168 TF parameter bit(2) unaligned dcl 302 in procedure "ampersand" set ref 299 321* 352* 371* 374* 436* 443* 447* 449* 452* 455* 472* 475* 478* 488* 491* 494* 497* 500* 503* 506* 509* 512* 515* 606* TF parameter bit(2) unaligned dcl 2587 in procedure "macro_length" set ref 2584 2611* 2643* TF parameter bit(2) unaligned dcl 3880 in procedure "var_range" set ref 3877 3926* 3929 4023* 4031 TF parameter bit(2) unaligned dcl 2654 in procedure "macro_let" set ref 2651 2687* 2795* 3033* 3058* TF parameter bit(2) unaligned dcl 2320 in procedure "macro_error" set ref 2317 2344* 2350* 2429* TF parameter bit(2) unaligned dcl 2232 in procedure "macro_empty" set ref 2230 2251* TF parameter bit(2) unaligned dcl 3352 in procedure "macro_substr" set ref 3349 3377* 3400* 3416* 3425* 3432 TF parameter bit(2) unaligned dcl 1882 in procedure "macro_call" set ref 1879 1909* 1935* TF parameter bit(2) unaligned dcl 628 in procedure "arg_range" set ref 625 654* 683* 691 TF parameter bit(2) unaligned dcl 3270 in procedure "macro_scan" set ref 3267 3293* 3336 3341* TF parameter bit(2) unaligned dcl 3782 in procedure "var_bound" set ref 3779 3826* TF parameter bit(2) unaligned dcl 2030 in procedure "macro_define" set ref 2027 2053* 2078 2121* TF parameter bit(2) unaligned dcl 1531 in procedure "logical" set ref 1528 1584* 1590 1595* 1597* 1600* 1650* 1658 1664* 1667* 1670* 1673* 1676* 1679* 1682* 1685* 1688* 1691* 1694* 1697* 1700* TF 000103 automatic bit(2) unaligned dcl 2462 in procedure "macro_if" set ref 2472* 2473* 2478* 2480* 2482 2497 2497 2500 2510 2528 2528 2531 addr builtin function dcl 4365 ref 1415 1415 1984 1986 1986 2408 2408 2412 2412 3336 3336 addrel builtin function dcl 4365 ref 2408 2408 ai 001012 automatic structure level 1 unaligned dcl 1419 set ref 1415 1415 al_sw 000010 internal static bit(1) initial unaligned dcl 4237 set ref 169 183 277 1371 1387 1395 1735 2732 2826 3084 3091 3142 3151 4124 4148 4189 4211 4215 4375* 4395* area_control based structure level 1 dcl 1-20 area_info based structure level 1 dcl 1-7 area_info_version_1 constant fixed bin(17,0) initial dcl 1-3 ref 1409 areap 16 001012 automatic pointer level 2 dcl 1419 set ref 1414* 1416 arg based char unaligned dcl 63 set ref 175* 345 695 argct parameter fixed bin(17,0) dcl 42 ref 13 13 27 73 174 177 342 359 653 693 argl based structure array level 1 unaligned dcl 60 argleng_less_than_zero 000256 stack reference condition dcl 4302 ref 74 arglp parameter pointer dcl 42 ref 13 13 27 74 76 175 175 175 175 345 345 345 346 695 695 695 696 args 000100 automatic structure array level 1 unaligned dcl 1967 set ref 1986 1986 argstr 000100 automatic char(1) array unaligned dcl 1968 in begin block on line 1966 set ref 1977* 1984 argstr 000100 automatic char unaligned dcl 3325 in begin block on line 3324 set ref 3334* 3336 3336 argstr 000100 automatic char unaligned dcl 3411 in begin block on line 3410 set ref 3413* 3485 3489 argstr 000100 automatic char unaligned dcl 3240 in begin block on line 3239 set ref 3241* 3244 3248 argstrl 000600 automatic fixed bin(24,0) dcl 1898 in procedure "macro_call" set ref 1959* 1960 1968 1974 1974 1977 1979 argstrl 001001 automatic fixed bin(24,0) dcl 3368 in procedure "macro_substr" set ref 3403* 3404 3411 3413 3435 3437 3459 3475 3483 argstrl 000765 automatic fixed bin(24,0) dcl 3286 in procedure "macro_scan" set ref 3317* 3318 3325 3331 3331 3334 3336* arithchar 000167 constant char(28) initial unaligned dcl 822 ref 824 844 844 904 905 arr_elem 000250 automatic fixed bin(24,0) dcl 4281 set ref 1383* 1384 1387 1387 1387 1387 1387 1391 1391 1391* 2829* 2830 2831* 3117* 3118 3118* 3134* 3136 3139 3142* 3142 3142 3146 3146 3146 3148 3149 3149 3149 3151* 3151 3151 3151 3151 3151 3151 3151 3155 3155* 4036* 4037 4037 4037 4038 4039* 4116* 4117* 4117 4117 4117 4117 4117 4121 4121 4121 4122 4124* 4124 4124 4127 4127 4127 4140* 4141* 4141 4141 4141 4141 4141 4145 4145 4145 4146 4148* 4148 4148 4151 4151 4151 arr_ptr 000246 automatic pointer dcl 4271 set ref 1379* 1380 1380 1384 1387 1387 1387 1387 1387 1391 1391 1391 2298* 2302 2302 2303 2303 2308 2309 2791* 2792 2793 2824* 2825 2826 2826 2830 2831 2833 2842 2857 2858 2874 2875 2885 2885 2892 2893 2903 2903 2910 2911 2919 2919 2925 2926 2940* 2941 2947 2974* 2975 2975 2983 2983 2989 2989 2990 2995* 2996 3004 3010 3010 3107* 3111 3111 3112 3112 3117 3117 3118 3118 3125 3132 3132 3134 3134 3136 3139 3142 3142 3146 3146 3146 3148 3149 3149 3149 3151 3151 3151 3151 3151 3151 3151 3155 3155 3848* 3854 3856 3922* 3923 3924 3928* 3954 3955 3967 3968 3981 3987 4034* 4035 4036 4037 4037 4037 4038 4104* 4108 4108 4116 4117 4117 4117 4117 4117 4121 4121 4121 4122 4123 4123 4124 4124 4127 4127 4127 4132 4132 4140 4141 4141 4141 4141 4141 4145 4145 4145 4146 4147 4147 4148 4148 4151 4151 4151 array based structure level 1 unaligned dcl 4272 set ref 2824 2826 2826 arrtext based char unaligned dcl 4279 set ref 1387* 1391 3118 3146 3149 3151 3151 3155* 4037 4117* 4121 4127 4141* 4145 4151 bc 000264 automatic fixed bin(24,0) dcl 4304 set ref 1271* 1287 begl 001300 automatic fixed bin(24,0) dcl 4070 in procedure "var_ref" set ref 4083* begl 000426 automatic fixed bin(24,0) dcl 1891 in procedure "macro_call" set ref 1905* 1923* 1972* 1988* 1993 begl 000100 automatic fixed bin(24,0) dcl 3672 in procedure "protected" set ref 3683* 3691* begl 000112 automatic fixed bin(24,0) dcl 637 in procedure "arg_range" set ref 650* 666* 707* begl 000700 automatic fixed bin(24,0) dcl 2596 in procedure "macro_length" set ref 2608* 2621* begl 000100 automatic fixed bin(24,0) dcl 2141 in procedure "macro_do" set ref 2151* 2175* 2188* 2223* begl 001010 automatic fixed bin(24,0) dcl 3513 in procedure "macro_unquote" set ref 3523* 3534* begl 000666 automatic fixed bin(24,0) dcl 2329 in procedure "macro_error" set ref 2341* 2375* begl 000100 automatic fixed bin(24,0) dcl 727 in procedure "arithmetic" set ref 740* 814* begl 000214 automatic fixed bin(24,0) dcl 1780 in procedure "macro_af" set ref 1789* 1803* begl 000774 automatic fixed bin(24,0) dcl 3361 in procedure "macro_substr" set ref 3374* 3387* begl 001024 automatic fixed bin(24,0) dcl 3599 in procedure "macro_usage" set ref 3614* 3627* begl 001212 automatic fixed bin(24,0) dcl 3889 in procedure "var_range" set ref 3904* 4006* begl 000100 automatic fixed bin(24,0) dcl 313 in procedure "ampersand" set ref 320* 466* 558* 571* 589* begl 000100 automatic fixed bin(24,0) dcl 1540 in procedure "logical" set ref 1554* 1584* 1650* begl 000762 automatic fixed bin(24,0) dcl 3279 in procedure "macro_scan" set ref 3290* 3303* 3329* begl 000644 automatic fixed bin(24,0) dcl 2238 in procedure "macro_empty" set ref 2248* 2261* 2270* 2278* 2288* 2296* begl 000632 automatic fixed bin(24,0) dcl 2039 in procedure "macro_define" set ref 2050* 2063* 2089* 2096* 2109* begl parameter fixed bin(24,0) dcl 1106 in procedure "error_missing" set ref 1103 1117 1123 1130 1136 1145* begl 000714 automatic fixed bin(24,0) dcl 2665 in procedure "macro_let" set ref 2684* 2695* 2800* 3017* 3028* 3045* 3067* 3099* 3160* begl 000100 automatic fixed bin(24,0) dcl 2455 in procedure "macro_if" set ref 2469* 2476* 2491* 2540* begl 000750 automatic fixed bin(24,0) dcl 3188 in procedure "macro_quote" set ref 3198* 3209* beglt 000101 automatic fixed bin(24,0) dcl 2456 set ref 2469* 2482* 2493* 2500* 2503* 2518* 2531* 2534* 2545* c32 000265 automatic varying char(32) dcl 4305 set ref 98* 99 124* 126* 128 139 193 359* 360 360 361 383* 411* 427 428* 447 449 452 455 458 472 475 478 481 488 491 494 497 500 503 506 509 512 515 518 518 518 518 518 518 523* 523 529 536 574* 599* 613 1482* 1490* 1592* 1595 1595 1595 1595 1818 1907 2099* 2109* 2114* 2163 2166 2171 2177 2192 2194 2196 2207 2210 2222 2487 2494 2505 2508 2523 2526 2536 2543 2558* 2563 2565 2567 2569 2571 3811 3844 3854 3863 3906* 3917 3939 3947 3960 3973 4084* 4089 4096 4112 4117 4124* 4136 4141 4148* 4156 c32x 000276 automatic varying char(32) dcl 4306 set ref 412* 427* 1906 call_err 000307 automatic bit(1) unaligned dcl 4307 set ref 181* 198 212 1994* callmac 000612 automatic varying char(32) dcl 1900 set ref 1907* 1923 1972* 1986* callseg 000601 automatic varying char(32) dcl 1899 set ref 1906* 1972* 1986* ch 001014 automatic char(1) unaligned dcl 3519 in procedure "macro_unquote" set ref 3555* 3556 3576 ch 000120 automatic char(1) unaligned dcl 1065 in procedure "cvt" set ref 1069* 1070 1070* 1072 ch60 000610 automatic varying char(60) dcl 737 set ref 1047* 1048 1048 1049 ch8 000704 automatic picture(8) unaligned dcl 2604 set ref 2635* 2637 2638 ch_2nd 000310 automatic char(1) unaligned dcl 4308 set ref 351* 352 355 364 367 371 374 377 380 387 char builtin function dcl 4365 ref 80 359 1519 3479 3481 3483 cline 000473 automatic varying char(6) dcl 1111 set ref 1145* 1161 1165 cmd 000054 internal static char(4) initial array unaligned dcl 3018 set ref 2687* 2695* 2800* 3017* 3028* 3045* 3067* 3099* 3160* com_err_ 000100 constant entry external dcl 4352 ref 1261 construct_nest 000311 automatic fixed bin(24,0) dcl 4309 set ref 180* 541 747* 747 798* 798 1093* 1552* 1552 1645* 1645 1796* 1796 1839* 1839 1916* 1916 1957* 1957 2056* 2056 2118* 2118 2160* 2160 2216* 2216 2348* 2348 2426* 2426 2496* 2496 2513* 2513 2542* 2542 2614* 2614 2640* 2640 3038* 3038 3061* 3061 3202* 3202 3233* 3233 3296* 3296 3337* 3337 3380* 3380 3493* 3493 3527* 3527 3551* 3551 3620* 3620 3650* 3650 control 1 001012 automatic structure level 2 dcl 1419 set ref 1410* convert builtin function dcl 4365 ref 860 1047 ctl 001027 automatic varying char(100) dcl 3607 set ref 3641* 3645* cu_$evaluate_active_string 000112 constant entry external dcl 1851 ref 1856 cv6 000100 automatic varying char(6) dcl 1504 set ref 1519* 1520 db_sw 000011 internal static bit(1) initial unaligned dcl 4238 set ref 90 102 110 126 136 167* 169 183 231* 255 267 288 321 741 811 837 1197 1248 1361 1380 1581 1647 1792 1909 1969 2053 2106 2154 2251 2344 2473 2482 2500 2518 2531 2545 2611 2687 2743 2751 2759 3096 3157 3293 3326 3377 3617 4184 4371* 4399* define_area_ 000060 constant entry external dcl 4173 ref 1415 divide builtin function dcl 4365 ref 1287 dname 4 based char(168) level 2 in structure "macro_list" packed unaligned dcl 4290 in procedure "macro_" set ref 110 110 281* 288* 3645* 4198 4201* 4207 dname parameter char(168) unaligned dcl 247 in procedure "addmacro" set ref 244 255* 281 dname 000156 automatic char(168) unaligned dcl 4227 in procedure "macro_" set ref 597* 1250* 1265* 1271* 1302 1327* e 000105 automatic fixed bin(24,0) dcl 1507 set ref 1511* ecode parameter fixed bin(35,0) dcl 42 set ref 13 13 27 82* 87* 196* 229* 1169* 1250* 1252 1257* 1265* 1268 1271* 1273* 1276 1283* 1305* 1415* 1856* 1859 1986* 1988 1990 2422* elem 4 based structure array level 2 unaligned dcl 4272 eline 000476 automatic varying char(6) dcl 1111 set ref 1146* 1154 1161 elseif 000107 automatic bit(1) unaligned dcl 2464 set ref 2475* 2482* 2514* ename 000230 automatic char(32) unaligned dcl 4228 in procedure "macro_" set ref 597* ename 56 based char(32) level 2 in structure "macro_list" packed unaligned dcl 4290 in procedure "macro_" set ref 136* 139 259 282* 288* 3645* 4201* end_sym 000240 automatic varying char(8) dcl 4239 set ref 533* 540* 579 587 602 1322 endl parameter fixed bin(24,0) dcl 1106 set ref 1103 1117 1123 1130 1136 1146* err_ct 000012 internal static fixed bin(17,0) initial array dcl 4240 set ref 229 229 1862* 2390* 2390 4223* err_sw parameter bit(1) unaligned dcl 302 ref 299 524 error_table_$badsyntax 000066 external static fixed bin(35,0) dcl 4340 ref 196 1169 error_table_$no_search_list 000070 external static fixed bin(35,0) dcl 4344 ref 1252 error_table_$translation_aborted 000072 external static fixed bin(35,0) dcl 4346 ref 2422 error_table_$translation_failed 000074 external static fixed bin(35,0) dcl 4348 ref 229 ext_var_ptr 000020 internal static pointer initial dcl 4241 set ref 1754 2741 2742* 4179 4181* extend 1 001012 automatic bit(1) level 3 packed unaligned dcl 1419 set ref 1411* fixed builtin function dcl 4365 ref 1453 1460 2482 3417 3426 found 000734 automatic fixed bin(24,0) dcl 2672 set ref 2727* 2728 2763 2819 2839 2865 2882 2900 2916 3070 free_area based area(1024) dcl 4310 ref 276 1373 1391 1397 1734 2104 2731 2824 3087 3090 3146 3149 4127 4151 4191 4213 4217 free_area_p 000022 internal static pointer initial dcl 4242 set ref 67 276 1373 1391 1397 1416* 1734 2104 2731 2824 3087 3090 3146 3149 4127 4151 4176 4191 4213 4217 4219* 4220* from 66 based fixed bin(24,0) level 2 dcl 4290 set ref 118 143 263 283* 288* 4201* h_bound 2 based fixed bin(17,0) level 2 dcl 4272 set ref 2302* 2309* 2793 2858* 2875* 2885 2893* 2903 2911* 2919 2926* 2975 2983 2989* 2989 2990 2996 3004 3010 3010* 3112* 3112 3117 3125 3132 3132* 3856 3924 3955 3967 3987 4108 4132 4140 4147* 4147 hbound builtin function dcl 4365 ref 2717 hcs_$fs_get_path_name 000064 constant entry external dcl 4229 ref 597 1247 hcs_$initiate_count 000104 constant entry external dcl 1231 ref 1271 hcs_$make_ptr 000110 constant entry external dcl 1255 ref 1257 higher 000736 automatic fixed bin(24,0) dcl 2673 set ref 2787* 2793* 2795* 2808 2823 2826* 2842 2857 2868 2885 2903 2919 2926 2947 2990* 3010* 3112 3132* 3134 3160* hold 000100 automatic varying char(1000) dcl 1110 set ref 1113* 1114* 1114 1120* 1126* 1127* 1127 1133* 1139* 1140* 1140 1143* 1143 1157 i 000645 automatic fixed bin(24,0) dcl 2242 in procedure "macro_empty" set ref 2253* 2255 2255* 2257 2263 2281* 2282 i 000751 automatic fixed bin(24,0) dcl 3192 in procedure "macro_quote" set ref 3203* 3205 3211 3214* 3214 3215 3215 3226* 3227 3234 3240 3241 3246 3257 i 000101 automatic fixed bin(24,0) dcl 731 in procedure "arithmetic" set ref 748* 750 756 759* 759 760 760 761 762 818* 824 828 842* 842 842 855 860 863* 863 872 881* 881 907* i 000633 automatic fixed bin(24,0) dcl 2043 in procedure "macro_define" set ref 2057* 2059 2065 2068* 2068 2069 2069 2070 2071 2081* 2082* 2082 2082 2082 2083 2083 2099 2100* 2100 2101 2103 2105 i 001170 automatic fixed bin(24,0) dcl 3795 in procedure "var_bound" set ref 3805* 3807 3815 3818* 3818 3819 3819 3820 3821 3854* 3856* i 001011 automatic fixed bin(24,0) dcl 3517 in procedure "macro_unquote" set ref 3528* 3530 3536 3539* 3539 3540 3540 3552* 3574* 3574 3576 3579 i 000775 automatic fixed bin(24,0) dcl 3365 in procedure "macro_substr" set ref 3381* 3383 3389 3392* 3392 3393 3393 3394 3395 3417* 3435 3435* 3435 3437 3448 3454 3459 3469 3475 3479 3489 i 000215 automatic fixed bin(24,0) dcl 1784 in procedure "macro_af" set ref 1797* 1799 1805 1808* 1808 1809 1809 1810 1811 i 000101 automatic fixed bin(24,0) dcl 1544 in procedure "logical" set ref 1555* 1557 1564 1567* 1567 1568 1568 1569 1570 i 000100 automatic fixed bin(24,0) dcl 3713 in procedure "show_string" set ref 3716* 3717 3718 3722 3726 3727 3727 3728* i 000101 automatic fixed bin(24,0) dcl 317 in procedure "ampersand" set ref 329* 330 333 334* 335 338 396* 399 399* 401 404 411 414 417 420* 426* 428 432 432 435 439 439 442 461* 462 468 554 562* 565 567 573* 573 574 575 579* 582 591 591 599 602 607 i 000100 automatic fixed bin(24,0) dcl 3751 in procedure "strip2" set ref 3753* 3755 3757 3760* 3761 3763* 3764 3770 i 000701 automatic fixed bin(24,0) dcl 2600 in procedure "macro_length" set ref 2615* 2617 2623 2626* 2626 2627 2627 2628 2629 2637* 2638 2638 2638 2639 i 001213 automatic fixed bin(24,0) dcl 3893 in procedure "var_range" set ref 3906* 3907 3923* 3926* 3935 3943 3954 3954* 3955 3967 3967* 3968 3981 4036 i 000100 automatic fixed bin(24,0) dcl 1194 in procedure "expand" set ref 1200* 1201 1201* 1203* 1203 1204 1207 1207 1208 1209 i 000715 automatic fixed bin(24,0) dcl 2669 in procedure "macro_let" set ref 2689* 2691 2697* 2699 2699* 2701* 2701 2702 2703 2709 2717* 2718* 3039* 3041 3047 3050* 3050 3051 3051 3052 3053 i 000427 automatic fixed bin(24,0) dcl 1895 in procedure "macro_call" set ref 1917* 1919 1925 1928* 1928 1929 1929 1930 1931 1981* 1982 1982 1982 1983 1984* i 000312 automatic fixed bin(24,0) dcl 4311 in procedure "macro_" set ref 1291* 1293* 1294 1308 1309* 1315* 1319 1326 1485* 1486 1486* 1488 1488* 1490 1510* 1512 1514 1515* 1517* 1517 i 000117 automatic fixed bin(24,0) dcl 1062 in procedure "cvt" set ref 1068* 1069* i 000763 automatic fixed bin(24,0) dcl 3283 in procedure "macro_scan" set ref 3297* 3299 3305 3308* 3308 3309 3309 3310 3311 i 000113 automatic fixed bin(24,0) dcl 641 in procedure "arg_range" set ref 652* 654* 694 i 000102 automatic fixed bin(24,0) dcl 2461 in procedure "macro_if" set ref 2554* 2555 2561 i 000101 automatic fixed bin(24,0) dcl 3676 in procedure "protected" set ref 3686* 3687 3693* 3693 3694 3694 3695 3696 i parameter fixed bin(24,0) dcl 1443 in procedure "get_range" set ref 1427 1453* i 000667 automatic fixed bin(24,0) dcl 2333 in procedure "macro_error" set ref 2369* 2371 2377 2380* 2380 2381 2381 2382 2383 2389* 2390 2390 2392 2394 2414 i 000101 automatic fixed bin(24,0) dcl 2145 in procedure "macro_do" set ref 2182* 2184 2190 i 001025 automatic fixed bin(24,0) dcl 3603 in procedure "macro_usage" set ref 3621* 3623 3629 3632* 3632 3633 3633 3634 3635 if_lineno 000104 automatic varying char(6) dcl 2463 set ref 2476* 2482* 2500* 2518* 2531* 2545* ife parameter fixed bin(24,0) dcl 718 in procedure "arithmetic" set ref 715 741* 748 760 766 770* 831 857 ife parameter fixed bin(24,0) dcl 628 in procedure "arg_range" set ref 625 654* 661 666* 672 683* ife parameter fixed bin(24,0) dcl 1430 in procedure "get_range" set ref 1427 1452* 1459* ife parameter fixed bin(24,0) dcl 1531 in procedure "logical" set ref 1528 1553* 1555 1568 1575 1575 1600* 1629* 1631 1638 1642 1642 1664* ife parameter fixed bin(24,0) dcl 3880 in procedure "var_range" set ref 3877 3926* 4001 4006* 4012 4023* ife parameter fixed bin(24,0) dcl 1086 in procedure "dumper" set ref 1083 1093* 1093* ife parameter fixed bin(24,0) dcl 2654 in procedure "macro_let" set ref 2651 2686* 2687* 2689 2697 2699 2702 2772* 2773 2777* 2795* 2803* 2835 2861 2878 2896 2929* 2954* 2955 2959* 3022* 3030 3033* 3034* 3039 3045* 3051 3055 3058* 3063 3067* 3069* ife parameter fixed bin(24,0) dcl 1181 in procedure "expand" set ref 1178 1197* 1199 1200 1201 1207 1211 1214* ife parameter fixed bin(24,0) dcl 3178 in procedure "macro_quote" set ref 3175 3200* 3203 3209* 3215 3219 3222* 3225* ife parameter fixed bin(24,0) dcl 2320 in procedure "macro_error" set ref 2317 2343* 2344* 2350* 2360* 2369 2375* 2381 2385 2388* 2429* ife parameter fixed bin(24,0) dcl 3664 in procedure "protected" set ref 3661 3686 3691* 3694 3697 ife parameter fixed bin(24,0) dcl 3352 in procedure "macro_substr" set ref 3349 3376* 3377* 3381 3387* 3393 3400* 3416* 3425* 3429 3431* ife parameter fixed bin(24,0) dcl 2587 in procedure "macro_length" set ref 2584 2610* 2611* 2615 2621* 2627 2631 2634* 2643* ife parameter fixed bin(24,0) dcl 3503 in procedure "macro_unquote" set ref 3500 3525* 3528 3534* 3540 3544 3547* 3550* ife parameter fixed bin(24,0) dcl 1771 in procedure "macro_af" set ref 1768 1791* 1792* 1797 1803* 1809 1815* ife parameter fixed bin(24,0) dcl 1061 in procedure "cvt" ref 1056 1068 ife parameter fixed bin(24,0) dcl 3782 in procedure "var_bound" set ref 3779 3804* 3805 3819 3823 3826* ife parameter fixed bin(24,0) dcl 4061 in procedure "var_ref" ref 4058 ife parameter fixed bin(24,0) dcl 2132 in procedure "macro_do" set ref 2129 2153* 2154* 2161* 2169* 2170* 2178* 2182 2188* 2191* 2192* 2194* 2212* ife parameter fixed bin(24,0) dcl 1882 in procedure "macro_call" set ref 1879 1908* 1909* 1917 1923* 1929 1935* 2018* ife parameter fixed bin(24,0) dcl 3746 in procedure "strip2" ref 3738 3743 3753 3755 3758 3760 3761 3763 ife parameter fixed bin(24,0) dcl 3590 in procedure "macro_usage" set ref 3587 3616* 3617* 3621 3627* 3633 3637 3640* 3653* ife parameter fixed bin(24,0) dcl 2232 in procedure "macro_empty" set ref 2230 2250* 2251* 2253 2255 2263 2273* 2274 2280* ife parameter fixed bin(24,0) dcl 3270 in procedure "macro_scan" set ref 3267 3292* 3293* 3297 3303* 3309 3313 3316* 3341* ife parameter fixed bin(24,0) dcl 1473 in procedure "get_token" set ref 1470 1478* 1479 1485 1486 1490 ife parameter fixed bin(24,0) dcl 2444 in procedure "macro_if" set ref 2441 2471* 2473* 2478* 2486* 2495* 2497* 2509* 2527* 2528* 2544* 2554 2562* 2563* 2571* ife parameter fixed bin(24,0) dcl 2030 in procedure "macro_define" set ref 2027 2052* 2053* 2057 2063* 2069 2073 2077* 2121* ife parameter fixed bin(24,0) dcl 302 in procedure "ampersand" set ref 299 321* 323 352* 367* 371* 374* 377* 396 399 411 418 428 432 436* 439 443* 447* 449* 452* 455* 461 466* 472* 475* 478* 488* 491* 494* 497* 500* 503* 506* 509* 512* 515* 555 562 574 579 589* 591 591 606* ifi parameter fixed bin(24,0) dcl 3178 in procedure "macro_quote" set ref 3175 3198 3199* 3199 3200* 3203 3215 3217* 3217 3219 3222* 3225* ifi parameter fixed bin(24,0) dcl 1181 in procedure "expand" set ref 1178 1197* 1199 1200 1201 1207 1209* 1209 1211 1213 1214* 1215 ifi parameter fixed bin(24,0) dcl 1473 in procedure "get_token" set ref 1470 1478* 1479 1485 1486 1490 ifi parameter fixed bin(24,0) dcl 1771 in procedure "macro_af" set ref 1768 1789 1790* 1790 1791* 1792* 1797 1809 1811* 1811 1813 1815* 1826* 1826 1834* 1834 ifi parameter fixed bin(24,0) dcl 2654 in procedure "macro_let" set ref 2651 2684 2685* 2685 2686* 2687* 2689 2695* 2697 2699 2702 2709* 2709 2772* 2773 2777* 2780 2783* 2783 2795* 2796 2800* 2802* 2802 2803* 2835 2838* 2838 2861 2864* 2864 2878 2881* 2881 2896 2899* 2899 2929* 2954* 2955 2959* 3013 3017* 3021* 3021 3022* 3024 3028* 3030 3033* 3034* 3039 3051 3053* 3053 3055 3058* 3063 3069* 3099 3160 ifi parameter fixed bin(24,0) dcl 1531 in procedure "logical" set ref 1528 1553* 1554 1555 1568 1570* 1570 1572 1575 1575 1584 1600* 1602 1612* 1612 1617* 1617 1622* 1622 1629* 1631 1638 1639* 1639 1642 1642 1650 1664* ifi parameter fixed bin(24,0) dcl 2587 in procedure "macro_length" set ref 2584 2608 2609* 2609 2610* 2611* 2615 2627 2629* 2629 2631 2634* 2643* ifi parameter fixed bin(24,0) dcl 2320 in procedure "macro_error" set ref 2317 2341 2342* 2342 2343* 2344* 2349* 2349 2350* 2360* 2361 2368* 2368 2369 2381 2383* 2383 2385 2388* 2406* 2429* ifi parameter fixed bin(24,0) dcl 3746 in procedure "strip2" set ref 3738 3741* 3741 3743 3753 3755* 3757* 3757 3758 3760 3761 3763 3768* 3768 3770* 3770 ifi parameter fixed bin(24,0) dcl 1882 in procedure "macro_call" set ref 1879 1905 1908* 1909* 1917 1929 1931* 1931 1933 1935* 1944* 1944 1952* 1952 1972 1988* 1993* 2004* 2004 2018* ifi parameter fixed bin(24,0) dcl 4061 in procedure "var_ref" ref 4058 4083 ifi parameter fixed bin(24,0) dcl 302 in procedure "ampersand" set ref 299 320 321* 323 329 334 339* 339 341* 341 351 352* 358* 358 364* 364 367* 371* 374* 377* 392* 392 396 399 411 414 417* 417 418 423 428 432 432 435* 435 436* 439 439 442* 442 443* 447* 449* 452* 455* 461 468* 468 472* 475* 478* 488* 491* 494* 497* 500* 503* 506* 509* 512* 515* 554* 554 555 558* 561* 561 562 571* 574 575* 575 576 578* 578 579 591 591 599* 599 602* 602 606* 607* 607 ifi parameter fixed bin(24,0) dcl 2030 in procedure "macro_define" set ref 2027 2050 2051* 2051 2052* 2053* 2057 2069 2071* 2071 2073 2076* 2076 2077* 2089* 2096* 2109 2121* ifi parameter fixed bin(24,0) dcl 1086 in procedure "dumper" set ref 1083 1093* 1093* ifi parameter fixed bin(24,0) dcl 2232 in procedure "macro_empty" set ref 2230 2248 2249* 2249 2250* 2251* 2253 2255 2261* 2263 2270* 2272* 2272 2273* 2274 2278* 2280* 2288* 2296* ifi parameter fixed bin(24,0) dcl 718 in procedure "arithmetic" set ref 715 740 740* 741* 748 760 762* 762 764 766 770* 778* 778 789* 789 794* 794 814 831 857 ifi parameter fixed bin(24,0) dcl 3880 in procedure "var_range" set ref 3877 3904 3925* 3925 3926* 3996 3999* 3999 4001 4012 4013* 4013 4016 4023* 4026 4029* 4029 ifi parameter fixed bin(24,0) dcl 3782 in procedure "var_bound" set ref 3779 3804* 3805 3819 3821* 3821 3823 3826* ifi parameter fixed bin(24,0) dcl 3503 in procedure "macro_unquote" set ref 3500 3523 3524* 3524 3525* 3528 3540 3542* 3542 3544 3547* 3550* ifi parameter fixed bin(24,0) dcl 2444 in procedure "macro_if" set ref 2441 2469 2470* 2470 2471* 2473* 2478* 2482 2486* 2491* 2493 2494* 2494 2495* 2497* 2500 2503 2508* 2508 2509* 2518 2526* 2526 2527* 2528* 2531 2534 2540* 2543* 2543 2544* 2545 2554 2561* 2561 2562* 2563* 2571* 2573* 2573 ifi parameter fixed bin(24,0) dcl 1430 in procedure "get_range" set ref 1427 1445 1445 1448* 1448 1452* 1455 1458* 1458 1459* ifi parameter fixed bin(24,0) dcl 3352 in procedure "macro_substr" set ref 3349 3374 3375* 3375 3376* 3377* 3381 3393 3395* 3395 3397 3400* 3415* 3415 3416* 3420 3420 3423 3424* 3424 3425* 3429 3431* ifi parameter fixed bin(24,0) dcl 3590 in procedure "macro_usage" set ref 3587 3614 3615* 3615 3616* 3617* 3621 3633 3635* 3635 3637 3640* 3653* ifi parameter fixed bin(24,0) dcl 1061 in procedure "cvt" ref 1056 1068 1068 ifi parameter fixed bin(24,0) dcl 628 in procedure "arg_range" set ref 625 650 654* 656 659* 659 661 672 673* 673 676 683* 686 689* 689 707* ifi parameter fixed bin(24,0) dcl 2132 in procedure "macro_do" set ref 2129 2151 2152* 2152 2153* 2154* 2158 2161* 2166* 2166 2169* 2170* 2175* 2177* 2177 2178* 2182 2190* 2190 2191* 2192* 2194* 2202* 2202 2210* 2210 2212* 2219* 2223* ifi parameter fixed bin(24,0) dcl 3270 in procedure "macro_scan" set ref 3267 3290 3291* 3291 3292* 3293* 3297 3309 3311* 3311 3313 3316* 3329 3341* ifi parameter fixed bin(24,0) dcl 3664 in procedure "protected" set ref 3661 3683 3684* 3684 3686 3694 3696* 3696 3697 3701* 3701 ifp parameter pointer dcl 2654 in procedure "macro_let" set ref 2651 2686* 2687* 2689 2697 2702 2772* 2773 2777* 2780 2795* 2796 2803* 2835 2861 2878 2896 2929* 2954* 2955 2959* 3013 3022* 3024 3030 3033* 3034* 3039 3051 3055 3058* 3063 3069* ifp parameter pointer dcl 1771 in procedure "macro_af" set ref 1768 1791* 1792* 1797 1809 1813 1815* ifp parameter pointer dcl 3178 in procedure "macro_quote" set ref 3175 3200* 3203 3215 3219 3222* 3225* ifp parameter pointer dcl 2587 in procedure "macro_length" set ref 2584 2610* 2611* 2615 2627 2631 2634* 2643* ifp parameter pointer dcl 4061 in procedure "var_ref" ref 4058 ifp parameter pointer dcl 2030 in procedure "macro_define" set ref 2027 2052* 2053* 2057 2069 2073 2077* 2121* ifp parameter pointer dcl 3746 in procedure "strip2" ref 3738 3743 3753 3758 3760 3761 3763 ifp parameter pointer dcl 1086 in procedure "dumper" set ref 1083 1093* ifp parameter pointer dcl 2132 in procedure "macro_do" set ref 2129 2153* 2154* 2161* 2169* 2170* 2178* 2182 2191* 2192* 2194* 2212* ifp parameter pointer dcl 3880 in procedure "var_range" set ref 3877 3926* 3996 4001 4012 4016 4023* 4026 ifp parameter pointer dcl 3503 in procedure "macro_unquote" set ref 3500 3525* 3528 3540 3544 3547* 3550* ifp parameter pointer dcl 3782 in procedure "var_bound" set ref 3779 3804* 3805 3819 3823 3826* ifp parameter pointer dcl 302 in procedure "ampersand" set ref 299 321* 329 334 351 352* 367* 371* 374* 377* 396 411 414 418 423 428 432 436* 439 443* 447* 449* 452* 455* 461 472* 475* 478* 488* 491* 494* 497* 500* 503* 506* 509* 512* 515* 555 562 574 576 579 591 591 597* 599* 606* ifp parameter pointer dcl 1430 in procedure "get_range" set ref 1427 1445 1445 1452* 1455 1459* ifp parameter pointer dcl 1882 in procedure "macro_call" set ref 1879 1908* 1909* 1917 1929 1933 1935* 1986* 2018* ifp parameter pointer dcl 3590 in procedure "macro_usage" set ref 3587 3616* 3617* 3621 3633 3637 3640* 3653* ifp parameter pointer dcl 1060 in procedure "cvt" ref 1056 1069 ifp parameter pointer dcl 2320 in procedure "macro_error" set ref 2317 2343* 2344* 2350* 2360* 2361 2369 2381 2385 2388* 2429* ifp parameter pointer dcl 2232 in procedure "macro_empty" set ref 2230 2250* 2251* 2253 2263 2273* 2274 2280* ifp parameter pointer dcl 628 in procedure "arg_range" set ref 625 654* 656 661 672 676 683* 686 ifp parameter pointer dcl 1531 in procedure "logical" set ref 1528 1553* 1555 1568 1572 1575 1575 1600* 1602 1629* 1631 1638 1642 1642 1664* ifp parameter pointer dcl 3270 in procedure "macro_scan" set ref 3267 3292* 3293* 3297 3309 3313 3316* 3341* ifp parameter pointer dcl 3352 in procedure "macro_substr" set ref 3349 3376* 3377* 3381 3393 3397 3400* 3416* 3420 3420 3423 3425* 3429 3431* ifp parameter pointer dcl 2444 in procedure "macro_if" set ref 2441 2471* 2473* 2478* 2486* 2495* 2497* 2509* 2527* 2528* 2544* 2554 2562* 2563* 2571* ifp parameter pointer dcl 1473 in procedure "get_token" set ref 1470 1478* 1479 1485 1490 ifp parameter pointer dcl 1181 in procedure "expand" set ref 1178 1197* 1200 1207 1214* ifp parameter pointer dcl 3664 in procedure "protected" ref 3661 3686 3694 3697 ifp parameter pointer dcl 718 in procedure "arithmetic" set ref 715 741* 748 760 764 766 770* ii 000753 automatic fixed bin(24,0) dcl 3192 in procedure "macro_quote" set ref 3201* 3226 3234 3241 3242 3244* 3246 3246* 3248 3248 3249 3250 ii 000115 automatic fixed bin(24,0) dcl 641 in procedure "arg_range" set ref 651* 679 679 680 ii 000635 automatic fixed bin(24,0) dcl 2043 in procedure "macro_define" set ref 2055* 2081 2117 ii 000101 automatic fixed bin(24,0) dcl 1194 in procedure "expand" set ref 1213* 1215 ii 000103 automatic fixed bin(24,0) dcl 1544 in procedure "logical" set ref 1628* 1652 1652 1654 1654 1654 1654 1667 1667 1667 1673 1673 1673 1679 1679 1679 1685 1685 1685 1691 1691 1691 1697 1697 1697 ii 000764 automatic fixed bin(24,0) dcl 3283 in procedure "macro_scan" set ref 3295* 3317 3331 3331 3334 3335 ii 001012 automatic fixed bin(24,0) dcl 3517 in procedure "macro_unquote" set ref 3526* 3552 3554* 3554* 3555 3562 3565* 3565* ii 001172 automatic fixed bin(24,0) dcl 3795 in procedure "var_bound" set ref 3803* 3829 3829 3830 ii 000702 automatic fixed bin(24,0) dcl 2600 in procedure "macro_length" set ref 2613* 2635 2636 ii 000777 automatic fixed bin(24,0) dcl 3365 in procedure "macro_substr" set ref 3379* 3403 3413 3414 3417 3417 3419 3426 3426 3427 ii 000431 automatic fixed bin(24,0) dcl 1895 in procedure "macro_call" set ref 1911* ii 000103 automatic fixed bin(24,0) dcl 731 in procedure "arithmetic" set ref 743* 803 815 815 815 815 818 907 907 1046 ii 001026 automatic fixed bin(24,0) dcl 3603 in procedure "macro_usage" set ref 3619* 3641 3641 3642 ii 000102 automatic fixed bin(24,0) dcl 2145 in procedure "macro_do" set ref 2158* 2219 ii 000216 automatic fixed bin(24,0) dcl 1784 in procedure "macro_af" set ref 1794* 1844 1856 1856 1856 1856 1864 1864 1867 ii 000670 automatic fixed bin(24,0) dcl 2333 in procedure "macro_error" set ref 2346* 2352 2356 2358 2389 2399 2412 2412 2412 2425 ii 001215 automatic fixed bin(24,0) dcl 3893 in procedure "var_range" set ref 3905* 4019 4019 4020 ii 000176 automatic fixed bin(24,0) dcl 1443 in procedure "get_range" set ref 1451* 1453 1453 1454 1460 1460 1461 ii 000102 automatic fixed bin(24,0) dcl 317 in procedure "ampersand" set ref 418* 420 423 426 index builtin function dcl 4365 ref 329 334 461 579 591 591 764 824 1200 1291 1293 1309 1315 1514 1572 1631 1813 1933 2057 2182 2369 2389 2554 2615 2637 3039 3203 3234 3244 3297 3528 3621 3686 3718 3763 3805 input based char unaligned dcl 3601 in procedure "macro_usage" ref 3621 3633 3637 input based char unaligned dcl 2667 in procedure "macro_let" ref 2689 2697 2702 2773 2835 2861 2878 2896 2955 3030 3039 3051 3055 3063 input based char unaligned dcl 3281 in procedure "macro_scan" ref 3297 3309 3313 input based char unaligned dcl 729 in procedure "arithmetic" ref 748 760 766 input based char unaligned dcl 1893 in procedure "macro_call" ref 1917 1929 input based char unaligned dcl 2143 in procedure "macro_do" ref 2182 input based char unaligned dcl 3515 in procedure "macro_unquote" ref 3528 3540 3544 input based char unaligned dcl 2331 in procedure "macro_error" ref 2369 2381 2385 input based char unaligned dcl 3190 in procedure "macro_quote" ref 3203 3215 3219 input based char unaligned dcl 2240 in procedure "macro_empty" ref 2253 2263 2274 input based char unaligned dcl 2459 in procedure "macro_if" ref 2554 input based char unaligned dcl 3363 in procedure "macro_substr" ref 3381 3393 3429 input based char unaligned dcl 2041 in procedure "macro_define" ref 2057 2069 2073 input based char unaligned dcl 3749 in procedure "strip2" ref 3753 3758 3760 3761 3763 input based char unaligned dcl 1542 in procedure "logical" ref 1555 1568 1575 1575 1631 1638 1642 1642 input based char unaligned dcl 639 in procedure "arg_range" ref 661 672 input based char unaligned dcl 3891 in procedure "var_range" ref 4001 4012 input based char unaligned dcl 1782 in procedure "macro_af" ref 1797 1809 input based char unaligned dcl 3793 in procedure "var_bound" ref 3805 3819 3823 input based char unaligned dcl 2598 in procedure "macro_length" ref 2615 2627 2631 input based char unaligned dcl 3674 in procedure "protected" ref 3686 3694 3697 input based char unaligned dcl 1476 in procedure "get_token" ref 1479 1485 1490 input based char unaligned dcl 1192 in procedure "expand" ref 1200 1207 input based char unaligned dcl 315 in procedure "ampersand" ref 396 411 418 428 461 555 562 574 579 591 591 inputa based char(1) array unaligned dcl 1892 in procedure "macro_call" ref 1933 inputa based char(1) array unaligned dcl 3890 in procedure "var_range" ref 3996 4016 4026 inputa based char(1) array unaligned dcl 1781 in procedure "macro_af" ref 1813 inputa based char(1) array unaligned dcl 1440 in procedure "get_range" ref 1445 1445 1455 inputa based char(1) array unaligned dcl 2330 in procedure "macro_error" ref 2361 inputa based char(1) array unaligned dcl 728 in procedure "arithmetic" ref 764 inputa based char(1) array unaligned dcl 3362 in procedure "macro_substr" ref 3397 3420 3420 3423 inputa based char(1) array unaligned dcl 2666 in procedure "macro_let" ref 2780 2796 3013 3024 inputa based char(1) array unaligned dcl 638 in procedure "arg_range" ref 656 676 686 inputa based char(1) array unaligned dcl 1064 in procedure "cvt" ref 1069 inputa based char(1) array unaligned dcl 1541 in procedure "logical" ref 1572 1602 inputa based char(1) array unaligned dcl 314 in procedure "ampersand" ref 329 334 351 414 423 432 439 576 inside 001013 automatic bit(1) unaligned dcl 3518 set ref 3553* 3559 3568* 3570* int_mac 100 based bit(1) level 2 in structure "macro_list" packed unaligned dcl 4290 in procedure "macro_" set ref 107 133 259 285* int_mac parameter bit(1) unaligned dcl 247 in procedure "addmacro" set ref 244 255* 259 285 int_var_ptr 000252 automatic pointer dcl 4283 set ref 70* 1725 1728* 1729 1730 1732* 1732 1734* 1735 1735 1735* 1738 1739 1740 1741 1744 2749 2750 4183* 4184* 4184 4186 4187 4189* 4191 int_vars based structure level 1 unaligned dcl 4284 set ref 1734 1735 1735 4191 int_vars_base 000024 internal static pointer initial dcl 4243 set ref 1728 1738 1741* 4182 4183 4186* ioa_ 000076 constant entry external dcl 4351 ref 102 110 126 136 172 175 177 183 255 267 277 288 842 846 850 1093 1248 1364 1365 1371 1380 1387 1395 1735 2482 2500 2518 2531 2545 2732 2743 2751 2759 2826 3084 3091 3142 3151 4096 4117 4124 4141 4148 4184 4189 4194 4201 4211 4215 ioa_$nnl 000102 constant entry external dcl 4357 ref 814 844 848 1584 1650 1653 1972 2109 3099 3160 3329 3727 3730 ioa_$rsnpnnl 000120 constant entry external dcl 3610 ref 3645 iox_$error_output 000114 external static pointer dcl 2432 set ref 2408* 2412* iox_$put_chars 000116 constant entry external dcl 2434 ref 2408 2412 j 000776 automatic fixed bin(24,0) dcl 3365 in procedure "macro_substr" set ref 3426* 3437* 3442 3448 3454* 3454 3456 3459 3465* 3465 3467* 3467 3481 3489 3490 j 001171 automatic fixed bin(24,0) dcl 3795 in procedure "var_bound" set ref 3831* 3832 j 000102 automatic fixed bin(24,0) dcl 731 in procedure "arithmetic" set ref 824* 825 852 852 882* 882 884 905 928 931 939 1027 j 001214 automatic fixed bin(24,0) dcl 3893 in procedure "var_range" set ref 3924* 3926* 3935 3954* 3967* 3987 4035 j 000101 automatic fixed bin(24,0) dcl 3713 in procedure "show_string" set ref 3718* 3719 3722* 3726 3727 3727 j 001301 automatic fixed bin(24,0) dcl 4074 in procedure "var_ref" set ref 4084* 4085 j 000102 automatic fixed bin(24,0) dcl 1544 in procedure "logical" set ref 1631* 1632 1634 1637* 1637 1638 1638 1639 1640 j 000634 automatic fixed bin(24,0) dcl 2043 in procedure "macro_define" set ref 2083* 2086 2092 2098* 2098 2099 2100 j parameter fixed bin(24,0) dcl 1443 in procedure "get_range" set ref 1427 1453* 1460* j 000103 automatic fixed bin(24,0) dcl 1505 in procedure "lineno" set ref 1514* 1515 1517 j 000114 automatic fixed bin(24,0) dcl 641 in procedure "arg_range" set ref 653* 654* 693* 693 694 697 j 000430 automatic fixed bin(24,0) dcl 1895 in procedure "macro_call" set ref 1983* 1984 j 000716 automatic fixed bin(24,0) dcl 2669 in procedure "macro_let" set ref 3073* 3078 3089 3095 3118 3136 3148 3155 3163 3163 j 000752 automatic fixed bin(24,0) dcl 3192 in procedure "macro_quote" set ref 3243* 3244 3246 3248 3250* 3250 3257 jj 001216 automatic fixed bin(24,0) dcl 3893 in procedure "var_range" set ref 4001* 4002 4008 4011* 4011 4012 4012 4013 4014 jj 001000 automatic fixed bin(24,0) dcl 3365 in procedure "macro_substr" set ref 3459* 3460 3463 3464 3465 jj 000104 automatic fixed bin(24,0) dcl 731 in procedure "arithmetic" set ref 828* 831 831* 833 843* 844 844* 847* 848* 855* 857 857* 860 863 jj 000717 automatic fixed bin(24,0) dcl 2669 in procedure "macro_let" set ref 3023* 3073 3095 3118 3121 3155 3163 3163 3168 jj 000103 automatic fixed bin(24,0) dcl 2145 in procedure "macro_do" set ref 2159* 2167* 2199* 2213 jj 000116 automatic fixed bin(24,0) dcl 641 in procedure "arg_range" set ref 661* 662 668 671* 671 672 672 673 674 jj 000104 automatic fixed bin(24,0) dcl 1544 in procedure "logical" set ref 1551* 1586 1586 1586 1586 1589 1592 1592 1652 1652 1652 1652 1657 1667 1667 1673 1673 1679 1679 1685 1685 1691 1691 1697 1697 k 000102 automatic fixed bin(24,0) dcl 3713 set ref 3726* 3728 kk 000105 automatic fixed bin(24,0) dcl 1544 set ref 1580* 1586 1586 1592 1646* 1654 1654 1667 1673 1679 1685 1691 1697 l 2 000100 automatic fixed bin(24,0) array level 2 in structure "args" dcl 1967 in begin block on line 1966 set ref 1982* l 2 based fixed bin(24,0) array level 2 in structure "argl" dcl 60 in procedure "macro_" set ref 74 76 175* 175 175 345 345 346 695 695 696 l_bound 1 based fixed bin(17,0) level 2 dcl 4272 set ref 2303* 2308* 2792 2857* 2874* 2885 2892* 2903 2910* 2919 2925* 2975 2983 3111* 3111 3117 3854 3923 3954 3968 3981 4108 4116 4123* 4123 4132 len 7 based fixed bin(17,0) level 2 in structure "var" dcl 4261 in procedure "macro_" set ref 1365 1365 1371 1371 1373 1373 1380 1383 2303 2737* 2823* 2824 2826 2826 2829 2842 2868 2947 2975 2983 2990 2996 3004 3078 3081 3084* 3087 3087 3089* 3090 3090 3091 3091 3091 3091 3095 3101 3101 3125 4096* 4096* 4096 4096 4099 4099 4100 4116 len 4 based fixed bin(17,0) array level 3 in structure "array" dcl 4272 in procedure "macro_" set ref 1387 1387 1391 1391 2831* 3118 3136 3142* 3146 3146 3148* 3149 3149 3151 3151 3151 3151 3155 4037 4037 4038 4117* 4117* 4117 4117 4121 4121 4122 4124* 4127 4127 4141* 4141* 4141 4141 4145 4145 4146 4148* 4151 4151 length builtin function dcl 4365 ref 360 361 602 700 701 1048 1049 1308 1868 1869 2166 2177 2210 2264 2272 2408 2408 2494 2508 2526 2543 3717 3722 4042 4043 level 000577 automatic fixed bin(24,0) dcl 1897 in procedure "macro_call" set ref 1915* 1945* 1945 1953* 1953 1954 2005 level 000105 automatic fixed bin(24,0) dcl 732 in procedure "arithmetic" set ref 746* 777* 777 781 795* 795 796 level 000217 automatic fixed bin(24,0) dcl 1785 in procedure "macro_af" set ref 1795* 1827* 1827 1835* 1835 1836 lg_sw 000026 internal static bit(1) initial unaligned dcl 4244 set ref 837 4383* 4387* limit 001270 automatic fixed bin(17,0) dcl 3896 set ref 4035* 4036 4039 line 000104 automatic fixed bin(24,0) dcl 1506 set ref 1509* 1513* 1513 1519 loc 000432 automatic fixed bin(24,0) array dcl 1896 set ref 1913* 1958* 1959 1974 1974 1977 1978 1982 1982 1983 2017* local_var_ptr 000314 automatic pointer dcl 4313 set ref 70* 227 1716 2757 2758* lower 000735 automatic fixed bin(24,0) dcl 2673 in procedure "macro_let" set ref 2787* 2792* 2795* 2808 2811 2817* 2823 2826* 2833 2842 2842 2858 2885 2903 2919 2925 2941 2990* 3010* 3111 3132* 3134 3160* lower based fixed bin(17,0) level 2 in structure "array" dcl 4272 in procedure "macro_" set ref 1380* 1380 1387 2302 2303 2833* 2842 2941 2947 3134 3134 4035 4036 ltrim builtin function dcl 4365 ref 80 359 1047 1519 3479 3481 3483 mac_sw 000745 automatic bit(1) unaligned dcl 4363 set ref 22* 35* 95 1288 maclp 000254 automatic pointer dcl 4289 set ref 105* 105* 107 110 110 110 114 117 118 119* 123 131* 131* 133 136 136 139 139 142 143 144* 148 258* 258* 259 259 259 263 263 263* 275 276* 277 277 277* 279 280 281 282 283 284 285 286 287 288 288 288 288 288 288 3643* 3643* 3645 3645 3645* 3649 4197* 4198 4201 4201 4201 4201 4201 4205 4206 4207 4210 4215* 4217 macname parameter varying char(32) dcl 42 in procedure "macro_" set ref 13 13 27 102* 104 114 124 126* 130 139 151* 172* 183* 1730 1735* 1740 2404 2420 2751* macname parameter varying char(32) dcl 1226 in procedure "find_macro" set ref 1224 1240 1248* 1282 1291 1293 1298 1308 1327 1339 macname parameter varying char(32) dcl 247 in procedure "addmacro" set ref 244 255* 259 279 macro 4 based char(32) level 2 packed unaligned dcl 4284 set ref 1730 1740* 4184* macro_holder based char unaligned dcl 4314 set ref 2104 2105* 2111* 4213 macro_holder_l 000316 automatic fixed bin(24,0) dcl 4315 set ref 2103* 2104 2104 2105 2105 2111 2111 2114* 4210* 4213 4213 macro_holder_p 000320 automatic pointer dcl 4316 set ref 2104* 2105 2111 2114* 4206* 4211* 4213 macro_list based structure level 1 unaligned dcl 4290 set ref 276 277 277 4217 macro_list_p 000030 internal static pointer initial dcl 4245 set ref 105 131 258 286 287* 3643 4193 4222* macro_nest 000032 internal static fixed bin(17,0) initial dcl 4246 set ref 88* 88 172* 183* 225* 225 1093* 4224* max builtin function dcl 4365 ref 1093 1093 3112 min builtin function dcl 4365 ref 693 1068 1511 3111 mod builtin function dcl 4365 ref 2990 4116 msg parameter varying char(1000) dcl 42 set ref 13 13 27 79* 80* 80 81* 81 86* 191* 193* 193 194* 194 198* 198 205* 205 206* 206 208* 208 209* 209 210* 210 211* 211 215* 215 220* 220 221* 221 235* 235 237* 237 271* 272* 272 326* 407* 408* 408 465* 545* 547* 547 548* 548 570* 585* 587* 587 588* 588 612* 613* 613 614* 614 665* 753* 901* 904* 904 905* 905 906* 906 907* 907 908* 908 1114 1127 1133 1140 1148* 1150* 1150 1151* 1151 1152* 1152 1153* 1153 1154* 1154 1155* 1155 1157* 1157 1158* 1158 1159* 1159 1160* 1160 1164* 1164 1165* 1165 1166* 1166 1168* 1168 1279* 1280* 1280 1281* 1281 1282* 1282 1297* 1298* 1298 1300* 1300 1301* 1301 1302* 1302 1303* 1303 1304* 1304 1322* 1560* 1802* 1863* 1922* 1963* 1986* 2011* 2012* 2012 2013* 2013 2062* 2095* 2174* 2187* 2222* 2260* 2267* 2268* 2268 2269* 2269 2277* 2285* 2286* 2286 2287* 2287 2293* 2294* 2294 2295* 2295 2347* 2374* 2391* 2392* 2392 2394* 2394 2398* 2398 2399* 2399 2400* 2400 2402* 2402 2403* 2403 2404* 2404 2405* 2405 2406* 2406 2407* 2407 2408 2408 2408 2408 2410* 2417* 2418* 2418 2419* 2419 2420* 2420 2421* 2421 2490* 2539* 2620* 2694* 2706* 2721* 2722* 2722 2723* 2723 2766* 2767* 2767 2768* 2768 2799* 2814* 2846* 2849* 2849 2850* 2850 2936* 2944* 2950* 2968* 2978* 2979* 2979 2980* 2980 2986* 2999* 3000* 3000 3001* 3001 3007* 3016* 3027* 3044* 3066* 3128* 3208* 3230* 3302* 3321* 3386* 3407* 3445* 3451* 3472* 3478* 3533* 3626* 3690* 3767* 3810* 3811* 3811 3812* 3812 3835* 3836* 3836 3837* 3837 3843* 3844* 3844 3845* 3845 3862* 3863* 3863 3864* 3864 3865* 3865 3867* 3867 3868* 3868 3910* 3916* 3917* 3917 3918* 3918 3938* 3939* 3939 3940* 3940 3946* 3947* 3947 3948* 3948 3958* 3960* 3960 3961* 3961 3971* 3973* 3973 3974* 3974 3984* 3990* 4005* 4049* 4088* 4089* 4089 4090* 4090 4111* 4112* 4112 4113* 4113 4135* 4136* 4136 4137* 4137 4155* 4156* 4156 4157* 4157 msg_etc 000322 automatic varying char(1000) dcl 4317 set ref 71* 217 221 1864* 3479* 3480* 3480 3481* 3481 3482* 3482 3483* 3483 3484* 3484 3485* 3485 3486* 3486 myname 000715 automatic varying char(32) dcl 4318 set ref 34* 104* 128* 129* 129 130* 130 209 599 1152 2114 name 2 based char(16) level 2 in structure "var" packed unaligned dcl 4261 in procedure "macro_" set ref 1364* 1380* 1395* 1718 1747 1756 2734* 2743* 2751* 2759* 3099* 3160* name 70 based char(32) level 2 in structure "macro_list" packed unaligned dcl 4290 in procedure "macro_" set ref 110* 114 136* 139 259 279* 288* 3645* 4201* next based pointer level 2 in structure "int_vars" dcl 4284 in procedure "macro_" set ref 1732 1738* 4186 next based pointer level 2 in structure "macro_list" dcl 4290 in procedure "macro_" set ref 123 148 275 286* 3649 4205 next based pointer level 2 in structure "var" dcl 4261 in procedure "macro_" set ref 1357 1720 1749 1758 2741* 2749* 2757* null builtin function dcl 4365 ref 23 36 67 70 91 105 131 258 1245 1250 1250 1261 1265 1265 1273 1355 1365 1368 1384 1414 1717 1725 1729 1739 1746 1755 1856 1856 2735 2830 3139 3643 4176 4181 4182 4194 4196 4220 4222 num 000100 automatic fixed bin(24,0) dcl 64 set ref 73* 74 76 80* 174* 175* 175 175 175 175* 333* 338* 338 342 345 345 345 346 694* 695 695 695 696 697* ofe parameter fixed bin(24,0) dcl 2320 in procedure "macro_error" set ref 2317 2344* 2346 2350* 2352 2352 2352 2358* 2364 2366* 2366 2381 2382* 2382 2411 2412 2425* 2429* ofe parameter fixed bin(24,0) dcl 3503 in procedure "macro_unquote" set ref 3500 3526 3540 3541* 3541 3547* 3554 3579* ofe parameter fixed bin(24,0) dcl 1531 in procedure "logical" set ref 1528 1551 1568 1569* 1569 1580 1589* 1600* 1618 1619* 1619 1628 1638 1640* 1640 1646 1657* 1664* ofe parameter fixed bin(24,0) dcl 302 in procedure "ampersand" set ref 299 321* 345 346* 346 352* 360 361* 361 371* 374* 377* 436* 443* 447* 449* 452* 455* 472* 475* 478* 488* 491* 494* 497* 500* 503* 506* 509* 512* 515* 606* ofe parameter fixed bin(24,0) dcl 2232 in procedure "macro_empty" set ref 2230 2251* ofe parameter fixed bin(24,0) dcl 3664 in procedure "protected" set ref 3661 3694 3695* 3695 3699 3700* 3700 ofe parameter fixed bin(24,0) dcl 3270 in procedure "macro_scan" set ref 3267 3293* 3295 3309 3310* 3310 3317 3335* 3336* 3341* ofe parameter fixed bin(24,0) dcl 1882 in procedure "macro_call" set ref 1879 1909* 1911 1912 1913 1913* 1929 1930* 1930 1935* 1940 1943* 1943 1948 1951* 1951 1958 1959 1978* 1983 1986* 2000 2003* 2003 2017 ofe parameter fixed bin(24,0) dcl 3590 in procedure "macro_usage" set ref 3587 3617* 3619 3633 3634* 3634 3641 3642* 3647 3648* 3648 3653* ofe parameter fixed bin(24,0) dcl 628 in procedure "arg_range" set ref 625 651 654* 672 674* 674 679 680* 683* 695 696* 696 700 701* 701 ofe parameter fixed bin(24,0) dcl 1086 in procedure "dumper" set ref 1083 1093* 1093 1093 1093* ofe parameter fixed bin(24,0) dcl 3782 in procedure "var_bound" set ref 3779 3803 3819 3820* 3820 3826* 3829 3830* ofe parameter fixed bin(24,0) dcl 2654 in procedure "macro_let" set ref 2651 2687* 2795* 3023 3033* 3051 3052* 3052 3058* 3073 3121* 3168* ofe parameter fixed bin(24,0) dcl 718 in procedure "arithmetic" set ref 715 741* 743 744 745* 745 760 761* 761 770* 773 776* 776 790 793* 793 803* 815 815 818 1046* 1048 1049* 1049 ofe parameter fixed bin(24,0) dcl 3178 in procedure "macro_quote" set ref 3175 3201 3215 3216* 3216 3222* 3226 3242* 3248 3249* 3249 3251 3254 3255* 3255 ofe parameter fixed bin(24,0) dcl 3352 in procedure "macro_substr" set ref 3349 3377* 3379 3393 3394* 3394 3400* 3403 3414* 3416* 3417 3419* 3425* 3426 3427* 3463 3464* 3464 3489 3490* 3490 ofe parameter fixed bin(24,0) dcl 2444 in procedure "macro_if" set ref 2441 2473* 2478* 2497* 2528* 2563* 2571 ofe parameter fixed bin(24,0) dcl 3880 in procedure "var_range" set ref 3877 3905 3926* 4012 4014* 4014 4019 4020* 4023* 4037 4038* 4038 4042 4043* 4043 ofe parameter fixed bin(24,0) dcl 1181 in procedure "expand" set ref 1178 1197* 1214* ofe parameter fixed bin(24,0) dcl 4061 in procedure "var_ref" ref 4058 ofe parameter fixed bin(24,0) dcl 2030 in procedure "macro_define" set ref 2027 2053* 2055 2069 2070* 2070 2082 2083 2103 2117* 2121* ofe parameter fixed bin(24,0) dcl 2587 in procedure "macro_length" set ref 2584 2611* 2613 2627 2628* 2628 2635 2636* 2638 2639* 2639 2643* ofe parameter fixed bin(24,0) dcl 1430 in procedure "get_range" set ref 1427 1451 1452* 1453 1454* 1459* 1460 1461* ofe parameter fixed bin(24,0) dcl 2132 in procedure "macro_do" set ref 2129 2154* 2161* 2169* 2192* 2194 ofe parameter fixed bin(24,0) dcl 1771 in procedure "macro_af" set ref 1768 1792* 1794 1809 1810* 1810 1815* 1822 1825* 1825 1830 1833* 1833 1840* 1840 1844* 1856 1856 1864 1867* 1868 1869* 1869 ofp parameter pointer dcl 3178 in procedure "macro_quote" set ref 3175 3215 3222* 3234 3241 3248 3251 3254 ofp parameter pointer dcl 2444 in procedure "macro_if" set ref 2441 2473* 2478* 2497* 2528* 2563* 2571* ofp parameter pointer dcl 3352 in procedure "macro_substr" set ref 3349 3377* 3393 3400* 3413 3416* 3417 3425* 3426 3463 3489 ofp parameter pointer dcl 2030 in procedure "macro_define" set ref 2027 2053* 2069 2082 2083 2099 2101 2105 2121* ofp parameter pointer dcl 628 in procedure "arg_range" set ref 625 654* 672 679 683* 695 700 ofp parameter pointer dcl 2587 in procedure "macro_length" set ref 2584 2611* 2627 2638 2643* ofp parameter pointer dcl 3782 in procedure "var_bound" set ref 3779 3819 3826* 3829 ofp parameter pointer dcl 3270 in procedure "macro_scan" set ref 3267 3293* 3309 3331 3331 3334 3336* 3341* ofp parameter pointer dcl 4061 in procedure "var_ref" ref 4058 4099 4121 4145 ofp parameter pointer dcl 3503 in procedure "macro_unquote" set ref 3500 3540 3547* 3555 3562 3576 ofp parameter pointer dcl 1771 in procedure "macro_af" set ref 1768 1792* 1809 1815* 1822 1830 1856 1856 1864 1868 ofp parameter pointer dcl 2132 in procedure "macro_do" set ref 2129 2154* 2161* 2169* 2192* 2194* ofp parameter pointer dcl 1531 in procedure "logical" set ref 1528 1568 1586 1586 1592 1600* 1618 1638 1652 1652 1654 1654 1664* 1667 1667 1673 1673 1679 1679 1685 1685 1691 1691 1697 1697 ofp parameter pointer dcl 302 in procedure "ampersand" set ref 299 321* 345 352* 360 371* 374* 377* 390 436* 443* 447* 449* 452* 455* 472* 475* 478* 488* 491* 494* 497* 500* 503* 506* 509* 512* 515* 606* ofp parameter pointer dcl 1181 in procedure "expand" set ref 1178 1197* 1207 1214* ofp parameter pointer dcl 1430 in procedure "get_range" set ref 1427 1452* 1453 1459* 1460 ofp parameter pointer dcl 2232 in procedure "macro_empty" set ref 2230 2251* ofp parameter pointer dcl 2654 in procedure "macro_let" set ref 2651 2687* 2795* 3033* 3051 3058* 3095 3118 3155 3163 3163 ofp parameter pointer dcl 3664 in procedure "protected" ref 3661 3694 3699 ofp parameter pointer dcl 3880 in procedure "var_range" set ref 3877 3926* 4012 4019 4023* 4037 4042 ofp parameter pointer dcl 3590 in procedure "macro_usage" set ref 3587 3617* 3633 3641 3647 3653* ofp parameter pointer dcl 1086 in procedure "dumper" set ref 1083 1093* ofp parameter pointer dcl 1882 in procedure "macro_call" set ref 1879 1909* 1912 1929 1935* 1940 1948 1974 1974 1977 1986* 2000 ofp parameter pointer dcl 2320 in procedure "macro_error" set ref 2317 2344* 2350* 2352 2352 2356 2364 2381 2389 2399 2411 2412 2412 2429* ofp parameter pointer dcl 718 in procedure "arithmetic" set ref 715 741* 744 760 770* 773 790 815 815 824 828 842 842 855 860 872 907 1048 out_len parameter fixed bin(24,0) dcl 42 set ref 13 13 27 182* 390 391* 391 1207 1208* 1208 4099 4100* 4100 4121 4122* 4122 4145 4146* 4146 out_ptr parameter pointer dcl 42 set ref 13 13 27 182* output based char(1044480) unaligned dcl 2332 in procedure "macro_error" set ref 2352 2352 2356* 2364* 2381* 2389 2399 2411* 2412 2412 output based char(1044480) unaligned dcl 1442 in procedure "get_range" ref 1453 1460 output based char(1044480) unaligned dcl 640 in procedure "arg_range" set ref 672* 679 695* 700* output based char(1044480) unaligned dcl 4073 in procedure "var_ref" set ref 4099* 4121* 4145* output based char(1044480) unaligned dcl 1894 in procedure "macro_call" set ref 1912* 1929* 1940* 1948* 1974 1974 1977 2000* output based char(1044480) unaligned dcl 3191 in procedure "macro_quote" set ref 3215* 3234 3241 3248* 3251 3254* output based char(1044480) unaligned dcl 3282 in procedure "macro_scan" set ref 3309* 3331 3331 3334 output based char(1044480) unaligned dcl 1543 in procedure "logical" set ref 1568* 1586 1586 1592 1618* 1638* 1652 1652 1654 1654 1667 1667 1673 1673 1679 1679 1685 1685 1691 1691 1697 1697 output based char(1044480) unaligned dcl 2599 in procedure "macro_length" set ref 2627* 2638* output based char(1044480) unaligned dcl 3602 in procedure "macro_usage" set ref 3633* 3641 3647* output based char(1044480) unaligned dcl 3892 in procedure "var_range" set ref 4012* 4019 4037* 4042* output based char(1044480) unaligned dcl 1783 in procedure "macro_af" set ref 1809* 1822* 1830* 1856 1856 1864 1868* output based char(1044480) unaligned dcl 3675 in procedure "protected" set ref 3694* 3699* output based char(1044480) unaligned dcl 2042 in procedure "macro_define" set ref 2069* 2082 2083 2099 2101 2105 output based char(1044480) unaligned dcl 3516 in procedure "macro_unquote" set ref 3540* 3555 3562 3576* output based char(1044480) unaligned dcl 730 in procedure "arithmetic" set ref 744* 760* 773* 790* 815 815 824 828 842 842 855 860 872 907 1048* output based char(1044480) unaligned dcl 1193 in procedure "expand" set ref 1207* output based char(1044480) unaligned dcl 3364 in procedure "macro_substr" set ref 3393* 3413 3417 3426 3463* 3489* output based char(1044480) unaligned dcl 3794 in procedure "var_bound" set ref 3819* 3829 output based char(1044480) unaligned dcl 2668 in procedure "macro_let" set ref 3051* 3095 3118 3155 3163 3163 output based char(1044480) unaligned dcl 316 in procedure "ampersand" set ref 345* 360* 390* owner 2 001012 automatic char(32) level 2 packed unaligned dcl 1419 set ref 1412* p 000100 automatic pointer array level 2 in structure "args" dcl 1967 in begin block on line 1966 set ref 1984* p based pointer array level 2 in structure "argl" dcl 60 in procedure "macro_" ref 175 345 695 pc_sw 000033 internal static bit(1) initial unaligned dcl 4247 set ref 169 183 4379* 4391* pic60 automatic picture(60) unaligned dcl 736 ref 1047 pr_sw parameter bit(1) unaligned dcl 4171 ref 4168 4194 4198 ref 2 based pointer level 2 in structure "int_vars" dcl 4284 in procedure "macro_" set ref 1739* 1744 2749 2750* 4187 ref 6 based pointer array level 3 in structure "array" dcl 4272 in procedure "macro_" set ref 1384 1387* 1387 1391 2830* 3118 3139 3142* 3146 3149* 3151 3151 3151* 3155 4037 4117 4121 4124* 4127 4141 4145 4148* 4151 ref 2 based pointer level 2 in structure "macro_list" dcl 4290 in procedure "macro_" set ref 117 142 263 280* 288* 4206 ref 10 based pointer level 2 in structure "var" dcl 4261 in procedure "macro_" set ref 1365 1365* 1365 1368 1371* 1371 1373 1379 2298 2735* 2791 2825* 2826* 2940 2974 2995 3084* 3087 3090* 3091 3091 3091* 3095 3101 3107 3848 3922 3928 4034 4096 4099 4104 ref_path 000104 automatic char(168) unaligned dcl 4167 set ref 1245* 1247* 1248* 1250* 1265* refp 000102 automatic pointer dcl 65 in procedure "macro_" set ref 24* 36* 151* refp parameter pointer dcl 1226 in procedure "find_macro" set ref 1224 1245 1247* refseg parameter pointer dcl 42 ref 13 13 24 rel 000106 automatic fixed bin(24,0) dcl 1549 set ref 1572* 1573 1611* 1611 1614 1653 1662 relat 000050 internal static char(2) initial array unaligned dcl 1660 set ref 1653* release_area_ 000062 constant entry external dcl 4174 ref 4219 res 000106 automatic varying char(32) dcl 1059 set ref 1067* 1072* 1072 1074* 1074 1075 reserved 000075 constant char(8) initial array unaligned dcl 2710 ref 2717 2718 ret_len 001161 automatic fixed bin(24,0) dcl 3609 set ref 3645* 3647 3647 3648 ret_str 001061 automatic char(256) unaligned dcl 3608 set ref 3645* 3647 reverse builtin function dcl 4365 ref 2637 rtrim builtin function dcl 4365 ref 1047 1047 1302 rval 000220 automatic varying char(500) dcl 1850 set ref 1856* 1868 1868 1869 save_db 000726 automatic bit(1) unaligned dcl 4320 set ref 90* 231 search builtin function dcl 4365 ref 661 748 1555 1797 1917 3381 4001 search_for 000762 automatic varying char(35) dcl 1238 set ref 1240* 1242* 1243* 1243 1248* 1250 1265 1271 1280 1304 1327 1327 1339 1339 search_paths_$find_dir 000106 constant entry external dcl 1235 ref 1250 1265 seg based char unaligned dcl 4321 ref 1291 1293 1309 1315 1514 sege 000727 automatic fixed bin(24,0) dcl 4323 in procedure "macro_" set ref 39* 119* 144* 155 162 182* 188 484 1287* 1291 1293 1309 1315 1326* 1327* 1339* 1511 1514 1515 sege parameter fixed bin(24,0) dcl 247 in procedure "addmacro" ref 244 263 284 segi parameter fixed bin(24,0) dcl 1501 in procedure "lineno" ref 1498 1511 1512 segi 000730 automatic fixed bin(24,0) dcl 4324 in procedure "macro_" set ref 38* 118* 143* 155 159* 159 162 166* 166 182* 188 211* 484* 1286* 1308* 1309 1314* 1314 1315 1326 1327* 1339* segi parameter fixed bin(24,0) dcl 247 in procedure "addmacro" ref 244 263 283 segment based char unaligned dcl 4326 ref 155 162 segname parameter varying char(32) dcl 42 in procedure "macro_" set ref 13 13 27 31 98 151* segname parameter varying char(32) dcl 247 in procedure "addmacro" set ref 244 255* 259 282 segname parameter varying char(32) dcl 1226 in procedure "find_macro" ref 1224 1240 1242 1329 segp parameter pointer dcl 247 set ref 244 255* 280 segptr 000732 automatic pointer dcl 4327 set ref 23* 37* 91 117* 142* 155 162 182* 263 1257* 1261 1271* 1273 1291 1293 1309 1315 1327* 1339* 1514 segtype 000734 automatic varying char(8) dcl 4328 set ref 18* 31* 33* 34 91 172* 202 sep_ct 000576 automatic fixed bin(24,0) dcl 1897 set ref 1914* 1958 1967 1979* 1981 1986 2008 2016* 2016 2017 separator 000117 automatic varying char(150) dcl 642 in procedure "arg_range" set ref 655* 679* 700 700 701 separator 001217 automatic varying char(150) dcl 3894 in procedure "var_range" set ref 3995* 4019* 4042 4042 4043 sepch 000100 automatic char(1) unaligned dcl 3412 set ref 3418* 3423* 3437 3439 size 13 001012 automatic fixed bin(18,0) level 2 in structure "ai" dcl 1419 in procedure "get_area" set ref 1413* size builtin function dcl 4365 in procedure "macro_" ref 277 277 1735 1735 2732 2732 2826 2826 3091 3091 3151 3151 sl 000107 automatic fixed bin(24,0) dcl 733 set ref 807* 843 861* 861 862 866 870 886 904 912 918 920 925* 925 926 928 928 930* 930 931 934 938* 938 939 955* 955 956 1022* 1022 1023 1032* 1032 1033 sl_name parameter varying char(32) dcl 42 set ref 13 13 19 27 151* 1412 1986* space 000216 constant char(5) initial unaligned dcl 4255 ref 2082 3753 start_sym 000737 automatic varying char(8) dcl 4329 set ref 532* 539* 547 558 571 589 599 stk 000564 automatic fixed bin(24,0) array dcl 735 set ref 809* 844 844 862* 866 870 886 904 912 918 920 926* 928 928 931* 934 939* 956* 1023* 1033* str1 parameter char unaligned dcl 3712 ref 3709 3717 3718 3722 3727 3727 str2 parameter char unaligned dcl 3712 set ref 3709 3730* string builtin function dcl 4365 set ref 1410* 1977* 3334* strlen parameter fixed bin(24,0) dcl 42 ref 27 39 strptr parameter pointer dcl 42 ref 27 37 substr builtin function dcl 4365 set ref 110 110 155 162 345* 360* 390* 396 411 418 428 461 555 562 574 579 591 591 661 672* 672 679 695* 700* 744* 748 760* 760 766 773* 790* 815 815 824 828 842 842 844 844 855 860 872 904 905 907 1048* 1200 1207* 1207 1309 1315 1453 1460 1479 1485 1490 1514 1555 1568* 1568 1575 1575 1586 1586 1592 1618* 1631 1638* 1638 1642 1642 1652 1652 1654 1654 1667 1667 1673 1673 1679 1679 1685 1685 1691 1691 1697 1697 1797 1809* 1809 1822* 1830* 1856 1856 1864 1868* 1912* 1917 1929* 1929 1940* 1948* 1974 1974 1977 2000* 2057 2069* 2069 2073 2082 2083 2099 2101 2105 2182 2253 2263 2274 2352 2352 2356* 2364* 2369 2381* 2381 2385 2389 2399 2411* 2412 2412 2554 2615 2627* 2627 2631 2638* 2638 2689 2697 2702 2773 2835 2861 2878 2896 2955 3030 3039 3051* 3051 3055 3063 3095 3118 3155 3163 3163 3203 3215* 3215 3219 3234 3241 3244 3248* 3248 3251 3254* 3297 3309* 3309 3313 3331 3331 3334 3381 3393* 3393 3413 3417 3426 3429 3463* 3489* 3489 3528 3540* 3540 3544 3555 3562 3576* 3621 3633* 3633 3637 3641 3647* 3647 3686 3694* 3694 3697 3699* 3718 3727 3727 3753 3758 3760 3761 3763 3805 3819* 3819 3823 3829 4001 4012* 4012 4019 4037* 4042* 4099* 4121* 4145* 4207 suffix parameter varying char(32) dcl 1226 ref 1224 1243 1250 1257 1257 1261 1265 1291 1309 text parameter char(4) unaligned dcl 1086 set ref 1083 1093* tf parameter bit(2) unaligned dcl 1181 in procedure "expand" set ref 1178 1197* 1214* tf parameter bit(2) unaligned dcl 3178 in procedure "macro_quote" set ref 3175 3222* tf parameter bit(2) unaligned dcl 3503 in procedure "macro_unquote" set ref 3500 3547* tf parameter bit(2) unaligned dcl 2444 in procedure "macro_if" ref 2441 2472 2480 tf 000104 automatic bit(2) unaligned dcl 2146 in procedure "macro_do" set ref 2168* 2169* 2179 to 67 based fixed bin(24,0) level 2 dcl 4290 set ref 119 144 263 284* 288* 4201* 4210 token_chars 000176 constant char(63) initial unaligned dcl 4331 ref 396 418 3760 tptr 000742 automatic pointer dcl 4330 set ref 227* 1355 1356 1357* 4179* 4187* 4193* 4194 4196 4197 4205* tr_sw 000744 automatic bit(1) unaligned dcl 4334 set ref 153* 160* 169 183 811 1581 1647 1969 2106 2482 2500 2518 2531 2545 3096 3157 3326 translate builtin function dcl 4365 ref 1592 type 6 based fixed bin(17,0) level 2 dcl 4261 set ref 1358 1376 1376 2290 2299 2305 2736* 2784 2822* 2842 2856* 2868 2873* 2885 2891* 2903 2909* 2919 2933 2933 2965 2965 2971 2992 3075 3108 3114 3840 3849 3849 3849 3858 3858 3865 3913 3932 3932 3951 4093 4105 4129 v 000630 automatic fixed dec(59,9) dcl 738 set ref 942* 946* 960* 964* 968* 972* 976* 980* 984* 988* 992* 996* 1001* 1006* 1011* 1016* 1021 val 000110 automatic fixed dec(59,9) array dcl 734 set ref 848* 860* 860 924* 942 942 950 950* 954* 960 960 968 968 976 976 984 984 992 992 1001 1001 1006 1006 1011 1011 1016 1016 1021* 1047 var based structure level 1 unaligned dcl 4261 set ref 1397 2731 2732 2732 var_ptr 000244 automatic pointer dcl 4260 set ref 1356* 1357 1358 1364* 1364 1365 1365 1365 1365 1365 1368 1371 1371 1371 1371 1373 1373 1373 1376 1376 1379 1380* 1380 1380 1383 1395 1395* 1397 1716* 1717 1718 1720* 1720 1744* 1746 1747 1749* 1749 1754* 1755 1756 1758* 1758 2290 2298 2299 2303 2305 2731* 2732 2732 2732* 2734 2735 2736 2737 2741 2742 2743* 2743 2749 2750 2751* 2751 2757 2758 2759* 2759 2771 2784 2791 2804* 2822 2823 2824 2825 2826 2826 2826 2829 2842 2842 2856 2868 2868 2873 2885 2891 2903 2909 2919 2933 2933 2940 2947 2965 2965 2971 2974 2975 2983 2990 2992 2995 2996 3004 3074* 3075 3078 3081 3084 3084 3087 3087 3087 3089 3090 3090 3090 3091 3091 3091 3091 3091 3091 3091 3095 3095 3099 3101 3101 3101 3107 3108 3114 3125 3160 3840 3848 3849 3849 3849 3858 3858 3865 3913 3921 3922 3927* 3928 3932 3932 3951 4033* 4034 4093 4096 4096 4096 4096 4096 4099 4099 4099 4100 4104 4105 4116 4129 vartext based char unaligned dcl 4268 set ref 1365* 1371* 1373 3087 3090 3091 3091 3095* 3101* 4096* 4099 verify builtin function dcl 4365 ref 396 418 562 828 855 1485 2082 2083 2253 2689 2697 3753 3760 version 001012 automatic fixed bin(17,0) level 2 dcl 1419 set ref 1409* vl 000106 automatic fixed bin(24,0) dcl 733 set ref 808* 847 859* 859 860 923* 923 924 942 942 950 950 954 960 960 968 968 976 976 984 984 992 992 1001 1001 1006 1006 1011 1011 1016 1016 1019* 1019 1021 vname 000646 automatic varying char(32) dcl 2244 in procedure "macro_empty" set ref 2263* 2264 2268 2272 2281* 2286 2294 vname 001173 automatic varying char(32) dcl 3799 in procedure "var_bound" set ref 3829* 3831* 3836 vname parameter varying char(32) dcl 1712 in procedure "lookup" ref 1709 1718 1747 1756 vname 000720 automatic varying char(32) dcl 2670 in procedure "macro_let" set ref 2702* 2718 2722 2727* 2732* 2734 2767 2826* 2849 2979 3000 3084* 3091* 3142* 3151* vptr 001266 automatic pointer dcl 3895 in procedure "var_range" set ref 3921* 3927 4033 vptr 000732 automatic pointer dcl 2671 in procedure "macro_let" set ref 2771* 2804 3074 watchfor parameter char unaligned dcl 4404 ref 4402 4406 watchword 000034 internal static char(32) initial unaligned dcl 4248 set ref 4096 4096* 4117 4117* 4141 4141* 4406* which parameter fixed bin(24,0) dcl 2654 in procedure "macro_let" ref 2651 2687 2695 2728 2738 2746 2773 2800 2805 2819 2839 2865 2882 2900 2916 2955 3017 3028 3045 3067 3070 3099 3160 which parameter char(3) unaligned dcl 1353 in procedure "free_um" set ref 1350 1364* 1380* who parameter char unaligned dcl 1106 ref 1103 1117 1123 1130 1136 1159 who_am_i 000044 internal static varying char(12) dcl 4249 set ref 19* 21* 172 183 206 271 407 1150 2012 2402 2418 4194* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. DEFAULT_ACTIVE_STRING internal static fixed bin(17,0) initial dcl 2-6 NORMAL_ACTIVE_STRING internal static fixed bin(17,0) initial dcl 2-6 TOKENS_ONLY_ACTIVE_STRING internal static fixed bin(17,0) initial dcl 2-6 archive_util_$first_element 000000 constant entry external dcl 4353 archive_util_$search 000000 constant entry external dcl 4355 area_infop automatic pointer dcl 1-5 argstrl automatic fixed bin(24,0) dcl 3679 in procedure "protected" argstrl automatic fixed bin(24,0) dcl 4077 in procedure "var_ref" argstrl automatic fixed bin(24,0) dcl 2336 in procedure "macro_error" argstrl automatic fixed bin(24,0) dcl 1548 in procedure "logical" argstrl automatic fixed bin(24,0) dcl 3606 in procedure "macro_usage" argstrl automatic fixed bin(24,0) dcl 2603 in procedure "macro_length" argstrl automatic fixed bin(24,0) dcl 3798 in procedure "var_bound" argstrl automatic fixed bin(24,0) dcl 2046 in procedure "macro_define" begl automatic fixed bin(24,0) dcl 1439 in procedure "get_range" begl automatic fixed bin(24,0) dcl 3791 in procedure "var_bound" begl automatic fixed bin(24,0) dcl 1063 in procedure "cvt" begl automatic fixed bin(24,0) dcl 1190 in procedure "expand" c6 automatic picture(6) unaligned dcl 1503 ch automatic char(1) unaligned dcl 3194 ch8 automatic picture(8) unaligned dcl 2337 error_table_$action_not_performed external static fixed bin(35,0) dcl 4336 error_table_$archive_fmt_err external static fixed bin(35,0) dcl 4338 error_table_$new_search_list external static fixed bin(35,0) dcl 4342 get_seg_ptr_ 000000 constant entry external dcl 4361 hcs_$fs_get_seg_ptr 000000 constant entry external dcl 4359 hcs_$make_ptr 000000 constant entry external dcl 4358 i automatic fixed bin(24,0) dcl 4074 ii automatic fixed bin(24,0) dcl 3676 in procedure "protected" ii automatic fixed bin(24,0) dcl 4074 in procedure "var_ref" ii automatic fixed bin(24,0) dcl 2242 in procedure "macro_empty" ii automatic fixed bin(24,0) dcl 2669 in procedure "macro_let" ii automatic fixed bin(24,0) dcl 2461 in procedure "macro_if" input based char unaligned dcl 1441 in procedure "get_range" input based char unaligned dcl 4072 in procedure "var_ref" inputa based char(1) array unaligned dcl 1191 in procedure "expand" inputa based char(1) array unaligned dcl 2040 in procedure "macro_define" inputa based char(1) array unaligned dcl 2458 in procedure "macro_if" inputa based char(1) array unaligned dcl 3189 in procedure "macro_quote" inputa based char(1) array unaligned dcl 2239 in procedure "macro_empty" inputa based char(1) array unaligned dcl 2142 in procedure "macro_do" inputa based char(1) array unaligned dcl 3600 in procedure "macro_usage" inputa based char(1) array unaligned dcl 2597 in procedure "macro_length" inputa based char(1) array unaligned dcl 3514 in procedure "macro_unquote" inputa based char(1) array unaligned dcl 4071 in procedure "var_ref" inputa based char(1) array unaligned dcl 3792 in procedure "var_bound" inputa based char(1) array unaligned dcl 3673 in procedure "protected" inputa based char(1) array unaligned dcl 3280 in procedure "macro_scan" inside automatic bit(1) unaligned dcl 3193 j automatic fixed bin(24,0) dcl 2242 in procedure "macro_empty" j automatic fixed bin(24,0) dcl 3517 in procedure "macro_unquote" j automatic fixed bin(24,0) dcl 317 in procedure "ampersand" j automatic fixed bin(24,0) dcl 3676 in procedure "protected" j automatic fixed bin(24,0) dcl 2600 in procedure "macro_length" j automatic fixed bin(24,0) dcl 3603 in procedure "macro_usage" j automatic fixed bin(24,0) dcl 2333 in procedure "macro_error" j automatic fixed bin(24,0) dcl 1194 in procedure "expand" j automatic fixed bin(24,0) dcl 2145 in procedure "macro_do" j automatic fixed bin(24,0) dcl 3283 in procedure "macro_scan" j automatic fixed bin(24,0) dcl 2461 in procedure "macro_if" j automatic fixed bin(24,0) dcl 1784 in procedure "macro_af" jaf automatic fixed bin(24,0) dcl 4312 jj automatic fixed bin(24,0) dcl 1194 in procedure "expand" jj automatic fixed bin(24,0) dcl 317 in procedure "ampersand" jj automatic fixed bin(24,0) dcl 3795 in procedure "var_bound" jj automatic fixed bin(24,0) dcl 2043 in procedure "macro_define" jj automatic fixed bin(24,0) dcl 2461 in procedure "macro_if" jj automatic fixed bin(24,0) dcl 3517 in procedure "macro_unquote" jj automatic fixed bin(24,0) dcl 3676 in procedure "protected" jj automatic fixed bin(24,0) dcl 3192 in procedure "macro_quote" jj automatic fixed bin(24,0) dcl 1895 in procedure "macro_call" jj automatic fixed bin(24,0) dcl 3603 in procedure "macro_usage" jj automatic fixed bin(24,0) dcl 2600 in procedure "macro_length" jj automatic fixed bin(24,0) dcl 1784 in procedure "macro_af" jj automatic fixed bin(24,0) dcl 2242 in procedure "macro_empty" jj automatic fixed bin(24,0) dcl 2333 in procedure "macro_error" jj automatic fixed bin(24,0) dcl 3283 in procedure "macro_scan" jj automatic fixed bin(24,0) dcl 1443 in procedure "get_range" jj automatic fixed bin(24,0) dcl 4074 in procedure "var_ref" level automatic fixed bin(24,0) dcl 4076 in procedure "var_ref" level automatic fixed bin(24,0) dcl 3797 in procedure "var_bound" loc automatic fixed bin(24,0) array dcl 3677 in procedure "protected" loc automatic fixed bin(24,0) array dcl 3796 in procedure "var_bound" loc automatic fixed bin(24,0) array dcl 4075 in procedure "var_ref" loc automatic fixed bin(24,0) array dcl 3366 in procedure "macro_substr" loc automatic fixed bin(24,0) array dcl 2601 in procedure "macro_length" loc automatic fixed bin(24,0) array dcl 3604 in procedure "macro_usage" loc automatic fixed bin(24,0) array dcl 1546 in procedure "logical" loc automatic fixed bin(24,0) array dcl 3284 in procedure "macro_scan" loc automatic fixed bin(24,0) array dcl 2334 in procedure "macro_error" loc automatic fixed bin(24,0) array dcl 2044 in procedure "macro_define" output based char(1044480) unaligned dcl 4319 in procedure "macro_" output based char(1044480) unaligned dcl 2241 in procedure "macro_empty" output based char(1044480) unaligned dcl 2460 in procedure "macro_if" output based char(1044480) unaligned dcl 2144 in procedure "macro_do" sega based char(1) array unaligned dcl 4322 segii automatic fixed bin(24,0) dcl 4325 sep_ct automatic fixed bin(24,0) dcl 3285 in procedure "macro_scan" sep_ct automatic fixed bin(24,0) dcl 3797 in procedure "var_bound" sep_ct automatic fixed bin(24,0) dcl 1547 in procedure "logical" sep_ct automatic fixed bin(24,0) dcl 2335 in procedure "macro_error" sep_ct automatic fixed bin(24,0) dcl 3678 in procedure "protected" sep_ct automatic fixed bin(24,0) dcl 2045 in procedure "macro_define" sep_ct automatic fixed bin(24,0) dcl 2602 in procedure "macro_length" sep_ct automatic fixed bin(24,0) dcl 3605 in procedure "macro_usage" sep_ct automatic fixed bin(24,0) dcl 3367 in procedure "macro_substr" sep_ct automatic fixed bin(24,0) dcl 4076 in procedure "var_ref" skip_sw automatic bit(1) unaligned dcl 2457 tf automatic bit(2) unaligned dcl 2243 NAMES DECLARED BY EXPLICIT CONTEXT. add_id 003415 constant label dcl 198 ref 552 1865 1995 add_identification 003412 constant label dcl 196 ref 238 273 327 409 615 754 909 1562 1964 2014 2707 2724 2769 2815 2851 2938 2945 2951 2969 2981 2987 3002 3008 3130 3231 3322 3408 3446 3452 3473 3487 3813 3838 3846 3869 3911 3919 3941 3949 3962 3975 3985 3991 4091 4114 4138 4158 addmacro 004430 constant entry internal dcl 244 ref 599 1327 1339 2114 alf 004360 constant entry external dcl 4393 aln 004300 constant entry external dcl 4373 ampersand 004763 constant entry internal dcl 299 ref 683 770 1214 1600 1664 1815 1935 2121 2429 2643 3058 3222 3341 3400 3547 3653 3826 4023 arg_range 007505 constant entry internal dcl 625 ref 352 arith_err 011033 constant label dcl 901 ref 781 833 835 866 912 918 934 1036 arithmetic 010063 constant entry internal dcl 715 ref 374 1452 1459 2350 3033 3416 3425 bad_mac 013576 constant label dcl 1298 set ref 1323 calc 000034 constant label array(11:22) dcl 942 ref 870 928 calc_common 011433 constant label dcl 1019 ref 947 965 973 981 989 997 1004 1009 1014 common 012176 constant label dcl 1143 ref 1115 1121 1128 1134 1141 comp 000057 constant label array(2:8) dcl 1667 ref 1662 cvt 011557 constant entry internal dcl 1056 ref 1093 1093 dbf 004371 constant entry external dcl 4397 dbn 004266 constant entry external dcl 4369 dcl_err 026364 constant label dcl 2846 ref 2868 2885 2903 2919 def_err 020601 constant label dcl 2089 ref 2101 doit 003062 constant label dcl 153 set ref 91 120 145 dumper 011646 constant entry internal dcl 1083 ref 321 741 1197 1792 1909 2053 2154 2251 2344 2473 2611 2687 3293 3377 3617 end_range 007753 constant label dcl 689 in procedure "arg_range" ref 681 end_range 035455 constant label dcl 4029 in procedure "var_range" ref 4021 endloop 011463 constant label dcl 1038 ref 864 932 940 1034 error_attempt 012140 constant entry internal dcl 1136 error_gen 012113 constant entry internal dcl 1130 ref 1988 2270 2288 2296 2695 3028 error_misplaced 012054 constant entry internal dcl 1123 ref 2223 error_missing 011773 constant entry internal dcl 1103 ref 466 571 589 666 1803 1923 2063 2096 2175 2188 2261 2278 2375 2491 2540 2621 2800 3017 3045 3067 3209 3303 3387 3534 3627 3691 3768 4006 error_syntax 012032 constant entry internal dcl 1117 ref 558 707 2089 exit 003622 constant label dcl 225 ref 1170 1284 1306 2423 expand 012463 constant entry internal dcl 1178 in procedure "macro_" ref 182 2161 2497 2528 3336 expand 002307 constant entry external dcl 27 find_macro 012636 constant entry internal dcl 1224 ref 151 found 016574 constant label dcl 1744 ref 1730 free 003707 constant entry external dcl 4168 free_um 014151 constant entry internal dcl 1350 ref 228 4180 4188 get_area 014542 constant entry internal dcl 1406 ref 67 get_range 014601 constant entry internal dcl 1427 ref 654 2795 3926 get_token 014755 constant entry internal dcl 1470 ref 2170 2191 2486 2562 here 013107 constant label dcl 1257 set ref 1257 1257 lgf 004336 constant entry external dcl 4385 lgn 004324 constant entry external dcl 4381 lineno 015051 constant entry internal dcl 1498 ref 211 814 814 1145 1146 1584 1584 1650 1650 1972 1972 2109 2109 2406 2476 2482 2482 2500 2500 2518 2518 2531 2531 2545 2545 3099 3099 3160 3160 3329 3329 log_err 015240 constant label dcl 1560 ref 1632 logical 015164 constant entry internal dcl 1528 ref 2169 2478 lookup 016426 constant entry internal dcl 1709 ref 2281 2727 3831 3906 4084 loop 031706 constant label dcl 3381 in procedure "macro_substr" ref 3401 loop 027346 constant label dcl 3039 in procedure "macro_let" ref 3059 loop 021255 constant label dcl 2161 in procedure "macro_do" ref 2205 2220 loop 017420 constant label dcl 1917 in procedure "macro_call" ref 1938 1946 1954 2020 loop 010141 constant label dcl 748 in procedure "arithmetic" ref 771 779 796 loop 033235 constant label dcl 3621 in procedure "macro_usage" ref 3654 loop 024771 constant label dcl 2615 in procedure "macro_length" ref 2644 loop 034213 constant label dcl 3805 in procedure "var_bound" ref 3827 loop 020376 constant label dcl 2057 in procedure "macro_define" ref 2122 loop 015214 constant label dcl 1555 in procedure "logical" ref 1601 1620 loop 032725 constant label dcl 3528 in procedure "macro_unquote" ref 3548 loop 016740 constant label dcl 1797 in procedure "macro_af" ref 1820 1828 1836 loop 031220 constant label dcl 3297 in procedure "macro_scan" ref 3342 loop 030606 constant label dcl 3203 in procedure "macro_quote" ref 3223 loop 031053 constant label dcl 3244 in begin block on line 3239 ref 3259 loop 034031 constant label dcl 3753 in procedure "strip2" ref 3771 loop 022640 constant label dcl 2369 in procedure "macro_error" ref 2430 loop1 015605 constant label dcl 1629 ref 1665 macdef 006656 constant label dcl 541 ref 534 macdef_err 006725 constant label dcl 558 ref 565 576 macnest_err 006661 constant label dcl 545 macro_ 002216 constant entry external dcl 13 ref 1986 macro_af 016656 constant entry internal dcl 1768 ref 371 macro_call 017314 constant entry internal dcl 1879 ref 436 macro_define 020316 constant entry internal dcl 2027 ref 491 macro_do 021164 constant entry internal dcl 2129 ref 512 2192 macro_empty 021725 constant entry internal dcl 2230 ref 452 macro_error 022445 constant entry internal dcl 2317 ref 455 macro_if 023424 constant entry internal dcl 2441 ref 515 2563 macro_length 024711 constant entry internal dcl 2584 ref 497 macro_let 025211 constant entry internal dcl 2651 ref 500 503 506 509 macro_quote 030557 constant entry internal dcl 3175 ref 475 macro_scan 031140 constant entry internal dcl 3267 ref 488 macro_substr 031626 constant entry internal dcl 3349 ref 494 macro_unquote 032676 constant entry internal dcl 3500 ref 478 macro_usage 033155 constant entry internal dcl 3587 ref 472 misplaced 003357 constant label dcl 191 ref 524 1818 3429 no_mend 007144 constant label dcl 585 ref 591 nother_logical 023522 constant label dcl 2478 ref 2515 od 021642 constant label dcl 2210 ref 2200 pcf 004347 constant entry external dcl 4389 pcn 004312 constant entry external dcl 4377 protected 033517 constant entry internal dcl 3661 ref 377 2194 2571 quit 003305 constant label dcl 183 ref 485 retry 010542 constant label dcl 837 ref 957 1024 show_string 033650 constant entry internal dcl 3709 ref 815 1586 1652 1654 1974 2111 3101 3163 3331 skip 021443 constant label dcl 2182 ref 2156 2203 skip_again 024074 constant label dcl 2503 ref 2521 skipper 024533 constant entry internal dcl 2550 ref 2499 2517 2530 start 002376 constant label dcl 67 ref 25 40 strip 034024 constant entry internal dcl 3743 ref 1478 1553 1629 1791 1908 2018 2052 2077 2153 2178 2212 2250 2273 2343 2360 2471 2495 2509 2527 2544 2610 2686 2772 2803 2929 2954 3022 3034 3200 3292 3376 3525 3616 3804 strip2 034012 constant entry internal dcl 3738 ref 367 2280 2388 2634 2777 2959 3069 3225 3316 3431 3550 3640 syntax_err 003645 constant label dcl 235 set ref 4050 type 000071 constant label array(4) dcl 1935 in procedure "macro_call" ref 1933 type 000000 constant label array(28) dcl 766 in procedure "arithmetic" ref 764 766 852 884 type 000066 constant label array(3) dcl 1815 in procedure "macro_af" ref 1813 type 000050 constant label array(7) dcl 1575 in procedure "logical" ref 1573 use_char 033142 constant label dcl 3574 ref 3566 var_bound 034173 constant entry internal dcl 3779 ref 447 449 var_range 034617 constant entry internal dcl 3877 ref 443 var_ref 035557 constant entry internal dcl 4058 ref 606 variable 005372 constant label dcl 396 watch 004404 constant entry external dcl 4402 xdw_ 002231 constant entry external dcl 13 NAMES DECLARED BY CONTEXT OR IMPLICATION. before builtin function ref 1327 1327 1339 1339 codeptr builtin function ref 1257 1257 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 42052 42174 41370 42062 Length 42670 41370 122 460 462 50 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME macro_ 848 external procedure is an external procedure. addmacro 132 internal procedure is called by several nonquick procedures. ampersand 1758 internal procedure calls itself recursively. arg_range internal procedure shares stack frame of internal procedure ampersand. arithmetic 640 internal procedure is called by several nonquick procedures. cvt internal procedure shares stack frame of internal procedure dumper. dumper 168 internal procedure is called by several nonquick procedures. error_missing 330 internal procedure is called during a stack extension. expand 86 internal procedure is called by several nonquick procedures. find_macro internal procedure shares stack frame of external procedure macro_. free_um internal procedure shares stack frame of external procedure macro_. get_area internal procedure shares stack frame of external procedure macro_. get_range internal procedure shares stack frame of internal procedure ampersand. get_token 75 internal procedure is called by several nonquick procedures. lineno 79 internal procedure is called by several nonquick procedures. logical 123 internal procedure is called by several nonquick procedures. lookup internal procedure shares stack frame of internal procedure ampersand. macro_af internal procedure shares stack frame of internal procedure ampersand. begin block on line 1848 begin block shares stack frame of internal procedure ampersand. macro_call internal procedure shares stack frame of internal procedure ampersand. begin block on line 1966 124 begin block uses auto adjustable storage. macro_define internal procedure shares stack frame of internal procedure ampersand. macro_do 100 internal procedure calls itself recursively. macro_empty internal procedure shares stack frame of internal procedure ampersand. macro_error internal procedure shares stack frame of internal procedure ampersand. macro_if 180 internal procedure calls itself recursively. skipper internal procedure shares stack frame of internal procedure macro_if. macro_length internal procedure shares stack frame of internal procedure ampersand. macro_let internal procedure shares stack frame of internal procedure ampersand. macro_quote internal procedure shares stack frame of internal procedure ampersand. begin block on line 3239 69 begin block uses auto adjustable storage. macro_scan internal procedure shares stack frame of internal procedure ampersand. begin block on line 3324 126 begin block uses auto adjustable storage. macro_substr internal procedure shares stack frame of internal procedure ampersand. begin block on line 3410 246 begin block uses auto adjustable storage. macro_unquote internal procedure shares stack frame of internal procedure ampersand. macro_usage internal procedure shares stack frame of internal procedure ampersand. protected 84 internal procedure is called by several nonquick procedures. show_string 90 internal procedure is called during a stack extension. strip2 84 internal procedure is called by several nonquick procedures. var_bound internal procedure shares stack frame of internal procedure ampersand. var_range internal procedure shares stack frame of internal procedure ampersand. var_ref internal procedure shares stack frame of internal procedure ampersand. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 al_sw macro_ 000011 db_sw macro_ 000012 err_ct macro_ 000020 ext_var_ptr macro_ 000022 free_area_p macro_ 000024 int_vars_base macro_ 000026 lg_sw macro_ 000030 macro_list_p macro_ 000032 macro_nest macro_ 000033 pc_sw macro_ 000034 watchword macro_ 000044 who_am_i macro_ 000050 relat logical 000054 cmd macro_let STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ampersand 000100 begl ampersand 000101 i ampersand 000102 ii ampersand 000112 begl arg_range 000113 i arg_range 000114 j arg_range 000115 ii arg_range 000116 jj arg_range 000117 separator arg_range 000176 ii get_range 000214 begl macro_af 000215 i macro_af 000216 ii macro_af 000217 level macro_af 000220 rval begin block on line 1848 000426 begl macro_call 000427 i macro_call 000430 j macro_call 000431 ii macro_call 000432 loc macro_call 000576 sep_ct macro_call 000577 level macro_call 000600 argstrl macro_call 000601 callseg macro_call 000612 callmac macro_call 000632 begl macro_define 000633 i macro_define 000634 j macro_define 000635 ii macro_define 000644 begl macro_empty 000645 i macro_empty 000646 vname macro_empty 000666 begl macro_error 000667 i macro_error 000670 ii macro_error 000700 begl macro_length 000701 i macro_length 000702 ii macro_length 000704 ch8 macro_length 000714 begl macro_let 000715 i macro_let 000716 j macro_let 000717 jj macro_let 000720 vname macro_let 000732 vptr macro_let 000734 found macro_let 000735 lower macro_let 000736 higher macro_let 000750 begl macro_quote 000751 i macro_quote 000752 j macro_quote 000753 ii macro_quote 000762 begl macro_scan 000763 i macro_scan 000764 ii macro_scan 000765 argstrl macro_scan 000774 begl macro_substr 000775 i macro_substr 000776 j macro_substr 000777 ii macro_substr 001000 jj macro_substr 001001 argstrl macro_substr 001010 begl macro_unquote 001011 i macro_unquote 001012 ii macro_unquote 001013 inside macro_unquote 001014 ch macro_unquote 001024 begl macro_usage 001025 i macro_usage 001026 ii macro_usage 001027 ctl macro_usage 001061 ret_str macro_usage 001161 ret_len macro_usage 001170 i var_bound 001171 j var_bound 001172 ii var_bound 001173 vname var_bound 001212 begl var_range 001213 i var_range 001214 j var_range 001215 ii var_range 001216 jj var_range 001217 separator var_range 001266 vptr var_range 001270 limit var_range 001300 begl var_ref 001301 j var_ref arithmetic 000100 begl arithmetic 000101 i arithmetic 000102 j arithmetic 000103 ii arithmetic 000104 jj arithmetic 000105 level arithmetic 000106 vl arithmetic 000107 sl arithmetic 000110 val arithmetic 000564 stk arithmetic 000610 ch60 arithmetic 000630 v arithmetic begin block on line 1966 000100 args begin block on line 1966 000100 argstr begin block on line 1966 begin block on line 3239 000100 argstr begin block on line 3239 begin block on line 3324 000100 argstr begin block on line 3324 begin block on line 3410 000100 sepch begin block on line 3410 000100 argstr begin block on line 3410 dumper 000106 res cvt 000117 i cvt 000120 ch cvt error_missing 000100 hold error_missing 000473 cline error_missing 000476 eline error_missing expand 000100 i expand 000101 ii expand lineno 000100 cv6 lineno 000103 j lineno 000104 line lineno 000105 e lineno logical 000100 begl logical 000101 i logical 000102 j logical 000103 ii logical 000104 jj logical 000105 kk logical 000106 rel logical macro_ 000100 num macro_ 000102 refp macro_ 000104 ref_path macro_ 000156 dname macro_ 000230 ename macro_ 000240 end_sym macro_ 000244 var_ptr macro_ 000246 arr_ptr macro_ 000250 arr_elem macro_ 000252 int_var_ptr macro_ 000254 maclp macro_ 000264 bc macro_ 000265 c32 macro_ 000276 c32x macro_ 000307 call_err macro_ 000310 ch_2nd macro_ 000311 construct_nest macro_ 000312 i macro_ 000314 local_var_ptr macro_ 000316 macro_holder_l macro_ 000320 macro_holder_p macro_ 000322 msg_etc macro_ 000715 myname macro_ 000726 save_db macro_ 000727 sege macro_ 000730 segi macro_ 000732 segptr macro_ 000734 segtype macro_ 000737 start_sym macro_ 000742 tptr macro_ 000744 tr_sw macro_ 000745 mac_sw macro_ 000762 search_for find_macro 001012 ai get_area macro_do 000100 begl macro_do 000101 i macro_do 000102 ii macro_do 000103 jj macro_do 000104 tf macro_do macro_if 000100 begl macro_if 000101 beglt macro_if 000102 i macro_if 000103 TF macro_if 000104 if_lineno macro_if 000107 elseif macro_if protected 000100 begl protected 000101 i protected show_string 000100 i show_string 000101 j show_string 000102 k show_string 000103 HT_sw show_string strip2 000100 i strip2 THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_l_a r_e_as set_stack alloc_cs cat_realloc_cs enter_begin leave_begin call_ext_in call_ext_out_desc call_ext_out call_int_this call_int_other_desc call_int_other return tra_ext alloc_auto_adj mod_fx1 signal shorten_stack ext_entry ext_entry_desc int_entry int_entry_desc set_cs_eis index_cs_eis any_to_any_tr alloc_based free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$evaluate_active_string define_area_ hcs_$fs_get_path_name hcs_$initiate_count hcs_$make_ptr ioa_ ioa_$nnl ioa_$rsnpnnl iox_$put_chars release_area_ search_paths_$find_dir THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badsyntax error_table_$no_search_list error_table_$translation_aborted error_table_$translation_failed iox_$error_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 13 002206 18 002241 19 002246 21 002262 22 002267 23 002271 24 002273 25 002276 27 002277 31 002317 33 002334 34 002341 35 002362 36 002364 37 002366 38 002371 39 002373 40 002375 67 002376 70 002404 71 002407 73 002410 74 002421 76 002433 79 002442 80 002447 81 002503 82 002515 83 002517 85 002520 86 002522 87 002525 88 002526 90 002530 91 002532 95 002543 98 002545 99 002553 102 002560 104 002600 105 002607 107 002616 110 002622 114 002652 117 002662 118 002664 119 002666 120 002670 123 002671 124 002674 126 002703 128 002727 129 002734 130 002743 131 002757 133 002766 136 002772 139 003016 142 003033 143 003035 144 003037 145 003041 148 003042 151 003045 153 003062 155 003063 159 003071 160 003073 162 003075 166 003102 167 003104 169 003107 172 003120 174 003165 175 003175 176 003235 177 003237 180 003257 181 003261 182 003262 183 003305 188 003354 191 003357 193 003366 194 003400 196 003412 198 003415 202 003433 205 003440 206 003451 208 003464 209 003500 210 003512 211 003524 212 003550 215 003552 217 003573 220 003601 221 003610 225 003622 227 003625 228 003627 229 003633 231 003642 232 003644 235 003645 237 003670 238 003703 4168 003704 4176 003714 4179 003721 4180 003723 4181 003727 4182 003732 4183 003737 4184 003741 4186 003770 4187 003774 4188 003777 4189 004003 4191 004026 4192 004030 4193 004031 4194 004033 4196 004066 4197 004072 4198 004074 4201 004107 4205 004145 4206 004150 4207 004153 4210 004157 4211 004161 4213 004203 4215 004210 4217 004233 4218 004235 4219 004236 4220 004245 4222 004250 4223 004252 4224 004263 4225 004264 4369 004265 4371 004273 4372 004276 4373 004277 4375 004305 4376 004310 4377 004311 4379 004317 4380 004322 4381 004323 4383 004331 4384 004334 4385 004335 4387 004343 4388 004345 4389 004346 4391 004354 4392 004356 4393 004357 4395 004365 4396 004367 4397 004370 4399 004376 4400 004400 4402 004401 4406 004417 4407 004426 244 004427 255 004435 258 004476 259 004507 263 004532 267 004544 269 004563 271 004564 272 004574 273 004606 275 004611 276 004614 277 004623 279 004653 280 004663 281 004667 282 004674 283 004701 284 004703 285 004705 286 004711 287 004714 288 004716 293 004761 299 004762 320 004770 321 004773 323 005022 326 005026 327 005036 329 005041 330 005054 333 005055 334 005060 335 005072 338 005073 339 005100 341 005101 342 005103 345 005107 346 005123 348 005125 351 005126 352 005134 355 005160 358 005162 359 005164 360 005216 361 005227 362 005231 364 005232 367 005237 371 005255 374 005300 377 005324 380 005346 383 005350 384 005354 387 005355 390 005357 391 005366 392 005367 393 005371 396 005372 399 005410 401 005414 404 005416 407 005420 408 005430 409 005442 411 005445 412 005455 414 005456 417 005464 418 005466 420 005503 423 005506 426 005513 427 005515 428 005522 432 005533 435 005550 436 005552 437 005572 439 005573 442 005600 443 005602 444 005622 447 005623 449 005651 452 005677 455 005725 458 005753 461 005760 462 005777 465 006000 466 006006 468 006031 469 006036 472 006037 475 006065 478 006113 481 006141 484 006146 485 006151 488 006154 491 006202 494 006230 497 006256 500 006304 503 006335 506 006367 509 006421 512 006453 515 006502 518 006531 523 006567 524 006610 526 006621 529 006622 532 006627 533 006633 534 006640 536 006641 539 006646 540 006652 541 006656 545 006661 547 006667 548 006701 552 006713 554 006716 555 006720 558 006725 560 006757 561 006760 562 006762 565 007004 567 007005 570 007007 571 007016 572 007046 573 007047 574 007051 575 007066 576 007070 578 007075 579 007076 582 007141 585 007144 587 007153 588 007165 589 007177 590 007230 591 007231 597 007262 599 007316 602 007411 603 007421 606 007422 607 007442 609 007445 612 007446 613 007455 614 007467 615 007501 619 007504 625 007505 650 007507 651 007511 652 007513 653 007515 654 007521 655 007546 656 007552 659 007562 660 007563 661 007564 662 007607 665 007610 666 007617 668 007641 671 007644 672 007646 673 007663 674 007665 676 007666 679 007676 680 007712 681 007714 683 007715 684 007742 686 007743 689 007753 691 007754 693 007762 694 007771 695 010000 696 010016 697 010020 700 010024 701 010032 703 010034 704 010036 707 010037 709 010061 715 010062 740 010070 741 010075 743 010124 744 010127 745 010134 746 010135 747 010137 748 010141 750 010164 753 010165 754 010175 756 010200 759 010202 760 010204 761 010216 762 010220 764 010221 766 010233 770 010243 771 010270 773 010271 776 010300 777 010301 778 010302 779 010303 781 010304 789 010307 790 010312 793 010321 794 010322 795 010323 796 010325 798 010327 800 010332 803 010337 804 010341 807 010342 808 010344 809 010345 811 010347 814 010354 815 010426 817 010462 818 010463 824 010475 825 010511 828 010512 831 010532 833 010537 835 010541 837 010542 842 010547 843 010603 844 010613 845 010637 846 010641 847 010654 848 010663 849 010703 850 010705 852 010720 855 010724 857 010746 859 010753 860 010754 861 010773 862 010774 863 010777 864 011003 866 011004 870 011010 872 011012 881 011022 882 011023 884 011024 886 011027 901 011033 904 011043 905 011054 906 011064 907 011076 908 011117 909 011131 912 011134 918 011140 920 011142 923 011144 924 011145 925 011153 926 011154 928 011157 930 011163 931 011164 932 011167 934 011170 938 011174 939 011175 940 011200 942 011201 946 011215 947 011220 950 011221 954 011236 955 011242 956 011244 957 011247 960 011250 964 011264 965 011267 968 011270 972 011304 973 011307 976 011310 980 011324 981 011327 984 011330 988 011344 989 011347 992 011350 996 011364 997 011367 1001 011370 1004 011400 1006 011401 1009 011411 1011 011412 1014 011422 1016 011423 1019 011433 1021 011435 1022 011443 1023 011445 1024 011450 1027 011451 1032 011454 1033 011456 1034 011461 1036 011462 1038 011463 1046 011465 1047 011470 1048 011544 1049 011554 1050 011556 1056 011557 1067 011561 1068 011565 1069 011601 1070 011610 1072 011615 1073 011624 1074 011626 1075 011635 1083 011645 1093 011653 1097 011771 1103 011772 1113 012006 1114 012013 1115 012030 1117 012031 1120 012045 1121 012052 1123 012053 1126 012067 1127 012074 1128 012111 1130 012112 1133 012126 1134 012136 1136 012137 1139 012153 1140 012160 1141 012175 1143 012176 1145 012210 1146 012222 1148 012234 1150 012244 1151 012257 1152 012271 1153 012303 1154 012315 1155 012327 1157 012341 1158 012353 1159 012362 1160 012376 1161 012405 1164 012413 1165 012425 1166 012437 1168 012446 1169 012455 1170 012457 1178 012462 1197 012470 1199 012520 1200 012524 1201 012544 1203 012552 1204 012554 1207 012556 1208 012572 1209 012576 1211 012577 1213 012602 1214 012603 1215 012630 1217 012634 1218 012635 1224 012636 1240 012640 1242 012655 1243 012662 1245 012720 1247 012731 1248 012764 1250 013022 1252 013102 1257 013107 1261 013174 1265 013241 1267 013322 1268 013323 1271 013325 1273 013377 1276 013405 1279 013407 1280 013416 1281 013430 1282 013437 1283 013453 1284 013455 1286 013456 1287 013460 1288 013463 1291 013465 1293 013530 1294 013564 1297 013567 1298 013576 1300 013614 1301 013626 1302 013640 1303 013664 1304 013673 1305 013705 1306 013707 1308 013710 1309 013713 1314 013737 1315 013740 1319 013757 1322 013760 1323 014014 1326 014016 1327 014021 1329 014067 1339 014076 1344 014150 1350 014151 1355 014153 1356 014160 1357 014162 1358 014165 1361 014170 1364 014173 1365 014222 1368 014260 1371 014265 1373 014317 1376 014325 1379 014333 1380 014335 1383 014405 1384 014415 1387 014424 1391 014472 1393 014504 1395 014506 1397 014536 1398 014540 1400 014541 1406 014542 1409 014543 1410 014545 1411 014546 1412 014550 1413 014556 1414 014560 1415 014562 1416 014575 1421 014600 1427 014601 1445 014603 1448 014616 1449 014620 1451 014621 1452 014623 1453 014645 1454 014673 1455 014675 1458 014704 1459 014706 1460 014727 1461 014751 1464 014753 1470 014754 1478 014762 1479 014776 1482 015006 1483 015010 1485 015011 1486 015027 1488 015034 1490 015040 1492 015047 1498 015050 1509 015056 1510 015057 1511 015062 1512 015070 1513 015075 1514 015076 1515 015115 1517 015122 1518 015123 1519 015124 1520 015154 1528 015163 1551 015171 1552 015174 1553 015176 1554 015211 1555 015214 1557 015237 1560 015240 1562 015250 1564 015253 1567 015255 1568 015257 1569 015271 1570 015273 1572 015274 1573 015306 1575 015307 1580 015317 1581 015321 1584 015327 1586 015405 1588 015441 1589 015442 1590 015445 1592 015452 1595 015474 1597 015526 1598 015531 1600 015532 1601 015557 1602 015560 1611 015564 1612 015565 1613 015566 1614 015567 1617 015571 1618 015572 1619 015600 1620 015601 1622 015602 1628 015603 1629 015605 1631 015621 1632 015643 1634 015644 1637 015646 1638 015650 1639 015662 1640 015664 1642 015665 1645 015676 1646 015701 1647 015703 1650 015710 1652 015766 1653 016020 1654 016043 1656 016077 1657 016100 1658 016103 1662 016110 1664 016112 1665 016137 1667 016140 1670 016171 1671 016175 1673 016176 1676 016227 1677 016233 1679 016234 1682 016265 1683 016271 1685 016272 1688 016324 1689 016330 1691 016331 1694 016363 1695 016367 1697 016370 1700 016421 1701 016425 1709 016426 1716 016430 1717 016434 1718 016441 1720 016454 1721 016456 1725 016457 1728 016463 1729 016466 1730 016473 1732 016503 1733 016505 1734 016506 1735 016515 1738 016555 1739 016561 1740 016564 1741 016573 1744 016574 1746 016601 1747 016607 1749 016622 1750 016624 1754 016625 1755 016630 1756 016635 1758 016650 1759 016652 1761 016653 1768 016656 1789 016660 1790 016662 1791 016664 1792 016700 1794 016731 1795 016734 1796 016736 1797 016740 1799 016763 1802 016764 1803 016773 1805 017015 1808 017020 1809 017022 1810 017037 1811 017041 1813 017042 1815 017057 1818 017104 1820 017115 1822 017116 1825 017124 1826 017125 1827 017126 1828 017127 1830 017130 1833 017136 1834 017137 1835 017140 1836 017142 1839 017144 1840 017147 1841 017151 1844 017156 1845 017160 1856 017161 1859 017232 1862 017236 1863 017247 1864 017257 1865 017274 1867 017277 1868 017302 1869 017311 1871 017313 1879 017314 1905 017316 1906 017320 1907 017326 1908 017333 1909 017347 1911 017400 1912 017403 1913 017410 1914 017413 1915 017415 1916 017416 1917 017420 1919 017443 1922 017444 1923 017453 1924 017511 1925 017512 1928 017515 1929 017517 1930 017534 1931 017536 1933 017537 1935 017554 1938 017601 1940 017602 1943 017610 1944 017611 1945 017612 1946 017613 1948 017614 1951 017622 1952 017623 1953 017624 1954 017626 1957 017630 1958 017633 1959 017636 1960 017641 1963 017643 1964 017652 1966 017655 1967 017660 1968 017666 1969 017675 1972 017703 1974 017765 1976 020020 1977 020021 1978 020043 1979 020047 1981 020053 1982 020064 1983 020074 1984 020101 1985 020106 1986 020110 1988 020150 1990 020201 1993 020205 1994 020211 1995 020213 1997 020216 1998 020217 2000 020220 2003 020226 2004 020227 2005 020230 2008 020233 2011 020236 2012 020246 2013 020261 2014 020273 2016 020276 2017 020277 2018 020302 2020 020315 2027 020316 2050 020320 2051 020322 2052 020324 2053 020340 2055 020371 2056 020374 2057 020376 2059 020420 2062 020421 2063 020431 2065 020453 2068 020456 2069 020460 2070 020475 2071 020477 2073 020500 2076 020510 2077 020512 2078 020525 2081 020535 2082 020540 2083 020562 2086 020600 2089 020601 2092 020624 2095 020627 2096 020637 2098 020662 2099 020664 2100 020701 2101 020703 2103 020710 2104 020713 2105 020725 2106 020735 2109 020742 2111 021023 2114 021046 2116 021125 2117 021126 2118 021131 2119 021134 2121 021135 2122 021162 2129 021163 2151 021171 2152 021174 2153 021176 2154 021211 2156 021242 2158 021250 2159 021252 2160 021253 2161 021255 2163 021304 2166 021312 2167 021315 2168 021317 2169 021324 2170 021345 2171 021361 2174 021367 2175 021375 2177 021420 2178 021424 2179 021437 2182 021443 2184 021465 2187 021466 2188 021475 2190 021517 2191 021524 2192 021537 2194 021572 2196 021622 2199 021627 2200 021630 2202 021631 2203 021633 2205 021634 2207 021635 2210 021642 2212 021645 2213 021660 2216 021662 2217 021665 2219 021666 2220 021671 2222 021672 2223 021701 2224 021724 2230 021725 2248 021727 2249 021731 2250 021733 2251 021747 2253 022000 2255 022023 2257 022030 2260 022032 2261 022042 2263 022064 2264 022101 2267 022104 2268 022113 2269 022125 2270 022137 2272 022161 2273 022164 2274 022177 2277 022207 2278 022216 2280 022240 2281 022254 2282 022260 2285 022261 2286 022270 2287 022302 2288 022314 2290 022337 2293 022343 2294 022351 2295 022363 2296 022375 2298 022420 2299 022425 2302 022430 2303 022433 2305 022436 2308 022441 2309 022443 2311 022444 2317 022445 2341 022447 2342 022451 2343 022453 2344 022467 2346 022520 2347 022523 2348 022527 2349 022530 2350 022532 2352 022553 2356 022574 2358 022600 2360 022603 2361 022616 2364 022626 2366 022634 2367 022636 2368 022637 2369 022640 2371 022662 2374 022663 2375 022672 2377 022714 2380 022717 2381 022721 2382 022736 2383 022740 2385 022741 2388 022751 2389 022764 2390 023000 2391 023002 2392 023011 2394 023026 2398 023043 2399 023055 2400 023065 2402 023077 2403 023111 2404 023123 2405 023136 2406 023150 2407 023177 2408 023206 2410 023233 2411 023237 2412 023246 2414 023274 2417 023277 2418 023307 2419 023322 2420 023334 2421 023347 2422 023361 2423 023363 2425 023366 2426 023371 2427 023374 2429 023375 2430 023422 2441 023423 2469 023431 2470 023435 2471 023437 2472 023452 2473 023460 2475 023510 2476 023511 2478 023522 2480 023544 2482 023554 2486 023652 2487 023666 2490 023674 2491 023703 2493 023726 2494 023731 2495 023734 2496 023747 2497 023751 2499 024001 2500 024002 2503 024074 2505 024077 2508 024105 2509 024107 2510 024122 2513 024126 2514 024131 2515 024133 2517 024134 2518 024135 2521 024217 2523 024220 2526 024225 2527 024227 2528 024242 2530 024272 2531 024273 2534 024365 2536 024370 2539 024376 2540 024404 2542 024426 2543 024431 2544 024434 2545 024447 2548 024532 2550 024533 2554 024534 2555 024556 2558 024557 2559 024561 2561 024562 2562 024565 2563 024600 2565 024633 2567 024641 2569 024647 2571 024655 2573 024705 2574 024707 2576 024710 2584 024711 2608 024713 2609 024715 2610 024717 2611 024733 2613 024764 2614 024767 2615 024771 2617 025013 2620 025014 2621 025023 2623 025045 2626 025050 2627 025052 2628 025067 2629 025071 2631 025072 2634 025102 2635 025115 2636 025130 2637 025132 2638 025142 2639 025155 2640 025157 2641 025162 2643 025163 2644 025210 2651 025211 2684 025213 2685 025215 2686 025217 2687 025233 2689 025263 2691 025277 2694 025300 2695 025310 2697 025332 2699 025355 2701 025363 2702 025365 2703 025375 2706 025400 2707 025410 2709 025413 2717 025414 2718 025421 2721 025430 2722 025440 2723 025452 2724 025464 2726 025467 2727 025471 2728 025475 2731 025500 2732 025507 2734 025544 2735 025552 2736 025554 2737 025556 2738 025557 2741 025563 2742 025566 2743 025570 2745 025616 2746 025617 2749 025621 2750 025624 2751 025627 2754 025664 2757 025665 2758 025667 2759 025671 2762 025721 2763 025722 2766 025724 2767 025734 2768 025746 2769 025760 2771 025763 2772 025766 2773 026002 2777 026014 2778 026027 2780 026030 2783 026037 2784 026041 2787 026045 2788 026050 2791 026051 2792 026053 2793 026055 2795 026057 2796 026103 2799 026113 2800 026122 2802 026144 2803 026146 2804 026161 2805 026164 2808 026167 2811 026172 2814 026174 2815 026203 2817 026206 2819 026210 2822 026213 2823 026216 2824 026222 2825 026235 2826 026237 2829 026305 2830 026320 2831 026325 2832 026326 2833 026330 2835 026332 2838 026342 2839 026344 2842 026347 2846 026364 2849 026374 2850 026406 2851 026420 2853 026423 2856 026424 2857 026430 2858 026434 2860 026437 2861 026440 2864 026446 2865 026450 2868 026453 2870 026463 2873 026464 2874 026470 2875 026473 2877 026474 2878 026475 2881 026477 2882 026501 2885 026504 2888 026520 2891 026521 2892 026525 2893 026530 2895 026531 2896 026532 2899 026534 2900 026536 2903 026541 2906 026555 2909 026556 2910 026562 2911 026565 2913 026566 2916 026567 2919 026572 2922 026606 2925 026607 2926 026613 2929 026615 2930 026631 2933 026632 2936 026640 2938 026647 2940 026652 2941 026654 2944 026657 2945 026666 2947 026671 2950 026676 2951 026705 2954 026710 2955 026724 2959 026736 2960 026751 2962 026752 2965 026753 2968 026762 2969 026771 2971 026774 2974 026776 2975 027000 2978 027006 2979 027015 2980 027027 2981 027041 2983 027044 2986 027045 2987 027054 2989 027057 2990 027060 2992 027066 2995 027071 2996 027073 2999 027076 3000 027105 3001 027117 3002 027131 3004 027134 3007 027135 3008 027144 3010 027147 3013 027154 3016 027164 3017 027173 3021 027215 3022 027217 3023 027232 3024 027235 3027 027244 3028 027254 3030 027276 3033 027306 3034 027327 3035 027343 3038 027344 3039 027346 3041 027370 3044 027371 3045 027400 3047 027422 3050 027425 3051 027427 3052 027444 3053 027446 3055 027447 3058 027457 3059 027504 3061 027505 3063 027510 3066 027520 3067 027527 3069 027551 3070 027565 3073 027572 3074 027576 3075 027601 3078 027604 3081 027607 3084 027611 3087 027644 3089 027653 3090 027657 3091 027673 3095 027733 3096 027750 3099 027755 3101 030043 3104 030067 3107 030070 3108 030072 3111 030074 3112 030101 3114 030106 3117 030111 3118 030122 3121 030140 3122 030142 3124 030143 3125 030145 3128 030152 3130 030161 3132 030164 3134 030170 3136 030206 3139 030213 3142 030221 3146 030264 3148 030277 3149 030305 3151 030324 3155 030373 3156 030412 3157 030414 3160 030421 3163 030520 3165 030552 3168 030553 3169 030556 3175 030557 3198 030561 3199 030563 3200 030565 3201 030601 3202 030604 3203 030606 3205 030630 3208 030631 3209 030640 3211 030662 3214 030665 3215 030667 3216 030704 3217 030705 3219 030706 3222 030716 3223 030743 3225 030744 3226 030757 3227 030763 3230 030765 3231 030775 3233 031000 3234 031003 3237 031020 3239 031021 3240 031024 3241 031034 3242 031047 3243 031051 3244 031053 3246 031074 3248 031101 3249 031114 3250 031116 3251 031117 3254 031124 3255 031127 3257 031130 3259 031136 3261 031137 3267 031140 3290 031142 3291 031144 3292 031146 3293 031162 3295 031213 3296 031216 3297 031220 3299 031242 3302 031243 3303 031252 3305 031274 3308 031277 3309 031301 3310 031316 3311 031320 3313 031321 3316 031331 3317 031344 3318 031350 3321 031352 3322 031362 3324 031365 3325 031370 3326 031400 3329 031406 3331 031461 3333 031514 3334 031515 3335 031533 3336 031536 3337 031570 3338 031574 3341 031577 3342 031625 3349 031626 3374 031630 3375 031632 3376 031634 3377 031650 3379 031701 3380 031704 3381 031706 3383 031731 3386 031732 3387 031741 3389 031763 3392 031766 3393 031770 3394 032005 3395 032007 3397 032010 3400 032020 3401 032045 3403 032046 3404 032051 3407 032053 3408 032063 3410 032066 3411 032071 3413 032101 3414 032114 3415 032116 3416 032120 3417 032141 3418 032163 3419 032165 3420 032170 3423 032203 3424 032204 3425 032206 3426 032227 3427 032251 3429 032254 3431 032266 3432 032303 3435 032312 3437 032317 3439 032326 3442 032330 3445 032333 3446 032343 3448 032346 3451 032350 3452 032360 3454 032363 3456 032366 3459 032370 3460 032375 3463 032376 3464 032405 3465 032407 3466 032412 3467 032413 3469 032415 3472 032420 3473 032430 3475 032433 3478 032435 3479 032445 3480 032475 3481 032504 3482 032540 3483 032552 3484 032606 3485 032615 3486 032630 3487 032637 3489 032642 3490 032666 3492 032671 3493 032672 3494 032675 3500 032676 3523 032700 3524 032702 3525 032704 3526 032720 3527 032723 3528 032725 3530 032747 3533 032750 3534 032757 3536 033001 3539 033004 3540 033006 3541 033023 3542 033024 3544 033025 3547 033035 3548 033062 3550 033063 3551 033076 3552 033101 3553 033103 3554 033104 3555 033113 3556 033122 3559 033125 3562 033127 3565 033133 3566 033134 3568 033135 3569 033136 3570 033137 3571 033141 3574 033142 3576 033143 3578 033147 3579 033151 3581 033154 3587 033155 3614 033157 3615 033161 3616 033163 3617 033177 3619 033230 3620 033233 3621 033235 3623 033257 3626 033260 3627 033267 3629 033311 3632 033314 3633 033316 3634 033333 3635 033335 3637 033336 3640 033346 3641 033361 3642 033376 3643 033400 3645 033411 3647 033446 3648 033456 3649 033457 3650 033465 3651 033467 3653 033470 3654 033515 3661 033516 3683 033524 3684 033527 3685 033531 3686 033532 3687 033554 3690 033555 3691 033564 3693 033606 3694 033610 3695 033625 3696 033627 3697 033632 3699 033636 3700 033642 3701 033644 3702 033645 3703 033646 3709 033647 3716 033670 3717 033672 3718 033675 3719 033715 3722 033716 3723 033722 3724 033723 3725 033724 3726 033726 3727 033730 3728 033763 3729 033766 3730 033767 3732 034010 3738 034011 3741 034017 3743 034022 3753 034031 3755 034054 3757 034061 3758 034064 3760 034071 3761 034106 3763 034112 3764 034130 3767 034131 3768 034140 3770 034165 3771 034172 3779 034173 3803 034175 3804 034177 3805 034213 3807 034235 3810 034236 3811 034246 3812 034260 3813 034272 3815 034275 3818 034277 3819 034301 3820 034313 3821 034315 3823 034316 3826 034323 3827 034350 3829 034351 3830 034365 3831 034367 3832 034373 3835 034374 3836 034404 3837 034416 3838 034430 3840 034433 3843 034437 3844 034446 3845 034460 3846 034472 3848 034475 3849 034477 3854 034505 3856 034515 3858 034517 3862 034524 3863 034533 3864 034545 3865 034557 3867 034572 3868 034601 3869 034613 3871 034616 3877 034617 3904 034621 3905 034623 3906 034625 3907 034640 3910 034641 3911 034651 3913 034654 3916 034660 3917 034667 3918 034701 3919 034713 3921 034716 3922 034717 3923 034721 3924 034723 3925 034725 3926 034730 3927 034754 3928 034757 3929 034762 3932 034770 3935 034776 3938 035001 3939 035010 3940 035022 3941 035034 3943 035037 3946 035041 3947 035050 3948 035062 3949 035074 3951 035077 3954 035102 3955 035107 3958 035111 3960 035120 3961 035132 3962 035144 3964 035147 3967 035150 3968 035155 3971 035157 3973 035166 3974 035200 3975 035212 3978 035215 3981 035216 3984 035222 3985 035231 3987 035234 3990 035237 3991 035246 3995 035251 3996 035255 3999 035265 4001 035266 4002 035311 4005 035312 4006 035321 4008 035343 4011 035346 4012 035350 4013 035365 4014 035367 4016 035370 4019 035400 4020 035414 4021 035416 4023 035417 4024 035444 4026 035445 4029 035455 4031 035456 4033 035464 4034 035467 4035 035472 4036 035476 4037 035510 4038 035523 4039 035525 4042 035530 4043 035536 4045 035540 4046 035542 4049 035543 4050 035553 4052 035556 4058 035557 4081 035561 4083 035567 4084 035571 4085 035604 4088 035605 4089 035615 4090 035627 4091 035641 4093 035644 4096 035650 4099 035714 4100 035731 4101 035734 4104 035735 4105 035737 4108 035741 4111 035744 4112 035753 4113 035765 4114 035777 4116 036002 4117 036006 4121 036065 4122 036103 4123 036106 4124 036110 4127 036155 4128 036170 4129 036171 4132 036173 4135 036176 4136 036205 4137 036217 4138 036231 4140 036234 4141 036236 4145 036315 4146 036333 4147 036336 4148 036341 4151 036406 4152 036421 4155 036422 4156 036431 4157 036443 4158 036455 4161 036460 ----------------------------------------------------------- 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