COMPILATION LISTING OF SEGMENT macro_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 02/14/84 0852.0 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 /**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16 */ 11 /**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo */ 12 /**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend */ 13 /**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt */ 14 /** FUTURE &fileout name ... &filend */ 15 16 macro_: proc (sl_name, segname, macname, out_ptr, out_len, arglp, argct, msg, 17 refseg, ecode); 18 19 segtype = "MACRO"; 20 if (sl_name = "macro") 21 then who_am_i = "MACRO"; 22 else who_am_i = "EXPANSION"; 23 mac_sw = "1"b; 24 segptr = null (); 25 refp = refseg; 26 goto start; 27 28 expand: 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 "; 35 myname = myname || segtype; 36 mac_sw = "0"b; 37 refp = null (); 38 segptr = strptr; 39 segi = 1; 40 sege = strlen; 41 goto start; 42 43 dcl sl_name char (32) var, /* search list name */ 44 segname char (32) var, /* name of segment to find */ 45 /* "" -> not specified */ 46 macname char (32) var, /* name of macro to expand */ 47 /* "" -> expanding a string */ 48 out_ptr ptr, /* output string (not aligned) */ 49 out_len fixed bin (24), /* length of output produced (Out) */ 50 arglp ptr, /* pointer to argument list */ 51 argct fixed bin, /* number of arguments */ 52 msg char (1000) var, /* error message text */ 53 refseg ptr, /* pointer to referencing segment */ 54 strptr ptr, /* pointer to string to expand */ 55 strlen fixed bin (24), /* length of string to expand */ 56 57 ecode fixed bin (35); 58 59 dcl 1 argl (24) based (arglp), 60 2 p ptr, 61 2 l fixed bin (24); 62 dcl arg char (argl.l (num)) based (argl.p (num)); 63 dcl num fixed bin (24); 64 dcl refp ptr; 65 66 start: 67 if free_area_p = null () 68 then call get_area; 69 local_var_ptr, int_var_ptr = null (); 70 msg_etc = ""; 71 72 do num = 1 to argct; 73 if (argl.l (num) < 0) 74 then signal condition (argleng_less_than_zero); 75 if (argl.l (num) > 500) 76 then do; 77 msg = "ARG "; 78 msg = msg || ltrim (char (num)); 79 msg = msg || " >500 characters."; 80 ecode = -1; 81 return; 82 end; 83 end; 84 msg = ""; 85 ecode = 0; 86 macro_nest = macro_nest + 1; 87 88 save_db = db_sw; 89 if (segtype = "STRING") | (segptr ^= null ()) 90 then goto doit; 91 92 /* name = "macro" | "foo$foo" | "foo$bar" */ 93 if mac_sw 94 then do; 95 c32 = segname; 96 if (c32 = "") 97 then do; 98 if db_sw 99 then call ioa_ (""""" ^a", macname); 100 myname = macname; 101 do maclp = macro_list_p 102 repeat (macro_list.next) 103 while (maclp ^= null ()); 104 if macro_list.int_mac 105 then do; 106 if db_sw 107 then call ioa_ (" ^a/^a", substr (macro_list.dname, 1, 1), 108 macro_list.name); 109 if (macro_list.name = macname) 110 then do; 111 segptr = macro_list.ref; 112 segi = macro_list.from; 113 sege = macro_list.to; 114 goto doit; 115 end; 116 end; 117 end; 118 c32 = macname; /* didn't find an imbedded macro by */ 119 end; /* this name, try for macro$macro. */ 120 if db_sw 121 then call ioa_ ("^a$^a", c32, macname); 122 myname = c32; 123 myname = myname || "$"; 124 myname = myname || macname; 125 do maclp = macro_list_p 126 repeat (macro_list.next) 127 while (maclp ^= null ()); 128 if ^macro_list.int_mac 129 then do; 130 if db_sw 131 then call ioa_ (" ^a/^a", macro_list.ename, macro_list.name); 132 if (macro_list.ename = c32) & (macro_list.name = macname) 133 then do; 134 segptr = macro_list.ref; 135 segi = macro_list.from; 136 sege = macro_list.to; 137 goto doit; 138 end; 139 end; 140 end; 141 end; 142 143 call find_macro (refp, segname, sl_name, macname); 144 145 doit: 146 tr_sw = "0"b; 147 if (substr (segment, segi, 7) = "&trace 148 ") 149 then do; 150 segi = segi + 7; 151 tr_sw = "1"b; 152 end; 153 if (substr (segment, segi, 7) = "&debug 154 ") 155 then do; 156 segi = segi + 7; 157 db_sw = "1"b; 158 end; 159 if db_sw | pc_sw | tr_sw | al_sw 160 then do; 161 call ioa_ ("^[EXPAND^s^;^a^](^i) ^a", (who_am_i = "EXPANSION"), 162 segtype, macro_nest, macname); 163 do num = 1 to argct; 164 call ioa_ ("ARG^2i: ""^va""", num, argl.l (num), arg); 165 end; 166 if (argct = 0) 167 then call ioa_ ("ARGs: none"); 168 end; 169 construct_nest = 1; 170 call_err = "0"b; 171 call expand (segptr, segi, sege, out_ptr, out_len, "11"b); 172 quit: 173 if db_sw | pc_sw | tr_sw | al_sw 174 then call ioa_ (" ^[MEND^;EXPEND^](^i) ^a", (who_am_i = "MACRO"), 175 macro_nest, macname); 176 177 if (segi < sege) 178 then do; 179 misplaced: 180 msg = "Misplaced """; 181 msg = msg || c32; 182 msg = msg || """. "; 183 184 add_identification: 185 ecode = error_table_$badsyntax; 186 add_id: 187 if call_err 188 then msg = msg || " 189 from"; 190 if segtype = "MACRO" 191 then do; 192 msg = msg || " "; 193 msg = msg || who_am_i; 194 end; 195 msg = msg || " """; 196 msg = msg || myname; 197 msg = msg || """, line "; 198 msg = msg || lineno (segi); 199 if ^call_err 200 then do; 201 msg = " 202 ERROR SEVERITY 4. " || msg; 203 if (msg_etc ^= "") 204 then do; 205 msg = msg || NL; 206 msg = msg || msg_etc; 207 end; 208 end; 209 end; 210 exit: 211 macro_nest = macro_nest - 1; 212 tptr = local_var_ptr; 213 call free_um ("loc"); 214 if (err_ct (3) ^= 0) & (err_ct (4) = 0) 215 then ecode = error_table_$translation_failed; 216 db_sw = save_db; 217 return; 218 219 220 syntax_err: 221 msg = "Syntax error in " || msg; 222 msg = msg || ". "; 223 goto add_identification; 224 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 225 /* */ 226 /* add a macro to the list of known macros */ 227 228 addmacro: proc (dname, segname, macname, int_mac, segp, segi, sege); 229 230 dcl dname char (168), 231 segname char (32) var, 232 macname char (32) var, 233 int_mac bit (1), /* 1- is ¯o/&define */ 234 segp ptr, 235 segi fixed bin (24), 236 sege fixed bin (24); 237 238 if db_sw 239 then call ioa_ ("addmacro ^a > ^a (^p) ^a^[ INTERNAL^]", 240 dname, segname, segp, macname, int_mac); 241 do maclp = macro_list_p 242 repeat (macro_list.next) 243 while (maclp ^= null ()); 244 if (macro_list.ename = segname) & (macro_list.name = macname) 245 & (macro_list.int_mac = int_mac) 246 then do; 247 if (segptr = macro_list.ref) 248 & (segi = macro_list.from) 249 & (sege = macro_list.to) 250 then do; 251 if db_sw 252 then call ioa_ (" already there"); 253 return; 254 end; 255 msg = who_am_i; 256 msg = msg || " already defined."; 257 goto add_identification; 258 end; 259 end; 260 allocate macro_list in (free_area); 261 if al_sw 262 then call ioa_ ("A macro_list ^i ^p", size (macro_list), maclp); 263 macro_list.name = macname; 264 macro_list.ref = segp; 265 macro_list.dname = dname; 266 macro_list.ename = segname; 267 macro_list.from = segi; 268 macro_list.to = sege; 269 macro_list.int_mac = int_mac; 270 macro_list.next = macro_list_p; 271 macro_list_p = maclp; 272 if db_sw then call ioa_ ("addmac ^16a ^p ^i:^i^/^-^a > ^a", 273 macro_list.name, macro_list.ref, macro_list.from, macro_list.to, 274 macro_list.dname, macro_list.ename); 275 276 end addmacro; 277 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 278 /* */ 279 /* An ampersand has been found, handle it. */ 280 281 ampersand: proc (ifp, ifi, ife, ofp, ofe, TF, err_sw) recursive; 282 283 dcl ifp ptr, /* pointer to input */ 284 ifi fixed bin (24), /* first char of input to use */ 285 ife fixed bin (24), /* last char of input to use */ 286 ofp ptr, /* pointer to output */ 287 ofe fixed bin (24), /* last char of output used */ 288 TF bit (2), 289 err_sw bit (1); /* 0- misplaced are error */ 290 /* 1- misplaced no sweat */ 291 dcl begl fixed bin (24); 292 dcl inputa (ife) char (1) based (ifp); 293 dcl input char (ife) based (ifp); 294 dcl output char (ofe) based (ofp); 295 dcl (i, j, ii, jj) fixed bin (24); 296 297 298 begl = ifi; 299 if db_sw then call dumper ("ampr", ifp, ifi, ife, ofp, ofe, TF); 300 if (ifi >= ife) 301 then do; 302 msg = "Orphan &."; 303 goto add_identification; 304 end; 305 i = index ("0123456789", inputa (ifi + 1)); 306 if (i ^= 0) 307 then do; 308 num = i - 1; 309 i = index ("0123456789", inputa (ifi + 2)); 310 if (i ^= 0) 311 then do; 312 num = num * 10 + i - 1; 313 ifi = ifi + 1; 314 end; 315 ifi = ifi + 2; 316 if (num <= argct) 317 then call putout(ofp, ofe, arg); 318 end; 319 else do; 320 ch_2nd = inputa (ifi + 1); 321 if (ch_2nd = "{") 322 then call arg_range (ifp, ifi, ife, ofp, ofe, TF); 323 324 else if (ch_2nd = "*") 325 then do; 326 ifi = ifi + 2; 327 call putout (ofp, ofe, ltrim (char (argct))); 328 end; 329 330 else if (ch_2nd = ".") /* &. null separator */ 331 then ifi = ifi + 2; 332 333 else if (ch_2nd = "+") /* &+ null separator, */ 334 then call strip2 (ifp, ifi, ife); /* grabs trailing space */ 335 336 else if (ch_2nd = "[") 337 then call macro_af (ifp, ifi, ife, ofp, ofe, TF); 338 339 else if (ch_2nd = "(") 340 then call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 341 342 else if (ch_2nd = """") 343 then call protected (ifp, ifi, ife, ofp, ofe); 344 345 else if (ch_2nd = ";") 346 then do; 347 c32 = "&;"; 348 return; 349 end; 350 351 else if (ch_2nd = "&") 352 then do; 353 ifi = ifi + 2; 354 call putout (ofp, out_len, "&"); 355 end; 356 else do; 357 variable: 358 i = verify (substr (input, ifi + 1), token_chars); 359 360 if (i = 0) 361 then i = ife - ifi + 1; 362 if (i > 1) 363 then do; 364 if (i > 26) 365 then do; 366 msg = who_am_i; 367 msg = msg || " name > 26 chars."; 368 goto add_identification; 369 end; 370 c32 = substr (input, ifi + 1, i - 1); 371 c32x = ""; 372 373 if (inputa (ifi + i) = "$") 374 then do; 375 ifi = ifi + i; 376 ii = verify (substr (input, ifi + 1), token_chars); 377 if (ii = 0) 378 then i = 0; /* error */ 379 else if (inputa (ifi + ii) = "(") 380 then do; 381 i = ii; 382 c32x = c32; 383 c32 = substr (input, ifi + 1, i - 1); 384 end; 385 end; 386 387 if (inputa (ifi + i) = "(") & (ife > ifi + i) 388 then do; 389 ifi = ifi + i + 1; 390 call macro_call (ifp, ifi, ife, ofp, ofe, TF); 391 end; 392 393 else if (inputa (ifi + i) = "{") & (ife > ifi + i) 394 then do; 395 ifi = ifi + i + 1; 396 call var_range (ifp, ifi, ife, ofp, ofe, TF); 397 end; 398 399 /* arg */ 400 else if (c32 = "lbound") 401 then call var_bound (ifp, ifi, ife, ofp, ofe, TF); 402 else if (c32 = "hbound") 403 then call var_bound (ifp, ifi, ife, ofp, ofe, TF); 404 405 else if (c32 = "empty") 406 then call macro_empty (ifp, ifi, ife, ofp, ofe, TF); 407 408 else if (c32 = "error") 409 then call macro_error (ifp, ifi, ife, ofp, ofe, TF); 410 411 else if (c32 = "comment") 412 then do; 413 i = index (substr (input, ifi), "&;"); 414 if (i = 0) 415 then do; 416 msg = "&;"; 417 call error_missing ("comment", begl, ife); 418 end; 419 ifi = ifi + i + 1; 420 return; 421 end; 422 423 else if (c32 = "usage") 424 then call macro_usage (ifp, ifi, ife, ofp, ofe, TF); 425 426 else if (c32 = "quote") 427 then call macro_quote (ifp, ifi, ife, ofp, ofe, TF); 428 429 else if (c32 = "unquote") 430 then call macro_unquote (ifp, ifi, ife, ofp, ofe, TF); 431 432 else if (c32 = "return") 433 then do; 434 segi = sege + 1; 435 goto quit; 436 end; 437 438 else if (c32 = "scan") 439 then call macro_scan (ifp, ifi, ife, ofp, ofe, TF); 440 441 else if (c32 = "define") 442 then call macro_define (ifp, ifi, ife, ofp, ofe, TF); 443 444 else if (c32 = "substr") 445 then call macro_substr (ifp, ifi, ife, ofp, ofe, TF); 446 447 else if (c32 = "length") 448 then call macro_length (ifp, ifi, ife, ofp, ofe, TF); 449 450 else if (c32 = "let") 451 then call macro_let (ifp, ifi, ife, ofp, ofe, TF, 0); 452 453 else if (c32 = "ext") 454 then call macro_let (ifp, ifi, ife, ofp, ofe, TF, 1); 455 456 else if (c32 = "int") 457 then call macro_let (ifp, ifi, ife, ofp, ofe, TF, 2); 458 459 else if (c32 = "loc") 460 then call macro_let (ifp, ifi, ife, ofp, ofe, TF, 3); 461 462 else if (c32 = "do") 463 then call macro_do (ifp, ifi, ife, ofp, ofe, TF); 464 465 else if (c32 = "if") 466 then call macro_if (ifp, ifi, ife, ofp, ofe, TF); 467 468 else if (c32 = "od") 469 | (c32 = "fi") 470 | (c32 = "then") 471 | (c32 = "else") 472 | (c32 = "elseif") 473 | (c32 = "while") 474 then do; 475 c32 = "&" || c32; 476 if ^err_sw 477 then goto misplaced; 478 return; 479 end; 480 481 else if (c32 = "expand") 482 then do; 483 start_sym = "expand"; 484 end_sym = "expend"; 485 goto macdef; 486 end; 487 else if (c32 = "macro") 488 then do; 489 start_sym = "macro"; 490 end_sym = "mend"; 491 macdef: 492 if construct_nest > 1 493 then do; 494 macnest_err: 495 msg = "&"; 496 msg = msg || start_sym; 497 msg = msg || " may not be nested in any other construct."; 498 goto add_id; 499 end; 500 ifi = ifi + i; 501 if (substr (input, ifi, 1) ^= " ") 502 then do; 503 macdef_err: 504 call error_syntax ((start_sym), begl, ifi); 505 end; 506 ifi = ifi + 1; 507 i = verify (substr (input, ifi), 508 "abcdefghijklmnopqrstuvwxyz" || 509 "ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"); 510 if (i = 0) 511 then goto macdef_err; 512 if (i < 2) 513 then do; 514 msg = "name"; 515 call error_missing ((start_sym), begl, ifi); 516 end; 517 i = i - 1; 518 c32 = substr (input, ifi, i); 519 ifi = ifi + i; 520 if (inputa (ifi) ^= NL) 521 then goto macdef_err; 522 ifi = ifi + 1; 523 i = index (substr (input, ifi), "&" || end_sym || NL); 524 if (i = 0) 525 then do; 526 no_mend: 527 msg = "&"; 528 msg = msg || end_sym; 529 msg = msg || ""; 530 call error_missing ((start_sym), begl, ife); 531 end; 532 if (index (substr (input, ifi, i - 1), "¯o ") ^= 0) 533 | (index (substr (input, ifi, i - 1), "&expand ") ^= 0) 534 then goto no_mend; 535 call hcs_$fs_get_path_name (ifp, dname, 0, ename, 0); 536 call addmacro (" &" || start_sym || " in " || myname, "", 537 c32, "1"b, ifp, ifi, ifi + i - 2); 538 ifi = ifi + i + length (end_sym) + 1; 539 end; 540 else do; 541 call var_ref (ifp, ifi, ife, ofp, ofe, TF); 542 ifi = ifi + i; 543 end; 544 end; 545 else do; 546 msg = "Unrecognized &control """; 547 msg = msg || c32; 548 msg = msg || """. "; 549 goto add_identification; 550 end; 551 end; 552 end; 553 end ampersand; 554 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 555 /* */ 556 /* parse an argument range specification. */ 557 558 arg_range: proc (ifp, ifi, ife, ofp, ofe, TF); 559 560 dcl ifp ptr, /* pointer to input */ 561 ifi fixed bin (24), /* first char of input to use */ 562 ife fixed bin (24), /* last char of input to use */ 563 ofp ptr, /* pointer to output */ 564 ofe fixed bin (24), /* last char of output used */ 565 TF bit (2); 566 dcl begl fixed bin (24); 567 dcl inputa (ife) char (1) based (ifp); 568 dcl input char (ife) based (ifp); 569 dcl output char (ofe) based (ofp); 570 dcl (i, j, ii, jj) fixed bin (24); 571 dcl separator char (150) var; 572 573 /* &{ ARITH } yields argument ARITH */ 574 /* &{ ARITH : ARITH } yields arguments ARITH thru ARITH */ 575 /* separated by a SP */ 576 /* &{ ARITH : ARITH , STRING } yields arguments ARITH thru ARITH */ 577 /* separated by STRING */ 578 579 begl = ifi; 580 ii = ofe; 581 i = 1; 582 j = argct; 583 call get_range (ifp, ifi, ife, ofp, ofe, TF, i, j); 584 separator = " "; 585 if (inputa (ifi) = ",") 586 then do; 587 ifi = ifi + 1; 588 do while ("1"b); 589 jj = search (substr (input, ifi), "&}"); 590 if (jj = 0) 591 then do; 592 msg = "}"; 593 call error_missing ("{", begl, ife); 594 end; 595 if (jj > 1) 596 then do; 597 jj = jj - 1; 598 call putout (ofp, ofe, substr (input, ifi, jj)); 599 ifi = ifi + jj; 600 end; 601 if (inputa (ifi) = "}") 602 then do; 603 separator = substr (output, ii + 1, ofe - ii); 604 ofe = ii; 605 goto end_range; 606 end; 607 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 608 end; 609 end; 610 if (inputa (ifi) = "}") 611 then do; 612 end_range: 613 ifi = ifi + 1; 614 if (TF = "00"b) 615 then return; 616 j = min (j, argct); 617 do num = i to j; 618 call putout (ofp, ofe, arg); 619 if (num ^= j) 620 then call putout (ofp, ofe, (separator)); 621 end; 622 end; 623 else do; 624 call error_syntax ("{", begl, ifi); 625 end; 626 end arg_range; 627 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 628 /* */ 629 /* process an arithmetic expression. */ 630 631 arithmetic: proc (ifp, ifi, ife, ofp, ofe, TF); 632 633 dcl ifp ptr, /* pointer to input */ 634 ifi fixed bin (24), /* first char of input to use */ 635 ife fixed bin (24), /* last char of input to use */ 636 ofp ptr, /* pointer to output */ 637 ofe fixed bin (24), /* last char of output used */ 638 TF bit (2); 639 dcl begl fixed bin (24); 640 dcl inputa (ife) char (1) based (ifp); 641 dcl input char (ife) based (ifp); 642 dcl output char (ofe) based (ofp); 643 dcl (i, j, ii, jj) fixed bin (24); 644 dcl level fixed bin (24); 645 dcl (vl, sl) fixed bin (24); 646 dcl val (20) fixed dec (59, 9); 647 dcl stk (20) fixed bin (24); 648 dcl pic60 pic "(49)-9v.(9)9"; 649 dcl v fixed dec (59, 9); 650 651 ifi, begl = ifi + 2; 652 if db_sw then call dumper ("arth", ifp, ifi, ife, ofp, ofe, TF); 653 ii = ofe; 654 call putout (ofp, ofe, "("); 655 level = 1; 656 construct_nest = construct_nest + 1; 657 loop: 658 i = search (substr (input, ifi), "&(),:}"); 659 if (i = 0) 660 then do; 661 msg = "Missing arithmetic terminator. "; 662 goto add_identification; 663 end; 664 if (i > 1) 665 then do; 666 i = i - 1; 667 call putout (ofp, ofe, substr (input, ifi, i)); 668 ifi = ifi + i; 669 end; 670 goto type (index ("&(),:}", inputa (ifi))); 671 672 type (1): /* & */ /* */ 673 if (substr (input, ifi, 2) = "&;") 674 then goto type (4); /* It stops scan, but is not used up */ 675 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 676 goto loop; 677 678 type (2): /* ( */ /* */ 679 call putout (ofp, ofe, "("); 680 level = level + 1; 681 ifi = ifi + 1; 682 goto loop; 683 684 type (4): /* , */ /* */ 685 type (5): /* : */ /* */ 686 type (6): /* } */ /* */ 687 if (level > 1) 688 then goto arith_err; 689 ifi = ifi - 1; /* don't want to use up this char */ 690 type (3): /* ) */ /* */ 691 call putout (ofp, ofe, ")"); 692 ifi = ifi + 1; 693 level = level - 1; 694 if (level > 0) 695 then goto loop; 696 construct_nest = construct_nest - 1; 697 698 if (TF = "00"b) 699 then do; 700 ofe = ii; 701 return; 702 end; 703 704 sl = 1; 705 vl = 0; 706 stk (1) = 16; 707 708 if db_sw | tr_sw 709 then do; 710 call ioa_$nnl ("#^a:^a^-arith ", lineno (begl), lineno (ifi - 1)); 711 call show_string (substr (output, ii + 1), NL); 712 end; 713 do i = ii + 1 to ofe; 714 /* format: off */ 715 /* "---------1111111111222222 22 2 */ 716 /* "---------0123456789012345 67 8 */ 717 dcl arithchar char (28) int static init ("0123456789(=^=<=>=+-*/) ."" 718 "); /* format: on */ 719 j = index (arithchar, substr (output, i, 1)); 720 if (j = 0) 721 then do; 722 jj = verify (substr (output, i), 723 "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"); 724 if (jj = 0) 725 then jj = ife - ifi + 1; 726 if (jj = 1) 727 then goto arith_err; 728 goto arith_err; 729 end; 730 retry: 731 if lg_sw 732 then if db_sw 733 then do; 734 call ioa_ ("^3i :^1a:", i, substr (output, i, 1)); 735 do jj = 1 to sl; 736 call ioa_$nnl (" ^1a", 737 substr (arithchar, stk (jj), 1)); 738 end; 739 call ioa_ ("."); 740 do jj = 1 to vl; 741 call ioa_$nnl (" ^f", val (jj)); 742 end; 743 call ioa_ ("#"); 744 end; 745 if (j > 10) 746 then goto type (j); 747 748 type (26): /* decimal point */ 749 jj = verify (substr (output, i), ".0123456789") - 1; 750 if (jj < 0) 751 then jj = ofe - i + 1; 752 vl = vl + 1; 753 val (vl) = convert (val (1), substr (output, i, jj)); 754 sl = sl + 1; 755 stk (sl) = 10; 756 i = i + jj - 1; 757 goto endloop; 758 759 type (23): /* ) */ /* */ 760 if (stk (sl) ^= 10) 761 then goto arith_err; 762 goto calc (stk (sl - 1)); 763 764 type (13): /* ^ */ /* */ 765 type (15): /* < */ /* */ 766 type (17): /* > */ /* */ 767 if (substr (output, i + 1, 1) = "=") 768 then do; 769 i = i + 1; 770 j = j + 1; 771 end; 772 if (j = 13) 773 then goto type (11); 774 type (14): /* ^= */ /* */ 775 type (16): /* <= */ /* */ 776 type (18): /* >= */ /* */ 777 type (12): /* = */ /* */ 778 type (21): /* * */ /* */ 779 type (22): /* / */ /* */ 780 if (stk (sl) ^= 10) 781 then do; 782 type (27): /* quoted string not handled yet */ 783 arith_err: 784 msg = "Arithmetic syntax error. "; 785 msg = msg || substr (arithchar, stk (sl), 1); 786 msg = msg || substr (arithchar, j, 1); 787 msg = msg || " """; 788 msg = msg || substr (output, ii + 1, i - ii); 789 msg = msg || """ "; 790 goto add_identification; 791 end; 792 793 type (19): /* + */ /* */ 794 type (20): /* - */ /* */ 795 if (stk (sl) = 21) 796 then goto arith_err; 797 if (stk (sl) = 22) 798 then goto arith_err; 799 if (stk (sl) > 10) 800 then do; 801 vl = vl + 1; 802 val (vl) = 0; 803 sl = sl + 1; 804 stk (sl) = 10; 805 end; 806 if (stk (sl - 1) >= j) 807 then goto calc (stk (sl - 1)); 808 sl = sl + 1; 809 stk (sl) = j; 810 goto endloop; 811 812 type (11): /* ( */ /* */ 813 if (stk (sl) = 10) 814 then goto arith_err; 815 sl = sl + 1; 816 stk (sl) = j; 817 goto endloop; 818 819 calc (12): /* = */ /* */ 820 if (val (vl - 1) = val (vl)) 821 then v = 1; 822 else v = 0; 823 goto calc_common; 824 825 826 calc (13): /* ^ */ /* */ 827 if (val (vl) = 0) 828 then val (vl) = 1; 829 else val (vl) = 0; 830 sl = sl - 1; 831 stk (sl) = 10; 832 goto retry; 833 834 835 calc (14): /* ^= */ /* */ 836 if (val (vl - 1) ^= val (vl)) 837 then v = 1; 838 else v = 0; 839 goto calc_common; 840 841 842 calc (15): /* < */ /* */ 843 if (val (vl - 1) < val (vl)) 844 then v = 1; 845 else v = 0; 846 goto calc_common; 847 848 849 calc (16): /* <= */ /* */ 850 if (val (vl - 1) <= val (vl)) 851 then v = 1; 852 else v = 0; 853 goto calc_common; 854 855 856 calc (17): /* > */ /* */ 857 if (val (vl - 1) > val (vl)) 858 then v = 1; 859 else v = 0; 860 goto calc_common; 861 862 863 calc (18): /* >= */ /* */ 864 if (val (vl - 1) >= val (vl)) 865 then v = 1; 866 else v = 0; 867 goto calc_common; 868 869 870 871 calc (19): /* + */ /* */ 872 v = val (vl - 1) + val (vl); 873 goto calc_common; 874 875 calc (20): /* - */ /* */ 876 v = val (vl - 1) - val (vl); 877 goto calc_common; 878 879 calc (21): /* * */ /* */ 880 v = val (vl - 1) * val (vl); 881 goto calc_common; 882 883 calc (22): /* / */ /* */ 884 v = val (vl - 1) / val (vl); 885 calc_common: 886 vl = vl - 1; 887 val (vl) = v; 888 sl = sl - 2; 889 stk (sl) = 10; 890 goto retry; 891 892 893 calc (11): /* ( */ /* */ 894 if (j = 23) 895 then do; 896 sl = sl - 1; 897 stk (sl) = 10; 898 goto endloop; 899 end; 900 goto arith_err; 901 902 type (24): /* SP */ /* */ 903 type (25): /* HT */ /* */ 904 type (28): /* NL */ /* */ 905 endloop: 906 end; 907 ofe = ii; 908 call putout (ofp, ofe, 909 ltrim (rtrim (rtrim (convert (pic60, val (1)), "0"), "."))); 910 end arithmetic; 911 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 912 /* */ 913 /* convert a text string for debug display. */ 914 915 cvt: proc (ifp, ifi, ife) returns (char (32) var); 916 917 dcl res char (32) var; 918 dcl ifp ptr; 919 dcl (ifi, ife) fixed bin (24); 920 dcl i fixed bin (24); 921 dcl begl fixed bin (24); 922 dcl inputa (ife) char (1) based (ifp); 923 dcl ch char (1); 924 925 res = """"; 926 do i = ifi to min (ifi + 15, ife); 927 ch = inputa (i); 928 if (ch < " ") 929 then ch = "~"; 930 res = res || ch; 931 end; 932 res = res || """"; 933 return (res); 934 935 end cvt; 936 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 937 /* */ 938 /* show a bunch of debugging information. */ 939 940 dumper: proc (text, ifp, ifi, ife, ofp, ofe, TF); 941 942 dcl text char (4), 943 ifp ptr, 944 (ifi, ife) fixed bin (24), 945 ofp ptr, 946 ofe fixed bin (24), 947 TF bit (2); 948 949 call ioa_ ("^2i.^2i ^4a TF^.1b ^i:^i ^i^-^a - ^a", macro_nest, 950 construct_nest, text, TF, ifi, ife, ofe, 951 cvt (ifp, ifi, ife), cvt (ofp, max (1, ofe - 15), ofe)); 952 953 end dumper; 954 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 955 /* */ 956 /* ERROR MESSAGE procs */ 957 958 error_missing: proc (who, begl, endl); 959 960 dcl who char (*), 961 begl fixed bin (24), 962 endl fixed bin (24); 963 964 dcl hold char (1000) var; 965 dcl (cline, eline) char (6) var; 966 967 hold = "Missing "; 968 hold = hold || msg; 969 goto common; 970 971 error_syntax: entry (who, begl, endl); 972 973 hold = "Syntax error"; 974 goto common; 975 976 error_misplaced: entry (who, begl, endl); 977 978 hold = "Misplaced "; 979 hold = hold || msg; 980 goto common; 981 982 error_gen: entry (who, begl, endl); 983 984 hold = msg; 985 goto common; 986 987 error_attempt: entry (who, begl, endl); 988 989 hold = "Attempt to "; 990 hold = hold || msg; 991 goto common; 992 993 common: 994 hold = hold || " in """; 995 cline = lineno (begl); 996 eline = lineno (endl); 997 998 msg = " 999 ERROR SEVERITY 4. "; 1000 msg = msg || who_am_i; 1001 msg = msg || " """; 1002 msg = msg || myname; 1003 msg = msg || """, line "; 1004 msg = msg || eline; 1005 msg = msg || ". 1006 "; 1007 msg = msg || hold; 1008 msg = msg || "&"; 1009 msg = msg || who; 1010 msg = msg || """"; 1011 if (eline ^= cline) 1012 then do; 1013 msg = msg || " (on line "; 1014 msg = msg || cline; 1015 msg = msg || ")"; 1016 end; 1017 msg = msg || "."; 1018 ecode = error_table_$badsyntax; 1019 goto exit; 1020 1021 end error_missing; 1022 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1023 /* */ 1024 /* expand a specified string */ 1025 1026 expand: proc (ifp, ifi, ife, ofp, ofe, tf); 1027 1028 dcl ifp ptr, /* pointer to input */ 1029 ifi fixed bin (24), /* first char of input to use */ 1030 ife fixed bin (24), /* last char of input to use */ 1031 ofp ptr, /* pointer to output */ 1032 ofe fixed bin (24), /* last char of output used */ 1033 tf bit (2); 1034 dcl begl fixed bin (24); 1035 dcl inputa (ife) char (1) based (ifp); 1036 dcl input char (ife) based (ifp); 1037 dcl output char (ofe) based (ofp); 1038 dcl (i, j, ii, jj) fixed bin (24); 1039 1040 1041 if db_sw then call dumper ("expn", ifp, ifi, ife, ofp, ofe, tf); 1042 do while (ifi <= ife); 1043 i = index (substr (input, ifi), "&"); 1044 if (i = 0) 1045 then i = ife - ifi + 1; 1046 else i = i - 1; 1047 if (i > 0) 1048 then do; 1049 call putout (ofp, out_len, substr (input, ifi, i)); 1050 ifi = ifi + i; 1051 end; 1052 if (ifi > ife) 1053 then return; 1054 ii = ifi; 1055 call ampersand (ifp, ifi, ife, ofp, ofe, tf, "1"b); 1056 if (ii = ifi) 1057 then return; 1058 end; 1059 end expand; 1060 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1061 /* */ 1062 /* search for the macro specified */ 1063 1064 find_macro: proc (refp, segname, suffix, macname); 1065 dcl refp ptr, 1066 segname char (32) var, 1067 suffix char (32) var, 1068 macname char (32) var; 1069 1070 dcl initiate_file_ entry (char(*), char(*), bit(*), ptr, fixed bin(24), 1071 fixed bin(35)); 1072 dcl search_paths_$find_dir entry (char (*), ptr, char (*), char (*), char (*), 1073 fixed bin (35)); 1074 dcl search_for char (35) var; 1075 1076 if (segname = "") 1077 then search_for = macname; 1078 else search_for = segname; 1079 search_for = search_for || "." || suffix; 1080 1081 if (refp = null ()) 1082 then ref_path = ""; 1083 else call hcs_$fs_get_path_name (refp, ref_path, 0, "", 0); 1084 if db_sw 1085 then call ioa_ ("find_macro ^a ^a (^a)", search_for, macname, ref_path); 1086 call search_paths_$find_dir ((suffix), null (), (search_for), ref_path, 1087 dname, ecode); 1088 if (ecode = error_table_$no_search_list) 1089 then do; 1090 dcl hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35)); 1091 here: call hcs_$make_ptr (codeptr (here), suffix || ".search", 1092 suffix || ".search", segptr, ecode); /* fudge a little */ 1093 if (segptr = null ()) 1094 then call com_err_ (0, (suffix), 1095 "Default search segment not in same directory as object segment."); 1096 else call search_paths_$find_dir ((suffix), null (), (search_for), 1097 ref_path, dname, ecode); 1098 end; 1099 if (ecode = 0) 1100 then call initiate_file_ (dname, (search_for), "100"b, segptr, bc, 1101 ecode); 1102 if (ecode ^= 0) 1103 then do; 1104 msg = "No definition segment found. "; 1105 msg = msg || search_for; 1106 msg = msg || "$"; 1107 msg = msg || macname; 1108 ecode = -1; 1109 goto exit; 1110 end; 1111 segi = 1; 1112 sege = divide (bc, 9, 24, 0); 1113 if mac_sw 1114 then do; 1115 if (suffix = "macro") 1116 then i = index (seg, "¯o " || macname || NL); 1117 else i = index (seg, "&expand " || macname || NL); 1118 if (i = 0) 1119 then do; 1120 msg = "No definition found for """; 1121 bad_mac: 1122 msg = msg || macname; 1123 msg = msg || """ "; 1124 msg = msg || "in "; 1125 msg = msg || rtrim (dname); 1126 msg = msg || ">"; 1127 msg = msg || search_for; 1128 ecode = -1; 1129 goto exit; 1130 end; 1131 segi = i + length (macname) + 8; 1132 if (suffix = "macro") 1133 then i = index (substr (seg, segi), "&mend 1134 "); 1135 else do; 1136 segi = segi + 1; /* &expand 1 char>than ¯o */ 1137 i = index (substr (seg, segi), "&expend 1138 "); 1139 end; 1140 if (i = 0) 1141 then do; 1142 if (suffix = "macro") 1143 then msg = "&mend"; 1144 else msg = "&expand"; 1145 msg = msg || " missing on """; 1146 goto bad_mac; 1147 end; 1148 1149 sege = segi + i - 2; 1150 call addmacro (dname, before (search_for, "."), (macname), "0"b, 1151 segptr, segi, sege); 1152 if (segname = "") 1153 then do; 1154 1155 /* now all that is fine and dandy, but we don't want to let &b() find an */ 1156 /* external b$b because nothing has been internally defined and then later */ 1157 /* have the same thing find a different macro because there now has been an */ 1158 /* internal macro/define encountered. So we dummy up a pseudo-internal entry */ 1159 /* to nip such a thing in the bud. */ 1160 1161 call addmacro ("", before (search_for, "."), (macname), "1"b, 1162 segptr, segi, sege); 1163 end; 1164 end; 1165 1166 end find_macro; 1167 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1168 /* */ 1169 /* free all the storage used */ 1170 1171 free_um: proc (which); 1172 1173 dcl which char (3); 1174 1175 do while (tptr ^= null ()); 1176 var_ptr = tptr; 1177 tptr = var.next; 1178 if (var.type = 0) 1179 then do; 1180 if db_sw 1181 then do; 1182 call ioa_ ("^p ^a ^a", var_ptr, which, var.name); 1183 if var.ref ^= null () 1184 then call ioa_ (" ^p ""^a""", var.ref, 1185 vartext); 1186 end; 1187 if (var.ref ^= null ()) 1188 then do; 1189 if al_sw then call ioa_ ("F ^p ""^a""", var.ref, 1190 vartext); 1191 free vartext in (free_area); 1192 end; 1193 end; 1194 if (var.type >= 1) & (var.type <= 5) 1195 then do; 1196 arr_ptr = var.ref; 1197 if db_sw 1198 then call ioa_ ("^p ^a ^a{^i:^i}", var_ptr, which, 1199 var.name, array.lower, array.lower + var.len - 1); 1200 do arr_elem = 1 to var.len; 1201 if (array.ref (arr_elem) ^= null ()) 1202 then do; 1203 if al_sw 1204 then call ioa_ ("^p {^i} ""^a""", 1205 array.ref (arr_elem), 1206 -array.lower + arr_elem - 1, arrtext); 1207 free arrtext in (free_area); 1208 end; 1209 end; 1210 end; 1211 if al_sw then call ioa_ ("F var-^a ^p", var.name, var_ptr); 1212 free var in (free_area); 1213 end; 1214 1215 end free_um; 1216 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1217 /* */ 1218 /* set up an area */ 1219 1220 get_area: proc; 1221 1222 ai.version = area_info_version_1; 1223 string (ai.control) = "0"b; 1224 ai.extend = "1"b; 1225 ai.owner = sl_name; 1226 ai.size = 2000; 1227 ai.areap = null (); 1228 call define_area_ (addr (ai), ecode); 1229 free_area_p = ai.areap; 1230 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 */ 1231 1232 dcl 1 ai like area_info; 1233 1234 end get_area; 1235 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1236 /* */ 1237 /* parse an array range specification. */ 1238 1239 get_range: proc (ifp, ifi, ife, ofp, ofe, TF, i, j); 1240 1241 dcl ifp ptr, /* pointer to input */ 1242 ifi fixed bin (24), /* first char of input to use */ 1243 ife fixed bin (24), /* last char of input to use */ 1244 ofp ptr, /* pointer to output */ 1245 ofe fixed bin (24), /* last char of output used */ 1246 TF bit (2); 1247 dcl begl fixed bin (24); 1248 dcl inputa (ife) char (1) based (ifp); 1249 dcl input char (ife) based (ifp); 1250 dcl output char (ofe) based (ofp); 1251 dcl (i, j, ii, jj) fixed bin (24); 1252 1253 if (inputa (ifi + 2) = "}") 1254 | (inputa (ifi + 2) = ",") 1255 then do; 1256 ifi = ifi + 2; 1257 return; 1258 end; 1259 ii = ofe; 1260 call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 1261 i, j = fixed (substr (output, ii + 1, ofe - ii)); 1262 ofe = ii; 1263 if (inputa (ifi) = ":") 1264 then do; 1265 ifi = ifi - 1; 1266 call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 1267 j = fixed (substr (output, ii + 1, ofe - ii)); 1268 ofe = ii; 1269 end; 1270 1271 end get_range; 1272 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1273 /* */ 1274 /* parse the next input token */ 1275 1276 get_token: proc (ifp, ifi, ife); 1277 1278 dcl ifp ptr, 1279 ifi fixed bin (24), 1280 ife fixed bin (24); 1281 dcl input char (ife) based (ifp); 1282 1283 call strip (ifp, ifi, ife); 1284 if (substr (input, ifi, 1) ^= "&") 1285 then do; 1286 c32 = ""; 1287 return; 1288 end; 1289 i = verify (substr (input, ifi + 1), "abcdefghijklmnopqrstuvwxyz"); 1290 if (i = 0) 1291 then i = ife - ifi + 1; 1292 else if (i = 1) 1293 then i = 2; 1294 c32 = substr (input, ifi, i); 1295 1296 end get_token; 1297 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1298 /* */ 1299 /* determine and format the line number of a given point in a segment */ 1300 1301 lineno: proc (segi) returns (char (6) var); 1302 1303 dcl segi fixed bin (24); 1304 1305 dcl c6 pic "zzzzz9"; 1306 dcl cv6 char (6) var; 1307 dcl j fixed bin (24); 1308 dcl line fixed bin (24); 1309 dcl e fixed bin (24); 1310 1311 line = 0; 1312 i = 1; 1313 e = min (segi, sege); 1314 do while (i <= segi); 1315 line = line + 1; 1316 j = index (substr (seg, i), NL); 1317 if (j = 0) 1318 then i = sege + 1; 1319 else i = i + j; 1320 end; 1321 cv6 = ltrim (char (line)); 1322 return (cv6); 1323 1324 end lineno; 1325 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1326 /* */ 1327 /* process a logical expression */ 1328 1329 logical: proc (ifp, ifi, ife, ofp, ofe, TF); 1330 1331 dcl ifp ptr, /* pointer to input */ 1332 ifi fixed bin (24), /* first char of input to use */ 1333 ife fixed bin (24), /* last char of input to use */ 1334 ofp ptr, /* pointer to output */ 1335 ofe fixed bin (24), /* last char of output used */ 1336 TF bit (2); 1337 dcl begl fixed bin (24); 1338 dcl inputa (ife) char (1) based (ifp); 1339 dcl input char (ife) based (ifp); 1340 dcl output char (ofe) based (ofp); 1341 dcl (i, j, ii, jj, kk) fixed bin (24); 1342 dcl loc (24) fixed bin (24); 1343 dcl sep_ct fixed bin (24); 1344 dcl argstrl fixed bin (24); 1345 dcl rel fixed bin (24); 1346 1347 jj = ofe; 1348 construct_nest = construct_nest + 1; 1349 call strip (ifp, ifi, ife); 1350 begl = ifi; 1351 loop: 1352 i = search (substr (input, ifi), "&=^<>"); 1353 if (i = 0) 1354 then do; 1355 log_err: 1356 msg = "Missing termination of logical expression. "; 1357 goto add_identification; 1358 end; 1359 if (i > 1) 1360 then do; 1361 i = i - 1; 1362 call putout (ofp, ofe, substr (input, ifi, i)); 1363 ifi = ifi + i; 1364 end; 1365 rel = index ("&=^=<^>=", inputa (ifi)); 1366 goto type (rel); 1367 1368 type (1): /* & */ /* & */ 1369 if (substr (input, ifi, 5) = "&then") 1370 | (substr (input, ifi, 2) = "&;") 1371 then do; 1372 kk = ofe; 1373 if db_sw | tr_sw 1374 then do; 1375 call ioa_$nnl ("#^a:^a^-log-^.1b (", lineno (begl), lineno (ifi - 1), 1376 TF); 1377 call show_string (substr (output, jj + 1, kk - jj), ") 1378 "); 1379 end; 1380 ofe = jj; 1381 if (TF = "00"b) 1382 then return; 1383 c32 = translate (substr (output, jj + 1, kk - jj), 1384 " ABCDEFGHIJKLMNOPQRSTUVWXYZ", " 1385 abcdefghijklmnopqrstuvwxyz"); 1386 if (c32 = "0") 1387 | (c32 = "FALSE") 1388 | (c32 = "F") 1389 | (c32 = "NO") 1390 then TF = "01"b; 1391 else TF = "10"b; 1392 return; 1393 end; 1394 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 1395 goto loop; 1396 type (3): /* ^ */ /* ^ */ 1397 type (5): /* < */ /* < */ 1398 type (7): /* > */ /* > */ 1399 if (inputa (ifi + 1) = "=") 1400 then do; 1401 rel = rel + 1; 1402 ifi = ifi + 1; 1403 end; 1404 else if (rel = 3) 1405 then do; 1406 ifi = ifi + 1; 1407 call putout (ofp, ofe, "^"); 1408 goto loop; 1409 end; 1410 type (2): /* = */ /* = */ 1411 /* 2 = 4 ^= */ 1412 /* 5 < 6 <= */ 1413 /* 7 > 8 >= */ 1414 ifi = ifi + 1; 1415 ii = ofe; 1416 loop1: 1417 call strip (ifp, ifi, ife); 1418 j = index (substr (input, ifi), "&") -1; 1419 if (j < 0) 1420 then goto log_err; 1421 if (j > 0) 1422 then do; 1423 call putout (ofp, ofe, substr (input, ifi, j)); 1424 ifi = ifi + j; 1425 end; 1426 if (substr (input, ifi, 5) = "&then") 1427 | (substr (input, ifi, 2) = "&;") 1428 then do; 1429 construct_nest = construct_nest - 1; 1430 kk = ofe; 1431 if db_sw | tr_sw 1432 then do; 1433 call ioa_$nnl ("#^a:^a^-log-^.1b (", lineno (begl), 1434 lineno (ifi - 1), TF); 1435 call show_string (substr (output, jj + 1, ii - jj), ""); 1436 call ioa_$nnl (")^a(", relat (rel)); 1437 call show_string (substr (output, ii + 1, kk - ii), ") 1438 "); 1439 end; 1440 ofe = jj; 1441 if (TF = "00"b) 1442 then return; 1443 dcl relat (2:8) char (2) int static 1444 init ("=", "!!", "^=", "<", "<=", ">", ">="); 1445 goto comp (rel); 1446 end; 1447 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 1448 goto loop1; 1449 1450 comp (2): 1451 if (substr (output, jj + 1, ii - jj) = substr (output, ii + 1, kk - ii)) 1452 then TF = "10"b; 1453 else TF = "01"b; 1454 return; 1455 1456 comp (4): 1457 if (substr (output, jj + 1, ii - jj) ^= substr (output, ii + 1, kk - ii)) 1458 then TF = "10"b; 1459 else TF = "01"b; 1460 return; 1461 1462 comp (5): 1463 if (substr (output, jj + 1, ii - jj) < substr (output, ii + 1, kk - ii)) 1464 then TF = "10"b; 1465 else TF = "01"b; 1466 return; 1467 1468 comp (6): 1469 if (substr (output, jj + 1, ii - jj) <= substr (output, ii + 1, kk - ii)) 1470 then TF = "10"b; 1471 else TF = "01"b; 1472 return; 1473 1474 comp (7): 1475 if (substr (output, jj + 1, ii - jj) > substr (output, ii + 1, kk - ii)) 1476 then TF = "10"b; 1477 else TF = "01"b; 1478 return; 1479 1480 comp (8): 1481 if (substr (output, jj + 1, ii - jj) >= substr (output, ii + 1, kk - ii)) 1482 then TF = "10"b; 1483 else TF = "01"b; 1484 return; 1485 1486 end logical; 1487 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1488 /* */ 1489 /* look up a specified name in the variable lists */ 1490 1491 lookup: proc (vname) returns (fixed bin) recursive; 1492 1493 dcl vname char (32) var; 1494 1495 /* first look up local variables */ 1496 1497 var_ptr = local_var_ptr; 1498 do while (var_ptr ^= null ()); 1499 if (var.name = vname) 1500 then return (3); 1501 var_ptr = var.next; 1502 end; 1503 1504 /* then look up internal static variables */ 1505 1506 if (int_var_ptr = null ()) 1507 then do; 1508 int_var_ptr = int_vars_base; 1509 do while (int_var_ptr ^= null ()); 1510 if (macname = int_vars.macro) 1511 then goto found; 1512 else int_var_ptr = int_vars.next; 1513 end; 1514 allocate int_vars in (free_area); 1515 if al_sw 1516 then call ioa_ ("A int_vars ^a^i ^p", macname, size (int_vars), 1517 int_var_ptr); 1518 int_vars.next = int_vars_base; 1519 int_vars.ref = null (); 1520 int_vars.macro = macname; 1521 int_vars_base = int_var_ptr; 1522 end; 1523 1524 found: 1525 var_ptr = int_vars.ref; 1526 do while (var_ptr ^= null ()); 1527 if (var.name = vname) 1528 then return (2); 1529 var_ptr = var.next; 1530 end; 1531 1532 /* then look up external static variables */ 1533 1534 var_ptr = ext_var_ptr; 1535 do while (var_ptr ^= null ()); 1536 if (var.name = vname) 1537 then return (1); 1538 var_ptr = var.next; 1539 end; 1540 1541 return (0); 1542 end lookup; 1543 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1544 /* */ 1545 /* handle the active function call */ 1546 1547 macro_af: proc (ifp, ifi, ife, ofp, ofe, TF); 1548 1549 dcl ifp ptr, /* pointer to input */ 1550 ifi fixed bin (24), /* first char of input to use */ 1551 ife fixed bin (24), /* last char of input to use */ 1552 ofp ptr, /* pointer to output */ 1553 ofe fixed bin (24), /* last char of output used */ 1554 TF bit (2); 1555 dcl begl fixed bin (24); 1556 dcl inputa (ife) char (1) based (ifp); 1557 dcl input char (ife) based (ifp); 1558 dcl output char (ofe) based (ofp); 1559 dcl (i, j, ii, jj) fixed bin (24); 1560 dcl level fixed bin (24); 1561 1562 /* &[ ... ] */ 1563 1564 begl = ifi; 1565 ifi = ifi + 2; 1566 call strip (ifp, ifi, ife); 1567 if db_sw then call dumper ("af..", ifp, ifi, ife, ofp, ofe, TF); 1568 ii = ofe; 1569 level = 1; 1570 construct_nest = construct_nest + 1; 1571 loop: 1572 i = search (substr (input, ifi), "&[]"); 1573 if (i = 0) 1574 then do; 1575 msg = "]"; 1576 call error_missing ("[", begl, ife); 1577 end; 1578 if (i > 1) 1579 then do; 1580 i = i - 1; 1581 call putout (ofp, ofe, substr (input, ifi, i)); 1582 ifi = ifi + i; 1583 end; 1584 goto type (index ("&[]", inputa (ifi))); 1585 1586 type (1): /* & */ /* */ 1587 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 1588 if (c32 = "&;") 1589 then goto misplaced; 1590 goto loop; 1591 1592 type (2): /* [ */ /* */ 1593 call putout (ofp, ofe, "["); 1594 ifi = ifi + 1; 1595 level = level + 1; 1596 goto loop; 1597 1598 type (3): /* ] */ /* */ 1599 call putout (ofp, ofe, "]"); 1600 ifi = ifi + 1; 1601 level = level - 1; 1602 if (level > 0) 1603 then goto loop; 1604 1605 construct_nest = construct_nest - 1; 1606 ofe = ofe - 1; 1607 if (TF = "00"b) 1608 then do; 1609 ofe = ii; 1610 return; 1611 end; 1612 varlen = 500; 1613 dcl varlen fixed bin; 1614 begin; 1615 dcl rval char (varlen) var; 1616 rval = ""; 1617 dcl cu_$evaluate_active_string entry (ptr, char(*), fixed bin, char(*) var, 1618 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 */ 1619 1620 call cu_$evaluate_active_string (null (), 1621 substr (output, ii + 1, ofe - ii), 1622 ATOMIC_ACTIVE_STRING, rval, ecode); 1623 if (ecode ^= 0) 1624 then do; 1625 err_ct = 0; 1626 msg = "Processing active functtion. "; 1627 msg_etc = substr (output, ii + 1, ofe - ii); 1628 goto add_id; 1629 end; 1630 ofe = ii; 1631 call putout (ofp, ofe, (rval)); 1632 end; 1633 return; 1634 1635 end macro_af; 1636 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1637 /* */ 1638 /* handle a macro call */ 1639 1640 macro_call: proc (ifp, ifi, ife, ofp, ofe, TF) recursive; 1641 1642 dcl ifp ptr, /* pointer to input */ 1643 ifi fixed bin (24), /* first char of input to use */ 1644 ife fixed bin (24), /* last char of input to use */ 1645 ofp ptr, /* pointer to output */ 1646 ofe fixed bin (24), /* last char of output used */ 1647 TF bit (2); 1648 dcl begl fixed bin (24); 1649 dcl inputa (ife) char (1) based (ifp); 1650 dcl input char (ife) based (ifp); 1651 dcl output char (ofe) based (ofp); 1652 dcl (i, j, ii, jj) fixed bin (24); 1653 dcl loc (100) fixed bin (24); 1654 dcl (sep_ct, level) fixed bin (24); 1655 dcl argstrl fixed bin (24); 1656 dcl callseg char (32) var; 1657 dcl callmac char (32) var; 1658 1659 /* &xxx( ... , ... , ...) */ 1660 /* &xxx$yy( ... , ... , ...) */ 1661 1662 begl = ifi; 1663 callseg = c32x; 1664 callmac = c32; 1665 call strip (ifp, ifi, ife); 1666 if db_sw then call dumper ("call", ifp, ifi, ife, ofp, ofe, TF); 1667 ii = ofe; 1668 call putout (ofp, ofe, "("); 1669 loc (1) = ofe; 1670 sep_ct = 1; 1671 level = 1; 1672 construct_nest = construct_nest + 1; 1673 loop: 1674 i = search (substr (input, ifi), "&(),"); 1675 if (i = 0) 1676 then do; 1677 msg = ")"; 1678 call error_missing (callmac || "(", begl, ife); 1679 end; 1680 if (i > 1) 1681 then do; 1682 i = i - 1; 1683 call putout (ofp, ofe, substr (input, ifi, i)); 1684 ifi = ifi + i; 1685 end; 1686 goto type (index ("&(),", inputa (ifi))); 1687 1688 type (1): /* & */ /* */ 1689 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 1690 if (c32 = "&;") 1691 then do; 1692 msg = "&;"; 1693 call error_misplaced ("call", begl, ife); 1694 end; 1695 goto loop; 1696 1697 type (2): /* ( */ /* */ 1698 call putout (ofp, ofe, "("); 1699 ifi = ifi + 1; 1700 level = level + 1; 1701 goto loop; 1702 1703 type (3): /* ) */ /* */ 1704 call putout (ofp, ofe, ")"); 1705 ifi = ifi + 1; 1706 level = level - 1; 1707 if (level > 0) 1708 then goto loop; 1709 1710 construct_nest = construct_nest - 1; 1711 loc (sep_ct + 1) = ofe; 1712 argstrl = ofe - loc (1) + 1; 1713 if (argstrl > 16384) 1714 then do; 1715 msg = "&call arg-string > 16384 chrs."; 1716 goto add_identification; 1717 end; 1718 begin; 1719 dcl 1 args (sep_ct) like argl; 1720 dcl argstr (argstrl) char (1) unal; 1721 if db_sw | tr_sw 1722 then do; 1723 call ioa_$nnl ("#^a:^a^-call ^a$^a ", lineno (begl), 1724 lineno (ifi - 1), callseg, callmac); 1725 call show_string (substr (output, loc (1), argstrl), NL); 1726 end; 1727 string (argstr) = substr (output, loc (1), argstrl); 1728 ofe = loc (1) - 1; 1729 if (argstrl = 2) 1730 then sep_ct = 0; 1731 do i = 1 to sep_ct; 1732 args.l (i) = loc (i + 1) - loc (i) - 1; 1733 j = loc (i) - ofe + 1; 1734 args.p (i) = addr (argstr (j)); 1735 end; 1736 call macro_ (sl_name, callseg, callmac, 1737 ofp, ofe, addr (args), (sep_ct), msg, ifp, ecode); 1738 if (ecode = -1) 1739 then call error_gen ("call", begl, ifi); 1740 if (ecode ^= 0) 1741 then do; 1742 ifi = begl; 1743 call_err = "1"b; 1744 goto add_id; 1745 end; 1746 end; 1747 return; 1748 1749 type (4): /* , */ /* */ 1750 call putout (ofp, ofe, ","); 1751 ifi = ifi + 1; 1752 if (level = 1) 1753 then do; 1754 if (sep_ct >= 100) 1755 then do; 1756 msg = "Cannot handle over 100 "; 1757 msg = msg || who_am_i; 1758 msg = msg || " arguments."; 1759 goto add_identification; 1760 end; 1761 sep_ct = sep_ct + 1; 1762 loc (sep_ct) = ofe; 1763 call strip (ifp, ifi, ife); 1764 end; 1765 goto loop; 1766 end macro_call; 1767 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1768 /* */ 1769 /* dynamically define a macro */ 1770 1771 macro_define: proc (ifp, ifi, ife, ofp, ofe, TF); 1772 1773 dcl ifp ptr, /* pointer to input */ 1774 ifi fixed bin (24), /* first char of input to use */ 1775 ife fixed bin (24), /* last char of input to use */ 1776 ofp ptr, /* pointer to output */ 1777 ofe fixed bin (24), /* last char of output used */ 1778 TF bit (2); 1779 dcl begl fixed bin (24); 1780 dcl inputa (ife) char (1) based (ifp); 1781 dcl input char (ife) based (ifp); 1782 dcl output char (ofe) based (ofp); 1783 dcl (i, j, ii, jj) fixed bin (24); 1784 dcl loc (24) fixed bin (24); 1785 dcl sep_ct fixed bin (24); 1786 dcl argstrl fixed bin (24); 1787 1788 /* &define ... &dend */ 1789 1790 begl = ifi; 1791 ifi = ifi + 7; 1792 call strip (ifp, ifi, ife); 1793 if db_sw then call dumper ("defi", ifp, ifi, ife, ofp, ofe, TF); 1794 ii = ofe; 1795 construct_nest = construct_nest + 1; 1796 loop: 1797 i = index (substr (input, ifi), "&"); 1798 if (i = 0) 1799 then do; 1800 msg = "&dend"; 1801 call error_missing ("define", begl, ife); 1802 end; 1803 if (i > 1) 1804 then do; 1805 i = i - 1; 1806 call putout (ofp, ofe, substr (input, ifi, i)); 1807 ifi = ifi + i; 1808 end; 1809 if (substr (input, ifi, 5) = "&dend") 1810 then do; 1811 ifi = ifi + 5; 1812 call strip (ifp, ifi, ife); 1813 if (TF & "10"b) 1814 then do; 1815 i = ii + 1; 1816 i = i + verify (substr (output, i, ofe - i + 1), space) - 1; 1817 j = verify (substr (output, i, ofe - i + 1), 1818 "abcdefghijklmnopqrstuvwxyz" || 1819 "ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"); 1820 if (j = 0) 1821 then do; 1822 def_err: 1823 call error_syntax ("define", begl, ifi); 1824 end; 1825 if (j < 2) 1826 then do; 1827 msg = "macroname"; 1828 call error_missing ("define", begl, ifi); 1829 end; 1830 j = j - 1; 1831 c32 = substr (output, i, j); 1832 i = i + j; 1833 if (substr (output, i, 1) ^= NL) 1834 then goto def_err; 1835 macro_holder_l = ofe - i; 1836 allocate macro_holder in (free_area); 1837 macro_holder = substr (output, i + 1, macro_holder_l); 1838 if db_sw | tr_sw 1839 then do; 1840 call ioa_$nnl ("#^a:^a^-&define ^a^/^-", lineno (begl), 1841 lineno (ifi - 1), c32); 1842 call show_string (macro_holder, "&dend 1843 "); 1844 end; 1845 call addmacro (" &define'ed in " || myname || " ", "", c32, "1"b, 1846 macro_holder_p, 1, macro_holder_l); 1847 end; 1848 ofe = ii; 1849 construct_nest = construct_nest - 1; 1850 return; 1851 end; 1852 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 1853 goto loop; 1854 end macro_define; 1855 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1856 /* */ 1857 /* handle the iteration construct */ 1858 1859 macro_do: proc (ifp, ifi, ife, ofp, ofe, TF); 1860 1861 dcl ifp ptr, /* pointer to input */ 1862 ifi fixed bin (24), /* first char of input to use */ 1863 ife fixed bin (24), /* last char of input to use */ 1864 ofp ptr, /* pointer to output */ 1865 ofe fixed bin (24), /* last char of output used */ 1866 TF bit (2); 1867 dcl begl fixed bin (24); 1868 dcl inputa (ife) char (1) based (ifp); 1869 dcl input char (ife) based (ifp); 1870 dcl output char (ofe) based (ofp); 1871 dcl (i, j, ii, jj) fixed bin (24); 1872 dcl tf bit (2); 1873 1874 /* &do EXPAND &while LOGICAL &; EXPAND &od */ 1875 /* LOGICAL ::= arithmetic | compare */ 1876 1877 begl = ifi; 1878 ifi = ifi + 3; 1879 call strip (ifp, ifi, ife); 1880 if db_sw then call dumper ("do..", ifp, ifi, ife, ofp, ofe, TF); 1881 if (TF = "00"b) 1882 then goto skip; 1883 ii = ifi; 1884 jj = 0; 1885 construct_nest = construct_nest + 1; 1886 loop: 1887 call expand (ifp, ifi, ife, ofp, ofe, (TF)); 1888 if (c32 = "&while") 1889 then do; 1890 ifi = ifi + length (c32); 1891 jj = 1; 1892 tf = TF; 1893 call logical (ifp, ifi, ife, ofp, ofe, tf); 1894 call get_token (ifp, ifi, ife); 1895 if (c32 ^= "&;") 1896 then do; 1897 msg = "&;"; 1898 call error_missing ("while", begl, ifi); 1899 end; 1900 ifi = ifi + length (c32); 1901 call strip (ifp, ifi, ife); 1902 if (tf = "01"b) 1903 then do; 1904 skip: 1905 i = index (substr (input, ifi), "&"); 1906 if (i = 0) 1907 then do; 1908 msg = "&od"; 1909 call error_missing ("do", begl, ife); 1910 end; 1911 ifi = ifi + i - 1; 1912 call get_token (ifp, ifi, ife); 1913 if (c32 = "&do") 1914 then call macro_do (ifp, ifi, ife, ofp, ofe, "00"b); 1915 else if (c32 = "&""") 1916 then call protected (ifp, ifi, ife, ofp, (ofe)); 1917 else if (c32 = "&od") 1918 then do; 1919 jj = 0; 1920 goto od; 1921 end; 1922 else ifi = ifi + 1; 1923 goto skip; 1924 end; 1925 goto loop; 1926 end; 1927 if (c32 = "&od") 1928 then do; 1929 od: 1930 ifi = ifi + length (c32); 1931 call strip (ifp, ifi, ife); 1932 if (jj = 0) 1933 then do; 1934 construct_nest = construct_nest - 1; 1935 return; 1936 end; 1937 ifi = ii; 1938 goto loop; 1939 end; 1940 msg = c32; 1941 call error_misplaced ("do", begl, ifi); 1942 end macro_do; 1943 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 1944 /* */ 1945 /* make a list or array var be empty again */ 1946 1947 macro_empty: proc (ifp, ifi, ife, ofp, ofe, TF); 1948 dcl ifp ptr, 1949 ifi fixed bin (24), 1950 ife fixed bin (24), 1951 ofp ptr, 1952 ofe fixed bin (24), 1953 TF bit (2); 1954 dcl begl fixed bin (24); 1955 dcl inputa (ife) char (1) based (ifp); 1956 dcl input char (ife) based (ifp); 1957 dcl output char (ofe) based (ofp); 1958 dcl (i, j, ii, jj) fixed bin (24); 1959 dcl tf bit (2); 1960 dcl vname char (32) var; 1961 1962 /* &empty name &; */ 1963 1964 begl = ifi; 1965 ifi = ifi + 6; 1966 call strip (ifp, ifi, ife); 1967 if db_sw then call dumper ("empt", ifp, ifi, ife, ofp, ofe, TF); 1968 i = verify (substr (input, ifi), 1969 "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"); 1970 if (i = 0) 1971 then i = ife - ifi + 1; 1972 if (i = 1) 1973 then do; 1974 msg = "array name"; 1975 call error_missing ("empty", begl, ifi); 1976 end; 1977 vname = substr (input, ifi, i - 1); 1978 if (length (vname) > 16) 1979 then do; 1980 msg = """"; 1981 msg = msg || vname; 1982 msg = msg || """ > 16 characters."; 1983 call error_gen ("empty", begl, ifi); 1984 end; 1985 ifi = ifi + length (vname); 1986 call strip (ifp, ifi, ife); 1987 if (substr (input, ifi, 2) ^= "&;") 1988 then do; 1989 msg = "&;"; 1990 call error_missing ("empty", begl, ifi); 1991 end; 1992 call strip2 (ifp, ifi, ife); 1993 i = lookup (vname); 1994 if (i = 0) 1995 then do; 1996 msg = """"; 1997 msg = msg || vname; 1998 msg = msg || """ undefined."; 1999 call error_gen ("empty", begl, ifi); 2000 end; 2001 if (var.type = 0) 2002 then do; 2003 msg = """"; 2004 msg = msg || vname; 2005 msg = msg || """ is a scalar."; 2006 call error_gen ("empty", begl, ifi); 2007 end; 2008 arr_ptr = var.ref; 2009 /* free any allocated strings */ 2010 if (var.type = 2) 2011 then do; 2012 array.h_bound = array.lower - 1; 2013 array.l_bound = array.lower + var.len; 2014 end; 2015 if (var.type = 3) 2016 then do; 2017 array.l_bound = 1; 2018 array.h_bound = 0; 2019 end; 2020 end macro_empty; 2021 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2022 /* */ 2023 /* print a user specified error message */ 2024 2025 macro_error: proc (ifp, ifi, ife, ofp, ofe, TF); 2026 2027 dcl ifp ptr, /* pointer to input */ 2028 ifi fixed bin (24), /* first char of input to use */ 2029 ife fixed bin (24), /* last char of input to use */ 2030 ofp ptr, /* pointer to output */ 2031 ofe fixed bin (24), /* last char of output used */ 2032 TF bit (2); 2033 dcl begl fixed bin (24); 2034 dcl inputa (ife) char (1) based (ifp); 2035 dcl input char (ife) based (ifp); 2036 dcl output char (ofe) based (ofp); 2037 dcl (i, j, ii, jj) fixed bin (24); 2038 dcl loc (24) fixed bin (24); 2039 dcl sep_ct fixed bin (24); 2040 dcl argstrl fixed bin (24); 2041 dcl ch8 pic "-------9"; 2042 2043 /* &error ARITH , ... &; */ 2044 2045 begl = ifi; 2046 ifi = ifi + 6; 2047 call strip (ifp, ifi, ife); 2048 if db_sw then call dumper ("err.", ifp, ifi, ife, ofp, ofe, TF); 2049 ii = ofe; 2050 msg = ""; 2051 construct_nest = construct_nest + 1; 2052 ifi = ifi - 2; 2053 call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 2054 2055 if (ofe ^= ii + 1) 2056 | (substr (output, ofe, 1) < "0") 2057 | (substr (output, ofe, 1) > "4") 2058 then do; 2059 ofe = ii; 2060 call putout (ofp, ofe, "4(Invalid &error severity, 4 assumed.) "); 2061 end; 2062 call strip (ifp, ifi, ife); 2063 if (inputa (ifi) ^= ",") 2064 then call putout (ofp, ofe, "(Missing comma after &error severity.) "); 2065 else ifi = ifi + 1; 2066 loop: 2067 i = index (substr (input, ifi), "&") -1; 2068 if (i < 0) 2069 then do; 2070 msg = "&;"; 2071 call error_missing ("error", begl, ife); 2072 end; 2073 if (i > 0) 2074 then do; 2075 call putout (ofp, ofe, substr (input, ifi, i)); 2076 ifi = ifi + i; 2077 end; 2078 if (substr (input, ifi, 2) = "&;") 2079 then do; 2080 call strip2 (ifp, ifi, ife); 2081 i = index ("01234", substr (output, ii + 1, 1)) - 1; 2082 err_ct (i) = err_ct (i) + 1; 2083 msg = NL; 2084 if (i = 0) 2085 then msg = msg || "NOTE: "; 2086 else if (i = 1) 2087 then msg = msg || "WARNING. "; 2088 else do; 2089 msg = msg || "ERROR SEVERITY "; 2090 msg = msg || substr (output, ii + 1, 1); 2091 msg = msg || ". "; 2092 end; 2093 msg = msg || who_am_i; 2094 msg = msg || " """; 2095 msg = msg || macname; 2096 msg = msg || """, line "; 2097 msg = msg || lineno (ifi); 2098 msg = msg || NL; 2099 call iox_$put_chars (iox_$error_output, addrel (addr (msg), 1), 2100 length (msg), 0); 2101 msg = ""; 2102 substr (output, ofe + 1, 1) = NL; 2103 call iox_$put_chars (iox_$error_output, 2104 addr (substr (output, ii + 2, 1)), ofe - ii, 0); 2105 if (i = 4) 2106 then do; 2107 msg = "Error detected by "; 2108 msg = msg || who_am_i; 2109 msg = msg || " """; 2110 msg = msg || macname; 2111 msg = msg || """."; 2112 ecode = error_table_$translation_aborted; 2113 goto exit; 2114 end; 2115 ofe = ii; 2116 construct_nest = construct_nest - 1; 2117 return; 2118 end; 2119 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 2120 goto loop; 2121 2122 dcl iox_$error_output ptr ext static; 2123 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 2124 end macro_error; 2125 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2126 /* */ 2127 /* handle the "if then [elseif] ... [else] fi" construct */ 2128 2129 macro_if: proc (ifp, ifi, ife, ofp, ofe, tf); 2130 2131 dcl ifp ptr, /* pointer to input */ 2132 ifi fixed bin (24), /* first char of input to use */ 2133 ife fixed bin (24), /* last char of input to use */ 2134 ofp ptr, /* pointer to output */ 2135 ofe fixed bin (24), /* last char of output used */ 2136 tf bit (2); /* 1x- process true */ 2137 /* x1- process false */ 2138 /* value not returned (modified) */ 2139 dcl begl fixed bin (24); 2140 dcl beglt fixed bin (24); 2141 dcl skip_sw bit (1); 2142 dcl inputa (ife) char (1) based (ifp); 2143 dcl input char (ife) based (ifp); 2144 dcl output char (ofe) based (ofp); 2145 dcl (i, j, ii, jj) fixed bin (24); 2146 dcl TF bit (2); 2147 dcl if_lineno char (6) var; 2148 dcl elseif bit (1); 2149 2150 2151 /* &if LOGICAL &then EXPAND {&elseif EXPAND} ... {&else EXPAND} &fi */ 2152 2153 begl, beglt = ifi; 2154 ifi = ifi + 3; 2155 call strip (ifp, ifi, ife); 2156 TF = tf; 2157 if db_sw then call dumper ("if..", ifp, ifi, ife, ofp, ofe, TF); 2158 elseif = "0"b; 2159 if_lineno = lineno (begl); 2160 2161 nother_logical: 2162 call logical (ifp, ifi, ife, ofp, ofe, TF); 2163 if (tf = "00"b) 2164 then TF = "00"b; 2165 if db_sw | tr_sw 2166 then call ioa_ ("#^a:^a^-&^[else^]if (^a) ^[skip^;F^;T^;TF^]", 2167 lineno (beglt), lineno (ifi - 1), elseif, if_lineno, 2168 fixed (TF) + 1); 2169 call get_token (ifp, ifi, ife); 2170 if (c32 ^= "&then") 2171 then do; 2172 msg = "&then"; 2173 call error_missing ("if", begl, ifi); 2174 end; 2175 beglt = ifi; 2176 ifi = ifi + length (c32); 2177 call strip (ifp, ifi, ife); 2178 construct_nest = construct_nest + 1; 2179 if (TF & "10"b) 2180 then call expand (ifp, ifi, ife, ofp, ofe, (TF)); 2181 else call skipper; 2182 if db_sw | tr_sw 2183 then call ioa_ ("#^a:^a^-&then (^a) ^[done^;skip^]", lineno (beglt), 2184 lineno (ifi - 1), if_lineno, (TF & "10"b)); 2185 skip_again: 2186 beglt = ifi; 2187 if (c32 = "&elseif") 2188 then do; 2189 ifi = ifi + length (c32); 2190 call strip (ifp, ifi, ife); 2191 if (TF & "01"b) 2192 then do; 2193 construct_nest = construct_nest - 1; 2194 elseif = "1"b; 2195 goto nother_logical; 2196 end; 2197 call skipper; 2198 if db_sw | tr_sw 2199 then call ioa_ ("#^a:^a^-&elseif (^a) skip", 2200 lineno (beglt), lineno (ifi - 1), if_lineno); 2201 goto skip_again; 2202 end; 2203 if (c32 = "&else") 2204 then do; 2205 ifi = ifi + length (c32); 2206 call strip (ifp, ifi, ife); 2207 if (TF & "01"b) 2208 then call expand (ifp, ifi, ife, ofp, ofe, (TF)); 2209 else call skipper; 2210 if db_sw | tr_sw 2211 then call ioa_ ("#^a:^a^-&else (^a) ^[done^;skip^]", 2212 lineno (beglt), lineno (ifi - 1), if_lineno, TF & "01"b); 2213 beglt = ifi; 2214 end; 2215 if (c32 ^= "&fi") 2216 then do; 2217 msg = "&fi"; 2218 call error_missing ("if", begl, ifi); 2219 end; 2220 construct_nest = construct_nest - 1; 2221 ifi = ifi + length (c32); 2222 call strip (ifp, ifi, ife); 2223 if db_sw | tr_sw 2224 then call ioa_ ("#^a:^a^-&fi (^a)", 2225 lineno (beglt), lineno (ifi - 1), if_lineno); 2226 return; 2227 2228 skipper: proc; 2229 2230 do while ("1"b); 2231 i = index (substr (input, ifi), "&"); 2232 if (i = 0) 2233 then do; 2234 c32 = ""; 2235 return; 2236 end; 2237 ifi = ifi + i - 1; 2238 call get_token (ifp, ifi, ife); 2239 if (c32 = "&if") 2240 then call macro_if (ifp, ifi, ife, ofp, ofe, "00"b); 2241 else if (c32 = "&fi") 2242 then return; 2243 else if (c32 = "&else") 2244 then return; 2245 else if (c32 = "&elseif") 2246 then return; 2247 else if (c32 = "&""") 2248 then call protected (ifp, ifi, ife, ofp, (ofe)); 2249 else ifi = ifi + 1; 2250 end; 2251 2252 end; 2253 2254 end macro_if; 2255 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2256 /* */ 2257 /* return the length of a string */ 2258 2259 macro_length: proc (ifp, ifi, ife, ofp, ofe, TF); 2260 2261 dcl ifp ptr, /* pointer to input */ 2262 ifi fixed bin (24), /* first char of input to use */ 2263 ife fixed bin (24), /* last char of input to use */ 2264 ofp ptr, /* pointer to output */ 2265 ofe fixed bin (24), /* last char of output used */ 2266 TF bit (2); 2267 dcl begl fixed bin (24); 2268 dcl inputa (ife) char (1) based (ifp); 2269 dcl input char (ife) based (ifp); 2270 dcl output char (ofe) based (ofp); 2271 dcl (i, j, ii, jj) fixed bin (24); 2272 dcl loc (24) fixed bin (24); 2273 dcl sep_ct fixed bin (24); 2274 dcl argstrl fixed bin (24); 2275 2276 /* &length ... &; */ 2277 2278 begl = ifi; 2279 ifi = ifi + 7; 2280 call strip (ifp, ifi, ife); 2281 if db_sw then call dumper ("leng", ifp, ifi, ife, ofp, ofe, TF); 2282 ii = ofe; 2283 construct_nest = construct_nest + 1; 2284 loop: 2285 i = index (substr (input, ifi), "&") -1; 2286 if (i < 0) 2287 then do; 2288 msg = "&;"; 2289 call error_missing ("length", begl, ife); 2290 end; 2291 if (i > 0) 2292 then do; 2293 call putout (ofp, ofe, substr (input, ifi, i)); 2294 ifi = ifi + i; 2295 end; 2296 if (substr (input, ifi, 2) = "&;") 2297 then do; 2298 call strip2 (ifp, ifi, ife); 2299 i = ofe - ii; 2300 ofe = ii; 2301 call putout (ofp, ofe, ltrim (char (i))); 2302 construct_nest = construct_nest - 1; 2303 return; 2304 end; 2305 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 2306 goto loop; 2307 end macro_length; 2308 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2309 /* */ 2310 /* process loc/int/ext/let statements (they look very much alike */ 2311 2312 macro_let: proc (ifp, ifi, ife, ofp, ofe, TF, which) recursive; 2313 2314 dcl ifp ptr, /* pointer to input */ 2315 ifi fixed bin (24), /* first char of input to use */ 2316 ife fixed bin (24), /* last char of input to use */ 2317 ofp ptr, /* pointer to output */ 2318 ofe fixed bin (24), /* last char of output used */ 2319 TF bit (2), 2320 which fixed bin (24); /* 0-let, 1-ext, 2-int, 3-loc */ 2321 dcl begl fixed bin (24); 2322 dcl inputa (ife) char (1) based (ifp); 2323 dcl input char (ife) based (ifp); 2324 dcl output char (ofe) based (ofp); 2325 dcl (i, j, ii, jj) fixed bin (24); 2326 dcl vname char (32) var; 2327 dcl vptr ptr; 2328 dcl found fixed bin (24); 2329 dcl (lower, higher) fixed bin (24); 2330 2331 /* &let var = EXPR &; 2332* &ext var = EXPR &; 2333* &ext var &; 2334* &int var = EXPR &; 2335* &int var &; 2336* &loc var = EXPR &; 2337* &loc var &; */ 2338 /* EXPR ::= arithmetic | string */ 2339 2340 begl = ifi; 2341 ifi = ifi + 4; 2342 call strip (ifp, ifi, ife); 2343 if db_sw then call dumper (cmd (which), ifp, ifi, ife, ofp, ofe, TF); 2344 i = verify (substr (input, ifi, 1), 2345 "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"); 2346 if (i ^= 0) 2347 then do; 2348 msg = "Variable name must begin with alphabetic char. "; 2349 call error_gen (cmd (which), begl, ifi); 2350 end; 2351 i = verify (substr (input, ifi), 2352 "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"); 2353 if (i = 0) 2354 then i = ife - ifi + 1; 2355 else i = i - 1; 2356 vname = substr (input, ifi, i); 2357 if (i > 16) 2358 then do; 2359 msg = "Data name > 16 characters. "; 2360 goto add_identification; 2361 end; 2362 ifi = ifi + i; 2363 dcl reserved (29) char (8) int static init ( 2364 "arg", 2365 "comment", 2366 "define", 2367 "dend", 2368 "do", 2369 "else", 2370 "elseif", 2371 "empty", 2372 "error", 2373 "expand", 2374 "expend", 2375 "ext", 2376 "fi", 2377 "hbound", 2378 "if", 2379 "int", 2380 "let", 2381 "lbound", 2382 "length", 2383 "loc", 2384 "macro", 2385 "mend", 2386 "quote", 2387 "return", 2388 "scan", 2389 "substr", 2390 "unquote", 2391 "usage", 2392 "while"); 2393 do i = 1 to hbound (reserved, 1); 2394 if (vname = reserved (i)) 2395 then do; 2396 msg = "Attempt to use reserved word """; 2397 msg = msg || vname; 2398 msg = msg || """ as variable. "; 2399 goto add_identification; 2400 end; 2401 end; 2402 found = lookup (vname); 2403 if (found < which) 2404 then do; 2405 allocate var in (free_area) set (var_ptr); 2406 if al_sw 2407 then call ioa_ ("A var-^a ^i ^p", vname, size (var), var_ptr); 2408 var.name = vname; 2409 var.ref = null (); 2410 var.type = 0; 2411 var.len = 0; 2412 if (which = 1) 2413 then do; 2414 var.next = ext_var_ptr; 2415 ext_var_ptr = var_ptr; 2416 if db_sw 2417 then call ioa_ ("^p ext ""^a""", var_ptr, var.name); 2418 end; 2419 else if (which = 2) 2420 then do; 2421 var.next = int_vars.ref; 2422 int_vars.ref = var_ptr; 2423 if db_sw 2424 then call ioa_ ("^p int.^a ""^a""", var_ptr, macname, 2425 var.name); 2426 end; 2427 else do; 2428 var.next = local_var_ptr; 2429 local_var_ptr = var_ptr; 2430 if db_sw 2431 then call ioa_ ("^p loc ""^a""", var_ptr, var.name); 2432 end; 2433 end; 2434 else if (found = 0) 2435 then do; 2436 msg = "Attempt to set undeclared variable """; 2437 msg = msg || vname; 2438 msg = msg || """. "; 2439 goto add_identification; 2440 end; 2441 vptr = var_ptr; 2442 call strip (ifp, ifi, ife); 2443 if (which > 0) 2444 then if (substr (input, ifi, 2) = "&;") 2445 then do; 2446 call strip2 (ifp, ifi, ife); 2447 return; 2448 end; 2449 if (inputa (ifi) = "{") 2450 then do; 2451 ifi = ifi - 1; 2452 if (var.type = 0) 2453 then do; 2454 lower, higher = -9999; 2455 end; 2456 else do; 2457 arr_ptr = var.ref; 2458 lower = array.l_bound; 2459 higher = array.h_bound; 2460 end; 2461 call get_range (ifp, ifi, ife, ofp, ofe, TF, lower, higher); 2462 if (inputa (ifi) ^= "}") 2463 then do; 2464 msg = "}"; 2465 call error_missing (cmd (which), begl, ifi); 2466 end; 2467 ifi = ifi + 1; 2468 call strip (ifp, ifi, ife); 2469 var_ptr = vptr; 2470 if (which > 0) /* not let */ 2471 then do; 2472 if (lower = higher) 2473 then do; 2474 if (lower < 1) 2475 then do; 2476 msg = "Improper dimension. "; 2477 goto add_identification; 2478 end; 2479 lower = 1; 2480 end; 2481 if (found ^= which) 2482 then do; 2483 var.type = 1; 2484 var.len = higher - lower + 1; 2485 allocate array in (free_area) set (arr_ptr); 2486 var.ref = arr_ptr; 2487 if al_sw 2488 then call ioa_ ("A^a{^i:^i} ^i ^p", vname, lower, 2489 higher, size (array), var.ref); 2490 do arr_elem = 1 to var.len; 2491 array.ref (arr_elem) = null (); 2492 array.len (arr_elem) = 0; 2493 end; 2494 array.lower = lower; 2495 end; 2496 if (substr (input, ifi, 3) = "var") 2497 then do; 2498 ifi = ifi + 3; 2499 if (found = which) 2500 then do; 2501 if (var.type ^= 2) 2502 | (array.lower ^= lower) 2503 | (var.len ^= higher - lower + 1) 2504 then do; 2505 dcl_err: 2506 msg = "Data declaration does not match prior declaration for """; 2507 msg = msg || vname; 2508 msg = msg || """. "; 2509 goto add_identification; 2510 end; 2511 end; 2512 else do; 2513 var.type = 2; 2514 array.l_bound = higher + 1; 2515 array.h_bound = lower - 1; 2516 end; 2517 end; 2518 else if (substr (input, ifi, 4) = "list") 2519 then do; 2520 ifi = ifi + 4; 2521 if (found = which) 2522 then do; 2523 if (var.type ^= 3) 2524 | (var.len ^= higher) 2525 then goto dcl_err; 2526 end; 2527 else do; 2528 var.type = 3; 2529 array.l_bound = 1; 2530 array.h_bound = 0; 2531 end; 2532 end; 2533 else if (substr (input, ifi, 4) = "fifo") 2534 then do; 2535 ifi = ifi + 4; 2536 if (found = which) 2537 then do; 2538 if (var.type ^= 4) 2539 | (array.l_bound ^= lower) 2540 | (array.h_bound ^= higher) 2541 then goto dcl_err; 2542 end; 2543 else do; 2544 var.type = 4; 2545 array.l_bound = 1; 2546 array.h_bound = 0; 2547 end; 2548 end; 2549 else if (substr (input, ifi, 4) = "lifo") 2550 then do; 2551 ifi = ifi + 4; 2552 if (found = which) 2553 then do; 2554 if (var.type ^= 5) 2555 | (array.l_bound ^= lower) 2556 | (array.h_bound ^= higher) 2557 then goto dcl_err; 2558 end; 2559 else do; 2560 var.type = 5; 2561 array.l_bound = 1; 2562 array.h_bound = 0; 2563 end; 2564 end; 2565 else do; 2566 if (found = which) 2567 then do; 2568 if (var.type ^= 1) 2569 | (array.l_bound ^= lower) 2570 | (array.h_bound ^= higher) 2571 then goto dcl_err; 2572 end; 2573 else do; 2574 array.l_bound = lower; 2575 array.h_bound = higher; 2576 end; 2577 end; 2578 call strip (ifp, ifi, ife); 2579 end; 2580 else do; 2581 if (var.type ^= 1) & (var.type ^= 2) 2582 then do; 2583 msg = "Attempt to do array assignment to non-array variable. "; 2584 goto add_identification; 2585 end; 2586 arr_ptr = var.ref; 2587 if (lower < array.lower) 2588 then do; 2589 msg = "Attempt to set below lower bound. "; 2590 goto add_identification; 2591 end; 2592 if (higher > array.lower + var.len - 1) 2593 then do; 2594 msg = "Attempt to set above upper bound. "; 2595 goto add_identification; 2596 end; 2597 end; 2598 call strip (ifp, ifi, ife); 2599 if (which > 0) 2600 then if (substr (input, ifi, 2) = "&;") 2601 then do; 2602 call strip2 (ifp, ifi, ife); 2603 return; 2604 end; 2605 end; 2606 else do; 2607 if (var.type = 1) 2608 | (var.type = 2) 2609 then do; 2610 msg = "Attempt to do scalar assignment to array variable. "; 2611 goto add_identification; 2612 end; 2613 if (var.type = 4) /* fifo */ 2614 then do; 2615 arr_ptr = var.ref; 2616 if (array.l_bound + var.len - 1 > array.h_bound) 2617 then do; 2618 msg = "Out-of-bounds on fifo """; 2619 msg = msg || vname; 2620 msg = msg || """. "; 2621 goto add_identification; 2622 end; 2623 if (array.l_bound + var.len - 1 = array.h_bound) 2624 then do; 2625 msg = "Attempt to stack too many elements. "; 2626 goto add_identification; 2627 end; 2628 array.h_bound = array.h_bound + 1; 2629 lower, higher = mod (array.h_bound, var.len) + 1; 2630 end; 2631 if (var.type = 5) 2632 then do; 2633 arr_ptr = var.ref; 2634 if (var.len < array.h_bound) 2635 then do; 2636 msg = "Out-of-bounds on lifo """; 2637 msg = msg || vname; 2638 msg = msg || """. "; 2639 goto add_identification; 2640 end; 2641 if (var.len = array.h_bound) 2642 then do; 2643 msg = "Attempt to stack too many elements. "; 2644 goto add_identification; 2645 end; 2646 array.h_bound, lower, higher = array.h_bound + 1; 2647 end; 2648 end; 2649 if (inputa (ifi) ^= "=") 2650 then do; 2651 msg = "="; 2652 call error_missing (cmd (which), begl, ifi); 2653 dcl cmd (0:3) char (4) int static init ("let ", "ext ", "int ", "loc "); 2654 end; 2655 ifi = ifi + 1; 2656 call strip (ifp, ifi, ife); 2657 jj = ofe; 2658 if (inputa (ifi) = "(") 2659 then do; 2660 msg = "Vector assignment not available yet."; 2661 call error_gen (cmd (which), begl, ifi); 2662 end; 2663 if (substr (input, ifi, 2) = "&(") 2664 then do; 2665 call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 2666 call strip (ifp, ifi, ife); 2667 end; 2668 else do; 2669 construct_nest = construct_nest + 1; 2670 loop: 2671 i = index (substr (input, ifi), "&") -1; 2672 if (i < 0) 2673 then do; 2674 msg = "&;"; 2675 call error_missing (cmd (which), begl, ife); 2676 end; 2677 if (i > 0) 2678 then do; 2679 call putout (ofp, ofe, substr (input, ifi, i)); 2680 ifi = ifi + i; 2681 end; 2682 if (substr (input, ifi, 2) ^= "&;") 2683 then do; 2684 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 2685 goto loop; 2686 end; 2687 construct_nest = construct_nest - 1; 2688 end; 2689 if (substr (input, ifi, 2) ^= "&;") 2690 then do; 2691 msg = "&;"; 2692 call error_missing (cmd (which), begl, ife); 2693 end; 2694 call strip2 (ifp, ifi, ife); 2695 if (found = 0) 2696 | (which = 0) 2697 then do; 2698 j = ofe - jj; 2699 var_ptr = vptr; 2700 if (var.type = 0) 2701 then do; 2702 if (var.len ^= j) 2703 then do; 2704 if (var.len > 0) 2705 then do; 2706 if al_sw 2707 then call ioa_ ("F ^a ^i ^p", vname, var.len, 2708 var.ref); 2709 free vartext in (free_area); 2710 end; 2711 var.len = j; 2712 allocate vartext in (free_area) set (var.ref); 2713 if al_sw 2714 then call ioa_ ("A ^a ^i ^p", vname, size (vartext), 2715 var.ref); 2716 end; 2717 vartext = substr (output, jj + 1, j); 2718 if db_sw | tr_sw 2719 then do; 2720 call ioa_$nnl ("#^a:^a^-&^a ^a =", lineno (begl), 2721 lineno (ifi - 1), cmd (which), var.name); 2722 call show_string (vartext, "&; 2723 "); 2724 end; 2725 end; 2726 else do; 2727 arr_ptr = var.ref; 2728 if (var.type = 2) 2729 then do; 2730 array.l_bound = min (array.l_bound, lower); 2731 array.h_bound = max (array.h_bound, higher); 2732 end; 2733 if (var.type = 3) 2734 then do; 2735 do arr_elem = array.l_bound to array.h_bound; 2736 if (arrtext = substr (output, jj + 1, j)) 2737 then do; 2738 ofe = jj; 2739 return; 2740 end; 2741 end; 2742 if (array.h_bound = var.len) 2743 then do; 2744 msg = "Attempt to add too many elements to list. "; 2745 goto add_identification; 2746 end; 2747 array.h_bound, lower, higher = array.h_bound + 1; 2748 end; 2749 do arr_elem = lower - array.lower + 1 to higher - array.lower + 1; 2750 if (array.len (arr_elem) ^= j) 2751 then do; 2752 if (array.ref (arr_elem) ^= null ()) 2753 then do; 2754 if al_sw 2755 then call ioa_ ("F ^a{^i} ^i ^p", vname, 2756 arr_elem, array.len (arr_elem), 2757 array.ref (arr_elem)); 2758 free arrtext in (free_area); 2759 end; 2760 array.len (arr_elem) = j; 2761 allocate arrtext in (free_area) set (array.ref (arr_elem)); 2762 if al_sw 2763 then call ioa_ ("A ^a{^i} ^i ^p", vname, 2764 arr_elem, size (arrtext), 2765 array.ref (arr_elem)); 2766 end; 2767 arrtext = substr (output, jj + 1, j); 2768 end; 2769 if db_sw | tr_sw 2770 then do; 2771 call ioa_$nnl ("#^a:^a^-&^a ^a{^i:^i} =", lineno (begl), 2772 lineno (ifi - 1), cmd (which), var.name, lower, higher); 2773 call show_string (substr (output, jj + 1, j), "&; 2774 "); 2775 end; 2776 end; 2777 end; 2778 ofe = jj; 2779 end macro_let; 2780 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2781 /* */ 2782 /* double any quotes in a string */ 2783 2784 macro_quote: proc (ifp, ifi, ife, ofp, ofe, tf); 2785 2786 dcl ifp ptr, /* pointer to input */ 2787 ifi fixed bin (24), /* first char of input to use */ 2788 ife fixed bin (24), /* last char of input to use */ 2789 ofp ptr, /* pointer to output */ 2790 ofe fixed bin (24), /* last char of output used */ 2791 tf bit (2); /* 1x- process true */ 2792 /* x1- process false */ 2793 dcl begl fixed bin (24); 2794 dcl inputa (ife) char (1) based (ifp); 2795 dcl input char (ife) based (ifp); 2796 dcl output char (ofe) based (ofp); 2797 dcl (i, j, ii, jj) fixed bin (24); 2798 dcl inside bit (1); 2799 dcl ch char (1); 2800 2801 /* "e ... &; */ 2802 2803 begl = ifi; 2804 ifi = ifi + 6; 2805 call strip (ifp, ifi, ife); 2806 ii = ofe; 2807 construct_nest = construct_nest + 1; 2808 loop: 2809 i = index (substr (input, ifi), "&") -1; 2810 if (i < 0) 2811 then do; 2812 msg = "&;"; 2813 call error_missing ("quote", begl, ife); 2814 end; 2815 if (i > 0) 2816 then do; 2817 call putout (ofp, ofe, substr (input, ifi, i)); 2818 ifi = ifi + 1; 2819 end; 2820 if (substr (input, ifi, 2) ^= "&;") 2821 then do; 2822 call ampersand (ifp, ifi, ife, ofp, ofe, tf, "0"b); 2823 goto loop; 2824 end; 2825 call strip2 (ifp, ifi, ife); 2826 i = ofe - ii; 2827 if (i > 16384) 2828 then do; 2829 msg = "Sorry, not yet handling "e strings > 16384 chrs."; 2830 goto add_identification; 2831 end; 2832 construct_nest = construct_nest - 1; 2833 if (index (substr (output, ii + 1, i), """") = 0) 2834 then do; 2835 return; 2836 end; 2837 begin; 2838 dcl argstr char (i); 2839 argstr = substr (output, ii + 1, i); 2840 ofe = ii; 2841 j = 1; 2842 loop: 2843 ii = index (substr (argstr, j), """"); 2844 if (ii = 0) 2845 then ii = i - j + 1; 2846 call putout (ofp, ofe, substr (argstr, j, ii)); 2847 j = j + ii; 2848 if (substr (output, ofe, 1) = """") 2849 then call putout (ofp, ofe, """"); 2850 if (j > i) 2851 then return; 2852 goto loop; 2853 end; 2854 end macro_quote; 2855 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2856 /* */ 2857 /* rescan a result of macro expansion */ 2858 2859 macro_scan: proc (ifp, ifi, ife, ofp, ofe, TF); 2860 2861 dcl ifp ptr, /* pointer to input */ 2862 ifi fixed bin (24), /* first char of input to use */ 2863 ife fixed bin (24), /* last char of input to use */ 2864 ofp ptr, /* pointer to output */ 2865 ofe fixed bin (24), /* last char of output used */ 2866 TF bit (2); 2867 dcl begl fixed bin (24); 2868 dcl inputa (ife) char (1) based (ifp); 2869 dcl input char (ife) based (ifp); 2870 dcl output char (ofe) based (ofp); 2871 dcl (i, j, ii, jj) fixed bin (24); 2872 dcl loc (24) fixed bin (24); 2873 dcl sep_ct fixed bin (24); 2874 dcl argstrl fixed bin (24); 2875 2876 /* &scan ... &; */ 2877 2878 begl = ifi; 2879 ifi = ifi + 5; 2880 call strip (ifp, ifi, ife); 2881 if db_sw then call dumper ("scan", ifp, ifi, ife, ofp, ofe, TF); 2882 ii = ofe; 2883 construct_nest = construct_nest + 1; 2884 loop: 2885 i = index (substr (input, ifi), "&") -1; 2886 if (i < 0) 2887 then do; 2888 msg = "&;"; 2889 call error_missing ("scan", begl, ife); 2890 end; 2891 if (i > 0) 2892 then do; 2893 call putout (ofp, ofe, substr (input, ifi, i)); 2894 ifi = ifi + i; 2895 end; 2896 if (substr (input, ifi, 2) = "&;") 2897 then do; 2898 call strip2 (ifp, ifi, ife); 2899 argstrl = ofe - ii; 2900 if (argstrl > 16384) 2901 then do; 2902 msg = "&scan string > 16384 chars."; 2903 goto add_identification; 2904 end; 2905 begin; 2906 dcl argstr char (argstrl); 2907 if db_sw | tr_sw 2908 then do; 2909 call ioa_$nnl ("#^a:^a^-&scan ", lineno (begl), lineno (ifi - 1)); 2910 call show_string (substr (output, ii + 1, argstrl), "&; 2911 "); 2912 end; 2913 string (argstr) = substr (output, ii + 1, argstrl); 2914 ofe = ii; 2915 call expand (addr (argstr), 1, argstrl, ofp, ofe, (TF)); 2916 construct_nest = construct_nest - 1; 2917 return; 2918 end; 2919 end; 2920 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 2921 goto loop; 2922 end macro_scan; 2923 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 2924 /* */ 2925 /* return part of a string with needed padding */ 2926 2927 macro_substr: proc (ifp, ifi, ife, ofp, ofe, TF); 2928 2929 dcl ifp ptr, /* pointer to input */ 2930 ifi fixed bin (24), /* first char of input to use */ 2931 ife fixed bin (24), /* last char of input to use */ 2932 ofp ptr, /* pointer to output */ 2933 ofe fixed bin (24), /* last char of output used */ 2934 TF bit (2); 2935 dcl begl fixed bin (24); 2936 dcl inputa (ife) char (1) based (ifp); 2937 dcl input char (ife) based (ifp); 2938 dcl output char (ofe) based (ofp); 2939 dcl (i, j, ii, jj) fixed bin (24); 2940 dcl loc (24) fixed bin (24); 2941 dcl sep_ct fixed bin (24); 2942 dcl argstrl fixed bin (24); 2943 2944 /* &substr ... , ARITH , ARITH &; 2945* &substr ... , ARITH &; 2946* &substr ... , ARITH : ARITH &; */ 2947 2948 begl = ifi; 2949 ifi = ifi + 7; 2950 call strip (ifp, ifi, ife); 2951 if db_sw then call dumper ("subs", ifp, ifi, ife, ofp, ofe, TF); 2952 ii = ofe; 2953 construct_nest = construct_nest + 1; 2954 loop: 2955 i = search (substr (input, ifi), "&,") -1; 2956 if (i < 0) 2957 then do; 2958 msg = "&;"; 2959 call error_missing ("substr", begl, ife); 2960 end; 2961 if (i > 0) 2962 then do; 2963 call putout (ofp, ofe, substr (input, ifi, i)); 2964 ifi = ifi + i; 2965 end; 2966 if (inputa (ifi) = "&") 2967 then do; 2968 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 2969 goto loop; 2970 end; 2971 argstrl = ofe - ii; 2972 if (argstrl > 16384) 2973 then do; 2974 msg = "&substr string > 16384 chrs."; 2975 goto add_identification; 2976 end; 2977 begin; 2978 dcl argstr char (argstrl); 2979 dcl sepch char (1); 2980 argstr = substr (output, ii + 1, argstrl); 2981 ofe = ii; 2982 ifi = ifi - 1; 2983 call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 2984 i = fixed (substr (output, ii + 1, ofe - ii)); 2985 sepch = " "; 2986 ofe = ii; 2987 if (inputa (ifi) = ",") 2988 | (inputa (ifi) = ":") 2989 then do; 2990 sepch = inputa (ifi); 2991 ifi = ifi - 1; 2992 call arithmetic (ifp, ifi, ife, ofp, ofe, TF); 2993 j = fixed (substr (output, ii + 1, ofe - ii)); 2994 ofe = ii; 2995 end; 2996 if (substr (input, ifi, 2) ^= "&;") 2997 then goto misplaced; 2998 call strip2 (ifp, ifi, ife); 2999 if (TF ^= "00"b) 3000 then do; 3001 if (i < 0) 3002 then i = argstrl + i + 1; 3003 if (sepch = " ") 3004 then j = argstrl - i + 1; 3005 if (sepch = ":") 3006 then do; 3007 if (j < 1) 3008 then do; 3009 msg = "Substr end location <0. "; 3010 goto add_identification; 3011 end; 3012 if (j < i) 3013 then do; 3014 msg = "Substr end before begin. "; 3015 goto add_identification; 3016 end; 3017 j = j - i + 1; 3018 end; 3019 if (j < 0) 3020 then do; 3021 jj = (argstrl - i + 1) + j; 3022 if (jj < 0) 3023 then do; 3024 substr (output, ofe + 1, -jj) = " "; 3025 ofe = ofe - jj; 3026 j = -j + jj; 3027 end; 3028 else j = -j; 3029 end; 3030 if (i < 1) 3031 then do; 3032 msg = "Substr before string begin. "; 3033 goto add_identification; 3034 end; 3035 if (i > argstrl) 3036 then do; 3037 msg = "Substr after string end. "; 3038 msg_etc = ltrim (char (i)); 3039 msg_etc = msg_etc || ","; 3040 msg_etc = msg_etc || ltrim (char (j)); 3041 msg_etc = msg_etc || " of "; 3042 msg_etc = msg_etc || ltrim (char (argstrl)); 3043 msg_etc = msg_etc || """"; 3044 msg_etc = msg_etc || argstr; 3045 msg_etc = msg_etc || """"; 3046 goto add_identification; 3047 end; 3048 jj = min (argstrl-i+1, j); 3049 call putout (ofp, ofe, substr (argstr, i, jj)); 3050 if (j > jj) 3051 then call putout (ofp, ofe, copy (" ",j-jj)); 3052 end; 3053 end; 3054 construct_nest = construct_nest - 1; 3055 end macro_substr; 3056 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3057 /* */ 3058 /* remove doubled quotes and surrounding quotes (if any) from a string */ 3059 3060 macro_unquote: proc (ifp, ifi, ife, ofp, ofe, tf); 3061 3062 dcl ifp ptr, /* pointer to input */ 3063 ifi fixed bin (24), /* first char of input to use */ 3064 ife fixed bin (24), /* last char of input to use */ 3065 ofp ptr, /* pointer to output */ 3066 ofe fixed bin (24), /* last char of output used */ 3067 tf bit (2); /* 1x- process true */ 3068 /* x1- process false */ 3069 dcl begl fixed bin (24); 3070 dcl inputa (ife) char (1) based (ifp); 3071 dcl input char (ife) based (ifp); 3072 dcl output char (ofe) based (ofp); 3073 dcl (i, j, ii, jj) fixed bin (24); 3074 dcl inside bit (1); 3075 dcl ch char (1); 3076 3077 /* &unquote ... &; */ 3078 3079 begl = ifi; 3080 ifi = ifi + 8; 3081 call strip (ifp, ifi, ife); 3082 ii = ofe; 3083 construct_nest = construct_nest + 1; 3084 loop: 3085 i = index (substr (input, ifi), "&") -1; 3086 if (i < 0) 3087 then do; 3088 msg = "&;"; 3089 call error_missing ("unquote", begl, ife); 3090 end; 3091 if (i > 0) 3092 then do; 3093 call putout (ofp, ofe, substr (input, ifi, i)); 3094 ifi = ifi + 1; 3095 end; 3096 if (substr (input, ifi, 2) ^= "&;") 3097 then do; 3098 call ampersand (ifp, ifi, ife, ofp, ofe, tf, "0"b); 3099 goto loop; 3100 end; 3101 call strip2 (ifp, ifi, ife); 3102 construct_nest = construct_nest - 1; 3103 i = ii; 3104 inside = "0"b; 3105 do ii = ii + 1 to ofe; 3106 ch = substr (output, ii, 1); 3107 if (ch = """") 3108 then do; 3109 if inside 3110 then do; 3111 if (substr (output, ii + 1, 1) = """") 3112 then do; 3113 ii = ii + 1; 3114 goto use_char; 3115 end; 3116 else inside = "0"b; 3117 end; 3118 else inside = "1"b; 3119 end; 3120 else do; 3121 use_char: 3122 i = i + 1; 3123 substr (output, i, 1) = ch; 3124 end; 3125 end; 3126 ofe = i; 3127 3128 end macro_unquote; 3129 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3130 /* */ 3131 /* show the macros used up to this point */ 3132 3133 macro_usage: proc (ifp, ifi, ife, ofp, ofe, TF); 3134 3135 dcl ifp ptr, /* pointer to input */ 3136 ifi fixed bin (24), /* first char of input to use */ 3137 ife fixed bin (24), /* last char of input to use */ 3138 ofp ptr, /* pointer to output */ 3139 ofe fixed bin (24), /* last char of output used */ 3140 TF bit (2); 3141 dcl begl fixed bin (24); 3142 dcl inputa (ife) char (1) based (ifp); 3143 dcl input char (ife) based (ifp); 3144 dcl output char (ofe) based (ofp); 3145 dcl (i, j, ii, jj) fixed bin (24); 3146 dcl loc (24) fixed bin (24); 3147 dcl sep_ct fixed bin (24); 3148 dcl argstrl fixed bin (24); 3149 dcl ctl char (100) var; 3150 dcl ret_str char (256); 3151 dcl ret_len fixed bin (24); 3152 dcl ioa_$rsnpnnl entry options (variable); 3153 3154 /* &usage string &; */ 3155 3156 begl = ifi; 3157 ifi = ifi + 6; 3158 call strip (ifp, ifi, ife); 3159 if db_sw then call dumper ("usag", ifp, ifi, ife, ofp, ofe, TF); 3160 ii = ofe; 3161 construct_nest = construct_nest + 1; 3162 loop: 3163 i = index (substr (input, ifi), "&") -1; 3164 if (i < 0) 3165 then do; 3166 msg = "&;"; 3167 call error_missing ("usage", begl, ife); 3168 end; 3169 if (i > 0) 3170 then do; 3171 call putout (ofp, ofe, substr (input, ifi, i)); 3172 ifi = ifi + i; 3173 end; 3174 if (substr (input, ifi, 2) = "&;") 3175 then do; 3176 call strip2 (ifp, ifi, ife); 3177 ctl = substr (output, ii + 1, ofe - ii); 3178 ofe = ii; 3179 do maclp = macro_list_p 3180 repeat (macro_list.next) 3181 while (maclp ^= null ()); 3182 call ioa_$rsnpnnl (ctl, ret_str, ret_len, 3183 macro_list.dname, macro_list.ename, 3184 macro_list.name); 3185 call putout (ofp, ofe, substr (ret_str, 1, ret_len)); 3186 end; 3187 construct_nest = construct_nest - 1; 3188 return; 3189 end; 3190 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 3191 goto loop; 3192 end macro_usage; 3193 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3194 /* */ 3195 /* put a string into the output, making sure the length is updated before */ 3196 /* placing the data therein. */ 3197 3198 putout: proc (ofp, ofe, str); 3199 3200 dcl ofp ptr, /* points to receiver (IN) */ 3201 ofe fixed bin (24), /* length of receiver (OUT) */ 3202 str char (*); /* string to insert (IN) */ 3203 3204 dcl output char (ofe) based (ofp); 3205 dcl tofe fixed bin (24); 3206 3207 tofe = ofe + 1; 3208 ofe = ofe + length (str); 3209 substr (output, tofe, length (str)) = str; 3210 if dt_sw & db_sw 3211 then call ioa_ ("^i,^i `^va'", tofe, length (str), length (str), str); 3212 3213 end putout; 3214 3215 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3216 /* */ 3217 /* process a protected string */ 3218 3219 protected: proc (ifp, ifi, ife, ofp, ofe); 3220 3221 dcl ifp ptr, /* pointer to input */ 3222 ifi fixed bin (24), /* first char of input to use */ 3223 ife fixed bin (24), /* last char of input to use */ 3224 ofp ptr, /* pointer to output */ 3225 ofe fixed bin (24); /* last char of output used */ 3226 dcl begl fixed bin (24); 3227 dcl inputa (ife) char (1) based (ifp); 3228 dcl input char (ife) based (ifp); 3229 dcl output char (ofe) based (ofp); 3230 dcl (i, j, ii, jj) fixed bin (24); 3231 dcl loc (24) fixed bin (24); 3232 dcl sep_ct fixed bin (24); 3233 dcl argstrl fixed bin (24); 3234 3235 /* &" ... {&"&"} ... &" */ 3236 3237 begl = ifi; 3238 ifi = ifi + 2; 3239 do while ("1"b); 3240 i = index (substr (input, ifi), "&""") -1; 3241 if (i < 0) 3242 then do; 3243 msg = "&"""; 3244 call error_missing ("""", begl, ife); 3245 end; 3246 call putout (ofp, ofe, substr (input, ifi, i)); 3247 ifi = ifi + i + 2; 3248 if (substr (input, ifi, 2) ^= "&""") 3249 then return; 3250 call putout (ofp, ofe, "&"""); 3251 ifi = ifi + 2; 3252 end; 3253 end protected; 3254 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3255 /* */ 3256 /* scan a string and print it indenting 1 HT. */ 3257 3258 show_string: proc (str1, str2); 3259 3260 dcl (str1, str2) char (*); 3261 dcl (i, j, k) fixed bin (24); 3262 dcl HT_sw bit (1); 3263 3264 i = 1; 3265 do while (i <= length (str1)); 3266 j = index (substr (str1, i), NL); 3267 if (j = 0) 3268 then do; 3269 j = length (str1) - i + 1; 3270 HT_sw = "0"b; 3271 end; 3272 else HT_sw = "1"b; 3273 k = i + j; 3274 call ioa_$nnl ("^a^[^-^]", substr (str1, i, j), HT_sw); 3275 i = k; 3276 end; 3277 call ioa_$nnl ("^a", str2); 3278 3279 end show_string; 3280 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3281 /* */ 3282 /* skip over whitespace. strip2 moves ahead 2 first */ 3283 3284 strip2: proc (ifp, ifi, ife); 3285 3286 ifi = ifi + 2; 3287 3288 strip: entry (ifp, ifi, ife); 3289 3290 dcl ifp ptr, 3291 ifi fixed bin (24), 3292 ife fixed bin (24); 3293 dcl input char (ife) based (ifp); 3294 3295 dcl i fixed bin (24); 3296 3297 loop: 3298 i = verify (substr (input, ifi), space); 3299 if (i = 0) 3300 then ifi = ife + 1; 3301 else ifi = ifi + i - 1; 3302 if (substr (input, ifi, 1) ^= "&") 3303 then return; 3304 i = verify (substr (input, ifi + 1), token_chars); 3305 if (substr (input, ifi + 1, i) ^= "comment") 3306 then return; 3307 i = index (substr (input, ifi), "&;"); 3308 if (i = 0) 3309 then do; 3310 msg = "&;"; 3311 call error_missing ("comment", ifi, ifi + 8); 3312 end; 3313 ifi = ifi + i + 1; 3314 goto loop; /* keep on stripping */ 3315 3316 end strip2; 3317 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3318 /* */ 3319 /* return the lbound/hbound of an array */ 3320 3321 var_bound: proc (ifp, ifi, ife, ofp, ofe, TF) recursive; 3322 3323 dcl ifp ptr, /* pointer to input */ 3324 ifi fixed bin (24), /* first char of input to use */ 3325 ife fixed bin (24), /* last char of input to use */ 3326 ofp ptr, /* pointer to output */ 3327 ofe fixed bin (24), /* last char of output used */ 3328 TF bit (2); 3329 dcl begl fixed bin (24); 3330 dcl inputa (ife) char (1) based (ifp); 3331 dcl input char (ife) based (ifp); 3332 dcl output char (ofe) based (ofp); 3333 dcl (i, j, ii, jj) fixed bin (24); 3334 dcl loc (24) fixed bin (24); 3335 dcl (sep_ct, level) fixed bin (24); 3336 dcl argstrl fixed bin (24); 3337 dcl vname char (32) var; 3338 3339 /* &lbound xxx&; 3340* &hbound xxx&; */ 3341 ii = ofe; 3342 call strip (ifp, ifi, ife); 3343 loop: 3344 i = index (substr (input, ifi), "&") -1; 3345 if (i < 0) 3346 then do; 3347 msg = "Missing terminator on &"; 3348 msg = msg || c32; 3349 msg = msg || ". "; 3350 goto add_identification; 3351 end; 3352 if (i > 0) 3353 then do; 3354 call putout (ofp, ofe, substr (input, ifi, i)); 3355 ifi = ifi + i; 3356 end; 3357 if (substr (input, ifi, 2) ^= "&;") 3358 then do; 3359 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 3360 goto loop; 3361 end; 3362 vname = substr (output, ii + 1, ofe - ii); 3363 ofe = ii; 3364 j = lookup (vname); 3365 if (j = 0) 3366 then do; 3367 msg = "Attempt to reference undeclared variable """; 3368 msg = msg || vname; 3369 msg = msg || """. "; 3370 goto add_identification; 3371 end; 3372 if (var.type = 0) 3373 then do; 3374 msg = "Attempt to get "; 3375 msg = msg || c32; 3376 msg = msg || " of a scalar. "; 3377 goto add_identification; 3378 end; 3379 arr_ptr = var.ref; 3380 if (var.type = 1) /* array */ 3381 | (var.type = 2) /* array var */ 3382 | (var.type = 3) /* list */ 3383 then do; 3384 if (c32 = "lbound") 3385 then i = array.l_bound; 3386 else i = array.h_bound; 3387 end; 3388 if (var.type = 4) /* fifo */ 3389 | (var.type = 5) /* lifo */ 3390 then do; 3391 msg = "Cannot get "; 3392 msg = msg || c32; 3393 msg = msg || " of "; 3394 if (var.type = 5) 3395 then msg = msg || "l"; 3396 else msg = msg || "f"; 3397 msg = msg || "ifo."; 3398 goto add_identification; 3399 end; 3400 end var_bound; 3401 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3402 /* */ 3403 /* */ 3404 3405 var_range: proc (ifp, ifi, ife, ofp, ofe, TF); 3406 3407 dcl ifp ptr, /* pointer to input */ 3408 ifi fixed bin (24), /* first char of input to use */ 3409 ife fixed bin (24), /* last char of input to use */ 3410 ofp ptr, /* pointer to output */ 3411 ofe fixed bin (24), /* last char of output used */ 3412 TF bit (2); 3413 dcl begl fixed bin (24); 3414 dcl inputa (ife) char (1) based (ifp); 3415 dcl input char (ife) based (ifp); 3416 dcl output char (ofe) based (ofp); 3417 dcl (i, j, ii, jj) fixed bin (24); 3418 dcl separator char (150) var; 3419 dcl vptr ptr; 3420 dcl limit fixed bin; 3421 3422 /* &var{ ARITH } yields argument ARITH */ 3423 /* &var{ ARITH : ARITH } yields arguments ARITH thru ARITH */ 3424 /* separated by a SP */ 3425 /* &var{ ARITH : ARITH , STRING } yields arguments ARITH thru ARITH */ 3426 /* separated by STRING */ 3427 3428 begl = ifi; 3429 ii = ofe; 3430 i = lookup (c32); 3431 if (i = 0) 3432 then do; 3433 msg = "Attempt to reference undeclared array. "; 3434 goto add_identification; 3435 end; 3436 if (var.type = 0) 3437 then do; 3438 msg = "Attempt to make non-scalar ref to scalar variable """; 3439 msg = msg || c32; 3440 msg = msg || """. "; 3441 goto add_identification; 3442 end; 3443 vptr = var_ptr; 3444 arr_ptr = var.ref; 3445 i = array.l_bound; 3446 j = array.h_bound; 3447 ifi = ifi - 2; 3448 call get_range (ifp, ifi, ife, ofp, ofe, TF, i, j); 3449 var_ptr = vptr; 3450 arr_ptr = var.ref; 3451 if (TF ^= "00"b) 3452 then do; 3453 if (var.type = 4) 3454 | (var.type = 5) 3455 then do; 3456 if (i ^= j) 3457 then do; 3458 msg = "Attempt to make multiple ref to stack """; 3459 msg = msg || c32; 3460 msg = msg || """. "; 3461 goto add_identification; 3462 end; 3463 if (i > 0) 3464 then do; 3465 msg = "Attempt to ref positive stack element """; 3466 msg = msg || c32; 3467 msg = msg || """. "; 3468 goto add_identification; 3469 end; 3470 if (var.type = 4) 3471 then do; 3472 i, j = array.l_bound - i; 3473 if (i > array.h_bound) 3474 then do; 3475 msg = "Attempt to ref non-existant stack element in """; 3476 msg = msg || c32; 3477 msg = msg || """. "; 3478 goto add_identification; 3479 end; 3480 end; 3481 else do; 3482 i, j = array.h_bound + i; 3483 if (i < array.l_bound) 3484 then do; 3485 msg = "Attempt to ref non-existant stack element in """; 3486 msg = msg || c32; 3487 msg = msg || """. "; 3488 goto add_identification; 3489 end; 3490 end; 3491 end; 3492 else do; 3493 if (i < array.l_bound) 3494 then do; 3495 msg = "Attempt to reference below lower bound. "; 3496 goto add_identification; 3497 end; 3498 if (j > array.h_bound) 3499 then do; 3500 msg = "Attempt to reference above upper bound. "; 3501 goto add_identification; 3502 end; 3503 end; 3504 end; 3505 separator = " "; 3506 if (inputa (ifi) = ",") 3507 then do; 3508 ifi = ifi + 1; 3509 do while ("1"b); 3510 jj = search (substr (input, ifi), "&}") -1; 3511 if (jj < 0) 3512 then do; 3513 msg = "}"; 3514 call error_missing ("xxx{", begl, ife); 3515 end; 3516 if (jj > 0) 3517 then do; 3518 call putout (ofp, ofe, substr (input, ifi, jj)); 3519 ifi = ifi + jj; 3520 end; 3521 if (inputa (ifi) = "}") 3522 then do; 3523 separator = substr (output, ii + 1, ofe - ii); 3524 ofe = ii; 3525 goto end_range; 3526 end; 3527 call ampersand (ifp, ifi, ife, ofp, ofe, TF, "0"b); 3528 end; 3529 end; 3530 if (inputa (ifi) = "}") 3531 then do; 3532 end_range: 3533 ifi = ifi + 1; 3534 if (TF = "00"b) 3535 then return; 3536 var_ptr = vptr; 3537 arr_ptr = var.ref; 3538 limit = j - array.lower + 1; 3539 do arr_elem = i - array.lower + 1 to limit; 3540 call putout (ofp, ofe, arrtext); 3541 if (arr_elem ^= limit) 3542 then call putout (ofp, ofe, (separator)); 3543 end; 3544 end; 3545 else do; 3546 msg = "&var{ ... }"; 3547 goto syntax_err; 3548 end; 3549 end var_range; 3550 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3551 /* */ 3552 /* reference a variable */ 3553 3554 var_ref: proc (ifp, ifi, ife, ofp, ofe, TF) recursive; 3555 3556 dcl ifp ptr, /* pointer to input */ 3557 ifi fixed bin (24), /* first char of input to use */ 3558 ife fixed bin (24), /* last char of input to use */ 3559 ofp ptr, /* pointer to output */ 3560 ofe fixed bin (24), /* last char of output used */ 3561 TF bit (2); 3562 dcl begl fixed bin (24); 3563 dcl inputa (ife) char (1) based (ifp); 3564 dcl input char (ife) based (ifp); 3565 dcl output char (ofe) based (ofp); 3566 dcl (i, j, ii, jj) fixed bin (24); 3567 dcl loc (24) fixed bin (24); 3568 dcl (sep_ct, level) fixed bin (24); 3569 dcl argstrl fixed bin (24); 3570 3571 /* &xxx */ /* xxx can be SCALAR, FIFI, or LIFO */ 3572 if (TF = "00"b) 3573 then return; 3574 begl = ifi; 3575 j = lookup (c32); 3576 if (j = 0) 3577 then do; 3578 msg = "Attempt to reference undeclared variable """; 3579 msg = msg || c32; 3580 msg = msg || """. "; 3581 goto add_identification; 3582 end; 3583 if (var.type = 0) 3584 then do; 3585 if (c32 = watchword) 3586 then call ioa_ ("^a ^i ""^va""", watchword, var.len, var.len, 3587 vartext); 3588 call putout (ofp, out_len, vartext); 3589 end; 3590 else do; 3591 arr_ptr = var.ref; 3592 if (var.type = 4) 3593 then do; 3594 if (array.l_bound > array.h_bound) 3595 then do; 3596 msg = "Attempt to reference empty fifo """; 3597 msg = msg || c32; 3598 msg = msg || """. "; 3599 goto add_identification; 3600 end; 3601 arr_elem = mod (array.l_bound, var.len) + 1; 3602 if (c32 = watchword) 3603 then call ioa_ ("^a{^i} ^i ""^va""", watchword, arr_elem, 3604 array.len (arr_elem), array.len (arr_elem), arrtext); 3605 call putout (ofp, out_len, arrtext); 3606 array.l_bound = array.l_bound + 1; 3607 if al_sw 3608 then call ioa_ ("F ^a{^i} ^i ^p", c32, arr_elem, 3609 array.len (arr_elem), array.ref (arr_elem)); 3610 free arrtext in (free_area); 3611 end; 3612 else if (var.type = 5) 3613 then do; 3614 if (array.l_bound > array.h_bound) 3615 then do; 3616 msg = "Attempt to reference empty lifo """; 3617 msg = msg || c32; 3618 msg = msg || """. "; 3619 goto add_identification; 3620 end; 3621 arr_elem = array.h_bound; 3622 if (c32 = watchword) 3623 then call ioa_ ("^a{^i} ^i ""^va""", watchword, arr_elem, 3624 array.len (arr_elem), array.len (arr_elem), arrtext); 3625 call putout (ofp, out_len, arrtext); 3626 array.h_bound = array.h_bound - 1; 3627 if al_sw 3628 then call ioa_ ("F ^a{^i} ^i ^p", c32, arr_elem, 3629 array.len (arr_elem), array.ref (arr_elem)); 3630 free arrtext in (free_area); 3631 end; 3632 else do; 3633 msg = "Attempt to make scalar reference to non-scalar """; 3634 msg = msg || c32; 3635 msg = msg || """. "; 3636 goto add_identification; 3637 end; 3638 end; 3639 end var_ref; 3640 /* -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- -+- */ 3641 /* */ 3642 /* EXTERNAL entry to cleanup the processing environment */ 3643 3644 dcl ref_path char (168); 3645 free: entry (pr_sw); 3646 3647 dcl pr_sw bit (1); 3648 3649 dcl define_area_ entry (ptr, fixed bin (35)); 3650 dcl release_area_ entry (ptr); 3651 3652 if free_area_p ^= null () 3653 then do; 3654 tptr = ext_var_ptr; 3655 call free_um ("ext"); 3656 ext_var_ptr = null (); 3657 do while (int_vars_base ^= null ()); 3658 int_var_ptr = int_vars_base; 3659 if db_sw 3660 then call ioa_ ("^p^-macro ^a", int_var_ptr, int_vars.macro); 3661 int_vars_base = int_vars.next; 3662 tptr = int_vars.ref; 3663 call free_um ("int"); 3664 if al_sw then call ioa_ ("F int_vars ^p", int_var_ptr); 3665 free int_vars in (free_area); 3666 end; 3667 tptr = macro_list_p; 3668 if (tptr ^= null ()) & pr_sw 3669 then call ioa_ ("^aS USED:", who_am_i); 3670 do while (tptr ^= null ()); 3671 maclp = tptr; 3672 if pr_sw & (macro_list.dname ^= "") 3673 then do; 3674 call ioa_ ("^i:^i ^a>^a -- (^a.macro)", macro_list.from, 3675 macro_list.to, macro_list.dname, 3676 macro_list.ename, macro_list.name); 3677 end; 3678 tptr = macro_list.next; 3679 macro_holder_p = macro_list.ref; 3680 if (substr (macro_list.dname, 1, 4) = " &") 3681 then do; 3682 macro_holder_l = macro_list.to; 3683 if al_sw 3684 then call ioa_ ("F macro_holder ^p", macro_holder_p); 3685 free macro_holder in (free_area); 3686 end; 3687 if al_sw then call ioa_ ("F macro_list ^p", maclp); 3688 free macro_list in (free_area); 3689 end; 3690 call release_area_ (free_area_p); 3691 free_area_p = null (); 3692 end; 3693 macro_list_p = null (); 3694 err_ct (*) = 0; 3695 macro_nest = 0; 3696 return; 3697 3698 dcl dname char (168); 3699 dcl ename char (32); 3700 dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin (24), char (*), fixed bin (35)); 3701 3702 3703 3704 /* * * * * * * * * * * * * * INTERNAL STATIC DATA * * * * * * * * * * * * * */ 3705 3706 dcl al_sw bit (1) int static init ("0"b); 3707 dcl db_sw bit (1) int static init ("0"b); 3708 dcl dt_sw bit (1) int static init ("0"b); 3709 dcl end_sym char (8) var; 3710 dcl err_ct (0:4) fixed bin int static init ((5) 0); 3711 dcl ext_var_ptr ptr int static init (null ()); 3712 dcl free_area_p ptr int static init (null ()); 3713 dcl int_vars_base ptr int static init (null ()); 3714 dcl lg_sw bit (1) int static init ("0"b); 3715 dcl macro_list_p ptr int static init (null ()); 3716 dcl macro_nest fixed bin int static init (0); 3717 dcl pc_sw bit (1) int static init ("0"b); 3718 dcl watchword char (32) int static init (""); 3719 dcl who_am_i char (12) var int static; 3720 3721 /* * * * * * * * * * * * * * * * CONSTANTS * * * * * * * * * * * * * * * * */ 3722 3723 dcl NL char (1) int static options (constant) init (" 3724 "); 3725 dcl space char (5) int static options (constant) init (" 3726 "); 3727 3728 /* * * * * * * * * * * * * * * * STRUCTURES * * * * * * * * * * * * * * * * */ 3729 3730 dcl var_ptr ptr; 3731 dcl 1 var based (var_ptr), 3732 2 next ptr, /* next variable in list */ 3733 2 name char (16), 3734 2 type fixed bin, /* 0-scalar 1-array 2-array var */ 3735 /* 3-list 4-fifo 5-lifo */ 3736 2 len fixed bin, /* length of data string */ 3737 2 ref ptr; /* points to data string */ 3738 dcl vartext char (var.len) based (var.ref); 3739 3740 3741 dcl arr_ptr ptr; 3742 dcl 1 array based (arr_ptr), 3743 2 lower fixed bin, 3744 2 l_bound fixed bin, /* defined lower bound */ 3745 2 h_bound fixed bin, /* defined higher bound */ 3746 2 elem (var.len), 3747 3 len fixed bin, /* length of data string */ 3748 3 ref ptr unal; /* points to data string */ 3749 dcl arrtext char (array.len (arr_elem)) based (array.ref (arr_elem)); 3750 dcl arr_elem fixed bin (24); 3751 3752 dcl int_var_ptr ptr; 3753 dcl 1 int_vars based (int_var_ptr), 3754 2 next ptr unal, 3755 2 ref ptr unal, /* points to variable definition */ 3756 2 macro char (32); /* name of macro owning it */ 3757 3758 dcl maclp ptr; 3759 dcl 1 macro_list based (maclp), 3760 2 next ptr, 3761 2 ref ptr, 3762 2 dname char (168), 3763 2 ename char (32), 3764 2 from fixed bin (24), 3765 2 to fixed bin (24), 3766 2 name char (32), 3767 2 int_mac bit (1); /* 1- ¯o/&define'ed */ 3768 3769 /* * * * * * * * * * * * * LOOSE ARRAYS and SCALARS * * * * * * * * * * * * */ 3770 3771 dcl argleng_less_than_zero condition; 3772 dcl bc fixed bin (24); 3773 dcl c32 char (32) var; 3774 dcl c32x char (32) var; 3775 dcl call_err bit (1); 3776 dcl ch_2nd char (1); 3777 dcl construct_nest fixed bin (24); 3778 dcl free_area area based (free_area_p); 3779 dcl i fixed bin (24); 3780 dcl jaf fixed bin (24); 3781 dcl local_var_ptr ptr; 3782 dcl macro_holder char (macro_holder_l) based (macro_holder_p); 3783 dcl macro_holder_l fixed bin (24); 3784 dcl macro_holder_p ptr; 3785 dcl msg_etc char (1000) var; 3786 dcl myname char (32) var; 3787 dcl output char (ofe) based (out_ptr); 3788 dcl save_db bit (1); 3789 dcl seg char (sege) based (segptr); 3790 dcl sega (sege) char (1) based (segptr); 3791 dcl sege fixed bin (24); 3792 dcl segi fixed bin (24); 3793 dcl segii fixed bin (24); 3794 dcl segment char (sege) based (segptr); 3795 dcl segptr ptr; 3796 dcl segtype char (8) var; 3797 dcl start_sym char (8) var; 3798 dcl tptr ptr; 3799 dcl token_chars char (63) int static options (constant) init ( 3800 "abcdefghijklmnopqrstuvwxyz" || 3801 "ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"); 3802 dcl tr_sw bit (1); 3803 3804 dcl error_table_$action_not_performed fixed bin (35) ext static; 3805 dcl error_table_$archive_fmt_err fixed bin (35) ext static; 3806 dcl error_table_$badsyntax fixed bin (35) ext static; 3807 dcl error_table_$new_search_list fixed bin (35) ext static; 3808 dcl error_table_$no_search_list fixed bin (35) ext static; 3809 dcl error_table_$translation_aborted fixed bin (35) ext static; 3810 dcl error_table_$translation_failed fixed bin (35) ext static; 3811 3812 dcl ioa_ entry options (variable); 3813 dcl com_err_ entry options (variable); 3814 dcl archive_util_$first_element entry (ptr, fixed bin (35)); 3815 dcl archive_util_$search entry (ptr, ptr, char (32), fixed bin (35)); 3816 dcl ioa_$nnl entry options (variable); 3817 dcl hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35)); 3818 dcl hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35)); 3819 dcl hcs_$fs_get_seg_ptr entry (char (*), ptr, fixed bin (35)); 3820 dcl get_seg_ptr_ entry (char (*), bit (6), fixed bin (24), ptr, fixed bin (35)); 3821 dcl mac_sw bit (1); 3822 3823 dcl (addr, addrel, char, convert, divide, fixed, hbound, index, length, ltrim, 3824 max, min, mod, null, reverse, rtrim, search, size, string, substr, 3825 translate, verify) builtin; 3826 dbn: entry; db_sw = "1"b; return; 3827 dtn: entry; dt_sw = "1"b; return; 3828 aln: entry; al_sw = "1"b; return; 3829 pcn: entry; pc_sw = "1"b; return; 3830 lgn: entry; lg_sw = "1"b; return; 3831 lgf: entry; lg_sw = "0"b; return; 3832 pcf: entry; pc_sw = "0"b; return; 3833 alf: entry; al_sw = "0"b; return; 3834 dtf: entry; dt_sw = "0"b; return; 3835 dbf: entry; db_sw = "0"b; return; 3836 3837 watch: entry (watchfor); 3838 dcl watchfor char (*); 3839 3840 watchword = watchfor; 3841 return; 3842 3843 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 02/14/84 0844.2 macro_.pl1 >special_ldd>on>6591>macro_.pl1 1231 1 06/11/76 1043.4 area_info.incl.pl1 >ldd>include>area_info.incl.pl1 1619 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 000371 constant fixed bin(17,0) initial dcl 2-6 set ref 1620* HT_sw 000103 automatic bit(1) unaligned dcl 3262 set ref 3270* 3272* 3274* NL 000220 constant char(1) initial unaligned dcl 3723 set ref 205 520 523 711* 1115 1117 1316 1725* 1833 2083 2098 2102 3266 TF parameter bit(2) unaligned dcl 1549 in procedure "macro_af" set ref 1547 1567* 1586* 1607 TF parameter bit(2) unaligned dcl 283 in procedure "ampersand" set ref 281 299* 321* 336* 339* 390* 396* 400* 402* 405* 408* 423* 426* 429* 438* 441* 444* 447* 450* 453* 456* 459* 462* 465* 541* TF parameter bit(2) unaligned dcl 942 in procedure "dumper" set ref 940 949* TF parameter bit(2) unaligned dcl 1241 in procedure "get_range" set ref 1239 1260* 1266* TF parameter bit(2) unaligned dcl 2261 in procedure "macro_length" set ref 2259 2281* 2305* TF parameter bit(2) unaligned dcl 1331 in procedure "logical" set ref 1329 1375* 1381 1386* 1391* 1394* 1433* 1441 1447* 1450* 1453* 1456* 1459* 1462* 1465* 1468* 1471* 1474* 1477* 1480* 1483* TF parameter bit(2) unaligned dcl 3407 in procedure "var_range" set ref 3405 3448* 3451 3527* 3534 TF parameter bit(2) unaligned dcl 633 in procedure "arithmetic" set ref 631 652* 675* 698 TF parameter bit(2) unaligned dcl 1773 in procedure "macro_define" set ref 1771 1793* 1813 1852* TF parameter bit(2) unaligned dcl 1861 in procedure "macro_do" set ref 1859 1880* 1881 1886 1892 TF parameter bit(2) unaligned dcl 2861 in procedure "macro_scan" set ref 2859 2881* 2915 2920* TF parameter bit(2) unaligned dcl 3135 in procedure "macro_usage" set ref 3133 3159* 3190* TF 000103 automatic bit(2) unaligned dcl 2146 in procedure "macro_if" set ref 2156* 2157* 2161* 2163* 2165 2179 2179 2182 2191 2207 2207 2210 TF parameter bit(2) unaligned dcl 2027 in procedure "macro_error" set ref 2025 2048* 2053* 2119* TF parameter bit(2) unaligned dcl 560 in procedure "arg_range" set ref 558 583* 607* 614 TF parameter bit(2) unaligned dcl 1948 in procedure "macro_empty" set ref 1947 1967* TF parameter bit(2) unaligned dcl 2314 in procedure "macro_let" set ref 2312 2343* 2461* 2665* 2684* TF parameter bit(2) unaligned dcl 1642 in procedure "macro_call" set ref 1640 1666* 1688* TF parameter bit(2) unaligned dcl 2929 in procedure "macro_substr" set ref 2927 2951* 2968* 2983* 2992* 2999 TF parameter bit(2) unaligned dcl 3323 in procedure "var_bound" set ref 3321 3359* TF parameter bit(2) unaligned dcl 3556 in procedure "var_ref" ref 3554 3572 addr builtin function dcl 3823 ref 1228 1228 1734 1736 1736 2099 2099 2103 2103 2915 2915 addrel builtin function dcl 3823 ref 2099 2099 ai 001012 automatic structure level 1 unaligned dcl 1232 set ref 1228 1228 al_sw 000010 internal static bit(1) initial unaligned dcl 3706 set ref 159 172 261 1189 1203 1211 1515 2406 2487 2706 2713 2754 2762 3607 3627 3664 3683 3687 3828* 3833* 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 1222 areap 16 001012 automatic pointer level 2 dcl 1232 set ref 1227* 1229 arg based char unaligned dcl 62 set ref 164* 316* 618* argct parameter fixed bin(17,0) dcl 43 ref 16 28 72 163 166 316 327 327 582 616 argl based structure array level 1 unaligned dcl 59 argleng_less_than_zero 000256 stack reference condition dcl 3771 ref 73 arglp parameter pointer dcl 43 ref 16 28 73 75 164 164 164 164 316 316 316 618 618 618 args 000100 automatic structure array level 1 unaligned dcl 1719 set ref 1736 1736 argstr 000100 automatic char unaligned dcl 2906 in begin block on line 2905 set ref 2913* 2915 2915 argstr 000100 automatic char unaligned dcl 2838 in begin block on line 2837 set ref 2839* 2842 2846 2846 argstr 000100 automatic char unaligned dcl 2978 in begin block on line 2977 set ref 2980* 3044 3049 3049 argstr 000100 automatic char(1) array unaligned dcl 1720 in begin block on line 1718 set ref 1727* 1734 argstrl 000565 automatic fixed bin(24,0) dcl 2874 in procedure "macro_scan" set ref 2899* 2900 2906 2910 2910 2913 2915* argstrl 000402 automatic fixed bin(24,0) dcl 1655 in procedure "macro_call" set ref 1712* 1713 1720 1725 1725 1727 1729 argstrl 000601 automatic fixed bin(24,0) dcl 2942 in procedure "macro_substr" set ref 2971* 2972 2978 2980 3001 3003 3021 3035 3042 3048 arithchar 000167 constant char(28) initial unaligned dcl 717 ref 719 736 736 785 786 arr_elem 000250 automatic fixed bin(24,0) dcl 3750 set ref 1200* 1201 1203 1203 1203 1203 1203 1207 1207 1207* 2490* 2491 2492* 2735* 2736 2736* 2749* 2750 2752 2754* 2754 2754 2758 2758 2758 2760 2761 2761 2761 2762* 2762 2762 2762 2762 2762 2762 2762 2767 2767* 3539* 3540 3540 3540 3541* 3601* 3602* 3602 3602 3602 3602 3602 3605 3605 3605 3607* 3607 3607 3610 3610 3610 3621* 3622* 3622 3622 3622 3622 3622 3625 3625 3625 3627* 3627 3627 3630 3630 3630 arr_ptr 000246 automatic pointer dcl 3741 set ref 1196* 1197 1197 1201 1203 1203 1203 1203 1203 1207 1207 1207 2008* 2012 2012 2013 2013 2017 2018 2457* 2458 2459 2485* 2486 2487 2487 2491 2492 2494 2501 2514 2515 2529 2530 2538 2538 2545 2546 2554 2554 2561 2562 2568 2568 2574 2575 2586* 2587 2592 2615* 2616 2616 2623 2623 2628 2628 2629 2633* 2634 2641 2646 2646 2727* 2730 2730 2731 2731 2735 2735 2736 2736 2742 2747 2747 2749 2749 2750 2752 2754 2754 2758 2758 2758 2760 2761 2761 2761 2762 2762 2762 2762 2762 2762 2762 2767 2767 3379* 3384 3386 3444* 3445 3446 3450* 3472 3473 3482 3483 3493 3498 3537* 3538 3539 3540 3540 3540 3591* 3594 3594 3601 3602 3602 3602 3602 3602 3605 3605 3605 3606 3606 3607 3607 3610 3610 3610 3614 3614 3621 3622 3622 3622 3622 3622 3625 3625 3625 3626 3626 3627 3627 3630 3630 3630 array based structure level 1 unaligned dcl 3742 set ref 2485 2487 2487 arrtext based char unaligned dcl 3749 set ref 1203* 1207 2736 2758 2761 2762 2762 2767* 3540* 3602* 3605* 3610 3622* 3625* 3630 bc 000264 automatic fixed bin(24,0) dcl 3772 set ref 1099* 1112 begl 000562 automatic fixed bin(24,0) dcl 2867 in procedure "macro_scan" set ref 2878* 2889* 2909* begl 000230 automatic fixed bin(24,0) dcl 1648 in procedure "macro_call" set ref 1662* 1678* 1693* 1723* 1738* 1742 begl 000112 automatic fixed bin(24,0) dcl 566 in procedure "arg_range" set ref 579* 593* 624* begl 000100 automatic fixed bin(24,0) dcl 3226 in procedure "protected" set ref 3237* 3244* begl 000470 automatic fixed bin(24,0) dcl 2033 in procedure "macro_error" set ref 2045* 2071* begl 000100 automatic fixed bin(24,0) dcl 2139 in procedure "macro_if" set ref 2153* 2159* 2173* 2218* begl 000514 automatic fixed bin(24,0) dcl 2321 in procedure "macro_let" set ref 2340* 2349* 2465* 2652* 2661* 2675* 2692* 2720* 2771* begl 000550 automatic fixed bin(24,0) dcl 2793 in procedure "macro_quote" set ref 2803* 2813* begl parameter fixed bin(24,0) dcl 960 in procedure "error_missing" set ref 958 971 976 982 987 995* begl 000214 automatic fixed bin(24,0) dcl 1555 in procedure "macro_af" set ref 1564* 1576* begl 001100 automatic fixed bin(24,0) dcl 3562 in procedure "var_ref" set ref 3574* begl 000100 automatic fixed bin(24,0) dcl 1337 in procedure "logical" set ref 1350* 1375* 1433* begl 000446 automatic fixed bin(24,0) dcl 1954 in procedure "macro_empty" set ref 1964* 1975* 1983* 1990* 1999* 2006* begl 000574 automatic fixed bin(24,0) dcl 2935 in procedure "macro_substr" set ref 2948* 2959* begl 000502 automatic fixed bin(24,0) dcl 2267 in procedure "macro_length" set ref 2278* 2289* begl 001012 automatic fixed bin(24,0) dcl 3413 in procedure "var_range" set ref 3428* 3514* begl 000100 automatic fixed bin(24,0) dcl 291 in procedure "ampersand" set ref 298* 417* 503* 515* 530* begl 000434 automatic fixed bin(24,0) dcl 1779 in procedure "macro_define" set ref 1790* 1801* 1822* 1828* 1840* begl 000624 automatic fixed bin(24,0) dcl 3141 in procedure "macro_usage" set ref 3156* 3167* begl 000100 automatic fixed bin(24,0) dcl 1867 in procedure "macro_do" set ref 1877* 1898* 1909* 1941* begl 000610 automatic fixed bin(24,0) dcl 3069 in procedure "macro_unquote" set ref 3079* 3089* begl 000100 automatic fixed bin(24,0) dcl 639 in procedure "arithmetic" set ref 651* 710* beglt 000101 automatic fixed bin(24,0) dcl 2140 set ref 2153* 2165* 2175* 2182* 2185* 2198* 2210* 2213* 2223* c32 000265 automatic varying char(32) dcl 3773 set ref 95* 96 118* 120* 122 132 181 347* 370* 382 383* 400 402 405 408 411 423 426 429 432 438 441 444 447 450 453 456 459 462 465 468 468 468 468 468 468 475* 475 481 487 518* 536* 547 1286* 1294* 1383* 1386 1386 1386 1386 1588 1664 1690 1831* 1840* 1845* 1888 1890 1895 1900 1913 1915 1917 1927 1929 1940 2170 2176 2187 2189 2203 2205 2215 2221 2234* 2239 2241 2243 2245 2247 3348 3375 3384 3392 3430* 3439 3459 3466 3476 3486 3575* 3579 3585 3597 3602 3607* 3617 3622 3627* 3634 c32x 000276 automatic varying char(32) dcl 3774 set ref 371* 382* 1663 call_err 000307 automatic bit(1) unaligned dcl 3775 set ref 170* 186 199 1743* callmac 000414 automatic varying char(32) dcl 1657 set ref 1664* 1678 1723* 1736* callseg 000403 automatic varying char(32) dcl 1656 set ref 1663* 1723* 1736* ch 000614 automatic char(1) unaligned dcl 3075 in procedure "macro_unquote" set ref 3106* 3107 3123 ch 000120 automatic char(1) unaligned dcl 923 in procedure "cvt" set ref 927* 928 928* 930 ch_2nd 000310 automatic char(1) unaligned dcl 3776 set ref 320* 321 324 330 333 336 339 342 345 351 char builtin function dcl 3823 ref 78 327 327 1321 2301 2301 3038 3040 3042 cline 000473 automatic varying char(6) dcl 965 set ref 995* 1011 1014 cmd 000054 internal static char(4) initial array unaligned dcl 2653 set ref 2343* 2349* 2465* 2652* 2661* 2675* 2692* 2720* 2771* com_err_ 000100 constant entry external dcl 3813 ref 1093 construct_nest 000311 automatic fixed bin(24,0) dcl 3777 set ref 169* 491 656* 656 696* 696 949* 1348* 1348 1429* 1429 1570* 1570 1605* 1605 1672* 1672 1710* 1710 1795* 1795 1849* 1849 1885* 1885 1934* 1934 2051* 2051 2116* 2116 2178* 2178 2193* 2193 2220* 2220 2283* 2283 2302* 2302 2669* 2669 2687* 2687 2807* 2807 2832* 2832 2883* 2883 2916* 2916 2953* 2953 3054* 3054 3083* 3083 3102* 3102 3161* 3161 3187* 3187 control 1 001012 automatic structure level 2 dcl 1232 set ref 1223* convert builtin function dcl 3823 ref 753 908 908 ctl 000627 automatic varying char(100) dcl 3149 set ref 3177* 3182* cu_$evaluate_active_string 000112 constant entry external dcl 1617 ref 1620 cv6 000100 automatic varying char(6) dcl 1306 set ref 1321* 1322 db_sw 000011 internal static bit(1) initial unaligned dcl 3707 set ref 88 98 106 120 130 157* 159 172 216* 238 251 272 299 652 708 730 1041 1084 1180 1197 1373 1431 1567 1666 1721 1793 1838 1880 1967 2048 2157 2165 2182 2198 2210 2223 2281 2343 2416 2423 2430 2718 2769 2881 2907 2951 3159 3210 3659 3826* 3835* define_area_ 000060 constant entry external dcl 3649 ref 1228 divide builtin function dcl 3823 ref 1112 dname 4 based char(168) level 2 in structure "macro_list" packed unaligned dcl 3759 in procedure "macro_" set ref 106 106 265* 272* 3182* 3672 3674* 3680 dname parameter char(168) unaligned dcl 230 in procedure "addmacro" set ref 228 238* 265 dname 000156 automatic char(168) unaligned dcl 3698 in procedure "macro_" set ref 535* 1086* 1096* 1099* 1125 1150* dt_sw 000012 internal static bit(1) initial unaligned dcl 3708 set ref 3210 3827* 3834* e 000105 automatic fixed bin(24,0) dcl 1309 set ref 1313* ecode parameter fixed bin(35,0) dcl 43 set ref 16 28 80* 85* 184* 214* 1018* 1086* 1088 1091* 1096* 1099 1099* 1102 1108* 1128* 1228* 1620* 1623 1736* 1738 1740 2112* elem 3 based structure array level 2 unaligned dcl 3742 eline 000476 automatic varying char(6) dcl 965 set ref 996* 1004 1011 elseif 000107 automatic bit(1) unaligned dcl 2148 set ref 2158* 2165* 2194* ename 000230 automatic char(32) unaligned dcl 3699 in procedure "macro_" set ref 535* ename 56 based char(32) level 2 in structure "macro_list" packed unaligned dcl 3759 in procedure "macro_" set ref 130* 132 244 266* 272* 3182* 3674* end_sym 000240 automatic varying char(8) dcl 3709 set ref 484* 490* 523 528 538 endl parameter fixed bin(24,0) dcl 960 set ref 958 971 976 982 987 996* err_ct 000013 internal static fixed bin(17,0) initial array dcl 3710 set ref 214 214 1625* 2082* 2082 3694* err_sw parameter bit(1) unaligned dcl 283 ref 281 476 error_table_$badsyntax 000066 external static fixed bin(35,0) dcl 3806 ref 184 1018 error_table_$no_search_list 000070 external static fixed bin(35,0) dcl 3808 ref 1088 error_table_$translation_aborted 000072 external static fixed bin(35,0) dcl 3809 ref 2112 error_table_$translation_failed 000074 external static fixed bin(35,0) dcl 3810 ref 214 ext_var_ptr 000020 internal static pointer initial dcl 3711 set ref 1534 2414 2415* 3654 3656* extend 1 001012 automatic bit(1) level 3 packed unaligned dcl 1232 set ref 1224* fixed builtin function dcl 3823 ref 1261 1267 2165 2984 2993 found 000534 automatic fixed bin(24,0) dcl 2328 set ref 2402* 2403 2434 2481 2499 2521 2536 2552 2566 2695 free_area based area(1024) dcl 3778 ref 260 1191 1207 1212 1514 1836 2405 2485 2709 2712 2758 2761 3610 3630 3665 3685 3688 free_area_p 000022 internal static pointer initial dcl 3712 set ref 66 260 1191 1207 1212 1229* 1514 1836 2405 2485 2709 2712 2758 2761 3610 3630 3652 3665 3685 3688 3690* 3691* from 66 based fixed bin(24,0) level 2 dcl 3759 set ref 112 135 247 267* 272* 3674* h_bound 2 based fixed bin(17,0) level 2 dcl 3742 set ref 2012* 2018* 2459 2515* 2530* 2538 2546* 2554 2562* 2568 2575* 2616 2623 2628* 2628 2629 2634 2641 2646 2646* 2731* 2731 2735 2742 2747 2747* 3386 3446 3473 3482 3498 3594 3614 3621 3626* 3626 hbound builtin function dcl 3823 ref 2393 hcs_$fs_get_path_name 000064 constant entry external dcl 3700 ref 535 1083 hcs_$make_ptr 000110 constant entry external dcl 1090 ref 1091 higher 000536 automatic fixed bin(24,0) dcl 2329 set ref 2454* 2459* 2461* 2472 2484 2487* 2501 2514 2523 2538 2554 2568 2575 2592 2629* 2646* 2731 2747* 2749 2771* hold 000100 automatic varying char(1000) dcl 964 set ref 967* 968* 968 973* 978* 979* 979 984* 989* 990* 990 993* 993 1007 i 000101 automatic fixed bin(24,0) dcl 643 in procedure "arithmetic" set ref 657* 659 664 666* 666 667 667 668 713* 719 722 734* 734 734 748 750 753 756* 756 764 769* 769 788* i 000770 automatic fixed bin(24,0) dcl 3333 in procedure "var_bound" set ref 3343* 3345 3352 3354 3354 3355 3384* 3386* i 000447 automatic fixed bin(24,0) dcl 1958 in procedure "macro_empty" set ref 1968* 1970 1970* 1972 1977 1993* 1994 i 000101 automatic fixed bin(24,0) dcl 1871 in procedure "macro_do" set ref 1904* 1906 1911 i 000563 automatic fixed bin(24,0) dcl 2871 in procedure "macro_scan" set ref 2884* 2886 2891 2893 2893 2894 i 000101 automatic fixed bin(24,0) dcl 1341 in procedure "logical" set ref 1351* 1353 1359 1361* 1361 1362 1362 1363 i parameter fixed bin(24,0) dcl 1251 in procedure "get_range" set ref 1239 1261* i 000101 automatic fixed bin(24,0) dcl 3230 in procedure "protected" set ref 3240* 3241 3246 3246 3247 i 000471 automatic fixed bin(24,0) dcl 2037 in procedure "macro_error" set ref 2066* 2068 2073 2075 2075 2076 2081* 2082 2082 2084 2086 2105 i 000435 automatic fixed bin(24,0) dcl 1783 in procedure "macro_define" set ref 1796* 1798 1803 1805* 1805 1806 1806 1807 1815* 1816* 1816 1816 1816 1817 1817 1831 1832* 1832 1833 1835 1837 i 000575 automatic fixed bin(24,0) dcl 2939 in procedure "macro_substr" set ref 2954* 2956 2961 2963 2963 2964 2984* 3001 3001* 3001 3003 3012 3017 3021 3030 3035 3038 3048 3049 3049 i 000625 automatic fixed bin(24,0) dcl 3145 in procedure "macro_usage" set ref 3162* 3164 3169 3171 3171 3172 i 000100 automatic fixed bin(24,0) dcl 3295 in procedure "strip2" set ref 3297* 3299 3301 3304* 3305 3307* 3308 3313 i 000101 automatic fixed bin(24,0) dcl 295 in procedure "ampersand" set ref 305* 306 308 309* 310 312 357* 360 360* 362 364 370 373 375 377* 381* 383 387 387 389 393 393 395 413* 414 419 500 507* 510 512 517* 517 518 519 523* 524 532 532 536 538 542 i 000102 automatic fixed bin(24,0) dcl 2145 in procedure "macro_if" set ref 2231* 2232 2237 i 001013 automatic fixed bin(24,0) dcl 3417 in procedure "var_range" set ref 3430* 3431 3445* 3448* 3456 3463 3472 3472* 3473 3482 3482* 3483 3493 3539 i 000100 automatic fixed bin(24,0) dcl 3261 in procedure "show_string" set ref 3264* 3265 3266 3269 3273 3274 3274 3275* i 000611 automatic fixed bin(24,0) dcl 3073 in procedure "macro_unquote" set ref 3084* 3086 3091 3093 3093 3103* 3121* 3121 3123 3126 i 000113 automatic fixed bin(24,0) dcl 570 in procedure "arg_range" set ref 581* 583* 617 i 000503 automatic fixed bin(24,0) dcl 2271 in procedure "macro_length" set ref 2284* 2286 2291 2293 2293 2294 2299* 2301 2301 i 000312 automatic fixed bin(24,0) dcl 3779 in procedure "macro_" set ref 1115* 1117* 1118 1131 1132* 1137* 1140 1149 1289* 1290 1290* 1292 1292* 1294 1312* 1314 1316 1317* 1319* 1319 i 000117 automatic fixed bin(24,0) dcl 920 in procedure "cvt" set ref 926* 927* i 000215 automatic fixed bin(24,0) dcl 1559 in procedure "macro_af" set ref 1571* 1573 1578 1580* 1580 1581 1581 1582 i 000551 automatic fixed bin(24,0) dcl 2797 in procedure "macro_quote" set ref 2808* 2810 2815 2817 2817 2826* 2827 2833 2838 2839 2844 2850 i 000100 automatic fixed bin(24,0) dcl 1038 in procedure "expand" set ref 1043* 1044 1044* 1046* 1046 1047 1049 1049 1050 i 000515 automatic fixed bin(24,0) dcl 2325 in procedure "macro_let" set ref 2344* 2346 2351* 2353 2353* 2355* 2355 2356 2357 2362 2393* 2394* 2670* 2672 2677 2679 2679 2680 i 000231 automatic fixed bin(24,0) dcl 1652 in procedure "macro_call" set ref 1673* 1675 1680 1682* 1682 1683 1683 1684 1731* 1732 1732 1732 1733 1734* if_lineno 000104 automatic varying char(6) dcl 2147 set ref 2159* 2165* 2182* 2198* 2210* 2223* ife parameter fixed bin(24,0) dcl 1331 in procedure "logical" set ref 1329 1349* 1351 1362 1362 1368 1368 1394* 1416* 1418 1423 1423 1426 1426 1447* ife parameter fixed bin(24,0) dcl 283 in procedure "ampersand" set ref 281 299* 300 321* 333* 336* 339* 342* 357 360 370 376 383 387 390* 393 396* 400* 402* 405* 408* 413 417* 423* 426* 429* 438* 441* 444* 447* 450* 453* 456* 459* 462* 465* 501 507 518 523 530* 532 532 541* ife parameter fixed bin(24,0) dcl 3221 in procedure "protected" set ref 3219 3240 3244* 3246 3246 3248 ife parameter fixed bin(24,0) dcl 1773 in procedure "macro_define" set ref 1771 1792* 1793* 1796 1801* 1806 1806 1809 1812* 1852* ife parameter fixed bin(24,0) dcl 2786 in procedure "macro_quote" set ref 2784 2805* 2808 2813* 2817 2817 2820 2822* 2825* ife parameter fixed bin(24,0) dcl 2261 in procedure "macro_length" set ref 2259 2280* 2281* 2284 2289* 2293 2293 2296 2298* 2305* ife parameter fixed bin(24,0) dcl 1278 in procedure "get_token" set ref 1276 1283* 1284 1289 1290 1294 ife parameter fixed bin(24,0) dcl 633 in procedure "arithmetic" set ref 631 652* 657 667 667 672 675* 724 ife parameter fixed bin(24,0) dcl 3135 in procedure "macro_usage" set ref 3133 3158* 3159* 3162 3167* 3171 3171 3174 3176* 3190* ife parameter fixed bin(24,0) dcl 2131 in procedure "macro_if" set ref 2129 2155* 2157* 2161* 2169* 2177* 2179* 2190* 2206* 2207* 2222* 2231 2238* 2239* 2247* ife parameter fixed bin(24,0) dcl 3323 in procedure "var_bound" set ref 3321 3342* 3343 3354 3354 3357 3359* ife parameter fixed bin(24,0) dcl 560 in procedure "arg_range" set ref 558 583* 589 593* 598 598 607* ife parameter fixed bin(24,0) dcl 1549 in procedure "macro_af" set ref 1547 1566* 1567* 1571 1576* 1581 1581 1586* ife parameter fixed bin(24,0) dcl 1642 in procedure "macro_call" set ref 1640 1665* 1666* 1673 1678* 1683 1683 1688* 1693* 1763* ife parameter fixed bin(24,0) dcl 919 in procedure "cvt" ref 915 926 ife parameter fixed bin(24,0) dcl 1948 in procedure "macro_empty" set ref 1947 1966* 1967* 1968 1970 1977 1986* 1987 1992* ife parameter fixed bin(24,0) dcl 3556 in procedure "var_ref" ref 3554 ife parameter fixed bin(24,0) dcl 2929 in procedure "macro_substr" set ref 2927 2950* 2951* 2954 2959* 2963 2963 2968* 2983* 2992* 2996 2998* ife parameter fixed bin(24,0) dcl 3407 in procedure "var_range" set ref 3405 3448* 3510 3514* 3518 3518 3527* ife parameter fixed bin(24,0) dcl 3290 in procedure "strip2" ref 3284 3288 3297 3299 3302 3304 3305 3307 ife parameter fixed bin(24,0) dcl 1861 in procedure "macro_do" set ref 1859 1879* 1880* 1886* 1893* 1894* 1901* 1904 1909* 1912* 1913* 1915* 1931* ife parameter fixed bin(24,0) dcl 1241 in procedure "get_range" set ref 1239 1260* 1266* ife parameter fixed bin(24,0) dcl 1028 in procedure "expand" set ref 1026 1041* 1042 1043 1044 1049 1049 1052 1055* ife parameter fixed bin(24,0) dcl 2861 in procedure "macro_scan" set ref 2859 2880* 2881* 2884 2889* 2893 2893 2896 2898* 2920* ife parameter fixed bin(24,0) dcl 3062 in procedure "macro_unquote" set ref 3060 3081* 3084 3089* 3093 3093 3096 3098* 3101* ife parameter fixed bin(24,0) dcl 942 in procedure "dumper" set ref 940 949* 949* ife parameter fixed bin(24,0) dcl 2027 in procedure "macro_error" set ref 2025 2047* 2048* 2053* 2062* 2066 2071* 2075 2075 2078 2080* 2119* ife parameter fixed bin(24,0) dcl 2314 in procedure "macro_let" set ref 2312 2342* 2343* 2344 2351 2353 2356 2442* 2443 2446* 2461* 2468* 2496 2518 2533 2549 2578* 2598* 2599 2602* 2656* 2663 2665* 2666* 2670 2675* 2679 2679 2682 2684* 2689 2692* 2694* ifi parameter fixed bin(24,0) dcl 633 in procedure "arithmetic" set ref 631 651 651* 652* 657 667 667 668* 668 670 672 675* 681* 681 689* 689 692* 692 710 724 ifi parameter fixed bin(24,0) dcl 1948 in procedure "macro_empty" set ref 1947 1964 1965* 1965 1966* 1967* 1968 1970 1975* 1977 1983* 1985* 1985 1986* 1987 1990* 1992* 1999* 2006* ifi parameter fixed bin(24,0) dcl 2786 in procedure "macro_quote" set ref 2784 2803 2804* 2804 2805* 2808 2817 2817 2818* 2818 2820 2822* 2825* ifi parameter fixed bin(24,0) dcl 1861 in procedure "macro_do" set ref 1859 1877 1878* 1878 1879* 1880* 1883 1886* 1890* 1890 1893* 1894* 1898* 1900* 1900 1901* 1904 1911* 1911 1912* 1913* 1915* 1922* 1922 1929* 1929 1931* 1937* 1941* ifi parameter fixed bin(24,0) dcl 2861 in procedure "macro_scan" set ref 2859 2878 2879* 2879 2880* 2881* 2884 2893 2893 2894* 2894 2896 2898* 2909 2920* ifi parameter fixed bin(24,0) dcl 2027 in procedure "macro_error" set ref 2025 2045 2046* 2046 2047* 2048* 2052* 2052 2053* 2062* 2063 2065* 2065 2066 2075 2075 2076* 2076 2078 2080* 2097* 2119* ifi parameter fixed bin(24,0) dcl 2261 in procedure "macro_length" set ref 2259 2278 2279* 2279 2280* 2281* 2284 2293 2293 2294* 2294 2296 2298* 2305* ifi parameter fixed bin(24,0) dcl 942 in procedure "dumper" set ref 940 949* 949* ifi parameter fixed bin(24,0) dcl 2131 in procedure "macro_if" set ref 2129 2153 2154* 2154 2155* 2157* 2161* 2165 2169* 2173* 2175 2176* 2176 2177* 2179* 2182 2185 2189* 2189 2190* 2198 2205* 2205 2206* 2207* 2210 2213 2218* 2221* 2221 2222* 2223 2231 2237* 2237 2238* 2239* 2247* 2249* 2249 ifi parameter fixed bin(24,0) dcl 2314 in procedure "macro_let" set ref 2312 2340 2341* 2341 2342* 2343* 2344 2349* 2351 2353 2356 2362* 2362 2442* 2443 2446* 2449 2451* 2451 2461* 2462 2465* 2467* 2467 2468* 2496 2498* 2498 2518 2520* 2520 2533 2535* 2535 2549 2551* 2551 2578* 2598* 2599 2602* 2649 2652* 2655* 2655 2656* 2658 2661* 2663 2665* 2666* 2670 2679 2679 2680* 2680 2682 2684* 2689 2694* 2720 2771 ifi parameter fixed bin(24,0) dcl 3221 in procedure "protected" set ref 3219 3237 3238* 3238 3240 3246 3246 3247* 3247 3248 3251* 3251 ifi parameter fixed bin(24,0) dcl 283 in procedure "ampersand" set ref 281 298 299* 300 305 309 313* 313 315* 315 320 321* 326* 326 330* 330 333* 336* 339* 342* 353* 353 357 360 370 373 375* 375 376 379 383 387 387 389* 389 390* 393 393 395* 395 396* 400* 402* 405* 408* 413 419* 419 423* 426* 429* 438* 441* 444* 447* 450* 453* 456* 459* 462* 465* 500* 500 501 503* 506* 506 507 515* 518 519* 519 520 522* 522 523 532 532 536* 536 538* 538 541* 542* 542 ifi parameter fixed bin(24,0) dcl 3135 in procedure "macro_usage" set ref 3133 3156 3157* 3157 3158* 3159* 3162 3171 3171 3172* 3172 3174 3176* 3190* ifi parameter fixed bin(24,0) dcl 1278 in procedure "get_token" set ref 1276 1283* 1284 1289 1290 1294 ifi parameter fixed bin(24,0) dcl 1241 in procedure "get_range" set ref 1239 1253 1253 1256* 1256 1260* 1263 1265* 1265 1266* ifi parameter fixed bin(24,0) dcl 3323 in procedure "var_bound" set ref 3321 3342* 3343 3354 3354 3355* 3355 3357 3359* ifi parameter fixed bin(24,0) dcl 1549 in procedure "macro_af" set ref 1547 1564 1565* 1565 1566* 1567* 1571 1581 1581 1582* 1582 1584 1586* 1594* 1594 1600* 1600 ifi parameter fixed bin(24,0) dcl 1028 in procedure "expand" set ref 1026 1041* 1042 1043 1044 1049 1049 1050* 1050 1052 1054 1055* 1056 ifi parameter fixed bin(24,0) dcl 1642 in procedure "macro_call" set ref 1640 1662 1665* 1666* 1673 1683 1683 1684* 1684 1686 1688* 1699* 1699 1705* 1705 1723 1738* 1742* 1751* 1751 1763* ifi parameter fixed bin(24,0) dcl 3290 in procedure "strip2" set ref 3284 3286* 3286 3288 3297 3299* 3301* 3301 3302 3304 3305 3307 3311* 3311 3313* 3313 ifi parameter fixed bin(24,0) dcl 919 in procedure "cvt" ref 915 926 926 ifi parameter fixed bin(24,0) dcl 2929 in procedure "macro_substr" set ref 2927 2948 2949* 2949 2950* 2951* 2954 2963 2963 2964* 2964 2966 2968* 2982* 2982 2983* 2987 2987 2990 2991* 2991 2992* 2996 2998* ifi parameter fixed bin(24,0) dcl 1773 in procedure "macro_define" set ref 1771 1790 1791* 1791 1792* 1793* 1796 1806 1806 1807* 1807 1809 1811* 1811 1812* 1822* 1828* 1840 1852* ifi parameter fixed bin(24,0) dcl 3407 in procedure "var_range" set ref 3405 3428 3447* 3447 3448* 3506 3508* 3508 3510 3518 3518 3519* 3519 3521 3527* 3530 3532* 3532 ifi parameter fixed bin(24,0) dcl 560 in procedure "arg_range" set ref 558 579 583* 585 587* 587 589 598 598 599* 599 601 607* 610 612* 612 624* ifi parameter fixed bin(24,0) dcl 1331 in procedure "logical" set ref 1329 1349* 1350 1351 1362 1362 1363* 1363 1365 1368 1368 1375 1394* 1396 1402* 1402 1406* 1406 1410* 1410 1416* 1418 1423 1423 1424* 1424 1426 1426 1433 1447* ifi parameter fixed bin(24,0) dcl 3556 in procedure "var_ref" ref 3554 3574 ifi parameter fixed bin(24,0) dcl 3062 in procedure "macro_unquote" set ref 3060 3079 3080* 3080 3081* 3084 3093 3093 3094* 3094 3096 3098* 3101* ifp parameter pointer dcl 2861 in procedure "macro_scan" set ref 2859 2880* 2881* 2884 2893 2893 2896 2898* 2920* ifp parameter pointer dcl 2261 in procedure "macro_length" set ref 2259 2280* 2281* 2284 2293 2293 2296 2298* 2305* ifp parameter pointer dcl 1549 in procedure "macro_af" set ref 1547 1566* 1567* 1571 1581 1581 1584 1586* ifp parameter pointer dcl 942 in procedure "dumper" set ref 940 949* ifp parameter pointer dcl 1642 in procedure "macro_call" set ref 1640 1665* 1666* 1673 1683 1683 1686 1688* 1736* 1763* ifp parameter pointer dcl 2131 in procedure "macro_if" set ref 2129 2155* 2157* 2161* 2169* 2177* 2179* 2190* 2206* 2207* 2222* 2231 2238* 2239* 2247* ifp parameter pointer dcl 1028 in procedure "expand" set ref 1026 1041* 1043 1049 1049 1055* ifp parameter pointer dcl 3556 in procedure "var_ref" ref 3554 ifp parameter pointer dcl 2027 in procedure "macro_error" set ref 2025 2047* 2048* 2053* 2062* 2063 2066 2075 2075 2078 2080* 2119* ifp parameter pointer dcl 1861 in procedure "macro_do" set ref 1859 1879* 1880* 1886* 1893* 1894* 1901* 1904 1912* 1913* 1915* 1931* ifp parameter pointer dcl 3221 in procedure "protected" ref 3219 3240 3246 3246 3248 ifp parameter pointer dcl 1773 in procedure "macro_define" set ref 1771 1792* 1793* 1796 1806 1806 1809 1812* 1852* ifp parameter pointer dcl 633 in procedure "arithmetic" set ref 631 652* 657 667 667 670 672 675* ifp parameter pointer dcl 3323 in procedure "var_bound" set ref 3321 3342* 3343 3354 3354 3357 3359* ifp parameter pointer dcl 3290 in procedure "strip2" ref 3284 3288 3297 3302 3304 3305 3307 ifp parameter pointer dcl 3062 in procedure "macro_unquote" set ref 3060 3081* 3084 3093 3093 3096 3098* 3101* ifp parameter pointer dcl 3135 in procedure "macro_usage" set ref 3133 3158* 3159* 3162 3171 3171 3174 3176* 3190* ifp parameter pointer dcl 918 in procedure "cvt" ref 915 927 ifp parameter pointer dcl 1331 in procedure "logical" set ref 1329 1349* 1351 1362 1362 1365 1368 1368 1394* 1396 1416* 1418 1423 1423 1426 1426 1447* ifp parameter pointer dcl 2314 in procedure "macro_let" set ref 2312 2342* 2343* 2344 2351 2356 2442* 2443 2446* 2449 2461* 2462 2468* 2496 2518 2533 2549 2578* 2598* 2599 2602* 2649 2656* 2658 2663 2665* 2666* 2670 2679 2679 2682 2684* 2689 2694* ifp parameter pointer dcl 560 in procedure "arg_range" set ref 558 583* 585 589 598 598 601 607* 610 ifp parameter pointer dcl 3407 in procedure "var_range" set ref 3405 3448* 3506 3510 3518 3518 3521 3527* 3530 ifp parameter pointer dcl 283 in procedure "ampersand" set ref 281 299* 305 309 320 321* 333* 336* 339* 342* 357 370 373 376 379 383 387 390* 393 396* 400* 402* 405* 408* 413 423* 426* 429* 438* 441* 444* 447* 450* 453* 456* 459* 462* 465* 501 507 518 520 523 532 532 535* 536* 541* ifp parameter pointer dcl 1241 in procedure "get_range" set ref 1239 1253 1253 1260* 1263 1266* ifp parameter pointer dcl 1278 in procedure "get_token" set ref 1276 1283* 1284 1289 1294 ifp parameter pointer dcl 2929 in procedure "macro_substr" set ref 2927 2950* 2951* 2954 2963 2963 2966 2968* 2983* 2987 2987 2990 2992* 2996 2998* ifp parameter pointer dcl 2786 in procedure "macro_quote" set ref 2784 2805* 2808 2817 2817 2820 2822* 2825* ifp parameter pointer dcl 1948 in procedure "macro_empty" set ref 1947 1966* 1967* 1968 1977 1986* 1987 1992* ii 000626 automatic fixed bin(24,0) dcl 3145 in procedure "macro_usage" set ref 3160* 3177 3177 3178 ii 000103 automatic fixed bin(24,0) dcl 643 in procedure "arithmetic" set ref 653* 700 711 711 713 788 788 907 ii 000772 automatic fixed bin(24,0) dcl 3333 in procedure "var_bound" set ref 3341* 3362 3362 3363 ii 000472 automatic fixed bin(24,0) dcl 2037 in procedure "macro_error" set ref 2049* 2055 2059 2081 2090 2103 2103 2103 2115 ii 000504 automatic fixed bin(24,0) dcl 2271 in procedure "macro_length" set ref 2282* 2299 2300 ii 000564 automatic fixed bin(24,0) dcl 2871 in procedure "macro_scan" set ref 2882* 2899 2910 2910 2913 2914 ii 000437 automatic fixed bin(24,0) dcl 1783 in procedure "macro_define" set ref 1794* 1815 1848 ii 000216 automatic fixed bin(24,0) dcl 1559 in procedure "macro_af" set ref 1568* 1609 1620 1620 1620 1620 1627 1627 1630 ii 001015 automatic fixed bin(24,0) dcl 3417 in procedure "var_range" set ref 3429* 3523 3523 3524 ii 000102 automatic fixed bin(24,0) dcl 295 in procedure "ampersand" set ref 376* 377 379 381 ii 000233 automatic fixed bin(24,0) dcl 1652 in procedure "macro_call" set ref 1667* ii 000103 automatic fixed bin(24,0) dcl 1341 in procedure "logical" set ref 1415* 1435 1435 1437 1437 1437 1437 1450 1450 1450 1456 1456 1456 1462 1462 1462 1468 1468 1468 1474 1474 1474 1480 1480 1480 ii 000102 automatic fixed bin(24,0) dcl 1871 in procedure "macro_do" set ref 1883* 1937 ii 000612 automatic fixed bin(24,0) dcl 3073 in procedure "macro_unquote" set ref 3082* 3103 3105* 3105* 3106 3111 3113* 3113* ii 000101 automatic fixed bin(24,0) dcl 1038 in procedure "expand" set ref 1054* 1056 ii 000577 automatic fixed bin(24,0) dcl 2939 in procedure "macro_substr" set ref 2952* 2971 2980 2981 2984 2984 2986 2993 2993 2994 ii 000553 automatic fixed bin(24,0) dcl 2797 in procedure "macro_quote" set ref 2806* 2826 2833 2839 2840 2842* 2844 2844* 2846 2846 2847 ii 000115 automatic fixed bin(24,0) dcl 570 in procedure "arg_range" set ref 580* 603 603 604 ii 000176 automatic fixed bin(24,0) dcl 1251 in procedure "get_range" set ref 1259* 1261 1261 1262 1267 1267 1268 index builtin function dcl 3823 ref 305 309 413 523 532 532 670 719 1043 1115 1117 1132 1137 1316 1365 1418 1584 1686 1796 1904 2066 2081 2231 2284 2670 2808 2833 2842 2884 3084 3162 3240 3266 3307 3343 initiate_file_ 000104 constant entry external dcl 1070 ref 1099 input based char unaligned dcl 3071 in procedure "macro_unquote" ref 3084 3093 3093 3096 input based char unaligned dcl 1956 in procedure "macro_empty" ref 1968 1977 1987 input based char unaligned dcl 2323 in procedure "macro_let" ref 2344 2351 2356 2443 2496 2518 2533 2549 2599 2663 2670 2679 2679 2682 2689 input based char unaligned dcl 2869 in procedure "macro_scan" ref 2884 2893 2893 2896 input based char unaligned dcl 2143 in procedure "macro_if" ref 2231 input based char unaligned dcl 3331 in procedure "var_bound" ref 3343 3354 3354 3357 input based char unaligned dcl 2035 in procedure "macro_error" ref 2066 2075 2075 2078 input based char unaligned dcl 3228 in procedure "protected" ref 3240 3246 3246 3248 input based char unaligned dcl 1650 in procedure "macro_call" ref 1673 1683 1683 input based char unaligned dcl 293 in procedure "ampersand" ref 357 370 376 383 413 501 507 518 523 532 532 input based char unaligned dcl 2937 in procedure "macro_substr" ref 2954 2963 2963 2996 input based char unaligned dcl 3293 in procedure "strip2" ref 3297 3302 3304 3305 3307 input based char unaligned dcl 1281 in procedure "get_token" ref 1284 1289 1294 input based char unaligned dcl 2795 in procedure "macro_quote" ref 2808 2817 2817 2820 input based char unaligned dcl 1781 in procedure "macro_define" ref 1796 1806 1806 1809 input based char unaligned dcl 1869 in procedure "macro_do" ref 1904 input based char unaligned dcl 1339 in procedure "logical" ref 1351 1362 1362 1368 1368 1418 1423 1423 1426 1426 input based char unaligned dcl 641 in procedure "arithmetic" ref 657 667 667 672 input based char unaligned dcl 3415 in procedure "var_range" ref 3510 3518 3518 input based char unaligned dcl 2269 in procedure "macro_length" ref 2284 2293 2293 2296 input based char unaligned dcl 568 in procedure "arg_range" ref 589 598 598 input based char unaligned dcl 3143 in procedure "macro_usage" ref 3162 3171 3171 3174 input based char unaligned dcl 1557 in procedure "macro_af" ref 1571 1581 1581 input based char unaligned dcl 1036 in procedure "expand" ref 1043 1049 1049 inputa based char(1) array unaligned dcl 1338 in procedure "logical" ref 1365 1396 inputa based char(1) array unaligned dcl 1248 in procedure "get_range" ref 1253 1253 1263 inputa based char(1) array unaligned dcl 1556 in procedure "macro_af" ref 1584 inputa based char(1) array unaligned dcl 567 in procedure "arg_range" ref 585 601 610 inputa based char(1) array unaligned dcl 292 in procedure "ampersand" ref 305 309 320 373 379 387 393 520 inputa based char(1) array unaligned dcl 2936 in procedure "macro_substr" ref 2966 2987 2987 2990 inputa based char(1) array unaligned dcl 1649 in procedure "macro_call" ref 1686 inputa based char(1) array unaligned dcl 2322 in procedure "macro_let" ref 2449 2462 2649 2658 inputa based char(1) array unaligned dcl 2034 in procedure "macro_error" ref 2063 inputa based char(1) array unaligned dcl 640 in procedure "arithmetic" ref 670 inputa based char(1) array unaligned dcl 3414 in procedure "var_range" ref 3506 3521 3530 inputa based char(1) array unaligned dcl 922 in procedure "cvt" ref 927 inside 000613 automatic bit(1) unaligned dcl 3074 set ref 3104* 3109 3116* 3118* int_mac parameter bit(1) unaligned dcl 230 in procedure "addmacro" set ref 228 238* 244 269 int_mac 100 based bit(1) level 2 in structure "macro_list" packed unaligned dcl 3759 in procedure "macro_" set ref 104 128 244 269* int_var_ptr 000252 automatic pointer dcl 3752 set ref 69* 1506 1508* 1509 1510 1512* 1512 1514* 1515 1515 1515* 1518 1519 1520 1521 1524 2421 2422 3658* 3659* 3659 3661 3662 3664* 3665 int_vars based structure level 1 packed unaligned dcl 3753 set ref 1514 1515 1515 3665 int_vars_base 000024 internal static pointer initial dcl 3713 set ref 1508 1518 1521* 3657 3658 3661* ioa_ 000076 constant entry external dcl 3812 ref 98 106 120 130 161 164 166 172 238 251 261 272 734 739 743 949 1084 1182 1183 1189 1197 1203 1211 1515 2165 2182 2198 2210 2223 2406 2416 2423 2430 2487 2706 2713 2754 2762 3210 3585 3602 3607 3622 3627 3659 3664 3668 3674 3683 3687 ioa_$nnl 000102 constant entry external dcl 3816 ref 710 736 741 1375 1433 1436 1723 1840 2720 2771 2909 3274 3277 ioa_$rsnpnnl 000120 constant entry external dcl 3152 ref 3182 iox_$error_output 000114 external static pointer dcl 2122 set ref 2099* 2103* iox_$put_chars 000116 constant entry external dcl 2123 ref 2099 2103 j 000102 automatic fixed bin(24,0) dcl 643 in procedure "arithmetic" set ref 719* 720 745 745 770* 770 772 786 806 809 816 893 j parameter fixed bin(24,0) dcl 1251 in procedure "get_range" set ref 1239 1261* 1267* j 000771 automatic fixed bin(24,0) dcl 3333 in procedure "var_bound" set ref 3364* 3365 j 000101 automatic fixed bin(24,0) dcl 3261 in procedure "show_string" set ref 3266* 3267 3269* 3273 3274 3274 j 001014 automatic fixed bin(24,0) dcl 3417 in procedure "var_range" set ref 3446* 3448* 3456 3472* 3482* 3498 3538 j 000103 automatic fixed bin(24,0) dcl 1307 in procedure "lineno" set ref 1316* 1317 1319 j 000114 automatic fixed bin(24,0) dcl 570 in procedure "arg_range" set ref 582* 583* 616* 616 617 619 j 000436 automatic fixed bin(24,0) dcl 1783 in procedure "macro_define" set ref 1817* 1820 1825 1830* 1830 1831 1832 j 000232 automatic fixed bin(24,0) dcl 1652 in procedure "macro_call" set ref 1733* 1734 j 001101 automatic fixed bin(24,0) dcl 3566 in procedure "var_ref" set ref 3575* 3576 j 000102 automatic fixed bin(24,0) dcl 1341 in procedure "logical" set ref 1418* 1419 1421 1423 1423 1424 j 000576 automatic fixed bin(24,0) dcl 2939 in procedure "macro_substr" set ref 2993* 3003* 3007 3012 3017* 3017 3019 3021 3026* 3026 3028* 3028 3040 3048 3050 3050 3050 j 000552 automatic fixed bin(24,0) dcl 2797 in procedure "macro_quote" set ref 2841* 2842 2844 2846 2846 2847* 2847 2850 j 000516 automatic fixed bin(24,0) dcl 2325 in procedure "macro_let" set ref 2698* 2702 2711 2717 2736 2750 2760 2767 2773 2773 jj 000104 automatic fixed bin(24,0) dcl 643 in procedure "arithmetic" set ref 722* 724 724* 726 735* 736 736* 740* 741* 748* 750 750* 753 756 jj 000600 automatic fixed bin(24,0) dcl 2939 in procedure "macro_substr" set ref 3021* 3022 3024 3025 3026 3048* 3049 3049 3050 3050 3050 jj 000517 automatic fixed bin(24,0) dcl 2325 in procedure "macro_let" set ref 2657* 2698 2717 2736 2738 2767 2773 2773 2778 jj 001016 automatic fixed bin(24,0) dcl 3417 in procedure "var_range" set ref 3510* 3511 3516 3518 3518 3519 jj 000104 automatic fixed bin(24,0) dcl 1341 in procedure "logical" set ref 1347* 1377 1377 1377 1377 1380 1383 1383 1435 1435 1435 1435 1440 1450 1450 1456 1456 1462 1462 1468 1468 1474 1474 1480 1480 jj 000103 automatic fixed bin(24,0) dcl 1871 in procedure "macro_do" set ref 1884* 1891* 1919* 1932 jj 000116 automatic fixed bin(24,0) dcl 570 in procedure "arg_range" set ref 589* 590 595 597* 597 598 598 599 k 000102 automatic fixed bin(24,0) dcl 3261 set ref 3273* 3275 kk 000105 automatic fixed bin(24,0) dcl 1341 set ref 1372* 1377 1377 1383 1430* 1437 1437 1450 1456 1462 1468 1474 1480 l 2 000100 automatic fixed bin(24,0) array level 2 in structure "args" dcl 1719 in begin block on line 1718 set ref 1732* l 2 based fixed bin(24,0) array level 2 in structure "argl" dcl 59 in procedure "macro_" set ref 73 75 164* 164 164 316 316 618 618 l_bound 1 based fixed bin(17,0) level 2 dcl 3742 set ref 2013* 2017* 2458 2514* 2529* 2538 2545* 2554 2561* 2568 2574* 2616 2623 2730* 2730 2735 3384 3445 3472 3483 3493 3594 3601 3606* 3606 3614 len 3 based fixed bin(17,0) array level 3 in structure "array" dcl 3742 in procedure "macro_" set ref 1203 1203 1207 1207 2492* 2736 2750 2754* 2758 2758 2760* 2761 2761 2762 2762 2762 2762 2767 3540 3540 3602* 3602* 3602 3602 3605 3605 3607* 3610 3610 3622* 3622* 3622 3622 3625 3625 3627* 3630 3630 len 7 based fixed bin(17,0) level 2 in structure "var" dcl 3731 in procedure "macro_" set ref 1183 1183 1189 1189 1191 1191 1197 1200 2013 2411* 2484* 2485 2487 2487 2490 2501 2523 2592 2616 2623 2629 2634 2641 2702 2704 2706* 2709 2709 2711* 2712 2712 2713 2713 2713 2713 2717 2722 2722 2742 3585* 3585* 3585 3585 3588 3588 3601 length builtin function dcl 3823 ref 538 1131 1890 1900 1929 1978 1985 2099 2099 2176 2189 2205 2221 3208 3209 3210 3210 3210 3210 3265 3269 level 000217 automatic fixed bin(24,0) dcl 1560 in procedure "macro_af" set ref 1569* 1595* 1595 1601* 1601 1602 level 000105 automatic fixed bin(24,0) dcl 644 in procedure "arithmetic" set ref 655* 680* 680 684 693* 693 694 level 000401 automatic fixed bin(24,0) dcl 1654 in procedure "macro_call" set ref 1671* 1700* 1700 1706* 1706 1707 1752 lg_sw 000026 internal static bit(1) initial unaligned dcl 3714 set ref 730 3830* 3831* limit 001070 automatic fixed bin(17,0) dcl 3420 set ref 3538* 3539 3541 line 000104 automatic fixed bin(24,0) dcl 1308 set ref 1311* 1315* 1315 1321 loc 000234 automatic fixed bin(24,0) array dcl 1653 set ref 1669* 1711* 1712 1725 1725 1727 1728 1732 1732 1733 1762* local_var_ptr 000314 automatic pointer dcl 3781 set ref 69* 212 1497 2428 2429* lower 000535 automatic fixed bin(24,0) dcl 2329 in procedure "macro_let" set ref 2454* 2458* 2461* 2472 2474 2479* 2484 2487* 2494 2501 2501 2515 2538 2554 2568 2574 2587 2629* 2646* 2730 2747* 2749 2771* lower based fixed bin(17,0) level 2 in structure "array" dcl 3742 in procedure "macro_" set ref 1197* 1197 1203 2012 2013 2494* 2501 2587 2592 2749 2749 3538 3539 ltrim builtin function dcl 3823 ref 78 327 327 908 908 1321 2301 2301 3038 3040 3042 mac_sw 000745 automatic bit(1) unaligned dcl 3821 set ref 23* 36* 93 1113 maclp 000254 automatic pointer dcl 3758 set ref 101* 101* 104 106 106 106 109 111 112 113* 117 125* 125* 128 130 130 132 132 134 135 136* 140 241* 241* 244 244 244 247 247 247* 259 260* 261 261 261* 263 264 265 266 267 268 269 270 271 272 272 272 272 272 272 3179* 3179* 3182 3182 3182* 3186 3671* 3672 3674 3674 3674 3674 3674 3678 3679 3680 3682 3687* 3688 macname parameter varying char(32) dcl 1065 in procedure "find_macro" set ref 1064 1076 1084* 1107 1115 1117 1121 1131 1150 1161 macname parameter varying char(32) dcl 230 in procedure "addmacro" set ref 228 238* 244 263 macname parameter varying char(32) dcl 43 in procedure "macro_" set ref 16 28 98* 100 109 118 120* 124 132 143* 161* 172* 1510 1515* 1520 2095 2110 2423* macro 2 based char(32) level 2 packed unaligned dcl 3753 set ref 1510 1520* 3659* macro_holder based char unaligned dcl 3782 set ref 1836 1837* 1842* 3685 macro_holder_l 000316 automatic fixed bin(24,0) dcl 3783 set ref 1835* 1836 1836 1837 1837 1842 1842 1845* 3682* 3685 3685 macro_holder_p 000320 automatic pointer dcl 3784 set ref 1836* 1837 1842 1845* 3679* 3683* 3685 macro_list based structure level 1 unaligned dcl 3759 set ref 260 261 261 3688 macro_list_p 000030 internal static pointer initial dcl 3715 set ref 101 125 241 270 271* 3179 3667 3693* macro_nest 000032 internal static fixed bin(17,0) initial dcl 3716 set ref 86* 86 161* 172* 210* 210 949* 3695* max builtin function dcl 3823 ref 949 949 2731 min builtin function dcl 3823 ref 616 926 1313 2730 3048 mod builtin function dcl 3823 ref 2629 3601 msg parameter varying char(1000) dcl 43 set ref 16 28 77* 78* 78 79* 79 84* 179* 181* 181 182* 182 186* 186 192* 192 193* 193 195* 195 196* 196 197* 197 198* 198 201* 201 205* 205 206* 206 220* 220 222* 222 255* 256* 256 302* 366* 367* 367 416* 494* 496* 496 497* 497 514* 526* 528* 528 529* 529 546* 547* 547 548* 548 592* 661* 782* 785* 785 786* 786 787* 787 788* 788 789* 789 968 979 984 990 998* 1000* 1000 1001* 1001 1002* 1002 1003* 1003 1004* 1004 1005* 1005 1007* 1007 1008* 1008 1009* 1009 1010* 1010 1013* 1013 1014* 1014 1015* 1015 1017* 1017 1104* 1105* 1105 1106* 1106 1107* 1107 1120* 1121* 1121 1123* 1123 1124* 1124 1125* 1125 1126* 1126 1127* 1127 1142* 1144* 1145* 1145 1355* 1575* 1626* 1677* 1692* 1715* 1736* 1756* 1757* 1757 1758* 1758 1800* 1827* 1897* 1908* 1940* 1974* 1980* 1981* 1981 1982* 1982 1989* 1996* 1997* 1997 1998* 1998 2003* 2004* 2004 2005* 2005 2050* 2070* 2083* 2084* 2084 2086* 2086 2089* 2089 2090* 2090 2091* 2091 2093* 2093 2094* 2094 2095* 2095 2096* 2096 2097* 2097 2098* 2098 2099 2099 2099 2099 2101* 2107* 2108* 2108 2109* 2109 2110* 2110 2111* 2111 2172* 2217* 2288* 2348* 2359* 2396* 2397* 2397 2398* 2398 2436* 2437* 2437 2438* 2438 2464* 2476* 2505* 2507* 2507 2508* 2508 2583* 2589* 2594* 2610* 2618* 2619* 2619 2620* 2620 2625* 2636* 2637* 2637 2638* 2638 2643* 2651* 2660* 2674* 2691* 2744* 2812* 2829* 2888* 2902* 2958* 2974* 3009* 3014* 3032* 3037* 3088* 3166* 3243* 3310* 3347* 3348* 3348 3349* 3349 3367* 3368* 3368 3369* 3369 3374* 3375* 3375 3376* 3376 3391* 3392* 3392 3393* 3393 3394* 3394 3396* 3396 3397* 3397 3433* 3438* 3439* 3439 3440* 3440 3458* 3459* 3459 3460* 3460 3465* 3466* 3466 3467* 3467 3475* 3476* 3476 3477* 3477 3485* 3486* 3486 3487* 3487 3495* 3500* 3513* 3546* 3578* 3579* 3579 3580* 3580 3596* 3597* 3597 3598* 3598 3616* 3617* 3617 3618* 3618 3633* 3634* 3634 3635* 3635 msg_etc 000322 automatic varying char(1000) dcl 3785 set ref 70* 203 206 1627* 3038* 3039* 3039 3040* 3040 3041* 3041 3042* 3042 3043* 3043 3044* 3044 3045* 3045 myname 000715 automatic varying char(32) dcl 3786 set ref 34* 35* 35 100* 122* 123* 123 124* 124 196 536 1002 1845 name 2 based char(16) level 2 in structure "var" packed unaligned dcl 3731 in procedure "macro_" set ref 1182* 1197* 1211* 1499 1527 1536 2408* 2416* 2423* 2430* 2720* 2771* name 70 based char(32) level 2 in structure "macro_list" packed unaligned dcl 3759 in procedure "macro_" set ref 106* 109 130* 132 244 263* 272* 3182* 3674* next based pointer level 2 in structure "var" dcl 3731 in procedure "macro_" set ref 1177 1501 1529 1538 2414* 2421* 2428* next based pointer level 2 in structure "int_vars" packed unaligned dcl 3753 in procedure "macro_" set ref 1512 1518* 3661 next based pointer level 2 in structure "macro_list" dcl 3759 in procedure "macro_" set ref 117 140 259 270* 3186 3678 null builtin function dcl 3823 ref 24 37 66 69 89 101 125 241 1081 1086 1086 1093 1096 1096 1175 1183 1187 1201 1227 1498 1506 1509 1519 1526 1535 1620 1620 2409 2491 2752 3179 3652 3656 3657 3668 3670 3691 3693 num 000100 automatic fixed bin(24,0) dcl 63 set ref 72* 73 75 78* 163* 164* 164 164 164 164* 308* 312* 312 316 316 316 316 617* 618 618 618 619* ofe parameter fixed bin(24,0) dcl 1861 in procedure "macro_do" set ref 1859 1880* 1886* 1893* 1913* 1915 ofe parameter fixed bin(24,0) dcl 2261 in procedure "macro_length" set ref 2259 2281* 2282 2293* 2299 2300* 2301* 2305* ofe parameter fixed bin(24,0) dcl 2314 in procedure "macro_let" set ref 2312 2343* 2461* 2657 2665* 2679* 2684* 2698 2717 2736 2738* 2767 2773 2773 2778* ofe parameter fixed bin(24,0) dcl 1549 in procedure "macro_af" set ref 1547 1567* 1568 1581* 1586* 1592* 1598* 1606* 1606 1609* 1620 1620 1620 1620 1627 1627 1630* 1631* ofe parameter fixed bin(24,0) dcl 3135 in procedure "macro_usage" set ref 3133 3159* 3160 3171* 3177 3177 3178* 3185* 3190* ofe parameter fixed bin(24,0) dcl 3407 in procedure "var_range" set ref 3405 3429 3448* 3518* 3523 3523 3524* 3527* 3540* 3541* ofe parameter fixed bin(24,0) dcl 3200 in procedure "putout" set ref 3198 3207 3208* 3208 3209 ofe parameter fixed bin(24,0) dcl 2786 in procedure "macro_quote" set ref 2784 2806 2817* 2822* 2826 2833 2839 2840* 2846* 2848 2848 2848* ofe parameter fixed bin(24,0) dcl 2131 in procedure "macro_if" set ref 2129 2157* 2161* 2179* 2207* 2239* 2247 ofe parameter fixed bin(24,0) dcl 2027 in procedure "macro_error" set ref 2025 2048* 2049 2053* 2055 2055 2055 2055 2055 2059* 2060* 2063* 2075* 2081 2090 2102 2102 2103 2103 2103 2115* 2119* ofe parameter fixed bin(24,0) dcl 2861 in procedure "macro_scan" set ref 2859 2881* 2882 2893* 2899 2910 2910 2913 2914* 2915* 2920* ofe parameter fixed bin(24,0) dcl 942 in procedure "dumper" set ref 940 949* 949 949 949* ofe parameter fixed bin(24,0) dcl 283 in procedure "ampersand" set ref 281 299* 316* 321* 327* 336* 339* 342* 390* 396* 400* 402* 405* 408* 423* 426* 429* 438* 441* 444* 447* 450* 453* 456* 459* 462* 465* 541* ofe parameter fixed bin(24,0) dcl 1642 in procedure "macro_call" set ref 1640 1666* 1667 1668* 1669 1683* 1688* 1697* 1703* 1711 1712 1725 1725 1727 1728* 1733 1736* 1749* 1762 ofe parameter fixed bin(24,0) dcl 2929 in procedure "macro_substr" set ref 2927 2951* 2952 2963* 2968* 2971 2980 2981* 2983* 2984 2984 2986* 2992* 2993 2993 2994* 3024 3024 3025* 3025 3049* 3050* ofe parameter fixed bin(24,0) dcl 633 in procedure "arithmetic" set ref 631 652* 653 654* 667* 675* 678* 690* 700* 711 711 713 719 722 734 734 748 750 753 764 788 907* 908* ofe parameter fixed bin(24,0) dcl 560 in procedure "arg_range" set ref 558 580 583* 598* 603 603 604* 607* 618* 619* ofe parameter fixed bin(24,0) dcl 1773 in procedure "macro_define" set ref 1771 1793* 1794 1806* 1816 1816 1817 1817 1831 1833 1835 1837 1848* 1852* ofe parameter fixed bin(24,0) dcl 1028 in procedure "expand" set ref 1026 1041* 1055* ofe parameter fixed bin(24,0) dcl 3221 in procedure "protected" set ref 3219 3246* 3250* ofe parameter fixed bin(24,0) dcl 3323 in procedure "var_bound" set ref 3321 3341 3354* 3359* 3362 3362 3363* ofe parameter fixed bin(24,0) dcl 1948 in procedure "macro_empty" set ref 1947 1967* ofe parameter fixed bin(24,0) dcl 3062 in procedure "macro_unquote" set ref 3060 3082 3093* 3098* 3105 3106 3111 3123 3126* ofe parameter fixed bin(24,0) dcl 1241 in procedure "get_range" set ref 1239 1259 1260* 1261 1261 1262* 1266* 1267 1267 1268* ofe parameter fixed bin(24,0) dcl 3556 in procedure "var_ref" ref 3554 ofe parameter fixed bin(24,0) dcl 1331 in procedure "logical" set ref 1329 1347 1362* 1372 1377 1377 1380* 1383 1394* 1407* 1415 1423* 1430 1435 1435 1437 1437 1440* 1447* 1450 1450 1456 1456 1462 1462 1468 1468 1474 1474 1480 1480 ofp parameter pointer dcl 1028 in procedure "expand" set ref 1026 1041* 1049* 1055* ofp parameter pointer dcl 1773 in procedure "macro_define" set ref 1771 1793* 1806* 1816 1817 1831 1833 1837 1852* ofp parameter pointer dcl 633 in procedure "arithmetic" set ref 631 652* 654* 667* 675* 678* 690* 711 711 719 722 734 734 748 753 764 788 908* ofp parameter pointer dcl 2929 in procedure "macro_substr" set ref 2927 2951* 2963* 2968* 2980 2983* 2984 2992* 2993 3024 3049* 3050* ofp parameter pointer dcl 1642 in procedure "macro_call" set ref 1640 1666* 1668* 1683* 1688* 1697* 1703* 1725 1725 1727 1736* 1749* ofp parameter pointer dcl 2786 in procedure "macro_quote" set ref 2784 2817* 2822* 2833 2839 2846* 2848 2848* ofp parameter pointer dcl 2314 in procedure "macro_let" set ref 2312 2343* 2461* 2665* 2679* 2684* 2717 2736 2767 2773 2773 ofp parameter pointer dcl 2261 in procedure "macro_length" set ref 2259 2281* 2293* 2301* 2305* ofp parameter pointer dcl 2861 in procedure "macro_scan" set ref 2859 2881* 2893* 2910 2910 2913 2915* 2920* ofp parameter pointer dcl 1948 in procedure "macro_empty" set ref 1947 1967* ofp parameter pointer dcl 942 in procedure "dumper" set ref 940 949* ofp parameter pointer dcl 2131 in procedure "macro_if" set ref 2129 2157* 2161* 2179* 2207* 2239* 2247* ofp parameter pointer dcl 3200 in procedure "putout" ref 3198 3209 ofp parameter pointer dcl 3556 in procedure "var_ref" set ref 3554 3588* 3605* 3625* ofp parameter pointer dcl 3221 in procedure "protected" set ref 3219 3246* 3250* ofp parameter pointer dcl 2027 in procedure "macro_error" set ref 2025 2048* 2053* 2055 2055 2060* 2063* 2075* 2081 2090 2102 2103 2103 2119* ofp parameter pointer dcl 3407 in procedure "var_range" set ref 3405 3448* 3518* 3523 3527* 3540* 3541* ofp parameter pointer dcl 3135 in procedure "macro_usage" set ref 3133 3159* 3171* 3177 3185* 3190* ofp parameter pointer dcl 1241 in procedure "get_range" set ref 1239 1260* 1261 1266* 1267 ofp parameter pointer dcl 1331 in procedure "logical" set ref 1329 1362* 1377 1377 1383 1394* 1407* 1423* 1435 1435 1437 1437 1447* 1450 1450 1456 1456 1462 1462 1468 1468 1474 1474 1480 1480 ofp parameter pointer dcl 1549 in procedure "macro_af" set ref 1547 1567* 1581* 1586* 1592* 1598* 1620 1620 1627 1631* ofp parameter pointer dcl 283 in procedure "ampersand" set ref 281 299* 316* 321* 327* 336* 339* 342* 354* 390* 396* 400* 402* 405* 408* 423* 426* 429* 438* 441* 444* 447* 450* 453* 456* 459* 462* 465* 541* ofp parameter pointer dcl 560 in procedure "arg_range" set ref 558 583* 598* 603 607* 618* 619* ofp parameter pointer dcl 3323 in procedure "var_bound" set ref 3321 3354* 3359* 3362 ofp parameter pointer dcl 3062 in procedure "macro_unquote" set ref 3060 3093* 3098* 3106 3111 3123 ofp parameter pointer dcl 1861 in procedure "macro_do" set ref 1859 1880* 1886* 1893* 1913* 1915* out_len parameter fixed bin(24,0) dcl 43 set ref 16 28 171* 354* 1049* 3588* 3605* 3625* out_ptr parameter pointer dcl 43 set ref 16 28 171* output based char unaligned dcl 2870 in procedure "macro_scan" ref 2910 2910 2913 output based char unaligned dcl 1558 in procedure "macro_af" ref 1620 1620 1627 output based char unaligned dcl 569 in procedure "arg_range" ref 603 output based char unaligned dcl 3144 in procedure "macro_usage" ref 3177 output based char unaligned dcl 2938 in procedure "macro_substr" set ref 2980 2984 2993 3024* output based char unaligned dcl 1340 in procedure "logical" ref 1377 1377 1383 1435 1435 1437 1437 1450 1450 1456 1456 1462 1462 1468 1468 1474 1474 1480 1480 output based char unaligned dcl 2324 in procedure "macro_let" ref 2717 2736 2767 2773 2773 output based char unaligned dcl 3204 in procedure "putout" set ref 3209* output based char unaligned dcl 2036 in procedure "macro_error" set ref 2055 2055 2081 2090 2102* 2103 2103 output based char unaligned dcl 2796 in procedure "macro_quote" ref 2833 2839 2848 output based char unaligned dcl 1651 in procedure "macro_call" ref 1725 1725 1727 output based char unaligned dcl 1250 in procedure "get_range" ref 1261 1267 output based char unaligned dcl 642 in procedure "arithmetic" ref 711 711 719 722 734 734 748 753 764 788 output based char unaligned dcl 3416 in procedure "var_range" ref 3523 output based char unaligned dcl 1782 in procedure "macro_define" ref 1816 1817 1831 1833 1837 output based char unaligned dcl 3072 in procedure "macro_unquote" set ref 3106 3111 3123* output based char unaligned dcl 3332 in procedure "var_bound" ref 3362 owner 2 001012 automatic char(32) level 2 packed unaligned dcl 1232 set ref 1225* p 000100 automatic pointer array level 2 in structure "args" dcl 1719 in begin block on line 1718 set ref 1734* p based pointer array level 2 in structure "argl" dcl 59 in procedure "macro_" ref 164 316 618 pc_sw 000033 internal static bit(1) initial unaligned dcl 3717 set ref 159 172 3829* 3832* pic60 automatic picture(60) unaligned dcl 648 ref 908 908 pr_sw parameter bit(1) unaligned dcl 3647 ref 3645 3668 3672 ref 2 based pointer level 2 in structure "macro_list" dcl 3759 in procedure "macro_" set ref 111 134 247 264* 272* 3679 ref 10 based pointer level 2 in structure "var" dcl 3731 in procedure "macro_" set ref 1183 1183* 1183 1187 1189* 1189 1191 1196 2008 2409* 2457 2486* 2487* 2586 2615 2633 2706* 2709 2712* 2713 2713 2713* 2717 2722 2727 3379 3444 3450 3537 3585 3588 3591 ref 1 based pointer level 2 in structure "int_vars" packed unaligned dcl 3753 in procedure "macro_" set ref 1519* 1524 2421 2422* 3662 ref 4 based pointer array level 3 in structure "array" packed unaligned dcl 3742 in procedure "macro_" set ref 1201 1203* 1203 1207 2491* 2736 2752 2754* 2758 2761* 2762 2762 2762* 2767 3540 3602 3605 3607* 3610 3622 3625 3627* 3630 ref_path 000104 automatic char(168) unaligned dcl 3644 set ref 1081* 1083* 1084* 1086* 1096* refp 000102 automatic pointer dcl 64 in procedure "macro_" set ref 25* 37* 143* refp parameter pointer dcl 1065 in procedure "find_macro" set ref 1064 1081 1083* refseg parameter pointer dcl 43 ref 16 25 rel 000106 automatic fixed bin(24,0) dcl 1345 set ref 1365* 1366 1401* 1401 1404 1436 1445 relat 000050 internal static char(2) initial array unaligned dcl 1443 set ref 1436* release_area_ 000062 constant entry external dcl 3650 ref 3690 res 000106 automatic varying char(32) dcl 917 set ref 925* 930* 930 932* 932 933 reserved 000075 constant char(8) initial array unaligned dcl 2363 ref 2393 2394 ret_len 000761 automatic fixed bin(24,0) dcl 3151 set ref 3182* 3185 3185 ret_str 000661 automatic char(256) unaligned dcl 3150 set ref 3182* 3185 3185 rtrim builtin function dcl 3823 ref 908 908 908 908 1125 rval 000100 automatic varying char dcl 1615 set ref 1616* 1620* 1631 save_db 000726 automatic bit(1) unaligned dcl 3788 set ref 88* 216 search builtin function dcl 3823 ref 589 657 1351 1571 1673 2954 3510 search_for 000762 automatic varying char(35) dcl 1074 set ref 1076* 1078* 1079* 1079 1084* 1086 1096 1099 1105 1127 1150 1150 1161 1161 search_paths_$find_dir 000106 constant entry external dcl 1072 ref 1086 1096 seg based char unaligned dcl 3789 ref 1115 1117 1132 1137 1316 sege parameter fixed bin(24,0) dcl 230 in procedure "addmacro" ref 228 247 268 sege 000727 automatic fixed bin(24,0) dcl 3791 in procedure "macro_" set ref 40* 113* 136* 147 153 171* 177 434 1112* 1115 1117 1132 1137 1149* 1150* 1161* 1313 1316 1317 segi 000730 automatic fixed bin(24,0) dcl 3792 in procedure "macro_" set ref 39* 112* 135* 147 150* 150 153 156* 156 171* 177 198* 434* 1111* 1131* 1132 1136* 1136 1137 1149 1150* 1161* segi parameter fixed bin(24,0) dcl 1303 in procedure "lineno" ref 1301 1313 1314 segi parameter fixed bin(24,0) dcl 230 in procedure "addmacro" ref 228 247 267 segment based char unaligned dcl 3794 ref 147 153 segname parameter varying char(32) dcl 1065 in procedure "find_macro" ref 1064 1076 1078 1152 segname parameter varying char(32) dcl 230 in procedure "addmacro" set ref 228 238* 244 266 segname parameter varying char(32) dcl 43 in procedure "macro_" set ref 16 28 31 95 143* segp parameter pointer dcl 230 set ref 228 238* 264 segptr 000732 automatic pointer dcl 3795 set ref 24* 38* 89 111* 134* 147 153 171* 247 1091* 1093 1099* 1115 1117 1132 1137 1150* 1161* 1316 segtype 000734 automatic varying char(8) dcl 3796 set ref 19* 31* 33* 35 89 161* 190 sep_ct 000400 automatic fixed bin(24,0) dcl 1654 set ref 1670* 1711 1719 1729* 1731 1736 1754 1761* 1761 1762 separator 000117 automatic varying char(150) dcl 571 in procedure "arg_range" set ref 584* 603* 619 separator 001017 automatic varying char(150) dcl 3418 in procedure "var_range" set ref 3505* 3523* 3541 sepch 000100 automatic char(1) unaligned dcl 2979 set ref 2985* 2990* 3003 3005 size 13 001012 automatic fixed bin(18,0) level 2 in structure "ai" dcl 1232 in procedure "get_area" set ref 1226* size builtin function dcl 3823 in procedure "macro_" ref 261 261 1515 1515 2406 2406 2487 2487 2713 2713 2762 2762 sl 000107 automatic fixed bin(24,0) dcl 645 set ref 704* 735 754* 754 755 759 762 774 785 793 797 799 803* 803 804 806 806 808* 808 809 812 815* 815 816 830* 830 831 888* 888 889 896* 896 897 sl_name parameter varying char(32) dcl 43 set ref 16 20 28 143* 1225 1736* space 000216 constant char(5) initial unaligned dcl 3725 ref 1816 3297 start_sym 000737 automatic varying char(8) dcl 3797 set ref 483* 489* 496 503 515 530 536 stk 000564 automatic fixed bin(24,0) array dcl 647 set ref 706* 736 736 755* 759 762 774 785 793 797 799 804* 806 806 809* 812 816* 831* 889* 897* str parameter char unaligned dcl 3200 set ref 3198 3208 3209 3209 3210 3210 3210 3210 3210* str1 parameter char unaligned dcl 3260 ref 3258 3265 3266 3269 3274 3274 str2 parameter char unaligned dcl 3260 set ref 3258 3277* string builtin function dcl 3823 set ref 1223* 1727* 2913* strlen parameter fixed bin(24,0) dcl 43 ref 28 40 strptr parameter pointer dcl 43 ref 28 38 substr builtin function dcl 3823 set ref 106 106 147 153 357 370 376 383 413 501 507 518 523 532 532 589 598 598 603 657 667 667 672 711 711 719 722 734 734 736 736 748 753 764 785 786 788 1043 1049 1049 1132 1137 1261 1267 1284 1289 1294 1316 1351 1362 1362 1368 1368 1377 1377 1383 1418 1423 1423 1426 1426 1435 1435 1437 1437 1450 1450 1456 1456 1462 1462 1468 1468 1474 1474 1480 1480 1571 1581 1581 1620 1620 1627 1673 1683 1683 1725 1725 1727 1796 1806 1806 1809 1816 1817 1831 1833 1837 1904 1968 1977 1987 2055 2055 2066 2075 2075 2078 2081 2090 2102* 2103 2103 2231 2284 2293 2293 2296 2344 2351 2356 2443 2496 2518 2533 2549 2599 2663 2670 2679 2679 2682 2689 2717 2736 2767 2773 2773 2808 2817 2817 2820 2833 2839 2842 2846 2846 2848 2884 2893 2893 2896 2910 2910 2913 2954 2963 2963 2980 2984 2993 2996 3024* 3049 3049 3084 3093 3093 3096 3106 3111 3123* 3162 3171 3171 3174 3177 3185 3185 3209* 3240 3246 3246 3248 3266 3274 3274 3297 3302 3304 3305 3307 3343 3354 3354 3357 3362 3510 3518 3518 3523 3680 suffix parameter varying char(32) dcl 1065 ref 1064 1079 1086 1091 1091 1093 1096 1115 1132 1142 text parameter char(4) unaligned dcl 942 set ref 940 949* tf parameter bit(2) unaligned dcl 1028 in procedure "expand" set ref 1026 1041* 1055* tf parameter bit(2) unaligned dcl 2786 in procedure "macro_quote" set ref 2784 2822* tf parameter bit(2) unaligned dcl 2131 in procedure "macro_if" ref 2129 2156 2163 tf 000104 automatic bit(2) unaligned dcl 1872 in procedure "macro_do" set ref 1892* 1893* 1902 tf parameter bit(2) unaligned dcl 3062 in procedure "macro_unquote" set ref 3060 3098* to 67 based fixed bin(24,0) level 2 dcl 3759 set ref 113 136 247 268* 272* 3674* 3682 tofe 000100 automatic fixed bin(24,0) dcl 3205 set ref 3207* 3209 3210* token_chars 000176 constant char(63) initial unaligned dcl 3799 ref 357 376 3304 tptr 000742 automatic pointer dcl 3798 set ref 212* 1175 1176 1177* 3654* 3662* 3667* 3668 3670 3671 3678* tr_sw 000744 automatic bit(1) unaligned dcl 3802 set ref 145* 151* 159 172 708 1373 1431 1721 1838 2165 2182 2198 2210 2223 2718 2769 2907 translate builtin function dcl 3823 ref 1383 type 6 based fixed bin(17,0) level 2 dcl 3731 set ref 1178 1194 1194 2001 2010 2015 2410* 2452 2483* 2501 2513* 2523 2528* 2538 2544* 2554 2560* 2568 2581 2581 2607 2607 2613 2631 2700 2728 2733 3372 3380 3380 3380 3388 3388 3394 3436 3453 3453 3470 3583 3592 3612 v 000610 automatic fixed dec(59,9) dcl 649 set ref 819* 822* 835* 838* 842* 845* 849* 852* 856* 859* 863* 866* 871* 875* 879* 883* 887 val 000110 automatic fixed dec(59,9) array dcl 646 set ref 741* 753* 753 802* 819 819 826 826* 829* 835 835 842 842 849 849 856 856 863 863 871 871 875 875 879 879 883 883 887* 908 908 var based structure level 1 unaligned dcl 3731 set ref 1212 2405 2406 2406 var_ptr 000244 automatic pointer dcl 3730 set ref 1176* 1177 1178 1182* 1182 1183 1183 1183 1183 1183 1187 1189 1189 1189 1189 1191 1191 1191 1194 1194 1196 1197* 1197 1197 1200 1211 1211* 1212 1497* 1498 1499 1501* 1501 1524* 1526 1527 1529* 1529 1534* 1535 1536 1538* 1538 2001 2008 2010 2013 2015 2405* 2406 2406 2406* 2408 2409 2410 2411 2414 2415 2416* 2416 2421 2422 2423* 2423 2428 2429 2430* 2430 2441 2452 2457 2469* 2483 2484 2485 2486 2487 2487 2487 2490 2501 2501 2513 2523 2523 2528 2538 2544 2554 2560 2568 2581 2581 2586 2592 2607 2607 2613 2615 2616 2623 2629 2631 2633 2634 2641 2699* 2700 2702 2704 2706 2706 2709 2709 2709 2711 2712 2712 2712 2713 2713 2713 2713 2713 2713 2713 2717 2717 2720 2722 2722 2722 2727 2728 2733 2742 2771 3372 3379 3380 3380 3380 3388 3388 3394 3436 3443 3444 3449* 3450 3453 3453 3470 3536* 3537 3583 3585 3585 3585 3585 3585 3588 3588 3588 3591 3592 3601 3612 varlen 000220 automatic fixed bin(17,0) dcl 1613 set ref 1612* 1615 vartext based char unaligned dcl 3738 set ref 1183* 1189* 1191 2709 2712 2713 2713 2717* 2722* 3585* 3588* verify builtin function dcl 3823 ref 357 376 507 722 748 1289 1816 1817 1968 2344 2351 3297 3304 version 001012 automatic fixed bin(17,0) level 2 dcl 1232 set ref 1222* vl 000106 automatic fixed bin(24,0) dcl 645 set ref 705* 740 752* 752 753 801* 801 802 819 819 826 826 829 835 835 842 842 849 849 856 856 863 863 871 871 875 875 879 879 883 883 885* 885 887 vname 000450 automatic varying char(32) dcl 1960 in procedure "macro_empty" set ref 1977* 1978 1981 1985 1993* 1997 2004 vname 000773 automatic varying char(32) dcl 3337 in procedure "var_bound" set ref 3362* 3364* 3368 vname 000520 automatic varying char(32) dcl 2326 in procedure "macro_let" set ref 2356* 2394 2397 2402* 2406* 2408 2437 2487* 2507 2619 2637 2706* 2713* 2754* 2762* vname parameter varying char(32) dcl 1493 in procedure "lookup" ref 1491 1499 1527 1536 vptr 001066 automatic pointer dcl 3419 in procedure "var_range" set ref 3443* 3449 3536 vptr 000532 automatic pointer dcl 2327 in procedure "macro_let" set ref 2441* 2469 2699 watchfor parameter char unaligned dcl 3838 ref 3837 3840 watchword 000034 internal static char(32) initial unaligned dcl 3718 set ref 3585 3585* 3602 3602* 3622 3622* 3840* which parameter fixed bin(24,0) dcl 2314 in procedure "macro_let" ref 2312 2343 2349 2403 2412 2419 2443 2465 2470 2481 2499 2521 2536 2552 2566 2599 2652 2661 2675 2692 2695 2720 2771 which parameter char(3) unaligned dcl 1173 in procedure "free_um" set ref 1171 1182* 1197* who parameter char unaligned dcl 960 ref 958 971 976 982 987 1009 who_am_i 000044 internal static varying char(12) dcl 3719 set ref 20* 22* 161 172 193 255 366 1000 1757 2093 2108 3668* 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 3814 archive_util_$search 000000 constant entry external dcl 3815 area_infop automatic pointer dcl 1-5 argstrl automatic fixed bin(24,0) dcl 3569 in procedure "var_ref" argstrl automatic fixed bin(24,0) dcl 2040 in procedure "macro_error" argstrl automatic fixed bin(24,0) dcl 1786 in procedure "macro_define" argstrl automatic fixed bin(24,0) dcl 1344 in procedure "logical" argstrl automatic fixed bin(24,0) dcl 3336 in procedure "var_bound" argstrl automatic fixed bin(24,0) dcl 3233 in procedure "protected" argstrl automatic fixed bin(24,0) dcl 2274 in procedure "macro_length" argstrl automatic fixed bin(24,0) dcl 3148 in procedure "macro_usage" begl automatic fixed bin(24,0) dcl 1247 in procedure "get_range" begl automatic fixed bin(24,0) dcl 921 in procedure "cvt" begl automatic fixed bin(24,0) dcl 3329 in procedure "var_bound" begl automatic fixed bin(24,0) dcl 1034 in procedure "expand" c6 automatic picture(6) unaligned dcl 1305 ch automatic char(1) unaligned dcl 2799 ch8 automatic picture(8) unaligned dcl 2041 error_table_$action_not_performed external static fixed bin(35,0) dcl 3804 error_table_$archive_fmt_err external static fixed bin(35,0) dcl 3805 error_table_$new_search_list external static fixed bin(35,0) dcl 3807 get_seg_ptr_ 000000 constant entry external dcl 3820 hcs_$fs_get_seg_ptr 000000 constant entry external dcl 3819 hcs_$make_ptr 000000 constant entry external dcl 3817 hcs_$status_mins 000000 constant entry external dcl 3818 i automatic fixed bin(24,0) dcl 3566 ii automatic fixed bin(24,0) dcl 1958 in procedure "macro_empty" ii automatic fixed bin(24,0) dcl 3230 in procedure "protected" ii automatic fixed bin(24,0) dcl 2325 in procedure "macro_let" ii automatic fixed bin(24,0) dcl 3566 in procedure "var_ref" ii automatic fixed bin(24,0) dcl 2145 in procedure "macro_if" input based char unaligned dcl 3564 in procedure "var_ref" input based char unaligned dcl 1249 in procedure "get_range" inputa based char(1) array unaligned dcl 3330 in procedure "var_bound" inputa based char(1) array unaligned dcl 1035 in procedure "expand" inputa based char(1) array unaligned dcl 3563 in procedure "var_ref" inputa based char(1) array unaligned dcl 2794 in procedure "macro_quote" inputa based char(1) array unaligned dcl 2142 in procedure "macro_if" inputa based char(1) array unaligned dcl 3070 in procedure "macro_unquote" inputa based char(1) array unaligned dcl 1868 in procedure "macro_do" inputa based char(1) array unaligned dcl 2868 in procedure "macro_scan" inputa based char(1) array unaligned dcl 1780 in procedure "macro_define" inputa based char(1) array unaligned dcl 1955 in procedure "macro_empty" inputa based char(1) array unaligned dcl 3142 in procedure "macro_usage" inputa based char(1) array unaligned dcl 2268 in procedure "macro_length" inputa based char(1) array unaligned dcl 3227 in procedure "protected" inside automatic bit(1) unaligned dcl 2798 j automatic fixed bin(24,0) dcl 1871 in procedure "macro_do" j automatic fixed bin(24,0) dcl 2145 in procedure "macro_if" j automatic fixed bin(24,0) dcl 3145 in procedure "macro_usage" j automatic fixed bin(24,0) dcl 1958 in procedure "macro_empty" j automatic fixed bin(24,0) dcl 2037 in procedure "macro_error" j automatic fixed bin(24,0) dcl 295 in procedure "ampersand" j automatic fixed bin(24,0) dcl 3230 in procedure "protected" j automatic fixed bin(24,0) dcl 2871 in procedure "macro_scan" j automatic fixed bin(24,0) dcl 1038 in procedure "expand" j automatic fixed bin(24,0) dcl 3073 in procedure "macro_unquote" j automatic fixed bin(24,0) dcl 2271 in procedure "macro_length" j automatic fixed bin(24,0) dcl 1559 in procedure "macro_af" jaf automatic fixed bin(24,0) dcl 3780 jj automatic fixed bin(24,0) dcl 1038 in procedure "expand" jj automatic fixed bin(24,0) dcl 3333 in procedure "var_bound" jj automatic fixed bin(24,0) dcl 2037 in procedure "macro_error" jj automatic fixed bin(24,0) dcl 2271 in procedure "macro_length" jj automatic fixed bin(24,0) dcl 3230 in procedure "protected" jj automatic fixed bin(24,0) dcl 1652 in procedure "macro_call" jj automatic fixed bin(24,0) dcl 2871 in procedure "macro_scan" jj automatic fixed bin(24,0) dcl 2145 in procedure "macro_if" jj automatic fixed bin(24,0) dcl 1783 in procedure "macro_define" jj automatic fixed bin(24,0) dcl 1251 in procedure "get_range" jj automatic fixed bin(24,0) dcl 3145 in procedure "macro_usage" jj automatic fixed bin(24,0) dcl 1559 in procedure "macro_af" jj automatic fixed bin(24,0) dcl 1958 in procedure "macro_empty" jj automatic fixed bin(24,0) dcl 3566 in procedure "var_ref" jj automatic fixed bin(24,0) dcl 3073 in procedure "macro_unquote" jj automatic fixed bin(24,0) dcl 295 in procedure "ampersand" jj automatic fixed bin(24,0) dcl 2797 in procedure "macro_quote" level automatic fixed bin(24,0) dcl 3335 in procedure "var_bound" level automatic fixed bin(24,0) dcl 3568 in procedure "var_ref" loc automatic fixed bin(24,0) array dcl 2272 in procedure "macro_length" loc automatic fixed bin(24,0) array dcl 1342 in procedure "logical" loc automatic fixed bin(24,0) array dcl 1784 in procedure "macro_define" loc automatic fixed bin(24,0) array dcl 3146 in procedure "macro_usage" loc automatic fixed bin(24,0) array dcl 2940 in procedure "macro_substr" loc automatic fixed bin(24,0) array dcl 3567 in procedure "var_ref" loc automatic fixed bin(24,0) array dcl 3334 in procedure "var_bound" loc automatic fixed bin(24,0) array dcl 3231 in procedure "protected" loc automatic fixed bin(24,0) array dcl 2038 in procedure "macro_error" loc automatic fixed bin(24,0) array dcl 2872 in procedure "macro_scan" output based char unaligned dcl 2270 in procedure "macro_length" output based char unaligned dcl 3787 in procedure "macro_" output based char unaligned dcl 3229 in procedure "protected" output based char unaligned dcl 1037 in procedure "expand" output based char unaligned dcl 1957 in procedure "macro_empty" output based char unaligned dcl 1870 in procedure "macro_do" output based char unaligned dcl 2144 in procedure "macro_if" output based char unaligned dcl 294 in procedure "ampersand" output based char unaligned dcl 3565 in procedure "var_ref" reverse builtin function dcl 3823 sega based char(1) array unaligned dcl 3790 segii automatic fixed bin(24,0) dcl 3793 sep_ct automatic fixed bin(24,0) dcl 3335 in procedure "var_bound" sep_ct automatic fixed bin(24,0) dcl 2941 in procedure "macro_substr" sep_ct automatic fixed bin(24,0) dcl 3568 in procedure "var_ref" sep_ct automatic fixed bin(24,0) dcl 3232 in procedure "protected" sep_ct automatic fixed bin(24,0) dcl 1785 in procedure "macro_define" sep_ct automatic fixed bin(24,0) dcl 2039 in procedure "macro_error" sep_ct automatic fixed bin(24,0) dcl 3147 in procedure "macro_usage" sep_ct automatic fixed bin(24,0) dcl 2273 in procedure "macro_length" sep_ct automatic fixed bin(24,0) dcl 2873 in procedure "macro_scan" sep_ct automatic fixed bin(24,0) dcl 1343 in procedure "logical" skip_sw automatic bit(1) unaligned dcl 2141 tf automatic bit(2) unaligned dcl 1959 NAMES DECLARED BY EXPLICIT CONTEXT. add_id 003410 constant label dcl 186 ref 498 1628 1744 add_identification 003405 constant label dcl 184 ref 223 257 303 368 549 662 790 1357 1716 1759 2360 2399 2439 2477 2509 2584 2590 2595 2611 2621 2626 2639 2644 2745 2830 2903 2975 3010 3015 3033 3046 3350 3370 3377 3398 3434 3441 3461 3468 3478 3488 3496 3501 3581 3599 3619 3636 addmacro 004465 constant entry internal dcl 228 ref 536 1150 1161 1845 alf 004404 constant entry external dcl 3833 aln 004324 constant entry external dcl 3828 ampersand 005026 constant entry internal dcl 281 ref 607 675 1055 1394 1447 1586 1688 1852 2119 2305 2684 2822 2920 2968 3098 3190 3359 3527 arg_range 007611 constant entry internal dcl 558 ref 321 arith_err 011305 constant label dcl 782 ref 684 726 728 759 793 797 812 900 arithmetic 010245 constant entry internal dcl 631 ref 339 1260 1266 2053 2665 2983 2992 bad_mac 014066 constant label dcl 1121 set ref 1146 calc 000034 constant label array(11:22) dcl 819 ref 762 806 calc_common 011705 constant label dcl 885 ref 823 839 846 853 860 867 873 877 881 common 012463 constant label dcl 993 ref 969 974 980 985 991 comp 000057 constant label array(2:8) dcl 1450 ref 1445 cvt 012043 constant entry internal dcl 915 ref 949 949 dbf 004426 constant entry external dcl 3835 dbn 004300 constant entry external dcl 3826 dcl_err 027376 constant label dcl 2505 ref 2523 2538 2554 2568 def_err 021476 constant label dcl 1822 ref 1833 doit 003054 constant label dcl 145 set ref 89 114 137 dtf 004415 constant entry external dcl 3834 dtn 004312 constant entry external dcl 3827 dumper 012132 constant entry internal dcl 940 ref 299 652 1041 1567 1666 1793 1880 1967 2048 2157 2281 2343 2881 2951 3159 end_range 037114 constant label dcl 3532 in procedure "var_range" ref 3525 end_range 010077 constant label dcl 612 in procedure "arg_range" ref 605 endloop 011735 constant label dcl 902 ref 757 810 817 898 error_attempt 012425 constant entry internal dcl 987 error_gen 012400 constant entry internal dcl 982 ref 1738 1983 1999 2006 2349 2661 error_misplaced 012341 constant entry internal dcl 976 ref 1693 1941 error_missing 012257 constant entry internal dcl 958 ref 417 515 530 593 1576 1678 1801 1828 1898 1909 1975 1990 2071 2173 2218 2289 2465 2652 2675 2692 2813 2889 2959 3089 3167 3244 3311 3514 error_syntax 012317 constant entry internal dcl 971 ref 503 624 1822 exit 003615 constant label dcl 210 ref 1019 1109 1129 2113 expand 012750 constant entry internal dcl 1026 in procedure "macro_" ref 171 1886 2179 2207 2915 expand 002305 constant entry external dcl 28 find_macro 013141 constant entry internal dcl 1064 ref 143 found 017157 constant label dcl 1524 ref 1510 free 003702 constant entry external dcl 3645 free_um 014442 constant entry internal dcl 1171 ref 213 3655 3663 get_area 015036 constant entry internal dcl 1220 ref 66 get_range 015075 constant entry internal dcl 1239 ref 583 2461 3448 get_token 015251 constant entry internal dcl 1276 ref 1894 1912 2169 2238 here 013407 constant label dcl 1091 set ref 1091 1091 lgf 004362 constant entry external dcl 3831 lgn 004350 constant entry external dcl 3830 lineno 015345 constant entry internal dcl 1301 ref 198 710 710 995 996 1375 1375 1433 1433 1723 1723 1840 1840 2097 2159 2165 2165 2182 2182 2198 2198 2210 2210 2223 2223 2720 2720 2771 2771 2909 2909 log_err 015534 constant label dcl 1355 ref 1419 logical 015460 constant entry internal dcl 1329 ref 1893 2161 lookup 017003 constant entry internal dcl 1491 ref 1993 2402 3364 3430 3575 loop 030360 constant label dcl 2670 in procedure "macro_let" ref 2685 loop 015510 constant label dcl 1351 in procedure "logical" ref 1395 1408 loop 020147 constant label dcl 1673 in procedure "macro_call" ref 1695 1701 1707 1765 loop 010340 constant label dcl 657 in procedure "arithmetic" ref 676 682 694 loop 025735 constant label dcl 2284 in procedure "macro_length" ref 2306 loop 017324 constant label dcl 1571 in procedure "macro_af" ref 1590 1596 1602 loop 035621 constant label dcl 3343 in procedure "var_bound" ref 3360 loop 031640 constant label dcl 2808 in procedure "macro_quote" ref 2823 loop 032120 constant label dcl 2842 in begin block on line 2837 ref 2852 loop 034461 constant label dcl 3162 in procedure "macro_usage" ref 3191 loop 021253 constant label dcl 1796 in procedure "macro_define" ref 1853 loop 034135 constant label dcl 3084 in procedure "macro_unquote" ref 3099 loop 035437 constant label dcl 3297 in procedure "strip2" ref 3314 loop 033032 constant label dcl 2954 in procedure "macro_substr" ref 2969 loop 023566 constant label dcl 2066 in procedure "macro_error" ref 2120 loop 022147 constant label dcl 1886 in procedure "macro_do" ref 1925 1938 loop 032327 constant label dcl 2884 in procedure "macro_scan" ref 2921 loop1 016142 constant label dcl 1416 ref 1448 macdef 006762 constant label dcl 491 ref 485 macdef_err 007031 constant label dcl 503 ref 510 520 macnest_err 006765 constant label dcl 494 macro_ 002227 constant entry external dcl 16 ref 1736 macro_af 017242 constant entry internal dcl 1547 ref 336 macro_call 020025 constant entry internal dcl 1640 ref 390 macro_define 021173 constant entry internal dcl 1771 ref 441 macro_do 022056 constant entry internal dcl 1859 ref 462 1913 macro_empty 022617 constant entry internal dcl 1947 ref 405 macro_error 023337 constant entry internal dcl 2025 ref 408 macro_if 024365 constant entry internal dcl 2129 ref 465 2239 macro_length 025655 constant entry internal dcl 2259 ref 447 macro_let 026206 constant entry internal dcl 2312 ref 450 453 456 459 macro_quote 031611 constant entry internal dcl 2784 ref 426 macro_scan 032247 constant entry internal dcl 2859 ref 438 macro_substr 032752 constant entry internal dcl 2927 ref 444 macro_unquote 034106 constant entry internal dcl 3060 ref 429 macro_usage 034401 constant entry internal dcl 3133 ref 423 misplaced 003352 constant label dcl 179 ref 476 1588 2996 no_mend 007250 constant label dcl 526 ref 532 nother_logical 024463 constant label dcl 2161 ref 2195 od 022534 constant label dcl 1929 ref 1920 pcf 004373 constant entry external dcl 3832 pcn 004336 constant entry external dcl 3829 protected 035070 constant entry internal dcl 3219 ref 342 1915 2247 putout 035000 constant entry internal dcl 3198 ref 316 327 354 598 618 619 654 667 678 690 908 1049 1362 1407 1423 1581 1592 1598 1631 1668 1683 1697 1703 1749 1806 2060 2063 2075 2293 2301 2679 2817 2846 2848 2893 2963 3049 3050 3093 3171 3185 3246 3250 3354 3518 3540 3541 3588 3605 3625 quit 003300 constant label dcl 172 ref 435 retry 011014 constant label dcl 730 ref 832 890 show_string 035256 constant entry internal dcl 3258 ref 711 1377 1435 1437 1725 1842 2722 2773 2910 skip 022335 constant label dcl 1904 ref 1881 1923 skip_again 025035 constant label dcl 2185 ref 2201 skipper 025476 constant entry internal dcl 2228 ref 2181 2197 2209 start 002370 constant label dcl 66 ref 26 41 strip 035432 constant entry internal dcl 3288 ref 1283 1349 1416 1566 1665 1763 1792 1812 1879 1901 1931 1966 1986 2047 2062 2155 2177 2190 2206 2222 2280 2342 2442 2468 2578 2598 2656 2666 2805 2880 2950 3081 3158 3342 strip2 035420 constant entry internal dcl 3284 ref 333 1992 2080 2298 2446 2602 2694 2825 2898 2998 3101 3176 syntax_err 003640 constant label dcl 220 set ref 3547 type 000050 constant label array(7) dcl 1368 in procedure "logical" ref 1366 type 000000 constant label array(28) dcl 672 in procedure "arithmetic" ref 670 672 745 772 type 000071 constant label array(4) dcl 1688 in procedure "macro_call" ref 1686 type 000066 constant label array(3) dcl 1586 in procedure "macro_af" ref 1584 use_char 034366 constant label dcl 3121 ref 3114 var_bound 035601 constant entry internal dcl 3321 ref 400 402 var_range 036242 constant entry internal dcl 3405 ref 396 var_ref 037256 constant entry internal dcl 3554 ref 541 variable 005476 constant label dcl 357 watch 004441 constant entry external dcl 3837 NAMES DECLARED BY CONTEXT OR IMPLICATION. before builtin function ref 1150 1150 1161 1161 codeptr builtin function ref 1091 1091 copy builtin function ref 3050 3050 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 43636 43760 43143 43646 Length 44456 43143 122 461 472 50 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME macro_ 816 external procedure is an external procedure. addmacro 132 internal procedure is called by several nonquick procedures. ampersand 1634 internal procedure calls itself recursively. arg_range internal procedure shares stack frame of internal procedure ampersand. arithmetic 624 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 88 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 136 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 1614 98 begin block uses auto adjustable storage. macro_call internal procedure shares stack frame of internal procedure ampersand. begin block on line 1718 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 2837 88 begin block uses auto adjustable storage. macro_scan internal procedure shares stack frame of internal procedure ampersand. begin block on line 2905 126 begin block uses auto adjustable storage. macro_substr internal procedure shares stack frame of internal procedure ampersand. begin block on line 2977 248 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. putout 92 internal procedure is called during a stack extension. protected 86 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 dt_sw macro_ 000013 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 varlen macro_af 000230 begl macro_call 000231 i macro_call 000232 j macro_call 000233 ii macro_call 000234 loc macro_call 000400 sep_ct macro_call 000401 level macro_call 000402 argstrl macro_call 000403 callseg macro_call 000414 callmac macro_call 000434 begl macro_define 000435 i macro_define 000436 j macro_define 000437 ii macro_define 000446 begl macro_empty 000447 i macro_empty 000450 vname macro_empty 000470 begl macro_error 000471 i macro_error 000472 ii macro_error 000502 begl macro_length 000503 i macro_length 000504 ii macro_length 000514 begl macro_let 000515 i macro_let 000516 j macro_let 000517 jj macro_let 000520 vname macro_let 000532 vptr macro_let 000534 found macro_let 000535 lower macro_let 000536 higher macro_let 000550 begl macro_quote 000551 i macro_quote 000552 j macro_quote 000553 ii macro_quote 000562 begl macro_scan 000563 i macro_scan 000564 ii macro_scan 000565 argstrl macro_scan 000574 begl macro_substr 000575 i macro_substr 000576 j macro_substr 000577 ii macro_substr 000600 jj macro_substr 000601 argstrl macro_substr 000610 begl macro_unquote 000611 i macro_unquote 000612 ii macro_unquote 000613 inside macro_unquote 000614 ch macro_unquote 000624 begl macro_usage 000625 i macro_usage 000626 ii macro_usage 000627 ctl macro_usage 000661 ret_str macro_usage 000761 ret_len macro_usage 000770 i var_bound 000771 j var_bound 000772 ii var_bound 000773 vname var_bound 001012 begl var_range 001013 i var_range 001014 j var_range 001015 ii var_range 001016 jj var_range 001017 separator var_range 001066 vptr var_range 001070 limit var_range 001100 begl var_ref 001101 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 v arithmetic begin block on line 1614 000100 rval begin block on line 1614 begin block on line 1718 000100 argstr begin block on line 1718 000100 args begin block on line 1718 begin block on line 2837 000100 argstr begin block on line 2837 begin block on line 2905 000100 argstr begin block on line 2905 begin block on line 2977 000100 sepch begin block on line 2977 000100 argstr begin block on line 2977 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 putout 000100 tofe putout 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_$make_ptr initiate_file_ 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 16 002217 19 002237 20 002244 22 002260 23 002265 24 002267 25 002271 26 002274 28 002275 31 002315 33 002332 34 002337 35 002343 36 002355 37 002356 38 002360 39 002363 40 002365 41 002367 66 002370 69 002376 70 002401 72 002402 73 002413 75 002425 77 002434 78 002441 79 002475 80 002507 81 002511 83 002512 84 002514 85 002517 86 002520 88 002522 89 002524 93 002535 95 002537 96 002545 98 002552 100 002572 101 002601 104 002610 106 002614 109 002644 111 002654 112 002656 113 002660 114 002662 117 002663 118 002666 120 002675 122 002721 123 002726 124 002735 125 002751 128 002760 130 002764 132 003010 134 003025 135 003027 136 003031 137 003033 140 003034 143 003037 145 003054 147 003055 150 003063 151 003065 153 003067 156 003074 157 003076 159 003101 161 003112 163 003154 164 003165 165 003227 166 003231 169 003252 170 003254 171 003255 172 003300 177 003347 179 003352 181 003361 182 003373 184 003405 186 003410 190 003426 192 003433 193 003444 195 003457 196 003473 197 003505 198 003517 199 003543 201 003545 203 003566 205 003574 206 003603 210 003615 212 003620 213 003622 214 003626 216 003635 217 003637 220 003640 222 003663 223 003676 3645 003677 3652 003707 3654 003714 3655 003716 3656 003722 3657 003725 3658 003733 3659 003735 3661 003765 3662 003774 3663 004001 3664 004005 3665 004032 3666 004034 3667 004035 3668 004037 3670 004071 3671 004076 3672 004100 3674 004113 3678 004151 3679 004154 3680 004157 3682 004163 3683 004165 3685 004212 3687 004217 3688 004244 3689 004246 3690 004247 3691 004256 3693 004261 3694 004263 3695 004275 3696 004276 3826 004277 3826 004305 3826 004310 3827 004311 3827 004317 3827 004322 3828 004323 3828 004331 3828 004334 3829 004335 3829 004343 3829 004346 3830 004347 3830 004355 3830 004360 3831 004361 3831 004367 3831 004371 3832 004372 3832 004400 3832 004402 3833 004403 3833 004411 3833 004413 3834 004414 3834 004422 3834 004424 3835 004425 3835 004433 3835 004435 3837 004436 3840 004454 3841 004463 228 004464 238 004472 241 004533 244 004545 247 004570 251 004602 253 004623 255 004624 256 004634 257 004646 259 004651 260 004654 261 004663 263 004716 264 004726 265 004732 266 004737 267 004744 268 004746 269 004750 270 004754 271 004757 272 004761 276 005024 281 005025 298 005033 299 005036 300 005065 302 005071 303 005101 305 005104 306 005117 308 005120 309 005123 310 005135 312 005136 313 005143 315 005144 316 005146 318 005203 320 005204 321 005212 324 005236 326 005240 327 005242 328 005320 330 005322 333 005327 336 005345 339 005370 342 005414 345 005436 347 005440 348 005444 351 005445 353 005447 354 005451 355 005475 357 005476 360 005514 362 005520 364 005522 366 005524 367 005534 368 005546 370 005551 371 005561 373 005562 375 005570 376 005572 377 005607 379 005612 381 005617 382 005621 383 005626 387 005637 389 005654 390 005656 391 005676 393 005677 395 005704 396 005706 397 005726 400 005727 402 005755 405 006003 408 006031 411 006057 413 006064 414 006103 416 006104 417 006112 419 006135 420 006142 423 006143 426 006171 429 006217 432 006245 434 006252 435 006255 438 006260 441 006306 444 006334 447 006362 450 006410 453 006441 456 006473 459 006525 462 006557 465 006606 468 006635 475 006673 476 006714 478 006725 481 006726 483 006733 484 006737 485 006744 487 006745 489 006752 490 006756 491 006762 494 006765 496 006773 497 007005 498 007017 500 007022 501 007024 503 007031 505 007063 506 007064 507 007066 510 007110 512 007111 514 007113 515 007122 516 007152 517 007153 518 007155 519 007172 520 007174 522 007201 523 007202 524 007245 526 007250 528 007257 529 007271 530 007303 531 007334 532 007335 535 007366 536 007422 538 007515 539 007525 541 007526 542 007546 544 007551 546 007552 547 007561 548 007573 549 007605 553 007610 558 007611 579 007613 580 007615 581 007617 582 007621 583 007625 584 007652 585 007656 587 007666 588 007667 589 007670 590 007713 592 007714 593 007723 595 007745 597 007750 598 007752 599 010006 601 010012 603 010022 604 010036 605 010040 607 010041 608 010066 610 010067 612 010077 614 010100 616 010106 617 010115 618 010124 619 010156 621 010214 622 010220 624 010221 626 010243 631 010244 651 010252 652 010257 653 010306 654 010311 655 010334 656 010336 657 010340 659 010363 661 010364 662 010374 664 010377 666 010401 667 010403 668 010434 670 010440 672 010454 675 010464 676 010511 678 010512 680 010536 681 010537 682 010541 684 010542 689 010545 690 010550 692 010574 693 010576 694 010600 696 010602 698 010605 700 010612 701 010614 704 010615 705 010617 706 010620 708 010622 710 010627 711 010703 712 010735 713 010736 719 010747 720 010763 722 010764 724 011004 726 011011 728 011013 730 011014 734 011021 735 011056 736 011065 738 011111 739 011113 740 011126 741 011135 742 011155 743 011157 745 011172 748 011176 750 011220 752 011225 753 011226 754 011245 755 011246 756 011251 757 011255 759 011256 762 011262 764 011264 769 011274 770 011275 772 011276 774 011301 782 011305 785 011315 786 011326 787 011336 788 011350 789 011371 790 011403 793 011406 797 011412 799 011414 801 011416 802 011417 803 011425 804 011426 806 011431 808 011435 809 011436 810 011441 812 011442 815 011446 816 011447 817 011452 819 011453 822 011467 823 011472 826 011473 829 011510 830 011514 831 011516 832 011521 835 011522 838 011536 839 011541 842 011542 845 011556 846 011561 849 011562 852 011576 853 011601 856 011602 859 011616 860 011621 863 011622 866 011636 867 011641 871 011642 873 011652 875 011653 877 011663 879 011664 881 011674 883 011675 885 011705 887 011707 888 011715 889 011717 890 011722 893 011723 896 011726 897 011730 898 011733 900 011734 902 011735 907 011737 908 011742 910 012041 915 012043 925 012045 926 012051 927 012065 928 012074 930 012101 931 012110 932 012112 933 012121 940 012131 949 012137 953 012255 958 012256 967 012272 968 012300 969 012315 971 012316 973 012332 974 012337 976 012340 978 012354 979 012361 980 012376 982 012377 984 012413 985 012423 987 012424 989 012440 990 012445 991 012462 993 012463 995 012475 996 012507 998 012521 1000 012531 1001 012544 1002 012556 1003 012570 1004 012602 1005 012614 1007 012626 1008 012640 1009 012647 1010 012663 1011 012672 1013 012700 1014 012712 1015 012724 1017 012733 1018 012742 1019 012744 1026 012747 1041 012755 1042 013005 1043 013012 1044 013032 1046 013040 1047 013042 1049 013044 1050 013076 1052 013102 1054 013105 1055 013106 1056 013133 1058 013137 1059 013140 1064 013141 1076 013143 1078 013160 1079 013165 1081 013223 1083 013234 1084 013267 1086 013322 1088 013402 1091 013407 1093 013474 1096 013541 1098 013622 1099 013623 1102 013674 1104 013677 1105 013706 1106 013720 1107 013727 1108 013743 1109 013745 1111 013746 1112 013750 1113 013753 1115 013755 1117 014020 1118 014054 1120 014057 1121 014066 1123 014104 1124 014116 1125 014130 1126 014154 1127 014163 1128 014175 1129 014177 1131 014200 1132 014203 1136 014227 1137 014230 1140 014247 1142 014250 1144 014265 1145 014274 1146 014306 1149 014307 1150 014312 1152 014360 1161 014367 1166 014441 1171 014442 1175 014444 1176 014450 1177 014452 1178 014455 1180 014460 1182 014463 1183 014512 1187 014547 1189 014554 1191 014607 1194 014615 1196 014623 1197 014625 1200 014677 1201 014707 1203 014715 1207 014763 1209 014777 1211 015001 1212 015032 1213 015034 1215 015035 1220 015036 1222 015037 1223 015041 1224 015042 1225 015044 1226 015052 1227 015054 1228 015056 1229 015071 1234 015074 1239 015075 1253 015077 1256 015112 1257 015114 1259 015115 1260 015117 1261 015141 1262 015167 1263 015171 1265 015200 1266 015202 1267 015223 1268 015245 1271 015247 1276 015250 1283 015256 1284 015272 1286 015302 1287 015304 1289 015305 1290 015323 1292 015330 1294 015334 1296 015343 1301 015344 1311 015352 1312 015353 1313 015356 1314 015364 1315 015371 1316 015372 1317 015411 1319 015416 1320 015417 1321 015420 1322 015450 1329 015457 1347 015465 1348 015470 1349 015472 1350 015505 1351 015510 1353 015533 1355 015534 1357 015544 1359 015547 1361 015551 1362 015553 1363 015604 1365 015610 1366 015624 1368 015625 1372 015635 1373 015637 1375 015645 1377 015726 1379 015762 1380 015763 1381 015766 1383 015773 1386 016015 1391 016047 1392 016052 1394 016053 1395 016100 1396 016101 1401 016105 1402 016106 1403 016107 1404 016110 1406 016112 1407 016113 1408 016136 1410 016137 1415 016140 1416 016142 1418 016156 1419 016177 1421 016200 1423 016201 1424 016231 1426 016235 1429 016250 1430 016253 1431 016255 1433 016262 1435 016343 1436 016375 1437 016420 1439 016454 1440 016455 1441 016460 1445 016465 1447 016467 1448 016514 1450 016515 1453 016546 1454 016552 1456 016553 1459 016604 1460 016610 1462 016611 1465 016642 1466 016646 1468 016647 1471 016701 1472 016705 1474 016706 1477 016740 1478 016744 1480 016745 1483 016776 1484 017002 1491 017003 1497 017005 1498 017011 1499 017017 1501 017032 1502 017034 1506 017035 1508 017041 1509 017044 1510 017051 1512 017061 1513 017066 1514 017067 1515 017076 1518 017133 1519 017143 1520 017150 1521 017156 1524 017157 1526 017166 1527 017173 1529 017206 1530 017210 1534 017211 1535 017214 1536 017221 1538 017234 1539 017236 1541 017237 1547 017242 1564 017244 1565 017246 1566 017250 1567 017264 1568 017315 1569 017320 1570 017322 1571 017324 1573 017347 1575 017350 1576 017357 1578 017401 1580 017404 1581 017406 1582 017442 1584 017446 1586 017463 1588 017510 1590 017521 1592 017522 1594 017545 1595 017547 1596 017550 1598 017551 1600 017574 1601 017576 1602 017600 1605 017602 1606 017605 1607 017607 1609 017614 1610 017616 1612 017617 1614 017621 1615 017624 1620 017635 1616 017640 1620 017641 1623 017713 1625 017720 1626 017731 1627 017742 1628 017761 1630 017764 1631 017770 1632 020022 1633 020024 1640 020025 1662 020027 1663 020031 1664 020037 1665 020044 1666 020060 1667 020111 1668 020114 1669 020137 1670 020142 1671 020144 1672 020145 1673 020147 1675 020172 1677 020173 1678 020202 1679 020240 1680 020241 1682 020244 1683 020246 1684 020302 1686 020306 1688 020323 1690 020350 1692 020356 1693 020364 1695 020407 1697 020410 1699 020433 1700 020435 1701 020436 1703 020437 1705 020462 1706 020464 1707 020466 1710 020470 1711 020473 1712 020476 1713 020501 1715 020503 1716 020512 1718 020515 1719 020520 1720 020526 1721 020535 1723 020543 1725 020630 1726 020661 1727 020662 1728 020704 1729 020710 1731 020714 1732 020724 1733 020734 1734 020741 1735 020746 1736 020750 1738 021010 1740 021041 1742 021045 1743 021051 1744 021053 1746 021056 1747 021057 1749 021060 1751 021103 1752 021105 1754 021110 1756 021113 1757 021123 1758 021136 1759 021150 1761 021153 1762 021154 1763 021157 1765 021172 1771 021173 1790 021175 1791 021177 1792 021201 1793 021215 1794 021246 1795 021251 1796 021253 1798 021275 1800 021276 1801 021306 1803 021330 1805 021333 1806 021335 1807 021371 1809 021375 1811 021405 1812 021407 1813 021422 1815 021432 1816 021435 1817 021457 1820 021475 1822 021476 1825 021521 1827 021524 1828 021534 1830 021557 1831 021561 1832 021576 1833 021600 1835 021605 1836 021610 1837 021622 1838 021632 1840 021637 1842 021715 1845 021740 1847 022017 1848 022020 1849 022023 1850 022026 1852 022027 1853 022054 1859 022055 1877 022063 1878 022066 1879 022070 1880 022103 1881 022134 1883 022142 1884 022144 1885 022145 1886 022147 1888 022176 1890 022204 1891 022207 1892 022211 1893 022216 1894 022237 1895 022253 1897 022261 1898 022267 1900 022312 1901 022316 1902 022331 1904 022335 1906 022357 1908 022360 1909 022367 1911 022411 1912 022416 1913 022431 1915 022464 1917 022514 1919 022521 1920 022522 1922 022523 1923 022525 1925 022526 1927 022527 1929 022534 1931 022537 1932 022552 1934 022554 1935 022557 1937 022560 1938 022563 1940 022564 1941 022573 1942 022616 1947 022617 1964 022621 1965 022623 1966 022625 1967 022641 1968 022672 1970 022715 1972 022722 1974 022724 1975 022734 1977 022756 1978 022773 1980 022776 1981 023005 1982 023017 1983 023031 1985 023053 1986 023056 1987 023071 1989 023101 1990 023110 1992 023132 1993 023146 1994 023152 1996 023153 1997 023162 1998 023174 1999 023206 2001 023231 2003 023235 2004 023243 2005 023255 2006 023267 2008 023312 2010 023317 2012 023322 2013 023325 2015 023330 2017 023333 2018 023335 2020 023336 2025 023337 2045 023341 2046 023343 2047 023345 2048 023361 2049 023412 2050 023415 2051 023421 2052 023422 2053 023424 2055 023445 2059 023466 2060 023470 2062 023514 2063 023530 2065 023565 2066 023566 2068 023607 2070 023610 2071 023617 2073 023641 2075 023643 2076 023676 2078 023702 2080 023712 2081 023725 2082 023741 2083 023743 2084 023752 2086 023767 2089 024004 2090 024016 2091 024026 2093 024040 2094 024052 2095 024064 2096 024077 2097 024111 2098 024140 2099 024147 2101 024174 2102 024200 2103 024207 2105 024235 2107 024240 2108 024250 2109 024263 2110 024275 2111 024310 2112 024322 2113 024324 2115 024327 2116 024332 2117 024335 2119 024336 2120 024363 2129 024364 2153 024372 2154 024376 2155 024400 2156 024413 2157 024421 2158 024451 2159 024452 2161 024463 2163 024505 2165 024515 2169 024613 2170 024627 2172 024635 2173 024644 2175 024667 2176 024672 2177 024675 2178 024710 2179 024712 2181 024742 2182 024743 2185 025035 2187 025040 2189 025046 2190 025050 2191 025063 2193 025067 2194 025072 2195 025074 2197 025075 2198 025076 2201 025160 2203 025161 2205 025166 2206 025170 2207 025203 2209 025233 2210 025234 2213 025326 2215 025331 2217 025337 2218 025345 2220 025367 2221 025372 2222 025375 2223 025410 2226 025475 2228 025476 2230 025477 2231 025500 2232 025522 2234 025523 2235 025525 2237 025526 2238 025531 2239 025544 2241 025577 2243 025605 2245 025613 2247 025621 2249 025651 2250 025653 2252 025654 2259 025655 2278 025657 2279 025661 2280 025663 2281 025677 2282 025730 2283 025733 2284 025735 2286 025756 2288 025757 2289 025766 2291 026010 2293 026012 2294 026045 2296 026051 2298 026061 2299 026074 2300 026100 2301 026102 2302 026153 2303 026157 2305 026160 2306 026205 2312 026206 2340 026210 2341 026212 2342 026214 2343 026230 2344 026260 2346 026274 2348 026275 2349 026305 2351 026327 2353 026352 2355 026360 2356 026362 2357 026372 2359 026375 2360 026405 2362 026410 2393 026411 2394 026417 2396 026426 2397 026436 2398 026450 2399 026462 2401 026465 2402 026467 2403 026473 2405 026476 2406 026505 2408 026544 2409 026552 2410 026554 2411 026556 2412 026557 2414 026563 2415 026566 2416 026570 2418 026617 2419 026620 2421 026622 2422 026630 2423 026636 2426 026675 2428 026676 2429 026700 2430 026702 2433 026731 2434 026732 2436 026734 2437 026744 2438 026756 2439 026770 2441 026773 2442 026776 2443 027012 2446 027024 2447 027037 2449 027040 2451 027047 2452 027051 2454 027055 2455 027060 2457 027061 2458 027063 2459 027065 2461 027067 2462 027113 2464 027123 2465 027132 2467 027154 2468 027156 2469 027171 2470 027174 2472 027177 2474 027202 2476 027204 2477 027213 2479 027216 2481 027220 2483 027223 2484 027226 2485 027232 2486 027245 2487 027247 2490 027317 2491 027332 2492 027337 2493 027340 2494 027342 2496 027344 2498 027354 2499 027356 2501 027361 2505 027376 2507 027406 2508 027420 2509 027432 2511 027435 2513 027436 2514 027442 2515 027446 2517 027451 2518 027452 2520 027460 2521 027462 2523 027465 2526 027475 2528 027476 2529 027502 2530 027505 2532 027506 2533 027507 2535 027511 2536 027513 2538 027516 2542 027532 2544 027533 2545 027537 2546 027542 2548 027543 2549 027544 2551 027546 2552 027550 2554 027553 2558 027567 2560 027570 2561 027574 2562 027577 2564 027600 2566 027601 2568 027604 2572 027620 2574 027621 2575 027625 2578 027627 2579 027643 2581 027644 2583 027652 2584 027661 2586 027664 2587 027666 2589 027671 2590 027700 2592 027703 2594 027710 2595 027717 2598 027722 2599 027736 2602 027750 2603 027763 2605 027764 2607 027765 2610 027774 2611 030003 2613 030006 2615 030010 2616 030012 2618 030020 2619 030027 2620 030041 2621 030053 2623 030056 2625 030057 2626 030066 2628 030071 2629 030072 2631 030100 2633 030103 2634 030105 2636 030110 2637 030117 2638 030131 2639 030143 2641 030146 2643 030147 2644 030156 2646 030161 2649 030166 2651 030176 2652 030205 2655 030227 2656 030231 2657 030244 2658 030247 2660 030256 2661 030266 2663 030310 2665 030320 2666 030341 2667 030355 2669 030356 2670 030360 2672 030401 2674 030402 2675 030411 2677 030433 2679 030435 2680 030470 2682 030474 2684 030504 2685 030531 2687 030532 2689 030535 2691 030545 2692 030554 2694 030576 2695 030612 2698 030617 2699 030623 2700 030626 2702 030631 2704 030634 2706 030636 2709 030672 2711 030701 2712 030705 2713 030721 2717 030760 2718 030775 2720 031002 2722 031072 2725 031116 2727 031117 2728 031121 2730 031123 2731 031130 2733 031135 2735 031140 2736 031150 2738 031166 2739 031171 2741 031172 2742 031174 2744 031201 2745 031210 2747 031213 2749 031217 2750 031234 2752 031242 2754 031246 2758 031313 2760 031330 2761 031337 2762 031357 2767 031430 2768 031447 2769 031451 2771 031456 2773 031552 2775 031604 2778 031605 2779 031610 2784 031611 2803 031613 2804 031615 2805 031617 2806 031633 2807 031636 2808 031640 2810 031661 2812 031662 2813 031671 2815 031713 2817 031715 2818 031750 2820 031753 2822 031763 2823 032010 2825 032011 2826 032024 2827 032030 2829 032032 2830 032042 2832 032045 2833 032050 2835 032065 2837 032066 2838 032071 2839 032101 2840 032114 2841 032116 2842 032120 2844 032141 2846 032146 2847 032177 2848 032203 2850 032236 2852 032245 2854 032246 2859 032247 2878 032251 2879 032253 2880 032255 2881 032271 2882 032322 2883 032325 2884 032327 2886 032350 2888 032351 2889 032360 2891 032402 2893 032404 2894 032437 2896 032443 2898 032453 2899 032466 2900 032472 2902 032474 2903 032504 2905 032507 2906 032512 2907 032522 2909 032530 2910 032605 2912 032640 2913 032641 2914 032657 2915 032662 2916 032714 2917 032720 2920 032723 2921 032751 2927 032752 2948 032754 2949 032756 2950 032760 2951 032774 2952 033025 2953 033030 2954 033032 2956 033054 2958 033055 2959 033064 2961 033106 2963 033110 2964 033143 2966 033147 2968 033157 2969 033204 2971 033205 2972 033210 2974 033212 2975 033222 2977 033225 2978 033230 2980 033240 2981 033253 2982 033255 2983 033257 2984 033300 2985 033322 2986 033324 2987 033327 2990 033342 2991 033343 2992 033345 2993 033366 2994 033410 2996 033413 2998 033425 2999 033442 3001 033451 3003 033456 3005 033465 3007 033467 3009 033472 3010 033502 3012 033505 3014 033507 3015 033517 3017 033522 3019 033525 3021 033527 3022 033534 3024 033535 3025 033544 3026 033546 3027 033551 3028 033552 3030 033554 3032 033557 3033 033567 3035 033572 3037 033574 3038 033604 3039 033634 3040 033643 3041 033677 3042 033711 3043 033745 3044 033754 3045 033767 3046 033776 3048 034001 3049 034010 3050 034041 3052 034100 3053 034101 3054 034102 3055 034105 3060 034106 3079 034110 3080 034112 3081 034114 3082 034130 3083 034133 3084 034135 3086 034156 3088 034157 3089 034166 3091 034210 3093 034212 3094 034245 3096 034250 3098 034260 3099 034305 3101 034306 3102 034321 3103 034324 3104 034326 3105 034327 3106 034337 3107 034346 3109 034351 3111 034353 3113 034357 3114 034360 3116 034361 3117 034362 3118 034363 3119 034365 3121 034366 3123 034367 3125 034373 3126 034375 3128 034400 3133 034401 3156 034403 3157 034405 3158 034407 3159 034423 3160 034454 3161 034457 3162 034461 3164 034502 3166 034503 3167 034512 3169 034534 3171 034536 3172 034571 3174 034575 3176 034605 3177 034620 3178 034635 3179 034637 3182 034651 3185 034706 3186 034737 3187 034746 3188 034750 3190 034751 3191 034776 3198 034777 3207 035013 3208 035017 3209 035021 3210 035030 3213 035066 3219 035067 3237 035075 3238 035100 3240 035102 3241 035123 3243 035124 3244 035133 3246 035155 3247 035211 3248 035217 3250 035225 3251 035250 3252 035253 3253 035254 3258 035255 3264 035276 3265 035300 3266 035303 3267 035323 3269 035324 3270 035330 3271 035331 3272 035332 3273 035334 3274 035336 3275 035371 3276 035374 3277 035375 3279 035416 3284 035417 3286 035425 3288 035430 3297 035437 3299 035462 3301 035467 3302 035472 3304 035477 3305 035514 3307 035520 3308 035536 3310 035537 3311 035546 3313 035573 3314 035600 3321 035601 3341 035603 3342 035605 3343 035621 3345 035642 3347 035643 3348 035653 3349 035665 3350 035677 3352 035702 3354 035703 3355 035733 3357 035737 3359 035746 3360 035773 3362 035774 3363 036010 3364 036012 3365 036016 3367 036017 3368 036027 3369 036041 3370 036053 3372 036056 3374 036062 3375 036071 3376 036103 3377 036115 3379 036120 3380 036122 3384 036130 3386 036140 3388 036142 3391 036147 3392 036156 3393 036170 3394 036202 3396 036215 3397 036224 3398 036236 3400 036241 3405 036242 3428 036244 3429 036246 3430 036250 3431 036263 3433 036264 3434 036274 3436 036277 3438 036303 3439 036312 3440 036324 3441 036336 3443 036341 3444 036342 3445 036344 3446 036346 3447 036350 3448 036353 3449 036377 3450 036402 3451 036405 3453 036413 3456 036421 3458 036424 3459 036433 3460 036445 3461 036457 3463 036462 3465 036464 3466 036473 3467 036505 3468 036517 3470 036522 3472 036525 3473 036532 3475 036534 3476 036543 3477 036555 3478 036567 3480 036572 3482 036573 3483 036600 3485 036602 3486 036611 3487 036623 3488 036635 3491 036640 3493 036641 3495 036645 3496 036654 3498 036657 3500 036662 3501 036671 3505 036674 3506 036700 3508 036710 3509 036711 3510 036712 3511 036734 3513 036735 3514 036744 3516 036766 3518 036770 3519 037023 3521 037027 3523 037037 3524 037053 3525 037055 3527 037056 3528 037103 3530 037104 3532 037114 3534 037115 3536 037123 3537 037126 3538 037131 3539 037135 3540 037146 3541 037177 3543 037235 3544 037241 3546 037242 3547 037252 3549 037255 3554 037256 3572 037260 3574 037266 3575 037270 3576 037303 3578 037304 3579 037314 3580 037326 3581 037340 3583 037343 3585 037347 3588 037413 3589 037443 3591 037444 3592 037446 3594 037450 3596 037453 3597 037462 3598 037474 3599 037506 3601 037511 3602 037515 3605 037577 3606 037633 3607 037636 3610 037705 3611 037722 3612 037723 3614 037725 3616 037730 3617 037737 3618 037751 3619 037763 3621 037766 3622 037770 3625 040052 3626 040106 3627 040112 3630 040161 3631 040176 3633 040177 3634 040206 3635 040220 3636 040232 3639 040235 ----------------------------------------------------------- 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