COMPILATION LISTING OF SEGMENT expand_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1645.4 mst Thu 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 11 expand_:proc(path,ent,segp1,bit_count,segp2,bit_count2,val); 12 13 /* expand_ does the real work of implementing % include ; statements. This entry point is called 14* directly by the expand command and assembler and pl1. Most of the actual work is done inside the 15* recursive internal procedure work. Whenever an include statement is recognized, work calls 16* itself. There is no possibility of getting into an infinite loop by having an include file 17* include itself because this error is checked for. There are some things that work does not do 18* the first time it is called in an invocation of expand_. This is implemented by providing 19* two entry points to work, one called work_first and the other called work. 20* 21* Most of the time expand_ is able to recover from errors in the ascii file it is expanding. 22* Since expand_ follows sss conventions, it reflects the error code of the last serious error. 23* Due to this, the caller of expand_ can't tell from the error code whether expand found 24* a fatal error, since the only fatal errors are file system errors that do not allow the 25* expanded segment to be made or truncated. Therefore, a caller of expand_ should check segp2. 26* if this pointer is null, then there was a fatal error, otherwise expand_ put something in the 27* expanded segment correctly(that is, expand operated correctly) even if the bit count of the 28* expanded segment is zero. 29* 30* segp is a pointer that is static with respect to work to aid in the generation of error messages. 31* 32* pwork is a pointer that points to the expanded segment - it is easier to access than segp2. 33* 34* revi is at first used in finding the suffix. Later it is used with segp in error messages. 35* 36* outi is the number of characters that have been put into the expanded segment. It must be static 37* with respect to work. 38* 39* suffix is a varying string that contains the suffix that is on ent. This tells us what syntax 40* to assume the ascii file is in and also helps specify names of include files. 41* 42* bit_count is the bit count of the file to be expanded. 43* 44* bit_count2 is the bit count of the expanded segment. 45* 46* segp1 is a pointer to file to be expanded. It is a parameter and is hard to access. 47* 48* segp2 is a pointer to the expanded segment. It is a parameter and is not used 49* for accessing that segment inside expand_. 50* 51* val is the parameter that is the error code we want to return. 52* 53* code is what we use to find out about errors in routines we call. 54* 55* i is a variable we don't really need except for ease of understanding the program. It is a temporary. 56* 57* level is used to keep track of what level of recursion we are working on at present. 58* 59* major_init is a flag that tells us whether we are dealing with assembler or pl1 syntax."1"b means assembler syntax, 60* "0"b means pl1 syntax. 61* 62* path holds the directory path name that is searched for include files before ">library_dir_dir>include" 63* is searched. 64* */ 65 66 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 67 68 69 dcl null builtin; 70 dcl (com_err_, com_err_$suppress_name, ioa_) entry options (variable); 71 dcl hcs_$make_seg entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (5), ptr, fixed bin); 72 dcl hcs_$set_bc entry (char (*) aligned, char (*) aligned, fixed bin (24), fixed bin); 73 dcl hcs_$initiate_count entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (24), fixed bin (2), 74 ptr, fixed bin); 75 dcl (bit_count,bit_count2) fixed bin(24),(segp,segp1,segp2,pwork) ptr; 76 dcl (val,code,revi,i) fixed bin(17); 77 dcl (outi,level) fixed bin(17),(ent, group_id, wkent)char(32) aligned; 78 dcl major_init bit(1) aligned init("0"b); 79 dcl path char(168) aligned; 80 dcl proj_incl_dir char(168) aligned; 81 dcl proj_incl_dir_init bit(1) aligned initial("0"b); 82 dcl suffix char(32) aligned varying init (""); 83 dcl (error_table_$namedup,error_table_$zero_length_seg,error_table_$badsyntax,error_table_$recursion_error, 84 error_table_$entlong) ext fixed bin(17); 85 86 dcl get_group_id_$tag_star external entry returns (char(32)); 87 dcl hcs_$truncate_seg ext entry(ptr,fixed bin(17),fixed bin(17)); 88 89 segp2=null; 90 outi,level,val,bit_count2=0; 91 92 /* revi=reverse_index(ent,".",0); I generate code for this routine.*/ 93 do revi=32 by-1 while(revi>0&substr(ent,revi,1)^="."); /* find the last suffix, if any */ 94 end; 95 96 /*locate the suffix*/ 97 if revi>0 then do; 98 99 i=index(substr(ent,revi)," "); 100 101 if i=0 then i=33-revi; 102 103 suffix = substr(ent,revi,i-1); /* get suffix*/ 104 105 end; 106 107 else do; /* probably an error - no suffix - continue any way, though */ 108 109 revi=index(ent," "); /*find size of file name*/ 110 if revi=0 then revi=33; 111 112 end; 113 114 if suffix=".eplbsa"|suffix=".alm" then major_init="1"b;/*is it an eplbsa 115* or a pl1 type expand?*/ 116 117 wkent=substr(ent,1,revi-1)||".ex"||suffix; /* generate name of expanded file*/ 118 119 if (revi+length(suffix))>30 /* if (revi-1 + 3 + length(suffix)>32 - only faster */ 120 then do; /* it is an error if the new name is longer than 32 chars */ 121 122 code=error_table_$entlong; /* Entry too long */ 123 go to error; 124 125 end; 126 127 call hcs_$make_seg(path,wkent,"",11,pwork,code); /* get expanded segment */ 128 if code = error_table_$namedup then call hcs_$truncate_seg(pwork,0,code); 129 if pwork=null then go to error; 130 131 segp2=pwork; /* set parameter */ 132 133 call work_first;/* special entry point for work when it is first called*/ 134 135 bit_count2=outi*9; 136 137 if outi=0 & val=0 then val=error_table_$zero_length_seg; 138 139 call hcs_$set_bc(path,wkent,bit_count2,code); /* set the bit count on the expanded segment */ 140 141 if code^=0 142 then 143 error: do; 144 145 call com_err_(code,"expand_","^a^/",wkent); 146 147 val=code; 148 149 end; 150 151 /* This is where the internal procedure work begins. There are no more statements in expand_ proper. */ 152 153 work:proc(nmp,nmn,checkp) recursive; 154 155 /* 156* This is where most of the work is done. 157* This entry point is only used for recursive calls to work. 158* 159* The code that appears between here and the entry work_first is only executed when processing 160* an include statement. 161* 162* quote is used in assembler syntax to remember what the quoting character of an acc or aci pseudo-op was. 163* 164* opcode is used in assembler syntax to get the opcode in a convenient location for checking against 165* "acc","aci",and "include". 166* 167* start_item is used to remember where a statement or comment or quote begins for use in 168* diagnostics. 169* 170* i is the variable in the huge loop that looks at each character. It tells which character in the 171* present file is being looked at. 172* 173* k has two uses. 1) as a flag to tell whether we are in the midst of an identifier 174* 2) to remember where an identifier begins, so we will be able to look at it when we have 175* come to the end of the identifier. 176* 177* n tells the number of characters in the file. 178* 179* lineno tells us which line we are presently looking at. 180* 181* start_id is used in much the same way that k is used. 182* 183* lasti is used to tell which character in the present file was the last one sent to the expanded segment. 184* In order to delete some characters from the expanded segment, merely call output_text 185* and then update value of lasti to skip over a part of the file being scanned. 186* size is used to tell how large various identifiers are. It is usually used in conjunction with k. 187* 188* c is an easily accessable place that contains the character in the file that is presently being looked at. 189* i tells where in the current file this character came from. 190* 191* 192* There are several different states that work can be in when it considers one 193* character. For example, are we inside of a comment? are we using pl1 or assembler syntax?, etc. 194* These different states are implemented by four label variables, called major_state,minor_state, 195* pct_break, and pct_finish. The main use of major_state is to distinguish between pl1 and ma 196* syntax and also to ignore include statements inside comments and/or quoted strings. 197* Minor_state is used to distinguish between processing inside and outside of an 198* include statement. Pct_break is transferred to whenever a blank or tab is found 199* right after an identifier. Pct_finish is transferred to whenever the end of 200* statement character is encountered if we care. Pct_break and pct_finish are only 201* transferred to if we care whether we just finished an identifier or statement. 202* For example, in pl1 syntax where statements begin and end is not kept track of 203* except for include statements, while for eplbsa, the statements are kept track 204* of. 205* 206* switch is a structure containing several flag bits. qcomment is used for deciding 207* whether a possible missing quote diagnostic has been given for this quotation. 208* percent_flag tells us whether we are in a percent statement in eplbsa. The 209* end_file_flag tells us whether we are ready to reach the end of the file or not. 210* "1"b means that, for qcomment, the diagnostic has been given, for percent_flag 211* we are in an include statement, for end_file_flag, we are not ready to end the file. 212* 213* bc contains the bit count of the file being considered. 214* 215* nmp was set from i before work was called. 216* 217* nmn was set as nmp was. 218* 219* checkp points to chain_link in the previous stack frame. 220* 221* chain_link is a structure that allows us to check for recursion error. Since there are no conditionals 222* in include statement processing, any loop of includes that closes on itself, of 223* any length, will cause infinite recursion. 224* segpt points to the include file in this level. It is used as such all during 225* work. 226* backpt points to chain_link in the previous stack frame. If there is no previous stack frame 227* of work, then backpt is null. 228* entr contains the entry name of the current include file. It is mostly for diagnostics. The 229* reason it is in this structure is so that if the next invocation of work 230* can't initiate it's include file, not only can the error message say which 231* file had a file system error, but also which line in which include file caused the 232* error. 233* startline contains the line on which a statement started, if we know we are at a statement. 234* 235* text is a character string consisting of the entire segment that we are processing. 236* 237* nm tells us how to find the name of the include file directly from the ascii segment 238* containing the include file. 239* 240* texti is thetext, only for the previous invocation of work. It is just for the purpose 241* of using nmn and nmp to get a pointer to nm. 242* */ 243 244 dcl hcs_$terminate_noname ext entry(ptr,fixed bin(17)); 245 dcl find_include_file_$initiate_count entry (char (*), ptr, char (*) aligned, fixed bin (24), ptr, fixed bin (17)); 246 dcl quote char(1) aligned; /* quote char for acc and aci statements in EPLBSA */ 247 dcl opcode char(7) varying aligned ; 248 dcl (start_item,i,k,n,lineno,start_id,lasti,size) fixed bin(17); 249 dcl c char(1) aligned; 250 251 dcl major_state label local; 252 253 dcl minor_state label local; 254 255 dcl pct_finish label local; 256 257 dcl pct_break label local; 258 259 dcl 1 switch aligned, 260 2(qcomment,percent_flag,end_file_flag) unaligned bit(1); 261 262 dcl (indx, num_chars) fixed binary(17); /* used in evaluating person's project */ 263 dcl bc fixed bin(24); 264 dcl (nmp /*tells where in the segment of the previous generation the name of the 265* include file for this generation is*/,nmn /*tells the number of characters in the 266* name*/)fixed bin(17),checkp ptr /*links the chainof recursive calls together*/; 267 dcl 1 chain_link aligned auto, 268 2 segpt ptr, /* points to the text segment*/ 269 2 backpt ptr, /* points to the previous generation*/ 270 2 entr char(32) aligned, /* for diagnostics */ 271 2 startline fixed bin(17); 272 dcl 1 chain aligned based(chain_link.backpt), 273 2 segptr ptr, 274 2 backp ptr, 275 2 entr1 char(32) aligned, 276 2 startline1 fixed bin(17); 277 dcl text char(n) aligned based(segpt),nm char(nmn) based(segpt),texti(nmp) char(1) based; 278 279 print_key:proc(mess1,mess2,incr); 280 /* 281* Print_key is used to print out most of the diagnostics for work. 282* 283* It is in charge of making sure that the header for error messages is correct at all times. 284* 285* There are two entry points,print_key and print_error. The basic difference is that print_key 286* prints out part of the include file and has a two part variable message while 287* print_error just has a one part error message and is just used to give miscellaneous 288* or simple error messages. 289* */ 290 291 dcl statement char(52) aligned varying; 292 dcl (mess1,mess2) char(*),incr fixed bin(17),print_switch bit(1) aligned; 293 294 print_switch="0"b; 295 296 go to print_maybe; 297 298 print_error:entry(message); 299 300 dcl message char(*); 301 302 print_switch="1"b; 303 304 print_maybe: 305 if segp^=segpt|revi^=level /* Only print this message once per call to work */ 306 /* segp and revi are static wrt work and so remember the 307* last segment and level for which this message was typed */ 308 then do; 309 310 call ioa_("expand_: Error in ^a at level ^d.^/",entr,level); 311 312 segp=segpt; 313 revi=level; /* remember the segment and level for which message typed */ 314 315 end; 316 317 if print_switch="0"b 318 319 then do; 320 statement=substr(text,start_item,i-start_item+incr); /*This makes sure I grab 321* no more than 52 characters*/ 322 call com_err_$suppress_name(0,"expand_"," ^a (starting on line ^d) ""^a"" ^a.^/",mess1,startline, 323 statement,mess2); 324 end; 325 326 else 327 call com_err_$suppress_name(0,"expand_"," ^a on line ^d.^/ Expansion will continue.^/",message,lineno); 328 329 if val=0 then val=error_table_$badsyntax; 330 331 end print_key; 332 333 output_text:proc; 334 335 dcl out_text char(j) based(pwork),(j,nout) fixed bin(17); 336 337 nout=i-lasti-1; 338 339 if nout<=0 then return; 340 341 j=outi+nout; 342 343 substr(out_text,outi+1,nout)=substr(text,lasti+1,nout); 344 345 outi=j; 346 347 end output_text; 348 349 segpt=addr(checkp->segptr->texti(nmp)); /* find out where nm begins*/ 350 351 entr=nm||".incl"||suffix; 352 353 backpt=checkp; 354 /*perform search - first of wdir then of projects include dir, then of >ldd>include*/ 355 356 if (nmn+length(suffix))>27 /* if length(nm||".incl"||suffix)>32 */ 357 then do; 358 359 code=error_table_$entlong; /* Entry too long. */ 360 go to too_long; 361 362 end; 363 364 call find_include_file_$initiate_count (substr (suffix, 2), chain.segptr, entr, bc, segpt, code); 365 if segpt=null then do; 366 367 too_long: if segp^=chain.segptr | revi^=level 368 then do; 369 370 371 call ioa_("expand_: Error in ^a at level ^d.^/",chain.entr1,level); 372 373 segp = chain.segptr; 374 revi = level; /* write header for error messages and remember */ 375 376 end; 377 378 call com_err_(code," expand_","^a, due to include statement starting on line ^d.^/", 379 entr,chain.startline1); 380 381 val=code; 382 383 return; 384 end; 385 386 do i=1 by 1 while(chain.backp^=null); 387 /* check for recursion error - don't check against original source*/ 388 389 if chain.segptr=chain_link.segpt 390 then do; 391 392 val=error_table_$recursion_error; /* fatal error*/ 393 394 call com_err_(0,"expand_","Recursion of include files starting with ^a is ^d levels deep.^/", 395 entr,i); 396 397 return; 398 end; 399 400 chain_link.backpt=chain.backp; 401 402 end; 403 404 chain_link.backpt=checkp; 405 406 go to start_work; 407 408 work_first:entry; 409 410 backpt=null; 411 segpt=segp1; 412 entr=ent; 413 bc=bit_count; 414 415 segp=null; 416 revi=0; /*revi and segp are used by the print_key and print_error routines to decide 417* whether it is necessary to type out the name of the file and the level 418* number for an error message - need a variable that tis static with respect 419* to work */ 420 421 422 start_work: 423 424 425 start_id,start_item,k,lasti=0; 426 percent_flag,end_file_flag = "0"b; /* flags that are used to determine state */ 427 if bc<9 then go to term_seg; 428 429 n=divide(bc,9,35,0); 430 431 level=level+1; 432 433 if major_init="1"b 434 then do; 435 436 major_state=eb_major; 437 minor_state=eb_new_stmt; 438 pct_break=eb_have_opcode; 439 pct_finish=eb_early_eos; 440 441 end; 442 443 else do; 444 445 major_state=any; 446 minor_state=usual; 447 448 end; 449 450 451 lineno,startline=1; 452 453 /* Initialization all done - ready for work loop */ 454 455 loop: do i=1 to n; 456 457 c=substr(text,i,1); /* this is a huge loop that looks at each character in the file. If we look 458* so hard, we need easy access to the character under consideration*/ 459 460 go to major_state;/* a label variable is more efficient than a constant transfer vector*/ 461 462 any: /* major_state - normal running */ 463 464 if c = "/" 465 then if i256 532 then 533 534 print_miss_quote: do; 535 536 qcomment="1"b; 537 538 call print_key("Probable missing quote","",1); 539 540 end; 541 542 end; 543 544 else go to print_miss_quote; 545 546 end; 547 548 go to next; 549 550 /* Minor states - only transferred to by major state any */ 551 552 usual: /* minor_state - not in a % statement or comment or quote*/ 553 554 if c = "%" 555 556 then do; 557 558 call output_text; 559 560 startline=lineno; 561 start_item=i; /* used in diagnostics */ 562 start_id=0; 563 pct_break=form_include; 564 pct_finish=null_pct; 565 minor_state=in_pct; 566 percent_flag="1"b; /* we are now in a percent statement in pl1 syntax */ 567 568 go to not_nl; 569 570 end; 571 572 else if c="""" 573 then do; 574 575 major_state=in_quote; 576 end_file_flag="1"b; 577 start_item=i; 578 startline=lineno; 579 qcomment="0"b; 580 581 go to not_nl; 582 583 end; 584 585 go to next; 586 587 in_pct: /* minor_state - inside % statement. Don't ignore quoted strings anymore */ 588 589 if c=";" 590 then go to pct_finish; 591 592 if c <= " " /* checks for blank,newline,tab all at once */ 593 then if start_id ^= 0 594 then go to pct_break; 595 else go to next; 596 597 if start_id=0 then start_id=i; /* we are either at the beginning or in the middle of an atom*/ 598 599 go to not_nl; 600 601 /* Termination states for processing "%" */ 602 603 have_name: /* pct_finish - have now seen "include" and a name and maybe more */ 604 605 if start_id ^= 0 606 then call print_key("Extra items in ""include"" statement 607 ","ignored",1); 608 609 recurse: call work(k,size,addr(chain_link)); 610 611 go to pct_clean; 612 613 null_pct: /* pct_finish - null % statement */ 614 615 if start_id^=0 616 then go to bad_pct; 617 618 pct_clean: 619 lasti=i; 620 minor_state=usual; 621 percent_flag="0"b; /* we are out of the percent statement */ 622 start_id=0; 623 624 go to not_nl; 625 626 bad_pct: /* pct_finish - illegal */ 627 628 call print_key("Illegal construction","deleted",1); 629 630 go to pct_clean; /* clean up anyway */ 631 632 finish_name: /* pct_finish - name ends with a ";" */ 633 634 k=start_id; 635 size=i-start_id; 636 637 go to recurse; 638 639 /* States to process break characters */ 640 641 form_include: /* pct_break - have gotten "include" */ 642 643 if substr(text,start_id,i-start_id)="include" 644 then do; 645 646 pct_break=form_name; 647 pct_finish=finish_name; 648 649 end; 650 651 else do; 652 653 pct_break=next; /* ignore any future break characters */ 654 pct_finish=bad_pct; /* Yell when the statement is finished*/ 655 656 end; 657 658 fin_break: 659 start_id=0; 660 661 if c="/" 662 then do; 663 664 i=i+1; /* didn't increment i to skip * so I could use i in substr above*/ 665 666 go to not_nl; 667 668 end; 669 670 go to next; 671 672 form_name: /* pct_break - have just received a break char for the name - remember where name is */ 673 674 k=start_id; 675 size=i-start_id; 676 pct_break=next; /*ignore any further breaks */ 677 pct_finish=have_name; 678 679 go to fin_break; 680 681 682 /* New states for recognizing "include" pseudo-op in EPLBSA syntax */ 683 684 eb_major: /* major_state - processing normal statement */ 685 686 if c = ";" 687 then go to pct_finish; 688 689 if c = " 690 " /* newline */ 691 then go to pct_finish; /* End of statement delimiters */ 692 693 go to minor_state; /* something else, see who has his hand up */ 694 695 eb_ascii: /* major_state - handling quoted string in ACC or ACI pseudo-ops */ 696 697 if c = quote 698 then if i < n 699 then if substr(text,i+1,1) = quote 700 then i = i + 1; /* doubled quote means insert quote character */ 701 else do; 702 703 major_state=eb_major; 704 ignore_to_EOS: pct_finish = eb_normal_eos; /* at EOS ignore whatever opcode was */ 705 ignore_rest_of_stmt: minor_state = not_nl; /* at EOS do whatever opcode demands */ 706 707 end; 708 709 go to next; 710 711 712 eb_new_stmt: /* minor_state */ 713 714 if c = ":" 715 then do; 716 717 if k = 0 718 then do; 719 720 err_c: call print_error("Error in syntax involving <"||c||">"); 721 722 end_file_flag = "1"b; /* we are in a statement - cannot end without eos */ 723 724 end; 725 726 else k=0; /* legitimate label, reset and restart */ 727 728 go to not_nl; 729 730 end; 731 732 eb_get_opcode: /* minor_state */ 733 734 if c = "%" 735 then if k ^= 0 736 then go to err_c; /* a % in the middle of an identifier - comment and continue */ 737 else do; 738 739 start_id = i; /* save */ 740 i = start_item; /* start_item is the beginning of the present statement */ 741 call output_text; 742 i = start_id; /* restore */ 743 lasti = i; /* drop "%" from segment */ 744 745 end_file_flag = "1"b; /* we are in a statement */ 746 747 go to not_nl; 748 749 end; 750 751 if c = """" 752 then if k ^= 0 753 then go to err_c; /* .. */ 754 else do; 755 756 end_file_flag = "1"b; /* we are in statement */ 757 758 go to ignore_rest_of_stmt; 759 760 end; 761 762 if c <= " " /* checks for blank, tab all at once */ 763 then if k ^= 0 764 then go to pct_break; 765 else go to not_nl; 766 767 if k=0 then do; 768 k=i; 769 end_file_flag="1"b; 770 771 end; 772 773 go to not_nl; 774 775 eb_get_ascii_quote: /* minor_state - looking for quoting char */ 776 777 if c > " " /* not blank,tab,etc */ 778 then do; 779 780 quote = c; 781 major_state = eb_ascii; 782 783 end; 784 785 go to not_nl; 786 787 eb_early_eos: /* pct_finish */ 788 789 if k ^= 0 790 then do; 791 792 size=i-k; 793 794 if size <= 7 795 then do; 796 797 opcode = substr(text,k,size); 798 799 if opcode ^= "acc" 800 then if opcode ^= "aci" 801 then if opcode ^= "include" /* if opcode^="acc"&opcode^="aci"&opcode^="include" */ 802 then 803 804 eb_normal_eos: /* pct_finish */ 805 do; 806 807 start_item = i + 1; 808 if c = " 809 " /* newline*/ 810 then startline = lineno + 1; /* For diagnostics */ 811 else startline = lineno; /* Rarely */ 812 k = 0; 813 major_state=eb_major; 814 end_file_flag="0"b; /* end of statement - we can end file now */ 815 minor_state = eb_new_stmt; 816 pct_break = eb_have_opcode; 817 pct_finish = eb_normal_eos; 818 819 go to next; 820 821 end; 822 823 /* error, opcode requiring operand followed by EOS */ 824 825 call print_error("Opcode "||opcode||" requires operand"); 826 827 end; 828 end; 829 830 go to eb_normal_eos; /* random opcode - don't care */ 831 832 eb_include_eos: /* pct_finish */ 833 834 if k^=0 & size=0 then size=i-k; 835 836 eb_include_eos_x: /* pct_finish */ 837 838 /* include statement completed, now the fun begins */ 839 840 start_id = i; /* save value */ 841 i = start_item; /* fudge for output_text */ 842 843 call output_text; 844 845 if k=0 846 then call print_error("Segment-name missing from ""include"" statement"); 847 else call work(k,size,addr(chain_link)); /* recurse */ 848 849 i = start_id; 850 lasti = i; 851 go to eb_normal_eos; 852 853 eb_have_opcode: /* pct_break */ 854 855 size = i - k; 856 if size <= 7 857 then do; 858 859 opcode = substr(text,k,size); 860 861 if opcode = "acc" 862 then do; 863 864 set_acc: minor_state=eb_get_ascii_quote; /* looking for quote */ 865 go to next; 866 867 end; 868 869 if opcode = "aci" 870 then go to set_acc; 871 872 if opcode = "include" 873 then do; 874 875 size=0; 876 k = 0; /* start collecting */ 877 pct_finish = eb_include_eos; 878 minor_state = eb_get_opcode; /* don't look for labels */ 879 pct_break = eb_have_include_name; 880 881 go to not_nl; 882 883 end; 884 end; 885 886 /* we're not interested, ignore to EOS */ 887 888 go to ignore_to_EOS; 889 890 eb_have_include_name: /* pct_break */ 891 892 if size=0 then if k^=0 /* if size=0 & k^=0 */ 893 then do; 894 895 size=i-k; 896 897 minor_state = not_nl; /* leave name undisturbed */ 898 pct_finish = eb_include_eos_x; 899 900 end; 901 902 go to not_nl; 903 904 /* End of loop, all states described */ 905 906 next: if c=" 907 " /*newline*/ 908 then lineno=lineno+1; 909 910 not_nl: end loop; 911 912 if ^(end_file_flag | percent_flag) 913 then call output_text; 914 else do; 915 start_id=start_item; /* Set variables for call to print_key */ 916 start_item = i; /* Save for call to output_text */ 917 i = start_id; /* Only move up to before error */ 918 919 call output_text; /* copy out any characters before error */ 920 921 i = start_item; /* restore */ 922 start_item = start_id; 923 924 call print_key("Unbalanced comment or quote or improper ""%"" sequence 925 ","deleted",0); 926 927 end; 928 929 level=level-1; 930 931 term_seg: 932 if level^=0 933 then do; 934 call hcs_$terminate_noname(segpt,code); 935 if code^=0 936 then do; 937 val=code; 938 call com_err_(code,"expand_","^a^/",entr); 939 end; 940 end; 941 942 end work; 943 end expand_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1614.5 expand_.pl1 >dumps>old>recomp>expand_.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. backp 2 based pointer level 2 dcl 272 ref 386 400 backpt 2 000140 automatic pointer level 2 dcl 267 set ref 353* 364 367 371 373 378 386 389 400* 400 404* 410* bc 000137 automatic fixed bin(24,0) dcl 263 set ref 364* 413* 427 429 bit_count parameter fixed bin(24,0) dcl 75 ref 11 413 bit_count2 parameter fixed bin(24,0) dcl 75 set ref 11 90* 135* 139* c 000114 automatic char(1) dcl 249 set ref 457* 462 487 504 523 552 572 587 592 661 684 689 695 712 720 732 751 762 775 780 808 906 chain based structure level 1 dcl 272 chain_link 000140 automatic structure level 1 dcl 267 set ref 609 609 847 847 checkp parameter pointer dcl 264 ref 153 349 353 404 code 000104 automatic fixed bin(17,0) dcl 76 set ref 122* 127* 128 128* 139* 141 145* 147 359* 364* 378* 381 934* 935 937 938* com_err_ 000010 constant entry external dcl 70 ref 145 378 394 938 com_err_$suppress_name 000012 constant entry external dcl 70 ref 322 326 end_file_flag 0(02) 000136 automatic bit(1) level 2 packed unaligned dcl 259 set ref 426* 470* 496* 519* 576* 722* 745* 756* 769* 814* 912 ent parameter char(32) dcl 77 ref 11 93 99 103 109 117 412 entr 4 000140 automatic char(32) level 2 dcl 267 set ref 310* 351* 364* 378* 394* 412* 938* entr1 4 based char(32) level 2 dcl 272 set ref 371* error_table_$badsyntax 000026 external static fixed bin(17,0) dcl 83 ref 329 error_table_$entlong 000032 external static fixed bin(17,0) dcl 83 ref 122 359 error_table_$namedup 000022 external static fixed bin(17,0) dcl 83 ref 128 error_table_$recursion_error 000030 external static fixed bin(17,0) dcl 83 ref 392 error_table_$zero_length_seg 000024 external static fixed bin(17,0) dcl 83 ref 137 find_include_file_$initiate_count 000040 constant entry external dcl 245 ref 364 hcs_$make_seg 000016 constant entry external dcl 71 ref 127 hcs_$set_bc 000020 constant entry external dcl 72 ref 139 hcs_$terminate_noname 000036 constant entry external dcl 244 ref 934 hcs_$truncate_seg 000034 constant entry external dcl 87 ref 128 i 000106 automatic fixed bin(17,0) dcl 76 in procedure "expand_" set ref 99* 101 101* 103 i 000105 automatic fixed bin(17,0) dcl 248 in procedure "work" set ref 320 337 386* 394* 455* 457 462 462 475 479* 479 487 487 494* 494 509 509 513* 513 531 561 577 597 618 635 641 664* 664 675 695 695 695* 695 739 740* 742* 743 768 792 807 832 836 841* 849* 850 853 895* 916 917* 921* incr parameter fixed bin(17,0) dcl 292 ref 279 320 ioa_ 000014 constant entry external dcl 70 ref 310 371 j 000164 automatic fixed bin(17,0) dcl 335 set ref 341* 343 345 k 000106 automatic fixed bin(17,0) dcl 248 set ref 422* 609* 632* 672* 717 726* 732 751 762 767 768* 787 792 797 812* 832 832 845 847* 853 859 876* 890 895 lasti 000112 automatic fixed bin(17,0) dcl 248 set ref 337 343 422* 618* 743* 850* level 000110 automatic fixed bin(17,0) dcl 77 set ref 90* 304 310* 313 367 371* 374 431* 431 929* 929 931 lineno 000110 automatic fixed bin(17,0) dcl 248 set ref 326* 451* 474 560 578 808 811 906* 906 major_init 000121 automatic bit(1) initial dcl 78 set ref 78* 114* 433 major_state 000116 automatic label variable local dcl 251 set ref 436* 445* 460 469* 495* 518* 575* 703* 781* 813* mess1 parameter char unaligned dcl 292 set ref 279 322* mess2 parameter char unaligned dcl 292 set ref 279 322* message parameter char unaligned dcl 300 set ref 298 326* minor_state 000122 automatic label variable local dcl 253 set ref 437* 446* 485 565* 620* 693 705* 815* 864* 878* 897* n 000107 automatic fixed bin(17,0) dcl 248 set ref 320 343 429* 455 457 462 462 487 487 509 509 641 695 695 797 859 nm based char unaligned dcl 277 ref 351 nmn parameter fixed bin(17,0) dcl 264 ref 153 351 356 nmp parameter fixed bin(17,0) dcl 264 ref 153 349 nout 000165 automatic fixed bin(17,0) dcl 335 set ref 337* 339 341 343 343 null builtin function dcl 69 ref 89 129 365 386 410 415 opcode 000101 automatic varying char(7) dcl 247 set ref 797* 799 799 799 825 859* 861 869 872 out_text based char unaligned dcl 335 set ref 343* outi 000107 automatic fixed bin(17,0) dcl 77 set ref 90* 135 137 341 343 345* path parameter char(168) dcl 79 set ref 11 127* 139* pct_break 000132 automatic label variable local dcl 257 set ref 438* 477 563* 592 646* 653* 676* 762 816* 879* pct_finish 000126 automatic label variable local dcl 255 set ref 439* 564* 587 647* 654* 677* 684 689 704* 817* 877* 898* percent_flag 0(01) 000136 automatic bit(1) level 2 packed unaligned dcl 259 set ref 426* 472 566* 621* 912 print_switch 000116 automatic bit(1) dcl 292 set ref 294* 302* 317 proj_incl_dir_init 000122 automatic bit(1) initial dcl 81 set ref 81* pwork 000102 automatic pointer dcl 75 set ref 127* 128* 129 131 343 qcomment 000136 automatic bit(1) level 2 packed unaligned dcl 259 set ref 523 536* 579* quote 000100 automatic char(1) dcl 246 set ref 695 695 780* revi 000105 automatic fixed bin(17,0) dcl 76 set ref 93* 93 93* 97 99 101 103 109* 110 110* 117 119 304 313* 367 374* 416* segp 000100 automatic pointer dcl 75 set ref 304 312* 367 373* 415* segp1 parameter pointer dcl 75 ref 11 411 segp2 parameter pointer dcl 75 set ref 11 89* 131* segpt 000140 automatic pointer level 2 dcl 267 set ref 304 312 320 343 349* 351 364* 365 389 411* 457 462 487 509 641 695 797 859 934* segptr based pointer level 2 dcl 272 set ref 349 364* 367 373 389 size 000113 automatic fixed bin(17,0) dcl 248 set ref 609* 635* 675* 792* 794 797 832 832* 847* 853* 856 859 875* 890 895* start_id 000111 automatic fixed bin(17,0) dcl 248 set ref 422* 477 562* 592 597 597* 603 613 622* 632 635 641 641 658* 672 675 739* 742 836* 849 915* 917 922 start_item 000104 automatic fixed bin(17,0) dcl 248 set ref 320 320 422* 475* 531 561* 577* 740 807* 841 915 916* 921 922* startline 14 000140 automatic fixed bin(17,0) level 2 dcl 267 set ref 322* 451* 474* 560* 578* 808* 811* startline1 14 based fixed bin(17,0) level 2 dcl 272 set ref 378* statement 000100 automatic varying char(52) dcl 291 set ref 320* 322* suffix 000123 automatic varying char(32) initial dcl 82 set ref 82* 103* 114 114 117 119 351 356 364 364 528 switch 000136 automatic structure level 1 dcl 259 text based char dcl 277 ref 320 343 457 462 487 509 641 695 797 859 texti based char(1) array unaligned dcl 277 set ref 349 val parameter fixed bin(17,0) dcl 76 set ref 11 90* 137 137* 147* 329 329* 381* 392* 937* wkent 000111 automatic char(32) dcl 77 set ref 117* 127* 139* 145* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. get_group_id_$tag_star 000000 constant entry external dcl 86 group_id automatic char(32) dcl 77 hcs_$initiate_count 000000 constant entry external dcl 73 indx automatic fixed bin(17,0) dcl 262 num_chars automatic fixed bin(17,0) dcl 262 proj_incl_dir automatic char(168) dcl 80 NAMES DECLARED BY EXPLICIT CONTEXT. any 001302 constant label dcl 462 ref 445 495 518 bad_pct 001627 constant label dcl 626 ref 613 654 eb_ascii 001746 constant label dcl 695 ref 781 eb_early_eos 002114 constant label dcl 787 ref 439 eb_get_ascii_quote 002103 constant label dcl 775 ref 864 eb_get_opcode 002036 constant label dcl 732 ref 878 eb_have_include_name 002377 constant label dcl 890 ref 879 eb_have_opcode 002321 constant label dcl 853 ref 438 816 eb_include_eos 002246 constant label dcl 832 ref 877 eb_include_eos_x 002255 constant label dcl 836 ref 898 eb_major 001735 constant label dcl 684 ref 436 703 813 eb_new_stmt 001775 constant label dcl 712 ref 437 815 eb_normal_eos 002153 constant label dcl 799 ref 704 817 830 851 err_c 002002 constant label dcl 720 ref 732 751 error 000577 constant label dcl 141 set ref 123 129 expand_ 000256 constant entry external dcl 11 fin_break 001712 constant label dcl 658 ref 679 finish_name 001657 constant label dcl 632 ref 647 form_include 001665 constant label dcl 641 ref 563 form_name 001721 constant label dcl 672 ref 646 have_name 001545 constant label dcl 603 ref 677 ignore_rest_of_stmt 001771 constant label dcl 705 ref 758 ignore_to_EOS 001766 constant label dcl 704 ref 888 in_commnt 001340 constant label dcl 487 ref 469 in_pct 001524 constant label dcl 587 ref 565 in_quote 001363 constant label dcl 504 ref 575 loop 001265 constant label dcl 455 next 002415 constant label dcl 906 ref 502 548 585 595 653 670 676 709 819 865 not_nl 002421 constant label dcl 910 ref 481 498 515 568 581 599 624 666 705 728 747 765 773 785 881 897 902 null_pct 001614 constant label dcl 613 ref 564 output_text 003024 constant entry internal dcl 333 ref 558 741 843 912 919 pct_clean 001616 constant label dcl 618 ref 611 630 print_error 002576 constant entry internal dcl 298 ref 720 825 845 print_key 002553 constant entry internal dcl 279 ref 538 603 626 924 print_maybe 002613 constant label dcl 304 ref 296 print_miss_quote 001425 constant label dcl 531 ref 528 recurse 001576 constant label dcl 609 ref 637 set_acc 002344 constant label dcl 864 ref 869 start_work 001215 constant label dcl 422 ref 406 term_seg 002477 constant label dcl 931 ref 427 too_long 000770 constant label dcl 367 ref 360 usual 001460 constant label dcl 552 ref 446 620 work 000635 constant entry internal dcl 153 ref 609 847 work_first 001170 constant entry internal dcl 408 ref 133 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 349 609 609 847 847 divide builtin function ref 429 index builtin function ref 99 109 length builtin function ref 119 356 substr builtin function set ref 93 99 103 117 320 343* 343 364 364 457 462 487 509 641 695 797 859 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3266 3330 3060 3276 Length 3524 3060 42 157 206 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME expand_ 124 external procedure is an external procedure. work 188 internal procedure calls itself recursively. print_key 138 internal procedure is called during a stack extension. output_text internal procedure shares stack frame of internal procedure work. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME expand_ 000100 segp expand_ 000102 pwork expand_ 000104 code expand_ 000105 revi expand_ 000106 i expand_ 000107 outi expand_ 000110 level expand_ 000111 wkent expand_ 000121 major_init expand_ 000122 proj_incl_dir_init expand_ 000123 suffix expand_ print_key 000100 statement print_key 000116 print_switch print_key work 000100 quote work 000101 opcode work 000104 start_item work 000105 i work 000106 k work 000107 n work 000110 lineno work 000111 start_id work 000112 lasti work 000113 size work 000114 c work 000116 major_state work 000122 minor_state work 000126 pct_finish work 000132 pct_break work 000136 switch work 000137 bc work 000140 chain_link work 000164 j output_text 000165 nout output_text THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other return shorten_stack ext_entry int_entry int_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ com_err_$suppress_name find_include_file_$initiate_count hcs_$make_seg hcs_$set_bc hcs_$terminate_noname hcs_$truncate_seg ioa_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badsyntax error_table_$entlong error_table_$namedup error_table_$recursion_error error_table_$zero_length_seg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000250 78 000263 81 000264 82 000265 89 000266 90 000271 93 000275 94 000307 97 000312 99 000314 101 000334 103 000340 105 000350 109 000351 110 000364 114 000367 117 000403 119 000433 122 000440 123 000443 127 000444 128 000503 129 000522 131 000526 133 000531 135 000535 137 000541 139 000550 141 000575 145 000577 147 000630 943 000633 153 000634 349 000642 351 000653 353 000704 356 000710 359 000714 360 000716 364 000717 365 000763 367 000770 371 001000 373 001025 374 001031 378 001033 381 001072 383 001076 386 001077 389 001106 392 001112 394 001117 397 001155 400 001156 402 001160 404 001162 406 001166 408 001167 410 001175 411 001177 412 001204 413 001210 415 001212 416 001214 422 001215 426 001221 427 001225 429 001230 431 001232 433 001234 436 001237 437 001242 438 001245 439 001250 441 001253 445 001254 446 001257 451 001262 455 001265 457 001274 460 001301 462 001302 469 001315 470 001320 472 001322 474 001325 475 001327 476 001331 477 001332 479 001335 481 001336 485 001337 487 001340 494 001353 495 001354 496 001357 498 001361 502 001362 504 001363 509 001366 513 001376 515 001377 518 001400 519 001403 523 001405 528 001413 531 001421 536 001425 538 001427 548 001457 552 001460 558 001463 560 001464 561 001466 562 001470 563 001471 564 001474 565 001477 566 001502 568 001504 572 001505 575 001507 576 001512 577 001514 578 001516 579 001520 581 001522 585 001523 587 001524 592 001530 595 001537 597 001540 599 001544 603 001545 609 001576 611 001613 613 001614 618 001616 620 001620 621 001623 622 001625 624 001626 626 001627 630 001656 632 001657 635 001661 637 001664 641 001665 646 001675 647 001700 649 001703 653 001704 654 001707 658 001712 661 001713 664 001716 666 001717 670 001720 672 001721 675 001723 676 001726 677 001731 679 001734 684 001735 689 001741 693 001745 695 001746 703 001763 704 001766 705 001771 709 001774 712 001775 717 002000 720 002002 722 002030 724 002033 726 002034 728 002035 732 002036 739 002043 740 002045 741 002047 742 002050 743 002052 745 002053 747 002055 751 002056 756 002062 758 002064 762 002065 765 002073 767 002074 768 002076 769 002100 773 002102 775 002103 780 002107 781 002110 785 002113 787 002114 792 002116 794 002121 797 002123 799 002134 807 002153 808 002156 811 002165 812 002167 813 002170 814 002173 815 002175 816 002200 817 002203 819 002206 825 002207 827 002244 830 002245 832 002246 836 002255 841 002257 843 002261 845 002262 847 002300 849 002315 850 002317 851 002320 853 002321 856 002324 859 002326 861 002337 864 002344 865 002347 869 002350 872 002355 875 002362 876 002363 877 002364 878 002367 879 002372 881 002375 888 002376 890 002377 895 002403 897 002406 898 002411 902 002414 906 002415 910 002421 912 002423 915 002433 916 002435 917 002437 919 002441 921 002442 922 002444 924 002446 929 002474 931 002477 934 002502 935 002513 937 002516 938 002520 942 002551 279 002552 294 002573 296 002574 298 002575 302 002611 304 002613 310 002625 312 002651 313 002656 317 002660 320 002662 322 002700 324 002750 326 002751 329 003013 331 003023 333 003024 337 003025 339 003031 341 003033 343 003036 345 003046 347 003047 ----------------------------------------------------------- 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