diff --git a/source/B65ESPOL/SOURCE.alg_m b/source/B65ESPOL/SOURCE.alg_m index 5298612..36c5de9 100644 --- a/source/B65ESPOL/SOURCE.alg_m +++ b/source/B65ESPOL/SOURCE.alg_m @@ -1,10172 +1,10172 @@ - B 6 5 0 0 I M P L E M E N T A T I O N L A N G U A G E 00001000 - C 0 M P I L E R 00002000 - 1/68 00003000 - DIRECTORY BY SECTION: 00004000 - 0 COMMENTARY & ERROR MESSAGE CODES. 00005000 - 1 NON-PROCEDURAL DECLARATIONS 00006000 - 2 STREAM PROCEDURES AND FORWARD DECLARATIONS. 00007000 - 3 THE SCANNER 00008000 - 4 THE EMITTERS & SERVICE ROUTINES 00009000 - 5 GENERAL COMPONENTS & EXPRESSIONS 00010000 - 6 STATEMENTS 00011000 - 7 DECLARATIONS 00012000 - 8 SYNTAX CONTROLLERS (BLOCK & STATEMENT) 00013000 - 9 INITIALIZATION AND WRAPUP 00014000 - ERROR NUMBERS (USUALLY) HAVE THE NUMBER OF THE SECTION IN WHICH 00015000 - DETECTED AS THE FIRST DIGIT. 00016000 - 100 UNKNOWN IDENTIFIER. 00100000 - 101 STATEMENT SCANNER SCREWED UP. 00101000 - 102 PRIMARY SCANNER SCREWED UP 00102000 - 103 BOOPRIM SCANNER SCREWED UP. 00103000 - 199 PROCEDURE HAS NOT YET BEEN CODED 00199000 - 300 SCAN IDENTIFIER OR NUMBER OF > 63 CHARACTERS. 00300000 - 301 TABLE ILLEGAL CONSTRUCT. 00301000 - 302 HOOK TOO MUCH NESTING OF DEFINES AND THINGS. 00302000 - 303 TABLE NUMBER IS TOO LARGE. 00303000 - 304 UNHOOK EXTRANEOUS CROSSHATCH OR SOMETHING LIKE THAT. 00304000 - 305 ASSOCIATE MISSING "(" OR "[". 00305000 - 306 ASSOCIATE MISSING ")" OR "]" OR TOO MANY PARAMETERS. 00306000 - 307 GOBBLE INVALID STRING CHARACTER. 00307000 - 308 GOBBLE INVALID STRING CODE OR ILLEGAL STRING SYNTAX. 00308000 - 400 EMITTERS TOO MUCH CODE IN THIS SEGMENT 00400000 - 401 EMITV/N DISPLACEMENT TOO BIG 00401000 - 402 SUBSCRIBER MISSING BRACKET OR SUBSCRIPT. 00402000 - 403 DOTTER EXPRESSION NOT ARITHMETIC. 00403000 - 404 DOTIT "." PERIOD NOT FOLLOWED BY FIELD IDENTIFIER. 00404000 - 405 PURGE LABEL DECLARED FORWARD NOT SEEN 00405000 - 406 PURGE PROCEDURE DECLARED FORWARD NOT SEEN 00406000 - 407 GETSPACE ILLEGAL ADDRESS-PART VALUE. 00407000 - 408 GETSPACE ILLEGAL ADDRESS-PART SYNTAX. 00408000 - 410 GETSPACE TOO MANY STACK CELLS AT THIS LEVEL. 00410000 - 415 GETSTACK TOO MANY TEMPORARIES IN USE AT ONE TIME 00415000 - 501 IFCLAUSE MISSING "THEN". 00501000 - 502 CASEHEAD EXPRESSION NOT ARITHMETIC. 00502000 - 503 CASEHEAD MISSING "OF". 00503000 - 504 IFEXP MISSING "ELSE". 00504000 - 505 EXPRESSION EXPRESSION IS NOT OF REQUIRED TYPE. 00505000 - 506 CASEXP MISSING "(". 00506000 - 507 CASEXP MISSING ")". 00507000 - 508 RELATION THIS EXPRESSION MAY NOT APPEAR IN A RELATION. 00508000 - 509 RELATION THIS RELATION MAY USE ONLY "=" OR "!". 00509000 - 510 RELATION MISSING "FOR" IN STRING RELATION. 00510000 - 511 RELATION ILLEGAL EXPRESSION TYPE. 00511000 - 512 BEXP EXPRESSION NOT BOOLEAN TYPE. 00512000 - 513 AEXP IF EXPRESSION NOT ARITHMETIC TYPE. 00513000 - 514 SIMPARITH ARRAY EXPRESSION MAY NOT BE SIGNED. 00514000 - 515 TERM ARRAY AND WORD EXPRESSIONS MAY NOT BE OPERATED UPON 00515000 - 516 BOOSEC CANT NEGATE AN EXPR UNLESS ITS BOOLEAN. 00516000 - 517 BOOCOMP EXPRESSION NOT BOOLEAN. 00517000 - 518 REXP VARIABLE NOT REFERENCE TYPE. 00518000 - 519 REXP NOT ENOUGH SUBSCRIPTS ON REFERENCE ARRAY. 00519000 - 520 REXP REF EXPR CANT START WITH THIS TYPE IDENTIFIER. 00520000 - 521 REXP EXPRESSION NOT OF TYPE REFERENCE. 00521000 - 522 REXP MISSING ")". 00522000 - 523 REXP CASE EXPR NOT OF TYPE REFERENCE. 00523000 - 524 REXP IF EXPRESSION NOT OF TYPE REFERENCE. 00524000 - 525 REXP REF EXPR CANT START WITH THIS QUANTITY. 00525000 - 526 REXP MISSING "(". 00526000 - 527 REXP CANT TRANSFER THIS TO TYPE REFERENCE. 00527000 - 528 REXP NOT ENOUGH SUBSCRIPTS. 00528000 - 529 VARIABLE REGISTER ASSIGNMENT MUST BE LEFT-MOST ASSIGNMENT. 00529000 - 530 VARIABLE LEFT BRACKET DOES NOT FOLLOW ARRAY IDENTIFIER. 00530000 - 531 VARIABLE FIELD DESIGNATOR IS NOT LEFT-MOST IN LEFT-PART LIST. 00531000 - 532 VARIABLE A PROCEDURE IDENTIFIER IS USED OUTSIDE OF ITS SCOPE. 00532000 - 533 LAYITOUT "&" NOT FOLLOWED BY LAYOUT. 00533000 - 534 LAYITOUT MISSING "(". 00534000 - 535 LAYITOUT MISSING ")". 00535000 - 537 ENTRYEXP NOT YET CODED 00537000 - 538 VARIABLE A VARIABLE IS NOT FOLLOWED BY A REPLACEMENT OPERATOR.00538000 - 539 VARIABLE A READ ONLY ARRAY MAY NOT BE STORED INTO. 00539000 - 540 PEXP EXPRESSION NOT POINTER TYPE. 00540000 - 541 PTRCOMP SKIP PART NOT INTEGER OR REAL EXPRESSION. 00541000 - 542 ITEMREFERENCE INCORRECT SYNTAX FOR AN ITEM REFERENCE 00542000 - 543 ENTRYEXPR INCORRECT SYNTAX FOR ENTRY EXPRESSION 00543000 - 544 LAYITOUT EXPRESSION NOT OF REQUIRED TYPE. 00544000 - 545 VARIABLE POINTER IDENTIFIER MAY NOT BE SUBSCRIPTED. 00545000 - 546 SETVARIABLE CANNOT MIX SETS OF VARYING SIZES IN SAME EXP 00546000 - 547 SETVARIABLE MISSING REPLACEMENT OPERATOR 00547000 - 548 VARIABLE REGISTERS MAY NOT BE PARTIAL FIELDED. 00548000 - 549 ARRAYROW MISSING LEFT BRACKET. 00549000 - 550 ARRAYROW ARRAY ROW MUST HAVE 1 ASTERISK. 00550000 - 551 LONGSTRING TOO MANY STRING CHARACTERS OR MISSING QUOTE. 00551000 - 552 STRINGSOURCE STRING MUST BE 4-, 6- OR 8-BIT CHARACTERS. 00552000 - 553 ARITHCOMP DOUBLE EXPRESSION MAY NOT BE DOTTED. 00553000 - 554 TERM SIMPARITH WORD EXPRESSIONS CONSIST OF WORD PRIMARY ONLY 00554000 - 567 VARIABLE EVENTS MAY NOT BE PARTIAL FIELDED 00567000 - 573 REPLACESTMT UPDATE ON ARITHMETIC SOURCE VALID ONLY FOR UNITS=DIGI00573000 - 574 SUBSCRIBER ACTUAL SUBSCRIPT(S) MUST PRECEDE ROW DESIGNATOR(S). 00574000 - 575 VARIABLE FIELDS MAY NOT BE DUPLICATED AND LOADED. 00575000 - 576 BITFIDDLE MISSING "(". 00576000 - 577 BITFIDDLE MISSING ",". 00577000 - 578 BITFIDDLE BAD BIT NUMBER. 00578000 - 579 BITFIDDLE MISSING ")". 00579000 - 600 CASESTMT MISSING ":". 00600000 - 601 CASESTMT MISSING "BEGIN". 00601000 - 602 CASESTMT TOO MANY STATEMENTS. 00602000 - 603 PROCALL ILLEGAL USE OF PROCEDURE IDENTIFIER 00603000 - 604 PROCALL EITHER ACTUAL AND FORMAL PARAMETERS DO NOT AGREE AS 00604000 - TO NUMBER OR EXTRA RIGHT PARENTHESIS 00604500 - 605 ACTUALPARAPART ACTUAL AND FORMAL ARRAYS DO NOT HAVE SAME NUMBER OF 00605000 - DIMENSIONS 00605500 - 607 ACTUALPARAPART NO ACTUAL PARAMETERS MAY START WITH A QUANTITY OF 00607000 - THIS TYPE 00607500 - 608 FORSTMT IMPROPER FOR INDEX VARIABLE 00608000 - 609 FORSTMT MISSING UNTIL OR WHILE IN STEP ELEMENT 00609000 - 610 FORSTMT MISSING DO IN FOR CLAUSE 00610000 - 611 FORSTMT MISSING LEFT ARROW FOLLOWING INDEX VARIABLE 00611000 - 612 LABELR MISSING COLON 00612000 - 613 LABELR THE LABEL WAS NOT DECLARED IN THIS BLOCK 00613000 - 614 LABELR THE LABEL HAS ALREADY OCCURED 00614000 - 615 GOSTMT LABEL OR CASE DOES NOT FOLLOW GO TO 00615000 - 616 GOSTMT IMPROPER GO TO WITH CASE 00616000 - 617 GOSTMT MISSING "(" 00617000 - 618 GOSTMT ONLY A LABEL MAY APPEAR IN THE LIST 00618000 - 619 GOSTMT MISSING ")" 00619000 - 620 ACTUALPARAPART ACTUAL PARAMETER IS INTRINSIC PROCEDURE (NOT ERROR) 00620000 - 621 ACTUALPARAPART TEMPORARY ABSENCE OF CODE FOR THIS (NOT ERROR) 00621000 - 622 ACTUALPARAPART THE ACTUAL AND FORMAL PARAMETERS DO NOT AGREE AS TO 00622000 - TYPE 00622500 - 623 ACTUALPARAPART ILLEGAL PARAMETER DELIMETER 00623000 - 624 COMPOUNDTAIL MISSING SEMICOLON OR END. 00624000 - 645 COMPOUNDTAIL EXTRA END. 00625000 - 626 COMPOUNDTAIL MISSING END. 00626000 - 628 QALGORITHM THIS ALGORITHM IS NOT VALID FOR THIS QUEUE 00628000 - 629 QALGORITHM MISSING ACTUAL PARAMETER PART IN EXPLICIT CALL 00629000 - 630 QALGORITHM FIRST ACTUAL PARAMETER OF QALGORITHM IS ILLEGAL 00630000 - 631 FORSTMT ILLEGAL FOR CLAUSE 00631000 - 632 FORSTMT ILLEGAL EXPRESSION TYPE 00632000 - 633 QALGORITHM TOO MANY ACTUAL PARAMETERS 00633000 - 634 QALGORITHM ILLEGAL PARAMETER DELIMETER (IN THE BROAD SENSE) 00634000 - 635 QALGORITHM TOO MANY ACTUAL PARAMETERS OR SOMETHING 00635000 - 636 REPLACESTMT POINTER IDENTIFIER REQUIRED. 00636000 - 637 REPLACESTMT MISSING KEY WORD "BY". 00637000 - 638 REPLACESTMT SIMPLE ARITHMETIC VARIABLE REQUIRED. 00638000 - 639 REPLACESTMT MISSING WHILE OR UNTIL CLAUSE. 00639000 - 640 REPLACESTMT RELATIONAL OPERATOR OR IN EXPECTED. 00640000 - 641 REPLACESTMT SET IDENTIFIER REQUIRED. 00641000 - 642 REPLACESTMT PICTURE IDENTIFIER REQUIRED. 00642000 - 643 SCANSTMT POINTER IDENTIFIER REQUIRED. 00643000 - 644 SCANSTMT SIMPLE ARITHMETIC VARIABLE REQUIRED. 00644000 - 645 SCANSTMT CONDITION MISSING. 00645000 - 646 SCANSTMT RELATIONAL OPERATOR OR IN EXPECTED. 00646000 - 647 SCANSTMT SET IDENTIFIER REQUIRED. 00647000 - 648 QALGORITHM BUSY AND SIZE MUST BE USED AS PRIMARIES 00648000 - 649 QALGORITHM INCORRECT USAGE OF UNTYPED QUEUE ALGORITHM 00649000 - 651 REPLACESTMT NUMBER OF CHARACTERS IN THE STRING EXCEEDS LENGTH OF 00650000 - THE ARRAY. 00651000 - 652 REPLACESTMT MISSING LEFT BRACKET. 00652000 - 653 REPLACESTMT SHOULD BE A ROW 00653000 - 654 REPLACESTMT POINTER CANNOT BE UPDATED BY SUBCRIPTED VARIABLE. 00654000 - 655 REPLACESTMT MUST BE A PICTURE ID. 00655000 - 656 FILLSTMT TOO MANY WORDS OF INITIAL VALUES. 00656000 - 657 FILLSTMT INITIAL VALUE MUST BE NUMBER OR STRING. 00657000 - 658 FILLSTMT MISSING RIGHT PARENTHESIS. 00658000 - 659 FILLSTMT ARRAY ROW REQUIRED. 00659000 - 660 FILLSTMT MISSING "WITH". 00660000 - 661 SWAPSTMT MISSING LEFT PARENTHESIS. 00661000 - 662 SWAPSTMT ARRAYID OR SUBARRAY DESIGNATOR REQUIRED. 00662000 - 663 SWAPSTMT MISSING COMMA. 00663000 - 664 SWAPSTMT MISSING RIGHT PARENTHESIS. 00664000 - 665 SWAPSTMT NUMBER OF UNSPECIFIED SUBSCRIPTS MUST AGREE. 00665000 - 666 THRUSTMT MISSING DO IN A THRU CLAUSE 00666000 - 667 FORSTMT MISSING UNTIL FOLLOWING A BY ELEMENT 00667000 - 668 FORSTMT CONTROL VARIABLE IS NOT SIMPLE IN BY ELEMENT LIST 00668000 - 669 QALGORITHM BUZZ IS UNTYPED 00669000 - 670 EVENTINTRINSIC THE PARAMETER MUST BE AN EVENT DESIGNATOR 00670000 - 671 EVENTINTRINSIC THE PARAMETER MUST BE AN INTERRUPT ID 00671000 - 672 EVENTINTRINSIC MISSING LEFT OR RIGHT PARENTHESIS 00672000 - 680 EVENTINTRINSIC SECONDWORD EXPECTS EVENT OR DP PARAMETER 00680000 - 700 IDLIST THIS ID ALREADY DECLARED IN THIS BLOCK. 00700000 - 701 MERRIMAC PARENTHESES PROBLEM. 00701000 - 702 MERRIMAC INCORRECT TYPE OF PROCEDURE OR MONITORED ITEM. 00702000 - 703 FIELDPART INCORRECT "FIELD PART". 00703000 - 704 FIELDER INCORRECT "FIELD" - VALUE OR SYNTAX. 00704000 - 705 LAYOUTDEC INCORRECT "LAYOUT PART" 00705000 - 706 LAYOUTDEC "FIELD VALUE" IS NOT UNSIGNED INTEGER 00706000 - 707 LAYOUTDEC ILLEGAL LAYOUT PART 00707000 - 708 PUTOGETHER TOTAL ALPHA LONGER THAN 2047 CHARACTERS 00708000 - 709 00709000 - 710 DEFINEDEC MISSING EQUAL 00710000 - 711 QUEUEDEC ILLEGAL MULTIPLE USE 0F IDENTIFIER 00711000 - 712 QUEUEDEC MISSING ENTRY DESCRIPTION 00712000 - 713 QUEUEDEC MULTIPLE USE 0F SAME ALGORITHM ID IN QUEUE DEC 00713000 - 714 QUEUEDEC INCORRECT USAGE OF STANDARD QUEUE ALGORITHM 00714000 - 715 QUEUEDEC THIS CONSTRUCT NOT CODED AS YET (NOT ERROR) 00715000 - 717 ARRAYDEC THIS CONSTRUCT NOT CODED AS YET (NOT ERROR) 00717000 - 718 READONLYARRAYDEC ARRAY WORD MISSING. 00718000 - 719 READONLYARRAYDEC IDENTIFIER DECLARED BEFORE. 00719000 - 720 INITIALIZEARRAY MISSING LEFT PARANTHESIS. 00720000 - 721 INITIALIZEARRAY NOT A NUMBER OR A LOGICAL VALUE. 00721000 - 722 INITIALIZEARRAY TOO BIG AN INTEGER. 00722000 - 723 INITIALIZEARRAY MISSING RIGHT PARANTHESIS. 00723000 - 724 ARRAYDEC IDENTIFIER DECLARED BEFORE. 00724000 - 725 ARRAYDEC MORE THAN ONE IDENTIFIER DECLARED BEFORE +. 00725000 - 726 ARRAYDEC MISSING LEFT BRACKET. 00726000 - 727 ARRAYDEC IF YOU KNOW WHAT IT MEANS IMPLEMENT IT. 00727000 - 728 ARRAYDEC MISSING RIGHT BRACKET. 00728000 - 729 ARRAYDEC MISSING SEMICOLON. 00729000 - 730 PROCEDUREDEC PROCEDURE TYPE DIFFERS FROM FORWARD DECLARATION. 00730000 - 731 PROCEDUREDEC PROCEDURE IDENTIFIER ALREADY USED IN THIS BLOCK. 00731000 - 732 PROCEDUREDEC A PARAMETER WAS NOT SPECIFIED. 00732000 - 733 PROCEDUREDEC NUMBER OF PARAMETERS DIFFERS FROM FORWARD DEC. 00733000 - 734 PROCEDUREDEC SPECTEICATION DIFFERS FROM FORWARD DECLARATION. 00734000 - 735 PROCEDUREDEC THIS PROCEDURE WAS ALREAOY DECLARED FORWARD. 00735000 - 736 PROCEDUREDEC MISSING ";" OR "(" AFTER PROCEDURE IDENTIFIER. 00736000 - 737 FMLPARAPART ILLEGAL PAPAMETER DELIMITER. 00737000 - 738 FMLPARAPART MISSING "; " AFTER FORMAL PARAMETER LIST. 00738000 - 739 FMLPARAPART NOT VALID PARAMETER IDENTIFIER. 00739000 - 740 FMLPARAPART MISSING ";" IN SPECIFICATION PART. 00740000 - 741 FMLPARAPART ILLEGAL SPECIFIER OR COMBINATION OF SPECIFIERS. 00741000 - 742 FMLPARAPART TOO MANY ":"S. 00742000 - 743 FMLPARAPART ID NOT FORMAL, OR ALREADY SPECIFIED. 00743000 - 744 FMLPARAPART MISSING "[" IN ARRAY SPECIFICATION. 00744000 - 745 FMLPARAPART ILLEGAL BOUND SPECIFIER. 00745000 - 746 FMLPARAPART MISSING "]" IN ARRAY SPECIFICATION. 00746000 - 747 DEFINEDEC FUNNY PARAMETER. 00747000 - 748 DEFINEDEC MORE THAN 9 DEFINE PARAMETERS. 00748000 - 749 DEFINEDEC MISSING "(". 00749000 - 750 QUEUEDEC MORE THAN 32767 ITEMS 00750000 - 751 QUEUEDEC INCORRECT SYNTAX FOR LOCKING SPECIFICATION 00751000 - 752 QUEUEDEC MISSING RIGHT BRACKET IN SIZE SPECIFICATION 00752000 - 753 QUEUEDEC ILLEGAL SYNTAX FOR QUEUE ARRAY BOUND 00753000 - 756 PICTUREDEC ILLEGAL REPEAT PART VALUE. 00756000 - 757 PICTUREDEC MISSING ")" IN REPEAT PART. 00757000 - 758 PICTUREDEC PICTURE ID ALREADY USED IN THIS BLOCK. 00758000 - 759 PICTUREDEC MISSING "(" AFTER PICTURE ID. 00759000 - 760 PICTUREDEC ILLEGAL PICTURE CHARACTER. 00760000 - 783 IDLIST EVENT MAY NOT HAVE INITIAL VALUE 00783000 - 784 FMLPARAPART THIS ID HAS APPEARRED IN THE VALUE PART. 00784000 - 785 INTERRUPTDEC MISSING EVENT DESIGNATOR 00785000 - 786 INTERRUPTDE C MISSING "ON" OR COLON 00786000 - 787 INTERRUPTDEC MISSING COMMA 00787000 - 788 PROCEDUREDEC PROCEDURE FOR SEPARATED COMPILING CANNOT BE EXTERNAL.00788000 - 789 PROCEDUREDEC PROCEDURE FOR SEPARATED COMPILING CANNOT BE FORWARD. 00789000 - 790 PROCEDUREDEC GLOBAL PROCEDURE SHOULDNT HAVE A BODY. 00790000 - 791 PROCEDUREDEC TOO MANY GLOBAL DECLARATIONS. 00791000 - 800 DECLARATIONS MISSING ";" AFTER DECLARATION. 00800000 - 801 DECLARATIONS ILLEGAL COMBINATION OF DECLARATORS. 00801000 - 802 DECLARATIONS "SAVE" MAY NOT BE USED THIS WAY. 00802000 - 803 DECLARATIONS "OWN" MAY NOT BE USED THIS WAY. 00803000 - 804 STATEMENT UNRECOGNIZABLE STATEMENT STARTER. 00804000 - 805 STATEMENT DECLARATIONS SHOULD PRECEDE STATEMENTS. 00805000 - 806 STATEMENT MISSING "UNTIL" IN DO STATEMENT. 00806000 - 807 STATEMENT MISSING "DO" IN WHILE STATEMENT. 00807000 - 808 PRIMARY NO PRIMARY MAY START THIS WAY. 00808000 - 809 PRIMARY MISSING ")". 00809000 - 810 PRIMARY SOMEBODY GOOFED, SOMEWHERE. 00810000 - 811 PRIMARY ILLEGAL TRANSFER TYPE. 00811000 - 812 PRIMARY MISSING "(". 00812000 - 813 PRIMARY ILLEGAL EXPR TYPE IN TRANSFER FUNCTION. 00813000 - 814 PRIMARY ILLEGAL SECOND EXPRESSION IN TRANSFER FUNCTION. 00814000 - 815 PRIMARY TIMER AND XSIGN MAY NOT BE READ/ MISSING "+". 00815000 - 816 PRIMARY WRONG TYPE EXPRESSION IN REGISTER ASSIGNMENT. 00816000 - 617 BOOPRIM NO PRIMARY STARTS LIKE THIS. 00817000 - 818 BOOPRIM SOMEBODY GOOFED. 00818000 - 819 BOOPRIM MISSING ")". 00819000 - 820 BOOPRIM MISSING "(". 00820000 - 821 BOOPRIM ILLEGAL EXPRESSION TYPE IN TRANSFER FUNCTION. 00821000 - 822 PTRPRIM COMPILER ERROR. 00822000 - 823 PTRPRIM MISSING ")". 00823000 - 824 PTRPRIM CASE EXPRESSION NOT POINTER TYPE. 00824000 - 825 PTRPRIM POINTER PRIMARY CANNOT START WITH THIS. 00825000 - 826 MAKEPOINTER MISSING "(" 00826000 - 827 MAKEPOINTER MUST BE ARRAY IDENTIFIER. 00827000 - 828 MAKEPOINTER MUST BE ARRAY ROW. 00828000 - 829 MAKEPOINTER MUST BE ONE-DIMENSIONAL ARRAY. 00829000 - 830 MAKEPOINTER MISSING ")" 00830000 - 831 SETPRIM MISSING RIGHT PARENTHESIS 00831000 - 833 MAKEPOINTER CHARACTER SIZE MUST BE LITERAL 4, 6 OR 8. 00833000 - 834 BOOPRIM EXPRESSION BEFORE "IN" MUST BE POINTER OR SINGLE 00834000 - 835 BOOPRIM SET IDENTIFIER REQUIRED AFTER "IN". 00835000 - 836 STATEMENT HAPPENED AND AVAILABLE ARE BOOLEAN INTRINSICS 00836000 - 837 BOOPRIM THIS EVENT INTRINSIC IS UNTYPED 00837000 - 838 DECLARATIONS NOTHING BUT PROCEDURES CAN BE SEPARATELY COMPILED. 00838000 - 839 DECLARATIONS NO SAVE PROCEDURE CAN BE SEPARATELY COMPILED 00839000 - 840 DECLARATIONS NO "OWN" DEC IS PERMITTED IN SEPAR. COMPILATION 00840000 - 841 DECLARATIONS NO "VALUE" DEC IS PERMITTED IN SEPAR. COMPILATION 00841000 - 850 GLOBALDECLARATIONS ILLEGAL GLOBAL DECLARATION FOR SEPARATED COMPILE00850000 - 851 GLOBALDECLARATIONS MISSING SEMICOLON ON GLOBAL DECLARATION. 00851000 - 852 GLOBALDECLARATIONS ARRAY ID ALREADY DECLARED OR MISSING. 00852000 - 853 GLOBALDECLARATIONS MISSING "[" IN ARRAY DECLARATION. 00853000 - 854 GLOBALDECLARATIONS ILLEGAL BOUND SPECIFIER. 00854000 - 855 GLOBALDECLARATIONS MISSING "]" IN ARRAY DECLARATION. 00855000 - 856 GLOBALDECLARATIONS GLOBAL ID ALREADY DECLARED OR MISSING. 00856000 - 857 GLOBALDECLARATIONS TOO MANY GLOBAL DECLARATIONS. 00857000 - 858 SEPARATEDCOMPILING MISSING SEMICOLON AFTER LAST "END" OF PROCEDURE.00858000 - 900 QUEUEDEC MISSING SPECIFICATION IN FORMAL ITEM LIST. 00900000 - 921 GENMICRO REPEAT } 65535. 00921000 - 922 PICTUREDEC EXTRANEOUS ( IN PICTURE (INVALID REPEAT PART). 00922000 - 923 REPLACESTMT MISSING ")". 00923000 - 924 PICTUREGEN MISSING ",". 00924000 - 925 PICTUREGEN MISSING EXPRESSION. 00925000 - 926 PICTUREGEN MISSING ")". 00926000 -COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 10003000 - NON-PROCEDURAL DECLARATIONS 10004000 - * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;10005000 -BEGIN 10006000 - INTEGER ERRORCOUNT; % NUMBER OF ERROR MESSAGES GIVEN. 10007000 -BOOLEAN DONSBUG; % PRT 26 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%10008000 - REAL PRT27; COMMENT SEQUENCE NUMBER%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%; 10008100 - FILE IN CARD (5,10); % CARD INPUT 10009000 - FILE IN TAPE DISK SERIAL (2,10,150); 10010000 - SAVE FILE NEWTAPE DISK SERIAL [20:3000] 10011000 - (2,10,150,SAVE 10);% NEW SRCE10012000 - SAVE FILE CODE DISK [20:1250 ] (4,30,SAVE 100);%FINAL 10013000 - FILE TEMP DISK SERIAL[20:200]"TEMP""CODE"(2,30,150,SAVE 100); 10014000 - FILE LINE 4 "6500MCP" "LISTING" (3,17); 10015000 - SAVE FILE INFOUT DISK SERIAL[4:128]"MCP""GLOBALS"(2,256,SAVE 10); 10015100 - FILE INFIN DISK SERIAL "MCP""GLOBALS"(2,256); 10015200 - FILE DECK "ESPOL""DECK" (2,20,SAVE 10); 10015900 -% SCANNER VARIABLES 10016000 - INTEGER NCR, % POINTS TO NEXT CHAR TO BE SCANNED. 10017000 - FCR, % POINTS TO FIRST CHAR CURRENT ID OR NR. 10018000 - LCR, % POINTS TO SEQ NR CURRENT RECORD, 10019000 - CLCR, % POINTS TO SEQ NR CURRENT CARD RECORD. 10020000 - TLCR, % POINTS TO SEQ NR CURRENT TAPE RECORD. 10021000 - CONTEXT, % USED BY THE COMPILER TO TELL THE SCANNER 10022000 - % WHAT TO DO: 10023000 - %0=DECLARATIONS (GLOBAL IDS UNKNOWN) 10024000 - %1=SPECIFICATIONS 10025000 - %2=STATEMENTS & EXPRESSIONS 10026000 - %3=END COMMENTARY 10027000 - SCRAM, % SCRAMBLE INDEX OF LAST THING SEEN. 10028000 - COUNT, % SIZE OF LAST THING SCANNED. 10029000 - I, % SCAN POINTER FOR CURRENT ITEM. 10030000 - NXTELBT, % NEXT AVAILABLE WORD IN ELBAT. 10031000 - ELCLASS, % ELBAT[I].CLASS 10032000 - RESULT, % WHAT SCAN FOUND OR IS TO LOOK FOR. 10033000 - LASTUSED, % REMEMBERS WHERE THE LAST RECORD COME FROM10034000 - %1=CARD (ONLY) 10035000 - %2=CARD (INSERT WITH TAPE) 10036000 - %3=CARD PATCHING TAPE 10037000 - %4=TAPE WITH CARD WAITING. 10038000 - %5=TAPE-RAN OUT OF CARDS. 10039000 - % >5 IS INFO INDEX OF DEFINED STUFF. 10040000 - CARDCOUNT, % JUST WHAT IT SAYS. 10041000 - SCANCOUNT, % NUMBER OF CALLS ON TABLE 10042000 - DEFINECTR, % LEVEL OF DEFINE DFCL NESTING. 10043000 - DEFINEINDEX, % TOP OF DEFINEARRAY. 10044000 - TCOUNT, % PREVIDUS COUNT, SOMETIMES. 10045000 - LASTSEQUENCE; % ADDRESS OF LAST SEQUENCE NUMBER SEEN. 10046000 - % +1 IS VOID SEQ NR. 10047000 - % +2 IS ERROR SEQ NR. 10048000 - REAL C, % VALUE OF LAST CONSTANT. 10049000 - T, % TEMP FOR NUMBER CONVERSION. 10050000 - THI, 10051000 - TLO, 10052000 - NHI, 10053000 - NLO, 10054000 - SPEC, % "SPECIAL" WORD FOR CURRENT CHARACTER 10055000 - SEQNUMBER, % CURRENT SEQUENCE NUMBER. 10056000 - VOIDNUMBER, % VOID SEQUENCE NUMBER. 10057000 - ERRSEQNUMBER; % ERROR SEQUENCE NUMBER. 10058000 - ARRAY SPECIAL[0:63], % SPECIAL-CHARACTER INFO. 10059000 - INFO[0:127,0:255], % ALL WE KNOW ABOUT EVERYTHING 10060000 - ADDL[0:127,0:255], % IS IN INFO AND ADDL 10061000 - STACKHEAD[0:124], % ASSORTED LIST HEADS. 10062000 - ELBAT[0:75]; % THE WINDOW BETWEEN THE SCANNER & COMPILER10063000 - BOOLEAN LISTOG,SEQ, % SUNDRY OUTPUT TOGGLES 10064000 - DECKTOG, 10064100 - VOIDING, % --AND INPUT TYPES, TOO. 10065000 - PRTOG,RESEQTOG, 10066000 - SEPARATOG, % SEPARATED COMPILATION OF PROCEDURES. 10066100 - % <0: AVAILABLE FOR SETTING BY $-CARD 10066101 - % =2: GLOBAL DECLARATION TIME 10066102 - % =1: SEPARATED PROCEDURE COMPILING TIME 10066103 - % =0: REGULAR COMPILING 10066104 - % =4: INSIDE SEPARATED PROCEDURE COMPILING 10066105 - SVINFOTOG, % INFO & ADDL TO BE SAVED ON CODE FILE 10066200 - % <0: AVAILABLE FOR SETTING BY $-CARD 10066201 - % =0: RESET, INFO & ADDL NOT SAVED GENERALY10066202 - % =1: SET, INFO & ADDL SAVED UNCONDITIONAL 10066203 - DEBUGTOG, 10067000 - DUMPTOG, 10068000 - NOJUMPTOG, 10068500 - ENDTOG, 10069000 - INFOTOG,SAVETOG, 10069100 - LISTING, 10069200 - POOLTOG, 10069300 - NEWTOG; 10070000 - ALPHA Q; % ACCUM[1] OF LAST ID-TYPE THING. 10071000 - INTEGER ACCUMSTART, % ABS ADDRESS OF ACCUM[1].[18:6] 10072000 - ACCUMINX, % ABS ADDRESS OF END OF ACCUMED BLOB 10073000 - BUMPCHAR, % CONSTANT 32768 , @100000 10074000 - BUMPWORD; % CONSTANT 229375, @677777 10075000 - INTEGER CSZ; COMMENT STRING CHARACTER SIZE; 10075100 - INTEGER MAXCSZ; COMMENT MAX STRING CHAR SIZE IN CURRENT STRING; 10075200 - BOOLEAN LEFTY; COMMENT TRUE IFF STRING IS LEFT JUSTIFIED; 10075300 - BOOLEAN LITERALS; % TO KEEP PEOPLE HONEST ON IN LINE FIELDS, ETC. 10075350 - DEFINE DEFAULTSIZE = 6#; %DEFAULT STRING SIZE -- NOT ALL REFERENCES****10075400 - SAVE ARRAY ACCUM[0:10]; % WHAT THE SCANNER FOUND 10076000 - ALPHA CHR; % USUALLY THE NEXT CHARACTER TO BE SCANNED 10077000 - DEFINE STEPNCR=NCR~(IF NCRPTRID THEN 10136000 - GIT(TAKE(BOUND1)).NODIM ELSE 0 ELSE 0#; 10136100 -COMMENT THESE ARE THE FIELDS IN ADDL ENTRIES THAT ARE USED BY DEFINE, 10137000 - FIELD AND LAYOUT. ;10138000 - DEFINE LAYINIT =[ 7: 1]# % IF = 1, NEXT ADDL ENTRY IS INITIAL VALUE 10139000 - ,LAYCODE =[ 8: 8]# % FIELDV OR TAGV (LAYOUT ONLY) 10140000 - ,LAYAEXP =[16:16]# % EXP FOR STARTING BIT 10141000 - , LAYLTA=[16: 1]# % IF = 1 LAYLNA IS THE LITERAL OTHERWISE 10142000 - % LAYLNA POINTS TO TEXT FOR ARITH EXP 10143000 - , LAYLNA=[17:15]# 10144000 - ,LAYBEXP =[32:16]# % EXP FOR NUMBER OF BITS 10145000 - , LAYLTB=[32: 1]# % SEE LAYLTA 10146000 - , LAYLNB=[33:15]# 10147000 - ,STARTBIT =[ 9: 6]#%STARTING BIT FOR BIT OPERATORS - INFO.DISP 10148000 - ,NOOFBITS =[15: 6]#%NUMBER OF BITS FOR BIT OPERATORS - INFO.DISP10149000 - ; 10150000 - REAL KLASSF, % CLASS IN LOW ORDER 7 BITS 10151000 - TYPEF, % TYPE IN LOW ORDER 3 BITS 10152000 - ADDRSF; % ADDRESS IN LOW ORDER 19 BITS 10153000 - BOOLEAN FORMALF, % FML BIT OF ELBAT WORD 10154000 - ITEMF, % QBIT OF ELBAT WORD 10154100 - VONF; % VAL BIT OF ELBAT WORD 10155000 - SAVE ARRAY DEFINEARRAY [0:47]; % FOR SCANNING DEFINDIDS 10156000 - BOOLEAN MACRO; COMMENT - FALSE IF SCANNING ACTUAL SYMBOL LIST.; 10157000 - ARRAY DEFINFO [0:89]; % DEFINE PARAMETER IDS ETC. NO. IDS{9 10158000 - % ALPHA TEXT TO ADDL VARIABLES 10159000 -INTEGER NEXTCHAR, % NEXT AVAILABLE CHAR IN ADDL 10160000 - % 30:15 ADDL INDEX 10161000 - % 45: 3 CHARACTER WITHIN ADDL INDEX 10162000 - REMCOUNT, % NUMBER OF 6-BIT CHARACTER POSITIONS IN AN ADDL10163000 - % ROW 10164000 - CHARCOUNT; % TOTAL NUMBER OF CHARACTERS INSERTED IN ADDL 10165000 - % BY A GIVEN CALL ON TEXT. 10166000 -BOOLEAN BADSTUFF; % ALPHA LONGER THAN 2047 CHARACTERS (TOTAL) 10167000 - COMMENT DEFINES FOR PARAMETERS TO TEXT 10168000 - DEFINFV ;10169000 - DEFINE FIELDEXPA = DEFINEV + 1#, 10170000 - LAYEXPA = FIELDEXPA #, 10171000 - FIELDEXPB = DEFINEV + 2#, 10172000 - LAYEXPB = DEFINEV + 3#; 10173000 - INTEGER N; % SCRATCH 10174000 - REAL GT1,GT2,GT3,GT4,GT5; % SCRATCH 10175000 - REAL QGT1; %USED IN QUEUEDEC TO REPLACE GT1 10175500 - BOOLEAN TB1; % SCRATCH 10176000 - BOOLEAN ERRORTOG; 10177000 -BOOLEAN ARRAYDECTOG; %ARRAYDEC IN BLOCK 10177400 -DEFINE BLOCKEXITPCW=10#; %PCW FOR BLOCKEXIT IN (0,12) 10177600 -DEFINE GOTOSOLVERPCW=11#; % PCW FOR GOTOSOLVER IN (0,13) 10177700 - BOOLEAN DONE, SAVED; 10178000 - BOOLEAN FLAGS; 10179000 - DEFINE DPTOG = FLAGS.[45:1]#, 10179100 - STRINGSOURCEFLAG = FLAGS.[46:1]#, 10179110 - DEFINESFLAG = FLAGS.[44:1]#, 10179120 - THIFLAG = FLAGS.[46:1]#, 10179200 - TLOFLAG = FLAGS.[47:1]#; 10179300 - DEFINE WRITELBUFF=WRITE(LINE[DBL],17,LBUFF[*])#; 10180000 - INTEGER DEFINEADDR; % ADDRESS OF DEFINEARRAY[0] 10181000 - ARRAY TEN[0:68]; % POWERS OF TEN 10182000 - DEFINE BUMPL= L~L+3#; 10183000 - DEFINE INDXCHK=IF LASTINDEX=L-1 THEN IF GET(L~L-1)=NXLV THEN EMIT(INDX)10183300 - ELSE L~L+1 ELSE#; 10183500 -COMMENT VARIABLE SOMETIMES ISSUES NXLV RATHER THAN INDX; 10183510 - DEFINE STUFF = EMIT(STFF)#; 10183540 - DEFINE ANEVENT = EVENTID AND (GT1~ELBAT[I]).TYPE! 10183560 - FORMALNAMEQ#; 10183580 - ARRAY EDOC[0:31,0:255]; % CODE ACCUMULATED FOR CURRENT SEG 10184000 - ARRAY INZCODE[0:31,0:255]; COMMENT EDOC FOR "SAVE 1" PROCEDURES; 10184100 - INTEGER SAVEL; COMMENT L FOR INZCODE; 10184200 - INTEGER CURRENT, % CURRENT ADDRESSING LEVEL 10185000 - STATE, 10186000 - MAXDISP , % MAXIMUM DISPLACEMENT FOR CURRENT LEVEL 10187000 - LLMASK; % INVERTED ADDRESSING-LEVEL, FOR VALC,ETC10188000 - INTEGER MODE; 10189000 - INTEGER CSTATE; 10190000 - DEFINE S0 = 128#; % INITIAL SIZE OF D0 - STACK 10190050 -%%%%%%%%%%%%%%%%%%%%%% FOR SEPARATED COMPILATION %%%%%%%%%%%%%%%%%%%%%%%10190100 - FILE SEPF DISK SERIAL[20:300](2,30,150); 10190110 - ARRAY SEPA[0:29] % SEPARATED COMPILING INFORMATION (2-WDS/LEVEL) 10190120 - ,SEPSTR[0:12] % INFORMATION STORAGE IN BETWEEN SEP. PROCEDURES10190130 - ,AY[0:29] % SRATCH ARRAY. 10190140 - ; 10190150 - REAL GLOBLCNT % COUNT OF GLOBALS IN A SEPARATED COMPILATION 10190160 - ,GINFO % STARTING INFO INDEX OF GLOBALS 10190170 - ,GADDL % STARTING ADDL INDEX OF GLOBALS 10190180 - ,PCW % PCW WHICH JUST HAS BEEN EMITED BY "EMITPCW" 10190190 - ,SEPAX % CURRENT SEPA[*] INDEX 10190200 - ,SEPFX % CURRENT SEPF-RECORD INDEX 10190210 - ,TOTALSEGSIZE % TOTAL SEGMENT SIZE 10190213 - ,CORESIZE % THIS IS NOT FOR SEPARATED COMPILING ONLY 10190217 - ; 10190220 - DEFINE ENTERSEPA(ENTERSEPA1,ENTERSEPA2,ENTERSEPA3) = 10190230 - IF REAL(SEPARATOG)=4 THEN 10190240 - IF ERRORCOUNT=0 THEN 10190250 - BEGIN 10190260 - SEPA[SEPAX ]~PCW&SEGNO[01:37:11]; 10190270 - SEPA[SEPAX+1]~ENTERSEPA1&ENTERSEPA2[19:32:16]& 10190280 - ENTERSEPA3[03:32:16]; 10190290 - IF SEPAX~SEPAX+2}30 THEN 10190300 - BEGIN 10190310 - WRITE(SEPF,30,SEPA[*]); 10190320 - SEPFX~SEPFX+15; 10190330 - SEPAX~0; 10190340 - END; 10190350 - END#; 10190360 - DEFINE DKADDR=TEMPADDR#; % TEMP DISK FILE ADDRESS 10190365 - DEFINE SEPLEVEL=3#; % RUNNING LEVEL OF OUTER MOST BLOCK OF PROCEDURE10190380 - FORMAT GFMT(X4,"GLOBAL=(02,0",A4,")"); 10190390 - DEFINE GLOBALINDEX = IF PRTOG THEN WRITE(LINE[DBL],GFMT,O(GLOBLCNT))#;10190400 -%%%%%%%%%%%%%%%%%%% END OF FOR SEPARATED COMPILATION %%%%%%%%%%%%%%%%%%%10190498 -% 10190499 -%%%%%%%%%%%%%%%%%%%%%%%% FOR EXTERNAL PROCEDURE %%%%%%%%%%%%%%%%%%%%%%%%10190600 - FILE INFF DISK SERIAL[20:1500](2,30,150); % SAVE INFO FILE 10190610 - ARRAY INFD[0:15,0:255] % SAVE INFO DIRECTORY 10190620 - ; 10190630 - REAL STARTINFO % STARTINFO INFO INDEX OF THE PROGRAM 10190640 - ,STARTADDL % ARTINFO ADDL INDEX OF THE PROGRAM 10190650 - ,EXTRNLCNT % EXTERNAL PROCEDURE COUNT 10190660 - ,LASTEXT % INDEX OF INFO[*] OF THE LAST EXTERNAL PROC 10190661 - ,INFFX % RECORD INDEX OF INFF FILE 10190662 - ,INFDX % WORD INDEX OF INFO[*] 10190664 - ; 10190670 - BOOLEAN SVINFO % INFO & ADDL TO BE SAVED FOR THIS CURRENT LEVEL10190680 - ,XTRNL % EXTERNAL PROCEDURE 10190682 - ; 10190690 -%%%%%%%%%%%%%%%%%%%% END OF FOR EXTERNAL PROCEDURE %%%%%%%%%%%%%%%%%%%%%10190998 -% 10190999 - REAL COUNTQALG, % COUNT OF NO. OF NON STANDARD Q ALGORITMS ENCOUNT- 10191000 - % ERED AT A GIVEN LEVEL. INITIALISED TO STARTNSQ AT 10192000 - % BLOCK ENTRY AND UPDATED BY 1 EACH TIME NON STANDARD10193000 - % ALGORITHM ENCOUNTERED. UNIQUE IDENTIFICATION OF 10194000 - % Q ALGORITHM ID AT ANY LEVEL 10195000 - PCL, 10195500 - INVISIBLE; % POINTS TO INFO ENTRY OF FIRST INVISIBLE ITEM AFTER 10196000 - % SPECPART HAS PROCESSED Q ENTRY DESCRIPTION 10197000 - BOOLEAN FIXCALL % FALSE IF FIX CALLED FROM STATEMENT. 10197200 - % ALTERNATIVE IS TO PASS PARAMETER TO 10197220 - % EVENT INTRINSIC 10197240 - ; 10197260 - DEFINE STARTNSQ = 511#;%UPPER LIMIT ON NUMBER OF STANDARD Q ALGORITHMS10197300 - ARRAY QALGORYTHM [0:19]; % DO NOT EXPAND BOUND BEYOND 62 10198000 -COMMENT ONE ENTRY OF ONE OR TWO WORDS PER STANDARD Q ALGORITHM WITH 10199000 - FIRST WORD HAVING FOLLOWING FIELDS; 10200000 - DEFINE ALGKEY = [6:6]#, % FIELD FOR ALGORITHM IDENT 10201000 - ALGTIPE = [12:3]#, % FIELD FOR ALGORITHM TYPE 10202000 - ALGPD = [15:3]#, % FIELD FOR PARAMETER DESCRIPTION10203000 - NOWORDS = [4:1]#; % NUMBER OF WORDS IN THIS ENTRY 10204000 - DEFINE MAXQALG= 19#; % NUMBER OF ENTRIES IN QALGORYTHM 10205000 - ALPHA ARRAY OPS[0:768]; % OPERATOR MNEMONICS FOR BUGOUT 10206000 - DEFINE VALC= 63#,NAMC=127#,ADD =128#,SUBT=129#,MULT=130#,DIVD=131#,10207000 - IDIV=132#,RDIV=133#,NTIA=134#,NTGR=135#,LESS=136#,GREQ=137#,GRTR=138#,10208000 - LSEQ=139#,EQUL=140#,NEQL=141#,CHSN=142#,MULX=143#,LAND=144#,LOR =145#,10209000 - LNOT=146#,LEQV=147#,SAME=148#,VARI=149#,BSET=150#,DBST=151#,FLTR=152#,10210000 - DFTR=153#,ISOL=154#,DISO=155#,INSR=156#,DINS=157#,BRST=158#,DBRS=159#,10211000 - BRFL=160#,BRTR=161#,BRUN=162#,EXIT=163#,STBR=164#,NXLN=165#,INDX=166#,10212000 - RETN=167#,DBFL=168#,DBTR=169#,DBUN=170#,ENTR=171#,EVAL=172#,NXLV=173#,10213000 - MKST=174#,STFF=175#,ZERO=176#,ONE =177#,LT8 =178#,LT16=179#,PUSH=180#,10214000 - DLET=181#,EXCH=182#,DUPL=183#,STOD=184#,STON=185#,OVRD=186#,OVRN=187#,10215000 - LOAD=189#,LT48=190#,MPCW=191#,SCLF=192#,DSLF=193#,SCRT=194#,DSRT=195#,10216000 - SCRS=196#,DSRS=197#,SCRF=198#,DSRF=199#,SCRR=200#,DSRR=201#,ICVD=202#,10217000 - ICVU=203#,SNGT=204#,SNGL=205#,XTND=206#,IMKS=207#,TEED=208#,PACD=209#,10218000 - EXSD=210#,TWSD=211#,TWOD=212#,SISO=213#,SXSN=214#,ROFF=215#,TEEU=216#,10219000 - PACU=217#,EXSU=218#,TWSU=219#,TWOU=220#,EXPU=221#,RTFF=222#,HALT=223#,10220000 - TLSD=224#,TGED=225#,TGTD=226#,TLED=227#,TEQD=228#,TNED=229#,TUND=230#,10221000 - TLSU=232#,TGEU=233#,TGTU=234#,TLEU=235#,TEQU=236#,TNEU=237#,TUNU=238#,10222000 - CLSD=240#,CGEQ=241#,CGTD=242#,CLED=243#,CEQD=244#,CNED=245#,CLSU=248#,10223000 - CGEU=249#,CGTU=250#,CLEU=251#,CEQU=252#,CNEU=253#,NOOP=254#,NVLD=255#,10224000 - JOIN=322#,SPLT=323#,IDLE=324#,SINT=325#,EEXI=326#,DEXI=327#,SCNI=33O#,10225000 - SCNO=331#,WHOI=334#,HEYU=335#,NTGD=385#,OCRX=389#,LOG2=395#,IRWL=429#,10226000 - PCWL=430#,MVST=431#,STAG=436#,RTAG=437#,RSUP=438#,RSDN=439#,RPRR=440#,10227000 - SPRR=441#,RDLK=442#,CBON=443#,LODT=444#,LLLU=445#,SRCH=446#,USND=464#,10228000 - UABD=465#,TWFD=466#,TWTD=467#,SWFD=468#,SWTD=469#,TRNS=471#,USNU=472#,10229000 - UABU=473#,TWFU=474#,TWTU=475#,SWFU=476#,SWTU=477#,SLSD=496#,SGED=497#,10230000 - SGTD=498#,SLED=499#,SEQD=500#,SNED=501#,SLSU=504#,SGEU=505#,SGTU=506#,10231000 - SLEU=507#,SEQU=508#,SNEU=509#,MINS=720#,MFLT=721#,SFSC=722#,SRSC=723#,10232000 - RSTF=724#,ENDF=725#,MVNU=726#,MCHR=727#,INOP=728#,INSG=729#,SFDC=730#,10233000 - SRDC=731#,INSU=732#,INSC=733#,ENDE=734#; 10234000 - DEFINE UNKNOWNID = 0#, 10235000 - FORMALID = 1#, 10236000 - FIELDID = 2#, 10237000 - EVENTID = 3#, 10238000 - LAYOUTID = 4#, 10239000 - PROCID = 5#, 10240000 - LABELID = 6#, 10241000 - DEFINDID = 7#, 10242000 - BOOPROCID = 8#, 10243000 - DPPROCID = 9#, 10244000 - REALPROCID = 10#, 10245000 - INTPROCID = 11#, 10246000 - REFPROCID = 12#, 10247000 - WORDPROCID = 13#, 10248000 - PTRPROCID = 14#, 10249000 - BOOID = 15#, 10250000 - DPID = 16#, 10251000 - REALID = 17#, 10252000 - INTID = 18#, 10253000 - REFID = 19#, 10254000 - WORDID = 20#, 10255000 - PTRID = 21#, 10256000 - BOOARRAYID = 22#, 10257000 - DPARRAYID = 23#, 10258000 - REALARRAYID = 24#, 10259000 - INTARRAYID = 25#, 10260000 - REFARRAYID = 26#, 10261000 - WORDARRAYID = 27#, 10262000 - PCID = 28#, 10263000 - BOOROAID = 29#, 10264000 - DPROAID = 30#, 10265000 - REALROAID = 31#, 10266000 - INTROAID = 32#, 10267000 - EVENTARRAYID = 33#, 10268000 - QUEUEARRAYID = 34#, 10269000 - REGID = 35#, 10270000 - QUEUEID = 36#, 10271000 - NULLV = 37#, 10272000 - TRUTHV = 38#, 10273000 - NUMBER = 39#, 10274000 - STRNGCON = 40#, 10275000 - QALGID = 42#, 10277000 - INTERRUPTID = 43#, 10278000 - INTRINSICEVENT = 44#, 10279000 - WORDV = 45#, 10280000 - LOCKEDV = 46#, 10281000 - STRING = 47#, 10282000 - LFTPRN = 48#, 10283000 - CASEV = 49#, 10284000 - BEGINV = 50#, 10285000 - ONV = 51#, 10286000 - DOV = 52#, 10287000 - IFV = 53#, 10288000 - GOV = 54#, 10289000 - THRUV = 55#, 10290000 - FORV = 56#, 10291000 - WHILEV = 57#, 10292000 - SCANV = 58#, 10293000 - REPLACEV = 59#, 10294000 - FILLV = 60#, 10295000 - SWAPV = 61#, 10296000 - SEMICOLON = 62#, 10297000 - ENDV = 63#, 10298000 - UNTILV = 64#, 10299000 - ELSEV = 65#, 10300000 - DOLLAR = 66#, 10301000 - COMMENTV = 67#, 10302000 - ADDOP = 68#, 10303000 - TYPEV = 69#, 10304000 - FIELDV = 70#, 10305000 - ARRAYV = 71#, 10306000 - OWNV = 72#, 10307000 - DEFINEV = 73#, 10308000 - LABELV = 74#, 10309000 - PROCV = 75#, 10310000 - SAVEV = 76#, 10311000 - LAYV = 77#, 10312000 - EVENTV = 78#, 10313000 - QUEUEV = 79#, 10314000 - ENTERRUPT = 80#, 10315000 - PITCHER = 81#, 10316000 - MONITORV = 83#, 10318000 - VALUEV = 84#, 10319000 - INV = 85#, 10320000 - CROSSHATCH = 86#, 10321000 - ATSIGN = 87#, 10322000 - PERCENT = 88#, 10323000 - PERIODV = 89#, 10324000 - STEPV = 90#, 10325000 - TOV = 91#, 10326000 - BYV = 92#, 10327000 - OVERITE = 93#, 10328000 - WITHV = 94#, 10329000 - USING = 95#, 10330000 - TAGV = 96#, 10331000 - FACTOP = 97#, 10332000 - LFTBRKT = 98#, 10333000 - QUESTIONMK = 99#, 10334000 - COMMA = 100#, 10335000 - RTPARN = 101#, 10336000 - RTBRKT = 102#, 10337000 - COLON = 103#, 10338000 - THENV = 104#, 10339000 - EXTERNALV = 105#, 10340000 - FORWARDV = 106#, 10341000 - OFV = 107#, 10342000 - NOTOP = 108#, 10343000 - ASSNOP = 109#, 10344000 - AMPERSAND = 110#, 10345000 - LOGOP = 111#, 10346000 - RELOP = 112#, 10347000 - MULOP = 113#, 10348000 - DEFINEP = 114#; 10349000 -DEFINE DIGIT = 0#, 10350000 - LETTER = 1#, 10351000 - SPASE = 2#, 10352000 - BOOV = 0#, 10353000 - DPV = 1#, 10354000 - REALV = 2#, 10355000 - INTV = 3#, 10356000 - REFV = 4#, 10357000 - WDV = 5#, 10358000 - PTRV = 6#; 10359000 - DEFINE FS=0#, % CALLS ON VARIABLE: STATEMENT 11000000 - FP=1#, % PRIMARY 11001000 - FL=2#, % ACTUAL PARAPART 11002000 - FR=3#; % FOR STATEMENTRT 11003000 -DEFINE INCR = 7 #, 11003300 - INCRTWICE = 14 #; 11003600 -% TYPE FIELD VALUES 11004000 - DEFINE FORMALNAMEP = 2#, 11005000 - FORMALNAMEQ = 6#, 11006000 - FORMALVALUEP= 3#, 11007000 - FORMALVALUEQ= 7#, 11008000 - LOCALTYPE = 0#, 11009000 - WITHINBODY = 1#, 11010000 - F0RWARD = 4#, 11011000 - INTRINSIC = 5#; 11012000 - DEFINE IDMAX = QUEUEID #; 11013000 - DEFINE MINDEC = TYPEV#, MAXDEC = VALUEV#; 11014000 - INTEGER NEXTINFO, % POINTS TO NEXT HOLE IN INFO 11015000 - NINFOO, % POINTS TO START OF INFO ENTRIES FOR 11016000 - % CURRENT BLOCK. 11017000 - NEXTADDL, % POINTS TO NEXT SPOT IN ADDL. 11018000 - LASTADDL, 11018100 - RSVDX, %%%%%%%%%%%%%%%%%%%% KLUDGE%%%%%%%%%%%%%%% 11019000 - LASTINFO; % POINTS TO LAST ENTRY IN INFO. 11020000 - DEFINE GLOBAL=0#; % OUTERMOST ADDRESSING LEVEL. 11021000 - BOOLEAN GTB1; % TEMP FREE-FOR-ALL 11022000 - INTEGER LASTNOT; % USUALLY POINTS JUST BEYOND LAST LNOT 11023000 - % OR RELOP. USED BY EMITNOT TO 11024000 - % OPTIMISER A LITTLE. 11025000 - INTEGER LASTINDEX; % USUALLY POINTS AT TWE LAST SUBSCRIPTING 11026000 - % OPERATOR, SO THE ACTUALPARAPART CAN CALL 11027000 - % THINGS BY NAME. 11028000 - INTEGER BEGINCTR; 11029000 - DEFINE DTYPE = ETYPE#; 11030000 - DEFINE EVENTINTRINSICID = INTRINSICEVENT#, 11030300 - INTERRUPTV = ENTERRUPT#; 11030800 - INTEGER ADRCPL; % SCRATCH FOR EMITTERS. 11031000 - DEFINE ATYPE = REALV#, % TYPES OF EXPRESSIONS: S.P. ARITH-REAL 11032000 - BTYPE = BOOV#, % BOOLEAN 11033000 - ITYPE = INTV#, % INTEGER 11034000 - ETYPE = DPV#, % D.P. ARITH 11035000 - RTYPE = REFV#, % REFERENCE 11036000 - PTYPE = PTRV#, % POINTER 11037000 - WTYPE = WDV#, 11037500 - XTYPE = 0#; % ARRAY 11038000 - COMMENT NOTE THAT AN ARRAY EXPRESSION IS GIVEN BY A TYPE < XTYPE. 11039000 - THE VALUE OF TYPE IS -(NUMBER OF DIMENSIONS LEFT) - 11040000 - (TYPE OF ARRAY) |32768; 11041000 -DEFINE PROCD = 6# 11042000 - ; 11043000 - DEFINE ARAYTPE = [30:3]#, % TYPE FIELD FOR EXPRSS VALUE FOR ARRAYS 11044000 - ARAYDIM = [33:15]#; % NO OF DIMENSIONS ASSOCIATED WITH ARAYTYPE 11045000 - DEFINE EMITLINK = EMIT3#; 11046000 - DEFINE EMITO = EMIT#; 11047000 - DEFINE ENABLEKEY = 20# 11047100 - , DISABLEKEY= 21# 11047200 - , SETKEY = 10# 11047300 - , RESETKEY = 11# 11047400 - , CAUSEKEY = 0# 11047500 - , WAITKEY = 1# 11047600 - , FIXKEY = 14# 11047700 - , FREEKEY = 15# 11047800 - , HAPPENEDKEY= 30# 11047900 - , AVAILABLEKEY= 31# 11047950 - ,SECONDWORDKEY=40# 11047960 - , STOREITEMKEY= 50# 11047970 - ; 11047980 - DEFINE INSERTKEY =0# % KEY FOR INSERT ALGORITHM 11048000 - ,ALLOCATEKEY =3#; % KEY FOR ALLOCATE ALGORITHM 11049000 - DEFINE SIZEKEY =15# % KEY FOR SIZE ALGORITHM/PROPERTY 11049100 - ,LOCKKEY =16# % KEY FOR LOCKED ALGORITHM/PROPERTY 11049200 - ,BUSYKEY =17# % KEY FOR BUSY ALGORITHM/PROPERTY 11049300 - ,BUZZKEY =16# % KEY FOR BUZZ ALGORITHM 11049330 - ,BUZZCONTROLKEY=20# % 11049360 - ,UNLOCKKEY =21# % KEY FOR UNLOCK ALGORITHM/PROPERTY 11049400 - ; 11049450 - INTEGER LASTX, % L OF LAST EXECUTABLE CODE BEFORE THE 11050000 - % CURRENT NON-EXEC: -1 IF CURRENT IS 11051000 - % EXECUTABLE. 11052000 - FIRSTX, % L OF FIRST EXECUTABLE CODE IN THE SEGMEMT11053000 - % -1 IF NONE YET. 11054000 - 11055000 - FIRSTMT; % L OF FIRST STATEMENT OF CURRENT BLOCK. 11056000 - ARRAY PDPRT[0:15,0:255]; 11057000 - INTEGER PDINX; 11058000 - DEFINE PPINX=PDINX.[36:4],PDINX.[40:8]#; 11059000 - COMMENT PDPRT TS USED AT THE END OF COMPILATION TO BUILD THE LEVEL-ZERO11060000 - STACK FOR THE PROGRAM. PDINX IS THE INDEX OF THE NEXT SLOT 11061000 - IN PDPRT. ENTRIES IN PDPRT CONTAIN THE FOLLOWING FIELDS: 11062000 - [36:12] MOM ADDRESS. THE DISPLACEMENT RELATIVE TO D[0]. 11063000 - NOTICE THAT PDINX BEARS NO RELATIONSHIP TO THIS VALUE11064000 - (OR TO ANY OTHER, FOR THAT MATTER). 11065000 - [23:13] RELATIVE DISK ADDRESS OF THE RELEVENT SEGMENT, IF 11066000 - THERE IS ONE. THIS ADDRESS REFERS TO THE TEMPORARY 11067000 - CODE FILE, AND IS CONVERTED TO A CORE ADDRESS, FOR 11068000 - SAVE STUFF, OR A DISK ADDRESS. THIS FIELD IS 11069000 - APPLICABLE TO DATA AND SEGMENT-DESCRIPTOR ENTRIES. 11070000 - [24:12] SEGMENT DESCRIPTOR ADDRESS, APPLICABLE TO PCWS ONLY. 11071000 - [10:13] SIZE, FOR DATA AND SEGMENT DESCRIPTORS. 11072000 - [ 7:17] L, FOR PCW ENTRIES. 11073000 - [ 6: 1] NCSF FOR PCW (1 => CONTROL STATE). 11074000 - [ 4: 3] OPERAND-SIZE FIELD FOR DATA DESCRIPTOR. 11075000 - 1 = PCW OF EXTERNAL PROCEDURE 11075500 - [ 8: 1] PRESENCE BIT, FOR SEGMENT AND DATA DESCRIPTORS. 11076000 - IF ON, THE SEGMENT WILL BE LOADED AT H/L. 11077000 - [ 2: 3] TYPE OF ENTRY: 11078500 - 0 = DATA DESC. 11079000 - 1 = DATA DESC ALSO. 11079500 - 2 = DOUBLE-PRECISION VARIABLE. 11080000 - 3 = POINTER VARIABLE. 11081000 - 4 = SEGMENT DESC OF EXTERNAL PROCEDURE 11081500 - 6 = SEGMENT DESC. 11082000 - 7 = PROG CTL WORD. 11083000 - [ 7, 1] READ-ONLY BIT FOR DATA DESC. 11084000 - ; 11085000 - DEFINE PDPRTDISPF=[36:12]# 11085200 - ,PDPRTSIZEF=[10:13]# 11085400 - ; 11085600 - INTEGER TEMPADDR; COMMENT REL ADDR INTO TEMP CODE FILE; 11086000 -DEFINE ERROR(ERROR1) = BEGIN ERR(ERROR1); GO TO EXIT END#; 11086010 - LABEL ENDOFITALL; 11087000 - DEFINE USINGV= USING#; 11087500 - DEFINE LFTPARN=LFTPRN#; 11087550 - INTEGER SAVESIZE; % AMOUNT OF SAVE ARRAYS DECLARED 11088000 - DEFINE POOLMAX = 511#; 11100000 - ALPHA ARRAY POOL[0:7, 0:255]; 11101000 - INTEGER POOLMOM, POOLX; 11102000 - ALPHA ARRAY TA [0:POOLMAX]; 11103000 - INTEGER TAX; 11104000 - DEFINE DEL=DLET#; 11104300 - DEFINE BRSET=BRST#; 11104500 - DEFINE CONTROLBUZZKEY=BUZZCONTROLKEY#; 11104800 -DEFINE MAXTEMP = 39#; 11105000 - ARRAY TEMPSTACK[0:MAXTEMP]; 11106000 - BOOLEAN FIGS; COMMENT SHOULD BE TRUE IFF EMITTING FIXUP CODE; 11106100 - DEFINE EVNTV = 100# % ANALOGOUS TO REALV,ATYPE,BOOV, 11107000 - , EVTYPE = EVNTV # % BTYPE BUT USED IN MORE RESTRIC-11108000 - ; % TED WAY FOR EVENTS 11109000 -COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 20000000 - STREAM PROCEDURE DECLARATIONS 20001000 - * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;20002000 - INTEGER STREAM PROCEDURE EXAMINE(PTR); VALUE PTR; 20003000 - BEGIN SI~PTR; DI~LOC PTR; DI~DI-1; DS~CHR END; 20004000 - INTEGER STREAM PROCEDURE SKIPFORWARD(PTR,BY); VALUE PTR,BY; 20005000 - BEGIN SI~PTR; SI~SI+BY; SKIPFORWARD~SI END; 20006000 - INTEGER STREAM PROCEDURE MKABS(X); 20007000 - BEGIN SI~X; MKABS~SI END; 20008000 - INTEGER STREAM PROCEDURE MOVECHRS(N,F,T); VALUE N,F,T; 20009000 - BEGIN SI~F; DI~T; DS~N CHR ; MOVECHRS~DI END MOVECHRS; 20010000 - BOOLEAN STREAM PROCEDURE EQUAL(A,B); VALUE A,B; 20011000 - BEGIN SI~A; DI~B; IF 8 SC=DC THEN TALLY~1; EQUAL~TALLY END; 20012000 - BOOLEAN STREAM PROCEDURE GREATER(A,B); VALUE A,B; 20013000 - BEGIN SI~A; DI~B; IF 8 SC>DC THEN TALLY~1; GREATER~TALLY END; 20014000 - STREAM PROCEDURE MOVEIT(F,T); VALUE T; 20015000 - BEGIN SI~F; DI~T; DS~WDS END MOVEIT; 20016000 - STREAM PROCEDURE SEQERR(S,B); VALUE S; 20017000 - BEGIN DI~B; DS~12 LIT" SEQERR"; SI~S; DS~8 CHR END SEQERR; 20018000 - STREAM PROCEDURE BLANKOUT(N,D); VALUE N; 20019000 - BEGIN DI~D; DS~8 LIT " "; SI~D; DS~N WDS END BLANKOUT; 20020000 - STREAM PROCEDURE CONVERTOUT(N,D); VALUE N,D; 20021000 - BEGIN DI~D; SI~LOC N; DS~8 DEC END CONVERTOUT; 20022000 - STREAM PROCEDURE EDITLINE(FCR,LST,V,SEG,C,L,BUF); 20023000 - VALUE FCR,LST,V,SEG,C,L ; 20024000 - BEGIN LABEL B, C, T, P, L; 20025000 - DI~BUF; DS~16 LIT" "; SI~FCR; DS~9 WDS; DS~8 LIT" "; BUF~DI; 20026000 - DS~WDS; DS~6 LIT" "; 20027000 - V(DI~DI-6; SI~LOC SEG; DS~3 DEC; DS~LIT":"; DS~4 DEC; 20028000 - DS~LIT":"; DS~DEC); 20029000 - DI~BUF; DI~DI-2; CI~CI+LST; GO B; GO B; GO C; GO P; GO T; 20030000 - GO T; GO L; 20030100 - T:DS~LIT"T"; GO B; 20031000 - C:DS~LIT"C"; GO B; 20032000 - P:DS~LIT"P"; GO B; 20033000 - L:DS~LIT"L"; 20033100 - B: 20034000 - END EDITLINE; 20035000 - STREAM PROCEDURE ZOT(C,AT); VALUE C, AT; 20036000 - BEGIN SI~LOC AT; SI~SI-1; DI~AT; DS~CHR; END ZOT; 20037000 - STREAM PROCEDURE MOVECHARACTERS(N,F,FS,T,TS); VALUE N,FS,TS; 20038000 - BEGIN SI~F; SI~SI+FS; DI~T; DI~DI+TS; DS~N CHR END; 20039000 - STREAM PROCEDURE MOVECHARACTERACCUM(N,F,FS,T,TS); VALUE N,FS,TS; 20040000 - BEGIN SI ~ F; SI ~ SI+FS; SI~SI+4; DI~T; DI~DI+TS; DS ~ N CHR END; 20041000 - BOOLEAN STREAM PROCEDURE OCTALCONVERT(A,C,S,T); VALUE A,C,S; 20042000 - BEGIN SI~A; DI~T; 3(DS~S RESET); 20043000 - C(IF SC<"0" THEN TALLY~1 ELSE IF SC>"7" THEN TALLY~1; 20044000 - SKIP 3 SB; 20045000 - 3(IF SB THEN DS~SET ELSE DS~RESET; SKIP SB)); 20046000 - OCTALCONVERT~TALLY 20047000 - END OCTALCONVERT; 20048000 - INTEGER STREAM PROCEDURE INPUTCONVERT(A,S,C); VALUE S,C; 20049000 - BEGIN SI~A; SI~SI+S; DI~LOC INPUTCONVERT; DS~C OCT END ICV; 20050000 - INTEGER STREAM PROCEDURE SEQCONVERT(LCR); VALUE LCR; 20050100 - BEGIN SI ~ LCR; DI ~ LOC SEQCONVERT; DS ~ 8 OCT; END SEQ CONVERT; 20050200 - BOOLEAN STREAM PROCEDURE CMPCHRNEQL(N,A,B); VALUE N; 20051000 - BEGIN SI~A; DI~B; IF N SC!DC THEN TALLY~1; CMPCHRNEQL~TALLY END; 20052000 - STREAM PROCEDURE MOVE(N,F,T); VALUE N; 20053000 - BEGIN LOCAL M; SI~LOC N; SI~SI+4; SI~SC; M~SI; 20054000 - SI~F; DI~T; DS~N WDS; M(DS~32 WDS; DS~32 WDS) 20055000 - END SUPER MOVE; 20056000 - STREAM PROCEDURE MOVE8BITS(FROM,SK,T0); VALUE SK; 20057000 - BEGIN SI ~ FROM; SK(SKIP 8 SB); DI ~ T0; DI ~ DI + 6; SKIP 4 DB; 20058000 - 8(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB); 20059000 - END MOVE 8 BITS; 20060000 - BOOLEAN STREAM PROCEDURE CMPCHREQL(N,A,B); VALUE N; 20061000 - BEGIN SI~A; DI~B; IF N SC=DC THEN TALLY~1; CMPCHREQL~TALLY END; 20062000 - STREAM PROCEDURE INSERT(N,STUFF,AT,PLUS); VALUE N,STUFF,PLUS; 20063000 - BEGIN SI ~ LOC AT; SI ~ SI - N; DI ~ AT; DI ~ DI + PLUS; DS~N CHR 20064000 - END INSERT; 20065000 - STREAM PROCEDURE ZN9N(OC,N,ZS,AT,PLUS); VALUE OC,N,ZS,PLUS; 20066000 - BEGIN SI~LOC OC; DI~AT; DI~DI+PLUS; AT~DI; 20067000 - DS~N DEC; DI~AT; DS~ZS FILL 20068000 - END ZN9N; 20069000 - REAL STREAM PROCEDURE REEL(P,N); VALUE P,N; 20070000 - BEGIN DI ~ LOC P; DI ~ DI - N; SI ~ P; DS ~ N CHR END; 20071000 - STREAM PROCEDURE FLOG(F,V,T); VALUE F,V; 20072000 - BEGIN DI ~ LOC V; DS ~ F SET; DI ~ T; SI ~ LOC V; DS ~ WDS END; 20073000 - STREAM PROCEDURE MOVEBITS(FROM,NR,SSK,T,DSK); VALUE NR,SSK, DSK; 20074000 - BEGIN SI ~ FROM; SKIP SSK SB; 20075000 - DI ~ T; SKIP DSK DB; NR(IF SB THEN DS ~ SET ELSE DS ~ RESET; 20076000 - SKIP SB) 20077000 - END BIT MOVER; 20078000 -BOOLEAN STREAM PROCEDURE FLAGBIT(A); 20079000 -BEGIN 20080000 - SI ~ A; 20081000 - IF SB THEN 20082000 - BEGIN TALLY ~ 1; DI ~ A; DS ~ RESET END; 20083000 - FLAGBIT ~ TALLY; 20084000 -END FLAGBIT; 20085000 - BOOLEAN STREAM PROCEDURE BIT(N)" OF "(WORD); VALUE N,WORD; 20086000 - BEGIN SI ~ LOC WORD; SKIP N SB; IF SB THEN TALLY ~ 1; BIT ~ TALLY; 20087000 - END BIT RETREIVER; 20088000 - STREAM PROCEDURE LABELINE(A,N,L); VALUE N; 20100000 - BEGIN SI ~ A; DI ~ L; SI ~ SI + 4; DS ~ N CHR; 20101000 - DS ~ 21LIT " SEEMS TO BE A LABEL." 20102000 - END LABELINE; 20103000 - PROCEDURE DUMPIT(A); ARRAY A[0]; 24000000 -; 24001000 -SAVE ARRAY SCRATCH [0:14]; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24002000 -PROCEDURE DONBUG (W, LI, LA); VALUE W, LI, LA; INTEGER LI,LA; ALPHA W; 24003000 - BEGIN 24004000 - OWN BOOLEAN BEFORE; 24005000 - FORMAT FLI (A6, " INFO ", 7I6), FLA (A6," ADDL ", 7I6); 24006000 - LIST LLI(W, LI, GT1.MONF, GT1.[9:6], GT1.[15:6], GT1.CLASS, 24007000 - GT1.TYPE, GT1.LINK), 24008000 - LLA(W, LA, GT1.LAYINIT, GT1.LAYCODE, GT1.LAYLTA, 24009000 - GT1.LAYLNA, GT1.LAYLTB, GT1.LAYLNB); 24010000 - IF DONSBUG AND NOT BEFORE 24011000 - THEN BEGIN 24012000 - FORMAT F ("INFO FIELDS ARE: INDEX, MONF, 9:6, 15:6,",24013000 - " CLASS, TYPE, LINK",/, 24014000 - "ADDL FIELDS ARE: INDEX, LAYINIT, LAYCODE, ", 24015000 - "LAYLTA, LAYLNA, LAYLTB, LAYLNB",/); 24016000 - BEFORE ~ TRUE; 24017000 - WRITE (LINE[DBL], F); 24018000 - END; 24019000 - IF DONSBUG 24020000 - THEN IF LI > 0 24021000 - THEN BEGIN 24022000 - GT1 ~ INFO [LI.LINKR, LI.LINKC]; 24023000 - WRITE (LINE[DBL], FLI, LLI); 24024000 - END 24025000 - ELSE IF LI < 0 AND LA ! 0 24026000 - THEN BEGIN 24027000 - BLANKOUT (14, SCRATCH); 24028000 - MOVE (ENTIER(ABS(LI) DIV 8 + 1), 24029000 - ADDL [LA.LINKR, LA.LINKC], SCRATCH); 24030000 - WRITE (LINE[DBL], 15, SCRATCH[*]); 24031000 - END 24032000 - ELSE IF LI = 0 24033000 - THEN BEGIN 24034000 - GT1 ~ ADDL[LA.LINKR, LA.LINKC]; 24035000 - WRITE (LINE[DBL], FLA, LLA); 24036000 - END; 24037000 - END DONBUG; 24038000 -COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 25000000 - FORWARD PROCEDURE DECLARATIONS 25001000 - * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;25002000 - INTEGER PROCEDURE SCAN; FORWARD; %0400400025003000 - INTEGER PROCEDURE READACARD; FORWARD; %0405700025004000 - PROCEDURE DATIME; FORWARD; %0412500025005000 - PROCEDURE GNC; FORWARD; %0414500025006000 - PROCEDURE CONVERTINTO(H,L); 25007000 - REAL H,L ; FORWARD; %0415000025008000 - PROCEDURE FLAG(N); VALUE N; INTEGER N; FORWARD; %0600500025009000 - PROCEDURE DOLLARCARD; FORWARD; 25010000 - PROCEDURE DEBLANK; FORWARD; %0434200025011000 - INTEGER PROCEDURE GETSPACE(L); VALUE L; INTEGER L;FORWARD; %0605100025012000 - PROCEDURE STEPIT; FORWARD; % 25013000 - INTEGER PROCEDURE STEPI; FORWARD; % 25014000 - PROCEDURE EMIT(OP); VALUE OP; INTEGER OP; FORWARD; % 25015000 - PROCEDURE EMITB(B,F,T); 25016000 - VALUE B,F,T; INTEGER B,F,T; FORWARD; % 25017000 - PROCEDURE EMITV(A); VALUE A; INTEGER A; FORWARD; 25018000 - PROCEDURE EMITN(A); VALUE A; INTEGER A; FORWARD; 25019000 - PROCEDURE EMITNUMBER(N,F); VALUE N,F; REAL N,F; FORWARD; 25020000 -DEFINE EMITNUM(EMITNUM1) = EMITNUMBER(EMITNUM1,0)#; 25020100 - PROCEDURE EMITD(A,B,N); VALUE A,B,N; 25021000 - INTEGER A,B,N; FORWARD; 25022000 - DEFINE EMITI(EMITI1,EMITI2)=EMIT2P(ISOL,EMITI1,EMITI2) #, 25023000 - EMITR(EMITR1,EMITR2)=EMIT2P(INSR,EMITR1,EMITR2) #; 25024000 - 25025000 - 25026000 - PROCEDURE ERR(N); VALUE N; INTEGER N; FORWARD; 25027000 - PROCEDURE EMITDP(H,L); VALUE H,L; 25028000 - REAL H,L; FORWARD; 25029000 - PROCEDURE EMITPAIR(A,O); VALUE A,O; 25030000 - INTEGER A,O; FORWARD; 25031000 - PROCEDURE EMITNOT; FORWARD; 25032000 - REAL PROCEDURE TAKE(N); VALUE N; INTEGER N; FORWARD; 25033000 - PROCEDURE PUT(N,X); VALUE N,X; 25034000 - INTEGER N,X; FORWARD; 25035000 - BOOLEAN PROCEDURE IFCLAUSE; FORWARD; 25036000 - INTEGER PROCEDURE CASEHEAD; FORWARD; 25037000 - PROCEDURE CASETAIL(M,B,P); VALUE M,B,P; 25038000 - INTEGER M,B,P; FORWARD; 25039000 - INTEGER PROCEDURE EXPRSS; FORWARD; 25040000 - INTEGER PROCEDURE IFEXP; FORWARD; 25041000 - PROCEDURE EXPRESSION(T); VALUE T; 25042000 - INTEGER T; FORWARD; 25043000 - INTEGER PROCEDURE CASEXP; FORWARD; 25044000 - PROCEDURE EMIT3(S); VALUE S; 25045000 - INTEGER S; FORWARD; 25046000 - INTEGER PROCEDURE GET3(L); VALUE L; INTEGER L; FORWARD; 25047000 - PROCEDURE BEXP; FORWARD; 25048000 - INTEGER PROCEDURE AEXP; FORWARD; 25049000 - PROCEDURE RELATION(T); VALUE T; INTEGER T;FORWARD; 25050000 - INTEGER PROCEDURE BOOSEC; FORWARD; 25051000 - PROCEDURE BOOCOMP; FORWARD; 25052000 - REAL PROCEDURE REXP(BOO); VALUE BOO; BOOLEAN BOO; FORWARD; 25053000 - REAL PROCEDURE PEXP(BOO); VALUE BOO; BOOLEAN BOO; FORWARD; 25054000 - PROCEDURE STATEMENT; FORWARD; 25055000 -DEFINE PUTNBUMP(PUTNBUMP1)=BEGIN PUTADDL(PUTNBUMP1,NEXTADDL); 25056000 - IF DUMPTOG THEN PADDLYOUROWN (NEXTADDL)END#; 25056001 -PROCEDURE PADDLYOUROWN(GNU); VALUE GNU; INTEGER GNU; 25056010 -BEGIN FORMAT F("NEXTADDL THINKS IT EQUALS "I9" AND IT REALLY IS "I9); 25056020 - WRITE(LINE,F,GNU,NEXTADDL) END; 25056030 - PROCEDURE COMPOUNDTAIL; FORWARD; 25057000 - PROCEDURE JUMPCHKX; FORWARD; 25058000 - PROCEDURE JUMPCHKNX; FORWARD; 25059000 - PROCEDURE IDLIST(A,B,C,D,E); VALUE A,B,C,D,E; 25060000 - BOOLEAN E; INTEGER B,C,D; REAL A; FORWARD; 25061000 - BOOLEAN PROCEDURE ENTER(A,B,C,D); VALUE A,B,C,D; 25062000 - BOOLEAN D; INTEGER A,B,C; FORWARD; 25063000 - PROCEDURE READONLYARRAYDEC(B,A); 25064000 - VALUE B,A; 25065000 - BOOLEAN B; INTEGER A; FORWARD; 25066000 - PROCEDURE MERRIMAC; FORWARD; 25067000 - PROCEDURE PICTUREDEC(S); VALUE S; 25068000 - BOOLEAN S; FORWARD; 25068100 - INTEGER PROCEDURE TEXT (FROM, FINAL); VALUE FROM, FINAL; 25069000 - INTEGER FROM, FINAL;FORWARD; 25070000 - PROCEDURE LAYOUTDEC; FORWARD; 25071000 - PROCEDURE DEFINEDEC; FORWARD; 25072000 - PROCEDURE FIELDEC; FORWARD; 25073000 - PROCEDURE PROCEDUREDEC(S,T); VALUE S,T; 25074000 - BOOLEAN S; INTEGER T; FORWARD; 25075000 - PROCEDURE ARRAYDEC(S,O,T); VALUE S,O,T; 25076000 - BOOLEAN S,O; INTEGER T; FORWARD; 25077000 - DEFINE EVENTDEC(EVENTDEC1)=IDLIST(EVENTDEC1,LOCALTYPE,EVENTID, 25078000 - EVNTV,TRUE)#; 25078100 - PROCEDURE QUEUEDEC(L); VALUE L; INTEGER L;FORWARD; 25079000 - REAL PROCEDURE PROCALL(F,C); VALUE F,C; BOOLEAN F; REAL C; 25080000 - FORWARD; 25080100 - PROCEDURE LABELR; FORWARD; 25081000 - REAL PROCEDURE VARIABLE(F); VALUE F; INTEGER F; FORWARD; 25082000 - PROCEDURE QSTMT; FORWARD; 25083000 - PROCEDURE LONGSTRING; FORWARD; 25083100 - PROCEDURE STRINGSOURCE; FORWARD; 25083200 - PROCEDURE BLOCK; FORWARD; 25084000 - PROCEDURE IFSTMT; FORWARD; 25085000 - PROCEDURE GOSTMT; FORWARD; 25086000 - PROCEDURE FORSTMT; FORWARD; 25087000 - PROCEDURE HOOK(X); VALUE X; INTEGER X; FORWARD; 25089000 - PROCEDURE UNHOOK; FORWARD; 25090000 - REAL PROCEDURE GIT(X); VALUE X; INTEGER X; FORWARD; 25091000 - INTEGER PROCEDURE FACTOR(T); VALUE T; INTEGER T; FORWARD; 25091900 - INTEGER PROCEDURE TERM(T); VALUE T; INTEGER T; FORWARD; 25092000 - INTEGER PROCEDURE SIMPARITH(T); VALUE T; INTEGER T; 25093000 - FORWARD; 25094000 - INTEGER PROCEDURE PRIMARY; FORWARD; 25095000 - INTEGER PROCEDURE SUBSCRIBER(W,N); VALUE W,N; 25096000 - INTEGER W,N; FORWARD; 25097000 - PROCEDURE DOTTER (T); VALUE T; REAL T; FORWARD; 25098000 - INTEGER PROCEDURE DOTIT; FORWARD; 25099000 - PROCEDURE LAYITOUT(T); VALUE T; INTEGER T;FORWARD; 25100000 - PROCEDURE ACTUALPARAPART(FBIT,INDEX,AD,FROM);VALUE FBIT,INDEX,AD,FROM; 25101000 - BOOLEAN FBIT,FROM; INTEGER INDEX; REAL AD; FORWARD; 25102000 - INTEGER PROCEDURE INSERTPCW; FORWARD; 25103000 - PROCEDURE EMITPCW(LEVEL,AD,STATE,SEG ); 25104000 - VALUE LEVEL,AD,STATE,SEG; 25105000 - INTEGER LEVEL,AD,STATE,SEG; FORWARD; 25106000 - INTEGER PROCEDURE BOOPRIM; FORWARD; 25107000 - REAL PROCEDURE PTRPRIM(BOO); VALUE BOO; BOOLEAN BOO; FORWARD; 25108000 - PROCEDURE PTRCOMP; FORWARD; 25109000 - PROCEDURE ENTRYEXPR; FORWARD; 25110000 - PROCEDURE SEGMENT(A, B, C); VALUE A, B; INTEGER A, B; 25111000 - ARRAY C[0, 0]; FORWARD; 25112000 - PROCEDURE WRITEFILE(F,A,X0,X1); VALUE X0,X1; REAL X0,X1; 25112300 - FILE F; ARRAY A[0,0]; FORWARD; 25112600 - INTEGER PROCEDURE NEWSEG(X); VALUE X; INTEGER X; FORWARD; 25113000 - PROCEDURE PURGE(T); VALUE T; INTEGER T; FORWARD; 25114000 - PROCEDURE DECLARATIONS; FORWARD; 25115000 - PROCEDURE GLOBALPCW(A,S,L,C); VALUE A,S,L,C; 25116000 - INTEGER A,S,L,C; FORWARD; 25117000 - PROCEDURE INITIALIZEARRAY(A); VALUE A; 25118000 - INTEGER A; FORWARD; 25119000 - PROCEDURE PLACE(W,X);VALUE W,X; REAL W,X; FORWARD; 25120000 - INTEGER PROCEDURE FORMALPARAPART(Q); VALUE Q; 25121000 - BOOLEAN Q; FORWARD; 25122000 - PROCEDURE SEGDICT(S,A,L,P);VALUE S,A,L,P; 25123000 - INTEGER S,A,L,P; FORWARD; 25124000 - PROCEDURE QALGORITHM(PARINFO,ADDLADRES,FROM); VALUE PARINFO,ADDLADRES, 25125000 - FROM; INTEGER PARINFO,ADDLADRES; BOOLEAN FROM; FORWARD; 25126000 - 25127000 - PROCEDURE PUTADDL(ENTRY,LINK); VALUE ENTRY; INTEGER LINK;REAL ENTRY; 25128000 - FORWARD; 25129000 - PROCEDURE DIDDLENTER(K); VALUE K; REAL K; FORWARD; 25130000 - PROCEDURE DSTROYNVISIBLE(LASTITEM); VALUE LASTITEM; INTEGER LASTITEM; 25131000 - FORWARD; 25132000 - INTEGER PROCEDURE EMITSPACE(LEVEL);VALUE LEVEL;INTEGER LEVEL; 25133000 - FORWARD; 25134000 - 25135000 - INTEGER PROCEDURE STANDSEARCH; FORWARD; 25136000 - BOOLEAN PROCEDURE ASSOCIATE (SPEC); VALUE SPEC; 25137000 - INTEGER SPEC; FORWARD; 25138000 - PROCEDURE ITEMREFERENCE(F); VALUE F; INTEGER F; FORWARD; 25139000 - INTEGER PROCEDURE QARRAYBOUND(LEVEL,BADTOG);VALUE LEVEL,BADTOG; 25140000 - INTEGER LEVEL; BOOLEAN BADTOG; FORWARD; 25141000 - PROCEDURE EMIT1P(OP,A); VALUE OP,A; 25141100 - INTEGER OP,A; FORWARD; 25141200 - PROCEDURE EMIT2P(OP,A,B); VALUE OP,A,B; 25142000 - INTEGER OP,A,B; FORWARD; 25143000 - PROCEDURE EMIT3P(OP,A,B,C); VALUE OP,A,B,C; 25144000 - INTEGER OP,A,B,C; FORWARD; 25145000 - PROCEDURE EMIT4P(OP,A,B,C,D); 25146000 - VALUE OP,A,B,C,D ; 25147000 - INTEGER OP,A,B,C,D ; FORWARD; 25148000 - INTEGER PROCEDURE GETSTACK; FORWARD; 25149000 - PROCEDURE RTNSTACK(ADR); VALUE ADR; REAL ADR; FORWARD; 25150000 - INTEGER PROCEDURE PICTUREGEN(A,B,C); VALUE A,B,C; 25151000 - BOOLEAN A,B; INTEGER C; FORWARD; 25152000 - PROCEDURE EMITMICRO(A); VALUE A; ALPHA A; FORWARD; 25153000 - ALPHA PROCEDURE HEXOUT(A); VALUE A; ALPHA A; FORWARD; 25154000 - PROCEDURE PRINTSPACE(X,L,D); VALUE X,L,D; 25155000 - ALPHA X,L,D; FORWARD; 25156000 - BOOLEAN PROCEDURE GOBBLE(B); VALUE B; BOOLEAN B; FORWARD; 25160000 - PROCEDURE INTERRUPTDEC; FORWARD; 25161000 - BOOLEAN PROCEDURE ITEMONLY(VBIT,SCLASS);VALUE VBIT,SCLASS; 25162000 - BOOLEAN VBIT;INTEGER SCLASS; FORWARD; 25163000 - PROCEDURE EVENTINTRINSIC; FORWARD; 25164000 - PROCEDURE EMITBUZEVENT; FORWARD; 25165000 - INTEGER PROCEDURE EMITDESC(LEVEL);VALUE LEVEL;INTEGER LEVEL; 25166000 - FORWARD; 25167000 -PROCEDURE MAKEARRAYROW; FORWARD; 25168000 -COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30000000 - THE SCANNER 30001000 - * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;30002000 -COMMENT THE NEXT SECTION CONTAINS THE SCANNER. IT IS COMPOSED OF THREE30003000 - MAIN PROCEDURES: TABLE, SCAN, AND READACARD. ITS PURPOSE IS TO, 30004000 - EACH TIME IT IS CALLED, GET THE NEXT LOGICAL ENTITY OF THE SOURCE 30005000 - PROGRAM, AND PRESENT IT TO THE CALLER. THE SOURCE PROGRAM COMES IN 30006000 - CHUNKS: USUALLY THE CHUNK IS A CARD-IMAGE FROM EITHER THE CARD OR 30007000 - THE TAPE FILE. HOWEVER, SOME CHUNKS ARE TEXTS FROM A DEEINE: THESE 30008000 - COME, A WORD AT A TIME, FROM ADDL. READACARD IS IN CHARGE OF 30009000 - FINDING THE NEXT CHUNK: IN FACT, VIRTUALLY ALL THE SOURCE-LANGUAGE 30010000 - MANAGEMFNT IS HANDLED BY READACARD, INCLUDING NORMAL LISTING, 30011000 - VOIDING, SEQUEWCE DIDDLING, ETC., UNDER CONTROL OF SCAN AND TABLE. 30012000 - SCAN IS RESPONSIBLE FOR GETTING AN ITEM FROM THE SOURCE AS 30013000 - PRESENTED BY READACARD: AN ITEM MAY BE 1) A SPECIAL CHARACTER, 2) A 30014000 - NUMBER, OR 3) AN IDENTIFIER. HOWEVER, SCAN-S LIFE IS COMPLICATED BY30015000 - THE POSSIBILITY THAT A NUMBER OR IDENTIFIER MAY BE SPLIT ACROSS 30016000 - CHUNKS OF SOURCE. IN ANY CASE, THE ITEM IS PLACED INTO ACCUM, IN 30017000 - BASICALLY THE SAME FORM AS AN INFO ENTRY (SEE BELOW), AND GIVEN TO 30018000 - TABLE FOR FURTHER PROCESSING. 30019000 - TABLE IS THE ONE THAT DOES THE DIRTY WORK OF TRANSLATING THE 30020000 - SOURCE-LANGUAGE ITEMS INTO A USABLE INTERNAL FORM, AND HANDLING THE 30021000 - FUNNY CASES. THE NAME "TABLE" IS DERIVED FROM ITS FUNCTION IN THE 30022000 - COMPILER: IT PRODUCES A NUMBER (CALLED THE CLASS) OF AN ITEM, 30023000 - MAINLY BY LOOKING IT UP SOMEWHERE. FOR THE BENEFIT OF THE COMPILER 30024000 - PROPER, IT MAINTAINS A TABLE, CALLED "ELBAT", CONTAINING THE 30025000 - INTERNAL REPRESENTATIONS OF THE SOURCE ITEMS. FOR OBVIOUS REASONS, 30026000 - THEN, THE INTERNAL REPRESENTATION OF AN ITEM IS CALLED ITS ELBAT- 30027000 - WORD. TABLE TRIES TO GUARANTEE THAT AT LEAST THE TEN MOST-RECENTLY-30028000 - SCANNED ITEMS ARE REPRESENTED. 30029000 - THE ELBAT WORD CONTAINS THE FOLLOWING FIELDS: 30030000 - ADDRESS : THE ADDRESS FIELD, FOR THINGS THAT HAVE ADDRESSES, 30031000 - IS JUST THAT. IT CONTAINS TWO SUBFIELDS, ADDRESSING 30032000 - LEVEL AND DISPLACEMENT. FOR OTHER THINGS, LIKE 30033000 - OPERATORS, IT CONTAINS OTHER VALUES: 30034000 - A.FOR ARITHMETIC, LOGICAL, AND RELATIONAL OPERATORS, 30035000 - THE OPERATOR CODE. 30036000 - B.FOR "TRUE" AND "FALSE", ONE AND ZERO. 30037000 - C.FOR INTRINSICS (WHERE POSSIBLE), THE OPERATOR. 30038000 - THESE OPERATORS USE ONLY THE DISP PART. 30038100 - TYPE : USED TO DISCRIMINATE AMONG LOCAL, OWN, FORMAL, ETC. 30039000 - RSVD : EQUALS ONE FOR RESERVED WORDS. 30040000 - F1 : HAS NO STANDARD MEANING 30041000 - CLASS: THE MAJOR CLASSIFICATION OF THE QUANTITY. THIS IS 30042000 - THE PRIMARY VALUE USED BY THE COMPILER TO ANALYZE THE30043000 - SYNTAX OF THE PROGRAM. 30044000 - LINK : FOR IDENTIFIERS, THE INFO INDEX OF ITS ENTRY. 30045000 - ELBAT WORDS COME FROM DIFFERENT PLACES, DEPENDING ON THE KIND 30046000 - OF ITEM. FOR NUMBERS, THEY ARE BUILT BY TABLE. FOR SPECIAL 30047000 - CHARACTERS, THEY COME FROM AN ARRAY CALLED "SPECIAL"* WHICH IS 30048000 - INDEXED BY THE CHARACTER ITSELF. NOTE THAT THIS WORD IS GOTTEN FROM30049000 - SPECIAL BY SCAN, AND IS LEFT IN SPEC: ALSO NOTE THAT SOME SPECIAL 30050000 - CHARACTERS--LIKE ., :, $--REQUIRE SPECIAL CONSIDERATION. FOR THESE 30051000 - CASES, THE LINK FIELD HAS A NON-ZERO VALUE. 30052000 - FOR IDENTIFIERS, THE ELBAT WORD COMES DIRECTLY FROM THE FIRST 30053000 - WORD OF THE INFO ENTRY: HOWEVER, THE LINK FIELD IS CHANGED IN THE 30054000 - PROCESS. A BASIC INFO ENTRY CONTAINS, ALSO, THE IDENTIFIER 30055000 - ; 30056000 - COMMENT SCAN GETS THE NEXT ENTITY FROM THE SOURCE STRING AND PLACES IT 31000000 - INTO ACCUM, REPORTING ON WHAT IT FOUND BOTH THROUGH ITS 31001000 - VALUE AND RESULT; 31002000 - INTEGER PROCEDURE SCAN; 31003000 - BEGIN 31004000 - LABEL AROUND; 31005000 - LABEL BACK; 31005100 - COUNT ~ ACCUM[1] ~ 0; RCOUNT ~ 63; 31006000 - ACCUMINX ~ ACCUMSTART; % POINTS TO START OF ACCUM 31007000 - DEBLANK; 31008000 - COMMENT CHR NOW CONTAINS THE FIRST CHARACTER OF THE ENTITY31009000 - WE ARE SEEKING, AND NCR HAS ITS ADDRESS. WE NOW 31010000 - LOOK TO SEE WHAT WE HAVE; 31011000 - IF SCAN~RESULT~(SPEC~SPECIAL[CHR]).CLASSRESULT; 31021000 - IF COUNT>RCOUNT THEN COMMENT TOO BIG--; 31022000 - BEGIN FLAG(300); COUNT~RCOUNT END; 31023000 - COMMENT WE HAVE FOUND THE END OF SOMETHING: EITHER 31024000 - THE ID/NR OR THE CARD. WE SAVE WHAT WE FOUND31025000 - AND THEN DECIDE WHAT TO DO WITH IT; 31026000 - ACCUMINX ~ MOVECHRS(COUNT, FCR,ACCUMINX); 31027000 - COMMENT NOW SEE WHETHER WE HIT END OF CARD; 31028000 - IF NCR=LCR THEN 31029000 - BEGIN 31030000 - COMMENT END OF CARD. WE READ ANOTHER AND SEE IF THIS 31031000 - ID/NR IS CONTINUED; 31032000 -BACK: 31032100 - NCR~( FCR~READACARD)+BUMPWORD; 31033000 - RCOUNT~RCOUNT-COUNT; 31034000 - COUNT ~ -1; 31035000 - GO AROUND 31036000 - END ELSE IF CHR = "%" THEN GO BACK; 31037000 - ACCUM[1].CHRCNT~COUNT~ COUNT + 63 - RCOUNT; 31038000 - END BUILDING IDS AND NRS ELSE 31039000 - BEGIN 31040000 - COMMENT A SPECIAL CHARACTER, SO WE PUT IT INTO ACCUM; 31041000 - ACCUM[1].[23:7]~CHR+64; 31042000 - BUMPNCR; 31043000 - ACCUM[0]~SPEC 31044000 - END SPECIAL CHARACTERS 31045000 - END SCAN; 31046000 - COMMENT READACARD FINDS THE NEXT HUNK OF SOURCE LANGUAGE TO BE SCANNED,31047000 - RETURNING ITS ADDRESS. IT READS CARDS, MERGING WITH TAPE 31048000 - IF NECESSARY, HANDLES VOID, LIST, NEW TAPE, RESEQUENCING, 31049000 - AND SEQUENCE CHECKING. IT ALSO DIGS OUT DEFINE-STUFF AND 31050000 - PUTS WHERE THEY CAN BE SEEN; 31051000 - INTEGER PROCEDURE READACARD; 31052000 - BEGIN 31053000 - LABEL EOFC,EOFT,BACK,C,T,EXIT; 31054000 - LABEL LISTEM; 31054100 - IF DONE THEN 31055000 - BEGIN READACARD~ (LCR~CLCR-8) -1; 31056000 - GO TO EXIT 31057000 - END; 31058000 - IF LASTUSED { 5 THEN GO BACK; 31059000 - COMMENT MUST BE RESCANNING A DEFINE--MOVE IT FROM ADDL TO 31060000 - WHEREVER THE LAST WORD WAS; 31061000 - MOVEIT(ADDL[(LASTUSED~LASTUSED+1).LINKR,LASTUSED.LINKC], 31062000 - READACARD~LCR-1); 31063000 - GO TO EXIT; 31064000 - COMMENT NOW THE END-OF-FILE ROUTINES FOR CARD AND TAPE; 31065000 - EOFC: IF GTI1~LASTUSED=1 THEN GTI1~MKABS(CARD(0)); 31066000 - COMMENT FORCE EOF NO LABEL IF CARD-ONLY, OTHERWISE USE 31067000 - TAPE-ONLY; 31068000 - LASTUSED~5; 31069000 - IF GTI1=3 THEN GO TO C COMMENT TBUFF WASNT VALID; 31070000 - ELSE GO TO T; 31071000 - EOFT: IF LASTUSED=5 THEN GT1~MKABS(TAPE(0)) ELSE CLOSE(TAPE); 31072000 - LASTUSED~1; COMMENT CARDS ONLY; 31073000 - GO TO T; 31074000 - BACK: IF LASTUSED{3 THEN READ(CARD,10,CBUFF[*])[EOFC]; 31075000 - C: IF LASTUSED}3 THEN READ(TAPE,10,TBUFF[*])[EOFT]; 31076000 - T: IF LASTUSED=1 THEN LCR~CLCR ELSE 31077000 - IF LASTUSED=5 THEN LCR~TLCR ELSE 31078000 - IF GREATER(CLCR,TLCR) THEN 31079000 - BEGIN LCR~TLCR; LASTUSED~4 END ELSE 31080000 - BEGIN LCR~CLCR; 31081000 - IF EQUAL(CLCR,TLCR) THEN LASTUSED~3 ELSE LASTUSED~2 31082000 - END CARD SELECTION; 31083000 - COMMENT LCR NOW POINTS TO THE SEQUENCE NUMBER OF THE NEXT 31084000 - CARD TO BE USED; 31085000 - IF VOIDING THEN 31086000 - IF GREATER(LASTSEQUENCE+1,LCR) THEN GO BACK 31087000 - ELSE VOIDING~FALSE 31088000 - COMMENT IF WE HAD SEEN A $ VOID, WE JUST CLEARED IT BY 31089000 - GOING BACK TO READ AGAIN UNLESS THE VOID WAS 31090000 - SATISFIED; 31091000 - ELSE 31091100 - IF LISTING THEN 31091200 - IF GREATER(LASTSEQUENCE+1,LCR) THEN 31091300 - BEGIN SEQ ~ FALSE; 31091310 - BLANKOUT(2,LBUFF[14]); 31091320 - GO LISTEM; 31091330 - END 31091340 - ELSE LISTING~FALSE; 31091400 - IF SEQ~GREATER(LASTSEQUENCE,LCR) THEN SEQERR(LASTSEQUENCE, 31092000 - LBUFF[14]) ELSE BLANKOUT(2,LBUFF[14]); 31093000 - COMMENT SET UP SEQUENCE ERROR MESSAGE IF NECESSARY; 31094000 - GTI1~MOVECHRS(8,LCR,LASTSEQUENCE); 31095000 - COMMENT SAVE OFF THE SEQUENCE NUMBER; 31096000 - IF LISTOG OR NEWTOG OR SEQ THEN 31097000 - IF EXAMINE(READACARD~LCR-9)!"$" THEN 31098000 - BEGIN COMMENT WRITE THE CARD OUT SOMEWHERE; 31099000 - IF RESEQTOG THEN % CHANGE THE SEQUENCE NR. 31100000 - BEGIN CONVERTOUT(RESEQNR,LCR); 31101000 - RESEQNR ~ RESEQNR + RESEQINC 31102000 - END RESEQUENCING; 31103000 - IF NEWTOG THEN % WRITE IT ONTO NEWTAPE 31104000 - IF LASTUSED<4 THEN WRITE(NEWTAPE,10,CBUFF[*]) 31105000 - ELSE WRITE(NEWTAPE,10,TBUFF[*]); 31106000 - LISTEM: 31106100 - IF LISTOG OR SEQ THEN % WRITE IT ON THE PRINTER 31107000 - BEGIN 31108000 - IF LISTOG.[46:1] THEN DATIME; % FIRST LINE 31109000 - EDITLINE(LCR-9,IF LISTING THEN 6 ELSE LASTUSED,1, 31110000 - SEGNO,L DIV 6,GTI1+L MOD 6, LBUFF); 31111000 - WRITELBUFF; 31112000 - END LISTING; 31113000 - IF LISTING THEN GO BACK; 31113100 - END SOURCE OUTPUT ELSE ELSE READACARD ~ LCR - 9; 31114000 - PRT27 ~ SEQCONVERT(LCR); 31114010 - ZOT("%",LCR); 31115000 - CARDCOUNT ~ CARDCOUNT + 1; 31116000 - EXIT: 31117000 - END READACARD; 31118000 - PROCEDURE DATIME; % PRODUCES HEADING LINE FOR LISTING. 31119000 - BEGIN 31120000 - INTEGER DAY,MO,DA,YR,HR,MN; 31121000 - LABEL OWT; 31122000 - FORMAT DT(X25,"B 6 5 0 0 E S P 0 L C 0 M P I L A T I 0 N,",31123000 - A8,"DAY, ",2(I2,"/"),I2,", ",A2,":"A2" H."); 31124000 - DA~(((DAY~TIME(0)).[30:6]|10)+DAY.[36:6])|10+DAY.[42:6]; 31125000 - YR~HR+DAY.[18:6]|10+DAY.[24:6]; 31126000 - FOR DAY~31,REAL(YR MOD 4=0)+28,31,30,31,30,31,31,30,31,30 DO 31127000 - IF DA{DAY THEN GO OWT ELSE 31128000 - BEGIN MO~MO+1; DA~DA-DAY END; 31129000 - OWT: IF MO<2 THEN BEGIN MN~MO+11; HR~YR-1 END ELSE MN~MO-1; 31130000 - MO~MO+1; 31131000 - DAY~((MN|26-2)DIV 10+DA+HR+HR DIV 4) MOD 7; 31132000 - HR~(HR~TIME1 DIV 216000)MOD 10+(HR DIV 10)|64; 31133000 - MN~(MN~(TIME1 DIV 3600)MOD 60)MOD 10 +(MN DIV 10)|64; 31134000 - WRITE(LINE[DBL],DT,IF DAY=3 THEN " THURS" ELSE IF DAY<3 THEN 31135000 - IF DAY=1 THEN " TUES" ELSE IF DAY<1 THEN" MON"ELSE 31136000 - "WEDNES"ELSE IF DAY=5 THEN" SATUR"ELSE IF DAY<5 THEN 31137000 - " FRI"ELSE " SUN",MO,DA,YR,HR,MN); 31138000 - LISTOG~LISTOG AND TRUE; 31139000 - END DATIME; 31140000 - PROCEDURE GNC; % GET NEXT CHARACTER & PUT IT INTO ACCUM 31141000 - BEGIN 31142000 - ACCUMINX ~ MOVECHRS(1,NCR,ACCUMINX); 31143000 - COUNT ~ COUNT+1; BUMPNCR 31144000 - END GNC; 31145000 - BOOLEAN FONY; % CAUSES TABLE TO STUTTER PROPERLY. 31145100 -BOOLEAN FIELDING; %KEEPS TABLE FROM STUTTERING IMPROPERLY. 31145200 - INTEGER PROCEDURE TABLE(P); VALUE P; INTEGER P; 31146000 - COMMENT TABLE IS THE REAL SCANNER: IT PRE-PROCESSES THE 31147000 - RAW SOURCE LANGUAGE BY LOOKING UP IDENTIFIERS, TRYING31148000 - TO CLASSIFY THEM, BY CONVERTING NUMBERS, AND BY 31149000 - GENERALLY REPLACING THINGS BY ELBAT WORDS REPRESENTIN31150000 - THEM. IT PERFORMS OTHER TRANSFORMATIONS ON THE TEXT, 31151000 - SUCH AS INITIATING AND TERMINATING DEFINE-EXPANSION, 31152000 - DELETING COMMENTS, AND OTHER GOOD STUFF; 31153000 - BEGIN 31154000 - LABEL RESCAN, COMPLAIN, FAKEIT, ON, FOUND,FPART,FINISHNUMBER;31155000 - LABEL FINISH, INN, AWAY; 31155100 - OWN REAL HIDYPLACE; 31155200 - LABEL UNRECURSE, THERE, SOMEWHERE; 31155300 - INTEGER HOOKUP; 31156000 - IF P < 0 THEN GO RESCAN ELSE 31156100 - WHILE P}NXTELBT DO 31157000 - BEGIN 31158000 - IF FONY THEN GO INN; 31158100 - RESCAN: IF SCAN>SPASE THEN COMMENT SPECIAL CHARACTER; 31159000 - BEGIN ENDTOG ~ FALSE; 31160000 - CASE SPEC.LINKC OF 31161000 - BEGIN ; COMMENT CASE 0= NO FUNNY BUSINESS; 31162000 - COMMENT CASE 1= CROSSHATCH; 31163000 - IF DEFINECTR = 0 31164000 - THEN BEGIN COMMENT TRY TO UNHOOK DEFINE; 31165000 - UNHOOK; 31166000 - GO RESCAN 31167000 - END CROSSHATCH CASE; 31168000 - COMMENT CASE 2=ATSIGN. BUILD OCTAL; 31169000 - IF P = -2 THEN GO UNRECURSE ELSE 31169100 - IF DEFINECTR = 0 THEN 31170000 - BEGIN DEBLANK; DPTOG ~ FALSE; 31171000 - IF CHR<8 THEN 31172000 - BEGIN 31172100 - IF SCAN = DIGIT THEN 31173000 - IF COUNT { 16 THEN 31174000 - IF COUNT ! 16 OR ACCUM[1].FIRSTCHR { 3 THEN 31175000 - IF NOT OCTALCONVERT(ACCUMSTART,COUNT,16-COUNT, 31176000 - THI) THEN GO FINISHNUMBER; 31177000 - COMPLAIN: FLAG(301); GO RESCAN 31178000 - END 31178100 - END AT SIGN; 31179000 - COMMENT CASE 3=COLON. CHECK FOR :=; 31180000 - BEGIN 31181000 - DEBLANK; 31182000 - IF CHR="=" THEN 31183000 - BEGIN CHR~"~"; 31184000 - FAKEIT: RESULT~(ACCUM[0]~SPEC~SPECIAL[CHR]).CLASS; 31185000 - ACCUM[1].FIRSTCHR ~ CHR; 31185100 - BUMPNCR 31186000 - END OF SUBSTITUTE CHARACTER; 31187000 - END COLON CASE; 31188000 - COMMENT CASE 4=DOLLAR. CALL WALLY; 31189000 - BEGIN DOLLARCARD; GO RESCAN END; 31190000 - COMMENT CASE 5=RIGHT PAREN.; 31191000 - BEGIN 31192000 - DEBLANK; 31193000 - IF CHR=""" THEN COMMENT A FUNNY COMMA, I HOPE; 31194000 - BEGIN 31195000 - DO BUMPNCR UNTIL EXAMINE(NCR)="""; 31196000 - BUMPNCR; 31197000 - DEBLANK; 31198000 - IF CHR!"(" THEN GO COMPLAIN; 31199000 - CHR~","; 31200000 - GO FAKEIT 31201000 - END FUNNY COMMA 31202000 - END RIGHT PAREN CASE; 31203000 - BEGIN COMMENT PERCENT; 31204000 - IF NCR!LCR-9 THEN 31204100 - NCR ~ READACARD; 31205000 - GO TO RESCAN; 31205100 - END; 31205300 - COMMENT CASE 7=QUOTE. MAKE A STRING; 31206000 - UNRECURSE: IF P < 0 THEN 31206100 - BEGIN TABLE~RESULT; GO AWAY END ELSE 31206200 - BEGIN 31207000 - MAXCSZ ~ CSZ ~ DEFAULTSIZE; 31208000 - SPEC.CLASS ~ IF GOBBLE(FALSE) THEN STRING 31209000 - ELSE STRNGCON; 31210000 - END QUOTE CASE; 31214000 - COMMENT CASE 8=PERIOD; 31215000 - IF P = -2 THEN GO UNRECURSE ELSE 31215100 - IF EXAMINE(NCR){9 AND CONTEXT!3 THEN 31216000 - IF DEFINECTR = 0 THEN 31217000 - BEGIN THI~TLO~TCOUNT~C~REAL(FLAGS~FALSE); 31218000 - GO TO FPART 31219000 - END PERIOD CASE 31220000 - 9 IS MULTIPLY TRY FOR TWO; 31221000 - IF DEFINECTR = 0 THEN 31222000 - BEGIN 31223000 - DEBLANK; 31224000 - IF CHR = "|" THEN 31225000 - BEGIN BUMPNCR; SPEC.ADDRESS ~ MULX END 31226000 - END MULTIPLY CASE 31227000 - END 31228000 - END SPECIAL CHARACTER CASES ELSE 31229000 - IF RESULT=LETTER THEN COMMENT IDENTIFIER-TYPE THING; 31230000 - BEGIN 31231000 - IF (GT1~(SPEC~STACKHEAD[SCRAM~(Q~ACCUM[1])MOD 125]) 31232000 - .LINKR) + GT2~SPEC.LINKC ! 0 THEN 31233000 - DO IF(SPEC~INFO[GT1,GT2]).[18:30] = Q THEN 31234000 - IF COUNT < 5 THEN GO ON ELSE 31235000 - IF CMPCHREQL(COUNT-4,ACCUM[2],INFO[GT1,GT2+1]) 31236000 - THEN 31237000 - ON: BEGIN 31238000 - SPEC ~(GT3 ~ INFO[GT1,GT2-1])>1[33:41:7] 31239000 - &(GT2-1)[40:40:8]; 31240000 - GO TO FOUND 31241000 - END 31242000 - UNTIL (GT1~SPEC.CONR)+GT2~SPEC.CONC = 0; 31243000 - SPEC ~ 0; COMMENT WE DID NOT FIND IT; 31244000 - FOUND: 31245000 - IF SPEC.CLASS = COMMENTV THEN 31246000 - IF CONTEXT!3 OR DEFINECTR!0 THEN 31247000 - BEGIN WHILE EXAMINE(NCR)!";" DO BUMPNCR; 31248000 - BUMPNCR; 31249000 - GO RESCAN 31250000 - END COMMENT REMOVER; 31251000 - IF CONTEXT { 1 THEN 31252000 - IF SPEC.LINK > RSVDX THEN %%%%%%%KLUDGE%%%%%%%%%%%% 31253000 - IF SPEC.RSVD =0 THEN 31254000 - IF SPEC .LINK < NINFOO THEN 31255000 - SPEC.CLASS ~ UNKNOWNID; 31256000 - IF DEFINECTR = 0 THEN 31256900 - IF CONTEXT!3 THEN 31257000 - IF SPEC.CLASS = DEFINDID THEN 31258000 - BEGIN 31259000 - LITERALS ~ FALSE; 31259100 - HOOKUP ~ GT3.LINK; 31260000 - IF GT1 ~ SPEC.ADDRESS ! 0 31261000 - THEN BEGIN 31262000 - HOOKUP ~ HOOKUP & NEXTINFO[18:33:15]; 31263000 - IF ASSOCIATE (SPEC.ADDRESS) 31264000 - THEN GO RESCAN; 31265000 - END; 31266000 - HOOK(HOOKUP); 31267000 - GO RESCAN; 31268000 - END START OF DEFINE SCAN; 31269000 - END IDENTIFIER TYPES ELSE 31270000 - IF DEFINECTR = 0 THEN 31271000 - BEGIN COMMENT NUMBERS; 31272000 - TCOUNT~NLO~TLO~NHI~REAL(FLAGS ~ FALSE); 31273000 - IF COUNT=1 THEN THI~ACCUM[1].FIRSTCHR ELSE 31274000 - CONVERTINTO(THI,TLO); 31275000 - IF P < 0 THEN GO FINISHNUMBER; 31275050 - IF NOT FIELDING THEN IF CONTEXT!3 THEN 31275055 - IF COUNT { 3 THEN 31275060 - IF HOOKUP~TABLE(-2)=PERIODV THEN GO THERE ELSE 31275100 - IF HOOKUP = ATSIGN THEN GO SOMEWHERE ELSE 31275140 - IF HOOKUP ! STRNGCON THEN GO FINISHNUMBER ELSE 31275150 - BEGIN MAXCSZ ~ 0; 31275160 - SPEC.CLASS ~ IF GOBBLE(THI MOD 10 = 0 OR 31275200 - BOOLEAN(2)) 31275250 - THEN STRING ELSE STRNGCON; 31275300 - GO FINISH 31275600 - END; 31275700 - IF CHR = "." THEN 31276000 - BEGIN BUMPNCR; 31277000 - THERE: DOUBLE(THI, TLO, 1.0, 0, |, ~, THI, TLO); 31278000 - IF EXAMINE(NCR){9 THEN 31279000 - BEGIN 31280000 - FPART: IF SCAN!DIGIT THEN GO COMPLAIN; 31281000 - IF COUNT=1 THEN NHI~ACCUM[1].FIRSTCHR ELSE 31282000 - CONVERTINTO(NHI,NLO); 31283000 - TCOUNT~COUNT 31284000 - END FRACTION PART; 31285000 - END DOT PART; 31286000 - IF EXAMINE(NCR)="@" THEN 31287000 - BEGIN BUMPNCR; 31288000 - SOMEWHERE: DPTOG ~ EXAMINE(NCR) = "@"; 31289000 - IF DPTOG THEN BUMPNCR; 31290000 - IF SCAN=ADDOP THEN 31291000 - BEGIN T~CHR; IF SCAN!DIGIT THEN GO COMPLAIN31291000 - END SIGN OF EXPONENT ELSE 31292000 - IF RESULT!DIGIT THEN GO COMPLAIN; 31293000 - IF COUNT=1 THEN C~ACCUM[1].FIRSTCHR ELSE 31294000 - CONVERTINTO(C,GTI1); 31295000 - IF T="-" THEN C~-C; 31296000 - END EXPONENT PART ELSE C~T~0; 31297000 - COMMENT THE NUMBER IS SPLIT ALL APART: 31298000 - HIGH LOW SIZE 31299000 - INTEGER THI TLO - 31300000 - FRACTION NHI NLO TCOUNT 31301000 - EXPONENT C JUNK COUNT 31302000 - NOW IT IS TIME TO PUT THE PIECES TOGETHER; 31303000 - DPTOG~(GT1~THI|1.0).[3:6]+(NHI|1.0).[3:6]< 31304000 - REAL(NHI|THI!0)|13 OR DPTOG; 31305000 - IF ABS(GT1.[3:6]>1[1:2:1]+(T~TEN[ABS(C)]).[3:6] 31306000 - &C[1:1:1]+12)>63 THEN 31307000 - FLAG(303) COMMENT NUMBER IS TOO BIG; ELSE 31308000 - BEGIN COMMENT THE NUMBER FITS: PUT THE INTEGER AND 31309000 - FRACTION PARTS TOGETHER; 31310000 - IF TCOUNT>0 THEN 31311000 - IF DPTOG THEN BEGIN 31312000 - FOR N~0 STEP 16 UNTIL TCOUNT DO 31313000 - DOUBLE(THI,TLO,TEN[MIN(TCOUNT-N,16)],0,|, 31314000 - ~,THI,TLO); 31315000 - DOUBLE(THI,TLO,NHI,NLO,+,~,THI,TLO) 31316000 - END OP ELSE 31317000 - THI~THI|TEN[TCOUNT]+NHI; 31318000 - COMMENT THE NUMBER IS IN (THI,TLO) AS AN 31319000 - INTEGER (MAYBE NORMALIZED, BUT WITH ZEROES 31320000 - TO THE RIGHT OF THE OCTAL POINT). WE NOW 31321000 - ADJUST IT BY THE APPROPRIATE POWER OF TEN. 31322000 - NOTE THAT ONLY THE POWERS 0 THRU 16 OF TEN 31323000 - (@0 THRU @16) CAN BE REPRESENTED EXACTLY IN31324000 - A SINGLE WORD, SO WE USE ONLY THOSE VALUES 31325000 - FOR DP CONVERSION; 31326000 - IF DPTOG THEN 31327000 - IF C~C-TCOUNT<0 THEN 31328000 - FOR N~0 STEP -16 UNTIL C DO 31329000 - DOUBLE(THI,TLO,TEN[MIN(N-C,16)],0,/, 31330000 - ~,THI,TLO) 31331000 - ELSE 31332000 - FOR N~0 STEP 16 UNTIL C DO 31333000 - DOUBLE(THI,TLO,TEN[MIN(C-N,16)],0,|, 31334000 - ~,THI,TLO) 31335000 - ELSE 31336000 - IF C~C-TCOUNT<0 THEN THI~THI/TEN[-C] ELSE 31337000 - IF C!0 THEN THI~TEN[C]|THI; 31338000 - END PUTTING PIECES TOGETHER; 31339000 - FINISHNUMBER: 31340000 - COMMENT HERE WE SHOULD THINK ABOUT CLASSIFYING THE 31341000 - NUMBER, ONCE WE DECIDE WHAT CLASSIFICATIONS 31342000 - WE NEED; 31343000 - SPEC.CLASS ~ NUMBER; 31344000 - FINISH: 31344900 - END NUMBERS; 31345000 - IF P < 0 THEN COMMENT GOBBLE IS RUNNING,31345010 - SO WE LEAVE THINGS LAYING AROUND 31345020 - TO PICK UP--IF GOBBLE DIDNT TURN 31345030 - OFF FONY; 31345040 - BEGIN 31345100 - FONY ~TRUE; 31345110 - RCOUNT ~ COUNT; 31345150 - TABLE ~ SPEC.CLASS; 31345160 - HIDYPLACE ~ SPEC; 31345170 - GO AWAY; 31345190 - INN: FONY ~ FALSE; 31345500 - SPEC ~ HIDYPLACE; 31345550 - COUNT ~ RCOUNT; 31345600 - END; 31345990 - COMMENT NOW WE HAVE SOMETHING, SO WE PUT THE CODED 31346800 - VERSION INTO ELBAT; 31347000 - ELBAT[NXTELBT]~SPEC; 31348000 - COMMENT CHECK THAT ELBAT IS NOT FULL. IF 31349000 - IT IS, DIDDLE IT SO THAT IT WONT 31350000 - OVERFLOW. BE SURE TO SAVE THE LAST 31351000 - 10 THINGS SEEN; 31352000 - IF NXTELBT~NXTELBT+1 > 74 THEN 31353000 - IF MACRO THEN 31354000 - BEGIN 31355000 - MOVE(10,ELBAT[65],ELBAT[0]); 31356000 - NXTELBT~10; I~I-65; P~P-65; 31357000 - END ELBAT ADJUSTMENT; 31358000 - SCANCOUNT ~ SCANCOUNT + 1; 31359000 - END OF WHILELOOP ON P VS NXTELBT; 31360000 - COMMENT NOW WE KNOW THAT ELBAT[P] IS VALID; 31361000 - IF TABLE ~ ELBAT[P].CLASS = COMMENTV THEN 31362000 - BEGIN THI ~ GIT(GT1~ELBAT[P]); 31363000 - FLAGS ~ BOOLEAN(GT1.[1:3]); 31364000 - IF DPTOG THEN TLO~GIT(GT1.LINK -1); 31364100 - IF GT1.[4:1]=1 THEN 31364200 - NEXTADDL ~ NEXTADDL -REAL(DPTOG) -1; 31364300 - ELBAT[P].CLASS ~ TABLE ~ NUMBER; 31365000 - END; 31365100 -AWAY: 31365900 - END TABLE; 31366000 - PROCEDURE DEBLANK; 31367000 - BEGIN 31368000 - LABEL INN, ON; 31368100 - INTEGER STREAM PROCEDURE UB(NCR); VALUE NCR; 31369000 - BEGIN LABEL L; 31370000 - SI~NCR; 31371000 - IF SC=" " THEN BEGIN L: SI~SI+1; IF SC=" " THEN GO L END; 31372000 - UB ~ SI 31373000 - END UB; 31374000 - ON: WHILE NCR ~ UB(NCR) = LCR DO INN: NCR ~ READACARD; 31375000 - IF CHR ~ EXAMINE(NCR) = "%" THEN GO INN; 31375500 - IF CHR = "#" THEN IF DEFINECTR = 0 THEN 31375600 - BEGIN BUMPNCR; UNHOOK; GO ON END; 31376000 - END; 31377000 - COMMENT AND THEN THERE ARE THESE GUYS, AGAIN; 31378000 - PROCEDURE STEPIT; ELCLASS~TABLE(I~I+I); 31379000 - INTEGER PROCEDURE STEPI; STEPI~ELCLASS~TABLE(I~I+1); 31380000 - PROCEDURE CONVERTINTO(HI,LO); REAL HI,LO; 31381000 - COMMENT CONVERTS THE NUMBER IN ACCUM INTO INTERNAL FORM, 31382000 - IN H AND L. IT TRIES TO KEEP THINGS INTEGER; 31383000 - BEGIN REAL J,K; 31384000 - HI~INPUTCONVERT(ACCUM[1],4,N~COUNT.[45:3]); 31385000 - WHILE K 47 THEN FLAG (302) ELSE 31397000 - BEGIN INDEX ~ INDEX - 1; 31398000 - DEFINEARRAY[DEFINEINDEX] ~ LASTUSED & INDEX [3:18:30]; 31399000 - LASTUSED ~ INDEX.[33:15]; 31400000 - DEFINEARRAY[DEFINEINDEX + 2] ~ -NCR 31401000 - & LCR [12:30:18] 31402000 - & DEFINECTR [4:40:8]; 31403000 - DEFINECTR ~ 0; 31404000 - IF DEFINEADDR = 0 THEN DEFINEADDR ~ MKABS(DEFINEARRAY)-1; 31405000 - LCR ~ (DEFINEINDEX ~ DEFINEINDEX + 3) + DEFINEADDR; 31406000 - NCR ~ READACARD 31407000 - END HOOKING UP A DEFINE TYPE ACTION; 31408000 - PROCEDURE UNHOOK; 31409000 - COMMENT UNHOOK RETURNS THE SCANNER FROM A DEFINE-TYPE ACTION, BY 31410000 - UNDOING THE WORK OF HOOK; 31411000 - IF DEFINEINDEX { 0 THEN FLAG(304) ELSE 31412000 - BEGIN 31413000 - LCR ~ (GT1 + DEFINEARRAY[DEFINEINDEX -1]).[12:18]; 31414000 - NCR ~ GT1.[30:18]; 31415000 - DEFINECTR ~ GT1.[4:8]; 31416000 - LASTUSED~(GT1+DEFINEARRAY[DEFINEINDEX+DEFINEINDEX-3]).[33:15]; 31417000 - IF (GT1 ~ GT1.[3:15]) ! 0 THEN 31418000 - BEGIN NEXTADDL ~ TAKE(GT1).LINK; PURGE(-NEXTINFO + GT1) END; 31418100 - END UNHOOKING THE DEFINE ACTION; 31419000 -PROCEDURE DOLLARCARD; 31420000 - COMMENT THIS CODE HANDLES $ CONTROL CARD OPTIONS; 31421000 - BEGIN LABEL QUIT; 31422000 - LABEL LISTEM; 31422100 - ZOT("[", LCR); 31422900 - LCR~LCR+BUMPCHAR; 31423000 - COUNT~RESULT~ACCUM[1]~0; N~SCAN; 31424000 - Q~ACCUM[1]; 31425000 - IF Q="4VOID" THEN 31426000 - BEGIN VOIDING~TRUE; 31427000 - LISTEM: 31427100 - DEBLANK; 31428000 - GT1~MOVECHRS(8,NCR,LASTSEQUENCE+1); 31429000 - COMMENT STORES VOID SEQUENCE NO.; 31430000 - NCR ~ LCR.[CF]; N ~ SCAN; 31430100 - GO QUIT; 31431000 - END; 31432000 - IF Q="7LIST" THEN 31432100 - BEGIN LISTING~TRUE; GO LISTEM END; 31432200 - IF Q="4DUMP" THEN 31433000 - IF SCAN ! LETTER THEN 31434000 - BEGIN DUMPIT(LBUFF); GO QUIT END ELSE 31435000 - BEGIN DUMPTOG ~ ACCUM[1] = "2ON00"; GO QUIT END; 31436000 - IF Q="4TAPE" THEN 31437000 - BEGIN 31437100 - IF LASTUSED=1 THEN LASTUSED~3; 31437200 - TLCR~MKABS(TBUFF[9]); 31437300 - END ELSE 31437400 - BEGIN IF Q!"4CARD" THEN GO QUIT; 31438000 - IF LASTUSED}5 THEN ELSE LASTUSED~1; 31439000 - END; 31440000 - LISTOG.[47:1]~FALSE; 31441000 - INFOTOG~SAVETOG~ 31441100 -DONSBUG ~ %%%%%%%%%%%%%%%%%%%% 31442000 - PRTOG~NEWTOG~RESEQTOG~DEBUGTOG~FALSE; 31443000 - DO BEGIN 31444000 - COUNT~RESULT~ACCUM[1]~0; N~SCAN; 31445000 - Q~ACCUM[1]; 31446000 - IF Q = "4LIST" THEN LISTOG.[47:1] ~ TRUE ELSE 31447000 - IF Q="3NEW0" THEN NEWTOG~TRUE ELSE 31448000 - IF Q="3SEQ0" THEN RESEQTOG~TRUE ELSE 31449000 - IF Q="3PRT0" THEN PRTOG~TRUE ELSE 31450000 - IF RESULT=DIGIT THEN CONVERTINTO(RESEQNR,GT1) ELSE 31451000 - IF RESULT=ADDOP THEN 31452000 - BEGIN 31453000 - N ~ SCAN; 31454000 - IF RESULT= DIGIT THEN CONVERTINTO(RESEQINC,GT1);31455000 - END ELSE 31458000 - IF Q="#PROC" THEN 31458100 - BEGIN 31458200 - IF REAL(SEPARATOG)<0 THEN SEPARATOG~BOOLEAN(2); 31458300 - END ELSE 31458400 - IF Q="6SVIN" THEN 31458500 - BEGIN 31458600 - IF REAL(SVINFOTOG)<0 THEN SVINFOTOG~TRUE; 31458700 - END ELSE 31458800 - IF Q="6DEBU" THEN DEBUGTOG~TRUE ELSE 31459000 - IF Q = "7DONS" THEN DONSBUG ~ TRUE ELSE 31460000 - IF Q ="4INFO" THEN INFOTOG ~ TRUE ELSE 31460100 - IF Q ="4SAVE" THEN SAVETOG ~ TRUE ELSE 31460200 - IF Q = "4POOL" THEN POOLTOG ~ TRUE ELSE 31460300 - IF Q = "4DECK" THEN DECKTOG ~ POOLTOG ~ TRUE ELSE 31460900 - IF Q!"4TAPE" THEN GO QUIT; 31461000 - END 31462000 - UNTIL FALSE; 31463000 -QUIT: 31464000 - END DOLLARDCARD; 31465000 -BOOLEAN PROCEDURE ASSOCIATE (SPEC); VALUE SPEC; INTEGER SPEC; 31466000 - BEGIN COMMENT ASSOCIATE CHECKS THE PARAMETERIZED DEFINE SYNTAX31467000 - AT INVOCATION TIME AND FORCES THE DECLARATION OF A PHONY 31468000 - DEFINED ID THAT POINTS TO THE TEXTUAL MATERIAL ASSOCIATED 31469000 - WITH THE PARAMETER. THE ID HAS THE FORM: "ANQO", WHERE 31470000 - A IS THE LETTER "A", N IS THE LEFT TO RIGHT SEOUENTIAL 31471000 - APPEARANCE NUMBER OF THE PARAMETER AND Q IS A QUESTION 31472000 - MARK. ;31473000 - DEFINE SCAT = IF E ! 0 THEN ERR(E); 31474000 - ASSOCIATE ~ TRUE; 31475000 - GO QUIT;#, 31476000 - LASTI = LASTINFO.LINKR, LASTINFO.LINKC#; 31477000 - LABEL QUIT; 31478000 - INTEGER T, J, E, FINAL, SAVELCLASS; 31479000 - INTEGER CONTEX; 31479100 - DOUBLE (CONTEXT, 3, ~, CONTEX, CONTEXT); 31479200 - SAVELCLASS ~ ELCLASS; 31479500 - ASSOCIATE ~ FALSE; 31480000 - MACRO ~ FALSE; 31481000 - DEFINECTR ~ DEFINECTR + 1; 31481100 - IF ELCLASS ~ TABLE (NXTELBT) = LFTPRN 31482000 - THEN FINAL ~ RTPARN 31483000 - ELSE IF ELCLASS = LFTBRKT 31484000 - THEN FINAL ~ RTBRKT 31485000 - ELSE BEGIN E ~ 305; SCAT END; 31486000 - NXTELBT ~ NXTELBT -1; 31487000 - DO BEGIN 31488000 - ELCLASS ~ TABLE(NXTELBT); 31489000 - NXTELBT ~ NXTELBT -1; 31490000 - MACRO ~ FALSE; 31491000 - IF -(T ~ TEXT(DEFINEP, FINAL)) > 0 31492000 - THEN BEGIN SCAT END 31493000 - ELSE BEGIN 31494000 - Q ~ 31495000 - ACCUM [1] ~ DEFINFO [J]; 31496000 - COUNT ~ 3; 31497000 - SCRAM ~ Q MOD 125; 31498000 - GTB1 ~ ENTER(0,LOCALTYPE,DEFINDID,FALSE); 31499000 - INFO[LASTI].LINK ~ T; 31500000 -DONBUG ("ASSOCI", LASTINFO, 0); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 31501000 - END; 31502000 - END UNTIL J ~ J + 10 > SPEC OR ELCLASS ! COMMA; 31503000 - IF ELCLASS ! FINAL THEN BEGIN E ~ 305; SCAT END; 31504000 -QUIT: 31505000 - CONTEXT ~ CONTEX; 31505100 - DEFINECTR ~ DEFINECTR - 1; 31505200 - MACRO ~ TRUE; 31506000 - ELCLASS ~ SAVELCLASS; 31506500 - END OF ASSOCIATE; 31507000 -BOOLEAN PROCEDURE SYNTAXCK(ELBATCLASS,ERRNO); 31508000 - VALUE ELBATCLASS,ERRNO; 31508100 - REAL ELBATCLASS,ERRNO; 31508200 - BEGIN 31508300 - IF SYNTAXCK ~ (ELBATCLASS!TABLE(I)) THEN 31508400 - ERR(ERRNO); 31508500 - END SYNTAXCK; 31508600 - BOOLEAN PROCEDURE GOBBLE(FROM); VALUE FROM; BOOLEAN FROM; 31510000 - COMMENT GOBBLE GETS UP TO 48 BITS OF STRING FROM THE SOURCE AND 31511000 - PACKS IT INTO ACCUM, THI, AND THIFLAG. IT RETURNS FALSE 31512000 - IF IT FOUND THE END OF THE STRING. GOBBLE MANAGES TO 31513000 - WORRY ABOUT CONCATENATED STRINGS WITH SIZE CODES, AND 31514000 - THINGS LIKE THAT. 31515000 - FROM IS TRUE IF THE STRING IS LEFT-JUSTIFIED (OR IS A 31516000 - CONTINUATION). THE [46:1] OF FROM IS TURNED ON(BY 31517000 - TABLE) TO START A NON-BCL STRING: GOBBLE WILL 31518000 - RETURN TRUE IN[46:1] IF THE NUMBER IN THI IS NOT A 31519000 - VALID STRING TYPE. 31520000 - COUNT WILL BE LEFT CONTAINING THE NUMBER OF BITS HANDLED. 31521000 - CSZ IS THE FRAME SIZE OF THE STRING(1,2,3,4,6,7,8); 31522000 - BEGIN 31523000 - LABEL ROUND,BYE,ECH,INN,OWT,START,WAY; 31524000 - REAL S; INTEGER T, C; 31525000 - DEFINE NEXTCR = BUMPNCR ELSE NCR#; 31525100 - DEFINE TABLET=BEGIN C~COUNT; T~ TABLE(-1); COUNT~C END#; 31525200 - COUNT ~ ACCUM[9] ~ 0; 31526000 - FLAGS ~ BOOLEAN(ACCUM[2]~0); 31527000 - LEFTY ~ FROM; 31527100 - S ~ CONTEXT; CONTEXT ~ 5; 31527200 - CHR ~ EXAMINE(NCR); 31528000 - COMMENT IF TABLE FINDS AN INTEGER AND A ", HE CALLS 31529000 - US WITH [46:1] TRUE; 31530000 - IF FROM.[46:1] THEN GO TO START; 31531000 - ROUND: COMMENT CHR CONTAINS THE NEXT CHARACTER TO BE 31532000 - CONSIDERED; 31533000 - CASE CSZ OF 31534000 - BEGIN COMMENT DEPENDING ON THE FRAME SIZE, CHECK AND/OR 31535000 - TRANSLATE THE CHARACTER; 31536000 - GO ECH; COMMENT INVALID; 31537000 - IF CHR > 1 THEN GO ECH; COMMENT BINARY; 31538000 - IF CHR > 3 THEN GO ECH; COMMENT QUATERNARY; 31539000 - IF CHR > 7 THEN GO ECH; COMMENT OCTAL; 31540000 - IF CHR > 9 THEN COMMENT HEXADECIMAL; 31541000 - IF CHR < "A" THEN GO ECH ELSE 31542000 - IF CHR > "F" THEN GO ECH ELSE CHR ~ CHR - 7; 31543000 - GO ECH; COMMENT INVALID; 31544000 - ; COMMENT BCL; 31545000 - COMMENT THE ASCII(CSZ=7) AND EBCDIC(CSZ=8) 31546000 - TRANSLATIONS ARE IN THE ARRAY SPECIAL; 31547000 - IF CHR ~ SPECIAL[CHR].ASCF = 0 THEN GO ECH; 31548000 - IF CHR ~ SPECIAL[CHR].EBCDF = 0 THEN 31549000 - ECH: FLAG(307) 31550000 - END CASES OF CHARACTER SIZE; 31551000 - COMMENT CHR NOW HAS THE CHARACTER TO BE PLACED INTO 31552000 - ACCUM; 31553000 - MOVEBITS(CHR,GT2 ~ IF CSZ=7 THEN 8 ELSE CSZ, 31554000 - 48-GT2, ACCUM[9], COUNT); 31555000 - COUNT ~ COUNT + GT2; 31556000 - COMMENT WE MUST NOW LOOK FOR THE END OF THE STRING, 31557000 - SO THAT WE WILL PROPERLY HANDLE A STRING WITH 31558000 - EXACTLY 48 BITS; 31559000 - IF CHR ~ EXAMINE(NEXTCR) = """ THEN 31560000 - BEGIN 31561000 - COMMENT THFRE IS A QUOTE, SO WE GO PAST IT AND LOOK 31562000 - SOME MORE; 31563000 - BUMPNCR; 31564000 - IF DEFINECTR ! 0 THEN GO OWT; 31564100 - TABLET; 31565000 - IF T ! NUMBER THEN 31566000 - IF T ! STRNGCON THEN GO OWT ELSE 31566100 - BEGIN 31567000 - COMMENT THERE ARE TWO QUOTES, MEANING A CONCATEN- 31568000 - ATION. WE PREPARE TO CHANGE FRAME SIZE TO 6; 31569000 - THI ~ DEFAULTSIZE; GO INN; % OR SOMETHING. 31570000 - END; 31571000 - FONY ~ FALSE; 31572000 - TABLET; IF T ! STRNGCON THEN GO BYE; 31583000 - START: COMMENT THERE IS A QUOTE, SO WE EXAMINE THE NUMBER 31584000 - IN THI TO SEE IF IT IS A VALID STRING CODE; 31585000 - IF THI > 480 THEN GO BYE; 31586000 - IF GT1 ~ (IF THI MOD 10 = 0 THEN THI DIV 10 ELSE THI)=0 31586500 - THEN GO BYE; 31587000 - IF GT1 < 10 THEN C ~ GT1 ELSE 31587500 - IF C ~ GT1 MOD 10 { GT1 ~ GT1 DIV 10 THEN GO BYE; 31588000 - IF C } 9 THEN GO BYE; 31588500 - IF (C~ REAL(C=7)+C)/GT1 MOD 1 ! 0 THEN GO BYE; 31589000 - IF C > MAXCSZ THEN MAXCSZ ~ C; 31590000 - IF GT1 < 1 THEN GO BYE; 31591000 - IF GT1 = 5 THEN 31592000 -BYE: COMMENT WE HAVE AN INVALID SIRING CODE; 31593000 - BEGIN FLAG(0308); GO OWT END; 31594000 - COMMENT WE PASSED ALL THE TESTS, SO WE HAVE A NEW 31611000 - FRAME SIZE; 31612000 - IF THI ~ GT1 } 9 THEN GO BYE; 31615000 -INN: COMMENT NOW WE FUDGE THE BIT COUNTER, SO THAT THE NEW31616000 - FRAMES START IN THE RIGHT PLACE; 31617000 - COUNT ~ ABS(ENTIER(-COUNT/THI)) | THI; 31618000 - IF (CSZ ~ THI) > MAXCSZ THEN 31619000 - MAXCSZ ~ IF CSZ = 7 THEN 8 ELSE CSZ; 31619100 - THI ~ 0; 31620000 - CHR ~ EXAMINE(NCR); 31621000 - COMMENT NOW EVERYTHING IS SET UP AS IF THE QUOTE 31622000 - NONSENSE HAD NEVER HAPPENED; 31623000 - END OF NONTERMINAL QUOTE HANDLING; 31624000 - COMMENT WE MAY NOW CHECK FOR 48 BITS; 31625000 - IF COUNT < 48 THEN GO ROUND; 31626000 - COMMENT WE DIDNT FIND THE TERMINATOR OF THE STRING, 31627000 - BUT WF HAVE BITTEN OFF A COMPLETE MOUTHFUL OF 31628000 - STUFF. WE RETURN TRUE TO THE GUY WHO IS GOING 31629000 - TO SWALLOW; 31630000 - GOBBLE ~ TRUE; 31631000 -OWT: COMMENT ACCUM HAS AS MUCH STRING AS WE ARE GOING TO 31632000 - HANDLE, SO WE PUT THE STUFF INTO THI. IT MAY BE31633000 - EITHER LEFT OR RIGHT JUSTIFIED; 31634000 - IF COUNT } 48 OR FROM THEN 31635000 - BEGIN COMMENT LEFT JUSTIFIED: THE MOST-SIGNIFICANT BIT GETS31636000 - HANDLED WITH EXTREME CARE; 31637000 - THIFLAG ~ FLAGBIT(ACCUM[9]); 31638000 - DEFINESFLAG ~ THIFLAG; 31638100 - THI ~ ACCUM[9]; 31639000 - END ELSE 31640000 - BEGIN 31641000 - THI ~ 0; 31642000 - MOVEBITS(ACCUM[9], COUNT, 0, THI, 48-COUNT); 31643000 - DEFINESFLAG ~ FLAGBIT(ACCUM[9]); 31643100 - END; 31644000 - CONTEXT ~ S; 31645000 -END GOBBLE; 31646000 -COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 40000000 - THE EMITTERS 40001000 - * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;40002000 - ALPHA PROCEDURE O(A); VALUE A; REAL A; 40003000 - O~A.[45:3]&A[39:42:3]&A[33:39:3]&A[27:36:3]&A[21:33:3] 40004000 - &A[15:30:3]&A[9:27:3]&A[3:24:3]; 40005000 - COMMENT BUGOUT FORMATS AND PRINTS DEBUGGING INFO-NOTE THAT THE PARAMS 40006000 - HAVE DIFFERENT MEANINGS AT DIFFENT CALLS; 40007000 - PROCEDURE BUGOUT(F,OP,P1,P2,P3); VALUE F,OP,P1,P2,P3; 40008000 - INTEGER F,OP,P1,P2,P3; 40009000 - BEGIN 40010000 - INTEGER I; 40011000 - ALPHA HEGS; 40012000 - DEFINE Q(Q1)=(O(Q1) & 29[24:43:5])#, H = HEXOUT #; 40012100 - LABEL L0,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,WAY; 40012200 - SWITCH SW ~ L0,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10; 40012300 - BLANKOUT(16,LBUFF); 40013000 - HEGS ~ " "; 40014000 - IF FIGS THEN BEGIN 40015000 - INSERT(2,"**",LBUFF[7],0); 40016000 - IF FIGS.[46:1] THEN FIGS ~ FALSE END; 40017000 - I ~ IF F = 7 THEN P1 ELSE L; 40017100 - INSERT(4,H(I DIV 6), LBUFF[7],3); % PIR - HEX 40018000 - INSERT(2,(I ~ I MOD 6) + ":0", LBUFF[7],7); 40018100 - INSERT(4,OPS[IF F = 7 THEN 768 ELSE OP],LBUFF[8],3); 40019000 - 40019100 - 40019200 - GO TO SW[F + 1]; GO WAY; 40020000 - L2: P2 ~ (P1 DIV 6) & I ~ P1 MOD 6[32:45:3];% BRANCH OP 40021000 - GO TO L10; 40021100 - L7: P1 ~ P2; % LINK 40022000 - L10: I ~ P1 MOD 6 + ":0"; 40023000 - INSERT(6,I + H(P1 DIV 6 | 256), LBUFF[9],1); % 10 =MPCW 40023100 - IF F = 10 THEN GO TO L9; 40023200 - 40023300 - HEGS.[12:24] ~ H(P2); 40023400 - GO TO L0; 40023500 - L1: P1 ~ OP; OP ~ VARI; GO TO L3; % VARIANT OP 40024000 - L8: % 4 PARAMS 40025000 - INSERT(2,H(P3.[16:8]),LBUFF[11],4); 40025100 - L5: % 3 PARAMS 40026000 - HEGS ~ H(P3); 40026100 - L4: % 2 PARAMS 40027000 - HEGS.[24:12] ~ H(P2); 40027100 - L3: % 1 PARAM 40027200 - HEGS.[12:12] ~ H(P1); 40027300 - L0: % PRIMARY 40027400 - INSERT(8, HEGS & H(OP) [1:37:11], LBUFF[10],4); 40027500 - GO WAY; 40027600 - L9: % LT48 40027700 - 40027800 - INSERT(2,H(OP),LBUFF[10],4); 40027820 - INSERT(GTI1~ 5 - L MOD 6, "FFFFF", LBUFF[10], 6); 40027840 - INSERT(GTI1,"FFFFF",LBUFF[10],6+GTI1); 40027860 - INSERT(6, H(P2),LBUFF[10],6+GTI1+GTI1); 40027900 - INSERT(6, H(P3),LBUFF[11],4+GTI1+GTI1); 40028000 - GO WAY; 40028100 - L6: % VALC/NAMC 40028200 - INSERT(4,"(00," + H(P1 | 16), LBUFF[9],1); 40028300 - 40028400 - INSERT(5, H(P2|16)+ ")", LBUFF[9],5); 40028500 - 40028600 - INSERT(4, H(P3), LBUFF[10],4); 40028700 - WAY: WRITELBUFF; 40029000 - END OF BUGOUT; 40030000 - COMMENT GET RETURNS A SYLLABLE FROM EDOC; 40031000 - INTEGER PROCEDURE GET(L); VALUE L; INTEGER L; 40032000 - BEGIN 40033000 - MOVE8BITS(EDOC[(GT1~L DIV 6).[35:5],GT1.[40:8]],GTI1~L MOD 6,L)40034000 - ; GET ~ L.[40:8] 40035000 - END GET; 40036000 - COMMENT PUTSYL PUTS A SYLLABLE INTO EDOC, THE OBJECT COOE ARRAY; 40037000 - PROCEDURE PUTSYL(SYL); VALUE SYL; INTEGER SYL; 40038000 - BEGIN 40039000 - REAL GT1;%FOR WALLY 40040000 - STREAM PROCEDURE PUTS(S,W,B); VALUE S,B; 40041000 - BEGIN DI~W; B(SKIP 8 DB); SI~LOC W; SI~SI-2; SKIP 4 SB; 40042000 - 8(IF SB THEN DS~SET ELSE DS~RESET; SKIP SB) 40043000 - END PUTS; 40044000 - PUTS(SYL,EDOC[(GT1~L DIV 6).[35:5],GT1.[40:8]],GTI1~L MOD 6) 40045000 - END PUTSYL; 40046000 - COMMENT EMIT EMITS ONE OR TWO SYLLABLES, AS IT THINKS APPROPRIATE; 40047000 - PROCEDURE EMIT(OP); VALUE OP; INTEGER OP; 40048000 - BEGIN 40049000 - IF DEBUGTOG THEN 40050000 - BUGOUT(REAL(OP MOD 512 > 255),OP,0,0,0); 40051000 - IF OP > 255 THEN 40052000 - IF OP < 512 THEN BEGIN PUTSYL(VARI); L ~ L + 1 END; 40053000 - PUTSYL(OP); 40053100 - IF L ~ L + 1 > 49150 THEN FLAG(400) 40053200 - END EMIT; 40054000 - COMMENT EMITV EMITS A VALUE-CALL ON THE LOCATION GIVEN BY ITS PARAM, A.40055000 - THE FORMAT OF A(BOTH FOR EMIIV AND EMITN) IS THAT OF THE 40056000 - ADDRESS FIELD OF AN ELBAT-WORD. IN PARTICULAR, [36:12] IS THE 40057000 - DISPLACEMENT, AND [31:5] IS THE LEVEL; 40058000 - PROCEDURE EMITV(A); VALUE A; INTEGER A; 40059000 - BEGIN 40060000 - LITERALS ~ FALSE; 40060100 - IF ADRCPL ~ A.[36:12] & A[35:29:1] > MAXDISP THEN FLAG(401); 40061000 - ADRCPL ~ STACKMASK[A.[31:5]].[CF] + ADRCPL; 40062000 - IF DEBUGTOG THEN 40063000 - BUGOUT(6,VALC,A.[31:5],A.[36:12]&A[35:29:1],ADRCPL); 40064000 - PUTSYL(ADRCPL.[34:6]); L~L+1; PUTSYL(A); 40065000 - IF L~L+1>49150 THEN FLAG(400); 40066000 - END EMITV; 40067000 - COMMENT EMITN EMITS A NAME-CALL. SEE THE EMITV COMMENT FOR DETAILS; 40068000 - PROCEDURE EMITN(A);VALUE A; INTEGER A; 40069000 - BEGIN 40070000 - LITERALS ~ FALSE; 40070100 - IF ADRCPL ~ A.[36:12] & A[35:29:1] > MAXDISP THEN FLAG(401); 40071000 - ADRCPL ~ STACKMASK[A.[31:5]].[CF] + ADRCPL + 16384; 40072000 - IF DEBUGTOG THEN 40073000 - BUGOUT(6,NAMC,A.[31:5],A.[36:12]&A[35:29:1],ADRCPL); 40074000 - PUTSYL(ADRCPL.[32:8]); L ~ L+ 1 ; PUTSYL(ADRCPL); 40075000 - IF L~L+1}49150 THEN FLAG(400); 40076000 - END EMITN; 40077000 - PROCEDURE EMITB(B,F,T); VALUE B,F,T; INTEGER B,F,T; 40078000 - BEGIN 40079000 - INTEGER TL; 40080000 - TL~L; L~F-3; 40081000 - IF DEBUGTOG THEN 40082000 - BEGIN FIGS ~ F ! TL OR TB1 ~ FIGS; 40082100 - BUGOUT(2,B,T,0,0); 40082200 - FIGS ~ TB1 AND NOT TB1.[46:1]; 40082300 - END; 40082400 - PUTSYL(B); L~L+1; 40083000 - PUTSYL((T DIV 1536)&(GTI1~T MOD 6)[40:45:3]); L ~L + 1; 40084000 - PUTSYL(T DIV 6); 40085000 - L ~ TL; 40086000 - END EMITR; 40087000 - PROCEDURE EMITD(A,B,N); VALUE A,B,N; INTEGER A,B,N; 40088000 - IF N - A = 1 THEN 40089000 - EMIT2P(INSR,B,N) ELSE 40090000 - EMIT3P(FLTR,A,B,N); 40091000 - ALPHA PROCEDURE HEXOUT(N); VALUE N; ALPHA N; 40092000 - COMMENT HEXOUT CONVERTS HALF OF A WORD (24 BITS) INTO BCL-CODED 40093000 - HEXADECIMAL (CHARACTERS 0-9, A-F). IT FIRST PLACES EACH 40094000 - 4-BIT DIGIT (OR HEXIT) INTO ONE 6-BIT CHARACTER. THEN 40095000 - IT ADDS "6" TO EACH CHARACTER: ANY CHARACTER WHICH 40096000 - OVERFLOWS INTO THE 16S BIT REQUIRES CONVERSION TO A LETTER40097000 - WE "AND" THE SUM WITH "+"S TO CATCH THAT BIT, AND SHIFT 40098000 - THE RESULT RIGHT BY FOUR BITS. MULTIPLYING THIS RESULT BY40099000 - SEVEN YIELDS A 7 IN EACH CHARACTER-POSITION NEEDING TO BE 40100000 - CONVERTED. THE CONVERSION IS ACCOMPLISHED BY ADDING THIS 40101000 - PRODUCT TO THE RESULT OF THE FIRST (CHAR + HEXIT) 40102000 - OPERATION; 40103000 - HEXOUT ~ REAL( BOOLEAN((N ~ N.[44:4] & N[38:40:4] & N [32:36:4] 40104000 - & N [26:32:4] & N[20:28:4] & N[14:24:4]) + "666666") 40105000 - AND BOOLEAN("++++++")).[12:32] | 7 + N; 40106000 - 40107000 - 40108000 - 40109000 - 40110000 -PROCEDURE EMITNUMBER(N,STRINGSOURCEFLAG); VALUE N, STRINGSOURCEFLAG; 40111000 - REAL N, STRINGSOURCEFLAG; 40111100 - BEGIN 40112000 - LABEL ON; 40113000 - REAL GT1; % FOR TALLY 40114000 - BOOLEAN S; 40115000 - IF BOOLEAN(STRINGSOURCEFLAG) OR N.[2:30] ! 0 THEN GO ON; 40121000 - S ~ BOOLEAN(N.[1:1]); N ~ ABS(N); 40122000 - IF N=0 THEN EMIT(ZERO) ELSE 40123000 - IF N=1 THEN EMIT(ONE) ELSE 40124000 - 40125000 - IF N.[9:31]=0 THEN 40126000 - EMIT1P(LT8,N) ELSE 40127000 - 40128000 - 40129000 - 40130000 - IF N.[9:23]=0 THEN 40131000 - EMIT2P(LT16,N.[32:8],N.[40:8]) ELSE 40132000 - BEGIN 40137000 - ON: IF DEBUGTOG THEN BUGOUT(9,LT48 ,0,N.[1:23] 40138000 - & STRINGSOURCEFLAG [24:47:1],N.[24:24]); 40138100 - PUTSYL(LT48); WHILE(L~L+1)MOD 6 ! 0 DO PUTSYL(NVLD); 40138200 - FLOG(STRINGSOURCEFLAG,N,EDOC[(GT1~L DIV 6).LINKR, 40139000 - GT1.LINKC]); 40140000 - IF L ~ L + 6 } 49150 THEN FLAG(400) 40141000 - END LT48; 40142000 - 40143000 - 40144000 - IF S THEN EMIT(CHSN) 40145000 - END EMITNUM; 40146000 - PROCEDURE EMITDP(H,J); VALUE H,J; REAL H,J; 40147000 - BEGIN 40148000 - EMITNUM(H); 40149000 - IF J = 0 AND J.[1:8] = 0 THEN EMIT(XTND) ELSE 40150000 - BEGIN EMITNUM(J); EMIT(JOIN) END; 40151000 - END EMITDP; 40152000 - PROCEDURE EMITPAIR(A,O); VALUE A,O; INTEGER A,O; 40153000 - BEGIN EMITN(A); EMIT(O) END EMITPAIR; 40154000 - PROCEDURE EMITNOT; 40155000 - COMMENT EMITNOT SOMETIMES EMITS AN LNOT. AT OTHER TIMES, DEPENDING 40156000 - ON THE VALUE OF LASTNOT, IT WILL CANCEL AN LNOT THAT HAD 40157000 - JUST BEEN EMITTED, OR IT WILL INVERT A RELATIONAL 40158000 - OPERATOR; 40159000 - IF LASTNOT = L THEN COMMENT LAST THING WAS AN LNOT; 40160000 - BEGIN L ~ L - 1; LASTNOT ~ 0; FIGS ~ BOOLEAN(3) END ELSE 40161000 - IF LASTNOT = -L AND GET(L-1) ! SAME THEN 40162000 - BEGIN 40162100 - FIGS ~ TRUE; 40162200 - EMIT(REAL(BOOLEAN(GET(L~L-1)) EQV NOT TRUE).[40:8]); 40163000 - FIGS ~ FALSE; 40163100 - COMMENT "EQV NOT TRUE" COMPLEMENTS THE LOW-ORDER BIT, 40164000 - WHICH IS SUFFICIENT TO INVERT THE RELATION; 40165000 - END ELSE 40165100 - COMMENT OUT OF LUCK. GOT TO EMIT SOMETHING; 40166000 - BEGIN EMIT(LNOT); LASTNOT ~ L END EMITNOT; 40167000 - INTEGER PROCEDURE GET3(L); VALUE L; INTEGER L; 40168000 - COMMENT GET3 RETURNS THE THREE SYLLABLES IN EDOC AT L; 40169000 - GET3 ~ GET(L+2) & GET(L+1)[32:40:8] & GET(L)[24:40:8]; 40170000 - PROCEDURE EMIT3(LINK); VALUE LINK; INTEGER LINK; 40171000 - COMMENT EMIT3, ALSO KNOWN AS EMITLINK, EMITS THREE SYLLABLES. IF 40172000 - WE ARE LISTING THE CODE, THE LISTING WILL SAY THAT IT IS A 40173000 - LINK; 40174000 - BEGIN 40175000 - IF DEBUGTOG THEN BUGOUT(7, LINK.[24:8],L,LINK.[32:16],0); 40176000 - PUTSYL(LINK.[24:8]); IF L~L+1 } 49148 THEN FLAG(400); 40177000 - PUTSYL(LINK.[32:8]); L ~ L + 1; 40178000 - PUTSYL(LINK); L ~ L + 1; 40179000 - END EMITLINK; 40180000 - PROCEDURE EMIT1P(OP,A); VALUE OP,A; INTEGER OP,A; 40181000 - BEGIN 40182000 - IF OP > 255 THEN 40183000 - IF OP < 512 THEN EMIT(VARI); 40184000 - IF DEBUGTOG THEN BUGOUT(3,OP,A,0,0); 40185000 - PUTSYL(OP); L~L + 1; PUTSYL(A); 40186000 - IF L ~ L + 1 } 49150 THEN FLAG(400) 40187000 - END; 40188000 - PROCEDURE EMIT2P(OP,A,B); VALUE OP,A,B; INTEGER OP,A,B; 40189000 - BEGIN 40190000 - IF OP > 255 THEN 40191000 - IF OP < 512 THEN EMIT(VARI); 40192000 - IF DEBUGTOG THEN BUGOUT(4,OP,A,B,0); 40193000 - PUTSYL(OP); L ~ L + 1; PUTSYL(A); L ~ L + 1; PUTSYL(B); 40194000 - IF L ~ L + 1 } 49150 THEN FLAG(400) 40195000 - END EMIT2P; 40196000 - PROCEDURE EMIT3P(OP,A,B,C); VALUE OP,A,B,C; INTEGER OP,A,B,C; 40197000 - BEGIN 40198000 - IF OP > 255 THEN 40199000 - IF OP < 512 THEN EMIT(VARI); 40200000 - IF DEBUGTOG THEN BUGOUT(5,OP,A,B,C); 40201000 - PUTSYL(OP); L ~ L + 1; PUTSYL(A); L ~ L + 1; 40202000 - PUTSYL(B); L ~ L + 1; PUTSYL(C); 40203000 - IF L ~ L + 1 } 49150 THEN FLAG(400) 40204000 - END EMIT3P; 40205000 - PROCEDURE EMIT4P(OP,A,B,C,D); VALUE OP,A,B,C,D; 40206000 - INTEGER OP,A,B,C,D; 40207000 - BEGIN 40208000 - IF OP } 256 THEN IF OP < 512 THEN EMIT(VARI); 40208100 - IF DEBUGTOG THEN BUGOUT(8,OP,A,B,C&D[16:40:8]); 40209000 - PUTSYL(OP); L ~ L + 1; PUTSYL(A); L ~ L + 1; PUTSYL(B); 40210000 - L ~ L + 1; PUTSYL(C); L ~ L + 1; PUTSYL(D); 40211000 - IF L ~ L + 1 > 49150 THEN FLAG(400); 40212000 - END EMIT4P; 40213000 - PROCEDURE EMITBUZEVENT; 40214000 -COMMENT EMITS CODE WHICH BUZZES LOCK BIT IN AN EVENT. CODE HAS 40215000 - PREVIOUSLY BEEN EMITTED TO PLACE POINTER(INDEXED DD OR IRW) TO 40216000 - EVENT IN TOS. THE BUZZ IS IN NORMAL STATE; 40217000 - BEGIN 40218000 - INTEGER TI1; 40219000 - EMIT(ZERO); 40220000 -COMMENT **** 40220200 - EMIT(EEXI); 40221000 - TI1~L; 40222000 - EMIT(DEL); 40223000 - EMIT(DUPL); 40224000 - EMIT(ONE); 40225000 - EMIT(RDLK); 40226000 - EMIT(DUPL); 40227000 -COMMENT IN TOS AT THIS POINT-TWO POINTERS TO EVENT,TWO COPIES OF FIRST 40228000 - WORD OF EVENT; 40229000 - EMITB(BRTR,BUMPL,TI1); % END OF EVENT BUZZ LOOP 40230000 - EMIT(ZERO); EMIT(STAG); %ZOT THE D.P. TAG 40230500 -COMMENT **** 40230520 - EMIT(DEXI); 40231000 -COMMENT IN TOS AT THIS POINT-POINTER TO EVENT(IRW OR INDEXED DD),FIRST 40232000 - WORD OF EVENT(WITH DOUBLE TAG); 40233000 - END EMITBUZEVENT; 40234000 - PROCEDURE EMITMICRO(WORD); VALUE WORD; ALPHA WORD; 40236000 - BEGIN 40237000 - DEFINE P1 = WORD.[35:8]#, 40238000 - P2 = WORD.[27:8]#, 40239000 - P3 = WORD.[19:8]#, 40240000 - OP = WORD.[44:4]+719 #, 40241000 - N = WORD.[17:2]#; 40242000 - INTEGER J; 40243000 - J ~ WORD.[1:16]; 40244000 - DO CASE REAL(J!0)|4 + N OF 40245000 - BEGIN 40246000 - EMIT(OP); 40247000 - EMIT1P(OP,P1); 40248000 - EMIT2P(OP,P1,P2); 40249000 - EMIT3P(OP,P1,P2,P3); 40250000 - EMIT1P(OP,MIN(J,255)); 40251000 - EMIT2P(OP,MIN(J,255),P1); 40252000 - EMIT3P(OP,MIN(J,255),P1,P2); 40253000 - EMIT4P(OP,MIN(J,255),P1,P2,P3) 40254000 - END CASE UNTIL J ~ J - 255 { 0; 40255000 - END EMITMICRO; 40256000 - PROCEDURE PRINTSPACE(ID,LL,DISP); VALUE ID,LL,DISP; 40260000 - ALPHA ID,LL,DISP; 40261000 - BEGIN INTEGER X; DEFINE H = HEXOUT #; 40262000 - BLANKOUT(16,LBUFF); 40263000 - IF ID ! 0 THEN 40264000 - IF ID < 0 THEN INSERT(X~6, ID,LBUFF[0],0) ELSE 40265000 - MOVECHARACTERS(X~TAKE(ID+1).CHRCNT,INFO[ID.LINKR,ID.LINKC+1],4,40266000 - LBUFF[0],0); 40267000 - INSERT(5,H(LL|16)+"=(00,",LBUFF[ID~X.[39:6]],X~X.[45:3]); 40268000 - INSERT(5,H(DISP|16)+")",LBUFF[ID],X+5); 40269000 - 40270000 - 40271000 - WRITELBUFF; 40272000 - END PRINTSPACE; 40273000 -COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 44000000 - SERVICE ROUTINES 44001000 - * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;44002000 - COMMENT FLAG WRITES ERROR MESSAGES ON THE PRINTER, USUALLY; 44003000 - PROCEDURE FLAG(NR); VALUE NR; INTEGER NR; 44004000 - IF ERRORTOG THEN 44004100 - BEGIN STREAM PROCEDURE EDITERR(N,C,W,L,S); VALUE N,C,S; 44005000 - BEGIN 44006000 - DI ~ L; 8(DS ~ 2 LIT ">"); 44(DS ~ 2 LIT " "); 44007000 - 8(DS ~ 2 LIT "<"); DS ~ 2 LIT " "; SI ~ S; DS ~ 8 CHR; 44008000 - DI~W; DI~DI+C; DS~14 LIT"~ERROR NUMBER "; 44009000 - SI~LOC N; DS~3 DEC; DS~LIT"."; SI~S;SI~SI-16;DI~S; DS~WDS;44010000 - END; 44011000 - STREAM PROCEDURE PREPERR(LBUFF); 44012000 - BEGIN DI ~ LBUFF; DS ~ 16 LIT ".DEFINED TO BE: "; 44013000 - 38(DS ~ 4 LIT " ") 44014000 - END PREPERR; 44015000 - INTEGER J,K,C,W,START; 44016000 - IF DEFINEINDEX>0 THEN 44017000 - BEGIN GT1~(GT2~DEFINEARRAY[2]).[30:18]; % GT1=NCR 44018000 - GT2~GT2.[12:18]; % GT2=LCR 44019000 - GT3~DEFINEARRAY[0] % GT3=LASTUSED 44020000 - END ELSE 44021000 - BEGIN GT1~NCR; GT2~LCR; GT3~LASTUSED END; 44022000 - IF NOT LISTOG THEN 44023000 - BEGIN IF LISTOG.[46:1] THEN DATIME; LISTOG~FALSE; 44024000 - BLANKOUT(16, LBUFF); 44024100 - ZOT(EXAMINE(LASTSEQUENCE),GT2); 44025000 - EDITLINE(GT2-9,GT3,0,0,0,0,LBUFF); 44026000 - ZOT("%",GT2); 44027000 - WRITELBUFF 44028000 - END FORCED LISTING; 44029000 - EDITERR(NR,GT1.[30:3],LBUFF[GT1-GT2+11],LBUFF,LASTSEQUENCE 44030000 - +2); 44031000 - WRITELBUFF; 44032000 - FOR J ~ 3 STEP 3 UNTIL DEFINEINDEX DO 44033000 - BEGIN PREPERR(LBUFF); K ~ 1; 44034000 - IF J < DEFINEINDEX THEN 44035000 - BEGIN W ~ DEFINEARRAY[J].[CF]; 44036000 - C ~ DEFINEARRAY[J+2].[30:3] 44037000 - END ELSE 44038000 - BEGIN W ~ LASTUSED; C ~ NCR.[30:3] END; 44039000 - IF W - START ~ DEFINEARRAY[J-3].[FF] > 8 THEN START ~W-8; 44040000 - WHILE START ~ START + 1 < W DO 44041000 - MOVE(1,ADDL[START.LINKR,START.LINKC],LBUFF[K~K+1]); 44042000 - MOVECHARACTERS(C,DEFINEARRAY[J-2],0,LBUFF[K+1],0); 44043000 - WRITELBUFF 44044000 - END OF PRINTING DEFINED STUFF; 44045000 - ERRORCOUNT~ERRORCOUNT+1; 44046000 - IF DUMPTOG THEN DUMPIT(LBUFF); 44047000 - ERRORTOG ~ FALSE; 44047100 - END FLAG; 44048000 - INTEGER PROCEDURE GETSPACE(LEVEL); VALUE LEVEL; INTEGER LEVEL; 44049000 - COMMENT GETSPACE ASSIGNS STACK SPACE AND RETURNS THE ADDRESS-FIELD 44050000 - VALUE FOR THAT SPACE. THE PARAMETER, LEVEL, INDICATES THE 44051000 - ADDRESSING LEVEL AT WHICH THE SPACE IS TO BE ALLOCATED. 44052000 - HOWEVER, IF AN ADDRESS PART IS GIVEN IN THE SOURCE, IT WILL 44053000 - OVERRIDE THE NORMAL ALLOCATION: IF THE PARAMETER HAS ITS SIGN 44054000 - BIT ON, HOWEVER, WE WILL NOT LOOK FOR AN ADDRESS PART. THE 44055000 - EXPONENT-SIGN BIT IS ON IF TWO SPACES ARE NEEDED, AS FOR 44055100 - DOUBLE PRECISION. THE 44055200 - CALLER IS INFORMED OF THE EXISTANCE OF THE ADDRESS PART VIA THE44056000 - SIGN BIT OF THE RESULT; 44057000 - BEGIN 44058000 - INTEGER ADRF; COMMENT THE DISPLACEMENT FIELD; 44059000 - INTEGER N; COMMENT # SPACES NEEDED; 44059100 - LABEL ON; 44060000 - BOOLEAN B; 44061000 - N ~ LEVEL.[2:1] + 1; 44061100 - IF B ~ LEVEL.[1:1] = 0 THEN 44062000 - IF TABLE(I+1) = RELOP THEN % ADDR PART JUST MIGHT BE THERE. 44063000 - IF ELBAT[I+1].DISP ! EQUL THEN 44064000 - FLAG(408) ELSE % OOPS--WRONG RELATIONAL. 44065000 - BEGIN STEPIT; % PAST THE "=". 44066000 - ADRF~CONTEXT; CONTEXT~2; %LET THE SCANNER WORK RIGHT. 44067000 - STEPIT; % GET THE NEXT THING. 44068000 - CONTEXT ~ ADRF; % UNFUTZ THE SCANNER. 44069000 - IF ELCLASS < IDMAX THEN % ID COPY ADDRESS 44070000 - IF ELBAT[I].ADDRESS = 0 THEN % BUT THE ADDRESS IS BAD NEWS44071000 - FLAG(407) ELSE 44072000 - IF ELBAT[I].LINK < FIRSTINFO THEN FLAG(408) ELSE 44072100 - BEGIN 44073000 - LEVEL ~ ELBAT[I].LVEL; 44074000 - ADRF ~ -ELBAT[I].DISP & ELBAT[I] [35:2:1]; 44075000 - IF TABLE(I+1) = ADDOP THEN 44075100 - BEGIN 44075200 - STEPIT; 44075300 - IF STEPI ! NUMBER THEN FLAG(408) ELSE 44075400 - ADRF ~(IF ELBAT[I-1].ADDRESS=ADD THEN -THI 44075500 - ELSE THI) + ADRF; 44075600 - END; 44075700 - GO ON 44076000 - END IDENTIFIER AS ADDRESS PART; 44077000 - IF ELCLASS ! LFTPRN THEN 44078000 - FLAG(408) ELSE 44079000 - BEGIN 44080000 - IF STEPI = ADDOP THEN % IS + OR - 44081000 - IF ELBAT[I].ADDRESS ! SUBT THEN % 44082000 - FLAG(408) ELSE % IT WAS +: ERROR 44083000 - IF STEPI ! NUMBER THEN % NOT A NUMBER IS BAD. 44084000 - FLAG(408) ELSE % 44085000 - LEVEL ~ LEVEL - THI ELSE % NUMBER IS RELATIVE. 44086000 - IF ELCLASS ! NUMBER THEN % WAS NOT SIGN (+ OR -). 44087000 - FLAG(408) ELSE 44088000 - LEVEL ~ THI; % UNSIGNED NR IS ABSOLUTE. 44089000 - IF LEVEL < 0 OR 44090000 - LEVEL > CURRENT THEN 44091000 - FLAG(407); 44092000 - IF STEPI ! RTPARN THEN % CHECK FOR DISPLACEMENT. 44093000 - IF ELCLASS ! COMMA THEN 44094000 - FLAG(408) ELSE 44095000 - BEGIN 44096000 - IF STEPI ! NUMBER THEN 44097000 - FLAG(408) ELSE ADRF ~-THI; 44098000 - IF STEPI ! RTPARN THEN FLAG(408); 44099000 - GO ON 44100000 - END ELSE % NO DISP GIVEN 44101000 - BEGIN 44102000 - IF STACKTOP[LEVEL] ~-(ADRF~-STACKTOP[LEVEL])+ N 44103000 - > MAXSTACK[LEVEL] THEN 44104000 - MAXSTACK[LEVEL] ~ STACKTOP[LEVEL]; 44105000 - GO ON 44106000 - END; END; END ABNORMAL ALLOCATION; 44107000 - IF STACKTOP[LEVEL~ABS(LEVEL)] ~(ADRF ~ STACKTOP[LEVEL]) + N 44108000 - > MAXSTACK[LEVEL] THEN 44109000 - MAXSTACK[LEVEL] ~ STACKTOP[LEVEL]; 44110000 - ON: IF ABS(ADRF) > MAXDISP THEN FLAG(410); 44111000 - IF PRTOG THEN IF NOT B THEN PRINTSPACE(0,LEVEL,ADRF); 44112000 - GETSPACE ~ ADRF & LEVEL [30:42:6] & ADRF [29:35:1]; 44113000 - END GETSPACE; 44114000 - PROCEDURE MOVECODE(E,T); ARRAY E,T[0,0]; 44115000 - BEGIN REAL Q; STREAM PROCEDURE FAKEIT(T,Q); 44116000 - BEGIN SI~LOC T; DI~Q; DS~WDS; TALLY~1; Q~TALLY; CI~CI+Q; 44117000 - DS ~ 48 LIT 44118000 - "10YH+A|8+A-E+E0@8EH)*/}V|8+AYH+A-E+E0@8E}V4A4A4(" 44119000 - END FAKEIT; FAKEIT(T,Q) 44120000 - END MOVECODE; 44121000 - REAL PROCEDURE TAKE(N); VALUE N; INTEGER N; 44122000 - TAKE ~ INFO[N.LINKR, N.LINKC]; 44123000 - PROCEDURE PUT( ENTRY,AT); VALUE ENTRY,AT; INTEGER ENTRY,AT; 44124000 - INFO[AT.LINKR, AT.LINKC] ~ ENTRY; 44125000 - PROCEDURE JUMPCHKX; 44126000 - COMMENT JUMPCHKX AND JUMPCHKNX HANDLE BRANCHING AROUND NON-EXECUTABLE 44127000 - CODE, SUCH AS PROCEDURE DECLARATIONS, THUNKS, ETC. JUMPCHKX 44128000 - IS CALLED IMMEDIATELY PRIOR TO EMITTING EXECUTABLE CODE: HE 44129000 - WILL, IF THERE HAS BEEN ANY NON-EXECUTABLE CODE EMITTED, GO 44130000 - BACK AND FIX UP A BRANCH. HE ALSO NOTICES WHETHER THIS IS THE 44131000 - FIRST EXECUTABLE CODE, AND REMEMBERS WHERE IT IS; 44132000 - IF FIRSTX < 0 THEN % FIRST EXECUTABLE CODE 44133000 - FIRSTX ~ L ELSE % SO MARK IT. 44134000 - IF LASTX } 0 THEN % THERE IS A BRANCH HANGING 44135000 - BEGIN EMITB(BRUN,LASTX, L); % SO FILL IT IN. 44136000 - IF FIRSTMT < 0 THEN % WE HAVENT DONE A STATEMENT YET 44137000 - LASTX ~ -1 % SO FORGET LASTX. 44138000 - END JUMPCHKX; 44139000 - PROCEDURE JUMPCHKNX; 44140000 - COMMENT JUMPCHKNX IS CALLED PRIOR TO EMITTING NON-EXECUTABLE CODE. HE 44141000 - LEAVES TRACKS, IF NECESSARY, FOR JUMPCHKX TO USE; 44142000 - IF FIRSTX } 0 THEN % THERE HAS BEEN EXECUTABLE CODE 44143000 - IF FIRSTMT } 0 THEN % WE HAVE SEEN A STATEMENT 44145100 - EMITB(BRUN,LASTX~BUMPL,FIRSTMT) ELSE 44145200 - IF LASTX < 0 THEN LASTX ~ BUMPL; 44145300 - 44146000 - 44147000 - 44148000 - 44149000 - 44150000 - PROCEDURE PUTADDL(ENTRY,LINK); VALUE ENTRY; 44151000 - INTEGER LINK; 44152000 - REAL ENTRY; 44153000 - BEGIN 44154000 -COMMENT PUTADDL INSERTS ENTRY AT LINK IN ADDL AND THEN UPDATES LINK BY 44155000 - ONE: 44156000 - ADDL[LINK.LINKR,LINK.LINKC] ~ ENTRY; 44157000 - LINK ~ LINK+1 44158000 - END PUTADDL; 44159000 - REAL PROCEDURE GIT(X); VALUE X; INTEGER X; 44160000 - COMMENT GIT RETURNS ADDL[X]; 44161000 - GIT ~ ADDL[X.LINKR,X.LINKC]; 44162000 - DEFINE RANGE(RANGE1,RANGE2)= 44163000 - ((RANGE1){ ELCLASS AND (RANGE2)} ELCLASS)#; 44164000 - 44165000 -COMMENT SCATTERELBAT CARVES UP THE ELBATWORD; 44166000 -PROCEDURE SCATTERELBAT; 44167000 - BEGIN 44168000 - REAL T; 44169000 - T ~ ELBAT[I]; 44170000 - KLASSF ~ T.CLASS; 44171000 - TYPEF ~ T.TYPE; 44172000 - FORMALF ~TYPEF=FORMALNAMEP OR TYPEF=FORMALNAMEQ; 44173000 - VONF ~ TYPEF=FORMALVALUEP OR TYPEF=FORMALVALUEQ; 44174000 - ITEMF ~ TYPEF=FORMALNAMEQ OR TYPEF=FORMALVALUEQ; 44174100 - ADDRSF ~ T.ADDRESS; 44175000 -COMMENT*** NOT ALL FIELDS ARE REFERENCED THIS MAY BE CHANGED; 44176000 - END SCATTERELBAT; 44177000 - PROCEDURE SEGMENT(IDINX, SIZE, EDOC); VALUE IDINX, SIZE; 44178000 - INTEGER IDINX, SIZE; ARRAY EDOC[0, 0]; 44178100 - COMMENT SEGMENT COPIES EDOC INTO THE TEMPORARY CODE FILE,TEMP. IT 44179000 - ALSO PUTS A MESSAGE OUT, ONTO THE PRINTER FILE, IF WE ARE 44180000 - LISTING THE PROGRAM. IDINX IS THE INFO INDEX OF THE ID OF THE 44181000 - SEGMENT, IF APPLICABLE, OR ZERO IF THE SEGMENT IS NOT NAMED; 44182000 - BEGIN 44183000 - INTEGER I,M; 44184000 - DEFINE CNT= CHRCNT#, LBUF= LBUFF#; 44185000 - IF LISTOG THEN 44186000 - BEGIN 44187000 - BLANKOUT(16,LBUFF); 44188000 - IF IDINX = 0 THEN INSERT(5,"BLOCK",LBUFF[12],4) ELSE 44189000 - IF IDINX =-1 THEN INSERT(5," DATA",LBUFF[12],4) ELSE 44189100 - MOVECHARACTERS(I~TAKE(IDINX).CNT,INFO[IDINX.LINKR, 44190000 - IDINX.LINKC],4,LBUF[13-(I+7).[41:4]], 44191000 - IF I MOD 8 ! 0 THEN 8 - I MOD 8 ELSE 0); 44192000 - INSERT(2,"IS",LBUF[13],2); 44193000 - ZN9N(SIZE,4,3,LBUF[13],5); 44194000 - INSERT(5,"LONG.",LBUFF[14],2); 44195000 - WRITELBUFF 44196000 - END LISTOG ACTION; 44197000 - IF ERRORCOUNT = 0 THEN 44197100 - WRITEFILE(TEMP,EDOC,0,SIZE-1); 44205000 - TEMPADDR ~ (SIZE+29) DIV 30 + TEMPADDR 44206000 - END SEGMENT; 44207000 -PROCEDURE ERR(N); VALUE N; INTEGER N; 44208000 - COMMENT ERR, IS THE SAME AS FLAG EXCEPT THAT IT MAKES AN ATTEMPT TO 44209000 - RECOVER FROM ERROR SITUATIONS BY SEARCHING FOR A SEMICOLON, 44210000 - END, OR BEGIN 44211000 - N- ERROR NUMBER; 44212000 - BEGIN FLAG(N); 44213000 - I~I-1; 44214000 - IF N=400 THEN GO ENDOFITALL; 44215000 - DO IF STEPI=BEGINV THEN STATEMENT 44216000 - UNTIL ELCLASS=ENDV OR ELCLASS=SEMICOLON; 44217000 - END ERR; 44218000 - PROCEDURE PLACE(WORD)" INTO ADDL AT "(INX); VALUE WORD,INX; 44219000 - REAL WORD,INX; 44220000 - ADDL[INX.LINKR,INX.LINKC] ~ WORD; 44221000 - PROCEDURE SEGDICT(SEGNO,DKADDR,SIZE,PBIT); 44222000 - VALUE SEGNO,DKADDR,SIZE,PBIT; 44223000 - INTEGER SEGNO,DKADDR,SIZE,PBIT; 44224000 - COMMENT SEGDICT MAKES A PDPRT ENTRY FOR A PROGRAM SEGMENT. 44225000 - IF LISTING IS GOING ON, WITH "PRTOG" TURNED ON, THEN HE 44226000 - MAKES REMARKS ON THE PRINTER FILE ABOUT THE ENTRIES; 44227000 - BEGIN 44228000 - LABEL HAIRY; 44228100 - PDPRT[PDINX.LINKR,PDINX.LINKC]~ SEGNO& 44229000 - DKADDR[23:35:13]& 44230000 - SIZE[10:35:13]& 44231000 - (IF XTRNL THEN 4 ELSE 6)[2:45:3] & 44231100 - PBIT[8:47:1]; 44232000 - PDINX ~ PDINX + 1; 44233000 - IF PRTOG THEN 44234000 - BEGIN 44235000 - BLANKOUT(16,LBUFF); 44236000 - INSERT(3,"(0,",LBUFF[7],0); 44242100 - INSERT(5,HEXOUT(SEGNO|16)+")",LBUFF[7],3); 44242200 - INSERT(7,"SEGDESC",LBUFF[8],3); 44242300 - INSERT(6,HEXOUT(SIZE.[32:16]&PBIT[24:47:1]),LBUFF[10],6); 44242400 - INSERT(6,HEXOUT(DKADDR&SIZE[24:44:4]),LBUFF[11],4); 44242500 - INSERT(1,3,LBUFF[10],4); 44242600 - WRITELBUFF 44243000 - END END OF SEGMENT DICTIONARY ENTRY; 44244000 -PROCEDURE FLUSHPOOL; 44244100 -BEGIN 44244150 - LABEL TOMAKEABLOCK; 44244160 - PDPRT[PPINX] ~ POOLMOM & TEMPADDR[23:35:13] & 44244200 - (POOLX~POOLX+1)[10:35:13]&1[7:47:1]&REAL(POOLTOG)[8:47:1]; 44244250 - PDINX ~ PDINX+1; 44244300 - IF POOLTOG THEN SAVESIZE ~ SAVESIZE +POOLX; 44244320 - SEGMENT(-1, POOLX, POOL); 44244350 - POOLX ~ POOLMOM ~ 0; 44244400 -END FLUSHPOOL; 44244450 - INTEGER PROCEDURE NEWSEG(AT); 44245000 - VALUE AT; INTEGER AT; 44246000 - COMMENT NEWSEG DOES THE HOUSEKEEPING STUFF INVOLVED WITH FINDING A 44247000 - NEW SEGMENT NUMBER AND INFORMING THE PROGRAMMER; 44248000 - BEGIN 44249000 - INTEGER N; 44250000 - NEWSEG ~ N~ GETSPACE(-0); 44251000 - IF LISTOG THEN 44252000 - BEGIN 44253000 - BLANKOUT(16,LBUFF); 44254000 - INSERT(2,"IS", LBUFF[12],6); 44255000 - INSERT(7,"SEGMEMT",LBUFF[13],1); 44256000 - INSERT(5,HEXOUT (N),LBUFF[14],1); 44257000 - IF AT = 0 THEN 44258000 - INSERT(5,"BLOCK",LBUFF[12],0) ELSE 44259000 - MOVECHARACTERS(GT1~TAKE(AT).CHRCNT, INFO[AT.LINKR,AT.LINKC44260000 - ],4,LBUFF[5],61 - GT1); 44261000 - WRITELBUFF 44262000 - END END NEW SEGMENT NUMBER ASSIGNMENT; 44263000 - PROCEDURE GLOBALPCW(MOM,SEGNO,L,STATE); 44264000 - VALUE MOM,SEGNO,L,STATE; INTEGER MOM,SEGNO,L,STATE; 44265000 - COMMENT GLOBALPCW MAKES A PDPRT ENTRY FOR A LEVEL-0 PROGRAM 44266000 - CONTROL WORD, AND NOTES THAT FACT ON THE PRINTER(SOMETIMES44267000 - ; 44268000 - BEGIN LABEL ECH; 44269000 - DEFINE H = HEXOUT#; 44269050 - IF SEPARATOG THEN 44269100 - IF PRTOG THEN 44269200 - BEGIN 44269300 - SEGNO~PCW.[35:13]; 44269400 - L ~PCW.[15:13]|6 + PCW.[12:3]; 44269500 - END ELSE ELSE 44269600 - BEGIN 44269700 - IF SVINFO THEN 44269800 - PCW~SEGNO&(L DIV 6)[15:35:13]&(GTI1~L MOD 6)[12:45:3]& 44269900 - STATE[28:47:1]&1[33:47:1]; 44269990 - PDPRT[PDINX.LINKR,PDINX.LINKC]~MOM & 44270000 - SEGNO[24:36:12]& 44271000 - L[7:31:17]& 44272000 - (IF XTRNL THEN 1 ELSE 7)[2:45:3]& 44272100 - STATE[6:47:1]; 44273000 - PDINX ~ PDINX + 1; 44274000 - END; 44274010 - IF PRTOG THEN 44275000 - BEGIN 44276000 - BLANKOUT(16,LBUFF); 44277000 - GTI1 ~ L MOD 6; 44285000 - INSERT(3,"(0,",LBUFF[7],0); 44285100 - INSERT(5,H(MOM|16)+")",LBUFF[7],3); 44285200 - INSERT(3,"PCW",LBUFF[8],3); 44285300 - INSERT(6,H((L~L DIV 6)|256)+GTI1+832,LBUFF[9],1); 44285400 - INSERT(6,H(L.[35:9]>I1[36:45:3]),LBUFF[10],6); 44285500 - INSERT(6,H(SEGNO&1[33:47:1]&STATE[28:47:1]&L[24:44:4]), 44285600 - LBUFF[11],4); 44285700 - INSERT(1,7,LBUFF[10],4); 44285800 - WRITELBUFF 44286000 - END END OF REMEMBERING A GLOBAL PCW; 44287000 - PROCEDURE FIRSTATEMENT; 44288000 - COMMENT FIRSTATEMENT IS CALLED TO MARK THE EXISTENCE OF THE FIRST 44289000 - STATEMENT IN A BLOCK OR PROCEDURE; 44290000 - BEGIN 44290100 - IF FIRSTX < 0 THEN FIRSTMT ~ L ELSE 44291000 - EMITB(BRUN,IF LASTX < 0 THEN LASTX ~ BUMPL ELSE LASTX, 44292000 - FIRSTMT ~ L); 44293000 - IF CURRENT > 0 THEN 44293100 - BEGIN EMIT(ZERO); EMITNUM(6); EMIT(STAG) END; 44293200 - 44293300 - EMIT(PUSH) END; 44294000 -PROCEDURE FILLPOOL; 44300000 -BEGIN REAL I; 44301000 - IF POOLMOM = 0 THEN POOLMOM ~ GETSPACE(-0) ELSE 44302000 - IF POOLX+TAX > POOLMAX THEN 44303000 - BEGIN 44304000 - FLUSHPOOL; 44305000 - POOLX ~ 0; POOLMOM ~ GETSPACE(-0); 44306000 - END; 44307000 - EMITNUM(POOLX); 44308000 - EMITN(POOLMOM); 44309000 - EMIT(INDX); 44310000 - EMITNUM(MAXCSZ DIV 2); EMITR(42, 3); 44310300 - POOLX ~ (GT2~POOLX)+TAX; 44311000 - DO 44312000 - BEGIN 44312100 - MOVE(I~MIN( TAX.LINKC,256-TAX.LINKC),TA, 44313000 - POOL[GT2.LINKR,GT2.LINKC]) ; 44314000 - GT2 ~ GT2 + I; 44314100 - END 44314200 - UNTIL TAX~TAX-I { 0; 44315000 -END FILLPOOL; 44316000 - INTEGER PROCEDURE GETSTACK; 44317000 - BEGIN 44318000 - REAL GT1,GT2; 44319000 - LABEL EXIT; 44320000 - FOR GT1 ~ 0 STEP 1 UNTIL MAXTEMP DO 44321000 - BEGIN 44321100 - IF GT2~TEMPSTACK[GT1] = 0 THEN 44322000 - IF CURRENT = 0 THEN 44322100 - BEGIN GETSTACK ~TEMPSTACK[GT1] ~ - GETSPACE(-0); 44322200 - GO EXIT; 44322300 - END ELSE 44322400 - BEGIN 44323000 - EMITLINK(0&BRUN[24:40:8]); GT2 ~ L; 44323090 - JUMPCHKX; 44323100 - GETSTACK~TEMPSTACK[GT1]~-GETSPACE(- CURRENT); 44324000 - EMIT(ZERO); 44324100 - JUMPCHKNX; 44324200 - EMITB(GET(GT2-3),GT2,L); 44324300 - GO TO EXIT; 44325000 - END; 44326000 - IF GT2 > 0 THEN 44327000 - BEGIN 44328000 - IF GT2.[31:5] = CURRENT THEN 44329000 - BEGIN 44330000 - GETSTACK~TEMPSTACK[GT1]~ -GT2; 44331000 - IF PRTOG THEN PRINTSPACE 44331100 - (-"TEMP ",CURRENT,GT2.[36:12]); 44331200 - GO TO EXIT; 44332000 - END; 44333000 - END; 44334000 - END; 44334100 - FLAG(415); 44334200 - EXIT: 44335000 - END GETSTACK; 44336000 - PROCEDURE RTNSTACK(ADR); VALUE ADR; REAL ADR; 44350000 - FOR GT1 ~ 0 STEP 1 UNTIL MAXTEMP DO 44351000 - IF TEMPSTACK[GT1] = ADR THEN 44352000 - BEGIN 44354000 - TEMPSTACK[GT1] ~ ABS(ADR); 44355000 - GT1 ~ MAXTEMP + 1; 44356000 - END; 44357000 - BOOLEAN PROCEDURE FUTZALABEL; 46000000 - COMMENT FUTZALABEL TRIES TO DO A DEFAULT DECLARATION ON THE 46001000 - THING IN ACCUM, AS A LABELID. IT RETURNS TRUE IFF IT 46002000 - FAILS; 46003000 - BEGIN LABEL PHONY; 46004000 - FUTZALABEL ~ TRUE; COMMENT PREPARE FOR FAILURE; 46005000 - IF ELBAT[I].LINK < NINFOO THEN COMMENT NOT LOCAL; 46006000 - IF NOT BOOLEAN(ELBAT[I].RSVD) THEN COMMENT NOT RESERVED; 46007000 - BEGIN 46008000 - IF LISTOG THEN 46009000 - BEGIN 46010000 - BLANKOUT(14,LBUFF[2]); 46011000 - LABELINE(ACCUM[1],COUNT,LBUFF[0]); 46012000 - WRITELBUFF; 46013000 - END; 46014000 - FUTZALABEL ~ ENTER(0&CURRENT[30:42:6],F0RWARD,LABELID, 46015000 - FALSE); 46016000 - COMMENT WITH THOSE PARAMETERS, ENTER IS FALSE; 46017000 - PUT(GT1 ~ TAKE(LASTINFO) & 0 [33:33:15] , LASTINFO); 46018000 - ELBAT[I] ~ GT1 & LASTINFO [33:33:15]; 46019000 - ELCLASS ~ LABELID; 46020000 - END END FUTZALABEL; 46021000 - BOOLEAN PROCEDURE IFCLAUSE; 50000000 - COMMENT IFCLAUSE TAKES CARE OF " IF THEN", MORE OR LESS. THE 50001000 - CALLER GETS TO BUMP L AND/OR EMIT THE BRANCH. IFCLAUSE 50002000 - WILL, HOWEVER, TELL THE GUY WHAT KIND OF BRANCH TO DO: 50003000 - BRTR OR BRFL; 50004000 - BEGIN STEPIT; COMMENT PAST THE "IF"; 50005000 - BEXP; 50006000 - IF IFCLAUSE ~ LASTNOT = L THEN EMITNOT; 50007000 - IF ELCLASS = THENV THEN STEPIT ELSE FLAG(501) 50008000 - END IFCLAUSE; 50009000 - INTEGER PROCEDURE CASEHEAD; 50010000 - COMMENT CASEHEAD DOES THE SYNTAX-CHECKING AND EMITS SOME OF THE CODE50011000 - FOR THE "CASE OF" CONSTRUCT. IT RETURNS L FOR THE 50012000 - REST OF THE CODE, AND LEAVES SPACE ENOUGH IN EDOC; 50013000 - BEGIN STEPIT; COMMENT PAST THE "CASE"; 50014000 - IF AEXP { XTYPE THEN FLAG(502); 50015000 - IF ELCLASS = OFV THEN STEPIT ELSE FLAG(503); 50016000 - EMIT(DUPL); EMIT(DUPL); EMIT(ZERO); 50017000 - EMIT(GREQ); EMIT(EXCH); 50018000 - L ~ (CASEHEAD ~ L) + 12; 50019000 - END FIRST PART OF CASE HEAD CONSTRUCT; 50020000 - PROCEDURE CASETAIL(MAX,BASE,PLACE); 50021000 - VALUE MAX,BASE,PLACE ; 50022000 - INTEGER MAX,BASE,PLACE ; 50023000 - COMMENT CASETAIL GOES BACK AND PICKS UP WHERE CASEHEAD LEFT OFF. 50024000 - PLACE IS THE L FOR THE FIXUPS, MAX IS THE NUMBER OF ENTRYS50025000 - IN THE BRANCH TABLE, AND BASE IS THE L OF THE BASE OF THE 50026000 - BRANCH TABLE; 50027000 - BEGIN INTEGER LO; 50028000 - LO ~ L; L ~ PLACE; 50029000 - FIGS ~ TRUE; 50029100 - EMITNUM(MAX); EMIT(LSEQ); EMIT(LAND); EMIT(EXCH); 50030000 - EMITNUM(BASE DIV 3); EMIT(ADD); EMIT( DBTR); 50031000 - EMIT(NVLD); 50032000 - L ~ LO 50033000 -; FIGS ~ FALSE; 50033100 - END SECOND PART OF CASE HEAD CODE; 50034000 - PROCEDURE GOGEN(LABELBAT,BRANCHTYPE); 50035000 - VALUE LABELBAT,BRANCHTYPE; 50036000 - REAL LABELBAT,BRANCHTYPE; 50037000 - BEGIN 50038000 - IF (GT1 ~ TAKE(LABELBAT)).TYPE = F0RWARD THEN 50039000 - BEGIN 50040000 - EMITLINK(GT1 & BRANCHTYPE [24:40:8]); 50041000 - PUT(GT1&(L-3)[32:32:16],LABELBAT); 50042000 - END ELSE 50043000 - EMITB(BRANCHTYPE,BUMPL,GT1.[32:16]); 50044000 - END GOGEN; 50045000 - BOOLEAN PROCEDURE SIMPGO; 50046000 - BEGIN 50047000 - LABEL EXIT,INN; 50048000 - IF ELCLASS = GOV THEN 50049000 - BEGIN 50050000 - IF STEPI = TOV THEN STEPIT; 50051000 - IF ELCLASS = LABELID THEN 50052000 - IF ELBAT[I].LINK } NINFOO THEN 50053000 - BEGIN 50054000 - SIMPGO ~ TRUE; 50055000 - GO TO EXIT; 50056000 - END ELSE GO INN ELSE 50057000 - IF FUTZALABEL THEN 50058000 - INN: 50058900 - BEGIN I ~ I - 1; ELCLASS ~ GOV END ELSE SIMPGO ~ TRUE50059000 - END; 50060000 - EXIT: 50061000 - END SIMPGO; 50062000 - PROCEDURE EMITPCW(LEVEL,AD,STATE,SEG ); 50063000 - VALUE LEVEL,AD,STATE,SEG; 50064000 - INTEGER LEVEL,AD,STATE,SEG; 50065000 - COMMENT EMITPCW GENERATES CODE TO MAKE A PCW IN THE STACK; 50066000 - BEGIN 50067000 - 50069000 - LABEL AWAY; 50069100 - PCW ~ SEG & LEVEL [29:43:5] & (AD DIV 6) [15:35:13] 50070000 - & GTI1 ~ AD MOD 6 [12:45:3] & STATE [28:47:1]; 50071000 - IF SEPARATOG THEN GO AWAY; 50071100 - IF DEBUGTOG THEN 50072000 - BUGOUT(10,IF XTRNL THEN LT48 ELSE MPCW,AD,PCW.[1:23],PCW.[24: 50073000 - 24]); 50074000 - PUTSYL(IF XTRNL THEN LT48 ELSE MPCW); 50075000 - WHILE (L ~ L + 1) MOD 6 ! 0 DO PUTSYL(NVLD); 50076000 - EDOC[(L DIV 6).LINKR,(L DIV 6).LINKC] ~ PCW; 50077000 - IF L ~ L + 6 } 49150 THEN FLAG(400); 50078000 - AWAY: 50078900 - END EMITPCW; 50079000 -PROCEDURE WRITEFILE(DKFL,ARY,STARTINX,LASTINX); 50080000 - VALUE STARTINX,LASTINX; 50081000 - REAL STARTINX,LASTINX; 50082000 - FILE DKFL; 50083000 - ARRAY ARY[0,0]; 50084000 -BEGIN 50085000 - DEFINE WRITEDKFL = BEGIN 50086000 - WRITE(DKFL,30,AY[*]); 50087000 - GT1~0; 50088000 - END#; 50089000 - REAL N,GT1,GT2; 50090000 - REAL GP1; 50091000 - LABEL START; 50092000 - GP1~STARTINX.LINKC; 50093000 - GO TO START; 50094000 - DO BEGIN 50095000 - IF (GT1~GT1+N)=30 THEN WRITEDKFL; 50096000 - GP1~IF GT2~STARTINX.LINKC=0 THEN 0 50097000 - ELSE GP1+N; 50098000 - START: MOVE(N~MIN(30-GT1,256-GT2,LASTINX-STARTINX+1), 50099000 - ARY[STARTINX.LINKR,GP1],AY[GT1]); 50100000 - END UNTIL (STARTINX~STARTINX+N)>LASTINX; 50101000 - IF N>0 THEN WRITE(DKFL,30,AY[*]); 50102000 -END OF WRITE FILE; 50103000 -PROCEDURE MAKEARRAYROW; 50200000 - BEGIN 50201000 - REAL T, N, ELBW; 50202000 - LABEL AWAY; 50203000 - IF STEPI}BOOARRAYID AND ELCLASS 1 THEN 50204300 - FLAG(828); 50204350 - IF T!N THEN EMIT(INDX) ELSE 50204400 - BEGIN EMITN(ELBW.ADDRESS); 50204450 - IF ELBW.TYPE=FORMALNAMEP THEN EMIT(EVAL); 50204460 - EMIT(LOAD); 50204470 - END; 50204480 - GO AWAY; 50204500 - END; 50204550 - END; 50204650 - IF T ~ AEXP } XTYPE THEN 50205000 - BEGIN 50206000 - IF T = WTYPE THEN GO AWAY; 50207000 - IF LASTINDEX + 1 = L THEN 50208000 - IF GET(L ~ L - 1) = NXLV THEN 50209000 - BEGIN 50210000 - FIGS ~ TRUE; 50210100 - EMIT(INDX); 50210200 - FIGS ~ FALSE; 50210300 - GO AWAY; 50210350 - END; 50210400 - FLAG(827); 50211000 - END ELSE 50212000 - IF T.[33:15] ! 1 THEN FLAG(829); 50213000 -AWAY: 50214000 - END MAKEARRAYROW; 50222000 -COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 51000000 - EXPRESSIONS 51001000 - * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;51002000 - INTEGER PROCEDURE EXPRSS; 51003000 - COMMENT EXPRSS COMPILES AN EXPRESSION OF SOME SORT: GENERALLY, IT 51004000 - WILL GOBBLE AS MUCH AS IT CAN. IT RETURNS A VALUE TELLING51005000 - WHAT IT DID: 51006000 - ATYPE: SINGLE-PRECISION ARITHMETIC 51007000 - HTYPE: BOOLEAN 51008000 - ETYPE: EXTENDED-PRECISION ARITHMETIC 51009000 - RTYPE: REFERENCE 51010000 - PTYPE: POINTER 51011000 - WTYPE : WORD 51011500 - XTYPE: ARRAY (INDEXABLE); 51012000 - IF ELCLASS = IFV THEN 51013000 - BEGIN IF GT1 ~ EXPRSS ~ IFEXP ! BTYPE THEN 51014000 - IF ELCLASS = RELOP THEN 51015000 - BEGIN RELATION(GT1); EXPRSS ~ BTYPE END 51016000 - END ELSE 51017000 - IF EXPRSS ~ BOOSEC = BTYPE THEN 51018000 - WHILE ELCLASS = LOGOP DO BOOCOMP; 51019000 - INTEGER PROCEDURE IFEXP; 51020000 - COMMENT IFEXP CDMPILES A CONDITIONAL EXPRESSION, AND RETURNS THE 51021000 - TYPE THEREOF. HE ALSO FIXES ANY SINGLE VS DOUBLE PROBLEM;51022000 - BEGIN BOOLEAN B; 51023000 - INTEGER T,TL; 51024000 - B ~ IFCLAUSE; 51025000 - TL ~ BUMPL; 51026000 - IFEXP ~ T ~ EXPRSS; 51027000 - EMITB(IF B THEN BRTR ELSE BRFL,TL,TL~BUMPL); 51028000 - IF ELCLASS ! ELSEV THEN FLAG(504) ELSE STEPIT; 51029000 - EXPRESSION(T); 51030000 - EMITB(BRUN,TL,L); 51031000 - LASTINDEX ~ LASTNOT ~ 0; 51032000 - COMMENT THE ABOVE FUTZING IS TO KEEP CODE DIDDLERS FROM 51033000 - BACKING UP INTO THE CONDITIONAL EXPRESSION; 51034000 - END IFEXP; 51035000 - BOOLEAN PROCEDURE SIMPLEX(KIND); VALUE KIND; INTEGER KIND; 51035100 - COMMENT SIMPLEX COMPILES AN EXPRESSION AND RETURNS THE BIT FROM 51035200 - KIND CORRESPONDING TO THE TYPE THEREOF; 51035300 - SIMPLEX ~ BIT(47 -(IF T~EXPRSS < XTYPE THEN 46 ELSE T),KIND); 51035500 - PROCEDURE EXPRESSION(TYPE); VALUE TYPE; INTEGER TYPE; 51036000 - COMMENT EXPRESSION COMPILES AN EXPR OF THE SPECIFIED TYPE: IF 51037000 - A SINGLE-DOUBLE MISMATCH OCCURS, THE EXPR IS ADJUSTED, 51038000 - OTHER MISMATCHES ARE FLAGGED; 51039000 - BEGIN LABEL ECH; 51040000 - IF TYPE = BTYPE THEN BEXP ELSE 51041000 - IF TYPE=RTYPE OR TYPE.[18:15]=RTYPE THEN GT1~REXP(FALSE) ELSE 51042000 - IF TYPE = WTYPE THEN GT2 ~ EXPRSS ELSE 51042500 - IF TYPE=PTYPE OR TYPE.[18:15]=PTYPE THEN GT1 ~ PEXP(FALSE) ELSE51043000 - IF GT1 ~ AEXP ! TYPE THEN 51044000 - IF(TYPEITYPE OR GT1=BTYPE) AND GT1!WTYPE THEN 51126000 - FLAG(513) 51127000 - END ELSE 51128000 - AEXP ~ SIMPARITH(0); 51129000 - INTEGER PROCEDURE SIMPARITH(T); VALUE T; INTEGER T; 51130000 - COMMENT SIMRARITH COMPILES A SIMPLE ARITHMETIC (OR ARRAY) EXPRESSION, 51131000 - AT LEAST TO THE POINT OF DOING THE ADDING-TYPE OPERATORS. 51132000 - FOR THE CASES WHERE TRE FIRST PRIMARY HAS BEEN COMPILED, T 51133000 - IS PASSED AS OTHER-THAN-ZERO, BEING THE TYPE OF THAT THING. 51134000 - SIMPARITH, AS USUAL, RETURNS THE TYPE OF THE THING; 51135000 - BEGIN 51136000 - INTEGER OP; 51137000 - LABEL AWAY; 51138000 - IF T = 0 THEN 51139000 - BEGIN 51140000 - IF ELCLASS = ADDOP THEN 51141000 - BEGIN OP ~ ELBAT[I].DISP; STEPIT END; 51142000 - IF T ~ TERM(0) < XTYPE THEN 51143000 - IF OP = 0 THEN GO AWAY ELSE FLAG(514); 51144000 - IF OP = SUBT THEN EMIT(CHSN); 51145000 - END ELSE 51146000 - BEGIN IF ELCLASS=FACTOP THEN T ~ FACTOR(T); 51146500 - IF ELCLASS = MULOP THEN T ~ TERM(T); 51147000 - END; 51147500 - WHILE ELCLASS = ADDOP DO 51148000 - BEGIN 51149000 - IF T=WTYPE THEN FLAG(554); 51149500 - OP ~ ELBAT[I].DISP; STEPIT; 51150000 - IF GT1~TERM(0)=WTYPE THEN FLAG(554)ELSE 51151000 - IF GT1=DTYPE THEN T~DTYPE ELSE 51151500 - IF T ! DTYPE THEN T ~ ATYPE; 51152000 - EMIT(OP) 51153000 - END; 51154000 - AWAY: SIMPARITH ~ T 51155000 - END SIMPARITH; 51156000 - INTEGER PROCEDURE TERM(T); VALUE T; INTEGER T; 51157000 - COMMENT TERM HANDLES EITHER ONE ARRAY DESIGNATOR OR A SERIES OF ONE OR 51158000 - MORE PRIMARIES SEPARATED BY MULTIPLYING OPERATORS. IT RETURNS 51159000 - AND GETS PASSED TO JUST LIKE SIMPARITH DOES; 51160000 - BEGIN 51161000 - INTEGER OP; 51162000 - LABEL AWAY; 51163000 - IF T = 0 THEN 51164000 - IF T ~ FACTOR(0) < XTYPE THEN GO AWAY; 51165000 - WHILE ELCLASS = MULOP DO 51166000 - BEGIN 51167000 - IF T =WTYPE THEN FLAG(554); 51167500 - OP ~ ELBAT[I].DISP; STEPIT; 51168000 - IF GT1~FACTOR(0) ELBW.TYPE THEN BOOCOMP ELSE GO ON; 51198000 - ON: IF ELBW.ADDRESS = 0 THEN COMMENT IMP IS A FUNNY; 51199000 - BEGIN EMITNOT; EMIT(LAND); EMIT(LNOT); LASTNOT ~ L END 51200000 - ELSE EMIT(ELBW.ADDRESS); 51201000 - END UNTIL ELBAT[I] ! ELBW; 51202000 - END BOOLEAN COMPLETION; 51203000 - INTEGER PROCEDURE ARITHCOMP(T); VALUE T; INTEGER T; 51204000 - COMMENT ARITHCOMP COMPLETES AN ARITHMETIC EXPRESSION; 51205000 - BEGIN 51206000 - IF ELCLASS = PERIODV THEN COMMENT THE "." OPERATOR; 51206100 - BEGIN IF T = ETYPE THEN FLAG(553); 51206200 - IF STEPI = TAGV THEN BEGIN EMIT(RTAG); 51206250 - IF T!WTYPE THEN T~ITYPE; STEPIT; END ELSE 51206270 - IF GT1 ~ DOTIT = 0 THEN EMIT(DISO) ELSE 51206300 - EMITI(GT1.[36:6], GT1.[42:6]); 51206400 - END; 51206500 - WHILE ELCLASS=AMPERSAND DO LAYITOUT (T); 51207000 - IF T=BTYPE THEN BEGIN 51207300 - IF ELCLASS!THENV AND ELCLASS!COMMA AND (ELCLASSELSEV) THEN BOOCOMP 51207500 - END ELSE 51207600 - 51208000 - IF T =PTYPE THEN PTRCOMP ELSE 51209000 - T ~SIMPARITH (T); 51209500 - ARITHCOMP ~ T 51210000 - END ARITHCOMP; 51211000 -REAL PROCEDURE REXP(BOO); VALUE BOO; BOOLEAN BOO; %BOO IS A KLUDGE 51212000 - COMMENT REXP HANDLES A REFERENCE EXPRESSION. INASMUCH AS THERE ARE NO 51213000 - REFERENCE OPERATORS (EXCEPT ~, WHICH VARIABLE GETS TO HANDLE), 51214000 - THIS IS ALL OF THE REFERENCE-EXPRESSION SYSTEM; 51215000 - BEGIN INTEGER T; 51216000 - LABEL FINI; 51216100 - REXP ~ RTYPE; 51216200 - IF ELCLASS { IDMAX THEN COMMENT WE MAKE A PRELIMINARY TEST TO 51217000 - DIVIDE BETWEEN IDS AND OTHERS; 51218000 - IF ELCLASS=REFID OR ELCLASS=WORDID THEN 51219000 - BEGIN IF(GT1~VARIABLE(FP)).[18:15]!RTYPE AND GT1!WTYPE 51220000 - THEN BEGIN 51220500 - IF BOO AND REXP ~ GT1 = ATYPE THEN GO FINI 51220600 - ELSE FLAG(518) END END ELSE 51220700 - IF ELCLASS}BOOPROCID AND ELCLASS{PTRPROCID THEN BEGIN 51221000 - IF GT1~PROCALL(TRUE,ELCLASS-BOOPROCID)!RTYPE AND GT1!WTYPE THEN51221300 - FLAG(520) END ELSE 51221500 - IF ELCLASS=REFARRAYID OR ELCLASS=WORDARRAYID THEN 51222000 - BEGIN IF(GT1~VARIABLE(FP)).[18:15]!RTYPE AND GT1!WTYPE 51223000 - THEN FLAG(519) END ELSE 51223500 - IF ELCLASS = QUEUEID THEN ENTRYEXPR ELSE 51224000 - IF ELCLASS = QUEUEARRAYID THEN ENTRYEXPR ELSE 51225000 - FLAG(520) ELSE COMMENT THATS ALL THE ID-TYPE THINGS, 51226000 - NOW WE WORK ON THE OTHERS; 51227000 - IF ELCLASS = NULLV THEN % MAKE A GUESS 51228000 - BEGIN EMIT(ZERO); 51229000 - EMITNUM(5); 51230000 - EMIT(STAG); 51231000 - EMITNUM(3); EMITR(47,2); 51231100 - STEPIT 51232000 - END NULLV ELSE 51233000 - IF ELCLASS=QALGID THEN QALGORITHM(0,0,TRUE) ELSE 51233500 - IF ELCLASS = LFTPRN THEN 51234000 - BEGIN STEPIT; 51235000 - IF (GT1~EXPRSS).[FF]!RTYPE AND GT1!RTYPE AND GT1!WTYPE 51236000 - THEN FLAG(521); 51236100 - IF ELCLASS ! RTPARN THEN FLAG(522); 51237000 - STEPIT 51238000 - ;GO TO FINI; 51238100 - END PARENS ELSE 51239000 - IF ELCLASS = CASEV THEN 51240000 - BEGIN IF GT1~CASEXP!RTYPE AND GT1!WTYPE THEN FLAG(523) END ELSE51241000 - IF ELCLASS = IFV THEN 51242000 - BEGIN IF GT1~IFEXP!RTYPE AND GT1!WTYPE THEN FLAG(524) END ELSE 51243000 - IF ELCLASS ! TYPEV THEN FLAG(525) ELSE 51244000 - IF TAKE(ELBAT[I]).LINK ! REFV THEN FLAG(525) ELSE 51245000 - IF STEPI ! LFTPRN THEN FLAG(526) ELSE 51246000 - BEGIN STEPIT; 51247000 - IF GTB1~(T~AEXP)!WTYPE AND T}XTYPE THEN FLAG(527) ELSE 51248000 - IF T.[CF] !1 AND T!WTYPE THEN FLAG(528) ELSE 51249000 - IF ELCLASS ! RTPARN THEN FLAG(522); 51250000 - STEPIT 51251000 - END; 51252000 - WHILE ELCLASS=AMPERSAND DO LAYITOUT(ATYPE); 51252700 - FINI: 51252999 - END REFERENCE EXPRESSION; 51253000 - PROCEDURE ENTRYEXPR; 51254000 - BEGIN COMMENT HANDLES ENTRY EXPRESSIONS, MOST OF THE WORK IS 51254200 - DONE BY QALGORITHM AND ACTUALPARAPART; 51254250 - INTEGER ADDLADRES; 51254500 - LABEL QUIT; 51254700 - ADDLADRES ~ TAKE(ELBAT[I]).LINK; 51255000 - IF ELCLASS = QUEUEARRAYID THEN 51255200 - ADDLADRES ~ ADDLADRES+1; 51255500 -COMMENT *** FIRST WORD OF ADDL FOR A QUEUE ARRAY CONTAINS INFORMATION 51255700 - ON BOUNDS; 51255750 - GT1.NOPAR ~ GIT(ADDLADRES).ITMNOF; 51255900 - IF STEPI ! LFTPRN THEN BEGIN FLAG(543); GO QUIT END; 51256000 - QALGORITHM(1,ADDLADRES,TRUE); 51256200 -COMMENT 1 SAYS CALL IS FROM ENTRYEXP, TRUE SAYS CALL IS NOT FROM 51256220 - STMT, QALGORITHM INVOKES IMPLICIT CALL ON THE ALLOCATE ALL- 51256240 - ORITHM ASSOCIATED WITH THE QUEUE. ALLOCATE GETS SPACE FOR A 51256260 - QUEUE ENTRY AND QALGORITHM EXITS WITH AN INDEXABLE DATA 51256270 - DESCRIPTOR POINTING TO THIS SPACE IN THE TOP OF THE STACK; 51256290 - ACTUALPARAPART(FALSE,ADDLADRES,GT1,FALSE); 51257000 -COMMENT FIRST PARAMETER SAYS QUEUE IS NOT FORMAL, LAST PARAMETER SAYS51257500 - CALL IS FROM ENTRYEXP. ACTUALPARAPART PASSES ACTUAL PARAME 51257520 - -TERS (OR IRWS POINTING TO THEM) TO THE SPACE REFERENCED BY 51257540 - THE DD IN THE TOP OF THE STACK; 51257560 - QUIT: END ENTRYEXPR; 51258000 -REAL PROCEDURE PEXP(BOO); VALUE BOO; BOOLEAN BOO; %BOO IS A KLUDGE 51259000 - BEGIN 51260000 - LABEL EXIT; 51261000 - IF ELCLASS = IFV THEN 51262000 - BEGIN 51263000 - IF PEXP ~ GT1 ~ IFEXP ! PTYPE AND GT1 ! WTYPE THEN 51264000 - BEGIN IF GT1 = ITYPE THEN PEXP~ GT1 ~ ATYPE; 51264050 - IF NOT (BOO AND GT1=ATYPE) THEN FLAG(540); 51264100 - END; 51264150 - IF GT1 = WTYPE THEN PEXP ~ PTYPE; 51264200 - GO TO EXIT; 51265000 - END; 51266000 - PEXP ~ PTRPRIM(BOO); 51267000 - IF ELCLASS = ADDOP THEN PTRCOMP; 51268000 -EXIT: 51269000 - WHILE ELCLASS=AMPERSAND DO LAYITOUT(ATYPE); 51269700 - END PEXP; 51270000 -PROCEDURE PTRCOMP; 51271800 - BEGIN 51272000 - REAL OP; 51273000 - LABEL EXIT; 51274000 - IF ELCLASS ! ADDOP THEN GO TO EXIT; 51275000 - OP ~ ELBAT[I].DISP; 51276000 - STEPIT; 51277000 - IF T ~ AEXP ! ITYPE AND T ! ATYPE THEN FLAG(541); 51278000 - EMIT(EXPU); 51279000 - EMIT(IF OP = ADD THEN SFDC ELSE SRDC); 51280000 -EXIT: 51281000 - END PTRCOMP; 51282000 -PROCEDURE LONGSTRING; 51300000 -BEGIN 51301000 - DEFINE BUMPTAX=IF TAX~TAX+1}POOLMAX THEN ERROR(551)#; 51302000 - LABEL EXIT; 51303000 - TAX ~ 0; 51305000 - DO BEGIN FLOG(THIFLAG,THI,TA[TAX]); 51306000 - BUMPTAX; 51306100 - END 51306200 - UNTIL NOT GOBBLE(TRUE); 51307000 - FLOG(THIFLAG, THI, TA[TAX]); 51308000 - BUMPTAX; 51308100 - COUNT ~ (TAX-1)|48+COUNT; 51309000 - EXIT: 51311000 -END LONGSTRING; 51312000 -PROCEDURE STRINGSOURCE; 51313000 -BEGIN COMMENT COMPILES LONG AND SHORT STRINGS AS SOURCES FOR 51314000 - REPLACE STATEMENTS AND STRING RELATIONS; 51315000 -REAL STREAM PROCEDURE FILLWORD(S,N,R,B,SK,D); 51316000 - VALUE N, R, B, SK; 51317000 -BEGIN 51318000 - DI ~ D; 51319000 - R(SI ~ S; SKIP SK SB; 51320000 - N(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB)); 51321000 - SI ~ S; SKIP SK SB; 51322000 - 8(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB); 51323000 - DI ~ D; SI ~ D; 51324000 - IF SB THEN BEGIN TALLY ~ 1; DS ~ RESET END; 51324100 - FILLWORD ~ TALLY; 51324200 -END FILLWORD; 51325000 - REAL FLG; 51325100 - IF ELCLASS = STRING THEN 51326000 - BEGIN LONGSTRING; FILLPOOL END ELSE 51327000 - BEGIN 51328000 - IF COUNT = 48 OR LEFTY THEN BEGIN 51328010 - FLG ~ REAL(THIFLAG); GT1 ~ THI; 51328020 - END ELSE 51328030 - FLG ~ FILLWORD(THI, COUNT, 48 DIV COUNT, GTI1 ~ 48 MOD 51328100 - COUNT, IF LEFTY THEN 0 ELSE 48 - COUNT, GT1); 51329000 - EMITNUMBER(GT1, FLG); 51330000 - END; 51331000 - COUNT ~ (COUNT+MAXCSZ-1) DIV MAXCSZ; 51332000 - IF MAXCSZ < 4 THEN FLAG(0552); 51333000 -END STRINGSOURCE; 51334000 -PROCEDURE ARRAYROW; 51335000 -BEGIN 51336000 - LABEL EXIT; 51337000 - REAL NDIMS, ELBW; 51338000 - ELBW ~ ELBAT[I]; 51339000 - NDIMS ~ BOUND(ELBW); 51340000 - IF STEPI ! LFTBRKT THEN ERROR(0549); 51341000 - IF SUBSCRIBER(ELBW.ADDRESS, NDIMS) ! 1 THEN ERROR(0550); 51342000 - IF NDIMS = 1 THEN EMITN(ELBW.ADDRESS); 51343000 - EXIT: 51344000 -END ARRAYROW; 51345000 - INTEGER PROCEDURE FACTOR(T); VALUE T; INTEGER T; 51401000 - COMMENT FACTOR WORKS LIKE SIMPARITH AND TERM, HANDLING THE * (RAISED- 51402000 - TO-THE-POWER) OPERATOR; 51403000 - BEGIN 51404000 - INTEGER N; 51404100 - DEFINE T1 = NHI#, T2 = NLO#, L1 = RCOUNT#, L2 = REMCOUNT#; 51404200 - LABEL ON, ROUND; 51405000 - BOOLEAN MINUS; 51406000 - IF T = 0 THEN 51407000 - IF T ~ PRIMARY < XTYPE OR T = WTYPE THEN GO ON; 51408000 - IF ELCLASS = FACTOP THEN 51409000 - IF T = ITYPE THEN T ~ ATYPE; 51410000 - ROUND: 51410500 - WHILE ELCLASS = FACTOP DO 51411000 - BEGIN 51412000 - N ~ REAL(MINUS ~ FALSE); 51413000 - IF STEPI = ADDOP THEN 51414000 - BEGIN MINUS ~ ELBAT[I].DISP = SUBT; STEPIT END; 51415000 - IF ELCLASS ! NUMBER THEN 51416000 - BEGIN 51416020 - IF N ~ PRIMARY ! ITYPE THEN 51416040 - IF N < XTYPE THEN FLAG(573) ELSE EMIT(NTGR); 51416060 - EMITPAIR(T1 ~ GETSTACK, OVRN); 51416080 - EMIT1P(BRST,46); 51416100 - L1 ~ L; EMITPAIR(T2 ~ GETSTACK, OVRN); 51416120 - EMIT(LOG2); EMIT(ONE); EMIT(LSEQ); 51416140 - L2 ~ BUMPL; 51416160 - EMITV(T2); EMITB(BRFL,BUMPL,L+1); EMIT(DUPL); 51416180 - EMIT(DUPL); EMIT(MULT); EMITV(T2); EMITI(38,38); 51416200 - EMITB(BRUN,BUMPL,L1); EMITB(BRTR,L2,L); EMITV(T2); 51416220 - L1 ~ BUMPL; EMITV(T1); EMIT1P(BRST,46); EMIT(CBON); 51416240 - L2 ~ L; EMIT(ONE); EMIT(SUBT); EMITPAIR(T2,STON); 51416260 - EMIT(ONE); EMIT(GREQ); 51416280 - N ~ BUMPL; EMIT(MULT); EMITV(T2); 51416300 - EMITB(BRUN,BUMPL,L2); EMITB(BRFL,L1,L); EMIT(DLET); 51416320 - EMIT(ONE); EMITB(BRFL,N,L); EMITV(T1); 51416340 - EMIT(ZERO); EMIT(LESS); 51416360 - EMITB(IF MINUS THEN BRTR ELSE BRFL,BUMPL,L+3); 51416380 - EMIT(ONE); EMIT(EXCH); EMIT(DIVD); 51416400 - RTNSTACK(T1); RTNSTACK(T2); 51416420 - GO ROUND 51416440 - END X TO THE NONCONSTANT; 51416460 - IF THI.[3:6] ! 0 THEN FLAG(573); 51417000 - WHILE THI.[9:38] ! 0 DO 51418000 - BEGIN 51419000 - EMIT(DUPL); 51420000 - IF BOOLEAN(THI) THEN 51421000 - BEGIN N ~ N + 1; EMIT(DUPL) END; 51422000 - EMIT(MULT); 51423000 - THI ~ THI.[9:38]; 51424000 - END; 51425000 - IF BOOLEAN(THI) THEN 51426000 - WHILE N ~ N - 1 > 0 DO EMIT(MULT) ELSE 51427000 - BEGIN EMIT(DLET); EMIT(ONE) END; 51428000 - IF MINUS THEN 51429000 - BEGIN EMIT(ONE); EMIT(EXCH); EMIT(DIVD) END; 51430000 - STEPIT; 51430100 - END; 51431000 - ON: FACTOR ~ T; 51432000 - END; 51433000 - INTEGER PROCEDURE BITFIDDLE(S); VALUE S; BOOLEAN S; 51450000 - COMMENT THIS IS THE "SET" AND "RESET" HANDLER. S TELLS US WHICH; 51451000 - BEGIN 51454000 - LABEL ECH, OWT; 51455000 - IF STEPI ! LFTPRN THEN FLAG(576); 51456000 - STEPIT; 51457000 - BITFIDDLE ~ EXPRSS; COMMENT THESE GUYS ARE TYPE-TRANSPARENT; 51458000 - IF ELCLASS ! COMMA THEN FLAG(577); 51460000 - IF STEPI = NUMBER THEN 51461000 - BEGIN 51462000 - IF RESULT ! RTPARN THEN GO OWT; 51463000 - IF THI > 47 THEN GO ECH; 51465000 - IF THI.[1:8] ! 0 THEN 51466000 - ECH: FLAG(578) ELSE 51467000 - EMIT1P(IF S THEN BSET ELSE BRST,THI); 51468000 - STEPIT; 51469000 - END STATIC KIND OF BITFIDDLE ELSE 51470000 - OWT: BEGIN 51471000 - IF AEXP < XTYPE THEN GO ECH; 51472000 - EMIT(IF S THEN DBST ELSE DBRS); 51473000 - END; 51474000 - IF ELCLASS ! RTPARN THEN FLAG(579); 51475000 - STEPIT; 51476000 - END BITFIDDLE; 51477000 -PROCEDURE MONITER (ELBW); 57000000 - VALUE ELBW; 57001000 - REAL ELBW; 57002000 - BEGIN COMMENT MONITER SETS UP PARAMETERS AND ISSUES A CALL ON 57003000 - A TYPED PROCEDURE WHOSE ADDRESS 1S KEPT IN THE LINK FIELD 57004000 - OF THE INFO WORD. THE FIRST PARAMETER IS THE FIRST 57005000 - 7 (5500) OR FEWER CHARACTERS OF THE IDENTIFIER AND THE 57006000 - SECOND IS THE VALUE BEING ASSIGNED TO THE VARIABLE AND 57007000 - RETURNED BY THE PROCEDURE. 57008000 - ;57009000 - EMITN (TAKE (GT3 ~ ELBW.LINK).LINK); 57010000 - EMIT (EXCH); 57011000 - EMIT (IMKS); 57012000 - GT1 ~ TAKE (GT3 + 1); 57013000 - IF GT2 ~ GT1.CHRCNT > 7 THEN GT2 ~ 7; 57014000 - GT1 ~ " "; 57015000 - MOVECHARACTERS (GT2, INFO[GT3.LINKR,GT3.LINKC+1], 4, GT1, 1); 57016000 - EMITNUM (GT1); 57017000 - EMIT (EXCH); 57018000 - EMIT (ENTR); 57019000 - END MONITER; 57020000 - 57141000 -REAL PROCEDURE VARIABLE(F); 57021000 - VALUE F; 57022000 - INTEGER F; 57023000 -BEGIN 57024000 - REAL ADDRS,ELBW,DIALS,TYP,T; 57025000 - BOOLEAN ARY,FORMAL,ADDRSTOG,QUE,FLD; 57026000 - DEFINE SBPT = [33:33:15] #, - TIPE = [18:33:15] #; - DEFINE SBT=TYP#; 57026100 - LABEL A1,A2,ASSGN,FEILD,AWAY; - FORMAL~TYP~(ELBW~ELBAT[I]).TYPE=FORMALNAMEP OR TYP=FORMALNAMEQ;57029000 - IF RANGE(BOOPROCID,PTRPROCID) THEN 57030000 - BEGIN 57031000 - T~ELCLASS-BOOPROCID; 57032000 - IF TYP!WITHINBODY THEN BEGIN ERR(532); GO AWAY END; 57033000 - ELBW.ADDRESS~ADDRS~GIT(TAKE(ELBW)).ADDRESS; 57034000 - STEPIT; ADDRSTOG~TRUE; GO TO ASSGN; 57035000 - END; 57036000 - ADDRS~ELBW.ADDRESS; 57037000 - T~IF ELCLASS=EVENTID OR ARY~ELCLASS=EVENTARRAYID THEN EVNTV 57038000 - ELSE ELCLASS-( 57039000 - IF RANGE(BOOID,PTRID) THEN BOOID ELSE 57040000 - IF ARY~RANGE(BOOARRAYID,WORDARRAYID) THEN BOOARRAYID ELSE 57041000 - IF ARY~RANGE(BOOROAID,INTROAID) THEN BOOROAID ELSE 57042000 - (ELCLASS+1)); 57043000 - IF T<0 THEN BEGIN ERR(111); GO AWAY END; 57044000 - IF QUE~TYP=FORMALNAMEQ OR TYP=FORMALVALUEQ THEN 57045000 - BEGIN 57046000 - ITEMREFERENCE(F); 57047000 - IF T=EVNTV THEN EMIT(LOAD) ELSE 57048000 - IF FORMAL THEN EMIT(EVAL); 57049000 - IF F=FR THEN GO AWAY; 57050000 - END ELSE STEPIT; 57051000 - IF ARY THEN 57052000 - BEGIN 57053000 - IF ADDRS=0 AND TYP=INTRINSIC THEN ARY~BOOLEAN(3); % REG, 57054000 - SBT~-GIT(TAKE(ELBW)).NODIM; 57055000 - IF ELCLASS=LFTBRKT THEN 57056000 - IF-SBT=SBT~SUBSCRIBER(IF QUE OR ADDRS=4 THEN 0 ELSE ADDRS,57057000 - -SBT) THEN SBT~-SBT; % AN EMPTY ARRAY IDENTIFIER. 57058000 - IF SBT!0 THEN 57059000 - BEGIN 57060000 - IF REAL(ARY)=3 THEN BEGIN ERR(529); GO AWAY END; 57061000 - T~-0&(T)TIPE&(SBT)SBPT; % THIS MAKES IT < "XTYPE". 57062000 - SBT ~ SBT.[1:1]; % AN EMPTY ARRAY IDENTIFIER. 57063000 - END ELSE 57064000 - ARY~ARY AND BOOLEAN(2); 57065000 - IF F=FR THEN BEGIN EMIT(INDX); GO TO AWAY END; 57065400 - IF F=FS THEN 57065500 - IF FLD~ELCLASS=PERIODV THEN GO TO A1; 57065700 - IF ELCLASS=ASSNOP THEN 57066000 - A1: BEGIN 57067000 - IF NOT ARY THEN 57068000 - IF ELBW.CLASS}BOOROAID THEN FLAG(539); 57069000 - IF BOOLEAN(SBT) THEN 57070000 - IF QUE THEN ELSE 57071000 - BEGIN 57072000 - EMITN(ADDRS); 57073000 - IF FORMAL THEN EMIT(EVAL); 57074000 - END ELSE 57075000 - BEGIN 57076000 - IF ADDRS=4 THEN EMITN(4); 57077000 - IF REAL(ARY)!2 THEN EMIT(INDX); 57078000 - END; 57079000 - IF FLD THEN GO TO FEILD; GO TO ASSGN; 57080000 - END; 57081000 - IF F=FS THEN BEGIN ERR(538); GO AWAY END; 57081500 - IF QUE THEN GO AWAY; 57082000 - IF ARY THEN 57083000 - IF BOOLEAN(SBT) THEN 57084000 - BEGIN 57085000 - EMITN(ADDRS); 57086000 - IF FORMAL THEN EMIT(EVAL); 57087000 - EMIT(LOAD); 57088000 - END ELSE EMIT(NXLN) ELSE 57089000 - IF REAL(ARY)=2 THEN EMIT(RPRR) ELSE 57090000 - IF ADDRS=4 THEN EMIT(LODT) ELSE 57091000 - BEGIN 57092000 - IF T>ITYPE AND T!EVNTV THEN EMIT(INDX); 57093000 - EMIT(IF T=WTYPE THEN LODT ELSE 57094000 - IF T>ITYPE AND T!EVNTV THEN NXLN ELSE NXLV); 57095000 - END; GO AWAY; 57096000 - END; 57097000 - IF F=FR THEN - BEGIN - EMITN(ADDRS); IF FORMAL THEN EMIT(EVAL); GO AWAY ; - END; - IF F=FS THEN - IF FLD~ELCLASS=PERIODV THEN GO TO A2; - IF ELCLASS=ASSNOP THEN 57098000 - A2: BEGIN 57099000 - IF QUE THEN ELSE 57100000 - IF FORMAL THEN EMITPAIR(ADDRS,EVAL) ELSE ADDRSTOG~TRUE; 57101000 - IF FLD THEN GO TO FEILD; 57102000 - ASSGN: IF STEPI=FACTOP THEN 57103000 - BEGIN 57104000 - STEPIT; 57105000 - FEILD: IF REAL(ARY)=2 THEN 57106000 - BEGIN EMIT(DUPL); EMIT(RPRR) END ELSE 57107000 - BEGIN 57108000 - IF ADDRSTOG THEN 57108200 - IF T>ITYPE AND T!EVNTV THEN 57108400 - BEGIN EMITN(ADDRS); ADDRSTOG~FALSE END ELSE 57108600 - EMITV(ADDRS); 57108800 - IF ADDRSTOG THEN ELSE 57109000 - BEGIN 57109200 - EMIT(DUPL); 57109500 - EMIT(IF T=WTYPE THEN LODT ELSE LOAD); 57110000 - END; 57111000 - END; 57112000 - IF FLD THEN 57113000 - BEGIN 57113020 - IF STEPI=TAGV THEN 57113040 - BEGIN DIALS~-2; STEPIT END ELSE DIALS~DOTIT; 57113060 - IF ELCLASS=ASSNOP THEN STEPIT ELSE 57113080 - BEGIN ERR(538); GO AWAY END; 57113100 - EXPRESSION(IF T=BTYPE THEN BTYPE ELSE ATYPE); 57113120 - IF DIALS=-2 THEN EMIT(STAG) ELSE 57113140 - IF DIALS=0 THEN EMIT(DINS) ELSE 57113160 - EMITR(DIALS.[36:6],DIALS.[42:6]); 57113180 - END ELSE GT1~ARITHCOMP(T); 57113200 - END ELSE EXPRESSION(T); 57114000 - IF ELBW.MONF=1 THEN MONITER(ELBW); 57114500 - IF REAL(ARY)=2 THEN EMIT(SPRR) ELSE 57115000 - BEGIN 57116000 - IF ADDRSTOG THEN EMITN(ADDRS) ELSE 57117000 - IF T>ITYPE AND T!EVNTV OR ARY THEN EMIT(EXCH); 57118000 - IF T>ITYPE AND T!EVNTV OR ARY THEN 57118300 - EMIT(IF F=FS THEN OVRD ELSE OVRN) ELSE 57118500 - EMIT(IF F=FS THEN STOD ELSE STON); 57119000 - END; 57120000 - GO AWAY; 57120500 - END; 57121000 - IF F=FS THEN BEGIN ERR(538); GO AWAY END; 57121500 - IF QUE THEN GO AWAY; 57122000 - IF T>ITYPE AND T!EVNTV THEN 57123000 - BEGIN 57124000 - EMITN(ADDRS); 57125000 - IF FORMAL THEN EMIT(EVAL); 57126000 - EMIT(IF T=WTYPE THEN LODT ELSE LOAD); 57127000 - END ELSE 57128000 - EMITV(ADDRS); 57129000 - AWAY: 57130000 - IF VARIABLE~T =PTYPE OR T=RTYPE THEN 57131000 - VARIABLE ~ -1&(T)TIPE; 57131100 -END OF VARIABLE; 57132000 -PROCEDURE LAYITOUT (TYPE); VALUE TYPE; INTEGER TYPE; 57142000 - BEGIN COMMENT 57143000 - ;57144000 - REAL ELBW, ADDLWD; 57145000 - REAL DIALS; 57145050 - DEFINE ELCLAS = ELCLASS #; 57145100 - BOOLEAN SIMPLE; 57146000 - INTEGER ADDLJ, ADDLN, T, S, N; 57147000 - INTEGER NEXTCLS; 57147100 - LABEL EXPR1, EXPR2, EXPR3; 57147200 - LABEL WAY; 57147500 - LABEL NEXT, QUIT; 57148000 - DEFINE ADDLI = ADDLJ.LINKR, ADDLJ.LINKC #, 57149000 - SCAT = DO UNTIL STEPI = SEMICOLON; GO QUIT#; 57150000 - STEPIT; 57151000 - IF (ELBW ~ TAKE (ELBAT[I].LINK)).CLASS ! LAYOUTID 57152000 - THEN 57153000 - BEGIN 57153010 - EXPRESSION(TYPE); 57153020 - IF ELCLASS ! LFTBRKT THEN GO WAY; 57153030 - LITERALS ~ TRUE; 57153035 - IF STEPI!NUMBER THEN GO EXPR1; 57153040 - IF TABLE(I+1)=COLON THEN BEGIN 57153045 - S ~ THI; STEPIT END ELSE BEGIN 57153050 - EXPR1: S ~ -1; IF NOT SIMPLEX(14) THEN GO WAY END; 57153055 - IF ELCLASS ! COLON THEN GO WAY; 57153060 - IF STEPI!NUMBER THEN GO EXPR2; 57153065 - IF T~TABLE(I+1)=COLON OR T=RTBRKT THEN BEGIN 57153070 - IF S<0 THEN GO EXPR2; T~THI; STEPIT END ELSE BEGIN 57153075 - EXPR2: IF S}0 THEN EMITNUM(S); S ~ -1; 57153080 - IF NOT SIMPLEX(14) THEN GO WAY END; 57153085 - IF ELCLASS=COLON THEN BEGIN 57153090 - IF STEPI!NUMBER THEN GO EXPR3; 57153100 - IF TABLE(I+1)=RTBRKT THEN BEGIN 57153110 - IF S<0 THEN GO EXPR3; N ~ THI; STEPIT; 57153120 - IF S}48 OR T}48 OR N>48 THEN FLAG(704); 57153125 - EMITD(S,T,N) END ELSE BEGIN 57153130 - EXPR3: IF S}0 THEN BEGIN EMITNUM(S); EMITNUM(T) END; 57153140 - IF NOT SIMPLEX(14) THEN GO WAY; 57153150 - EMIT(DFTR) END 57153160 - END THE TWO COLON CASE ELSE 57153170 - IF S}0 THEN BEGIN IF S}48 OR T>48 THEN FLAG(704); 57153175 - EMIT2P(INSR, S, T) END ELSE BEGIN 57153180 - EMIT(RSUP); EMIT(DINS) END; 57153185 - IF LITERALS THEN WAY: FLAG(533); 57153190 - IF ELCLASS = RTBRKT THEN STEPIT ELSE 57153200 - BEGIN 57153210 - WHILE ELCLASS!RTBRKT AND ELCLASS!SEMICOLON DO 57153220 - STEPIT; 57153230 - FLAG(533); 57153240 - END; 57153250 - GO QUIT 57153260 - END; 57153270 - IF STEPI ! LFTPRN 57154000 - THEN BEGIN FLAG (534); SCAT END; 57155500 - ADDLJ ~ ELBW.LINK - 1; 57156000 - ADDLN ~ ELBW.ADDRESS; 57157000 - ELCLASS ~ COMMA; 57157100 -NEXT: WHILE ADDLJ ~ ADDLJ + 1 < ADDLN DO 57158000 - BEGIN 57159000 - IF ELCLASS!RTPARN THEN 57159040 - IF ELCLASS!COMMA THEN FLAG(535); 57159060 - DIALS ~ 0; 57159100 - DEBLANK; 57160000 - ADDLWD ~ ADDL[ADDLI]; 57161000 - IF CHR = "*" 57162000 - THEN BEGIN 57163000 - ELCLAS ~ TABLE (I~I+2); 57164000 - ADDLJ ~ ADDLJ + ADDLWD.LAYINIT; 57165000 - IF ELCLAS= RTPARN THEN ADDLJ~ADDLN; 57165500 - GO NEXT; 57166000 - END; 57167000 - IF SIMPLE ~ ADDLWD.LAYLTA = 0 AND ADDLWD.LAYLTB = 0 57168000 - AND T ~ ADDLWD.LAYCODE = FIELDID 57169000 - THEN BEGIN 57170000 - S ~ ADDLWD.LAYLNA; 57171000 - N ~ ADDLWD.LAYLNB; 57172000 - END 57173000 - ELSE IF T ! TAGV 57174000 - THEN IF T = LAYOUTID 57175000 - THEN IF (GT1 ~ TAKE (ADDLWD.LINK)).ADDRESS ! 0 57176000 - THEN BEGIN 57177000 - S ~ GT1.STARTBIT; 57178000 - SIMPLE ~ TRUE; 57179000 - N ~ GT1.NOOFBITS; 57180000 - END 57181000 - ELSE DIALS ~ GIT (GT1.LINK) & 1[1:47:1] 57182000 - ELSE DIALS ~ ADDLWD & 1 [1:47:1]; 57183000 - IF ELCLAS ! RTPARN THEN DEBLANK; 57183100 - IF CHR = "," OR CHR =")" OR ELCLAS = RTPARN 57184000 - THEN BEGIN 57184100 - IF NEXTCLS~ELCLAS!RTPARN THEN NEXTCLS~STEPI; 57184150 - IF N =1 AND T! TAGV AND SIMPLE THEN 57184175 - BEGIN IF N ~ ADDLWD.LAYINIT ! 0 THEN 57184200 - BEGIN 57184250 - N ~ GIT(ADDLJ ~ ADDLJ + 1).[47:1]; 57184300 - EMIT1P(BSET&(1-N)[44:47:1],S); 57184400 - END; 57184450 - GO TO NEXT 57184500 - END ELSE 57184600 - IF ADDLWD.LAYINIT = 0 57185000 - THEN GO NEXT 57186000 - ELSE BEGIN 57187000 - IF DIALS !0 57187100 - THEN DOTTER (DIALS); 57187200 - ADDLJ ~ ADDLJ + 1; 57187300 - EMITNUM (ADDL[ADDLI]) 57187400 -; ELCLAS ~ NEXTCLS; 57187450 - END 57187500 - END 57187600 - ELSE BEGIN 57188000 - IF DIALS ! 0 57188010 - THEN DOTTER (DIALS); 57188020 - STEPIT; 57188025 - IF AEXP < XTYPE 57188030 - THEN FLAG(544) 57188100 - ELSE BEGIN 57188200 - 57188300 - ADDLJ ~ ADDLJ + ADDLWD.LAYINIT; 57188400 - END; 57188500 - END; 57188600 - IF T =TAGV 57189000 - THEN EMIT (STAG) 57190000 - ELSE IF SIMPLE THEN EMITR (S, N) ELSE EMIT (DINS); 57191000 - END; 57192000 - 57192100 - IF ELCLASS ! RTPARN THEN BEGIN FLAG(535); SCAT END ELSE STEPIT;57193000 -QUIT: 57194000 - END LAYITOUT; 57195000 -INTEGER PROCEDURE SUBSCRIBER (ADDRESS, BOUNDS); 57196000 - VALUE ADDRESS, BOUNDS; 57197000 - INTEGER ADDRESS,BOUNDS; 57198000 - BEGIN COMMENT SUBSCRIBER HANDLES A SUBSCRIPT LIST INCLUDING 57199000 - THE ENCLOSING BRACKETS. IT RETURNS THE NUMBER OF ASTER- 57200000 - ISKS (SUBSCRIPTS NOT SEEN), AND EMITS NXLN-S FOR ALL 57201000 - ACTUAL SUBSCRIPTS EXCEPT THE FINAL ONE. WHEN ADDRESS IS 57202000 - NON-ZERO, A NAME IS EMITTED AFTER THE FIRST SUBSCRIPTS 57203000 - ARITHMETIC EXPRESSION HAS BEEN COMPILED. BOUNDS IS THE 57204000 - NUMBER OF DECLARED DIMENSIONS. 57205000 - ;57206000 - INTEGER BDS, NOTBDS; 57207000 - BOOLEAN FIRST; 57208000 - FIRST ~ ADDRESS !0; 57209000 - IF ELCLASS ! LFTBRKT 57210000 - THEN BEGIN ERR(402); SUBSCRIBER ~ 0; END 57211000 - ELSE BEGIN 57212000 - DO BEGIN 57213000 - STEPIT; 57214000 - IF ELCLASS ! FACTOP 57215000 - THEN BEGIN 57216000 - IF AEXP < XTYPE THEN FLAG (505); 57217000 - IF NOTBDS ! 0 THEN FLAG (574); 57217100 - BDS ~ BDS + 1; 57218000 - IF FIRST 57219000 - THEN BEGIN 57220000 - FIRST ~ FALSE; 57221000 - EMITN (ADDRESS); 57222000 - END; 57223000 - IF BDS!BOUNDS AND TABLE(I+1)! 57224000 - FACTOP THEN EMIT(NXLN); 57224010 - END 57225000 - ELSE BEGIN NOTBDS ~ NOTBDS + 1; STEPIT END;57226000 - END UNTIL ELCLASS ! COMMA; 57227000 - IF ELCLASS ! RTBRKT 57228000 - OR BDS + (SUBSCRIBER ~ NOTBDS) ! BOUNDS 57229000 - THEN ERR (402) ELSE 57230000 - STEPIT; 57231000 - END; 57232000 - LASTINDEX ~ L; 57233000 - END SUBSCRIBER; 57234000 -PROCEDURE DOTTER (DIALS); 57235000 - VALUE DIALS; 57236000 - REAL DIALS; 57237000 - BEGIN 57238000 - INTEGER D; 57239000 - FOR D ~ DIALS.LAYAEXP, DIALS.LAYBEXP 57240000 - DO IF D.LAYLTB = 0 57241000 - THEN EMITNUM (D.LAYLNB) 57242000 - ELSE BEGIN 57243000 - HOOK (D.LAYLNB); 57244000 - STEPIT; 57245000 - IF AEXP < XTYPE THEN FLAG (403); 57246000 - IF ELCLASS = SEMICOLON THEN UNHOOK; 57247000 - END; 57248000 - IF DIALS > 0 THEN STEPIT; 57249000 - END DOTTER; 57250000 -INTEGER PROCEDURE DOTIT; 57251000 - BEGIN COMMENT WHEN DOTIT RETURNS A ZERO, CODE WILL HAVE BEEN 57252000 - EMITTED TO INITIALIZE THE STACK TO THE PROPER VARIABLES 57253000 - SO THAT THE CALLER MAY EMIT A DINS 0R DISO AT SOME LATER 57254000 - TIME. WHEN DOTIT IS NON-ZERO IT CONTAINS THE STARTING BIT57255000 - 36:6 AND NUMBER OF BITS 42:6. 57256000 - 57257000 - ;57258000 - LABEL WAY, EXPR1, EXPR2; 57258100 - INTEGER S, T; 57258200 - IF ELCLASS ! FIELDID 57259000 - THEN 57260000 - IF ELCLASS ! LFTBRKT THEN GO WAY ELSE 57260010 - BEGIN 57260020 - LITERALS ~TRUE; 57260025 - IF STEPI!NUMBER THEN GO EXPR1; 57260030 - IF TABLE(I+1)=COLON THEN BEGIN S ~ THI; STEPIT END ELSE 57260035 - EXPR1: BEGIN S ~ -1; IF NOT SIMPLEX(14) THEN GO WAY END; 57260040 - IF ELCLASS!COLON THEN GO WAY; 57260045 - IF STEPI!NUMBER THEN GO EXPR2; 57260050 - IF TABLE(I+1)=RTBRKT THEN BEGIN 57260055 - IF S<0 THEN GO EXPR2; T ~ THI; STEPIT; 57260060 - IF S}48 OR T>48 THEN FLAG(704); 57260065 - DOTIT ~ T & S[36:42:6] END ELSE BEGIN 57260070 - EXPR2: IF S}0 THEN EMITNUM(S); 57260080 - IF NOT SIMPLEX(14) THEN GO WAY END; 57260090 - IF ELCLASS ! RTBRKT THEN GO WAY; 57260100 - STEPIT; 57260105 - IF LITERALS THEN 57260110 - WAY: FLAG(404); 57260120 - END 57260140 - ELSE BEGIN 57261000 - IF DOTIT ~ ELBAT[I].ADDRESS = 0 57262000 - THEN DOTTER(GIT(TAKE(ELBAT[I].LINK).LINK)) 57263000 - ELSE STEPIT; 57263100 - END; 57264000 - END DOTIT; 57265000 - PROCEDURE ITEMREFERENCE(F); VALUE F; INTEGER F; 57266000 - BEGIN COMMENT (MCS 1); 57267000 -COMMENT GOBBLES UP AN ITEM REFERENCE AND LEAVES A THING LOOKING LIKE AN 57268000 - ACTUAL PARAMETER IN THE TOP OF THE STACK- I.E. AN IRW FOR A NAME57269000 - ITEM AND A VALUE FOR A VALUE ITEM 57269500 - F TELLS WHO CALLED AS IN VARIABLE 57269530 - ; 57269590 - INTEGER NEXTCLASS, % HOLDS CLASS OF NEXT THING AFTER ITEM 57270000 - INDEX, % INDEX OF ITEM WITHIN ENTRY 57271000 - QUEUECLASS; % QUEUEID OR QUEUEARRAYID 57272000 - REAL ITEMINFO, % HOLDS FIRST WORD OF ITEM INFO 57273000 - QUEUEINFO; % FIRST WORD OF QUEUE OR QUEUE ARRAY INFO 57274000 - REAL GT1; % HOLDS CLASS OF ITEM 57274500 - LABEL ON,QUIT,FINI; 57275000 - INDEX~(ITEMINFO+TAKE(ELBAT[I])).QINDEXF; 57276000 - N ~ ITEMINFO.LINK; 57277000 - QUEUECLASS~(QUEUEINFO~TAKE(IF(GT1~ ITEMINFO.CLASS) 57278000 - >EVENTARRAYID OR GT1 0 AND FSN >0 THEN COMMENT FIRST STMT IS DUMMY; 60037000 - BEGIN 60037100 - S ~ GET3(L ~ S - 3); COMMENT PICK UP LAST LINK; 60037200 - WHILE L MOD 3 ! 0 DO EMIT(NOOP); 60037300 - T ~ L; 60037400 - EMITLINK(S); COMMENT PUT THE LINK BACK; 60037500 - S ~ L; 60037600 - END ELSE 60037700 - BEGIN 60037800 - WHILE L MOD 3 ! 0 DO EMIT(NVLD); 60037900 - T ~ L; 60038000 - END; 60038100 - CASETAIL(N~N-1, T , LT); 60039000 - IF N > SN THEN 60039100 - IF N > LN THEN N ~ N - 1; COMMENT LAST STMT IS DUMMY; 60039200 - LT ~ (N+1)| 3 + T; COMMENT COMPUTE EXIT POINT ADDRESS; 60040000 - 60041000 - 60041900 - 60020000 - 60042100 - WHILE L < LT DO EMITB(BRUN,BUMPL,LT); 60043000 - FIGS ~ TRUE; 60043100 - WHILE LCTR ~ LCTR - 1 } 0 DO 60044000 - BEGIN 60045000 - L ~ (E ~ GIT( NEXTADDL ~ NEXTADDL - 1)).DISP | 3 + T; 60046000 - GOGEN(E,BRUN); 60047000 - END OF LABELS; 60048000 -IF FSN } 0 THEN 60049000 - DO BEGIN 60050000 - SN ~ GET3(S - 3); 60051000 - EMITB(BRUN,S,LT); 60052000 - EMITB(BRUN,(SN.[24:8] + 1)|3+ T,S ~ SN.[32:16]); 60053000 - END STATEMENTS UNTIL SN.[24:8] { FSN; 60054000 - L ~ LT; 60066000 - FIGS ~ FALSE; 60066100 - COMPOUNDTAIL 60067000 - END CASE STATEMENT; 60068000 - PROCEDURE FORSTMT; 60069000 - BEGIN OWN REAL B,STMTSTART,REGO,RETURNSTORE,ADDRES,V,VRET,BRET; 60070000 - OWN BOOLEAN SIGNA,SIGNB,SIGNC,INT, 60071000 - BYE, 60071100 - CONSTANA,CONSTANB,CONSTANC; 60072000 - DEFINE SIMPLEB = SIGNC #, FORMALV = SIGNA #, 60073000 - SIMPLEV = CONSTANA #, A = V # , Q = REGO #, 60074000 - K = BRET #; 60075000 - LABEL EXIT; 60076000 - REAL T1,T2,T3,T4; 60077000 - PROCEDURE PLUG(C,A); VALUE C,A; REAL A; BOOLEAN C; 60078000 - IF C THEN EMITNUM(A) ELSE EMITV(A.ADDRESS); 60079000 - BOOLEAN PROCEDURE SIMPLE(B,A,S); 60080000 - BOOLEAN B,S; REAL A; 60081000 - BEGIN 60082000 - S ~ IF STEPI ! ADDOP THEN FALSE ELSE 60083000 - ELBAT[I].DISP = SUBT; 60084000 - IF ELCLASS= ADDOP THEN STEPIT; 60085000 - IF ELCLASS } NUMBER AND ELCLASS { STRNGCON THEN 60086000 - BEGIN 60087000 - SIMPLE ~ NOT DPTOG; 60088000 - ELBAT[I] ~ K&COMMENTV[21:41:7]; 60089000 - ADDL[K.LINKR,K.LINKC] ~ A ~ THI; 60090000 - B ~ TRUE; 60091000 - K ~ K + 1; 60092000 - END ELSE 60093000 - BEGIN 60094000 - B ~ FALSE; 60095000 - A ~ ELBAT[I]; 60096000 - SIMPLE ~ ELCLASS } DPID AND ELCLASS{INTID 60097000 - END; 60098000 - STEPIT; 60099000 - END SIMPLE; 60100000 - PROCEDURE TEST; 60101000 - BEGIN 60102000 - IF NOT CONSTANB THEN 60103000 - BEGIN 60104000 - EMITO(SUBT); 60105000 - IF SIMPLEB THEN EMITV(B.ADDRESS) ELSE 60106000 - BEGIN 60107000 - EMITNUM((L+9)DIV 3); 60108000 - EMITB(BRUN,BUMPL,B); 60109000 - WHILE L MOD 3 ! 0 DO EMIT(NVLD); 60110000 - END; 60111000 - EMITO(MULT); EMITNUM(0); 60112000 - END; 60113000 - EMITO(IF SIGNB THEN GREQ ELSE LSEQ); 60114000 - END TEST; 60115000 - BOOLEAN PROCEDURE SIMPI(ALL); VALUE ALL; REAL ALL; 60116000 - BEGIN 60117000 - REAL T; 60118000 - ADDRES ~ ALL.ADDRESS; 60119000 - FORMALV~ ALL.TYPE = FORMALNAMEP; 60120000 - IF T ~ ALL.CLASS > INTARRAYID 60121000 - OR T < BOOID 60122000 - OR T = REFID 60123000 - OR T = PTRID THEN ERR(REAL(T!0)|508 + 100); 60124000 - INT ~ T = INTID OR T = INTARRAYID; 60125000 - SIMPI ~ T { INTID; 60126000 - END SIMPI; 60127000 - PROCEDURE STORE(S); VALUE S; BOOLEAN S; 60128000 - BEGIN 60129000 - IF FORMALV THEN 60130000 - BEGIN 60131000 - S ~ FALSE; 60132000 - END ELSE 60133000 - EMITN(ADDRES); 60134000 - IF INT THEN BEGIN EMIT(EXCH); EMIT(NTGR) END; 60135000 - EMITO(STOD + REAL(S)); 60136000 - END STORE; 60137000 - PROCEDURE CALL(S); VALUE S; BOOLEAN S; 60138000 - BEGIN 60139000 - IF SIMPLEV THEN 60140000 - IF S THEN EMITV(ADDRES) ELSE 60141000 - EMITPAIR(ADDRES,EVAL) ELSE 60142000 - BEGIN 60143000 - EMITNUM((L+9) DIV 3); 60144000 - EMITB(BRUN,BUMPL,V); 60145000 - WHILE L MOD 3 ! 0 DO EMIT (NVLD); 60146000 - IF S THEN EMIT(NXLV); 60147000 - END; 60148000 - END CALL; 60149000 - PROCEDURE FORLIST(NUMLE); VALUE NUMLE; BOOLEAN NUMLE; 60150000 - BEGIN 60151000 - INTEGER BACKFIX,FORWARDBRANCH,FOOT,STOREFIX; 60152000 - LABEL BRANCH,EXIT; 60153000 - STOREFIX ~ L; 60154000 - BACKFIX ~ V + REAL(SIMPLEV) - 1; 60155000 - IF GT1 ~ AEXP { XTYPE THEN 60156000 - BEGIN 60157000 - ERR(632); GO TO EXIT; 60158000 - END; 60159000 - VRET ~ L; 60160000 - IF ELCLASS = BYV THEN 60161000 - BEGIN 60161010 - IF GT1 ! ITYPE THEN EMIT(NTGR); 60161015 - IF NOT SIMPLEV THEN 60161020 - BEGIN 60161030 - ERR(668); GO TO EXIT; 60161040 - END; 60161060 - STEPIT; 60161070 - EXPRESSION(ITYPE); 60161080 - EMITR(47,12); 60161090 - IF ELCLASS ! UNTILV THEN 60161140 - BEGIN 60161150 - ERR(667); GO TO EXIT; 60161160 - END; 60161180 - STEPIT; 60161185 - EXPRESSION(ITYPE); 60161190 - EMIT(ONE); 60161200 - EMIT(ADD); 60161210 - EMITR(35,16); 60161220 - EMITNUM(4); 60161250 - EMIT(STAG); 60161260 - EMITN(ADDRES); 60161270 - EMIT(STOD); 60161280 - IF ELCLASS ! DOV THEN 60161290 - BEGIN 60161300 - ERR(610); GO TO EXIT; 60161310 - END; 60161330 - BACKFIX ~ L; 60161340 - EMITN(ADDRES); 60161350 - STOREFIX ~ L; 60161360 - EMITLINK(0&STBR[24:40:8]); 60161370 - EMIT(DLET); 60161380 - STEPIT; 60161390 - STATEMENT; 60161400 - EMITB(BRUN,BUMPL,BACKFIX); 60161410 - EMITB(GET(STOREFIX),STOREFIX+3,L); 60161420 - GO TO EXIT; 60161430 - END; 60161440 - IF ELCLASS = STEPV THEN 60161999 - BEGIN 60162000 - BACKFIX ~ BUMPL; 60163000 - IF FORMALV THEN 60164000 - IF SIMPLEV THEN CALL(FALSE) ELSE 60164100 - WHILE L MOD 3 ! 0 DO EMIT(NVLD); 60164200 - CALL(TRUE); BACKFIX.[2:1] ~ 1; 60164300 - IF I > 70 THEN 60165000 - BEGIN 60166000 - NXTELBT ~ 1; 60167000 - I ~ 0; 60168000 - END ELSE 60169000 - REGO ~ I; 60170000 - IF SIMPLEB ~ SIMPLE(CONSTANB,B,SIGNB) 60171000 - AND (ELCLASS = UNTILV 60172000 - OR ELCLASS = WHILEV) THEN 60173000 - PLUG(CONSTANB,B) ELSE 60174000 - BEGIN 60175000 - I ~ IF I < 4 THEN 0 ELSE REGO; 60176000 - STEPIT; 60177000 - SIGNB ~ CONSTANB ~ FALSE; 60178000 - EMITO(ZERO); 60179000 - B ~ L; 60180000 - IF AEXP { XTYPE THEN 60181000 - BEGIN 60182000 - ERR(632); GO TO EXIT; 60183000 - END; 60184000 - EMITO(EXCH); 60185000 - BRET ~ L; 60186000 - EMIT(DBUN); 60187000 - END; 60188000 - EMITO(ADD + REAL(SIGNB)); 60189000 - EMITB(BRUN,BACKFIX,L); 60190000 - IF ELCLASS = UNTILV THEN 60191000 - BEGIN 60192000 - STORE(TRUE); 60193000 - IF FORMALV THEN CALL(TRUE); 60194000 - STEPIT; 60195000 - IF AEXP { XTYPE THEN 60196000 - BEGIN 60197000 - ERR(632); GO TO EXIT; 60198000 - END; 60199000 - TEST; 60200000 - END ELSE 60201000 - BEGIN 60202000 - IF ELCLASS ! WHILEV THEN 60203000 - BEGIN 60204000 - ERR(609); 60205000 - GO TO EXIT 60206000 - END; 60207000 - STEPIT; 60208000 - STORE(FALSE); 60209000 - BEXP; 60210000 - END; 60211000 - END ELSE 60212000 - BEGIN 60213000 - STORE(FALSE); 60214000 - IF ELCLASS = WHILEV THEN 60215000 - BEGIN 60216000 - STEPIT; 60217000 - BEXP; 60218000 - END ELSE 60219000 - BEGIN 60220000 - ERR(631); 60221000 - GO TO EXIT; 60222000 - END; 60223000 - END; 60224000 - EMITLINK(0&BRFL[24:40:8]); 60225000 - BRANCH: FORWARDBRANCH ~ L; 60226000 - IF ELCLASS = COMMA THEN 60227000 - BEGIN 60228000 - ERR(631); 60229000 - END ELSE 60230000 - BEGIN 60231000 - IF ELCLASS ! DOV THEN 60232000 - BEGIN 60233000 - ERR(610); 60234000 - GO TO EXIT; 60235000 - END; 60236000 - STEPIT; 60237000 - STATEMENT; 60238000 - IF BACKFIX.[2:1] = 1 AND FORMALV 60238100 - AND NOT SIMPLEV THEN 60238200 - BEGIN 60238300 - EMITNUM((BACKFIX+2) DIV 3); 60238400 - EMITB(BRUN,BUMPL,V); 60238500 - END ELSE 60238600 - EMITB(BRUN,BUMPL,BACKFIX); 60239000 - EMITB(GET(FORWARDBRANCH - 3), 60240000 - FORWARDBRANCH, 60241000 - L); 60242000 - END; 60243000 - EXIT: 60244000 - END FORLIST; 60245000 - NXTELBT ~ 1; I ~ 0; 60246000 - STEPIT; 60247000 - IF SIMPI(VRET ~ ELBAT[I]) THEN 60248000 - BEGIN 60249000 - IF STEPI ! ASSNOP THEN 60250000 - BEGIN 60251000 - ERR(611); 60252000 - GO TO EXIT; 60253000 - END; 60254000 - T1 ~ L; 60255000 - IF FORMALV THEN EMITN(ADDRES); 60256000 - K ~ NEXTADDL; 60257000 - IF SIMPLE(CONSTANA,A,SIGNA) THEN 60258000 - IF ELCLASS = STEPV OR BYE~ELCLASS=BYV THEN 60259000 - IF SIMPLE(CONSTANB,B,SIGNB) THEN 60260000 - IF ELCLASS = UNTILV THEN 60261000 - IF SIMPLE(CONSTANC,Q,SIGNC) THEN 60262000 - IF ELCLASS = DOV THEN 60263000 - BEGIN 60264000 - IF CONSTANA AND CONSTANB AND CONSTANC AND 60265000 - NOT(SIGNA OR SIGNB OR SIGNC ) AND 60266000 - A.[1:31]=0 AND Q.[1:31]=0 AND B.[1:36]=060267000 - % THE ABOVE CARD SHOULD BE CHANGED LATER TO ALLOW FOR TWELVE BITS 60267100 - % WORTH OF INCREMENT VALUE. . . . . 60267200 - AND BYE 60267300 - THEN 60268000 - BEGIN 60269000 - IF A > Q THEN 60270000 - BEGIN 60271000 - T1 ~ BUMPL; 60272000 - STEPIT; 60273000 - STATEMENT; 60274000 - EMITB(BRUN,T1,L); 60275000 - GO TO EXIT; 60276000 - END; 60277000 - EMITNUM(A&Q[12:32:16]&B[1:37:11]);60278000 - EMITNUM(4); 60279000 - EMIT(STAG); 60280000 - EMITN((T1~VRET).ADDRESS); 60281000 - EMIT(STOD); 60282000 - T2 ~ L; 60283000 - STEPIT; 60284000 - STATEMENT; 60285000 - EMITN(T1.ADDRESS); 60286000 - EMITB(STBR,BUMPL,L+4); 60287000 - EMIT(DLET); 60288000 - EMITB(BRUN,BUMPL,T2); 60289000 - GO TO EXIT; 60290000 - END; 60291000 - IF NOT BYE THEN 60291100 - BEGIN 60291200 - PLUG(CONSTANA,A); 60292000 - IF SIGNA THEN EMITO(CHSN); 60293000 - RETURNSTORE ~ BUMPL; 60294000 - STMTSTART ~ L; 60295000 - STEPIT; 60296000 - T1 ~ RETURNSTORE&STMTSTART[8:28:20]; 60297000 - T1.[7:1] ~ REAL(CONSTANB); 60298000 - T1.[6:1] ~ REAL(CONSTANC); 60299000 - T1.[5:1]~ REAL(SIGNB); 60300000 - T1.[4:1] ~ REAL(SIGNC); 60301000 - T2 ~ VRET; 60302000 - T3 ~ B; 60303000 - T4 ~ Q; 60304000 - STATEMENT; 60305000 - SIGNC ~ BOOLEAN(T1.[4:1]); 60306000 - SIGNB ~ BOOLEAN(T1.[5:1]); 60307000 - CONSTANC ~ BOOLEAN(T1.[6:1]); 60308000 - CONSTANB ~ BOOLEAN(T1.[7:1]); 60309000 - STMTSTART ~ T1.[8:20]; 60310000 - RETURNSTORE ~ T1.[28:20]; 60311000 - VRET ~ T2; 60312000 - B ~ T3; 60313000 - Q ~ T4; 60314000 - SIMPLEV ~ SIMPI(VRET); 60315000 - IF FORMALV THEN EMITN(ADDRES); 60316000 - EMITV(ADDRES); 60317000 - PLUG(CONSTANB,B); 60318000 - EMITO(ADD + REAL(SIGNB)); 60319000 - EMITB(BRUN,RETURNSTORE,L); 60320000 - STORE(TRUE); 60321000 - IF FORMALV THEN CALL(TRUE); 60322000 - PLUG(CONSTANC,Q); 60323000 - IF SIGNC THEN EMITO(CHSN); 60324000 - SIMPLEB ~ TRUE; 60325000 - TEST; 60326000 - EMITB(BRTR,BUMPL,STMTSTART); 60327000 - GO TO EXIT; 60328000 - END; 60328100 - END; 60329000 - I ~ 2; K ~ 0; 60330000 - SIMPLEV ~ SIMPI(VRET); 60331000 - V ~ T1; 60332000 - END ELSE 60333000 - BEGIN 60334000 - V ~ BUMPL; 60335000 - 60336000 - SIMPLEV ~ FALSE; 60337000 - FORMALV ~ TRUE; 60338000 - VRET ~ VARIABLE(FR); 60339000 - EMIT(EXCH); 60340000 - EMIT(DBUN); 60341000 - WHILE L MOD 3 ! 0 DO EMIT(NVLD); 60341100 - VRET ~ L; L ~ V-3; FIGS ~ TRUE; 60341200 - EMIT2P(LT16, VRET DIV 768, VRET MOD 768 DIV 3); 60341300 - FIGS ~ FALSE; L ~ VRET; 60341400 - IF ELCLASS ! ASSNOP THEN 60342000 - BEGIN 60343000 - ERR(611); 60344000 - GO TO EXIT; 60345000 - END; 60346000 - END; 60347000 - STEPIT; 60348000 - FORLIST(FALSE); 60349000 - EXIT: 60350000 - K ~ 0; 60351000 - END FORSTMT; 60352000 - PROCEDURE LABELR; 60353000 - BEGIN 60354000 - LABEL EXIT,ROUND; 60355000 - REAL GT1; 60356000 - DEFINE ELBATWORD = GT1 #, 60357000 - LINK = GT2 #, 60358000 - INDEX = GT3 #, 60359000 - ADDITIONAL= GT4 #, 60360000 - NEXTLINK = GT5 #; 60361000 - DO BEGIN 60362000 - IF STEPI ! COLON THEN 60363000 - BEGIN 60364000 - ERR(612); 60365000 - GO TO EXIT; 60366000 - END; 60367000 - IF (ELBATWORD~ELBAT[I-1]).[33:15] < NINFOO THEN 60368000 - BEGIN 60369000 - FLAG(613); 60370000 - GO TO ROUND; 60371000 - END; 60372000 - LINK ~ (ADDITIONAL ~ INDEX ~ TAKE(ELBATWORD)) 60373000 - .[32:16]; 60374000 - IF ADDITIONAL.TYPE ! F0RWARD THEN 60375000 - BEGIN 60376000 - FLAG(614); 60377000 - GO TO ROUND; 60378000 - END; 60379000 - WHILE LINK ! 0 DO 60380000 - BEGIN 60381000 - NEXTLINK ~ GET3(LINK); 60382000 - EMITB(NEXTLINK.[24:8],LINK+3,L); 60383000 - LINK ~ NEXTLINK.[32:16]; 60384000 - END; 60385000 - PUT(INDEX&L[32:32:16]&0[29:45:3],ELBATWORD); 60386000 - ROUND: 60387000 - ERRORTOG ~ TRUE; 60388000 - END UNTIL STEPI ! LABELID; 60389000 - EXIT: 60390000 - END LABELR; 60391000 - PROCEDURE IFSTMT; 60392000 - BEGIN 60393000 - REAL T1,T2,T3; 60394000 - LABEL INN, GRONK, ON; 60394100 - LABEL EXIT; 60395000 - T3 ~ REAL(IFCLAUSE).[47:1]; 60396000 - IF SIMPGO THEN 60397000 - BEGIN 60398000 - GOGEN(ELBAT[I], BRTR-T3); 60399000 - IF STEPI = ELSEV THEN 60400000 - BEGIN 60401000 - STEPIT; 60402000 - IF SIMPGO THEN 60403000 - BEGIN 60404000 - 60405000 - GOGEN(ELBAT[I],BRUN); 60406000 - STEPIT; 60407000 - GO TO EXIT; 60408000 - END; 60409000 - 60409200 - 60409300 - STATEMENT; 60409400 - GO TO EXIT; 60409500 - 60409600 - END; 60410000 - 60411000 - GO TO EXIT; 60412000 - END; 60413000 - IF ELCLASS } SEMICOLON AND ELCLASS { UNTILV THEN GO GRONK; 60413050 - T2 ~ T1 ~ BUMPL; 60413100 - IF ELCLASS = ELSEV THEN 60413150 - IF STEPI < SEMICOLON OR ELCLASS > ELSEV THEN 60413200 - IF SIMPGO THEN GO ON ELSE 60413250 - BEGIN T3 ~ 1 - T3; STATEMENT; GO INN END ELSE 60413300 - BEGIN 60413350 - L ~ L - 3; 60413400 - GRONK: EMIT(DLET); 60413450 - GO TO EXIT; 60413500 - END; 60413550 - 60414000 - STATEMENT; 60415000 - IF ELCLASS ! ELSEV THEN 60416000 - BEGIN 60417000 -INN: 60417500 - EMITB(BRFL+T3,T1,L); 60418000 - GO TO EXIT; 60419000 - END; 60420000 - STEPIT; 60421000 - IF SIMPGO THEN 60422000 - BEGIN 60423000 - T2 ~ L; 60424000 -ON: 60424500 - L ~ T1 - 3; 60425000 - FIGS ~ TRUE; 60425100 - GOGEN(ELBAT[I],BRFL + T3); 60426000 - L ~ T2; 60427000 - FIGS ~ FALSE; 60427100 - STEPIT; 60428000 - GO TO EXIT; 60429000 - END; 60430000 - T2 ~ BUMPL; 60431000 - EMITB(BRFL+T3,T1,L); 60432000 - STATEMENT; 60433000 - EMITB(BRUN,T2,L); 60434000 - EXIT: 60435000 - END IFSTMT; 60436000 - PROCEDURE GOSTMT; 60437000 - BEGIN 60438000 - REAL LT,S,N; 60439000 - REAL ELBW,GT1; 60439500 - REAL PCWADDR; 60439700 - DEFINE NEXTADDL = LASTADDL#; %HERE BEE MORE DRAGONS 60439800 - BOOLEAN TB1; 60440000 - LABEL EXIT, ON; 60441000 - LABEL CASECASE,CONTINUECASE; 60442000 - IF STEPI = TOV THEN STEPIT; 60443000 - IF ELCLASS = LABELID THEN TB1 ~ TRUE ELSE 60444000 - IF ELCLASS = CASEV THEN GO ON ELSE 60445000 - IF NOT TB1 ~ NOT FUTZALABEL THEN 60445100 - BEGIN 60446000 - ERR(615); 60447000 - GO TO EXIT; 60448000 - END; 60449000 - IF (ELBW~ELBAT[I]).LINK0 THEN IF ELCLASS!LFTPRN THEN IF T1!HALT THEN 60515000 - FLAG(604); 60515100 - CASE T2 OF 60516000 - BEGIN 60517000 - EMIT(T1); 60517100 - BEGIN 60518100 - IF STEPI=UNKNOWNID THEN FLAG(622); 60518110 - K~ELBAT[I]; 60518120 - IF GT1~TABLE(I+1)=LFTBRKT OR GT1=ATSIGN THEN 60518130 - BEGIN 60518140 - GT1~VARIABLE(FR); 60518150 - END ELSE 60518160 - BEGIN 60518170 - EMITN(K.ADDRESS); 60518180 - IF K.TYPE=FORMALNAMEP OR 60518190 - K.TYPE=FORMALNAMEQ THEN 60518200 - IF K.CLASS>BOOID AND 60518210 - (K.CLASS 0 THEN 60518980 - IF ELCLASS ! RTPARN THEN FLAG(623) ELSE STEPIT; 60518990 - GO TO SKIP2; 60519000 - END ELSE GO SKIP1; 60520000 - END; 60521000 - EMIT(MKST); 60522000 - IF TYPEF=FORMALNAMEQ 60522200 - THEN ITEMREFERENCE(FP) 60522300 - ELSE BEGIN EMITN(ADDRSF);STEPIT;END; 60522350 -COMMENT ITEMREFERENCE LEAVES IRW POINTING TO PCW IN TOS; 60522400 -SKIP1: 60523000 - N~(GT1~IF NOT FORMALF THEN GIT(ADDLADRES) ELSE 0).NOPAR; 60524000 -COMMENT THERE IS NO ADDL ENTRY FOR A FORMAL PROCEDURE; 60524100 - IF ELCLASS = LFTPRN THEN 60525000 - ACTUALPARAPART(FORMALF,ADDLADRES,GT1,TRUE) ELSE 60526000 - IF N!0 THEN ERR(604); 60527000 - IF T3=INTRINSIC THEN 60528000 - BEGIN 60528100 - IF T1.[30:6]=0 THEN EMIT(T1) ELSE 60528200 - BEGIN % PICK UP SYLLABLE FROM ADDL 60528250 - T2~T1.[30:6]; 60528300 - T2~ADDL[T2.LINKR,T2.LINKC]; 60528400 - EMIT1P(T1,T2); 60528500 - END; 60528600 - 60528700 - GO SKIP2 60528800 - END; 60528900 - EMIT(ENTR); 60529000 -SKIP2: IF TB1 AND NOT FROM THEN EMIT(DLET); 60530000 -COMMENT A CALL ON A FUNCTION FROM STMT REQUIRES A DLET ON RETURN; 60531000 - FINI: END PROCALL; 60532000 -INTEGER RETNBUG; COMMENT KLUDGE FOR BUG IN RETN OP; 60533XXX - PROCEDURE ACTUALPARAPART(FBIT,INDEX,AD,FROM); 60533000 - VALUE FBIT,INDEX,AD,FROM; 60534000 - BOOLEAN FBIT,FROM; 60535000 - INTEGER INDEX; 60536000 - REAL AD; 60537000 -COMMENT ACTUALPARAPART IS RESPONSIBLE FOR CONSTRUCTING ALL CALLS ON PAR-60538000 - AMETERS.IT HANDLES THE ENTIRE PARAMETER LIST WITH ONE 60539000 - CALL. IT IS ALSO RESPONSIBLE FOR CHECKING FOR NON-CORRE-60540000 - SPONDENCE OF THE ACTUAL AND FORMAL PARAMETERS. 60541000 - FBIT TELLS IF THE PROCEDURE BEING CALLED IS FORMAL OR 60542000 - NOT 60543000 - AD IS FIRST ADDL WORD FOR PROCEDURE OR QUEUE 60544000 - FROM TRUE IF CALL FROM PROCALL.FALSE IF FROM ENTRYEXP 60544100 - INDEX IS THE INDEX INTO ADDL (-VE IF FROM STOREITEM) 60545000 - ; 60545500 - BEGIN 60546000 - INTEGER PCTR,ACLASS,SCLASS; 60547000 - BOOLEAN INTRINSICFLAG %TURNED ON FOR INTRINSIC 60547500 - ,STOREITEMFLAG %TURNED ON FOR STOREITEM CALL 60547600 - ; 60547700 - 60548000 - 60549000 - 60550000 - DEFINE FL=FR#; 60550500 - 60551000 - 60552000 -COMMENT PCTR IS A COUNT OF THE NUMBER OF PARAMETERS COMPILED. 60553000 - ACLASS IS THE CLASS OF THE ACTUAL PARAMETER 60554000 - SCLASS IS THE CLASS OF THE FORMAL PARAMETER; 60555000 - REAL WHOLE; 60556000 -COMMENT WHOLE CONTAINS THE ELBAT WORD OF THE ACTUAL PARAMETERS; 60557000 - BOOLEAN VBIT,VP; 60558000 -COMMENT VBIT TELLS WHETHER THE PARAMETER IS TO BE CALLED BY 60559000 - VALUE OR BY NAME 60560000 - VP TELLS WHETHER PROCEDURE HAS VARIABLE NO. OF PARAMS; 60561000 - LABEL ANOTHER,NORMAL,STORE,LRTS,CERR,NMCALL,VE,LOADPAR,NAMCPAR60562000 - ,LP,DIMCHECK,COMMON,HANDLEARRAY,FINI,BS; 60563000 - REAL T1,T2,T3,T4,T5,T6,T7; 60564000 - BOOLEAN ITEMFLAG; %SET FOR ACTUALS WHICH ARE ITEM REFERENCES 60564100 -COMMENT *** THE FOLLOWING TWO MECHANISMS MIGHT PROFITABLY BE OPTIMISED; 60564200 - DEFINE NOTWORDARRAY=(ACLASS!WORDARRAYID OR SCLASSWORDARRAYID) AND (SCLASS!WORDARRAYID 60564400 - OR ACLASSEVENTARRAYID 60564500 - OR ACLASS=PCID)#, 60564600 - NOTWORDPROCID=(ACLASS!WORDPROCID OR SCLASSPTRPROCID) AND (SCLASS!WORDPROCID60564800 - OR ACLASSPTRPROCID)#, 60564850 - NOTFORMALWORDARRAY=SCLASS!WORDID AND SCLASS!WORDARRAYID# 60564855 - ; 60564900 -COMMENT *** PERHAPS THESE CAN BE REDUCED; 60565000 - LABEL 60566000 - L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17,L18,L19,L20, 60567000 - L21,L22,L23,L24,L25,L26,L27,L28,L29,L30,L31,L32,L33,L34,L35, 60568000 - L36,L37,L38,L40,L41,L42; 60569000 - DEFINE BOTTOM = 4#; 60570000 - SWITCH S ~L6 ,L7 ,L8 ,L9 ,L10 ,L11 ,L12 ,60571000 - L13 ,L40 ,L14 ,L15 ,L16 ,L17 ,L18 ,L19 ,L41 ,60572000 - L20 ,L21 ,L22 ,L23 ,L24 ,L25 ,L42 ,L26 ,L27 ,60573000 - L28 ,L29 ,L30 ,L31 ,L32 ,L33 ,L34 ,L35 ,L36 ,60574000 - %THIS PATCH FOR L37 MAKES STRNGCON LOOK LIKE NUMBER. USE THE 60574008 - %OPTAB SWITCH AS SOON AS WE GET A 6500. 60574009 - L37 ,L37 ; 60574100 -COMMENT THESE LABELS ARE ALL SCREWED UP. THERE IS NO CORRESPONDENCE 60575000 - BETWEEN THE NUMBERS IN THE LABELS AND THE CLASS VALUES IT 60576000 - WOULD BE WORTHWHILE CHANGING TO MNEMONIC LABELS LATER; 60577000 - 60578000 - COMMENT FOLLOWING MUST BE REMOVED LATER; 60579000 - FORMAT FMT ( " DEBUG ",3I6); 60580000 - FORMAT FMT1(" DEBUG ",4I9); COMMENT REMOVE LATER; 60580500 - INTEGER TEMPNO; 60581000 - INTEGER LOC; % LOCATION OF PCW IN THE SEGMENT, A WORD INDEX. 60581300 - BOOLEAN RETERN; 60581500 - DEFINE DEBUGLINE=IF DONSBUG THEN WRITE(LINE[DBL],FMT,ACLASS,SCLASS, 60582000 - TEMPNO)#; 60582001 - COMMENT END OF DEBUG DECLARATIONS; 60583000 - IF DONSBUG THEN 60583500 - WRITE (LINE[DBL],FMT,AD.NOPAR,N,10); COMMENT REMOVE LATER; 60584000 - INTRINSICFLAG ~ TYPEF=INTRINSIC; 60584500 - IF (STOREITEMFLAG~INDEX<0) THEN INDEX~ABS(INDEX); 60584800 - PCTR ~ 1; 60585000 - IF AD< 0 THEN BEGIN VP ~ TRUE;EMIT(ZERO) END ELSE VP~FALSE; 60586000 -COMMENT PROCEDURE HAS VARIABLE NUMBER OF PARAMETERS; 60587000 - ANOTHER:ACLASS ~ STEPI; WHOLE ~ ELBAT[I]; SCATTERELBAT; 60588000 -COMMENT SETUP FIELDS OF ACTUAL PAR;60589000 - IF FBIT OR VP THEN 60590000 - BEGIN VBIT ~ FALSE; SCLASS ~ FORMALID END 60591000 - ELSE 60592000 - BEGIN 60593000 - T7 ~ GIT(INDEX+PCTR); 60594000 - VBIT~((IF FROM THEN T7 ELSE T7~TAKE(T7.LINK)).TYPE 60594300 - =FORMALVALUEQ OR T7.TYPE=FORMALVALUEP); 60594500 - 60594600 - IF DONSBUG THEN 60594650 - WRITE(LINE[DBL],FMT,T7.TYPE,T7.CLASS,11); COMMENT REMOVE LATER; 60595000 -COMMENT *** ADDL WORDS OF PROCEDURE CONTAIN ELBAT WORDS FOR FORMAL 60596000 - PARAMETERS WHEREAS ADDL WORDS FOR QUEUE CONTAIN LINK TO60596100 - ITEM ELBATWORDS IS THIS DISTINCTION NECESSARY; 60596200 - IF SCLASS~ T7.CLASS{INTROAID AND SCLASS}REALPROCID THEN 60597000 - IF(SCLASS-REALPROCID) MOD INCR=1 THEN SCLASS~SCLASS-160598000 - ; 60599000 -COMMENT *** WHEN NOT FORMAL OR VARIABLE PARAMETER OBTAIN VBIT,SCLASS60600000 - FROM THE ADDL ENTRY FOR THE PROCEDURE. SCLASS MAY BE 60601000 - MODIEIED TO ELIMINATE DISTINCTION BETWEEN REAL AND INTE-60602000 - GER. NOTE DEPENDENCE UPON CLASS RELATIVITIES; 60603000 - 60604000 - IF NOT FROM AND NOT STOREITEMFLAG THEN 60604300 - BEGIN EMIT(DUPL);EMITNUM(T7.QINDEXF);EMIT(INDX) END;60604500 -COMMENT ACTUALPARAPART IS CALLED FROM ENTRYEXP WITH AN 60604800 - INDEXABLE DD IN THE TOP OF THE STACK, ALL ACTUAL 60604810 - PARAMETERS MUST BE PASSED TO THE SPACE REFERENCED BY60604820 - THIS DD (SEE BELOW). AT THIS POINT - I.E. AT THE 60604830 - BEGINNING OF PROCESSING FOR ALL PARAMETERS, AN 60604840 - INDEXED DD IS POINTING TO THE HOLE IN THE SPACE 60604850 - WHERE THE NEXT PARAMETER WILL BE PLACED; 60604860 - END; 60605000 - TEMPNO ~ 1; DEBUGLINE; COMMENT REMOVE LATER; 60606000 - IF NOT (ITEMFLAG~ITEMONLY(VBIT,SCLASS)) THEN 60606500 - IF T1~TABLE(I+1)!COMMA THEN 60607000 - IF T1 ! RTPARN THEN 60608000 -COMMENT THE ACTUAL PARAMETER HAS MORE THAN ONE LOGICAL QUANTITY60609000 - HENCE A DIFFERENT ANALYSIS IS REQUIRED; 60610000 - BEGIN 60611000 - IF ACLASS QUEUEARRAYID THEN 60612000 - BEGIN 60613000 -COMMENT THE ACTUAL PARAMETER DOES NOT START WITH AN ARRAY 60614000 - NAME, HENCE IT IS GENERAL EXPRESSION; 60615000 - NORMAL: IF VBIT OR VP OR ACLASS=EVENTARRAYID THEN 60616000 - VE: BEGIN COMMENT VALUE CALL OR REFERENCE CALL EPRSION;60617000 - T1~IF ELCLASS!EVENTID AND ELCLASS!EVENTARRAYID 60618000 - THEN EXPRSS ELSE VARIABLE(FP); 60618030 - IF DONSBUG THEN 60618050 - WRITE(LINE[DBL],FMT1,ELCLASS,T1.ARAYTPE,T1.ARAYDIM,16); 60618500 - IF VP OR ACLASS=EVENTARRAYID THEN INDXCHK 60619000 - END 60620000 - ELSE 60621000 - BEGIN COMMENT NAME CALL EXPRESSION; 60622000 - NMCALL: T2~ BUMPL; 60623000 -COMMENT T2 NOW HOLDS LOCATION FOR JUMP AROUND EXPRESSION;60624000 - T3 ~ INSERTPCW; 60625000 -COMMENT INSERTPCW CAUSES PCW TO BE PLACED BELOW 60626000 - MARKSTACK; 60627000 - T1~IF ELCLASS!EVENTID AND ELCLASS!EVENTARRAYID 60628000 - THEN EXPRSS ELSE VARIABLE(FP); 60628030 - IF DONSBUG THEN 60628050 - WRITE(LINE[DBL],FMT1,ELCLASS,T1.ARAYTPE,T1.ARAYDIM,15); 60628500 -COMMENT NOTE THAT PROTECTION AGAINST AN ATTEMPT TO STORE 60629000 - INTO AN EXPRESSION (INSIDE A PROCEDURE) IS PROV- 60630000 - IDED BY HARDWARE AND NOT (AS ON THE 5500) BY COM-60631000 - PILED CODE; 60632000 - INDXCHK; 60633000 -EMITN(RETNBUG~GETSTACK); EMIT(OVRD);EMITPAIR(RETNBUG,STFF); 60634XXX -RTNSTACK(RETNBUG); 60634YYY - EMIT(RETN); 60634000 - ENTERSEPA((LOC~T2 DIV 6 + 1),L,(LOC|6+9)); 60634100 -COMMENT THIS IS FOR SEPARATED COMPILING ONLY; 60634200 - EMITB(BRUN,T2,L); EMITN(T3); STUFF; 60634300 -COMMENT FINISH CODE AND COMPLETE BRANCH. AN IRW REFEREN- 60635000 - CING PCW PLACED IN STACK; 60636000 - END NAME CALL EXPRESSION; 60637000 - IF NOT BOOLEAN(T1.[01:01])%THEN IT"S NOT AN ARRAY. 60638000 - THEN ACLASS~(IF T1!EVTYPE THEN T1~BOOID ELSE 60638300 - EVENTID) 60638600 - ELSE 60638800 -COMMENT *** EXPRSS RETURNS TYPEPCID THEN ACLASS~ACLASS-INCRTWICE 60664000 - ELSE ACLASS~ACLASS-INCR; 60665000 - IF ACLASS= INTID THEN ACLASS~ REALID; 60666000 -COMMENT ACLASS NOW IS CLASS WHICH WOULD BE RETURNED BY EXPRSS; 60667000 -COMMENT *** THIS CODE IS KLUDEGY AND MAY BE WRONG- RECONSIDER LATER; 60668000 - GO TO BS; 60669000 - END NAME CALL SINGLY SUBSCRIPTED VARIABLE 60670000 - END ACTUAL PARAMETER WITH MORE THAN ONE LOGICAL QUANT;60671000 -COMMENT IF WE REACH THIS POINT THE ACTUAL PARAMETER IS A SINGLE 60672000 - LOGICAL QUANTITY; 60673000 - IF NOT ITEMFLAG THEN STEPIT; 60674000 - GO TO S[ACLASS-BOTTOM]; 60675000 - IF ACLASS=EVENTID THEN GO TO NAMCPAR; 60676000 - IF ACLASS=0 THEN FLAG(100) 60677000 - ELSE 60678000 - CERR: COMMENT ILLEGAL ACTUAL PARAMETERS FLAGGED HERE; 60679000 - L7:L8:L33: BEGIN FLAG(607); ERRORTOG ~ TRUE; GO TO COMMON END; 60680000 - L26: COMMENT PICTURE ID; 60681000 - IF FORMALF THEN EMITPAIR(ADDRSF,LOAD) ELSE 60682000 - COMMENT IF THE PICTURE WAS FORMAL, WE PASS IT ALONG. 60682020 - OTHERWISE WE GEN UP A THUNK; 60682040 - BEGIN 60682060 - T4 ~ 0 & (CURRENT+1) [30:42:6]; 60682080 - T2 ~ BUMPL; 60682100 - EMITPAIR(T4+2,LOAD); EMITPAIR(T4+3,LOAD); 60682120 - T5 ~ PICTUREGEN(FALSE,TRUE,TAKE(ELBAT[I-1]).LINK); 60682140 - EMITPAIR(T4+4,STOD); 60682160 - EMIT(RETN); 60682180 - T3 ~ INSERTPCW; 60682200 - EMITNUM(T5); 60682220 - EMIT(GREQ); 60682240 - EMITB(BRTR,BUMPL,T2); 60682260 - EMIT(NVLD); 60682280 - EMITB(BRUN,T2,L); 60682300 - EMITN(T3); STUFF 60682320 - END; 60682340 - GO TO BS; 60682360 - LOADPAR:IF VBIT THEN 60683000 - BEGIN 60683100 - %PATCH TO MAKE INTEGERS LOOK LIKE REALS--RATCHFORD, 11-16-68. 60683150 - I~I-2; STEPIT; 60683200 - IF ACLASS~EXPRSS+BOOID{INTROAID AND ACLASS}REALPROCID THEN 60683300 - IF (ACLASS-REALPROCID) MOD INCR=1 THEN ACLASS~ACLASS-1; 60683400 - END ELSE 60683500 - NAMCPAR: IF ITEMFLAG THEN ELSE BEGIN EMITN(ADDRSF); 60684000 - IF FORMALF THEN EMIT(LOAD) ELSE STUFF END; 60684500 - BS: IF SCLASS ! ACLASS THEN 60685000 - IF SCLASS ! FORMALID THEN 60686000 - IF SCLASS!WORDID AND ACLASS!WORDID THEN 60686200 - IF NOTWORDARRAY THEN 60686400 - IF NOTWORDPROCID THEN 60686600 -COMMENT ACTUAL AND FORMAL PARAMETERS DO NOT AGREE; 60687000 - BEGIN TEMPNO ~ 2; DEBUGLINE; FLAG(622); GO TO CERR; COMMENT FIX UP;END;60688000 - COMMON: 60689000 -COMMENT NEXT PARAMETER WILL BE EXAMINED; 60690000 - PCTR ~ PCTR+1; 60691000 - 60692000 - IF NOT FROM THEN 60692100 - BEGIN 60692200 -COMMENT WE ARE PROCESSING AN ENTRY EXPRESSION. PARAMETER IS IN TOP 60692300 - OF STACK, INDEXED DD IN SECOND WORD FROM TOP AND INDEXABLE 60692310 - DD IN THIRD WORD FROM TOP; 60692320 - EMIT(EXCH); 60692400 - EMIT(OVRD); 60692500 -COMMENT PARAMETER HAS BEEN TRANSFERRED TO SPACE FOR ENTRY.INDEX- 60692600 - ABLE DD POINTING TO THIS SPACE IS IN TOP OF STACK; 60692610 - END ENTRY EXPRESSION CASE; 60692700 - IF ELCLASS= COMMA THEN 60692750 - GO TO ANOTHER; 60692800 - 60692900 - IF ELCLASS ! RTPARN THEN BEGIN ERR (623);GO TO FINI END; 60693000 - IF NOT FBIT AND NOT VP THEN 60694000 - IF FROM AND AD.NOPAR+1!PCTR THEN 60695000 - BEGIN COMMENT WRONG NUMBER OF PARAMETERS; 60696000 - IF DONSBUG THEN 60696050 - WRITE(LINE[DBL],FMT,PCTR,AD.NOPAR,12); COMMENT REMOVE LATER; 60697000 - ERR(604); GO TO FINI 60698000 - END; 60699000 - STEPIT; GO TO FINI; 60700000 - L6: 60701000 -COMMENT PROCEDURE; 60702000 - TEMPNO ~ 3; DEBUGLINE; COMMENT REMOVE LATER; 60703000 - TB1~ TRUE; 60704000 - IF FORMALF THEN GO TO NAMCPAR; 60705000 - LP: IF TYPEF = INTRINSIC THEN BEGIN FLAG(620);GO TO CERR END; 60706000 -COMMENT ***INTRINSIC PROCEDURE AS ACTUAL PARAMETER- FIX UP LATER; 60707000 - IF T1 ~ GIT(WHOLE~TAKE(WHOLE).LINK).NOPAR =0 THEN 60708000 - BEGIN 60709000 -COMMENT THE PROCEOURE BEING PASSED HAS ZERO PARAMETERS; 60710000 - IF TB1 THEN GO TO NAMCPAR; COMMENT PROCID OR DPPROCID; 60711000 - IF NOT FBIT AND NOT VP THEN 60712000 - BEGIN 60713000 - TEMPNO ~ 4; DEBUGLINE; COMMENT REMOVE LATER; 60714000 - ACLASS ~ ACLASS+INCR; 60715000 - IF SCLASS{PTRPROCID THEN SCLASS~SCLASS+INCR; 60716000 - END; 60717000 -COMMENT *** ACTUAL PARAMETER IS ZERO PARAMETER FUNCTION-MAY BE PASSED60718000 - AS EXPRESSION IRRESPECTIVE OF CLASS OF FORMAL PARAMETER. 60719000 - CONVENIENT TO MODIFY(WHEN NECESSARY) SCLASS RATHER THAN 60720000 - ACLASS, NOTE DEPENDENCE ON RELATIVITIES OF CLASSES; 60721000 - GO TO LOADPAR 60722000 - END CASE OF ZERO PARAMETERS; 60723000 - TB1 ~ TRUE; 60724000 - FOR T2~1 STEP 1 UNTIL T1 60725000 - DO BEGIN 60726000 - IF (T3~GIT(WHOLE+T2)).TYPE=FORMALVALUEQ OR 60727000 - T3.TYPE=FORMALVALUEP THEN 60727100 -COMMENT THE T2-TH PARAMETER TO THE PROCEDURE BEING PASSED IS 60728000 - VALUE; 60729000 - BEGIN 60730000 - IF TB1 THEN 60731000 - BEGIN 60732000 -COMMENT THIS IS THE FIRST VALUE PARAMETER. WE CONSTRUCT 60733000 - THUNK HERE TO ENSURE THAT WHEN THIS PROCEDURE IS 60734000 - CALLED,ITS PARAMETERS THAT ARE VALUE GET CALLED BY60735000 - VALUE. THIS ONLY OCCURS WITH FIRST VALUE PARMETER;60736000 - TB1~FALSE ; COMMENT TURN OFF FOR FUTURE VAL PARS;60737000 - T5 ~ BUMPL; 60738000 - T6 ~ INSERTPCW; 60739000 - EMIT(MKST); 60739100 - EMITN(ADDRSF); 60739200 - FOR T4~2 STEP 1 WHILE T4{T2 DO 60739300 - BEGIN 60739400 -COMMENT SINCE WE FIND THE 1ST VALUE PARAMETER, WE RE-DO 60739500 - THOSE NAME CALLS WHICH WE DIDNOT CARE BEFORE; 60739600 - EMITN(T4&(CURRENT+1)[30:42:6]); 60739700 - STUFF; 60739800 - END; 60739900 - END CASE FOR FIRST VALUE PARAMETER; 60740000 -COMMENT WE CAN NOW BUILD CODE FOR VALUE CALL EVALUATION; 60741000 - EMITV((T2+1)&(CURRENT+1)[30:42:6]); 60742000 - END CASE FOR ANY VALUE PARAMETER ELSE 60743000 - IF TB1 THEN ELSE 60743100 - BEGIN 60743200 -COMMENT SINCE THERE ARE VALUE PARAMETERS, WE HAVE TO ALSO 60743300 - PASS THE NAME PARAMETERS; 60743400 - EMITN((T2+1)&(CURRENT+1)[30:42:6]); 60743500 - STUFF; 60743600 - END; 60743700 - END CHASING OF PARAMETERS TO PROCEDURE BEING PASSED; 60744000 - IF NOT TB1 THEN 60745000 - BEGIN 60746000 -COMMENT THERE WERE VALUE CALLS SO THUNK MUST BE COMPLETED; 60747000 - EMIT(ENTR); 60747500 - EMIT(IF RETERN THEN RETN ELSE EXIT); 60748000 - ENTERSEPA((LOC~T5 DIV 6 + 1),L,(LOC|6+9)); 60748500 -COMMENT FOR SEPARATED COMPILING ONLY, TEST IS IN THE DEFINE; 60748501 - EMITB(BRUN,T5,L); 60749000 - ADDRSF ~ T6 60750000 - END CASE OF VALUE PARAMETERS TO PROCEDURE BEING PASSED; 60751000 - TEMPNO ~ 5; DEBUGLINE; COMMENT REMOVE LATER; 60752000 - GO TO NAMCPAR; COMMENT MUST BE NAME CALL; 60753000 - L12: ACLASS~ REALPROCID; COMMENT CHANGE INTEGER TO REAL ID; 60754000 - L9:L10:L11:L13:L14:L40: 60755000 -COMMENT ALL TYPED PROCEDURES PROCESSED HERE; 60756000 - IF FORMALF THEN COMMENT PROCEDURE BEING PASSED IS FORMAL; 60757000 - BEGIN 60758000 - IF SCLASS>PTRPROCID THEN ACLASS~ACLASS+INCR; 60759000 -COMMENT *** THE FORMAL PARAMETER DOES NOT CALL FOR A PROCEDURE SO IT 60760000 - MUST CALL FOR AN EXPRESSION, NOTE USE OF RELATIVITIES; 60761000 - IF VBIT THEN BEGIN EMITV(ADDRSF);GO TO BS END 60762000 - ELSE GO TO NAMCPAR; 60763000 - END CASE WHERE PROCEDURE BEING PASSED IS FORMAL; 60764000 - RETERN~TRUE; 60764500 - TB1~ACLASS=DPPROCID; GO TO LP; 60765000 -COMMENT NO ZERO PARAMETER FUNCTION OPTIMIZATION FOR DPPROCID; 60765300 - L19:L20:L41: COMMENT REFERENCE,POINTER,WORD IDS; 60765500 - IF VBIT AND NOT ITEMFLAG THEN BEGIN EMITN(ADDRSF);EMIT(IF 60765600 - ACLASS=WORDID THEN LODT ELSE LOAD);GO TO BS END ELSE 60765800 - GO TO NAMCPAR; 60765850 - L18: ACLASS ~ REALID; 60766000 - L15:L16:L17: 60767000 -COMMENT ALL TYPED IDS PROCESSED HERE; 60768000 - IF VBIT THEN BEGIN IF ITEMFLAG THEN ELSE EMITV(ADDRSF); 60769000 - GO TO BS END ELSE GO TO NAMCPAR; 60770000 - L24:L30:ACLASS~ REALARRAYID; 60771000 -COMMENT INTEGER ARRAYS CHANGED TO REAL; 60772000 - GO TO HANDLEARRAY; 60773000 - L32: ACLASS~ REFARRAYID; COMMENT QUEUARRAYS LOOK LIKE REFARRAYS; 60774000 - GO TO HANDLEARRAY; 60775000 - L27:L28:L29: 60776000 - ACLASS ~ ACLASS-INCR; 60777000 -COMMENT ***READ ONLY ARRAYS NOW LOOK LIKE REGULAR ARRAYS. 60778000 - ; 60779000 - HANDLEARRAY: 60780000 - L21:L22:L23:L25:L31:L42: 60781000 -COMMENT ARRAYS HANDLED HERE; 60782000 - IF NOT ITEMFLAG THEN 60782500 - EMITN(ADDRSF); 60783000 - IF INTRINSICFLAG AND VBIT THEN EMIT(LODT) ELSE 60784000 - 60784001 - IF NOT ITEMFLAG THEN IF FORMALF THEN EMIT(LOAD) ELSE STUFF; 60784300 -COMMENT AN INTRINSIC VALUE CALL EXPECTS THE DD; 60784600 - T1.ARAYDIM ~ GIT(TAKE(WHOLE).LINK).NODIM; 60785000 - GO TO DIMCHECK; 60786000 - L34: COMMENT QUEUEID; 60787000 - ACLASS ~ REFID; 60788000 - GO TO LOADPAR; 60789000 - L35: COMMENT NULLV; 60790000 - EMIT(ZERO);EMITNUM(5);EMIT(STAG);GO TO BS; 60791000 -COMMENT *** FORMAT OF NULLV NOT YET DETERMINED; 60792000 - L36: COMMENT TRUTHV; 60793000 - ACLASS ~ BOOID; EMIT(ADDRSF); GO TO BS; 60794000 - L37: COMMENT NUMBER; 60795000 - I ~ I-2; STEPIT; 60796000 - IF SCLASS = FORMALID THEN T1~EXPRSS ELSE 60796500 - EXPRESSION(SCLASS-BOOID); 60797000 - IF DONSBUG THEN 60797050 - WRITE(LINE[DBL],FMT1,ELCLASS,T1.ARAYTPE,T1.ARAYDIM,16); 60797500 - ACLASS ~ SCLASS; 60798000 - GO TO BS; 60799000 -L38: 60800000 -COMMENT *** HANDLING OF DOUBLE PRECISION NUMBERS RAISES SOME PROBLEMS AT60801000 - PRESENT HENCE KLUDGE.CHANGE AS SOON AS POSSIBLE; 60802000 - FINI : END ACTUALPARAPART; 60803000 -INTEGER PROCEDURE INSERTPCW; 60804000 -COMMENT INSERTPCW CAUSES PCW TO BE PLACED BELOW MARKSTACK AND RETURNS 60805000 - ITS LOCATION; 60806000 - 60806010 - IF CURRENT = 0 THEN 60806100 - BEGIN 60806150 - JUMPCHKNX; 60806180 - GLOBALPCW(INSERTPCW~GETSPACE(-0),SEGNO,L,STATE); 60806200 - END ELSE 60806250 - BEGIN 60807000 - JUMPCHKX; COMMENT THIS IS BLOCKHEAD CODE; 60807500 - INSERTPCW ~ GETSPACE(-CURRENT); 60808000 - EMITPCW(CURRENT+1,(L DIV 6)|6+15,STATE,SEGNO); 60809000 - JUMPCHKNX; 60809500 - END INSERTPCW; 60810000 - 60810010 - BOOLEAN PROCEDURE ITEMONLY(VBIT,SCLASS);VALUE VBIT,SCLASS; 60810020 - BOOLEAN VBIT; INTEGER SCLASS; 60810040 -COMMENT WHEN THE ACTUAL PARAMETER IS EITHER: 60810060 - OR60810080 - @ OR60810100 - 60810120 - (WHERE ITEM IS PROCEDURE EITHERUNTYPED OR 60810140 - TYPED WITH FORMAL PARAMETER TYPED 60810160 - PROCEDURE ALSO) 60810170 - IT IS COMPILED AND THE VALUE TRUE IS RETURNED.OTHER- 60810180 - WISE FALSE IS RETURNED; 60810200 - BEGIN 60810220 - LABEL FINI; 60810230 - BOOLEAN NAMEFLAG; 60810240 - INTEGER ELCLAS; 60810260 - IF KLASSF=NUMBER THEN BEGIN ITEMONLY~FALSE ;GO FINI;END; 60810270 - IF (ITEMONLY~ 60810280 - ((NAMEFLAG~TYPEF=FORMALNAMEQ) OR TYPEF=FORMALVALUEQ) AND 60810300 - (((ELCLAS~ 60810320 - TABLE(I+1))=ATSIGN AND TABLE(I+2)=REFID) OR 60810340 - (ELCLAS=COMMA OR ELCLAS=RTPARN) OR60810350 - 60810360 - 60810380 - KLASSF=PROCID OR 60810400 - (RANGE(BOOPROCID,PTRPROCID) AND SCLASS}BOOPROCID AND 60810420 - SCLASS{PTRPROCID))) 60810440 - THEN 60810460 - BEGIN 60810480 - ITEMREFERENCE(FP); 60810500 - IF NAMEFLAG 60810520 - THEN IF VBIT 60810540 - THEN EMIT (IF KLASSF=WORDID THEN LODT ELSE 60810560 - LOAD) 60810580 - ELSE 60810600 - ELSE IF VBIT 60810620 - THEN 60810640 - IF ELCLASS!PERIODV THEN ELSE 60810642 - BEGIN 60810644 - IF STEPI = TAGV THEN 60810646 - BEGIN EMIT(RTAG); STEPIT END ELSE60810647 - IF GT1~DOTIT =0 THEN EMIT(DISO) 60810648 - ELSE 60810650 - EMITI(GT1.[36:6],GT1.[42:6]); 60810652 - END 60810654 - ELSE INDXCHK 60810660 - END; 60810680 -FINI: 60810690 - END ITEMONLY; 60810700 -PROCEDURE COMPOUNDTAIL; 60811000 - COMMENT COMPOUNDTAIL COMPILES COMPOUNDTAILS. IT ALSO ELIMINATES 60812000 - COMMENTS FOLLOWING ENDS. AFTER ANY ERROR, ERROR MESSAGES ARE 60813000 - SUPPRESSED. COMPOUNDTAIL IS PARTIALLY RESPONSIBLE FOR 60814000 - RESTORING THE ABILITY TO WRITE ERROR MESSAGES. SOME CARE IS 60815000 - ALSO TAKEN TO PREVENT READING BEYOND THE "END."; 60816000 - BEGIN LABEL ANOTHER; 60817000 - I~I-1; 60818000 -ANOTHER: ERRORTOG~TRUE; % ALLOW ERROR MESSAGES 60819000 - CONTEXT ~ 2; 60820000 - STEPIT; 60821000 - STATEMENT; 60822000 - IF ELCLASS=SEMICOLON THEN GO ANOTHER; 60823000 - IF ELCLASS!ENDV THEN 60824000 - BEGIN ERR(624); % MISSING SEMICOLON OR END 60825000 - GO ANOTHER; 60826000 - END; 60827000 - ENDTOG~TRUE; 60828000 - DO CONTEXT~3 % END COMMENTARY 60829000 - UNTIL STEPI } SEMICOLON AND ELCLASS { ELSEV OR NOT ENDTOG; 60830000 - ENDTOG~FALSE; 60831000 - CONTEXT ~ 2; 60832000 - IF BEGINCTR~BEGINCTR-1!0 EQV ELCLASS=PERIODV THEN 60833000 - BEGIN IF BEGINCTR=0 THEN 60834000 - BEGIN FLAG(625); % EXTRA END 60835000 - BEGINCTR~1; GO ANOTHER; 60836000 - END; 60837000 - FLAG(626); % MISSING END 60838000 - END; 60839000 - IF ELCLASS=PERIODV THEN 60840000 - BEGIN 60841000 - CBUFF[0] ~ "ND;END."&"E"[1:43:5]; 60842000 - DONE~TRUE; 60843000 - NCR~READACARD; 60844000 - ELBAT[I~I-2]~SPECIAL[46]; 60845000 - ELCLASS~SEMICOLON; 60846000 - END; 60847000 - END COMPOUNDTAIL; 60848000 - PROCEDURE QSTMT; 60851000 -COMMENT COMPILES THE QUEUE ASSIGNMENT STATEMENT 60852000 - THE QUEUE ASSIGNMENT STATEMENT IS OF THE FORM: 60853000 - ::= WHERE 60854000 - ::=/[INDEX] 60856000 - MOST OF THE WORK IS DONE BY QALGORITHM; 60857000 - BEGIN COMMENT (MCS 1); 60858000 - DEFINE ADDLADRES = N#, % LINK TO ADDL ENTRY FOR Q 60859000 - PARINFO = GT1#; % INFORMATION ON PARAMETERS TO 60860000 - % INSERT 60861000 - % =2 ONE PARAMETER ONLY 60862000 - % =3 TWO PARAMETERS 60863000 - PARINFO ~ 2; 60864000 - ADDLADRES ~ TAKE(ELBAT[I]).LINK; 60865000 - IF ELCLASS= QUEUEARRAYID THEN 60866000 - ADDLADRES ~ ADDLADRES + 1; 60867000 -COMMENT *** FIRST WORD OF ADDL FOR A QUEUE ARRAY CONTAINS INFOR- 60868000 - MATION ON BOUNDS; 60869000 - IF STEPI = LFTBRKT THEN PARINFO ~ 3; 60870000 - QALGORITHM (PARINFO, ADDLADRES,FALSE) 60871000 - END QSTMT MCS1 ; 60872000 - PROCEDURE QALGORITHM(PARINFO,ADDLADRES,FROM); VALUE PARINFO,ADDLADRES, 60873000 - FROM; 60874000 - INTEGER PARINFO, % =0 EXPLICIT CALL I AT ALGORITHM ID 60875000 - % =1 IMPLICIT CALL ON ALLOCATE, I AT LFTPRN60876000 - % =2 IMPLICIT CALL ON INSERT,I AT ASSNOP 60877000 - % =3 IMPLICIT CALL ON INSERT,I AT LFTBRKT 60878000 - ADDLADRES; % HOLDS LINK TO FIRST (QUEUEID) OR 60879000 - % SECOND (QEUEARRAYID) WORD OF QADDL FOR 60880000 - % IMPLICIT CALLS 60881000 - BOOLEAN FROM; % FALSE IF CALL IS FROM STATEMENT 60882000 -COMMENT COMPILES CODE FOR EXPLICIT OR IMPLICIT CALLS ON QUEUE ALGORITHMS60883000 - DETERMINES THE NUMBER AND TYPE OF ACTUAL PARAMETERS TO BE PASSED60884000 - WHEN THERE ARE FEWER ACTUAL PARAMETERS THAN REQUIRED CONSTRUCTS 60885000 - APPROPRIATE DUMMY PARAMETERS 60886000 - THIS PROCEDURE IS CALLED FROM QSTMT TO HANDLE IMPLICIT CALL 60887000 - ON INSERT. IT IS ALSO CALLED TO HANDLE THE IMPLICIT ALLOCATE 60888000 - ASSOCIATED WITH AN ENTRY EXPRESSION. 60888500 - THE FACILITIES SIZE,BUSY,LOCK AND UNLOCK ARE HANDLED HERE 60889000 - HOWEVER IN-LINE CODE RATHER THAN PROCEDURE ENTRY IS RESULT 60890000 - NOTE THAT BUSY,LOCK AND UNLOCK CAN REFERENCE OTHER THAN QUEUES 60890500 - HOWEVER IT IS CONVENIENT TO HANDLE THEM HERE 60890505 - ; 60890800 -COMMENT *** SHOULD THIS PROCEDURE HANDLE BOTH IMPLICIT AND EXPLICIT 60891000 - CALLS; 60892000 - BEGIN COMMENT (MCS 1); 60893000 - INTEGER KEY, % ALGORITHM KEY 60894000 - DESCPARA,% PARAMETER DESCRIPTION 60895000 - NOPAR, % NUMBER OF PARAMETERS 60896000 - TYPEA; % TYPE OF ALGORITHM 60897000 - INTEGER ARRAY ACTUALP[1:2]; %HOLDS CLASS OF FORMAL PAR 60898000 - BOOLEAN MISSINGACTUAL; % SET WHEN FEWER ACTUAL THAN 60899000 - % FORMAL PARAMETERS 60899050 - BOOLEAN NOTQUEUE %INDICATES NON Q 60899500 - , TB %SCRATCH 60899600 - , ISVALUE %INDICATES VALUE ITEMREFRNCE60899700 - , BUZZF %INDICATES BUZZ ALGORITHM 60899800 - ; 60899900 - DEFINE BUZF=BUZZF#; 60900000 - BOOLEAN GTB1; %SCRATCH 60900500 - INTEGER N; 60900550 - LABEL ON,QUIT,ENDPAR,STAP,FINISH,FINI,EMITENTER,ANOTHER; 60901000 - LABEL ISRTPARN,WHEREFROM,CONTINUE; 60901500 - REAL ELCLAS; 60901520 - LABEL RESIGN,LOCKL; 60901530 - REAL GT4,GT5; 60901540 - LABEL CONTINU ; 60901545 - REAL GT1,GT2,GT3; 60901550 -COMMENT FOLLOWING MUST BE REMOVED LATER; 60901551 -FORMAT FMT4 (" ITEMINFO ", 10I9); 60901552 -INTEGER DT1,DT2,DT3,DT4,TEMPNO; 60901553 - DEFINE DEBUG = IF DONSBUG THEN#; 60901554 -DEFINE 60901555 -D4 = DEBUG WRITE(LINE[DBL],FMT4,TD.ADDRESS,TD.ALGNO,TD.TYPE,TD.PARADESC 60901556 -,TEMPNO,DT1,DT2,DT3,DT4)#; 60901557 -REAL TD; 60901558 - MISSINGACTUAL~FALSE; 60902000 -COMMENT*** NOTQUEUE~TB~ISVALUE~BUZZF~FALSE; %IMPLIED BY PREVIOUS STMNT 60902500 - GT3~0; 60902600 - IF PARINFO ! 0 THEN GT2~GIT(ADDLADRES); 60902800 - IF PARINFO = 0 60903000 - THEN 60904000 - BEGIN COMMENT (MCS 2) EXPLICIT CALL; 60905000 - KEY~(GT1~TAKE(ELBAT[I])).ALGNO; 60906000 - IF STEPI ! LFTPRN THEN BEGIN FLAG(629);GO QUIT END; 60907000 - GTB1~KEY}LOCKKEY AND KEY{UNLOCKKEY; 60907500 - IF STEPI!QUEUEID AND ELCLASS!QUEUEARRAYID 60908000 - THEN BEGIN COMMENT MCS2AA; 60908200 - NOTQUEUE~TRUE ; 60908400 - IF NOT GTB1 THEN GO RESIGN; 60908600 - IF((ELCLAS~ELCLASS)}BOOID AND ELCLASS{PTRID60908700 - )60908750 - THEN IF(ISVALUE~(GT2~(GT5~TAKE(ELBAT[I])60908800 - ).TYPE)=FORMALVALUEQ) OR 60908801 - GT2=FORMALNAMEQ 60908900 - THEN BEGIN ITEMREFERENCE(FP); 60909000 - GO TO LOCKL;END 60909030 - ELSE BEGIN GT3~ELBAT[I].ADDRESS; 60909050 - GO CONTINU ;END; 60909100 -TEMPNO~5;DT1~ELCLASS;DT2~ELCLAS;D4; 60909200 - IF(ISVALUE~((ELCLAS~(ELCLASS-INCR))}BOOID 60909300 - AND ELCLAS{WORDID)) 60909400 - THEN IF VARIABLE(FP)[]~61018000 - REVERSES THE ORDER OF PARAMETERS REQUIRED BY INSERT 61019000 - HENCE WE MUST EXCHANGE THE TWO ACTUAL PARAMETERS; 61020000 - EMIT (ENTR); 61021000 - IF TYPEA ! PROCD AND NOT FROM THEN EMIT(DLET); 61022000 -COMMENT WHEN CALL IS FROM STATEMENT AND WE HAVE A TYPED 61023000 - ALGORITHM THEN WE MUST DELETE RESULT; 61024000 - GO FINI; 61025000 - QUIT: FLAG(635); 61025200 - ERRORTOG~TRUE; 61025400 - FINI: END MCS 1 QALGORITHM; 61025600 - PROCEDURE EVENTINTRINSIC; 61026000 -COMMENT THE ELBAT WORD OF THE EVENT INTRINSIC HAS A KEY IN FIELD "KIND"61026005 - WHICH IDENIFIES THE PARTICULAR INTRINSIC. THIS PROCEDURE 61026010 - FIRST CHECKS THE PARAMETER(S), THEN TAKES THE FOLLOWING ACTION:61026015 - CAUSE ONE PARAMETER ONLY. EMITS CODE TO ENTER THE MCP 61026020 - WAIT PROCEDURE "EVENTHANDLER", PASSING AS PARAMETERS 61026025 - THE KEY(BY VALUE) AND THE EVENT (BY NAME) 61026030 - 61026035 - 61026040 - SET TURNS ON (SET) OR OFF THE HAPPENED BIT IN THE 61026045 - RESET EVENT REFERENCED BY EACH PARAMETER 61026050 - 61026055 - 61026060 - FIX TURNS ON (FIX) OR OFF THE AVAILABLE BIT IN THE 61026065 - FREE EVENT REFERENCED BY EACH PARAMETER 61026070 - 61026075 - 61026080 - ENABLE TURNS ON MCP SOFTWARE INTERRUPT LOCK (IN KNOWN 61026085 - DISABLE LOCATION IN MCP STACK) THUS PREVENTING MCP 61026090 - ACCESS TO EVENT INTERRUPT QUEUE. TURNS ON 61026095 - (ENABLE) OR OFF THE ENABLE BIT IN THE INTERRUPT 61026100 - REFERENCED BY EACH PARAMETER. TURNS OFF MCP 61026105 - SOFTWARE INTERRUPT LOCK 61026110 - NOTE THE PARAMETER(S) TO ENABLE AND DISABLE ARE 61026115 - INTERRUPTS RATHER THAN EVENTS, HOWEVER IT IS 61026120 - CONVENIENT TO HANDLE THEM HERE 61026125 - 61026130 - 61026135 - HAPPENED CAN HAVE ONLY ONE PARAMETER. RETURNS VALUE OF 61026140 - AVAILABLE HAPPENED OR AVAILABLE BIT FOR THE EVENT REFER- 61026145 - ENCED BY THE PARAMETER.EQUIVALENT TO BOOLEAN 61026150 - PROCEDURE 61026155 - 61026157 - 61026159 - SECONDWORD LEAVES SECOND WORD OF EVENT OR DOUBLE ON TOS 61026161 - PRESUMES EVENT HAS BEEN LOCKED PREVIOUSLY 61026163 - 61026170 - 61026172 - STOREITEM NOT REALLY AN EVENT INTRINSIC BUT CONVENIENT TO 61026174 - HANDLE IT HERE.CALLS ACTUALPARAPART WHICH TREATS61026176 - FIRST PARAMETER(WHICH MUST BE AN ITEM REFERENCE 61026178 - ) AS FORMAL AND SECOND AS ACTUAL PARAMETER 61026180 - 61026197 - 61026198 - 61026199 - ; 61026200 -BEGIN 61026300 - INTEGER KEY % TELLS WHICH INTRINSIC 61026400 - ; 61026500 - LABEL RESIGN 61026600 - , FINI 61026630 - , CHECK 61026640 - ; 61026650 - BOOLEAN TB1 61026700 - ; 61026800 - 61027000 - REAL GT1 61027100 - , GT2 61027150 - ; 61027200 - DEFINE SOFTWAREINTERRUPTLOCK = 17# %FIXED MCP LOCATION 61027300 - , ISOLATEHAPPEN = 1,1# %ISOLATE FOR HAPPEN BIT61027310 - , EMITI(EMITI1) =EMIT2P(ISOL,EMITI1)#%FAKE OUT BILL 61027315 - , ENABLEP = 46# % ENABLE BIT POSITION 61027320 - , AVAILABLEP = 2# %AVAILABLE BIT POSITION61027330 - , HAPPENEDP = 1# %HAPPENED BIT POSITION 61027340 - , LOCKBITP = 0 # 61027345 - , ISOLATEAVAILABLE= 2,1# %ISOLATE AVAILABLE BIT 61027360 - , EVENTHANDLER = 15# %FIXED MCP LOCATION 61027380 - , INDXNLOADCHK=BEGIN IF GET(L-1)=LOAD THEN 61027382 - L~L-1 ELSE INDXCHK END# 61027384 - ; 61027400 - TB1 ~ ELBAT[I] < 0; ELBAT[I] ~ ABS(ELBAT[I]); 61027410 - KEY~TAKE(ELBAT[I]).KIND; 61027500 - IF STEPI!LFTPARN THEN GO RESIGN ; 61027600 - CASE KEY DIV 10 OF 61027700 - BEGIN COMMENT MCS 1; 61027800 - 61027820 - 61027840 - BEGIN COMMENT CAUSE AND WAIT; 61027900 - EMIT (MKST); 61028000 - EMITN(EVENTHANDLER); 61028100 - IF STEPI=ANEVENT 61028200 - THEN BEGIN EMITN((GT1:=ELBAT[I]).ADDRESS); 61028300 - IF GT1.TYPE = FORMALNAMEP THEN 61028310 - EMIT(EVAL) ELSE EMIT(STFF); STEPIT; 61028320 - END 61028330 - ELSE IF VARIABLE(FP) =EVTYPE THEN INDXNLOADCHK 61028400 - ELSE FLAG(670); 61028450 - EMITBUZEVENT; 61028452 -COMMENT IN TOS AT THIS POINT-POINTER TO EVENT (IRW OR INDEXED DD),61028454 - FIRST WORD OF EVENT (WITH DOUBLE TAG); 61028456 - EMITNUM(KEY); 61028500 - EMIT(ENTR); 61028550 - END ; % CAUSE,WAIT 61028600 - 61028700 - 61028750 - DO 61028800 - BEGIN COMMENT SET AND RESET 61028900 - FIX AND FREE ;61029000 - IF STEPI=ANEVENT 61029100 - THEN BEGIN EMITN((GT1:=ELBAT[I]).ADDRESS); 61029200 - IF GT1.TYPE = FORMALNAMEP THEN 61029210 - EMIT(EVAL); STEPIT; 61029220 - END 61029230 - ELSE IF ELCLASS=EVENTID OR ELCLASS=EVENTARRAYID THEN 61029400 - IF VARIABLE(FP)=EVTYPE THEN INDXNLOADCHK 61029500 - ELSE FLAG(670) 61029505 - ELSE IF KEY=SETKEY OR KEY=RESETKEY THEN 61029510 - BEGIN 61029520 - EXPRESSION(ATYPE); 61029525 - IF ELCLASS!COMMA THEN FLAG(670); 61029530 - STEPIT; 61029532 - IF ELCLASS = NUMBER AND NOT DPTOG THEN 61029534 - IF TABLE(I+1)=RTPARN 61029535 - THEN 61029536 - BEGIN 61029538 - EMIT1P(IF KEY=SETKEY THEN BSET 61029540 - ELSE BRST, THI DIV 1); 61029542 - STEPIT; 61029544 - IF NOT TB1 THEN EMIT(DLET); 61029546 - GO CHECK; 61029548 - END; 61029550 - GT1 ~ AEXP; 61029552 - EMIT(IF KEY=SETKEY THEN DBST ELSE DBRS); 61029554 - IF TB1 THEN ELSE EMIT(DLET); 61029555 - GO TO CHECK; 61029560 - END 61029570 - ELSE FLAG(670); 61029600 -COMMENT AT THIS POINT WE HAVE TO EMIT CODE FOR BUZZING EVENT; 61029610 - EMITBUZEVENT; 61029620 -COMMENT IN TOS AT THIS POINT-POINTER TO EVENT(IRW OR INDEXED DD), 61029640 - FIRST WORD OF EVENT(WITH DOUBLE TAG); 61029660 - L ~ L - 3; % COVER THE ZERO STAG 61029700 - FIGS ~ TRUE; 61029710 - EMIT1P(BRSET,LOCKBITP); 61029800 - FIGS ~ FALSE; 61029810 - IF KEY=FIXKEY AND FIXCALL THEN 61029820 -BEGIN EMIT(DUPL); EMIT2P(ISOL,AVAILABLEP,1);EMIT(RSDN); END; 61029840 - EMIT1P(IF KEY = SETKEY OR KEY=FIXKEY THEN BSET ELSE BRSET,61029850 - IF KEY =FIXKEY OR KEY =FREEKEY THEN AVAILABLEP ELSE 61029900 - HAPPENEDP); 61029950 - EMIT(OVRD); 61030000 - END UNTIL ELCLASS!COMMA; % FINISH SET,RESET 61030300 - % FIX,FREE 61030400 - 61030430 - 61030460 - BEGIN COMMENT ENABLE AND DISABLE; 61030500 - EMIT(ONE); 61030600 - EMITN(SOFTWAREINTERRUPTLOCK); 61030700 - EMIT(STOD); 61030800 -COMMENT *** MAYBE WE NEED A READ WITH LOCK. I HOPE THIS LOCKP OUT 61030900 - ALL INTERRUPT BASHERS EXCEPT THOSE WHO ONLY WANT TO TURN 61031000 - THE LOCK; 61031100 - DO 61031200 - BEGIN COMMENT MCS 2; 61031300 - IF STEPI!INTERRUPTID THEN FLAG(671); 61031400 - EMITN(GT1~ELBAT[I].ADDRESS); 61031500 - EMIT(LODT); 61031600 - EMIT1P(IF KEY =ENABLEKEY THEN BSET ELSE BRSET 61031700 - ,ENABLEP); 61031800 - EMITN(GT1); 61031900 - EMIT(OVRD); 61032000 - STEPIT 61032100 - END UNTIL ELCLASS!COMMA; 61032200 - EMIT(ZERO); 61032300 - EMITN(SOFTWAREINTERRUPTLOCK); 61032400 - EMIT(STOD); 61032500 - END; % ENABLE, 61032600 - % DISABLE 61032700 - 61032800 - 61032900 - BEGIN COMMENT HAPPENED,AVAILABLE; 61033000 - STEPIT; 61033100 - IF VARIABLE(FP)!EVTYPE THEN FLAG(670); 61033200 - IF KEY =HAPPENEDKEY THEN EMITI(ISOLATEHAPPEN) 61033300 - ELSE EMITI(ISOLATEAVAILABLE); 61033350 - 61033380 - END; % HAPPENED,AVAILABLE; 61033400 - 61033430 - 61033460 - 61033462 - 61033464 - BEGIN COMMENT SECONDWORD; 61033466 - STEPIT; 61033467 - IF GT1~VARIABLE(FP)!EVTYPE AND GT1!ETYPE THEN FLAG(680); 61033468 - EMIT(SPLT ); 61033470 - EMIT(EXCH);EMIT(DLET); 61033480 -COMMENT THE SECOND WORD WITH SP TAG IS NOW IN TOS; 61033482 - END; % SECONDHALF 61033490 - 61033492 - 61033494 - 61033500 - BEGIN COMMENT STOREITEM; 61033503 - STEPIT; 61033506 - GT1~ TAKE(ELBAT[I]); 61033507 - ITEMREFERENCE(FP); INDXNLOADCHK; 61033511 - ACTUALPARAPART ( 61033513 - FALSE , 61033516 - 61033519 - - ((GT2 ~ TAKE ( 61033522 - IF(GT3~GT1.CLASS)>EVENTARRAYID 61033525 - OR GT30 OR NEWDP>0 OR NEWCT>0 OR COMMAFLAG THEN 61179000 - BEGIN OP ~ OP + 8; UPDATETOG ~ TRUE; END; 61180000 - EMIT(OP); 61181000 - IF NOT UPDATETOG THEN GO TO EXIT; 61182000 - IF NEWCT ! -1 THEN 61183000 - IF NEWCT = 0 THEN EMIT(DLET) ELSE 61184000 - EMITPAIR(NEWCT.ADDRESS, STOD); 61185000 - DOSP: 61186000 - IF NEWSP}0 THEN 61186500 - IF NEWSP = 0 THEN EMIT(DLET) ELSE 61187000 - EMITPAIR(NEWSP.ADDRESS, OVRD); 61188000 - IF COMMAFLAG THEN 61189000 - CONTINUE: 61190000 - BEGIN 61191000 - NEWCT ~ NEWSP ~ 0; 61192000 - COMMAFLAG ~ UPDATETOG ~ FALSE; 61193000 - GO TO SOURCEPART; 61194000 - END; 61195000 - DODP: 61196000 - IF NEWDP = 0 THEN EMIT(DLET) ELSE 61197000 - EMITPAIR(NEWDP.ADDRESS, OVRD); 61198000 - GO TO EXIT; 61199000 -PTRFORCOUNT: 61200000 - STEPIT; TYPE ~ AEXP; 61201000 - IF ELCLASS=WORDV OR OVERITOG~ELCLASS=OVERITE THEN 61202000 - BEGIN 61203000 - STEPIT; 61204000 - OP ~ TWSD + REAL(OVERITOG); NEWCT ~ -1; 61205000 - GO TO EMITOP; 61206000 - END; 61207000 -DOIT: 61207100 - IF ELCLASS = WHILEV OR ELCLASS = UNTILV THEN GO TO CONDITION; 61208000 - IF ELCLASS = WITHV THEN 61209000 - BEGIN 61210000 - MAKEARRAYROW; 61211000 - IF NEWSP < 0 THEN NEWSP ~ 0; IF NEWDP < 0 THEN NEWDP ~ 0;61212000 - OP ~ TRNS - 8|REAL(NEWSP~NEWDP!0 OR ELCLASS=COMMA); 61224000 - UPDATETOG ~ TRUE; NEWCT ~ -1; 61225000 - GO EMITOP; 61226000 - END; 61227000 - OP ~ TUND; 61228000 - GO TO EMITOP; 61229000 -STRINGSORCE: 61230000 - STRINGSOURCE; 61231000 - TYPE ~ COUNT; STEPIT; 61232000 - IF ELCLASS ! FORV THEN 61233000 - BEGIN 61234000 - EMITNUM(TYPE); 61235000 - OP ~ TUND; 61236000 - GO TO EMITOP; 61237000 - END; 61238000 - STEPIT; TYPE ~ AEXP; 61239000 - GO TO UNITS; 61240000 -AEXPSOURCE: 61241000 - IF TYPE!ATYPE AND TYPE!ITYPE AND TYPE!ETYPE AND TYPE!WTYPE THEN61242000 - FLAG(638); 61243000 - IF ELCLASS ! FORV THEN 61244000 - BEGIN 61245000 - EMIT(ONE); OP ~ TWSD; NEWCT ~ -1; 61246000 - GO TO EMITOP; 61247000 - END; 61248000 - STEPIT; TYPE ~ AEXP; 61249000 - IF Q = "6DIGI" THEN 61250000 - BEGIN 61251000 - STEPIT; 61252000 - EMIT(DUPL); EMIT(RSDN); 61253000 - IF ERROR573 THEN 61254000 - BEGIN %AEXP SOURCE W/ UPDATE ARITH VARIABLE 61254100 - ERROR573~FALSE; 61254200 - EMIT(DSRS); %SAVES THE QUOTENT IN THE UPDATE VARIABLE 61254300 - 61254350 - EMIT3(NEWSP.ADDRESS); 61254400 - EMIT(STOD); 61254500 - END ELSE 61254600 - BEGIN 61254610 - EMIT(DSRF); 61254700 - END; 61254720 - EMIT(EXCH); 61254800 - OP ~ UABD; %SOMEBODY OUGHTA ALLOW FOR SIGN SOMETIME. 61255000 - NEWCT ~ - 1; 61256000 - NEWSP ~ 0; 61256100 - GO TO EMITOP; 61257000 - END; 61258000 -UNITS: 61259000 - IF ELCLASS = WORDV THEN 61260000 - BEGIN 61261000 - STEPIT; 61262000 - OP ~ TWSD; NEWCT ~ -1; 61263000 - GO TO EMITOP; 61264000 - END; 61265000 - IF ELCLASS = OVERITE THEN 61266000 - BEGIN 61267000 - STEPIT; 61268000 - OP ~ TWOD; NEWCT ~ -1; 61269000 - GO TO EMITOP; 61270000 - END; 61271000 - IF ELCLASS { IDMAX THEN 61271100 - IF Q = "9CORR" THEN 61271150 - BEGIN 61271200 - INSERT(5,"ECTLY",ACCUM[9],0); 61271250 - IF CMPCHREQL(5,ACCUM[2],ACCUM[9]) THEN 61271300 - BEGIN 61271350 - EMITPAIR(OP ~ GETSTACK, OVRN); 61271400 - EMIT(EXSU); EMIT(SRSC); EMITV(OP); 61271450 - RTNSTACK(OP); STEPIT; 61271500 - END; END; 61271550 - GO DOIT; 61271900 -EXIT: 61274000 -END REPLACESTMT; 61275000 -PROCEDURE FILLDATA(N); VALUE N; INTEGER N; 62020200 -BEGIN 62021000 - DEFINE BUMPTAX=IF TAX~TAX+1}POOLMAX THEN ERROR(0656)#; 62021100 - LABEL EXIT, CHECK, LOOP, STUFF; 62022000 - INTEGER Z,FIRSTX,LASTX, J; 62023000 - FIRSTX ~ TAX; 62024000 - LOOP: 62025000 - IF STEPI ! STRNGCON THEN GO TO STUFF; 62026000 - IF ELCLASS = STRING THEN 62027000 - BEGIN 62028000 - DO BEGIN 62029000 - TA[TAX] ~ THI; BUMPTAX; 62029100 - TA[TAX] ~ REAL(THIFLAG); BUMPTAX; 62029200 - END 62029300 - UNTIL NOT GOBBLE(TRUE); 62030000 - GO TO STUFF; 62031000 - END; 62032000 - IF ELCLASS = ADDOP THEN 62033000 - BEGIN 62033100 - IF STEPI ! NUMBER THEN ERROR(657); 62033200 - IF ELBAT[I-1].DISP = SUBT THEN THI ~ -THI; 62033300 - GO TO STUFF; 62033400 - END; 62033500 - IF ELCLASS ! NUMBER THEN ERROR(657); 62033600 - IF RESULT ! LFTPRN THEN GO STUFF; 62034000 - 62035000 - Z ~ THI; STEPIT; 62036000 - FILLDATA(Z-1); 62037000 - IF ELCLASS ! RTPARN THEN ERROR(0658); 62038000 - GO TO CHECK; 62039000 - STUFF: 62040000 - TA[TAX] ~ THI; BUMPTAX; 62041000 - TA[TAX]~ REAL(THIFLAG); BUMPTAX; 62041100 - IF DPTOG THEN 62042000 - BEGIN TA[TAX] ~ TLO; BUMPTAX;TA[TAX]~REAL(TLOFLAG);BUMPTAX END;62043000 - CHECK: 62044000 - IF STEPI = COMMA THEN GO TO LOOP; 62045000 - LASTX ~ TAX-1; 62046000 - FOR Z~1 STEP 1 UNTIL N DO 62047000 - FOR J ~ FIRSTX STEP 1 UNTIL LASTX DO 62048000 - BEGIN TA[TAX] ~ TA[J]; BUMPTAX END; 62049000 - EXIT: 62050000 -END FILLDATA; 62051000 -PROCEDURE FILLSTMT; 62052000 -BEGIN 62053000 - LABEL EXIT; 62065000 - INTEGER N; 62065500 - STEPIT; 62066000 - IF BOOARRAYID { ELCLASS AND ELCLASS { INTARRAYID THEN 62067000 - ARRAYROW ELSE ERROR(0659); 62068000 - IF ELCLASS ! WITHV THEN ERROR(0660); 62069000 - TAX ~ 0; 62071000 - FILLDATA(0); N ~ TAX; 62072000 - FILLPOOL; 62073000 - EMITNUM(N); EMIT(TWSD); 62074000 - EXIT: 62075000 -END FILLSTMT; 62076000 -PROCEDURE SWAPSTMT; 62100000 -BEGIN 62101000 - LABEL L, EXIT; 62102000 - REAL NA, NB, A, B, T; 62103000 - IF STEPI ! LFTPRN THEN ERROR(0661); 62104000 - IF STEPI < BOOARRAYID OR ELCLASS > INTARRAYID THEN ERROR(0662);62105000 - A ~ ELBAT[I]; NA ~ BOUND(A); A ~ A.ADDRESS; 62106000 - IF STEPI = LFTBRKT THEN 62107000 - BEGIN 62108000 - IF T ~ SUBSCRIBER(A, NA) = 0 THEN FLAG(0662); 62109000 - IF T ! NA THEN 62110000 - BEGIN 62111000 - EMIT(INDX); EMIT(DUPL); EMIT(LOAD); 62112000 - A ~ 0; NA ~ T; 62113000 - END; 62114000 - END; 62115000 - IF ELCLASS ! COMMA THEN ERROR(0663); 62116000 - IF STEPI < BOOARRAYID OR ELCLASS > INTARRAYID THEN ERROR(0662);62117000 - B ~ ELBAT[I]; NB ~ BOUND(B); B ~ B.ADDRESS; 62118000 - IF STEPI = LFTBRKT THEN 62119000 - BEGIN 62120000 - IF T ~ SUBSCRIBER(B, NB) = 0 THEN FLAG(0662); 62121000 - IF T ! NB THEN 62122000 - BEGIN 62123000 - EMIT(INDX); EMIT(DUPL); EMIT(LOAD); 62124000 - B ~ 0; NB ~ T; 62125000 - END; 62126000 - END; 62127000 - IF ELCLASS = RTPARN THEN STEPIT ELSE ERROR(0664); 62128000 - IF A = 0 THEN 62129000 - IF B = 0 THEN 62130000 - BEGIN 62131000 - EMIT(RSDN); EMIT(OVRD); 62132000 - EMIT(EXCH); EMIT(OVRD); 62133000 - END ELSE 62134000 - BEGIN 62135000 - L: EMITN(B); EMIT(LOAD); 62136000 - EMIT(RSDN); EMITN(B); 62137000 - EMIT(OVRD); EMIT(OVRD); 62138000 - END ELSE 62139000 - IF B = 0 THEN 62140000 - BEGIN B ~ A; GO TO L END ELSE 62141000 - BEGIN 62142000 - EMITN(A); EMIT(LOAD); 62143000 - EMITN(B); EMIT(LOAD); 62144000 - EMITN(A); EMIT(OVRD); 62145000 - EMITN(B); EMIT(OVRD); 62146000 - END; 62147000 - IF NA ! NB THEN FLAG(0665); 62148000 - EXIT: 62149000 -END SWAPSTMT; 62150000 - INTEGER PROCEDURE PICTUREGEN(FROM,UP,X); VALUE FROM,UP,X; 65001000 - BOOLEAN FROM,UP; INTEGER X; 65002000 - COMMENT PICTUREGEN GENERATES (SURPRIZE) A PICTURE EDIT-MICRO 65003000 - STRING...OR AN ENTER-EDIT ON A MICRO-STRING IN A TABLE 65004000 - SOMEWHERE. "X" POINTS INTO ADDL, AT THE STUFF FOR THE 65005000 - PICTURE (SEE PICIUREDEC). "UP" IS TRUE IF THE UPDATED 65006000 - POINTERS ARE REQUIRED. "FROM" IS TRUE IF WE ARE CALLED BY65007000 - REPLACESTMT: IF SO, WE HAVE EXPRESSIONS TO COMPILE FOR ANY65008000 - DYNAMIC REPEATS IN THE PICTURE. IF "FROM" IS FALSE, WE 65009000 - ARE CALLED FROM ACTUALPARAPART (Q.V.), AND WE MUST DREAM 65010000 - UP VALUE-CALLS FOR THOSE DYNAMIC THINGS; 65011000 - BEGIN 65012000 - BOOLEAN DOING; COMMENT TRUE IFF WE ARE COMPILING EXPRESSIONS- 65013000 - TURNS OFF WHEN WE RUN OUT; 65014000 - REAL A, OP, N; 65015000 - IF FROM THEN 65016000 - IF DOING ~ STEPI = LFTPRN THEN ELCLASS ~ COMMA; 65017000 - DO BEGIN 65018000 - A ~ GIT(X); X ~ X + 1; 65019000 - IF A.[44:4] = 0 THEN % TABLE-ENTER 65020000 - BEGIN EMITNUM(A.[19:24]); EMITPAIR(A.[1:18],INDX); 65021000 - OP ~ TEED; 65022000 - END TABLE MODE ELSE 65023000 - BEGIN 65024000 - IF A.[1:16] = 65535 THEN % DYNAMIC 65025000 - BEGIN 65026000 - IF FROM THEN 65027000 - IF DOING THEN 65028000 - IF ELCLASS ! COMMA THEN FLAG(924) ELSE 65029000 - BEGIN STEPIT; EXPRESSION(ITYPE) END ELSE 65030000 - FLAG(925) ELSE 65031000 - COMMENT HERE WE DREAM UP A VALC; 65032000 - EMITV(5&(CURRENT+1)[30:42:6] + N); 65033000 - N ~ N + 1; 65034000 - 65035000 - END ELSE 65036000 - EMITNUM(A.[1:16]); % STUPID MACHINE 65037000 - A.[1:16] ~ 0; 65038000 - OP ~ EXSD; 65039000 - END; 65040000 - IF DOING THEN COMMENT CHECK FOR END OF EXPR LIST; 65041000 - IF ELCLASS = RTPARN OR BOOLEAN(A.[43:1]) THEN 65042000 - BEGIN 65043000 - WHILE ELCLASS = COMMA DO 65044000 - BEGIN STEPIT; EXPRESSION(ITYPE); EMIT(DLET) END; 65045000 - IF ELCLASS ! RTPARN THEN FLAG(926) ELSE STEPIT; 65046000 - DOING ~ FALSE; 65047000 - END; 65048000 - IF FROM THEN 65048900 - IF NOT DOING THEN 65049000 - IF ELCLASS = COMMA THEN UP ~ TRUE; 65050000 - EMIT(OP & REAL(UP OR NOT BOOLEAN(A.[43:1]))[44:47:1]); 65051000 - IF OP = EXSD THEN EMITMICRO(A); 65052000 - END UNTIL BOOLEAN(A.[43:1]); 65053000 - PICTUREGEN ~ IF FROM THEN REAL(UP) ELSE N; 65054000 - END PICTUREGEN; 66055000 - PROCEDURE BLOCK; 66000000 - COMMENT BLOCK COMPILES ONE OF THOSE. MOST OF HIS WORK IS KEEPING TRACK66001000 - OF THINGS FOR SEGMENTATION AND NOMENCLATURE NESTING; 66002000 - COMMENT FIRST WHACK, 2/68, MCP *************************************; 66003000 - BEGIN 66004000 - ARRAY TEDOC[0:31,0:255]; 66005000 - INTEGER LO, SEGNOO, NINFOOO, NADDLO, BLKAD,LINFOO, LASTXO, 66006000 - FIRSTXO, FIRSTMTO, POINT; 66007000 - REAL CQAO; 66007100 - BOOLEAN SVINFOO; 66007200 - DEFINE LEVELMASK = STACKMASK #; 66008000 - NADDLO ~ NEXTADDL; 66009000 - NINFOOO ~ NINFOO; 66010000 - NINFOO ~ NEXTINFO; 66011000 - LINFOO ~ LASTINFO; 66012000 - FIRSTMTO ~ FIRSTMT; 66013000 - FIRSTXO ~ FIRSTX; 66014000 - LASTXO ~ LASTX; 66015000 - SEGNOO ~ SEGNO; 66016000 - IF SVINFOTOG THEN ELSE 66016100 -BEGIN 66016200 - SVINFOO~SVINFO; 66016300 - SVINFO~FALSE; 66016400 - END; 66016500 - BEGIN 66017000 - EMIT(MKST); 66018000 - EMITN(BLKAD ~ GETSPACE(-CURRENT)); 66019000 - EMIT(ENTR); 66020000 - POINT ~ BUMPL; 66021000 - IF NOT SAVED THEN 66022000 - IF REAL(SEPARATOG)!4 THEN 66022500 - BEGIN 66023000 - LO ~ L; 66024000 - MOVECODE(TEDOC,EDOC); 66025000 - L ~ 0; 66026000 - SEGNO ~ NEWSEG(0); 66027000 - END; END; 66028000 - FIRSTX ~ LASTX ~ FIRSTMT ~ -1; 66029000 - LASTINDEX ~ LASTNOT ~ 0; 66030000 - IF CURRENT < 31 THEN CURRENT ~ CURRENT + 1 ELSE FLAG(627); 66031000 - MAXDISP ~ LEVELMASK[CURRENT].[FF]; 66032000 - STACKTOP[CURRENT] ~ MAXSTACK[CURRENT] ~ 2; 66033000 - DECLARATIONS; 66034000 - FIRSTATEMENT; 66035000 - 66036000 - 66037000 - COMPOUNDTAIL; 66038000 - IF SVINFO THEN 66038100 - BEGIN 66038105 - WRITEFILE(INFF,INFO,NINFOO,NEXTINFO-1); 66038110 - WRITEFILE(INFF,ADDL,NADDLO,NEXTADDL-1); 66038115 - INFD[(INFDX~INFDX+2).LINKR,INFDX.LINKC] ~ 66038120 - (GTI1~(NEXTINFO-NINFOO+29)DIV 30+INFFX)& 66038125 - INFFX[18:33:15]; 66038130 - INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC] ~ 66038135 - (NEXTINFO-1)&NINFOO[18:33:15]& 66038140 - (NINFOO-STARTINFO)[3:33:15]; 66038145 - INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC] ~ 66038150 - (NEXTADDL-1)&NADDLO[18:33:15]& 66038155 - (NADDLO-STARTADDL)[3:33:15]; 66038160 - INFFX~(NEXTADDL-NADDLO+29) DIV 30 + GTI1; 66038165 - END; 66038170 - NEXTINFO ~ NINFOO; 66040000 - NINFOO ~ NINFOOO; 66041000 - NEXTADDL ~ NADDLO; 66042000 - LASTINFO ~ LINFOO; 66043000 - IF REAL(ARRAYDECTOG AND BOOLEAN(2*CURRENT)) !0 THEN 66043100 - BEGIN 66043200 - EMIT(MKST); 66043300 - EMITN(BLOCKEXITPCW); 66043400 - EMIT(ENTR); 66043500 - ARRAYDECTOG~ARRAYDECTOG AND NOT BOOLEAN(2*CURRENT); 66043540 - END; 66043600 - EMIT(EXIT); 66044000 - PURGE(NEXTINFO); 66044300 - LINFOO~L; % LAST SYLLABLE OF THE LEVEL 66044500 - IF NOT SAVED THEN 66045000 - IF REAL(SEPARATOG)!4 THEN 66045500 - BEGIN 66046000 - WHILE L MOD 6 ! 0 DO EMIT(NVLD); 66047000 - SEGMENT(0, L DIV 6, EDOC); 66048000 - L ~ LO; MOVECODE(TEDOC,EDOC); 66049000 - END; 66050000 - LO ~ IF FIRSTX < 0 THEN FIRSTMT ELSE FIRSTX; 66050100 - DOUBLE(SEGNO,SEGNOO,~,SEGNOO,SEGNO); 66050200 - FIRSTX ~ FIRSTXO; LASTX ~ LASTXO; FIRSTMT ~ FIRSTMTO; 66050300 - IF CURRENT = 1 THEN 66051000 - GLOBALPCW(BLKAD,SEGNO,LO,STATE) ELSE 66052000 - BEGIN 66053000 - IF NOT NOJUMPTOG THEN JUMPCHKX; 66054000 - PCL~L; 66054500 - EMITPCW(CURRENT,LO,STATE,SEGNOO); 66055000 - ENTERSEPA(((L-6) DIV 6),LINFOO,POINT); 66055500 - LO ~ STACKTOP[CURRENT - 1]; 66056000 - BLKAD ~ BLKAD.[36:12]; 66057000 - WHILE BLKAD ~ BLKAD + 1 < LO DO EMIT(ZERO); 66058000 - COMMENT TO RESERVE CELLS FOR THINGS WITH ADDR PARTS; 66059000 - IF NOT NOJUMPTOG THEN JUMPCHKNX; 66059100 - END; 66059200 - EMITB(BRUN, POINT, L); 66060000 - IF SVINFO THEN 66060100 - INFO[(GTI1~INFDX-3).LINKR,GTI1.LINKC]~PCW; 66060200 - IF SVINFOTOG THEN ELSE SVINFO~SVINFO OR SVINFOO; 66060800 - MAXDISP ~ LEVELMASK[CURRENT ~ CURRENT-1].[FF]; 66061000 - CQAO ~ COUNTQALG; COUNTQALG ~ STARTNSQ; 66061100 - 66062000 - END THE BLOCK ROUTINE; 66063000 - PROCEDURE PURGE(T); VALUE T; INTEGER T; 66064000 - BEGIN 66065000 - INTEGER I, J, K, ERR; 66066000 - REAL E; 66067000 - LABEL GRIPE; 66068000 - DEFINE CNT = CHRCNT#; 66069000 - IF T < 0 THEN T ~ - T ELSE 66069050 - FOR GT1 ~ 0 STEP 1 UNTIL MAXTEMP DO 66069100 - IF TEMPSTACK[GT1] .[31:5] = CURRENT THEN 66069200 - TEMPSTACK[GT1] ~ 0; 66069300 - FOR I ~ 0 STEP 1 UNTIL 124 DO 66070000 - WHILE J~STACKHEAD[I]}T DO 66071000 - BEGIN 66072000 - STACKHEAD[I] ~ TAKE(J).CONL; 66073000 - IF(E ~ TAKE(J-1)).CLASS = LABELID THEN 66074000 - BEGIN 66075000 - IF E.TYPE = F0RWARD THEN 66076000 - IF E.LINK ! 0 THEN 66077000 - BEGIN ERR ~ 405; GO GRIPE END 66078000 - ELSE ELSE 66078100 - IF E.DISP!0 THEN 66078200 - BEGIN 66078300 - JUMPCHKX; 66078400 - EMITPCW(E.LVEL,E.[32:16],STATE,SEGNO); 66078500 - EMITPAIR(E.ADDRESS,OVRD); 66078600 - JUMPCHKNX; 66078650 - END; 66078700 - END ELSE 66079000 - IF E.CLASS = PROCID OR E.CLASS } BOOPROCID AND 66080000 - E.CLASS { PTRPROCID THEN 66081000 - IF E.TYPE = F0RWARD THEN 66082000 - BEGIN ERR ~ 406; 66083000 - GRIPE: ERRORTOG ~ TRUE; 66084000 - FLAG(ERR); 66085000 - BLANKOUT(16,LBUFF[0]); 66086000 - INSERT(5,"ERROR",LBUFF[2],0); 66087000 - MOVECHARACTERS(TAKE(J).CNT,INFO[J.LINKR,J.LINKC],4, 66088000 - LBUFF[3],3); 66089000 - INSERT(4,"WAS:",LBUFF[2],6); 66090000 - WRITELBUFF 66093000 - END ELSE ELSE 66094000 -% ARRAY ACTION 66095000 - END END PURGE; 66096000 - PROCEDURE THRUSTMT; 66200000 - BEGIN 66201000 - REAL SAVEL, GT1, SAVESTBR; 66202000 - BOOLEAN TB1,TB2; 66202100 - LABEL EXIT; 66203000 - SAVEL ~ L; 66204100 - IF TB1~STEPI = NUMBER THEN 66205000 - BEGIN 66205100 - DOUBLE(THI,TLO,~,GT1,SAVESTBR); TB2 ~ DPTOG; 66205200 - TB1 ~ TB1 AND TABLE(I+1)=DOV; 66205300 - DOUBLE(GT1,SAVESTBR,~,THI,TLO); DPTOG ~ TB2; 66205400 - END; 66205500 - IF TB1 AND THI.[1:31] = 0 THEN 66208000 - BEGIN 66209000 - EMITNUM(0&1[1:37:11]&THI[12:32:16]); 66210000 - STEPIT; 66211000 - IF ELCLASS ! DOV THEN FLAG(666); 66212000 - EMITNUM(4); 66215000 - EMIT(STAG); 66216000 - EMITPAIR(GT1 ~ GETSTACK, OVRN); 66217100 - SAVEL ~ L; 66219000 - EMITN(GT1); 66220000 - SAVESTBR ~ L; 66221000 - EMITLINK(0&STBR[24:40:8]); 66222000 - EMIT(DLET); 66223000 - STEPIT; 66224000 - STATEMENT; 66225000 - EMITB(BRUN,BUMPL,SAVEL); 66226000 - EMITB(GET(SAVESTBR),SAVESTBR+3,L); 66227000 - GO TO EXIT; 66229000 - END; 66230000 - GT1 ~ AEXP; 66230100 - IF ELCLASS ! DOV THEN FLAG(666); 66230200 - GT1 ~ GETSTACK; 66231000 - SAVEL ~ BUMPL; 66232000 - STEPIT; 66233000 - STATEMENT; 66234000 - EMITV(GT1); 66235000 - EMIT(ONE); 66236000 - EMIT(SUBT); 66237000 - EMITB(BRUN,SAVEL,L); 66238000 - EMITN(GT1); 66239000 - EMIT(OVRN); 66240000 - EMIT(ZERO); 66241000 - EMIT(LSEQ); 66242000 - EMITB(BRFL,BUMPL,SAVEL); 66243000 - EXIT: 66297000 - RTNSTACK(GT1); 66298000 - END THRUSTMT; 66299000 -COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 70000000 - DECLARATIONS 70001000 - * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *; 70002000 - PROCEDURE IDLIST(SPAZE,TIPE,KLASS,B,C); VALUE SPAZE,TIPE,KLASS,B,C; 70003000 - BOOLEAN C; INTEGER TIPE,KLASS,B; REAL SPAZE; 70004000 - COMMENT IDLIST HANDLES THE ENTRY INTO INFO OF A LIST OF IDENTIFIERS, 70005000 - SEPARATED BY COMMAS. "I" MUST BE POINTING TO THE FIRST ONE, 70006000 - AND MUST NOT HAVE EVER PASSED IT (I.E., YOU MAY NOT "I~I-1", 70007000 - THEN CALL IDLIST). SPAZE GETS PASSED ON TO GETSPACE, Q.V. 70008000 - TIPE IS THE TYPE-FIELD VALUE FOR THE ELBAT WORD, AND KLASS, 70009000 - THEN CLASS FIELD. IF B IS } ZERO, WE WILL PROVIDE AN INITIAL 70010000 - VALUE OF TYPE B(UNLESS ENTER RETURNS TRUE, INDICATING THAT THE 70011000 - PROGRAMMER GAVE AN ADDRESS PART). C IS TRUE IF SPACE IS TO BE 70012000 - ALLOCATED; 70013000 - BEGIN 70014000 - INTEGER CONTEX, T; 70015000 - LABEL INN, OWT; 70015100 - BOOLEAN FAKEY; 70016000 - 70017000 - IF B=DPV OR B=EVNTV THEN SPAZE.[2:1]~ 1; 70017200 - IF CURRENT ! 0 THEN T ~ 1 ELSE 70017200 - IF KLASS=DPID OR KLASS=EVENTID THEN T~2 ELSE 70017300 - IF KLASS = REFID THEN T ~ 0 ELSE 70017400 - IF KLASS = PTRID THEN T ~ 3 ELSE T ~ 1; 70017500 - I ~ I - 1; CONTEX ~ CONTEXT; % FUTZ UP THE SCANNER 70018000 - DO BEGIN 70019000 - CONTEXT ~ 0; % ITS DECLARATION TIME, GANG. 70020000 - IF STEPI ! UNKNOWNID THEN % BUT THIS HAS ALREADY BEEN 70021000 - FLAG(700); % DECLARED. 70022000 - IF NOT ENTER(SPAZE,TIPE,KLASS,C) THEN % 70023000 - IF B > 0 THEN % B IS INITIAL-VALUE TYPE 70024000 - IF TABLE(I+1) = ASSNOP THEN % DID HE GIVE ONE 70025000 - BEGIN % WELL, COMPILE IT 70026000 - IF B=EVNTV THEN FLAG(783); 70026500 - CONTEXT ~ 2; % UNFUTZ THE SCANNER 70027000 - ELCLASS ~ TABLE(I~I+2); % MEANS STEPIT TWICE. 70028000 - JUMPCHKX; 70028100 - EXPRESSION(B); % AND DD THE THING. 70029000 - I ~ I - 1; 70029010 - IF CURRENT = 0 THEN 70029100 - BEGIN 70029200 - EMITPAIR(TAKE(LASTINFO).ADDRESS, 70029300 - IF B < REFV THEN STOD ELSE OVRD); 70029400 - IF(N~IF B = DPV THEN 2 ELSE 70029500 - IF B = REFV THEN 0 ELSE 70029600 - IF B = PTRV THEN 3 ELSE 1)! 1 THEN GO INN 70029700 - END; 70029800 - FAKEY ~ FALSE 70030000 - END ELSE % HE DIDNT GIVE ONE, WE GOTTA DO 70031000 - IF N ~ T ! 1 THEN % ITS A COMPILE-TIME THING 70031100 - BEGIN 70031200 - INN: PDPRT[PDINX.LINKR,PDINX.LINKC]~TAKE(LASTINFO).DISP 70031300 - &REAL(T=0)[8:47:1] 70031310 - &N[2:45:3]; 70031400 - PDINX ~ PDINX + 1; GO OWT 70031500 - END ELSE % THE OBJECT CODE GOTTA DO 70031600 - IF CURRENT ! 0 THEN % BUT IF ITS OUTER BLOCK, DONT DO70031700 - BEGIN JUMPCHKX; EMIT(ZERO); 70032000 - IF KLASS=DPID OR KLASS=EVENTID THEN %MAYBE TWICE 70033000 - EMIT(XTND) ELSE 70034000 - IF KLASS = REFID THEN 70035000 - IF FAKEY THEN 70036000 - BEGIN L ~ L - 1; EMIT(DUPL) END ELSE 70037000 - BEGIN EMITNUM(5); EMIT(STAG); FAKEY ~ TRUE END; 70038000 - END; 70039000 - OWT: 70039500 - PUT(TAKE(LASTINFO)&NEXTINFO[33:33:15],LASTINFO); 70040000 - END UNTIL STEPI ! COMMA; 70041000 - CONTEXT ~ CONTEX 70042000 - END IDLIST; 70043000 - BOOLEAN PROCEDURE ENTER(SPAZE,TIPE,KLASS,B); VALUE SPAZE,TIPE,KLASS,B; 70044000 - BOOLEAN B; INTEGER SPAZE,TIPE,KLASS; 70045000 - COMMENT ENTER PUTS THE IDENTIFIER IN ACCUM INTO INFO, AND LINKS IT IN 70046000 - APPROPRIATELY, MAKING CERTAIN THAT THE ENTRY IS NOT SPLIT 70047000 - ACROSS A ROW BOUND. IF B IS TRUE, SPAZE IS PASSED ON TO 70048000 - GETSPACE, WHICH RETURNS THE ADDRESS-FIELD VALUE: OTHERWISE, 70049000 - SPAZE ITSELF IS THE ADDRESS-FIELD VALUE. TIPE GOES INTO THE 70050000 - TYPE FIELD, AND KLASS INTO THE CLASS FIELD; 70051000 - BEGIN 70052000 - INTEGER N; 70053000 - REAL ELBW; 70054000 - IF ((N ~ (COUNT + 19) DIV 8) + NEXTINFO).LINKR ! 70055000 - NEXTINFO.LINKR THEN 70056000 - PUT(NEXTINFO~(LASTINFO~NEXTINFO)+256-NEXTINFO.LINKC, 70057000 - LASTINFO); 70058000 - ACCUM[1].CONL ~ STACKHEAD[SCRAM]; 70059000 - STACKHEAD[SCRAM] ~ NEXTINFO + 1; 70060000 - MOVE(N-1,ACCUM[1],INFO[NEXTINFO.LINKR,NEXTINFO.LINKC+1]); 70061000 - IF B THEN 70062000 - BEGIN 70062100 - ENTER~SPAZE ~ GETSPACE(SPAZE) < 0; 70062200 - IF PRTOG THEN PRINTSPACE(NEXTINFO,SPAZE.[31:5], 70062300 - SPAZE.[36:12]); 70062400 - END; 70062500 - ELBW.ADDRESS ~ SPAZE; 70063000 - ELBW.CLASS ~ KLASS; 70064000 - ELBW.TYPE ~ TIPE; 70065000 - PUT(ELBW, LASTINFO ~ NEXTINFO); 70066000 - NEXTINFO ~ NEXTINFO + N; 70067000 - END ENTER; 70068000 -PROCEDURE MERRIMAC; 70069000 - BEGIN COMMENT MERRIMAC IS STILL WORKING ON THE MONITOR. 70070000 - ::= MONITOR 70071000 - () 70072000 - THE PROCEDURE IDENTIFIER PARAMETERS ARE CHECKED TO SEE IF THEY 70073000 - ARE BOTH VALUE AND IF THE TYPE OF SECOND PARAMETER IS THE SAME 70074000 - AS THE PROCEDURE. THE MONITOR LIST VARIABLES ARE RE-ENTERED 70075000 - IN INFO (IF FOUND) MARKED AS MONITORED AND WITH A LINK POINT- 70076000 - ING TO THE INFO ENTRY FOR THE PROCEDURE IDENIIFIER. ;70077000 - REAL ELBW, CLAS, PROCLINK; 70078000 - DO BEGIN 70078010 - CONTEXT ~ 2; 70078050 - CLAS ~ STEPI - BOOPROCID; 70079000 - IF RANGE (BOOPROCID, PTRPROCID) 70080000 - THEN BEGIN 70081000 - PROCLINK ~ ELBAT[I].ADDRESS; 70082000 - COMMENT CHECK PARAMETERS %-----------% ;70083000 - IF STEPI ! LFTPRN 70084000 - THEN ERR (701) 70085000 - ELSE DO IF STEPI - BOOID = CLAS 70086000 - OR CLAS = WORDID - BOOID 70086100 - THEN BEGIN 70087000 - GTB1 ~ ENTER((ELBW ~ ELBAT [I]). 70088000 - ADDRESS, ELBW.TYPE, ELBW.CLASS, 70089000 - FALSE); 70090000 - PUT (INFO [(GT1~LASTINFO).LINKR, 70091000 - GT1.LINKC] 70092000 - &1 [1:47:1] 70093000 - &PROCLINK [33:33:15], 70094000 - LASTINFO); 70095000 - END 70096000 - ELSE ERR (702) 70097000 - UNTIL STEPI ! COMMA; 70098000 - IF ELCLASS ! RTPARN THEN ERR (701); 70099000 - STEPIT; 70100000 - END 70101000 - ELSE ERR (702); 70102000 - END UNTIL ELCLASS!COMMA; 70102010 - END MERRIMAC; 70103000 -BOOLEAN PROCEDURE FIELDER (DIALS, SIMPLE); 70104000 - REAL DIALS; 70105000 - BOOLEAN SIMPLE ; 70106000 - BEGIN COMMENT FIELDER HANDLES THE CONSTRUCT: 70107000 - ::= : 70108000 - AS FOUND IN FIELD AND LAYOUT DECLARATIONS, THE SIMPLE CASE IS 70109000 - WHEN BOTH AEXP-S ARE LITERALS, AND IN THIS CASE THE DIAL SET- 70110000 - TINGS ARE FORMATTED SO THAT THEY WILL MAP INTO THE DISP FIELD 70111000 - OF THE ELBAT WORD AND THE LVT BIT IS TURNED ON AND SIMPLE IS 70112000 - SET TRUE. IN THE NOT SIMPLE CASE AN ADDL WORD IS BUILT (IN 70113000 - DIALS) THAT CONTAINS EITHER A DIAL SETTING OR A LINK TO ADDL 70114000 - IF EACH OF TWO FIELDS. IN EITHER CASE FIELDER IS SET FALSE IF 70115000 - A SYNTAX ERROR IS DETECTED. 70116000 - ;70117000 - DEFINE SCAT = BEGIN FIELDER ~ FALSE; GO QUIT END#, 70118000 - LITERAL = NUMBER#; %----------% 70119000 - LABEL QUIT, COLONCHECK, WRAPUP, SECOND; 70120000 - INTEGER S, N; 70121000 - FIELDER ~ SIMPLE ~ TRUE; 70122000 - COMMENT I POINTS AT FIRST COMPONENT OF ARITH EXPR AND HAS NOT70123000 - BEEN STEPPED PAST IT; 70124000 - IF ELCLASS = LITERAL 70125000 - THEN BEGIN 70126000 - DEBLANK; 70127000 - IF CHR = ":" 70128000 - THEN BEGIN 70129000 - IF S ~ THI { 47 70130000 - THEN BEGIN STEPIT; GO COLONCHECK END; 70131000 - FLAG (704); SCAT; 70132000 - END; 70133000 - END; 70134000 - SIMPLE ~ FALSE; 70135000 - IF S ~ -TEXT(FIELDEXPA, COLON) > 0 THEN SCAT; 70136000 -COLONCHECK: 70137000 - IF ELCLASS ! COLON THEN SCAT; 70138000 - IF STEPI = LITERAL 70139000 - THEN BEGIN 70140000 - DEBLANK; 70141000 - IF CHR = "," 70142000 - THEN GO SECOND; 70143000 - IF CHR = ";" OR CHR = ")" OR CHR = "~" 70144000 - THEN BEGIN 70145000 -SECOND: 70146000 - IF N ~ THI { 48 AND N > 0 70147000 - THEN BEGIN STEPIT; GO WRAPUP END; 70148000 - FLAG (704); 70149000 - SCAT; 70150000 - END 70151000 - END; 70152000 - SIMPLE ~ FALSE; 70153000 - IF N ~ -TEXT(FIELDEXPB, SEMICOLON) > 0 THEN SCAT; 70154000 -WRAPUP: IF SIMPLE 70155000 - THEN BEGIN 70156000 - 70157000 - DIALS ~ N & S [36:42:6]; 70158000 - END 70159000 - ELSE DIALS ~ ABS (N) 70160000 - & N [32:1:1] 70161000 - & ABS (S)[17:33:15] 70162000 - & S [16:1:1]; 70163000 -QUIT: COMMENT WHEN SUCCESSFUL I POINTS AT ENTITY AFTER LAST AEXP.; 70164000 - END FIELDER; 70165000 -BOOLEAN PROCEDURE FIELDPART (LSTINFO, DIALS); 70166000 - REAL LSTINFO, DIALS; 70167000 - BEGIN COMMENT FIELDPART HANDLES THE CONSTRUCT: 70168000 - ::= = 70169000 - AND MAY BE DRIVEN BY FIELDEC OR LAYOUTDEC. THE IDENTIFIER IS 70170000 - ENTERED AND LSTINFO IS RETURNED TO THE CALLER. FIELDER RETURNS70171000 - DIALS AND IF THE DIALS AHE NOT SIMPLE THEY ARE NEGATED FOR THE 70172000 - CALLER. WHEN FIELDPART IS TRUE - IT WAS SUCCESSFUL 70173000 - ; 70174000 - INTEGER ELCLAS; 70175000 - BOOLEAN SIMPLE; 70176000 - LABEL QUIT; 70177000 - DEFINE SCAT=DO UNTIL 70178000 - (ELCLAS~STEPI=COMMA AND TABLE (I+2)=RELOP) 70179000 - OR ELCLAS= SEMICOLON; 70180000 - FIELDPART ~ FALSE; 70181000 - GO QUIT#; 70182000 - DEFINE LASTI = LSTINFO.LINKR,LSTINFO.LINKC#; 70183000 - COMMENT T POINTS AT IDENTIFIER.; 70184000 - IF ELCLASS ! UNKNOWNID 70185000 - THEN BEGIN FLAG (700); SCAT END; 70186000 - GTB1 ~ ENTER (0, LOCALTYPE, FIELDID, FALSE); 70187000 - LSTINFO ~ LASTINFO; 70188000 - IF STEPI ! RELOP OR ELBAT[I].DISP ! EQUL 70189000 - THEN BEGIN FLAG (703); SCAT END; 70190000 - FIELDING ~ TRUE; 70190100 - STEPIT; 70191000 - IF FIELDER (DIALS, SIMPLE) 70192000 - THEN BEGIN 70193000 - IF SIMPLE 70194000 - THEN INFO [LASTI].ADDRESS ~ DIALS 70195000 - ELSE BEGIN 70196000 - INFO [LASTI].LINK ~ NEXTADDL; 70197000 - PUTNBUMP (DIALS); 70198000 -DONBUG ("FIELDS", 0, NEXTADDL-1); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70199000 - END; 70200000 - END 70201000 - ELSE BEGIN FLAG (704); SCAT END; 70202000 - FIELDING ~ FALSE; 70202100 - FIELDPART ~ TRUE; 70203000 -QUIT: COMMENT T POINTS AT TERMINATING "," OR SEMICOLON; 70204000 -DONBUG ("FIELDS", LSTINFO,0); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70205000 - END FIELDPART; 70206000 -PROCEDURE FIELDEC; 70207000 - BEGIN COMMENT FIELDEC PROCESSES THE DECLARATION: 70208000 - ::= FIELD 70209000 - WHEN THE DIALS ARE SIMPLE THEY ARE PLACE IN THE ADDRESS PART OF70210000 - THE INFO WORD, OTHERWISE THE LINK POINTS TO A WORD IN ADDL THAT70211000 - CONTAINS A DIAL AND/OR A POINTER TO TEXT IN ADDL. 70212000 - ;70213000 - REAL DIALS; 70214000 - INTEGER LSTINFO; 70215000 - DO BEGIN 70216000 - STEPIT; 70217000 - GTB1 ~ FIELDPART (LSTINFO, DIALS); 70218000 - END UNTIL ELCLASS ! COMMA; 70219000 - END FIELDEC; 70220000 -PROCEDURE LAYOUTDEC; 70221000 - BEGIN COMMENT LAYOUTDEC PROCESSES THE DECLARATION 70222000 - ::= LAYOUT 70223000 - IN ALL CASES THE INFO WORD LINK POINTS TO N ADDL ENTRIES WHERE 70224000 - EACH ENTRY IS SIMILAR TO THE ADDL ENTRIES FOR FIELDEC EXCEPT 70225000 - THAT SIMPLE DIALS ARE ALSO KEPT IN ADDL. SOME OF THE ENTRIES 70226000 - MAY BE INITIAL VALUES. THE ADDRESS PART OF THE INFO WORD CON- 70227000 - TAINS N (THE NUMBER OF ADDL ENTRIES). 70228000 - ;70229000 - INTEGER ADDLI, ELCLAS, CODE, LSTINFO, J; 70230000 - ARRAY TADDL [0:98]; 70231000 - REAL TINFO, DIALS; 70232000 - BOOLEAN SIMPLE, INITIAL; 70233000 - LABEL ON; 70233100 - LABEL BACK, GONE; 70233200 - LABEL EXIT; 70234000 - DEFINE SCAT = 70235000 - BEGIN WHILE ELCLASS!RTPARN AND ELCLASS!SEMICOLON DO 70236000 - STEPIT; 70237000 - IF ELCLASS=RTPARN THEN GO EXIT ELSE GO GONE 70238000 - END # 70239000 - , LITERAL = NUMBER # %------------% 70240000 - , LASTI = LSTINFO.LINKR, LSTINFO.LINKC # 70241000 - , EVERYTHING= CODE [8:40:8] 70242000 - & REAL(INITIAL)[7:47:1]# 70243000 - ; 70244000 - DO BEGIN 70245000 - IF STEPI ! UNKNOWNID 70246000 - THEN BEGIN FLAG (700); SCAT END; 70247000 - GTB1 ~ ENTER (0, LOCALTYPE, LAYOUTID, FALSE); 70248000 - LSTINFO ~ LASTINFO; 70249000 - IF STEPI ! LFTPRN 70250000 - THEN BEGIN FLAG (705); SCAT END; 70251000 - DO BEGIN 70252000 - FIELDING ~ TRUE; 70252100 - STEPIT; 70253000 - FIELDING ~ FALSE; 70253100 - DEBLANK; 70254000 - IF CHR = "=" 70255000 - THEN IF FIELDPART (TINFO, DIALS) 70256000 - THEN BEGIN 70257000 - CODE ~ LAYOUTID; 70258000 - DIALS ~ TINFO; 70259000 - END 70260000 - ELSE BEGIN FLAG (703); END 70261000 - ELSE 70261100 - BACK: 70261150 - IF ELCLASS = UNKNOWNID THEN 70261200 - IF GT1 ~ ELBAT[I] = 0 THEN GO ON ELSE 70261300 - BEGIN 70261400 - ELBAT[I].CLASS ~ ELCLASS ~ (TINFO ~TAKE(GT170261500 - )).CLASS; 70261600 - IF ELCLASS ! DEFINDID THEN GO ON ELSE 70261700 - 70261800 - DIALS ~ TINFO.LINK; 70261900 - IF TINFO.ADDRESS ! 0 THEN 70262000 - BEGIN 70262100 - DIALS.[18:15]~ NEXTINFO; 70262200 - IF ASSOCIATE(TINFO.ADDRESS) THEN 70262300 - GO ON; 70262400 - END; 70262500 - HOOK(DIALS); NXTELBT ~ NXTELBT-1; 70262600 - ELCLASS ~ TABLE(I); 70262700 - GO BACK; 70262800 - END ELSE 70262900 - ON: IF ELCLASS = FIELDID THEN 70263000 - BEGIN 70263100 - CODE ~ LAYOUTID; 70264000 - DIALS ~ ELBAT [I].LINK; 70265000 - STEPIT; 70266000 - END 70267000 - ELSE 70268000 - IF ELCLASS = TAGV 70269000 - THEN BEGIN 70270000 - CODE ~ TAGV; 70271000 - STEPIT; 70272000 - END 70273000 - ELSE 70274000 - BEGIN FIELDING ~ TRUE; 70274100 - IF FIELDER (DIALS, SIMPLE) 70275000 - THEN BEGIN 70276000 - IF SIMPLE 70277000 - THEN DIALS~ 0 &DIALS[26:36:6] 70278000 - &DIALS[42:42:6]; 70279000 - CODE ~ FIELDID; 70280000 - END 70281000 - ELSE BEGIN FLAG (707); SCAT END; 70282000 - FIELDING ~ FALSE END; 70282100 - IF ELCLASS = ASSNOP 70283000 - THEN BEGIN 70284000 - IF STEPI ! LITERAL OR THI < 0 70285000 - THEN BEGIN FLAG (706); SCAT END; 70286000 - INITIAL ~ TRUE; 70287000 - STEPIT; 70288000 - END; 70289000 - TADDL [ADDLI~ADDLI+1]~ ABS (DIALS)& EVERYTHING; 70290000 - IF INITIAL THEN TADDL [ADDLI ~ ADDLI + 1] ~ THI;70291000 - INITIAL ~ SIMPLE ~ FALSE; 70292000 - END 70293000 - UNTIL ELCLASS ! COMMA; 70294000 - IF ELCLASS ! RTPARN THEN FLAG (705); 70295000 - INFO [LASTI] ~ INFO [LASTI] 70296000 - &(NEXTADDL ~ ADDLI)[2:29:19] 70297000 - & NEXTADDL [33:33:15]; 70298000 -DONBUG ("LAYOUT", LSTINFO, 0); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70299000 - WHILE J ~ J + 1 { ADDLI DO PUTNBUMP (TADDL [J]); 70300000 -ADDLI ~ INFO [LASTI].ADDRESS; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70301000 -BEGIN J~INFO[LASTI].LINK-1; WHILE J~J+1< ADDLI DO DONBUG("LAYOUT",0,J); 70302000 -END; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70303000 -EXIT: STEPIT; 70304000 - ADDLI ~ J ~ 0; 70305000 - END 70306000 - UNTIL ELCLASS ! COMMA; 70307000 - GONE: 70307100 - END LAYOUTDEC; 70308000 -PROCEDURE PUTOGETHER (CHAR); 70309000 - REAL CHAR; 70310000 - BEGIN 70311000 - DEFINE ADDLI = (GT1 ~ NEXTCHAR.[30:15]).LINKR, GT1.LINKC#; 70312000 - INTEGER COUNT, EXCESS; 70313000 - REAL GT1; 70314000 - IF (CHARCOUNT ~ (COUNT ~ CHAR.CHRCNT) + CHARCOUNT)> 2047 THEN 70315000 - BEGIN FLAG (708); BADSTUFF ~ TRUE END 70316000 - ELSE BEGIN 70317000 - IF COUNT > REMCOUNT 70318000 - THEN BEGIN 70319000 - COUNT ~ (COUNT -(EXCESS~ REMCOUNT)); 70320000 - MOVECHARACTERACCUM 70321000 - (EXCESS, CHAR, 0, ADDL[ADDLI], 70322000 - NEXTCHAR.[45:3]); 70323000 -DONBUG("PUTOGE", -EXCESS, GT1); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70324000 - NEXTCHAR ~ NEXTCHAR + EXCESS; 70325000 - REMCOUNT ~ 2047; 70326000 - END; 70327000 - MOVECHARACTERACCUM 70328000 - (COUNT, CHAR, EXCESS, ADDL[ADDLI], 70329000 - NEXTCHAR.[45:3]); 70330000 -DONBUG ("PUTOGE",-COUNT, GT1); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70331000 - NEXTCHAR ~ NEXTCHAR + COUNT; 70332000 - REMCOUNT ~ REMCOUNT - COUNT; 70332500 - END 70333000 - END PUTOGETHER; 70334000 -INTEGER PROCEDURE TEXT (FROM, FINAL); 70335000 - VALUE FROM, FINAL; 70336000 - INTEGER FROM, FINAL; 70337000 - BEGIN COMMENT TEXT HANDLES THE PLACING OF A SEQUENCE OF VALID 70338000 - SYMBOLS IN ADDL. THE PARAMETER FROM DETERMINES HOW THE 70339000 - TRANSFER IS TERMINATED AND THE TERMINATING SYMBOL THAT IS 70340000 - PLACED IN ADDL. CURRENTLY RECOGNIZED FHOM(S) ARE: 70341000 - DEFINEV = #, 70342000 - FIELDEXPA OR LAYEXPA = : 70343000 - FIELDEXPB = <, OR SEMICOLON> 70344000 - IF THE VALUE OF TEXT IS } 0 THEN IT IS THE ADDL INDEX FOR 70345000 - THE TEXT, OTHERWISE AN ERROR HAS OCCURRED. 70346000 - FINAL IS THE ELCLASS FOR A POSSIBLE TERMINATING CHARACTER 70347000 - OR A FUNCTION OF THE NUMBER OF SYMBOLS IN A FORMAL SYMBOL 70348000 - LIST I.E. FINAL DIV 10 + 1 * NO. OF SYMBOLS. 70349000 - ;70350000 - REAL TERMINATE; 70351000 - BOOLEAN TERMINATOR, FIELDPARTA, FIELDPARTB; 70352000 - INTEGER BRAKET, PARENS, PARCOUNT, J; 70353000 - BOOLEAN DEFINPARAM; 70354000 - BOOLEAN GOBBLER; 70354100 - DEFINE FLOGGER = 70354200 - IF REMCOUNT = 0 THEN REMCOUNT ~ 2047; 70354250 - FLOG(DEFINESFLAG,ACCUM[9],ADDL[(GT1~NEXTCHAR.[30:15]).LINKR, 70354300 - GT1.LINKC]); 70354400 - NEXTCHAR ~ (GT3 ~ COUNT DIV 6) + NEXTCHAR; 70354500 - CHARCOUNT ~ GT3 + CHARCOUNT; 70354550 - REMCOUNT ~ REMCOUNT - GT3; 70354575 - DONBUG ("FLOGER",-COUNT DIV 6, GT1);#; %%%%%%%%%%%%%%%%%%%%%%%70354600 - LABEL ON, AWAY; 70355000 - LABEL WAY; 70355100 - INTEGER LASTRESULT, CONTEX; 70356000 - IF FROM =DEFINEV THEN PARCOUNT ~ FINAL; 70357000 - FIELDPARTA ~ FROM = FIELDEXPA; 70358000 - FIELDPARTB ~ FROM =FIELDEXPB; 70359000 - IF DEFINPARAM ~ FROM =DEFINEP THEN TERMINATE ~ "1#000"; 70360000 - CHARCOUNT ~ 0; 70361000 - REMCOUNT ~ (256 - NEXTADDL MOD 256) | 8; 70362000 - NEXTCHAR ~ 0 & NEXTADDL [30:33:15]; 70363000 - DOUBLE (CONTEXT, 3, ~, CONTEX, CONTEXT); 70364000 - WHILE NOT (TERMINATOR OR BADSTUFF) 70365000 - DO BEGIN 70366000 - IF ELCLASS = STRNGCON OR ELCLASS =STRING 70367000 - THEN BEGIN 70367300 - WHILE NEXTCHAR.[45:3] ! 7 70367600 - DO PUTOGETHER ("1 000"); 70368000 - PUTOGETHER (33292288); % 1"000 70368300 - FLOGGER; 70369000 - IF ELCLASS = STRING 70370000 - THEN DO BEGIN 70370300 - GOBBLER ~ GOBBLE (FALSE); 70370600 - FLOGGER; 70371000 - END UNTIL NOT GOBBLER; 70371300 - PUTOGETHER (33292288); % 1"000 70371600 - END 70372000 - ELSE BEGIN 70373000 - IF FROM = DEFINEP AND ELCLASS } LFTPRN 70374000 - OR FIELDPARTB 70375000 - THEN BEGIN 70376000 - PARENS~PARENS+REAL(ELCLASS=LFTPRN); 70377000 - PARENS~PARENS-REAL(ELCLASS=RTPARN); 70378000 - BRAKET~BRAKET+REAL(ELCLASS=LFTBRKT); 70379000 - BRAKET~BRAKET-REAL(ELCLASS=RTBRKT ); 70380000 - END 70381000 - ELSE IF FROM = DEFINEV AND ELCLASS < NULLV 70382000 - THEN IF PARCOUNT ! 0 THEN 70383000 - BEGIN 70384000 - J ~ 1; 70385000 - DO BEGIN 70386000 - IF (GTB1 ~ DEFINFO[J] =ACCUM[1]) 70387000 - AND COUNT < 5 70387100 - THEN GO ON 70388000 - ELSE IF COUNT > 4 70389000 - AND GTB1 70389050 - THEN IF CMPCHREQL (COUNT -4,70389100 - ACCUM[2],DEFINFO[J+1]) 70390000 - THEN BEGIN 70391000 - ON: ACCUM[1]~DEFINFO[J-1]; 70392000 - GO AWAY; 70393000 - END 70394000 - END 70395000 - UNTIL J ~ J + 10 > PARCOUNT; 70396000 - END; 70397000 - AWAY: 70398000 - IF LASTRESULT < SPASE AND RESULT < SPASE 70399000 - THEN PUTOGETHER ("1 000"); 70400000 - PUTOGETHER (ACCUM [1]); 70401000 - IF ELCLASS=SEMICOLON AND FIELDPARTA THEN 70401100 - BEGIN BADSTUFF~TRUE; GO WAY END; 70401200 - END; 70402000 - LASTRESULT ~ RESULT; 70403000 - IF ELCLASS = DEFINEV THEN DEFINECTR ~ DEFINECTR + 1; 70404000 - IF ACCUM[1] ! "1#000" THEN 70404100 - IF MACRO THEN STEPIT 70405000 - ELSE BEGIN ELCLASS~TABLE(NXTELBT); NXTELBT~NXTELBT-1 END; 70406000 - IF TERMINATOR~FROM=DEFINEV AND ELCLASS=CROSSHATCH 70407000 - THEN BEGIN TERMINATE ~ ACCUM [1]; STEPIT; 70408000 - IF DEFINECTR > 1 70409000 - THEN TERMINATOR ~ DEFINECTR ~ DEFINECTR - 70410000 - REAL(ELCLASS ! COMMA) = 0; 70411000 - IF NOT TERMINATOR 70412000 - THEN PUTOGETHER (TERMINATE); 70413000 - END 70414000 - ELSE IF TERMINATOR ~ (FIELDPARTA AND ELCLASS = FINAL)70415000 - OR (FIELDPARTB 70416000 - AND (ELCLASS = FINAL OR ELCLASS = COMMA 70417000 - OR (ELCLASS = RTPARN AND PARENS = 0) 70418000 - OR ELCLASS = ASSNOP)) 70419000 - THEN TERMINATE ~ "1;000" 70420000 - ELSE TERMINATOR ~ DEFINPARAM AND 70421000 - (ELCLASS=COMMA OR ELCLASS=FINAL) 70422000 - AND (BRAKET+PARENS= 0); 70423000 - END; 70424000 - WAY: 70424500 - IF BADSTUFF 70425000 - THEN TEXT ~ - NEXTADDL 70426000 - ELSE BEGIN 70427000 - PUTOGETHER (TERMINATE); 70428000 - TEXT ~ NEXTADDL; 70429000 - END; 70430000 - PUTOGETHER ("1#000"); 70431000 - NEXTADDL ~ (CHARCOUNT + 7) DIV 8 + NEXTADDL; 70432000 - CONTEXT ~ CONTEX; 70433000 - END PLACING TEXT IN ADDL; 70434000 -PROCEDURE DEFINEDEC; 70435000 - BEGIN COMMENT DEFINEDEC PROCESSES THE DECLARATION 70436000 - ::= DEFINE . IF AN IDENTI-70437000 - FIER IS ENTERED, THE MINIMUM ADDL ENTRY IS A #; 70438000 - DEFINE SCAT = DO UNTIL STEPI = CROSSHATCH; 70439000 - IF STEPI = COMMA 70440000 - THEN GO BACK ELSE WHILE ELCLASS ! SEMICOLON DO STEPIT; 70441000 - GO EXIT;#; 70442000 - INTEGER LSTINFO, DEFI; 70443000 - INTEGER CONTEX; 70443100 - LABEL BACK, EXIT; 70444000 - DO BEGIN 70445000 -BACK: BADSTUFF ~ FALSE; 70446000 - DEFINECTR ~ 1; 70447000 - IF STEPI ! UNKNOWNID 70448000 - THEN BEGIN FLAG (700); SCAT END; 70449000 - GTB1 ~ ENTER (0, LOCALTYPE, DEFINDID, FALSE); 70450000 - 70451000 - 70452000 - LSTINFO ~ LASTINFO; 70453000 - IF STEPI = LFTPRN 70454000 - THEN BEGIN %PROCESS PARAMETERS 70455000 - DEFI ~ -9; 70456000 - DO BEGIN 70457000 - IF DEFI ~ DEFI + 10 > 90 70458000 - THEN BEGIN FLAG (749); SCAT END; 70459000 - IF STEPI > NULLV % MUST BE IN ID70460000 - THEN BEGIN FLAG(747); SCAT END; 70461000 - MOVE (GTI1~(Q.CHRCNT+11)DIV 8, 70462000 - ACCUM[1], DEFINFO[DEFI]); 70463000 - END UNTIL STEPI ! COMMA; 70464000 - IF ELCLASS ! RTPARN 70465000 - THEN BEGIN FLAG(749); SCAT END; 70466000 - INFO [(GT1~ LSTINFO).LINKR, 70467000 - GT1.LINKC].ADDRESS ~ DEFI; 70468000 - STEPIT; 70469000 - END; 70470000 - 70471000 - IF ELCLASS ! RELOP OR ELBAT[I].DISP ! EQUL 70472000 - THEN BEGIN 70473000 - FLAG (710); 70474000 - BADSTUFF ~ TRUE; 70475000 - GT1 ~ TEXT (DEFINEV, DEFI); 70476000 - SCAT; 70477000 - END; 70478000 - DOUBLE (CONTEXT, 3, ~, CONTEX, CONTEXT); 70478100 - STEPIT; 70479000 - CONTEXT ~ CONTEX; 70479100 - INFO [LSTINFO.LINKR,LSTINFO.LINKC].LINK ~ NEXTADDL; 70479500 -DONBUG ("DEFINE", LSTINFO, 0); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70479600 - 70479700 - IF TEXT (DEFINEV, DEFI) <0 70480000 - THEN BEGIN SCAT END; 70481000 - END UNTIL ELCLASS ! COMMA; 70482000 -EXIT: DEFINECTR ~ 0; 70483000 - END DEFINE DECLARATION; 70484000 - PROCEDURE PROCEDUREDEC(SAV,KLASS); VALUE SAV,KLASS; 70485000 - BOOLEAN SAV; INTEGER KLASS; 70486000 - COMMENT PROCEDUREDEC COMPILES A PROCEDURE DECLARATION. SAV IS TRUE 70487000 - FOR SAVE, AND KLASS IS THE ELCLASS FOR THE THING; 70488000 - BEGIN ARRAY TEDOC[0:31,0:255]; 70489000 - LABEL BYPASS,SGMENT,SAVE1; 70489100 - INTEGER X, Z, 70490000 - PROINFO, % INFO INDEX OF THE ENTRY WE MAKE 70491000 - NINFOOO, % OLD VALUE OF NINFOO 70492000 - SEGNOO, 70493000 - LASTXO, 70494000 - FIRSTXO, 70495000 - FIRSTMTO, LO, 70496000 - PADDL, % ADDL INDEX FOR THE PROCEDURE STUFF 70497000 - PINFO, % FIRST PARAMETER INFO INDEX 70498000 - DSP; % DISPLACEMENT VALUE FOR PARAM ADDRESSES 70499000 - BOOLEAN SEGED, %PROCEDURE BODY IS A SEGMENT 70500000 - SEPARATOGO, % OLD "SEPARATOG" 70500500 - SVINFOO, % OLD "SVINFO" 70500600 - BLOCKED; % BODU IS A BLOCK 70501000 - REAL Y,P, 70502000 - CQAO, % COUNTQALG SAVED HERE 70502100 - ELBW, % ELBAT WORD FOR THE PROCEDURE. 70503000 - FELBW, % ELBAT WORD OF THE FORWARD DEC, IF ANY 70504000 - NP; % FIRST ADDL WORD FOR THE PROCEDURE. 70505000 - DEFINE FWD = FELBW ! 0#; 70506000 - IF SVINFOTOG THEN ELSE 70506200 - BEGIN 70506300 - SVINFOO~SVINFO; 70506400 - SVINFO~FALSE; 70506500 - END; 70506600 - CONTEXT ~ 0; % ITS DECLARATION TIME 70507000 - IF STEPI ! UNKNOWNID THEN % PROCID MATCHES A LOCAL ID 70508000 - IF ELBAT[I].TYPE ! F0RWARD THEN FLAG(731) ELSE 70509000 - IF ELCLASS ! KLASS THEN FLAG(730) ELSE 70510000 - FELBW ~ ELBAT[I]; % ITS OK--WAS DECLARED FWD WITH SAME TYPE 70511000 - IF BOOLEAN(X~REAL(REAL(SEPARATOG AND BOOLEAN(3))!0)) THEN 70511200 - BEGIN 70511400 - IF (GLOBLCNT~GLOBLCNT+1).[16:5]>2 THEN FLAG(791); 70511600 - GLOBALINDEX; % PRINT PRT FOR GLOBAL IF "PRTOG" IS SET 70511800 - END; 70512000 - TB1~ENTER(IF FWD THEN FELBW.ADDRESS ELSE 70512200 - IF BOOLEAN(X) THEN GLOBLCNT ELSE CURRENT, 70512400 - WITHINBODY, KLASS, NOT(FWD OR BOOLEAN(X))); 70512600 - IF SEPARATOGO~SEPARATOG THEN 70512800 - BEGIN 70513000 - SEPSTR[12]~" "; 70513100 - MOVECHARACTERS(X~MIN(7,COUNT),ACCUM[1],4,SEPSTR[12],1); 70513200 - FILL TEMP WITH SEPSTR[12]; 70513300 - SEPSTR[12].[1:5]~X; 70513350 - WRITE(TEMP); % SAVE THE 1ST RECORD FOR DIRECTORY. 70513400 - END; 70513500 - ELBW ~ TAKE(PROINFO ~ LASTINFO) & PADDL ~ NEXTADDL [33:33:15]; 70514000 - PUT(ELBW,PROINFO); 70515000 - PUTNBUMP(0); % RESERVE CELL FOR 1ST ADDL WORD 70516000 - DSP ~ 1; % PREPARE FOR ADDRESS CALCULATIONS 70517000 - NINFOOO ~ NINFOO; 70518000 - X ~ PINFO ~ NINFOO ~ NEXTINFO; 70519000 - CONTEXT ~ 2; 70520000 - IF STEPI = LFTPRN THEN % IF ANY PARAMETERS... 70521000 - NP ~ FORMALPARAPART(FALSE) % THEN HANDLE THEM 70522000 - ELSE 70523000 - IF ELCLASS ! SEMICOLON THEN FLAG(736) ELSE STEPIT; 70524000 - FOR Z ~ 1 STEP 1 UNTIL NP DO % FOR EACH PARAMETER 70525000 - BEGIN % X POINTS TO FIRST PARAM INFO 70526000 - IF (P~Y~TAKE(X)).CLASS = 0 THEN P~Y~TAKE(X~Y); 70527000 - P.LINK ~ P.ADDRESS; % FMLPARAPART PUTS LINK IN 70528000 - P.LVEL ~ CURRENT + 1; % AND WE ASSIGN ADDRESSES 70529000 - P.DISP ~ DSP ~ DSP + 1; 70530000 - PUT(P,X); 70531000 - IF P.CLASS = FORMALID THEN % NO SPECIFICATION FOR THISUN 70532000 - FLAG(732) ELSE % CHANGE TO PURGE-TYPE ACTION 70533000 - IF P.CLASS=DPID OR P.CLASS=EVENTID THEN 70534000 - DSP ~ REAL (P.TYPE = FORMALVALUEP) + DSP ELSE 70535000 - IF P.CLASS } BOOARRAYID AND P.CLASS { EVENTARRAYID THEN 70536000 - P.LINK ~ GIT(P).NODIM; 70537000 - PLACE(P)"INTO ADDL AT"(PADDL + Z); 70538000 - X ~ Y.LINK %X NOW POINTS TO NEXT PARAM ENTRY 70539000 - END OF PARAMETER FUTZING; 70540000 - IF ELCLASS { IDMAX THEN 70540100 - IF X ~ ELBAT[I].LINK } PINFO THEN 70540200 - ELBAT[I].ADDRESS ~ TAKE(X).ADDRESS; 70540300 - IF FWD THEN 70541000 - IF GIT(X ~TAKE(FELBW).LINK).LINK!NP THEN FLAG(733) ELSE 70542000 - FOR Y ~ 1 STEP 1 UNTIL NP DO % CHECK CORRESPONDENCE WITH FWDEC70543000 - IF GIT(X + Y) ! GIT(PADDL + Y) THEN FLAG(734); 70544000 - IF KLASS ! PROCID THEN 70545000 - NP.ADDRESS ~(DSP ~ DSP + 1)&(CURRENT + 1)[30:42:6]; 70546000 - COMMENT THAT SHOULD TAKE CARE OF THE PROCEDURE HEAD. NOW WE TRY 70547000 - FOR A BODY-- OR AT LEAST A "FORWARD"; 70548000 - PLACE(NP,PADDL); 70549000 - IF ELCLASS=EXTERNALV THEN 70549100 - IF SEPARATOG THEN 70549150 - BEGIN % TIME FOR SEPARATED PROCEDURE DECLARATIONS, 70549200 - FLAG(788); % IT SHOULDNT HAVE AN "EXTERNAL" IN ANY SENSE.70549250 - GO BYPASS; 70549300 - END ELSE 70549350 - IF REAL(SEPARATOG)=2 THEN % TIME FOR GLOBAL DECLARATIONS, IT 70549400 - GO BYPASS ELSE % IS A GLOBAL PROC DECLARATION. 70549450 - BEGIN % WE ARE DOING REGULAR COMPILATION, IT IS AN EXTRNL DEC.70549500 - EXTRNLCNT~EXTRNLCNT+REAL(SVINFO~XTRNL~TRUE); 70549550 - SEGNOO~NEWSEG(PROINFO+1); 70549560 - PURGE(NEXTINFO~IF FWD THEN PROINFO ELSE PINFO); 70549570 - IF FWD THEN PROINFO~FELBW.LINK; 70549580 - PUT(TAKE(PROINFO)&LOCALTYPE[29:45:3],PROINFO); 70549590 - NINFOO~NINFOOO; 70549600 - NEXTADDL~IF FWD THEN PADDL ELSE PADDL+NP.LINK+1; 70549610 - SEGDICT(SEGNOO,0,0,0); 70549630 - LO~L; % THE L VALUE OF "MPCW" 70549640 - IF SEGED~SEPARATOG OR CURRENT>0 THEN 70549650 - BEGIN 70549653 - EMITPCW(CURRENT+1,0,STATE,SEGNOO); 70549656 - IF FWD THEN 70549658 - BEGIN 70549660 - EMITN(TAKE(PROINFO).ADDRESS); 70549662 - EMIT(STOD); 70549664 - END; 70549666 - END ELSE 70549668 - GLOBALPCW(ELBW.DISP,SEGNOO,0,STATE); 70549670 - INFD[(GT3~INFDX~INFDX+1).LINKR,INFDX.LINKC]~PCW; 70549680 - INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC]~NEXTINFO& 70549690 - (GT1~((GT2~TAKE(PROINFO+1)).CHRCNT+35)DIV 8) 70549700 - [18:33:15]&KLASS[1:41:7]; 70549710 - INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC]~ 70549720 - PROINFO&(IF SEGED THEN LO&SEGNO[20:35:13] ELSE 70549730 - ELBW.DISP)[5:20:28]; 70549740 - INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC]~ 70549750 - GT2&LASTEXT[3:33:15]; 70549760 - LASTEXT~GT3; 70549770 - IF GT1}5 THEN 70549780 - BEGIN 70549790 - MOVE(GT1-4,INFO[PROINFO.LINKR,PROINFO.LINKC+2], 70549800 - INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC]); 70549810 - INFDX~INFDX+GT1-5; 70549820 - END; 70549825 - XTRNL~FALSE; 70549830 - STEPIT; 70549835 - END ELSE 70549990 - IF ELCLASS = FORWARDV THEN 70550000 - BEGIN 70551000 - IF FWD THEN FLAG(735) ELSE % OOOOOPS...... 70552000 - IF SEPARATOG THEN FLAG(789) ELSE 70552100 - IF REAL(SEPARATOG)!2 THEN % =2: GLOBAL DEC FOR SEPA COMP.70552150 - IF CURRENT>0 THEN 70552200 - BEGIN JUMPCHKX; EMIT(ZERO) END; 70552300 - BYPASS: PURGE(NINFOO); % DISPOSE OF THE PARAM INFO 70553000 - ELBW.TYPE ~ F0RWARD; 70554000 - PUT(ELBW, LASTINFO ~ PROINFO); 70555000 - NEXTINFO ~ NINFOO; 70556000 - NINFOO ~ NINFOOO; 70557000 - NEXTADDL ~ PADDL + NP.LINK + 1; 70558000 - STEPIT; 70558100 - END FORWARD DECLARARATION ELSE 70559000 - IF ELCLASS = NULLV THEN 70559100 - BEGIN 70559200 - ELBW ~ TAKE(ELBAT[I-2]) & ELBW [21:21:7]; 70559300 - PUT(ELBW,LASTINFO ~ PROINFO); 70559400 - NEXTINFO ~ NINFOO; 70559500 - NINFOO ~ NINFOOO; 70559600 - NEXTADDL ~ PADDL + NP.LINK + 1; 70559700 - STEPIT; 70559800 - END ELSE 70559900 - COMMENT THE HEAD GOTS A BODY; 70560000 - BEGIN 70561000 - IF SEPARATOG THEN SEPARATOG~BOOLEAN(4) ELSE 70561100 - IF REAL(SEPARATOG)=2 THEN FLAG(790); 70561200 - MAXDISP ~ STACKMASK[CURRENT ~ CURRENT + 1].[FF]; 70562000 - STACKTOP[CURRENT] ~ MAXSTACK[CURRENT] ~ 70563000 - REAL(KLASS = DPPROCID) + DSP + 1; 70564000 - TB1 ~ SAV; SAV ~ SAVED; SAVED ~TB1; 70565000 - SEGNOO ~ SEGNO; 70566000 - CONTEXT ~ 2; 70567000 - IF ELCLASS = BEGINV THEN 70568000 - IF BLOCKED ~GT1~TABLE(I+1)}MINDEC AND GT1{MAXDEC THEN 70569000 - SGMENT: IF SEGED~NOT SAVED THEN 70570000 - BEGIN % NEW SEGMENT REQUIRED 70571000 - IF REAL(SEPARATOGO)=4 THEN 70571100 - BEGIN 70571200 - SEGED~NOT(SAVED~TRUE); 70571400 - GO TO SAVE1; 70571500 - END ELSE 70571600 - SAVED~SEPARATOGO; 70571700 - SEGNO ~ NEWSEG(PROINFO+1); 70572000 - MOVECODE(TEDOC,EDOC); 70573000 - LO ~ L; L ~ 0; 70574000 - GO TO SAVE1; 70574500 - END; 70575000 - IF SEPARATOGO THEN GO TO SGMENT; 70575050 - SAVE1: IF SAVED.[46:1] THEN 70575100 - BEGIN 70575200 - LO ~ L; SEGNO ~ 1; 70575300 - L ~ IF SAVEL = 0 THEN SAVEL ~18 ELSE SAVEL; 70575400 - MOVECODE(EDOC,INZCODE); 70575500 - END ELSE 70575900 - IF NOT SEGED THEN JUMPCHKNX; 70576000 - LASTXO ~ LASTX; FIRSTXO ~ FIRSTX; FIRSTMTO ~ FIRSTMT; 70577000 - LASTX ~ FIRSTX ~ FIRSTMT ~ -1; 70578000 - X~L; % THIS STORES THE STARTING L FOR SEPARATED COMPILING70578100 - 70579000 - IF KLASS ! PROCID THEN 70580000 - BEGIN 70581000 - JUMPCHKX; %GOT TO INITIALIZE THE VALUE CELL 70582000 - EMIT(ZERO); 70583000 - IF KLASS = DPPROCID THEN EMIT(XTND) ELSE 70584000 - IF KLASS = REFPROCID THEN 70585000 - BEGIN EMITNUM(5); EMIT(STAG) END 70586000 - END; 70587000 - LASTINDEX ~ LASTNOT ~ 0; 70588000 - P~NEXTADDL; 70588500 - NINFOO ~ NEXTINFO; 70589000 - CQAO ~ COUNTQALG; COUNTQALG ~ STARTNSQ; 70589100 - Y ~ STACKTOP[CURRENT - 1]; 70590000 - IF BLOCKED THEN 70591000 - BEGIN 70592000 - BEGINCTR ~ BEGINCTR + 1; 70593000 - DECLARATIONS; 70594000 - FIRSTATEMENT; 70596000 - 70597000 - COMPOUNDTAIL; 70598000 - IF SVINFO THEN 70598100 - BEGIN 70598150 - WRITEFILE(INFF,INFO,NINFOO,NEXTINFO-1); 70598200 - WRITEFILE(INFF,ADDL,P,NEXTADDL-1); 70598250 - INFD[(INFDX~INFDX+2).LINKR,INFDX.LINKC] ~ 70598300 - (GTI1~(NEXTINFO-NINFOO+29)DIV 30+INFFX)& 70598350 - INFFX[18:33:15]; 70598400 - INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC] ~ 70598450 - (NEXTINFO-1)&NINFOO[18:33:15]& 70598500 - (NINFOO-STARTINFO)[3:33:15]; 70598550 - INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC] ~ 70598600 - (NEXTADDL-1)&P[18:33:15]& 70598650 - (P-STARTADDL)[3:33:15]; 70598700 - INFFX~(NEXTADDL-P+29) DIV 30 + GTI1; 70598750 - END; 70598900 - END ELSE 70600000 - BEGIN 70601000 - FIRSTATEMENT; 70601100 - STATEMENT 70601200 - END PROCEDURE BODY; 70601300 - COMMENT SO MUCH FOR THE PROCEDURE. NOW TO CLEAN UP ALL THAT MESS; 70602000 - NINFOO ~ NINFOOO; 70603000 -COMMENT THE FOLLOWING APPLIES TO CODE AT 70616500-700; 70605000 - COMMENT IF A PROCEDURE HAD BEEN DECLARED FORWARD, WE 70606000 - MAKE A COMPLETE NEW ENTRY IN INFO AT THE ACTUAL 70607000 - DECLARATION. THE CODE JUST ABOVE HAS REMOVED THE 70608000 - DUPLICATE ENTRY, AS WELL AS THE PARAMETER ENTRIES; 70609000 - IF REAL(ARRAYDECTOG AND BOOLEAN(2*CURRENT))!0 THEN 70609150 - BEGIN 70609200 - EMIT(MKST); 70609300 - EMITN(BLOCKEXITPCW); 70609400 - EMIT(ENTR); 70609500 - ARRAYDECTOG~ARRAYDECTOG AND NOT BOOLEAN(2*CURRENT); 70609540 - END; 70609600 - IF KLASS = PROCID THEN EMIT(EXIT) ELSE 70610000 - BEGIN 70611000 - IF KLASS=REFPROCID OR KLASS=PTRPROCID OR KLASS 70612000 - =WORDPROCID THEN 70612500 - EMITPAIR(NP.ADDRESS,LODT ) ELSE 70613000 - EMITV(NP.ADDRESS); 70614000 - EMIT(RETN); 70615000 - END; 70616000 - PURGE(NEXTINFO~IF FWD THEN PROINFO ELSE PINFO); 70616500 - NEXTADDL~IF FWD THEN PADDL ELSE PADDL + NP.LINK +1; 70616700 - IF SEGED THEN 70617000 - BEGIN 70618000 - WHILE L MOD 6 ! 0 DO EMIT(NVLD); 70619000 - SEGDICT(SEGNO,TEMPADDR,L DIV 6, 0); 70620000 - SEGMENT( (IF FWD THEN PROINFO ~ FELBW.LINK 70621000 - ELSE PROINFO)+1, L DIV 6, EDOC); 70622000 - MOVECODE(TEDOC,EDOC); 70623000 - DSP~L; % THIS STORES THE LAST L FOR SEPARATED COMPLG70623500 - L ~ LO; LASTINDEX ~ LASTNOT ~ 0; 70624000 - DOUBLE(SEGNO,SEGNOO,~,SEGNOO,SEGNO); 70625000 - END ELSE 70626000 - BEGIN 70626100 - DSP~L; % THIS STORES THE LAST L OF THIS LEVEL 70626120 - IF FWD THEN PROINFO~FELBW.LINK; 70626140 - END; 70626160 - IF SAVED.[46:1] THEN 70626200 - BEGIN 70626300 - MOVECODE(EDOC,INZCODE); 70626400 - SAVEL ~ L; L ~ LO; SEGNO ~ SEGNOO; SEGNOO~ 1; 70626500 - LASTINDEX ~ LASTNOT ~ 0; 70626600 - END; 70626900 - LO ~ IF FIRSTX < 0 THEN FIRSTMT ELSE FIRSTX; 70627000 - FIRSTX ~ FIRSTXO; LASTX ~ LASTXO; 70628000 - COUNTQALG ~ CQAO; 70628100 - FIRSTMT ~ FIRSTMTO; 70629000 - SAVED ~ SAV; 70630000 - IF SEPARATOG~SEPARATOGO THEN 70630300 - EMITPCW(CURRENT,LO,STATE,SEGNOO) ELSE 70630600 - IF CURRENT = 1 THEN 70631000 - GLOBALPCW(ELBW.DISP,SEGNOO,LO,STATE) ELSE 70632000 - BEGIN 70633000 - JUMPCHKX; 70634000 - EMITPCW(CURRENT,LO,STATE,SEGNOO); 70635000 - IF FWD THEN 70635100 - BEGIN 70635150 - EMITN(TAKE(PROINFO).ADDRESS); 70635200 - EMIT(STOD); 70635250 - END; 70635300 - ENTERSEPA(((L-6)DIV 6),DSP,X); 70635500 - X ~ STACKTOP[CURRENT-1]; 70636000 - WHILE Y~Y+1{X DO EMIT(ZERO); 70637000 - END; 70638000 - PUT(TAKE(PROINFO)&LOCALTYPE[29:45:3],PROINFO); 70639000 - IF SVINFO THEN 70639100 - INFD[(GTI1+INFDX-3).LINKR,GTI1.LINKC]~PCW; 70639200 - IF SVINFOTOG THEN ELSE SVINFO~SVINFO OR SVINFOO; 70639800 - MAXDISP ~ STACKMASK[CURRENT ~ CURRENT-1].[FF]; 70640000 - END BODY OF THE PROCEDURE 70641000 - END OF THE PROCEDURE DECLARARION; 70642000 - INTEGER PROCEDURE FORMALPARAPART(Q); VALUE Q; BOOLEAN Q; 70643000 - COMMENT FORMALPARAPZRT HANDLES THE FORMAL PARAMETER LIST, VALUE 70644000 - PART, AND SPECIFICATION PART FOR PROCEDURE AND QUEUE DECS. 70645000 - Q IS TRUE FOR QUEUES. FMLPARAPART RETURNS THE NUMBER OF 70646000 - PARAMETERS, AND SVAES THAT MANY SPOTS IN ADDL. 70647000 - HE LEAVES FUNNY THINGS IN THE ELBAT WORDS IN INFO: 70648000 - THE LINK FIELD POINTS TO THE ELBAT WORD FOR THE NEXT PARAM, AND70649000 - THR LINK-FIELD-VALUE, AS APPROPRIATE, IS IN THE ADDRESS FIELD. 70650000 - THE ADDRESS FIELD IS OTHERWISE MEANINGLESS; 70651000 - BEGIN 70652000 - INTEGER MARK,PJ,T; 70653000 - LABEL ROUND, BACK ,FLUSH, ARRAI, SIMPLE; 70654000 - LABEL SIMPLENV; 70654100 - CONTEXT ~ 0; 70655000 - MARK ~ NEXTINFO; 70656000 - T ~ IF Q THEN FORMALNAMEQ ELSE FORMALNAMEP; 70657000 - DO BEGIN 70658000 -ROUND: IF STEPI ! UNKNOWNID THEN FLAG(739); 70659000 - ERRORTOG ~ TRUE; 70659100 - TB1 ~ 70660000 - ENTER(0,T,FORMALID,FALSE); 70661000 - PUT(TAKE(LASTINFO)&NEXTINFO[33:33:15],LASTINFO); 70662000 - PJ ~ PJ + 1 70663000 - END UNTIL STEPI ! COMMA; 70664000 - IF ELCLASS = COLON THEN 70665000 - BEGIN 70666000 - IF Q THEN 70667000 - IF INVISIBLE } MARK THEN FLAG(742) ELSE 70668000 - INVISIBLE ~ NEXTINFO ELSE FLAG(742); 70669000 - GO ROUND; 70670000 - END; 70671000 - NEXTADDL ~ (FORMALPARAPART ~ PJ) + NEXTADDL; 70672000 - IF ELCLASS ! RTPARN THEN 70673000 - BEGIN 70674000 - FLAG(737); 70675000 - FLUSH: WHILE ELCLASS ! SEMICOLON DO STEPIT; 70676000 - ERRORTOG ~ TRUE; 70676100 - END ELSE 70677000 - STEPIT; 70678000 - IF ELCLASS ! SEMICOLON THEN FLAG(738 ) ELSE STEPIT; 70679000 - CONTEXT ~ 1; 70680000 - T ~ IF Q THEN FORMALVALUEQ ELSE FORMALVALUEP; 70681000 - IF ELCLASS ! VALUEV THEN ELCLASS ~ TABLE(I~I-1) ELSE 70682000 - DO IF STEPI ! FORMALID THEN FLAG(747) ELSE 70683000 - IF GT1~ELBAT[I].TYPE =FORMALVALUEP OR 70683100 - GT1 = FORMALVALUEQ THEN 70683110 - BEGIN FLAG(784); ERRORTOG ~ TRUE END ELSE 70683200 - PUT(TAKE(ELBAT[I])&T[29:44:4],ELBAT[I]) 70684000 - UNTIL STEPI ! COMMA; 70685000 - BACK: MARK ~ 0; 70686000 - CONTEXT ~ 2; 70687000 - IF ELCLASS ! SEMICOLON THEN ERR(740) ELSE STEPIT; 70688000 - CONTEXT ~ 1; 70689000 - IF ELCLASS = TYPEV THEN 70690000 - BEGIN 70691000 - T ~ TAKE(ELBAT[I]).LINK ; 70692000 - IF PJ ~ TABLE(I+1) = PROCV THEN 70693000 - BEGIN T ~ T + BOOPROCID; STEPIT; GO TO SIMPLENV END; 70694000 - IF PJ = ARRAYV THEN 70695000 - BEGIN 70696000 - IF T ~ T ~ BOOARRAYID = PCID THEN FLAG(741); 70697000 - STEPIT; 70698000 - GO TO ARRAI 70699000 - END; 70700000 - IF PJ > IDMAX THEN 70701000 - BEGIN 70702000 - FLAG(741); 70703000 - WHILE ELCLASS>IDMAX AND ELCLASS!SEMICOLON DO STEPIT; 70704000 - IF ELCLASS = SEMICOLON THEN GO BACK 70705000 - END; 70706000 - T ~ T + BOOID; 70707000 - GO TO SIMPLE 70708000 - END; 70709000 - IF ELCLASS = ARRAYV THEN 70710000 - BEGIN T ~ REALARRAYID; GO TO ARRAI END; 70711000 - IF ELCLASS = PROCV THEN 70712000 - BEGIN T ~ PROCID; GO TO SIMPLENV END; 70713000 - IF ELCLASS = PITCHER THEN 70714000 - BEGIN T ~ PCID; 70714100 - SIMPLENV: COMMENT WE ARE HERE TO PROCESS SIMPLE SPECIFICATION THAT 70714200 - DISALLOW VALUE BUSINESS; 70714300 - DO IF STEPI ! FORMALID THEN FLAG(743) ELSE 70714400 - BEGIN 70714500 - IF (GT1~TAKE(ELBAT[I])).TYPE=FORMALVALUEP OR 70714600 - GT1.TYPE=FORMALVALUEQ THEN FLAG(784); 70714610 - PUT(GT1 & T [21:41:7],ELBAT[I]); 70714700 - ERRORTOG ~ TRUE 70714800 - END UNTIL STEPI ! COMMA; 70714900 - GO BACK 70715000 - END; 70715100 - IF ELCLASS = EVENTV THEN 70716000 - BEGIN 70717000 - IF TABLE(I+1) = ARRAYV THEN 70718000 - BEGIN 70719000 - T ~ EVENTARRAYID; 70720000 - STEPIT; 70721000 - ARRAI: IF STEPI ! FORMALID THEN FLAG(743) ELSE 70722000 - PUT((GT1~TAKE(ELBAT[I]))&T[21:41:7]&MARK 70723000 - [6:33:15], MARK ~ ELBAT[I].LINK); 70724000 - IF GT1.TYPE=FORMALVALUEP OR 70724100 - GT1.TYPE=FORMALVALUEQ THEN 70724110 - BEGIN FLAG(784); ERRORTOG ~ TRUE END; 70724200 - IF STEPI = COMMA THEN GO TO ARRAI; 70725000 - IF ELCLASS ! LFTBRKT THEN 70726000 - BEGIN FLAG(744); GO FLUSH END; 70727000 - PJ ~ 0; COMMENT TO COUNT DIMENSIONS; 70728000 - DO IF STEPI ! FACTOP THEN FLAG(745) ELSE PJ~PJ+170729000 - UNTIL STEPI ! COMMA; 70730000 - DO PUT((GT1~TAKE(MARK))&NEXTADDL[6:33:15],MARK) 70731000 - UNTIL MARK ~ GT1.ADDRESS = 0; 70732000 - PUTNBUMP(PJ); 70733000 - IF ELCLASS ! RTBRKT THEN 70734000 - BEGIN FLAG(746 ); GO FLUSH END; 70735000 - IF STEPI ! COMMA THEN GO BACK; 70736000 - GO TO ARRAI 70737000 - END ARRAY SPECIFICATION; 70738000 - T ~ EVENTID; 70739000 - SIMPLE: DO IF STEPI ! FORMALID THEN FLAG(743) ELSE 70740000 - PUT(TAKE(ELBAT[I])&T[21:41:7],ELBAT[I]) 70741000 - UNTIL STEPI ! COMMA; 70742000 - GO BACK 70743000 - END EVENT; 70744000 - IF ELCLASS } MINDEC THEN 70745000 - IF ELCLASS { MAXDEC THEN 70746000 - BEGIN FLAG(741); GO FLUSH END; 70747000 - END FORMAL PARAMETER PART; 70748000 -PROCEDURE READONLYARRAYDEC(SAVEBIT,TYP); VALUE SAVEBIT,TYP; 70749000 - BOOLEAN SAVEBIT; INTEGER TYP; 70750000 - COMMENT THIS CODE HANDLES VALUE ARRAY DECLARATION AS: 70751000 - SAVE VALUE ARRAY() 70752000 - INITIALIZEARRAY PROCEDURE IS CALLED TO CREATE A SEGMENT 70753000 - AND THEN APPROPRIATE PDPRT ENTRIES ARE MADE 70754000 - SAVEBIT - FOR INDICATING SAVE ARRAY 70755000 - TYP - CLASS OF IDENTIFIER TYPE; 70756000 - BEGIN 70757000 - LABEL STRT;% 70757100 - IF STEPI!ARRAYV THEN ERR(718); %ARRAY WORD MISSING 70758000 - TYP~BOOROAID+TYP; %MAKE APPROPRIATE READONLY ARRAY ID CLASS 70759000 -STRT:% 70759100 - IF STEPI!UNKNOWNID THEN ERR(719); %IDENTIFIER DECLARED BEFORE 70760000 - TB1~ENTER(0,LOCALTYPE,TYP,TRUE);%GET STACK AND MAKE INFO ENTRY70761000 - IF STEPI ! ASSNOP THEN FLAG(709); 70761100 - INITIALIZEARRAY(TYP - BOOROAID); % PASS TYPE OF INITIAL VALUE 70762000 - PDPRT[PPINX].[7:1]~1; 70763000 - PDPRT[PPINX].[8:1]~IF SAVEBIT THEN 1 ELSE 0; 70764000 - SAVESIZE~SAVESIZE+PDPRT[PPINX].[10:13]; 70764500 - PDINX~PDINX+1; 70765000 - IF STEPI=COMMA THEN GO TO STRT;% 70766000 - END READONLYARRAYDEC; 70767000 -PROCEDURE INITIALIZEARRAY(KLASS); VALUE KLASS; INTEGER KLASS; 70768000 - COMMENT INITIALIZEARRAY HANDLES THE CONSTRUCT: 70769000 - () 70770000 - WHICH IS USED IN VALUE ARRAY DECLARATION AND ARRAY DECLARATION70771000 - IT USES EDOC ARRAY FOR STORING CONSTANTS AND THEN CALLS 70772000 - SEGMENT FOR CREATING SEGMENT.IT ALSO INSERTS SOME FIELDS IN 70773000 - PDPRT ENTRY 70774000 - KLASS- CLASS OF EXPECTED VALUES(BOOV,DPV,REALV,INTV OR PTRV) 70775000 - KLASS=(READONLYARRAY IDENTIFIER CLASS)-26 OR 70776000 - (ARRAY IDENTIFIER CLASS)-20; 70777000 - BEGIN LABEL QUIT; 70778000 - INTEGER INDEX, TINDEX; 70779000 - ARRAY TEDOC[0:31,0:255]; 70780000 - DEFINE MAXNTGR=549755813887#, 70781000 - EDOCI=INDEX.[35:5],INDEX.[40:8]#; 70782000 - IF STEPI!LFTPRN THEN ERR(720); 70783000 - MOVECODE(EDOC,TEDOC); 70784000 - TAX ~ TINDEX ~ INDEX ~ 0; 70785000 - FILLDATA(0); 70786000 - TINDEX ~ TAX DIV 2; 70787000 - 70788000 - DO BEGIN 70789000 - FLOG (TA[INDEX|2+1], TA[INDEX|2], 70790000 - EDOC[EDOCI]); 70791000 - END UNTIL INDEX ~ INDEX + 1 } TINDEX; 70792000 - INDEX ~ TINDEX; 70793000 - IF ELCLASS!RTPARN THEN ERR(723); %MISSING RIGHT PARANTHESIS 70808000 - PDPRT[PPINX].[23:13]~TEMPADDR; 70808500 - SEGMENT(LASTINFO+1, INDEX, EDOC); 70809000 - MOVECODE(TEDOC,EDOC); 70810000 - PDPRT[PPINX].[10:13]~INDEX; %INSERT ARRAY SIZE FIELD 70811000 - PDPRT[PPINX].[36:12]~INFO[LASTINFO.LINKR,LASTINFO.LINKC]. 70812000 - ADDRESS; 70813000 - INFO[LASTINFO.LINKR,LASTINFO.LINKC].LINK~NEXTADDL; 70814000 - PUTNBUMP(1); 70814500 - IF KLASS=DPV THEN PDPRT[PPINX].[6:1]~1; 70815000 - END INITIALIZEARRAY; 70816000 -PROCEDURE ARRAYDEC(SAVEBIT,OWNBIT,KLASS); 70817000 - VALUE SAVEBIT,OWNBIT,KLASS; 70818000 - BOOLEAN SAVEBIT,OWNBIT; 70819000 - INTEGER KLASS; 70820000 - COMMENT THIS CODE HANDLES OF ARRAY DECLARATION: 70821000 - ARRAY 70822000 - IT ALSO HANDLES THE ARRAY DECLARATION AS A WHOLE BY USING 70823000 - THE INFORMATION PASSED ON THROUGH PARAMETERS. 70824000 - SAVEBIT- FOR INDICATING SAVE ARRAY 70825000 - OWNBIT - FOR INDICATING OWN ARRAY 70826000 - KLASS - CLASS OF ARRAY IDENTIFIER TYPE; 70827000 - BEGIN LABEL LOOP,PASSRTBRKT,QUIT; 70828000 - LABEL FINI,NEXTDIM,CHECKAGAIN,SKIP; 70828500 - INTEGER CONTEX,NOOFID,TCURRENT; 70829000 - INTEGER NOOFDIMS, 70829400 - TNOOFID, %TEMPORARY FOR NOOFID 70829600 - ARRAYTYPE; 70829700 - BOOLEAN ADDRTOG, %ON MEANS ADDRESS PART IN SOURCE 70830000 - DPTOG, %ON MEANS KLASS DP OR EVENT 70830500 - ASTERIKTOG, % FIRST DIMENSION IS ASTERIK; 70830600 - MULTIDIMTOG, 70830700 - PDPRTOG; %GLOBAL SAVE ARRAY- MAKE PDPRT ENTRY 70831000 - INTEGER OL; BOOLEAN CODE; 70831100 - DEFINE SCAT=DO STEPIT UNTIL ELCLASS=COMMA OR ELCLASS=SEMICOLON70832000 - ; I~I-1; GO QUIT;#; 70833000 - DEFINE ARRAYDECPCW=7#; 70833500 - CONTEX~CONTEXT; %FUTZ UP THE SCANNER 70834000 - 70835000 - JUMPCHKX; 70836000 - TCURRENT~CURRENT; %STORES THE CURRENT LEVEL 70838000 - IF KLASS=QUEUEARRAYID THEN 70838500 - BEGIN QUEUEDEC(IF OWNBIT THEN GLOBAL ELSE CURRENT);GO FINI END;70838550 - IF OWNBIT OR (SAVEBIT AND CURRENT=0) THEN %GLOBAL SAVE ARRAY 70839000 - PDPRTOG~TRUE; 70840000 - DPTOG~KLASS=EVENTARRAYID OR KLASS=DPARRAYID; 70840500 -LOOP: 70841000 - NOOFDIMS~1; 70841100 - CONTEXT ~ NOOFID ~ 0; 70841200 - OL ~ L; CODE ~ NOT PDPRTOG; 70841300 - MULTIDIMTOG~ASTERIKTOG~ADDRTOG~FALSE; 70841500 - DO BEGIN 70842000 - IF STEPI!UNKNOWNID THEN 70843000 - BEGIN FLAG(724); SCAT END; %ID DECLARED BEFORE 70844000 - DEBLANK; %INITIALIZED ARRAY 70845000 - IF CHR="~" THEN 70846000 - BEGIN 70847000 - IF KLASS=EVENTARRAYID THEN FLAG(783); 70847500 - IF NOOFID!0 THEN %MORE THAN ONE IDENTIFIER 70848000 - BEGIN FLAG(725); SCAT END;%DECLARED BEFORE ~ 70849000 - TB1~ENTER(0,LOCALTYPE,KLASS,TRUE); 70850000 - STEPIT; 70851000 - INITIALIZEARRAY(KLASS-20); 70852000 - IF CURRENT ! 0 THEN FLAG(717); 70852100 - PDPRT[PPINX].[8:1]~REAL(SAVEBIT OR OWNBIT); 70853000 - SAVESIZE~PDPRT[PPINX].[10:13]+SAVESIZE; 70853500 - PDINX~PDINX+1; 70854000 - GO QUIT; 70855000 - END; 70856000 - NOOFID~NOOFID+1; 70856500 - IF NOT ENTER(TCURRENT,LOCALTYPE,KLASS,TRUE) THEN 70857000 - BEGIN 70858000 - INFO[LASTINFO.LINKR,LASTINFO.LINKC].LINK~NEXTADDL; 70859100 - IF CURRENT=0 AND NOT PDPRTOG THEN 70859130 - PUTNBUMP(INFO[LASTINFO.LINKR,LASTINFO.LINKC].ADDRESS) ELSE 70859160 - PUTNBUMP(1); 70859200 - IF PDPRTOG THEN 70860000 - BEGIN 70861000 - PDPRT[PPINX].[36:12]~INFO[LASTINFO.LINKR,LASTINFO. 70862000 - LINKC].ADDRESS; 70863000 - IF DPTOG THEN PDPRT[PPINX].[6:1]~1; 70864000 - 70865000 - PDPRT[PPINX].[8:1]~1; 70866000 - PDINX~PDINX+1; 70867000 - END; 70868000 - END ELSE 70869000 - ADDRTOG~TRUE; 70870000 - END 70871000 - UNTIL STEPI!COMMA; 70872000 - IF NOT ADDRTOG THEN 70872400 - IF PDPRTOG THEN PDINX~PDINX-NOOFID; 70872500 - IF ELCLASS!LFTBRKT THEN 70873000 - BEGIN FLAG(726); SCAT END; %MISSING LEET BRACKET 70874000 - CONTEXT ~ 2; 70874100 - IF ADDRTOG THEN 70875000 - BEGIN 70876000 - IF TABLE(I+1)!FACTOP THEN 70877000 - BEGIN FLAG(727); %IF YOU.KNOW WHAT IT MEANS, 70878000 - SCAT END; %IMPLEMENT IT. 70879000 - INFO[LASTINFO.LINKR,LASTINFO.LINKC].LINK~NEXTADDL; 70879100 - PUTNBUMP(1); 70879200 - STEPIT; 70879400 - IF TABLE(I+1)!RTBRKT THEN STEPIT; 70879600 - ASTERIKTOG~TRUE; 70879800 - GO CHECKAGAIN; 70880000 - END ELSE 70881000 - IF TABLE(I+1)=FACTOP THEN % [*] SPECIFICATION 70882000 - BEGIN 70882100 - IF SAVEBIT THEN FLAG(727); 70882110 - EMIT(ZERO); 70882200 - EMITNUM(5); 70882300 - EMIT(STAG); 70882400 - STEPIT; 70882600 - IF TABLE(I+1)!RTBRKT THEN STEPIT; 70882700 - ASTERIKTOG~TRUE; 70882750 - GO CHECKAGAIN; 70882800 - END ELSE 70883000 - IF TABLE(I+1)=NUMBER AND TABLE(I+2)=RTBRKT AND PDPRTOG THEN 70883100 - BEGIN 70883200 - DO BEGIN 70883400 - 70883500 - PDPRT[PPINX].[10:13]~THI; 70883600 - PDINX~PDINX+1; 70883700 - SAVESIZE~SAVESIZE+THI; 70883750 - END 70883800 - UNTIL (NOOFID~NOOFID-1)=0; 70883900 - IF TABLE(I+2) ! RTBRKT THEN FLAG(728); 70883910 - GO PASSRTBRKT; 70883930 - END ELSE 70883960 - BEGIN %[AEXP] SPECIFICATION 70884000 - IF SAVEBIT AND CURRENT = 0 THEN FLAG(727); 70884100 - EMIT(ZERO); 70885000 -NEXTDIM: 70885500 - STEPIT; 70886000 - EXPRESSION(ITYPE); %INTEGER=AEXP ON TOP OF STACK 70887000 - CODE ~ TRUE; 70888000 -CHECKAGAIN: 70889050 - IF TABLE(I)=COMMA AND TABLE(I+1)!RTBRKT THEN 70889100 - BEGIN 70889150 - NOOFDIMS~NOOFDIMS + 1; 70889200 - IF TABLE(I+1)!FACTOP THEN 70889300 - BEGIN 70889400 - MULTIDIMTOG~TRUE; 70889500 - GO NEXTDIM; 70889600 - END ELSE 70889620 - BEGIN 70889640 - STEPIT; 70889660 - STEPIT; 70889670 - IF ASTERIKTOG THEN GO CHECKAGAIN 70889680 - ELSE 70889682 - BEGIN 70889684 - MULTIDIMTOG~TRUE; 70889686 - NOOFDIMS~1; 70889687 - END; 70889688 - END; 70889690 - END ELSE 70889700 - IF NOT MULTIDIMTOG AND NOT ASTERIKTOG THEN 70889800 - BEGIN 70889900 - EMITR(39,20); %INSERT SIZE FIELD 70890000 - EMITNUM(5); %5 ON TOP OF STACK 70891000 - EMIT(STAG); %SET TAG FIELD 70892000 - END; 70892500 - END; 70893000 - IF ADDRTOG THEN GO SKIP; 70894000 - IF SAVEBIT AND CURRENT!0 THEN %LOCAL SAVE ARRAY 70895000 - IF MULTIDIMTOG THEN ARRAYTYPE~1 70896000 - ELSE EMIT1P(BSET,0); 70897000 - IF DPTOG THEN % DP OR EVENT ARRAY 70898000 - IF MULTIDIMTOG THEN ARRAYTYPE ~ ARRAYTYPE + 4 70899000 - ELSE EMIT1P(BSET,40); 70900000 - IF MULTIDIMTOG THEN 70901000 - BEGIN 70902000 - EMIT(MKST); 70902300 - EMITN(ARRAYDECPCW); 70902600 - EMITNUM(NOOFDIMS); 70903000 - EMITNUM(NOOFID); 70903100 - EMITNUM(-ARRAYTYPE); 70903200 - EMIT(ENTR); 70903300 - END; 70904000 - 70904100 -SKIP: 70904200 - NEXTADDL~NEXTADDL-NOOFID; 70904250 - TNOOFID~NOOFID; 70904270 - DO BEGIN 70904300 - IF CURRENT=0 AND NOT MULTIDIMTOG AND NOT ADDRTOG THEN70904330 - BEGIN 70904370 - EMITN(ADDL[NEXTADDL.LINKR,NEXTADDL.LINKC]); 70904400 - IF NOOFID>1 THEN EMIT(OVRN) ELSE EMIT(OVRD); 70904500 - END; 70904550 - PUTNBUMP(NOOFDIMS); 70904600 - END UNTIL (NOOFID~NOOFID-1)=0; 70904700 - IF CURRENT!0 AND NOT ADDRTOG THEN 70904900 - WHILE (TNOOFID~TNOOFID-1)>0 DO EMIT(DUPL); %DUPLICATE 70905000 -PASSRTBRKT: 70906000 - WHILE ELCLASS!RTBRKT AND ELCLASS!SEMICOLON DO STEPIT; 70907000 - IF ELCLASS=SEMICOLON THEN 70908000 - BEGIN FLAG(728); I~I-1; %MISSING RIGHT BRACKET 70909000 - SCAT END; 70910000 - QUIT: IF NOT CODE THEN L ~ OL; IF STEPI = COMMA THEN GO LOOP; 70911000 - IF ELCLASS!SEMICOLON THEN ERR(729); %MISSING SEMICOLON 70912000 - CONTEXT~CONTEX; 70913000 -FINI: END ARRAYDEC; 70914000 - PROCEDURE QUEUEDEC (LEVEL); VALUE LEVEL; INTEGER LEVEL; 70915000 -COMMENT SPACE IS OBTAINED FOR THE DESCRIPTOR AT THE HEAD OF THE QUEUE. 70916000 - CODE TO PUT ZERO (QUEUEDEC) OR A SUITABLE DESCRIPTOR(QUEUE ARAY)70917000 - IN THIS SPACE IS EMITTED 70917500 - INFO AND ADDL ENTRIES FOR THE QUEUE ARE AS FOLLOWS: 70918000 - (1) LINK IN FIRST WORD OF INFO POINTS TO ADDL. ADDRESS REFER-70919000 - ENCES A ZERO WORD IN THE STACK 70920000 - (2) THE FIRST WORD OF ADDL CONTAINS: 70921000 - ADDRESS OF LOCK CELL IN ADDRESS FIELD 70922000 - NUMBER OF ALGORITHMS IN FIELD "ALGNOF" 70923000 - NUMBER OF ITEMS IN FIELD "ITMNOF" 70924000 - SIZE OF ENTRY IN FIELD "SIZEF" 70924500 - (3) THERE IS ONE ADDL WORD PER ITEM WITH THE LINK FIELD POIN-70925000 - TING TO THE INFO ENTRY FOR THE RELEVANT ITEM 70926000 - (4) THERE IS ONE ADDL WORD PER Q ALGORITHM WITH: 70927000 - ADDRESS OF PCW IN ADDRESS FIELD 70928000 - ALGORITHM KEY IN FIELD "ALGNO" 70929000 - TYPE OF ALGORITHM IN TYPE FIELD HAVING FOLLOWING VALUES70930000 - ITYPE INTEGER ALGORITHM ID 70931000 - RTYPE REFERENCE ALGORITHM ID 70932000 - BTYPE BOOLEAN ALGORITHM ID 70933000 - PROCD UNTYPED ID 70934000 - PARAMETER DESCRIPTION IN FIELD "PARADESC" 70935000 - =0 NO PARAMETERS 70936000 - =1 ONE PARAMETER,TYPE REFERENCE - ASSOCIATED WITH 70937000 - IMPLIED FORMAL PARAMETER NAME "ENTRY" 70938000 - =2 ONE PARAMETER,TYPE INTEGER - ASSOCIATED WITH IMP-70939000 - LIED FORMAL PARAMETER NAME "INDEX" 70940000 - =3 TWO PARAMETERS THE FIRST ONE ASSOCIATED WITH 70941000 - "ENTRY" AND THE SECOND WITH "INDEX" 70942000 - IF A LINK PART IS SUPPLIED,AN INFO ENTRY OF CLASS REFERENCE, 70943000 - (QUEUEDEC) OR REFERENCE ARRAY (QUEUE ARRAY DECLARATION) 70943300 - AND ADDRESS THAT OF THE QUEUE HEAD DESCRIPTOR IS GENERATED FOR 70944000 - THE LINK IDENTIFIER. THUS NO SPACE IS RESERVED FOR THE LINK 70945000 - EACH ITEM IN THE ENTRY DESCRIPTION HAS AN INFO ENTRY OF THE 70946000 - FOLLOWING FORM: 70947000 - QINDEXF FIELD POSITION OF ITEM IN ENTRY 70948000 - DESCRIPTION 70949000 - LINK FIELD LINK TO ADDL FOR ARRAYS AND PROCE-70950000 - DURES OTHERWISE LINK TO INFO ENTRY70951000 - FOR QUEUE ID 70952000 - ADDL WORD (FOR ARRAYS ONLY) 70953000 - FIELD "NODIM" HOLDS NUMBER OF 70954000 - DIMENSIONS 70955000 - FIELD "QLINK" HOLDS LINK TO INFO 70956000 - ENTRY FOR QUEUE ID 70957000 - IF A SIZE PART IS SUPPLIED, CODE FOR BUILDING AN ABSENT, IND-70958000 - EXABLE, NON SEGMENTED DESCRIPTOR IN THE SPACE RESERVED FOR THE 70959000 - QUEUE ID IS EMITTED.NOTE POSSIBLE CONFLICT WITH ARRAY DESC. 70960000 - EACH ALGORITHM IN THE QUEUE DECLARATION HAS AN INFO ENTRY OF 70961000 - THE FOLLOWING FORM. 70962000 - PARAMETER DESCRIPTION IN FIELD "PARADESC" 70963000 - ALGORITHM KEY IN FIELD "ALGNO" 70964000 - CLASS OF QALGID 70965000 - TYPE OF ALGORIIHM IN TYPE FIELD 70966000 - FIELD STANDF CONTAINS 0 (STANDARD ALGORITHMS) OR 1 70967000 - THE CODE FOR EACH ALGORITHM IS GENERATED BY CALLS ON EXPRESSION 70968000 - OR STATEMENT. THIS IS THE CODE ACCESSED BY THE PCW WHOSE ADDRESS70969000 - IS IN THAT ADDL WORD OF THE QUEUE ID ASSOCIATED WITH THE 70970000 - ALGORITHM 70971000 - THE "ALGORITHM KEY" IS GENERATED AND USED AS FOLLOWS: 70972000 - (1)IF THE ALGORITHM ID IS UNKNOWN AND IF IT IS A STAND-70973000 - ARD ALGORITHM ID THEN THE ALGORITHM KEY IS 70974000 - FOUND BY THE PROCEDURE STANDSEARCH 70975000 - COUNTQALG IS SET TO STARTNSQ AT BLOCK ENTRY. 70976000 - IF THE ALGORITHM ID IS NOT STANDARD THIS COUNTER IS 70977000 - UPDATED AND USED AS THE ALGORITHM KEY 70978000 - (2)IF THE ALGORITHM ID IS KNOWN AND IF ITS PREVIOUS 70979000 - CLASS IS OTHER THAN QALGID THEN SYNTAX ERROR 70980000 - IF ITS PREVIOUS CLASS IS QALGID THEN THE 70981000 - ALGORITHM KEY IS OBTAINED FROM THE INFO ENTRY. 70982000 - IF THIS ALGORITHM KEY MATCHES THAT IN ANY 70983000 - QUEUE ADDL WORD THEN SYNTAX ERROR (MULTIPLE USE OF 70984000 - ALGORITHM ID IN SAME QUEUE DECLARATION). 70985000 - OTHERWISE A NEW ADDL ENTRY FOR THE ALGORITHM IS 70986000 - MADE FOR THE QUEUE. NOTE THAT ONLY ONE INFO ENTRY 70987000 - APPEARS FOR THE QUEUE ALGORITHM ID (AT ANY GIVEN 70988000 - LEVEL) NO MATTER HOW MANY QUEUE DECLARATIONS USE 70989000 - THAT ALGORITHM ID 70990000 - THE LOCKED ALGORITHM IS HANDLED DIFFERENTLY. NO CODE IS GENER 70990100 - -ATED AND THE ONLY ACTIONS ARE TO GET SPACE FOR THE LOCK CELL 70990200 - (WHEN NECESSARY) AND TO PLACE THE ADDRESS OF THE SPACE IN THE 70990300 - FIRST WORD OF ADDL FOR THE QUEUE 70990400 - NOTE THAT QUEUE ARRAYS ARE HANDLED ESSENTIALLY AS QUEUE VARABLES70991000 - NOTE ALSO THAT A QUEUE ARRAY DECLARATION WITHOUT A LINK PART 70992000 - DOES NOT MEAN MUCH AND THAT A SIZE PART WITHIN A QUEUE DECLAR- 70993000 - ATION IS RATHER STRANGE; 70994000 -COMMENT *** THE FOLLOWING FACILITIES HAVE NOT YET BEEN IMPLEMENTED: 70995000 - (1) OWN QUEUES; 70996000 - BEGIN COMMENT (MCS 1); 70997000 - LABEL FINI,RESIGN,ANOTHER,ENDALG,ENDING,ITEMS,QUIT,SIZE, 70998000 - COMPILEALG,LEAVE; 70999000 - LABEL HUNT; 70999500 - REAL ALGTYPE;% HOLDS THE TYPE OF AN ALGORITHM 71000000 - INTEGER QW, % LINK INTO INFO FOR QUEUE 71001000 - LW, % LINK INTO INFO FOR QUEUE "LINK" 71002000 - NOITEMS,% NUMBER OF ITEMS IN QUEUE 71003000 - SPAZE, % ADDRESS OF SPACE FOR Q ID 71004000 - QADDL, % LINK INTO ADDL FOR FIRST Q ADDL ENTRY 71005000 - NEXTQADDL,% RUNNING LINK INTO Q ADDL ENTRIES 71006000 - ALGCOUNT,% NO OF QUEUE ALGORITHMS 71007000 - LASTITEM,% LINK TO INFO ENTRY OF LAST ITEM 71008000 - ITEMINDEX,% INDEX OF ITEM IN ENTRY 71008500 - LOCKADDRESS;% ADDRESS OF LOCK CELL IF ANY 71009000 - INTEGER TI1,TI2; % SCRATCH; 71010000 - BOOLEAN ARAY; % TRUE IF QUEUE ARRAY 71010220 - BOOLEAN BADTOG; % TRUE WHEN BAD BOUND FOR QUEUE ARRAY 71010240 - REAL GT2,GT3; % SCRATCH RENAME GLOBAL SCRATCH 771010300 - DEFINE GT1 = QGT1#; % FIX SOME NOMENCLATURE 71010500 - INTEGER N; %SCRATCH 71010800 - DEFINE QEUEID = QUEUEID #; 71011000 - INTEGER PNEXTADDL, %ALL THESE QUANTITIES USED FOR 71012000 - PNEXTINFO, % STORING INFORMATION BEFORE 71013000 - PLASTINFO; % COMPILATION OF Q ALQORITHM 71014000 -DEFINE SPECPART = FORMALPARAPART#; 71015000 -COMMENT FOLLOWING MUST BE REMOVED LATER; 71015300 -FORMAT FMT1(" QINFO ", 10I9); 71015302 -FORMAT FMT2 ( "Q1ADDL ",10I9); 71015304 -FORMAT FMT3 (" QADDLITEM " ,10I9); 71015306 -FORMAT FMT4 (" ITEMINFO ", 10I9); 71015308 -FORMAT FMT6 (" ITEMINFO ", 10I9); 71015400 -FORMAT FMT7 ( " ITEMADDL ",10I9); 71015402 -FORMAT FMT8 (" ALGINFO " ,10I9); 71015404 -FORMAT FMT9 (10I9); 71015405 -INTEGER DT1,DT2,DT3,DT4,TEMPNO; 71015406 - DEFINE DEBUG=IF DONSBUG THEN#; 71015407 -REAL TD; 71015408 -DEFINE 71015409 -D1= DEBUG WRITE(LINE[DBL],FMT1,TD.ADDRESS,TD.CLASS,TD.TYPE,TD.LINKR, 71015410 -TD.LINKC,TEMPNO,DT1,DT2,DT3,DT4)#, 71015412 -D2= DEBUG WRITE(LINE[DBL],FMT2,TD.ADDRESS,TD.ALGNOF,TD.ITMNOF,TD.SIZEF 71015414 -,TEMPNO,DT1,DT2,DT3,DT4)#, 71015416 -D3 = DEBUG WRITE(LINE[DBL],FMT3,TD.LINK,TEMPNO,DT1,DT2,DT3,DT4)#, 71015418 -D4 = DEBUG WRITE(LINE[DBL],FMT4,TD.ADDRESS,TD.ALGNO,TD.TYPE,TD.PARADESC 71015420 -,TEMPNO,DT1,DT2,DT3,DT4)#, 71015440 -D5=D1#, 71015460 -D6 =DEBUG WRTTE(LINE[DBL],FMT6,TD.QINDEXF,TD.LINK,TEMPNO,DT1,DT2,DT3, 71015480 -TD.CLASS,TD.TYPE,DT4)#, 71015500 -D7 = DEBUG WRITE(LINE[DBL],FMT7,TD.NODIM,TD.QLINK,TEMPNO,DT1,DT2,DT3, 71015502 -DT4)#, 71015504 -D8 =DEBUG WRITE(LINE[DBL],FMT8,TD.PARADESC,TD.ALGNO,TD.CLASS,TD.TYPE, 71015506 -TD.STANDF,TEMPNO,DT1,DT2,DT3,DT4)#, 71015508 -D9 = DEBUG WRITE(LINE[DBL],FMT9,TEMPNO,DT1,DT2,DT3,DT4)#; 71015510 - 71016000 - LOCKADDRESS~INVISIBLE~ALGCOUNT~NOITEMS~0; 71017000 - ITEMINDEX~0; 71017500 - IF (ARAY~ELCLASS=ARRAYV) THEN STEPIT; 71017550 - IF ELCLASS ! UNKNOWNID THEN GO RESIGN; 71018000 - GTB1~ENTER(0,LOCALTYPE,IF ARAY THEN QUEUEARRAYID ELSE QUEUEID71019000 - ,FALSE); 71019500 - QW ~ LW ~ LASTINFO; 71020000 - TI1 ~ -CURRENT; 71021000 -COMMENT ACQUIRE INFO ENTRY FOR QID, SET UP PARAMETER TO GETSPACE FOR 71022000 - NO ADDRESS PART; 71023000 - IF TABLE(I+1) = COLON THEN 71024000 - BEGIN COMMENT (MCS 2); 71025000 -COMMENT A LINK ID IS SUPPLIED; 71026000 - STEPIT; 71027000 - IF STEPI ! UNKNOWNID THEN GO RESIGN; 71028000 - GTB1~ENTER(0,LOCALTYPE,IF ARAY THEN REFARRAYID ELSE 71029000 - REFID ,FALSE); 71029500 - LW ~ LASTINFO; 71030000 - IF ARAY THEN BEGIN INFO[LW.LINKR,LW.LINKC].LINK 71030500 - ~NEXTADDL;PUTNBUMP(1) END; 71030600 -COMMENT LINK GIVES RISE TO REFERENCE ARRAY; 71030605 - TI1 ~ CURRENT; 71031000 - BADTOG~FALSE; 71031500 -COMMENT ACQUIRE INFO ENTRY FOR LINK IO,SET UP PARAMETER TO GET-71032000 - SPACE FOR POSSIBLE ADDRESS PART; 71033000 - END MCS 2 LINK PART; 71034000 - INFO[QW.LINKR,QW.LINKC].ADDRESS 71035000 - ~SPAZE~IF ARAY THEN QARRAYBOUND(TI1,BADTOG) ELSE 71036000 - EMITDESC(TI1); 71036300 - IF BADTOG THEN BEGIN FLAG(753);GO RESIGN END; 71036800 -COMMENT QARRAYBOUND GOBBLES UP ARRAYBOUND AND BUILDS DESCRIPTOR, 71036803 - EMITSPACE MERELY LEAVES HOLE IN STACK. THERE IS AN ERROR 71036805 - IF BOUND SYNTAX INCORRECT; 71036808 - INFO[LW.LINKR,LW.LINKC].ADDRESS ~ SPAZE; 71037000 - 71037500 -COMMENT*** THE Q INFO ENTRY AND THE LINK INFO ENTRY (IF ANY) MUST HAVE 71038000 - SAME ADDRESS SUPPLIED BY GETSPACE; 71039000 - IF STEPI ! LFTPRN THEN GO QUIT; 71040000 - TI1 ~ NEXTINFO; 71041000 - 71041500 - TD~ INFO[LW.LINKR,LW.LINKC];DT1~TI1; D5; % REMOVE 71041600 - ITEMS: IF(NOITEMS~SPECPART(TRUE))>32767 THEN 71042000 - BEGIN FLAG(750); GO QUIT END; 71042500 -COMMENT *** SPECPART ANALYSES ENTRY DESCRIPTION AND RETURNS NUMBER OF 71043000 - ITEMS ENCOUNTERED. BUILDS UP CHAIN OF INFO ENTRIES CONCER- 71044000 - NING ITEMS (POINTED AT BY TI1 ). FALSE SAYS CALL IS FROM 71045000 - QUEUEDEC. INVISIBLE POINTS TO FIRST ENTRY FOR INVISIBLE IT- 71046000 - EMS AT EXIT; 71047000 - INFO[QW.LINKR,QW.LINKC].LINK~QADDL~NEXTADDL; 71048000 - IF ARAY THEN PUTNBUMP(1); 71048500 - QADDL~NEXTADDL; 71048800 - ADDL[QADDL.LINKR,QADDL.LINKC]~0;%5500 KLUDGE REMOVE 6500 71048850 - NEXTADDL~ NEXTADDL+1; 71049000 -COMMENT MUST LEAVE HOLE FOR FIRST QADDL ENTRY; 71050000 - FOR TI2~1 STEP 1 UNTIL NOITEMS DO 71051000 - BEGIN COMMENT (MCS 3) PROCESS ITEMS; 71052000 - IF TI1=INVISIBLE THEN INVISIBLE~NEXTADDL; 71052500 -COMMENT INVISIBLE POINTS TO LINK TO FIRST INVISIBLE ITEM; 71052600 - N~(IF(GT1~TAKE(TI1)).ALLBUTLINK!0 THEN GT1 ELSE 71053000 - (GT1~TAKE(TI1~GT1.LINK))).LINK; 71053500 -COMMENT *** NOTE KLUDGE FOR HOLE IN INFO.MAYBE CAN REMOVE LATER; 71053510 - 71054500 - 71055000 - 71056000 - IF(GT2~GT1.CLASS) >PTRID AND GT2{ EVENTARRAYID THEN 71057000 - BEGIN COMMENT (MCS 2A); 71058000 -COMMENT ARRAY ITEMS HAVE ADDL ENTRIES SUPPLIED BY 71059000 - SPECPART; 71060000 - GT1.LINK~GT1.ADDRESS; 71061000 - ADDL[GT1.LINKR,GT1.LINKC].QLINK~QW; 71062000 - 71062500 - END MCS 2A 71063000 - ELSE 71064000 - GT1.LINK~QW; 71065000 - IF GT2 = FORMALID THEN FLAG(900); %WCP 71065100 - ERRORTOG ~ TRUE; %WCP 71065200 -COMMENT WHEN ITEM IS OTHER THAN ARRAY 71066000 - IT REQUIRES NO ADDL AND LINKS DIRECTLY TO Q71067000 - INFO; 71068000 - GT1.QINDEXF ~ ITEMINDEX; 71069000 - GT1.ITMQAINDXF~TI2-1; 71069200 - ITEMINDEX~ITEMINDEX+(IF(GT2=DPID OR GT2=EVENTID) 71069300 - AND GT1.TYPE!FORMALNAMEQ THEN 2 ELSE 1); 71069350 -COMMENT A DOUBLE PRECISION NUMBER TAKES TWO WORDS; 71069600 - 71069650 -TD~TI1; D3; %REMOVE 71069660 - PUT(GT1,TI1); 71070000 - PUTNBUMP(TI1); 71071000 - 71071502 -COMMENT QUEUE NOW POINTS TO ITEM; 71072000 - TI1~ N; 71073000 - END MCS 3 PROCESS ITEMS; 71074000 - GT1.ITMNOF~NOITEMS; 71074500 - GT1.SIZEF~ITEMINDEX; 71074502 - ADDL[QADDL.LINKR,QADDL.LINKC]~GT1; 71074504 -COMMENT*** SIZE MUST BE AVAILABLE TO ALGORITHMS; 71074510 - LASTITEM~QADDL+NOITEMS; 71075000 -COMMENT INVISIBLE AND LASTITEM USED IN DESTROYING INVISIBLE ITEM INFO71076000 - AFTER PROCESSING ALGORITHMS; 71077000 - SIZE: IF ELCLASS=LFTBRKT THEN 71078000 - BEGIN COMMENT MCS 3A; 71079000 -COMMENT A SIZE PART WAS BEEN SPECIFID AND SO WE MUST EMIT CODE TO 71079400 - BUILD DESCRIPTOR; 71079410 -COMMENT *** THIS PROBABLY WILL NOT WORK AT GLOBAL LEVEL; 71079412 - STEPIT; 71079415 - EMIT(ZERO); 71079600 - EXPRESSION(ITYPE); 71079800 - IF ITEMINDEX>1 THEN BEGIN COMMENT MCS 3B; 71079850 - EMITNUM(ITEMINDEX); 71080000 - 71080200 -COMMENT THE SIZE OF AN ENTRY IS NOW ON TOP OF THE STACK AND 71080300 - THE REQUIRED NUMBER OF ENTRIES IS THE SECOND WORD IN 71080310 - THE STACK; 71081000 - EMIT(MULT) END MCS 3B; 71081500 -COMMENT WE NOW HAVE THE SIZE OF THE REQUIRED AREA ON TOP OF THE71081600 - STACK; 71081610 - EMITR(39,20); 71082000 - EMITNUM(5); 71082500 - EMIT (STAG); 71083000 -COMMENT WE NOW HAVE AN ABSENT,INDEXABLE DATA DESCRIPTOR ON TOP 71083100 - OF THE STACK. WE MUST NOW STORE IT AT HOLE POINTED AT 71083110 - BY SPAZE; 71083120 - EMITN(SPAZE); EMIT (OVRD); 71084000 - IF ELCLASS=RTBRKT THEN STEPIT ELSE GO HUNT; 71084500 -COMMENT *** IS THIS CODE O.K.; 71085000 - END MCS 3A SIZE PART PROCESSING; 71086000 - 71086500 - IF ELCLASS!USINGV THEN GO TO ENDING ELSE 71087000 - BEGIN COMMENT (MCS 4); 71088000 -COMMENT AT THIS POINT WE PROCESS ALGORITHM PART; 71089000 - NEXTQADDL ~ NEXTADDL; 71090000 - ANOTHER: 71091000 - IF STEPI=LOCKEDV THEN 71092000 - BEGIN COMMENT MCS 3A; 71092300 -COMMENT WE HAVE A LOCKING SPECIFICATION; 71092350 - 71092355 - IF STEPI=WITHV THEN 71092400 - BEGIN COMMENT MCS 3B; 71092500 - CONTEXT~2; 71092600 - 71092650 - IF STEPI!QUEUEID AND ELCLASS!QUEUEARRAYID 71092700 - OR ELCLASS=UNKNOWNID 71092750 - THEN BEGIN FLAG(751);GO LEAVE END; 71092780 - GT1~TAKE(ELBAT[I]).LINK; 71092800 - LOCKADDRESS~ GIT(IF ELCLASS=QUEUEID THEN71092900 - GT1 ELSE GT1+1).ADDRESS; 71092950 -COMMENT *** THE FIRST WORD OF ADDL FOR A QUEUE ARRAY71092980 - CONTAINS INFORMATION ON BOUNDS; 71092985 - IF LOCKADDRESS=0 THEN 71093000 - BEGIN FLAG(751);GO LEAVE END; 71093050 -COMMENT THE REFERENCED QUEUE DOES NOT HAVE LOCK;71093055 - CONTEXT~0; 71093080 - 71093085 - STEPIT; 71093088 - END MCS 3B 71093100 - ELSE 71093200 - LOCKADDRESS~EMITSPACE(-CURRENT); 71093300 -COMMENT A NEW LOCK CELL IS REQUIRED; 71093305 - 71093350 - ADDL[QADDL.LINKR,QADDL.LINKC].ADDRESS 71093355 - ~LOCKADDRESS; 71093357 -COMMENT LOCKADDRESS MUST BE AVAILABLE TO ALGORITHMS; 71093358 - GO TO ENDALG 71093400 - END MCS 3A; 71093500 - GT1~0; %5500 FB KLUDGE REMOVE ON 6500 71093550 - ALGCOUNT ~ ALGCOUNT+1; 71093600 - 71093650 - IF ELCLASS!TOV THEN ALGTYPE~0 ELSE 71094000 - BEGIN STEPIT; ALGTYPE~PROCD END; 71095000 - IF ELCLASS = UNKNOWNID THEN 71096000 - BEGIN COMMENT (MCS 5); 71097000 -COMMENT *** THE ALGORITHM ID IS UNKNOWN, HENCE: 71098000 - (1)IT IS STANDARD Q ALG ID NOT YET USED IN ANY OTHER71099000 - Q DECLARATION AT THIS LEVEL OR 71100000 - (2)IT IS FIRST APPEARANCE AT THIS LEVEL OF NON STAN-71101000 - DARD Q ALG ID; 71102000 - TB1~ENTER(0,LOCALTYPE,QALGID,FALSE); 71103000 - GT2 ~ TAKE(LASTINFO); 71104000 - IF(N+STANDSEARCH) =63 THEN 71105000 - BEGIN COMMENT(MCS 6); 71106000 -COMMENT IT IS A NON-STANDARD ALGORITHM; 71107000 - N ~ COUNTQALG ~ COUNTQALG+ 1; 71108000 - TI2~3; GT2.STANDF~1; 71109000 - 71109050 - END MCS 6 71110000 - ELSE 71111000 - BEGIN COMMENT (MCS 7); 71112000 -COMMENT IT IS A STANDARD ALGORITHM; 71113000 - TI2 ~ GT1.ALGPD; 71114000 - GT2.TYPE~GT1.ALGTIPE; 71114500 - GT2.STANDF~0; 71115000 - 71115500 - 71116000 - END MCS 7; 71117000 - GT1.PARADESC ~ TI2; 71118000 - GT2.PARADESC ~ TI2; 71119000 - GT1.ALGNO ~ N; 71120000 - GT2.ALGNO ~ N; 71121000 - 71121500 - PUT(GT2,LASTINFO); 71122000 - GT3~LASTINFO; 71122500 -COMMENT INFO ENTRY FOR ALGORITHM NOW COMPLETE ; 71123000 - END MCS 5 UNKNOWN ID 71124000 - ELSE 71125000 - BEGIN COMMENT (MCS 8); 71126000 -COMMENT *** THE ALGORITHM IS KNOWN; 71127000 - 71127050 - GT3~(GT2~TAKE(ELBAT[I])).ALGNO; 71128000 - IF ELCLASS!QALGID THEN GO LEAVE; 71129000 -COMMENT ONLY Q ALGORITHMS MAY APPEAR MORE THAN ONCE; 71130000 - IF NEXTADDL ! NEXTQADDL THEN 71131000 - FOR TI1~NEXTQADDL STEP 1 UNTIL NEXTADDL-1 DO 71132000 - BEGIN COMMENT(MCS 9); 71133000 -COMMENT THERE HAVE BEEN PREVIOUS ALGORITHMS. MUST 71134000 - CHECK THAN NONE OF THEM HAS SAME KEY; 71137000 - IF ADDL[TI1.LINKR,TI1.LINKC].ALGNO 71136000 - = GT3 THEN 71137000 - BEGIN FLAG(713);GO LEAVE END; 71138000 - END MCS 9 ; 71139000 - TI2~GT2.PARADESC; 71139500 - GT1.ALGNO ~ GT3; 71140000 - GT2.STANDF~0; 71140500 - GT1.PARADESC~TI2; 71141000 - GT3~ELBAT[I]; 71141050 - 71141500 - END MCS 8 ; 71142000 -COMMENT WE HAVE STILL TO STORE ALGORITHM TYPE INTO QUEUE ADDL 71143000 - WORD FOR ALGORITHM AND (FOR NON-STANDARD ALGORITHMS) 71144000 - INTO ALGORITHM INFO ENTRY.FOR STANDARD ALGORITHMS WE 71145000 - CHECK THAT DECLARED AND IMPLICIT TYPES AGREE; 71146000 - GT1.TYPE~ALGTYPE~IF STEPI = IFV THEN BTYPE ELSE 71147000 - IF ELCLASS = RELOP AND ELBAT[I].DISP 71148000 - = SAME THEN RTYPE ELSE 71148100 - IF ELCLASS = RELOP AND ELBAT[I].DISP 71149000 - = EQUL THEN ITYPE ELSE 71150000 - IF ELCLASS=COMMA THEN 71151000 - ALGTYPE ELSE 0; 71152000 - 71152050 - IF (GTB1~ GT2.STANDF = 0) AND ALGTYPE!GT2.TYPE THEN 71153000 - BEGIN FLAG(714); GO LEAVE END; 71154000 - IF NOT GTB1 THEN INFO[GT3.LINKR,GT3.LINKC].TYPE 71154500 - ~ ALGTYPE; 71154530 -COMMENT FOR A NON-STANDARD ALGORITHM,THE TYPE MUST BE ENTERED; 71154560 - COMPILEALG: 71155000 - 71156000 - 71156500 - GT1.ADDRESS~INSERTPCW; 71156800 - PUTNBUMP(GT1); 71157000 - ADDL[QADDL.LINKR,QADDL.LINKC].ALGNOF~ALGCOUNT; 71158000 - 71159000 - 71160000 - IF CURRENT<31 THEN CURRENT~CURRENT+1 ELSE FLAG(627);71161000 - STACKTOP[CURRENT]~MAXSTACK[CURRENT]+2; 71161500 - 71161800 - MAXDISP ~ (GT1~STACKMASK[CURRENT]).MAXDISPF; 71162000 - LLMASK ~ GT1.LLMASKF; 71163000 - PNEXTADDL ~ NEXTADDL; PNEXTINFO ~ NEXTINFO; 71164000 - PLASTINFO ~ LASTINFO; 71165000 -COMMENT *** WHAT ELSE HAS TO BE STORED; 71166000 - CONTEXT ~ 2; 71167000 - IF TI2=1 OR TI2=3 THEN DIDDLENTER(REFID); 71168000 - 71168500 - IF TI2=2 OR TI2=3 THEN DIDDLENTER(INTID); 71169000 - 71169500 - STEPIT; 71169500 -COMMENT DIDDLENTER MAKES UP INFO ENTRIES AND GETSPACE FOR 71170000 - IMPLIED PARAMETERS; 71171000 - IF ALGTYPE ! PROCD 71172000 - THEN BEGIN EXPRESSION(ALGTYPE);EMIT(RETN);END 71172200 - ELSE IF ELCLASS=BEGINV 71172400 - THEN 71173000 - BEGIN 71173200 - BEGINCTR~BEGINCTR+1; 71173400 - IF GT1~TABLE(I+1)}MINDEC AND GT1 71174000 - {MAXDEC 71174200 - THEN BEGIN 71174400 - GT1~BUMPL; 71174420 - NOJUMPTOG~TRUE; 71174422 - BLOCK; 71174430 - NOJUMPTOG~FALSE; 71174432 - EMITB(BRUN,GT1,PCL); 71174440 - EMITB(BRUN,BUMPL,GT1); 71174442 - EMITB(BRUN,GT1+7,L); 71174444 - EMIT(EXIT); 71174450 - END 71174460 - ELSE BEGIN STEPIT; COMPOUNDTAIL; 71174600 - EMIT(EXIT);END; 71174620 - END 71174700 - ELSE BEGIN STATEMENT;EMIT(EXIT);END; 71174800 - NEXTADDL ~ PNEXTADDL; NEXTINFO ~ PNEXTINFO; 71175000 - LASTINFO ~ PLASTINFO; 71176000 -COMMENT *** WHAT ELSE HAS TO BE RESTORED; 71177000 - CURRENT ~ CURRENT-1; 71178000 - MAXDISP~(GT1~STACKMASK[CURRENT]).MAXDISPF; 71179000 - LLMASK ~ GT1.LLMASKF; 71180000 - 71180452 - PURGE(NEXTINFO); 71180500 - 71180550 - CONTEXT ~ 0; 71181000 -COMMENT FINISHED EMITTING CODE FOR ALGORITHM,MUST FIX UP JUMP; 71182000 - 71183000 - ENDALG: IF ELCLASS=COLON THEN GO TO ANOTHER; 71184000 - 71184500 - END MCS 4 PROCESSING OF ALGORITHMS; 71185000 -COMMENT QUEUE IS NOW FINISHED APART FROM SOME CLEARING UP; 71186000 - ENDING: GT1.ADDRESS ~ LOCKADDRESS; 71187000 - GT1.ALGNOF ~ ALGCOUNT; 71188000 - GT1.SIZEF~ITEMINDEX; 71188500 - GT1.ITMNOF ~ NOITEMS; 71189000 - 71189500 - PUTADDL(GT1,QADDL); 71190000 -COMMENT INFO AND ADDL ENTRIES FOR QUEUE ARE NOW COMPLETE,LAST THING 71191000 - WE MUST DO IS DESTROY INFO ENTRIES FOR ANY INVISIBLE ITEMS; 71192000 - IF INVISIBLE ! 0 THEN DSTROYNVISIBLE(LASTITEM); 71193000 - 71193500 - GO FINI; 71194000 - RESIGN: 71195000 -COMMENT ILLEGAL MULTIPLE USE OF IDENTIFIERS OR BAD BOUNDS; 71196000 - FLAG (711); 71197000 - DO UNTIL STEPI = LFTPRN; 71198000 - ERRORTOG~TRUE; 71199000 - GO TO ITEMS; 71200000 - QUIT: 71201000 -COMMENT MISSING ENTRY DESCRIPTION; 71202000 - FLAG(712); 71203000 - DO UNTIL STEPI=LFTBRKT OR ELCLASS 71204000 - =USINGV; 71205000 - ERRORTOG~TRUE; 71206000 - IF ELCLASS = LFTBRKT THEN GO TO SIZE;71207000 - GO TO ANOTHER; 71208000 - LEAVE: 71209000 -COMMENT ILLEGAL MULTIPLE USE OF IDENTIFIERS; 71210000 - FLAG(711); 71211000 - IF STEPI = IFV OR ELCLASS = COMMA OR 71212000 - ELCLASS = RELOP AND 71212500 - (GT1~ELBAT[I].DISP = SAME OR GT1 = EQUL) THEN 71213000 - BEGIN ERRORTOG~TRUE; GO TO COMPILEALG END 71214000 - ELSE 71215000 - DO UNTIL STEPI = COLON OR TABLE(I+1)=SEMICOLON; 71216000 -COMMENT WHAT ELSE CAN I DO; 71217000 - IF ELCLASS= COLON THEN GO TO ANOTHER; 71218000 - GO FINI; 71218050 - HUNT: 71218100 -COMMENT MISSING RIGHT BRACKET SIZE SPEC; 71218200 - FLAG(752); 71218300 - ERRORTOG~ TRUE; 71218400 - DO UNTIL STEPI=USINGV OR ELCLASS 71218500 - =SEMICOLON OR ELCLASS=COLON; 71218600 - IF ELCLASS=COLON OR ELCLASS=USINGV 71218700 - THEN GO TO ANOTHER; 71218800 - FINI: END MCS 1 QUEUEDEC; 71219000 - INTEGER PROCEDURE QARRAYBOUND(LEVEL,BADTOG);VALUE LEVEL,BADTOG; 71220000 - INTEGER LEVEL; % PARAMETER TO GETSPACE 71220300 - BOOLEAN BADTOG; % ERROR INDICATOR 71220600 -COMMENT GOBBLES UP BOUNDS FOR QUEUE ARRAY AND BUILDS DESCRIPTOR,RETURNS 71221000 - ADDRESS OF DESCRIPTOR; 71221300 - BEGIN 71221600 - LABEL QUIT; 71222000 - LABEL FIN; 71222050 - IF STEPI! LFTBRKT THEN GO QUIT ELSE STEPIT; 71222300 - QARRAYBOUND~GT1~GETSPACE(LEVEL); 71222400 - IF ABS (LEVEL)=GLOBAL THEN 71222600 - BEGIN 71222800 - IF ELCLASS!FACTOP THEN GT1.PDPRTSIZEF~THI; 71223000 - PDPRT[PPINX]~GT1; 71223020 - PDINX~PDINX+1; 71223055 - STEPIT; 71223200 - GO FIN; 71223300 - END; 71223400 - JUMPCHKX; 71223500 - EMIT(ZERO); 71223600 - IF ELCLASS ! FACTOP THEN 71223630 - BEGIN 71223660 - EXPRESSION(ITYPE); 71224000 - EMIT(ONE); 71224300 - EMIT(ADD); 71224600 - EMITR(39,20); 71225000 - EMITNUM(5); 71225300 - END ELSE STEPIT; 71225350 - EMIT(STAG); 71225600 - FIN: 71225800 - IF ELCLASS ! RTBRKT THEN 71226000 - QUIT: BADTOG~TRUE; 71226300 - END QARRAYBOUND; 71226600 - PROCEDURE DIDDLENTER(K);VALUE K; REAL K; 71227000 -COMMENT BUILDS AN ENTRY IN INFO AND GETS SPACE FOR THE IMPLICITLY 71228000 - DECLARED QUEUE ALGORITHM FORMAL PARAMETER"ENTRY"(K IS REFID) OR 71229000 - "INDEX"(K IS REALID), RETURNS SPACE ADDRESS; 71230000 - BEGIN 71231000 - INTEGER I; 71232000 - INTEGER OCOUNT,OSCRAM; 71232500 - REAL OACCUM0,OACCUM1,OACCUM2; 71232800 - STREAM PROCEDURE DIDDLE(D,V); VALUE D,V; 71233000 -COMMENT DIDDLE TRANSFERS "ENTRY" OR "INDEX" TO ACCUM; 71234000 - BEGIN 71235000 - DI~D;DI~DI-1;SI~LOC V;SI~SI+2;DS~6 CHR 71236000 - END DIDDLE; 71237000 - ACCUM[1]~0; 71237500 - IF K=REFID THEN DIDDLE(ACCUMSTART,"5ENTRY") ELSE 71238000 - DIDDLE(ACCUMSTART,"5INDEX"); 71239000 - OCOUNT~COUNT;OSCRAM~SCRAM; 71239050 - MOVECHARACTERS(24,ACCUM,0,OACCUM0,0); 71239080 - COUNT~5; 71239500 - SCRAM ~ ACCUM[1] MOD 125; 71239800 - ACCUM[0] ~ 0; 71240000 -COMMENT *** IS THIS REALLY NECESSARY; 71241000 - 71242000 - GTB1~ENTER(0,FORMALVALUEP,K,FALSE); 71243000 - INFO[LASTINFO.LINKR,LASTINFO.LINKC].ADDRESS 71244000 - ~GETSPACE(-CURRENT); 71244300 - COUNT~OCOUNT;SCRAM~OSCRAM; 71244600 - MOVECHARACTERS(24,OACCUM0,0,ACCUM,0); 71244900 - END DIDDLENTER; 71245000 - PROCEDURE DSTROYNVISIBLE (LASTITEM); VALUE LASTITEM; INTEGER LASTITEM; 71246000 -COMMENT REMOVES INVISIBLE ITEMS FROM INFO ON FINISHING QUEUE DECLARATION71247000 - COMPILATION. THE ITEMS ARE REMOVED BY DESTROYING THE FIELDS 71248000 - CHRCNT AND ALFA IN THE SECOND WORD OF INFO.THERE MAY BE BETTER 71249000 - WAYS; 71250000 - BEGIN 71251000 - INTEGER I; 71252000 - 71252500 - FOR I ~ INVISIBLE STEP 1 UNTIL LASTITEM DO 71253000 - INFO[(GT1~GIT(I)).LINKR,GT1.LINKC+1].PARTALFA~0; 71254000 - END; 71255000 - INTEGER PROCEDURE EMITSPACE(LEVEL); VALUE LEVEL ; INTEGER LEVEL; 71256000 - BEGIN COMMENT PUTS HOLE IN STACK; 71257000 - IF ABS(LEVEL)!GLOBAL THEN BEGIN JUMPCHKX;EMIT(ZERO);END; 71258000 - EMITSPACE~GETSPACE(LEVEL); 71259000 - END EMITSPACE; 71260000 - INTEGER PROCEDURE EMITDESC(LEVEL); VALUE LEVEL;INTEGER LEVEL; 71260020 - BEGIN COMMENT PUTS NULL IN STACK; 71260040 - EMITDESC~GT1~GETSPACE(LEVEL); 71260045 - IF ABS(LEVEL)! GLOBAL 71260060 - THEN BEGIN 71260080 - JUMPCHKX; 71260100 - EMIT(ZERO); 71260120 - EMITNUM(5); 71260130 - EMIT(STAG); 71260140 - EMIT1P(BSET,47); 71260160 - END 71260180 - ELSE 71260200 - BEGIN 71260220 - GT1.[8:1]~1; 71260240 - PDPRT[PPINX]~GT1; 71260260 - PDINX~PDINX+1; 71260280 - END 71260300 - END EMITDESC; 71260320 - INTEGER PROCEDURE STANDSEARCH; 71261000 -COMMENT IF ACCUM CONTAINS A STANDARD ALGORITHM RETURNS THE ALGORITHM KEY71262000 - AND PLACES INFORMATION CONCERNING THE ALGORITHM IN GT1. OTHER- 71263000 - WISE RETURNS 63. MAX NUMBER OF STANDARD Q ALGORITHMS THUS IS 63;71264000 - BEGIN 71265000 - INTEGER I; 71266000 - DEFINE GT1 = QGT1#; %FIX UP SOME NOMENCLATURE 71266500 - LABEL ON; 71267000 - FOR I~0 STEP 1 UNTIL MAXQALG-1 DO 71268000 - BEGIN 71269000 - IF(GT1~QALGORYTHM[I]).PARTALFA = Q 71270000 - THEN IF COUNT<5 71271000 - THEN GO ON 71272000 - ELSE IF CMPCHREQL(COUNT-4,ACCUM[2],QALGORYTHM 71273000 - [I+1]) 71274000 - THEN GO ON; 71275000 - I ~ I+GT1.NOWORDS 71276000 - END; 71277000 -COMMENT NO EQUALITY; 71278000 - GT1.ALGKEY ~ 63; 71279000 - ON: STANDSEARCH ~ GT1.ALGKEY; 71280000 - END STANDSEARCH; 71281000 - 71282000 - PROCEDURE PICTUREDEC(S); VALUE S; BOOLEAN S; 72000000 - COMMENT PICTUREDEC GENERATES THE EDIT STRINGS AND OTHER GOOD STUFF 72001000 - FOR A PICTURE DECLARATION. THE PARAMETER, S, IS TRUE IF THE 72002000 - EDIT-STRING ARRAY IS SAVE. THERE IS ONE ARRAY PER DECLARATION,72003000 - SO AS TO REDUCE THE NUMBER OF DESCRIPTORS INVOLVED. 72004000 - THE INFO FOR A LOCAL-TYPE PICTURE POINTS INTO ADDL, AT A 72005000 - REPRESENTATION OF THE CODE TO BE GENERATED. IF THE FIELD 44:472006000 - CONTAINS ZERO, THE PICTURE IS IN A TABLE, 1:18 IS THE ADDRESS 72007000 - OF THE DESCRIPTOR, AND 19:24 IS THE INDEX. IF 44:4 IS NOT ZERO72008000 - THE WORD REPRESENTS A MICRO-OP FOR IN-LINE CODE. SEE 72008100 - EMITMICRO FOR THAT FORMAT. 72008200 - BIT 43 IS ON FOR THE LAST WORD OF THE ENTRY.; 72008300 - BEGIN 72009000 - LABEL INN; 72009100 - LABEL START, X, WAY,BACK; 72010000 - ALPHA CRS,CU ,CNV; 72011000 - INTEGER SZ; % PICTURES CHARACTER SIZE 72011100 - INTEGER TL, CONTEX, TSEG ; 72012000 - OWN COMMENT REMOVE WHEN UPLEVEL STUFF WORKS--MAYBE-----------;72013000 - ALPHA CHAR, NCHR,CNT; 72014000 - OWN INTEGER AD,PCINX; 72014100 - DEFINE OWNBIT = BOOLEAN(AD.[1:1])#; 72014200 - DEFINE GNCH = EXAMINE(BUMPNCR ELSE NCR)#, 72015000 - CB = CRS.[40:8]#, COMMENT BLANK ; 72016000 - CC = CRS.[32:8]#, COMMENT COMMA ; 72017000 - CM = CRS.[24:8]#, COMMENT MINUS-SIGN ; 72018000 - CN = CRS.[16:8]#, COMMENT PERIOD ; 72019000 - CP = CRS.[ 8:8]#; COMMENT PLUS-SIGN ; 72020000 - 72021000 - PROCEDURE GENMICRO(N,REPEAT,OP,P1,P2,P3); 72021010 - VALUE N,REPEAT,OP,P1,P2,P3; 72021020 - INTEGER N,REPEAT,OP,P1,P2,P3; 72021030 - COMMENT GENMICRO IS CALLED TO DECIDE WHEN TO GENERATE 72021040 - TABLE-EDIT VS IN-LINE-EDIT CODE; 72021050 - BEGIN 72021060 - DEFINE CLEANUP = IF EMITTING THEN 72021070 - EMIT(ENDE)#, 72021080 - 72021090 - EMITTING = MODE = 2#, 72021100 - FIRSTIME = MODE = 0#, 72021110 - BADNEWS = MODE = 3#, 72021120 - IDUNNO = MODE = 1#; 72021130 - REAL WORD; 72021140 - OWN REAL MODE; 72021150 - IF REPEAT < 65535 THEN 72021160 - IF REPEAT < 0 THEN REPEAT ~ 65535 ELSE ELSE FLAG(921); 72021170 - WORD ~ (OP-719)&P1[35:40:8]&P2[27:40:8]&P3[19:40:8] 72021180 - &N [17:46:2]&REPEAT[1:32:16]; 72021190 - IF N < 0 THEN 72021200 - BEGIN 72021210 - CLEANUP; 72021220 - PLACE(GIT(NEXTADDL-1)&1[43:47:1],NEXTADDL-1); 72021230 - MODE ~ 0 72021240 - END ELSE 72021250 - IF FIRSTIME OR BADNEWS OR REPEAT > 1020 THEN 72021260 - BEGIN 72021270 - CLEANUP; 72021280 - PUTNBUMP(WORD); 72021290 - MODE ~ 1 & REAL(REPEAT>1020 OR OWNBIT)[46:47:1]; 72021300 - END ELSE 72021310 - BEGIN 72021320 - IF AD = 0 THEN AD ~ SEGNO ~ NEWSEG(PCINX); 72021330 - IF MODE = 1 THEN 72021340 - BEGIN 72021350 - MODE ~ GIT(NEXTADDL ~ NEXTADDL - 1); 72021360 - PUTNBUMP(0&AD[1:30:18] & L [19:24:24]); 72021370 - EMITMICRO(MODE); 72021380 - END; 72021390 - MODE ~ 2; 72021400 - EMITMICRO(WORD); 72021410 - END; 72021420 - END GENMICRO; 72021430 - PROCEDURE REPEAT(N,OP,P1,P2,P3); 72022000 - VALUE N,OP,P1,P2,P3 ; 72023000 - INTEGER N,OP,P1,P2,P3 ; 72024000 - COMMENT REPEAT LOOKS FOR AND CONSOLIDATES MULTIPLE OCCURANCES 72025000 - OF (SOME OF THE) PICTURE CHARACTERS, SO AS TO REDUCE THE 72026000 - AMOUNT OF CODE GENERATED. IT ALSO HANDLES REPEAT PARTS, 72027000 - BY CONSOLIDATING THEM WITH THE REST. THE GLOBAL, CHAR, 72028000 - CONTAINS THE CURRENT PICTURE CHARACTER, AND CNT IS THE 72029000 - COUNTER. 72030000 - N IS THE NUMBER OF PARAMS,P|, TO BE EMITTED. 72031000 - OR IS THE OPERATOR. 72032000 - P| ARE THE PARAMETERS TO THE OPERATOR; 72033000 - BEGIN 72034000 - CNT ~ 1; 72035000 - DO IF NCHR = CHAR THEN 72036000 - BEGIN CNT ~ CNT + 1; NCHR ~ GNCH END ELSE 72037000 - IF NCHR = "(" THEN 72038000 - BEGIN 72039000 - BUMPNCR; 72040000 - IF SCAN=FACTOP THEN 72041000 - BEGIN 72041100 - IF CNT > 1 THEN GENMICRO(N,CNT-1,OP,P1,P2,P3)72041200 - ;GENMICRO(N,-1,OP,P1,P2,P3); CNT ~ 0; 72041300 - END DYNAMIC ELSE 72041400 - IF RESULT = DIGIT THEN 72042000 - BEGIN CONVERTINTO(THI,TLO); 72042100 - IF CNT ~ CNT + THI - 1 > 1048575 THEN FLAG(756) 72043000 - END ELSE FLAG(576); 72043100 - DEBLANK; 72044000 - IF CHR ! ")" THEN 72045000 - BEGIN FLAG(757); NCHR~")" END ELSE 72046000 - NCHR ~ GNCH; 72047000 - END UNTIL NCHR ! "(" AND NCHR ! CHAR; 72048000 - IF CNT>0 THEN GENMICRO(N,CNT,OP,P1,P2,P3); 72049000 - END REPEAT; 72056000 - ARRAY TEDOC[0:7,0:255]; 72057000 - CONTEX ~ CONTEXT; 72058000 - TL ~ L; 72059000 - MOVECODE(TEDOC,EDOC); 72060000 - L ~ AD ~ CONTEXT ~ 0; 72061000 - TSEG ~ SEGNO; 72061100 - IF ELBAT[I-1].CLASS = OWNV THEN AD ~ -0; 72061200 - PCINX ~ ELBAT[I].LINK + 1; 72062000 - SZ~ 6; CRS ~ "10.@3Q "; CU ~ "$"; 72063000 - START: 72064000 - IF STEPI ! UNKNOWNID THEN FLAG(758); 72065000 - TB1 ~ ENTER(AD,LOCALTYPE,PCID,FALSE); 72066000 - PUT(TAKE(LASTINFO) & NEXTADDL [33:33:15],LASTINFO); 72067000 - IF STEPI ! LFTPRN THEN 72068000 - BEGIN ERR(759); GO WAY END; 72069000 - CHAR ~ EXAMINE(NCR) ; GO INN; 72069100 - BACK: NCHR ~ GNCH; 72070000 - DO BEGIN 72071000 - CHAR ~ NCHR; 72072000 - INN: 72072100 - NCHR ~ GNCH; 72073000 - CNV ~ IF SZ= 6 THEN NCHR ELSE 72073100 - IF SZ= 8 THEN SPECIAL[NCHR].EBCDF ELSE 72073200 - IF SZ= 7 THEN SPECIAL[NCHR].ASCF ELSE 72073300 - IF NCHR > 9 THEN NCHR - 7 ELSE NCHR; 72073400 - CASE CHAR OF 72074000 - BEGIN 72075000 - GO X; GO X; GO X; GO X; COMMENT 0->3; 72075100 - BEGIN CU ~ 15; COMMENT 4 ; 72075200 - SZ~ 4; CRS ~ " $}3+!}" 72075300 - END 4; 72075400 - GO X; COMMENT 5 ; 72075500 - BEGIN CU ~ "$"; COMMENT 6 ; 72075600 - SZ ~ 6; CRS ~ "10.@3Q "; 72075700 - END 6; 72075800 - BEGIN CU ~ 36; COMMENT 7 ; 72075900 - SZ~ 7; CRS ~ "2-;@B |" 72076000 - END 7; 72076100 - BEGIN CU ~ 91; COMMENT 8 ; 72076200 - SZ~ 8; CRS ~ "4Z@H6)0" 72076300 - END 8; 72076400 - REPEAT(0,MVNU,0,0,0); COMMENT 9 ; 72077000 - GO X; GO X; GO X; COMMENT #->QUEST.; 72078000 - GENMICRO(0,0,RSTF,0,0,0); COMMENT : ; 72079000 - REPEAT(0,SFSC,0,0,0); COMMENT > ; 72080000 - GO X; GO X; COMMENT }->+; 72081000 - REPEAT(0,MCHR,0,0,0); COMMENT A ; 72082000 - BEGIN CB ~ CNV; GO BACK END; COMMENT B ; 72083000 - BEGIN CC ~ CNV; GO BACK END; COMMENT C ; 72084000 - REPEAT(2,INSC,CB,CC,0); COMMENT D ; 72085000 - REPEAT(3,MFLT,CB,CM,CP); COMMENT E ; 72086000 - REPEAT(3,MFLT,CB,CU,CU); COMMENT F ; 72087000 - GO X; GO X; COMMENT G->H; 72088000 - REPEAT(1,INSU,CN,0,0); COMMENT I ; 72089000 - GO X; GO X; GO X; COMMENT .->&; 72089500 - BEGIN ERR(922); GO WAY END; COMMENT ( ; 72090000 - REPEAT(0,SRSC,0,0,0); COMMENT < ; 72091000 - GO X; GO X; COMMENT ~->|; 72092000 - GENMICRO(2,0,ENDF,CU,CU,0); COMMENT J ; 72093000 - GO X; GO X; COMMENT K->L; 72094000 - BEGIN CM ~ CNV; GO BACK END; COMMENT M ; 72095000 - BEGIN CN ~ CNV; GO BACK END; COMMENT N ; 72096000 - GO X; COMMENT O ; 72097000 - BEGIN CP ~ CNV; GO BACK END; COMMENT P ; 72098000 - BEGIN COMMENT Q ; 72099000 - REPEAT(0,SRDC,0,0,0); 72099100 - GENMICRO(0,0,INOP,0,0,0); 72099200 - END Q; 72100000 - GENMICRO(2,0,ENDF,CM,CP,0); COMMENT R ; 72101000 - GO X; GO X; GO X; COMMENT $->-; 72102000 - BEGIN COMMENT ) ; 72103000 - GENMICRO(-1,0,0,0,0,0); 72104000 - 72105000 - BUMPNCR; 72106000 - DEBLANK; 72107000 - IF CHR = "," THEN GO START ELSE GO WAY; 72108000 - END RIGHT PAREN; 72109000 - GO X; GO X; ; GO X; COMMENT SEMI->/; 72110000 - GENMICRO(2,0,INSG,CM,CP,0); COMMENT S ; 72111000 - GO X; COMMENT T ; 72112000 - BEGIN CU ~ CNV; GO BACK END; COMMENT U ; 72113000 - GO X; GO X; COMMENT V->W; 72114000 - REPEAT(0,SFDC,0,0,0); COMMENT X ; 72115000 - GO X; COMMENT Y ; 72116000 - REPEAT(1,MINS,CB,0,0); COMMENT Z ; 72117000 - GO X; GO X; GO X; GO X; GO X; COMMENT ,->]; 72118000 - DO BEGIN COMMENT " ; 72119000 - CHAR ~ NCHR; 72120000 - CNT ~ 1; 72121000 - WHILE NCHR ~ GNCH = CHAR DO CNT ~ CNT + 1; 72122000 - IF CHAR = """ THEN 72123000 - BEGIN 72124000 - CHAR ~ CHAR & CNT [1:47:1]; 72125000 - CNT ~ CNT DIV 2 72126000 - END; 72127000 - IF CNT ! 0 THEN 72127900 - GENMICRO(1,CNT,INSU,CNV,0,0); 72128000 - CNV ~ IF SZ=6 THEN NCHR ELSE IF SZ=8 THEN 72129000 - SPECIAL[NCHR].EBCDF ELSE IF SZ=7 THEN SPECIAL 72130000 - [NCHR].ASCF ELSE IF NCHR>9 THEN NCHR-7 ELSE 72131000 - NCHR; 72131100 - END GOBBLING STRING UNTIL CHAR < 0 72132000 - END CASES OF PICTURE CHARACTERS 72133000 - END LOOP OF PICTURE ANALYZER UNTIL FALSE; 72134000 - X: COMMENT ERROR EXIT FROM CASE LOOP; 72135000 - ERR(760); 72136000 - WAY: 72137000 - ELCLASS ~ SEMICOLON; 72137100 - CONTEXT ~ CONTEX; 72138000 - IF AD ! 0 THEN 72138100 - BEGIN 72138200 - WHILE L MOD 6 = 0 DO EMIT(NVLD); 72138300 - PDPRT[PDINX.LINKR,PDINX.LINKC] ~ AD & TEMPADDR[23:35:13] 72139000 - &(L DIV 6) [10:35:13] & REAL(S) [8:47:1] 72140000 - & 4 [4:45:3]; 72141000 - PDINX ~ PDINX + 1; 72142000 - SEGNO ~ TSEG; 72142100 - SEGMENT(PCINX, L DIV 6, EDOC); 72143000 - END; 72143100 - MOVECODE(TEDOC, EDOC); 72144000 - L ~ TL 72145000 - END PICTURE DECLARATION ROUTINE; 72146000 - PROCEDURE INTERRUPTDEC; 79000000 -COMMENT HANDLES THE INTERRUPT DECLARATION WHICH HAS THE FOLLOWING : 79001000 - SYNTAX: 79002000 - ::= INTERRUPT 79003000 - ::=/, 79004000 - 79005000 - ::= INTERRUPT IDENTIFIER: 79006000 - ::=ON , 79007000 - ::= 79008000 - ; 79008500 -BEGIN 79009000 - LABEL RESIGN,AGAIN,FINI,QUIT ; 79010000 - INTEGER INTADDR %ADDRESS OF INTERRUPT 1ST WORD 79011000 - ; 79012000 - DEFINE SOFTWAREINTERRUPTDEC =14 # 79013000 - ; 79014000 -DO BEGIN 79015000 -AGAIN: 79016000 - IF STEPI!UNKNOWNID THEN FLAG(700); 79017000 - GTB1~ENTER(0,LOCALTYPE,INTERRUPTID,FALSE); 79018000 - GT1~EMITSPACE(-CURRENT); 79019000 - 79020000 -COMMENT THE FIRST WORD OF AN INTERRUPT IS INITIALLY ZERO; 79021000 - EMIT(MKST); 79022000 - EMITN(SOFTWAREINTERRUPTDEC); 79023000 -COMMENT CODE IS EMITTED FOR A CALL ON AN MCP PROCEDURE; 79024000 - IF STEPI!COLON OR STEPI ! ONV THEN GO RESIGN; 79025000 - CONTEXT~2; 79025500 - IF STEPI=ANEVENT 79026000 - THEN BEGIN EMITN (ELBAT[I].ADDRESS);EMIT(STFF);STEPIT;END 79027000 - ELSE IF VARIABLE(FP)!EVTYPE 79028000 - THEN FLAG(785) 79029000 - ELSE INDXCHK; 79030000 -COMMENT WE MUST HAVE AN EVENT DESIGNATOR OF ONE KIND OR ANOTHER. AN IRW79031000 - OR AN INDEXED 00 POINTING TO EVENT IS NOW IN STACK; 79032000 - IF ELCLASS!COMMA THEN GO QUIT ELSE STEPIT; 79033000 - EMITBUZEVENT; 79033500 - EMIT(ZERO); 79033650 -COMMENT IN TOS AT THIS POINT-POINTER TO EVENT (IRW OR INDEXED DO),FIRST79033700 - WORD OF EVENT (WITH DOUBLE TAG), ZERO; 79033750 - INFO[LASTINFO.LINKR,LASTINFO.LINKC].ADDRESS~ INTADDR~INSERTPCW;79034000 -COMMENT A PCW, REFERENCING THE NON-EXECUTABLE CODE, NOW FOLLOWS THE 79035000 - FIRST INTERRUPT WORD IN THE STACK; 79036000 - STATEMENT; 79038000 - EMIT(EXIT); 79039000 - JUMPCHKX; 79040000 - EMITN(INTADDR); STUFF; 79041000 - EMIT(ENTR); 79042000 -COMMENT THIS COMPLETES CALL UPON SOFTWAREINTERRUPTDEC. TWO PARAMETERS 79043000 - ARE PASSED BY NAME, THE FIRST ONE REFERENCING THE EVENT AND 79044000 - THE SECOND REFERENCING THE INTERRUPT PCW.THE FIRST WORD OF 79045000 - EVENT AND A HOLE FOR THE SECOND WORD ARE PASSED(SEPARATELY) BY 79045300 - VALUE; 79045600 - CONTEXT~0; 79046000 - END UNTIL ELCLASS!COMMA; 79047000 - GO FINI; 79047500 -RESIGN: COMMENT MISSING COLON OR ON; 79048000 - FLAG(786); 79049000 - ERRORTOG~TRUE; 79050000 - DO UNTIL STEPI=SEMICOLON; 79051000 - GO FINI; 79052000 -QUIT: COMMENT MISSING COMMA; 79053000 - ERRORTOG~TRUE; 79054000 - FLAG(787); 79055000 - DO UNTIL STEPI=COMMA OR ELCLASS=SEMICOLON; 79056000 - IF ELCLASS=COMMA THEN GO AGAIN; 79057000 -FINI: 79058000 -END INTERRUPTDEC; 79059000 -COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 80000000 - SYNTAX CONTROLLERS 80001000 - * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;80002000 -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%80003000 - PROCEDURE DECLARATIONS; 80004000 - COMMENT THIS ROUTINE HANDLES THE DECLARATION LIST OF A BLOCK HEAD, 80005000 - BY EXAMINING THE DECLARATORS IN EACH, AND CALLING THE PROPER 80006000 - ROUTINE. BECAUSE OF THE POSSIBILITY OF MULTIPLE DECLARATORS IN80007000 - A DECLARATION(I.E.,"SAVE OWN REAL ARRAY"), WE USE A WIERD 80008000 - ENCODING SCHEME TO REMEMBER THE (VALID) ONES WE HAVE SEEN. 80009000 - THE BOOLEAN, SAVEBIT. IS TRUE IF WE HAVE SEEN "SAVE". THE 80010000 - INTEGER, SEEN, REMEMBERS "OWN","QUEUE","EVENT", AND : 80011000 - FOR , TYP REMEMBERS WHICH (OF "REAL","INTEGER",ETC). 80012000 - AS "OWN" IS INDEPENDENT, IT HAS A BIT BY ITSELF, THE "1" BIT. 80013000 - THE OTHERS, BEING MUTUALLY EXCLUSIVE, HAVE THE VALUES 6, 4, AND80014000 - 2, RESPECTIVELY; 80015000 - BEGIN 80016000 - BOOLEAN SAVEBIT; 80017000 - INTEGER SEEN, TYP; 80018000 - LABEL ON,ROUND,LTYPE,LEVENT,LQUE,LSAV,LOWN,LARRAY,LPROC,LFIELD,80019000 - LDEFIN,LLABEL,LLAY,LPIX,LMON,LVALUE,AWAY; 80020000 - LABEL LINTRP ; 80020500 -% SPACE FOR SWITCH DEC 80022000 - DEFINE BOTTOM = 68#; 80023000 - SWITCH DECSW ~LTYPE ,LFIELD,LARRAY,LOWN ,LDEFIN,LLABEL,LPROC ,80024000 - LSAV ,LLAY ,LEVENT,LQUE ,LINTRP,LPIX ,ON ,LMON ,LVALUE;80025000 - DEFINE CSN = IF SEEN !0THEN FLAG(801) #, 80026000 - CSB = IF SAVEBIT THEN FLAG(802)#, 80027000 - C = CSB ELSE CSN #, 80028000 - OWNBIT = BOOLEAN(SEEN)#; 80029000 - ELCLASS ~ SEMICOLON; 80030000 - ON: IF ELCLASS ! SEMICOLON THEN 80031000 - BEGIN ERR(800); GO AWAY END; 80032000 - ERRORTOG ~ TRUE; 80032100 - SEEN ~ REAL(SAVEBIT ~ FALSE); 80033000 - CONTEXT ~ 2; 80034000 - ROUND: STEPIT; CONTEXT ~ 0; 80035000 - IF SEPARATOG THEN 80035910 - IF ELCLASS!SAVEV THEN IF ELCLASS!TYPEV THEN 80035920 - IF ELCLASS!PROCV THEN BEGIN FLAG(838); GO ON END; 80035930 - GO TO DECSW[ELCLASS - BOTTOM]; 80036000 - IF ELCLASS ! UNKNOWNID THEN 80037000 - IF NOT (SEEN ! 0 OR SAVEBIT) THEN GO AWAY; 80038000 - IF SAVEBIT THEN 80039000 - BEGIN ERR(801); GO AWAY END; 80040000 - CASE SEEN OF BEGIN 80041000 - BEGIN ERR(100); GO AWAY END; % NOTHING 80042000 - BEGIN ERR(801); GO AWAY END; % OWN 80043000 - IDLIST(CURRENT,LOCALTYPE,BOOID+TYP,TYP,TRUE);% TYPE 80044000 - IDLIST(-GLOBAL,LOCALTYPE,BOOID+TYP,TYP,TRUE);% OWN TYPE 80045000 - EVENTDEC(CURRENT); % EVENT 80046000 - EVENTDEC(-GLOBAL); %OWN EVENT 80047000 - QUEUEDEC(CURRENT); % QUEUE 80048000 - QUEUEDEC(GLOBAL) % OWN QUEUE 80049000 - END CASES OF MULTIPLE DECLARATORS; 80050000 - GO ON; 80051000 - LTYPE: IF SEEN > 1 THEN FLAG(801) ELSE SEEN ~ SEEN + 2; 80052000 - TYP ~ TAKE(ELBAT[I]).LINK; 80053000 - GO ROUND; 80054000 - LEVENT: IF SEEN > 1 THEN FLAG(801) ELSE SEEN ~ SEEN + 4; 80055000 - GO ROUND; 80056000 - LQUE: IF SEEN > 1 THEN FLAG(801) ELSE SEEN ~ SEEN + 6; 80057000 - GO ROUND; 80058000 - LSAV: IF SEEN ! 0 OR SAVEBIT THEN FLAG(802); 80059000 - IF TABLE(I+1) = NUMBER THEN 80059100 - BEGIN I ~ I + 1; SAVEBIT ~ BOOLEAN(2|THI+1) END ELSE 80059200 - SAVEBIT ~ TRUE; 80060000 - GO ROUND; 80061000 - LOWN: IF SEEN!0 THEN FLAG(803) ELSE 80062000 - IF REAL(SEPARATOG)=4 THEN FLAG(840) ELSE SEEN~1; 80062500 - GO ROUND; 80063000 - LARRAY: ARRAYDEC(SAVEBIT,OWNBIT,IF SEEN{1 THEN REALARRAYID ELSE 80064000 - IF SEEN{3 THEN BOOARRAYID+TYP ELSE 80065000 - IF SEEN{5 THEN EVENTARRAYID ELSE 80066000 - QUEUEARRAYID); 80067000 - ARRAYDECTOG~ARRAYDECTOG OR BOOLEAN(2*CURRENT); 80067500 - GO ON; 80068000 - LPROC: 80069000 - IF OWNBIT THEN FLAG(803); 80070000 - IF SEEN > 3 THEN FLAG(801); 80071000 - IF SEPARATOG THEN 80071100 - IF SAVEBIT THEN 80071200 - BEGIN FLAG(839); SAVEBIT~FALSE END; 80071300 - PROCEDUREDEC(SAVEBIT,IF SEEN<2 THEN PROCID ELSE 80072000 - BOOPROCID + TYP); 80073000 - IF SEPARATOG THEN GO AWAY ELSE GO ON; 80074000 - LFIELD: 80075000 - C; FIELDEC; GO ON; 80076000 - LDEFIN: 80077000 - C; DEFINEDEC; GO ON; 80078000 -LINTRP : 80078500 - C;INTERRUPTDEC; GO ON; 80078800 - LLABEL: 80079000 - C; 80080000 - STEPIT; 80081000 - SEEN ~ NEXTINFO; 80082000 - IDLIST(0 & CURRENT[30:42:6],F0RWARD,LABELID,-1,FALSE); 80083000 - DO PUT((GT1 ~ TAKE(SEEN))&0[33:33:15],SEEN) 80084000 - UNTIL SEEN ~ GT1.LINK } NEXTINFO; 80085000 - GO ON; 80086000 - LLAY: 80087000 - C; LAYOUTDEC; GO ON; 80088000 - LPIX: 80089000 - IF SEEN > 1 THEN FLAG(801) ELSE 80090000 - IF OWNBIT AND SAVEBIT THEN FLAG(802); 80090100 - PICTUREDEC(SAVEBIT); 80090200 - GO ON; 80090300 - LMON: 80091000 - C; MERRIMAC; GO ON; 80092000 - LVALUE: 80093000 - IF OWNBIT THEN FLAG(803); 80094000 - IF SEEN > 3 THEN FLAG(801); 80095000 - IF SEEN < 2 THEN TYP ~ REALV; 80096000 - IF REAL(SEPARATOG)=4 THEN 80096300 - BEGIN FLAG(841); GO ROUND END; 80096600 - READONLYARRAYDEC(SAVEBIT,TYP); 80097000 - GO ON; 80098000 - AWAY: 80100000 - END OF DECLARATIONS; 80101000 - 80102000 - 80103000 - 80103500 - PROCEDURE STATEMENT; 80104000 - COMMENT STATEMENT HANDLES ONE OF THEM PER CALL, USUALLY BY CALLING 80105000 - THE PROPER PROCEDURE. SOME CASES, HOWEVER, IT HANDLES ITSELF, 80106000 - USUALLY BY RECURSION; 80107000 - BEGIN 80108000 - INTEGER LO; 80109000 - BOOLEAN B; 80110000 - LABEL ERROR; 80111000 - LABEL AROUND, LPROC, LABLE, SCNERR, LTPROC, LID, LARRAY, LREG, 80112000 - LQUEUE, LCASE, LBEGIN, LDO, LIF, LGO, LFOR, LWHILE, 80113000 - LDEC, AWAY, LSETID, LSCAN, LREPL; 80114000 - LABEL LQALG, LTHRU; 80114500 - LABEL LEVIN; 80114800 - DEFINE BOTTOM = 4#; 80115000 - SWITCH STMTSW~LPROC ,LABLE ,SCNERR,LTPROC,LTPROC,LTPROC,LTPROC,80116000 - LTPROC,LTPROC,LTPROC,LID ,LID ,LID ,LID ,LID ,LID ,80117000 - LID ,LARRAY,LARRAY,LARRAY,LARRAY,LARRAY,LARRAY,ERROR ,ERROR ,80118000 - ERROR ,ERROR ,ERROR ,ERROR ,LQUEUE,LREG ,LQUEUE,ERROR ,ERROR ,80119000 - ERROR ,ERROR, ERROR, LQALG ,ERROR ,LEVIN ,ERROR ,ERROR ,ERROR ,80120000 - ERROR ,LCASE ,LBEGIN,LDEC ,LDO ,LIF ,LGO ,LTHRU ,LFOR ,80121000 - LWHILE,LSCAN ,LREPL ,ERROR ,ERROR ,AWAY ,AWAY ,AWAY ,AWAY ,80122000 - SCNERR,SCNERR,ERROR ,LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,80123000 - LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,80123100 - LDEC ; 80123200 - AROUND: 80124000 - IF ELCLASS { IDMAX THEN 80124100 - IF ELCLASS ! LABELID THEN 80124110 - IF ELBAT[I].LINK < NINFOO THEN COMMENT TRY FOR LABEL; 80124200 - BEGIN 80124300 - MOVE(9,ACCUM[1],SCRATCH); 80124400 - IF TABLE(I+1) = COLON THEN 80124500 - BEGIN 80124600 - MOVE(9,SCRATCH,ACCUM[1]); 80124700 - COUNT ~ ACCUM[1].CHRCNT; 80124750 - IF NOT FUTZALABEL THEN GO TO LABLE 80124800 - END END; 80124900 - GO TO STMTSW[ELCLASS - BOTTOM]; 80125000 - ERROR: 80125100 - ERR(804); 80126000 - GO AWAY; 80127000 - LPROC: COMMENT PROCEDURE; 80128000 - GT1 ~ PROCALL(FALSE,XTYPE); 80129000 - GO AWAY; 80130000 - LEVIN: COMMENT EVENT INTRINSIC; 80130100 - IF GT1~TAKE(ELBAT[I]).KIND=HAPPENEDKEY OR GT1=AVAILABLEKEY 80130150 - OR GT1=SECONDWORDKEY THEN FLAG(836); 80130155 - FIXCALL~FALSE; 80130157 - EVENTINTRINSIC; 80130200 - GO AWAY; 80130250 - LQALG: COMMENT QUEUE ALGORITHM; 80130300 - QALGORITHM(0,0,FALSE); 80130310 - GO AWAY; 80130320 - LABLE: COMMENT LABELID; 80131000 - LABELR; 80132000 - GO AROUND; 80133000 - SCNERR: COMMENT SCANNER ERROR; 80134000 - ERR(101); 80135000 - GO AWAY; 80136000 - LTPROC: COMMENT TYPED PROCEDURE; 80137000 - GT1 ~ PROCALL(FALSE,XTYPE); 80138000 - COMMENT PROCALL MAY CALL VARIABLE OR GEN PROC. ENTRY; 80139000 - GO AWAY; 80140000 - LREG: COMMENT REGISTER; 80141000 - LARRAY: COMMENT ARRAY; 80142000 - LID: COMMENT VARIABLE; 80143000 - GT1 ~ VARIABLE(FS); 80144000 - GO AWAY; 80145000 - LQUEUE: COMMENT QUEUE OR QUEUE ARRAY; 80146000 - QSTMT; 80147000 - GO AWAY; 80148000 - LCASE: COMMENT "CASE"; 80149000 - CASESTMT; 80150000 - GO AWAY; 80151000 - LBEGIN: COMMENT "BEGIN"; 80152000 - BEGINCTR ~ BEGINCTR + 1; 80153000 - IF GT1 ~ TABLE(I+1) } MINDEC AND GT1 { MAXDEC THEN 80154000 - BLOCK ELSE 80155000 - BEGIN 80156000 - STEPIT; 80157000 - COMPOUNDTAIL 80158000 - END; 80159000 - GO AWAY; 80160000 - LDO: COMMENT "DO". COMPILE HERE; 80161000 - LO ~ L; STEPIT; 80162000 - STATEMENT; 80163000 - IF ELCLASS ! UNTILV THEN 80164000 - BEGIN ERR(806); GO AWAY END; 80165000 - STEPIT; 80166000 - BEXP; 80167000 - IF B ~ L = LASTNOT THEN EMITNOT; 80168000 - EMITB(IF B THEN BRTR ELSE BRFL,BUMPL,LO); 80169000 - GO AWAY; 80170000 - LIF: COMMENT "IF"; 80171000 - IFSTMT; 80172000 - GO AWAY; 80173000 - LGO: COMMENT "GO"; 80174000 - GOSTMT; 80175000 - GO AWAY; 80176000 - LFOR: COMMENT "FOR"; 80177000 - FORSTMT; 80178000 - GO AWAY; 80179000 - LTHRU: COMMENT " THRU"; 80179100 - THRUSTMT; 80179200 - GO AWAY; 80179300 - LWHILE: COMMENT "WHILE"; 80180000 - STEPIT; LO ~ L; 80181000 - BEXP; 80182000 - IF ELCLASS ! DOV THEN 80183000 - BEGIN ERR(807); GO AWAY END; 80184000 - STEPIT; 80185000 - IF LASTNOT = L THEN B ~ BOOLEAN(-L~L+2) 80186000 - ELSE B ~ BOOLEAN(BUMPL); 80187000 - STATEMENT; 80188000 - EMITB(BRUN,BUMPL,LO); 80189000 - EMITB(IF B.[1:1] THEN BRTR ELSE BRFL,ABS(REAL(B)),L); 80190000 - GO AWAY; 80191000 - LDEC: COMMENT DECLARATION; 80192000 - FLAG(805); 80193000 - LO ~ BUMPL; DECLARATIONS; 80194000 - IF L = LO THEN L ~ L - 3 ELSE 80194100 - BEGIN JUMPCHKNX; EMITB(BRUN,LO,L) END; 80194200 - GO AWAY; 80195000 -LSCAN: COMMENT "SCAN"; 80196000 - SCANSTMT; 80197000 - GO AWAY; 80198000 -LREPL: COMMENT "REPLACE"; 80200000 - REPLACESTMT; 80201000 - GO AWAY; 80201100 - AWAY: 80202000 - END THE STATEMENT ROUTINE; 80203000 - INTEGER PROCEDURE PRIMARY; 80204000 - COMMENT PRIMARY COMPILES AN ARITHMETIC OR ARRAY PRIMARY; 80205000 - BEGIN 80206000 - REAL LT1,LT2; 80207000 - LABEL ERROR, LDPROC, LAPROC, LIPROC, LDVAR, DT, LAVAR, AT, 80208000 - LIVAR, IT, LARR, LREG, LNUM, LPAREN, SUBSCRIBE, LCASE, 80209000 - SCNERR, LTYPE, DOTTY, ON, WAY; 80210000 - LABEL LQALG; 80211500 - LABEL LEVIN; 80211530 - LABEL LWPROC,WT,LWVAR; 80211550 - DEFINE BOTTOM = 6#; 80212000 - SWITCH PRIMSW~SCNERR,ERROR ,LDPROC,LAPROC,LIPROC,ERROR ,LWPROC,80213000 - ERROR ,ERROR ,LDVAR ,LAVAR , LIVAR ,LARR ,LWVAR ,LARR ,LARR ,80214000 - LARR ,LARR ,LARR ,LARR ,LARR ,ERROR ,LARR ,LARR ,LARR ,80215000 - LARR ,ERROR ,ERROR ,LREG ,ERROR ,ERROR ,ERROR ,LNUM ,LNUM ,80216000 - ERROR ,LQALG ,ERROR ,LEVIN ,ERROR ,ERROR ,ERROR ,LPAREN,LCASE ,80217000 - ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,80218000 - ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,SCNERR,SCNERR,80219000 - ERROR ,LTYPE ; 80219100 - SWITCH PROCSW ~ DT, AT, IT, ERROR, WT; 80219200 - GO TO PRIMSW[ELCLASS - BOTTOM]; 80220000 - IF ELCLASS = 0 THEN FLAG(100) ELSE 80221000 - ERROR: 80222000 - FLAG(808); 80223000 - GO WAY; 80224000 -LEVIN: COMMENT EVTNTINTRINSIC; 80224020 - IF GT1~TAKE(ELBAT[I]).KIND!SECONDWORDKEY AND 80224040 - GT1!SETKEY AND GT1!RESETKEY THEN FLAG(836); 80224050 - IF GT1=SETKEY OR GT1=RESETKEY THEN 80224055 - BEGIN PRIMARY~LT1~BITFIDDLE(GT1=SETKEY); GO SUBSCRIBE END; 80224057 - EVENTINTRINSIC; 80224060 - GO TO AT; 80224080 - LQALG: COMMENT QUEUE ALGORITHM; 80224200 - IF ELBAT[I].TYPE!ITYPE THEN GO TO ERROR; 80224210 - QALGORITHM(0,0,TRUE); 80224220 - GO TO IT; 80224230 - LDPROC: COMMENT D.P. PROC ID; 80225000 - LAPROC: COMMENT REAL PROC ID; 80228000 - LIPROC: COMMENT INTEGER PROC ID; 80231000 - LWPROC: COMMENT WORD PROCEDURE ID; 80233200 - GO TO PROCSW[GT1 ~ PROCALL(TRUE,ELCLASS-BOOPROCID)]; 80233400 -COMMENT SOME PROCEDURES CHANGE TYPE ON YOU; 80233450 - IF GT1 < 0 THEN GO TO LARR; 80233500 - GO TO ERROR; 80233600 - LDVAR: COMMENT DP ID; 80234000 - IF (GT1~VARIABLE(FP))!DTYPE AND GT1!WTYPE THEN FLAG(810); 80235000 - DT: 80236000 - PRIMARY ~ DTYPE; 80237000 - GO WAY; 80238000 - LAVAR: COMMENT REAL ID; 80239000 - IF (GT1~VARIABLE(FP))!ATYPE AND GT1!WTYPE THEN FLAG(810); 80240000 - AT: 80241000 - PRIMARY ~ ATYPE; 80242000 - GO DOTTY; 80243000 - LIVAR: COMMENT INTEGER ID; 80244000 - IF (GT1~VARIABLE(FP))!ITYPE AND GT1!WTYPE THEN FLAG(810); 80245000 - IT: 80246000 - PRIMARY ~ ITYPE; 80247000 - GO DOTTY; 80248000 - LWVAR: COMMENT WORD ID; 80248300 - GT1~VARIABLE(FP); 80248400 -WT: PRIMARY~LT1~GT1; 80248500 - GO DOTTY; 80248800 - LARR: COMMENT ARITHMETIC ARRAY ID; 80249000 - IF PRIMARY ~ VARIABLE(FP) = DTYPE THEN GO WAY ELSE GO DOTTY; 80250000 - LREG: COMMENT REGISTER ID; 80251000 - LT1 ~ ELBAT[I].ADDRESS; 80252000 - IF STEPI ! ASSNOP THEN BEGIN FLAG(815); GO WAY END; 80253000 - STEPIT; 80254000 - PRIMARY ~ AEXP; 80255000 - EMIT(DUPL); EMIT(RSDN); EMIT(LT1); 80256000 - GO ON; 80257000 - LNUM: COMMENT NUMBER; 80258000 - 80258100 - IF DPTOG THEN 80259000 - BEGIN EMITDP(THI,TLO); 80260000 - PRIMARY ~ DTYPE; 80261000 - STEPIT; 80261100 - GO WAY 80262000 - END DP; 80263000 - EMITNUMBER(THI, REAL(THIFLAG)); 80264000 - PRIMARY ~ IF THI.[1:8] = 0 THEN ITYPE ELSE ATYPE; 80265000 - STEPIT; 80266000 - GO ON; 80267000 - LCASE: COMMENT "CASE"; 80268000 - PRIMARY ~ LT1 ~ CASEXP; 80269000 - GO SUBSCRIBE; 80270000 - LPAREN: COMMENT A PARENTHETICAL EXPRESSION; 80272000 - STEPIT; 80273000 - PRIMARY ~ LT1 ~ AEXP; 80274000 - IF ELCLASS ! RTPARN THEN BEGIN FLAG(809); GO WAY END; 80275000 - STEPIT; 80275500 - COMMENT THE EXPRESSION(S) IN THE PARENS MAY HAVE BEEN INDEXABLE, 80276000 - AND MAY BE FOLLOWED HERE BY A SUBSCRIPT LIST; 80277000 - SUBSCRIBE: 80278000 - IF LT1 < XTYPE THEN 80279000 - IF ELCLASS ! LFTBRKT THEN GO DOTTY ELSE 80280000 - BEGIN COMMENT THE SUBSCRIPT LIST; 80281000 - IF GT1 ~ SUBSCRIBER(0,LT1.[CF]) ! 0 THEN 80282000 - BEGIN PRIMARY ~ LT1>1[33:CF]; 80283000 - EMIT(NXLN); GO DOTTY 80284000 - END; 80285000 - IF PRIMARY ~ LT1 ~ LT1.[FF] = RTYPE THEN 80286000 - BEGIN EMIT(INDX); EMIT(LOAD) END ELSE 80287000 - IF LT1=WTYPE THEN BEGIN EMIT(INDX);EMIT(LODT) END ELSE 80287500 - EMIT(NXLV); 80288000 - END OF SUBSCRIPTED APRAY EXPRESSION; 80289000 - IF LT1 = DTYPE THEN GO WAY ELSE GO DOTTY; 80290000 -SCNERR: COMMENT OOPS; 80291000 - FLAG(102); 80292000 - GO DOTTY; 80293000 -LTYPE: COMMENT A TYPE DECLARATOR; 80294000 - IF LT1~TAKE(ELBAT[I]).LINK > PTRV OR LT1=BOOV THEN 80295000 - BEGIN FLAG(811); STEPIT; GO TO LPAREN END; 80296000 - IF STEPI ! LFTPRN THEN 80297000 - BEGIN FLAG(812); GO WAY END; 80298000 - STEPIT; 80299000 - IF LT2 ~ EXPRSS = LT1 THEN FLAG(813) ELSE 80300000 - IF ELCLASS ! COMMA THEN 80302000 - IF LT1 = INTV THEN EMIT(NTGR) ELSE 80304000 - IF LT1 = DPV THEN EMIT(XTND) ELSE 80305000 - IF LT1 = REALV AND LT2 = DTYPE THEN EMIT(SNGL) ELSE ELSE 80306000 - BEGIN STEPIT; 80307000 - IF GT1~EXPRSSITYPE AND GT1! WTYPE 80308000 - THEN FLAG(814); 80308500 - IF LT2 = PTYPE THEN 80309000 - BEGIN 80310000 - IF LT1 = REALV THEN EMIT(SISO) ELSE 80311000 - BEGIN EMIT(ICVD); 80312000 - EMIT(IF LT1 = INTV THEN NTGR ELSE XTND) 80313000 - END END ELSE 80314000 - IF LT1 ! DPV THEN FLAG(814) ELSE 80315000 - IF GT1 = DTYPE THEN FLAG(814) ELSE EMIT(JOIN) 80316000 - END; 80317000 - PRIMARY ~ LT1; 80318000 - IF ELCLASS ! RTPARN THEN FLAG(809); STEPIT; 80319000 - IF LT1 = DTYPE THEN GO WAY; 80320000 - DOTTY: 80321000 - IF ELCLASS = PERIODV THEN 80322000 - BEGIN PRIMARY ~ATYPE; 80323000 - IF STEPI=TAGV 80323500 - THEN BEGIN EMIT(RTAG); STEPIT END ELSE 80323800 - IF GT1 ~ DOTIT = 0 THEN EMIT(DISO) ELSE 80324000 - EMITI(GT1.[36:6],GT1.[42:6]) 80325000 - END; 80326000 - ON: 80327000 - WHILE ELCLASS = AMPERSAND DO LAYITOUT(ATYPE); 80328000 - WAY: 80329000 - END PRIMARY; 80330000 - INTEGER PROCEDURE BOOPRIM; 80331000 - COMMENT THE BOOLEAN PRIMARY ROUTINE WILL COMPILE A BOOLEAN PRIMARY IF 80332000 - IT CAN: OTHERWISE, IT CONTENTS ITSELF WITH A REFERENCE, 80333000 - POINTER, OR ARITHMETIC EXPRESSION; 80334000 - BEGIN 80335000 - INTEGER T; 80336000 - REAL QATIPE; 80336500 - BOOLEAN GTB1; 80336550 - LABEL LBPROC,LBARR,LBVAR,LTRUTH,LCASE,LPAREN,LB,LTYPE,LREF, 80337000 - LPTR,LARITH,RC,DOTTY,ON,WAY,SCNERR,ERROR; 80338000 - LABEL LSETID,LSTRNG,BOOTYPE; 80339000 - LABEL LQALG; 80339500 - LABEL LWPROC,LWARR,LWVAR; 80339550 - LABEL LEVIN; 80339555 - LABEL LRARR; 80339580 - DEFINE BOTTOM = 6#; 80340000 - SWITCH BPSWCH~SCNERR,LBPROC,LARITH,LBPROC,LARITH,LREF ,LWPROC,80341000 - LPTR ,LBVAR ,LARITH,LARITH,LARITH,LREF ,LWVAR ,LPTR ,LBARR ,80342000 - LARITH,LARITH,LARITH,LRARR ,LWARR ,ERROR ,LBARR ,LARITH,LARITH,80343000 - LARITH,ERROR ,LREF ,LARITH,LREF ,LREF ,LTRUTH,LARITH,LARITH,80344000 - ERROR ,LQALG ,ERROR ,LEVIN ,ERROR ,ERROR ,ERROR ,LPAREN,LCASE ,80345000 - ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,80346000 - ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,SCNERR,SCNERR,80347000 - LARITH,LTYPE ; 80347100 - T ~ BTYPE; 80348000 - GO TO BPSWCH[ELCLASS - BOTTOM]; 80349000 - IF ELCLASS = UNKNOWNID THEN FLAG(100) ELSE 80350000 - ERROR: FLAG(817); 80351000 - STEPIT; GO WAY; 80352000 - SCNERR: FLAG(103); GO WAY; 80353000 - LQALG: COMMENT QUEUE ALGORITHM; 80353200 - IF (QATIPE~ ELBAT[I].TYPE)=PROCD THEN GO TO ERROR; 80353210 - IF QATIPE = ITYPE THEN GO TO LARITH; 80353230 - IF QATIPE = RTYPE THEN GO TO LREF; 80353240 -COMMENT IT IS BOOLEAN TYPE QUEUE ALGORITHM; 80353260 - QALGORITHM(0,0,TRUE); 80353270 - GO DOTTY; 80353290 - LWPROC: COMMENT WORD PROCEDURE; 80353295 - 80353298 - LBPROC: COMMENT BOOLEAN PROCEDURE; 80354000 - T ~ PROCALL(TRUE,ELCLASS-BOOPROCID); 80355000 - IF (GTB1 ~ T>BTYPE AND T 1 THEN 80439300 - FLAG(833) ELSE 80439400 - NSR: BEGIN EMITNUM(ELBW); EMITR(42,3) END ELSE 80439500 - IF ELCLASS ! FACTOP THEN 80439600 - BEGIN IF GT1 ~ PEXP(TRUE) ! PTYPE AND GT1 ! WTYPE THEN 80439700 - FLAG(833) ELSE EMITD(42,42,3); I~I-1 END; 80439750 - IF STEPI = RTPARN THEN STEPIT ELSE FLAG(830); 80439800 -XIT: 80441000 - END MAKEPOINTER; 80442000 -REAL PROCEDURE PTRPRIM(BOO); VALUE BOO; BOOLEAN BOO; %BOO IS A KLUDGE 80443000 - BEGIN LABEL FONY; 80444000 - IF ELCLASS = PTRID OR ELCLASS = WORDID THEN 80445000 - BEGIN 80446000 - IF (GT1~VARIABLE(FP)).[18:15]!PTYPE AND GT1!WTYPE 80447000 - THEN BEGIN 80447100 - IF GT1 = ITYPE THEN GT1 ~ ATYPE; 80447150 - IF BOO AND PTRPRIM ~ GT1 = ATYPE THEN 80447200 - GO FONY ELSE FLAG(822) END 80447300 - END ELSE 80448000 - IF ELCLASS}BOOPROCID AND ELCLASS{PTRPROCID THEN 80449000 - BEGIN IF GT1~PROCALL(TRUE,ELCLASS-BOOPROCID)!PTYPE 80449500 - AND GT1!WTYPE THEN FLAG(825) END ELSE 80449600 - IF ELCLASS = LFTPRN THEN 80450000 - BEGIN 80451000 - STEPIT; GT1 ~ PEXP(FALSE); 80452000 - IF ELCLASS = RTPARN THEN STEPIT ELSE FLAG(823); 80453000 - END ELSE 80454000 - IF ELCLASS = CASEV THEN 80455500 - BEGIN 80456000 - IF PTRPRIM ~ GT1 ~ CASEXP ! PTYPE OR GT1 ! WTYPE THEN 80457000 - BEGIN IF GT1=ITYPE THEN PTRPRIM~GT1~ATYPE; 80457050 - IF NOT (BOO AND GT1 = ATYPE) THEN FLAG(824); 80457100 - END; 80457150 - IF GT1 = WTYPE THEN PTRPRIM ~ PTYPE; GO FONY; 80457200 - END ELSE 80458000 - IF ELCLASS = TYPEV AND TAKE(ELBAT[I]).LINK = PTRV THEN 80459000 - MAKEPOINTER ELSE 80460000 - IF BOO THEN 80460100 - IF GT1 ~AEXP = ATYPE OR GT1 = ITYPE THEN 80460200 - BEGIN PTRPRIM~ATYPE;GO FONY END ELSE ERR(825) ELSE 80460250 - ERR(825); 80461000 - PTRPRIM ~ PTYPE; 80461050 - FONY: 80461100 - END PTRPRIM; 80462000 -PROCEDURE WRITESVINFO(DF); 80472000 - FILE DF; 80473000 -BEGIN 80473500 - LABEL DUMMY; 80473800 - AY[0]~"SVINFO"&REAL(SVINFOTOG)[1:47:1]; 80474000 - AY[1]~EXTRNLCNT&LASTEXT[18:33:15]; 80475000 - AY[2]~(INFDX+60)DIV 30 + DKADDR; 80476000 - AY[3]~STARTADDL&STARTINFO[18:33:15]; 80477000 - FOR GT1~4 STEP 1 UNTIL 29 DO AY[GT1]~0; 80478000 - WRITE(DF,30,AY[*]); 80479000 - WRITEFILE(DF,INFD,0,INFDX); 80480000 - REWIND(INFF); 80481000 - FOR GT1~1 STEP 1 UNTIL INFFX DO 80482000 - BEGIN 80483000 - READ(INFF,30,AY[*]); 80484000 - WRITE(DF,30,AY[*]); 80485000 - END; 80486000 -END OF WRITESVINFO; 80487000 -PROCEDURE GLOBALDECLARATIONS; 85000000 -COMMENT ................................................................85001000 -: THIS IS THE ROUTINE WHICH HANDLS THE GLOBAL DECLARATIONS FOR THE :85002000 -:SEPARATED COMPILATION. EXCEPT THE GLOBAL PROCEDURE DECLARATIONS, :85003000 -:WHICH SHOULD HAVE THE SAME SYNTATICAL CONSTRUCTS AS IN THE FORWARD :85004000 -:DECLARATIONS AND ARE STORED IN INFO AS LOCALTYPES, THE OTHER GLOBAL :85005000 -:DECLARATIONS SHOULD HAVE THE SAME SYNTATICAL CONSTRUCTS AS THOSE IN :85006000 -:THE FORMAL SPEC PART, AND ARE STORED IN INFO AS FORMALNAMES. :85007000 -: -------- J. C. PAO 07/16/68 --------:85008000 -:......................................................................;85009000 -BEGIN 85010000 - REAL MARK,T,PJ,GT1; 85011000 - DEFINE ENTERINFO = 85011100 - BEGIN 85011120 - IF (GLOBLCNT~GLOBLCNT+1).[16:5]>2 THEN 85011140 - FLAG(857); 85011160 - TB1~ENTER(GLOBLCNT,FORMALNAMEP,T,FALSE); 85011180 - GLOBALINDEX; 85011200 - END#; 85011210 - LABEL ON,ROUND,PROC,ARRAI,SKIP,ENTR,AWAY, 85011500 - LTYPE,LFIELD,LARRAY,LOWN,LDFN,LLBL,LPROC,LSAVE,LLAY,LEVNT, 85012000 - LQUE,LINTRP,LPIX,LMON,LVALUE; 85013000 - SWITCH LDEC~LTYPE,LFIELD,LARRAY,LOWN,LDFN,LLBL,LPROC,LSAVE,LLAY, 85014000 - LEVNT,LQUE,LINTRP,LPIX,ON,LMON,LVALUE; 85015000 - ELCLASS~SEMICOLON; 85016000 - I~I-1; 85017000 - ON: IF ELCLASS!SEMICOLON THEN ERR(851); 85018000 - ERRORTOG~TRUE; 85019000 - CONTEXT~2; 85020000 - ROUND: STEPIT; CONTEXT~0; 85021000 - GO TO LDEC[ELCLASS-TYPEV+1]; 85022000 - IF ELCLASS!BEGINV THEN 85023000 - LOWN: 85024000 - LSAVE: 85026000 - LMON: 85027000 - LVALUE: 85028000 - LQUE: 85028200 - LINTRP: 85028300 - BEGIN 85029000 - FLAG(850); 85030000 - GO ON; 85031000 - END ELSE GO AWAY; 85032000 - LTYPE: T~TAKE(ELBAT[I]).LINK; 85033000 - IF PJ~TABLE(I+1)=PROCV THEN 85034000 - BEGIN 85035000 - T~T+BOOPROCID; STEPIT; 85036000 - PROC: PROCEDUREDEC(FALSE,T); GO ON; 85037000 - END; 85038000 - IF PJ=ARRAYV THEN 85039000 - BEGIN 85040000 - IF (T~T+BOOARRAYID)>WORDARRAYID THEN FLAG(850); 85040100 - STEPIT; 85040200 - GO TO ARRAI; 85040300 - END; 85040400 - IF PJ>IDMAX THEN 85040500 - BEGIN 85040600 - FLAG(850); GO TO SKIP; 85040700 - END; 85040800 - T~T+BOOID; GO TO ENTR; 85041000 - LARRAY: T~REALARRAYID; GO TO ARRAI; 85042000 - LDFN: DEFINEDEC; GO ON; 85043000 - LLAY: LAYOUTDEC; GO ON; 85044000 - LFIELD: FIELDEC; GO ON; 85045000 - LLBL: T~LABELID; GO TO ENTR; 85048000 - LPIX: T~PCID; GO TO ENTR; 85049000 - LPROC: T~PROCID; GO TO PROC; 85054000 - LEVNT: IF TABLE(I+1)=ARRAYV THEN 85055000 - BEGIN 85056000 - T~EVENTARRAYID; 85057000 - STEPIT; 85058000 - ARRAI: MARK~0; 85059000 - DO 85060000 - IF STEPI!UNKNOWNID THEN FLAG(852) ELSE 85061000 - BEGIN 85062000 - ENTERINFO; 85063000 - PUT(TAKE(LASTINFO)&MARK[33:33:15],MARK~LASTINFO); 85064000 - END UNTIL STEPI!COMMA; 85065000 - IF ELCLASS!LFTBRKT THEN 85066000 - BEGIN 85067000 - FLAG(853); 85068000 - SKIP: WHILE ELCLASS!SEMICOLON DO STEPIT; 85069000 - GO ON; 85070000 - END; 85071000 - PJ~0; % TO COUNT DIMENSIONS OF THE ARRAYS SCANNED SO FAR.85072000 - DO IF STEPI!FACTOP THEN FLAG(854) ELSE PJ~PJ+1 85073000 - UNTIL STEPI!COMMA; 85074000 - DO PUT((GT1~TAKE(MARK))&NEXTADDL[33:33:15],MARK) 85075000 - UNTIL MARK~GT1.LINK=0; 85076000 - PUTNBUMP(PJ); 85077000 - IF ELCLASS!RTBRKT THEN 85078000 - BEGIN FLAG(855); GO SKIP END; 85079000 - IF STEPI=COMMA THEN GO TO ARRAI ELSE GO ON; 85080000 - END OF ARRAY DECLARATIONS; 85081000 - T~EVENTID; 85082000 - ENTR: DO IF STEPI!UNKNOWNID THEN FLAG(856) ELSE 85083000 - ENTERINFO 85083500 - UNTIL STEPI!COMMA; 85085000 - GO ON; 85086000 - AWAY: 85087000 -END OF GLOBALDECLARATIONS; 85088000 - 85089000 - 85090000 - 85091000 -PROCEDURE SEPARATEDCOMPILING; 85100000 -COMMENT ................................................................85101000 -: THIS IS THE ROUTINE WHICH CONTROLS THE SEPARATED COMPILING. :85102000 -: -------- J. C. PAO 07/19/68 --------:85103000 -:......................................................................;85104000 -BEGIN 85105000 - LABEL COMPILING; 85106000 -COMMENT IF SEPARATOG IS TRUE, IT IS NOT THE FIRST TIME ENTRY. THERE IS85107000 - NO GLOBAL DECLARATIONS, BUT INSTEAD, WE HAVE TO RE-INITIALIZE ALL 85108000 - THE PARAMETERS FOR THE SUCCESSIVE SEPARATED COMPILING; 85109000 - IF SEPARATOG THEN 85110000 - BEGIN 85111000 - SEPSTR[ 0]~SEPSTR[ 0]+CARDCOUNT -(CARDCOUNT ~SEPSTR[ 1]); 85112000 - SEPSTR[ 2]~SEPSTR[ 2]+SCANCOUNT -(SCANCOUNT ~SEPSTR[ 3]); 85113000 - SEPSTR[ 4]~SEPSTR[ 4]+ERRORCOUNT-(ERRORCOUNT~SEPSTR[ 5]); 85114000 - SEPSTR[ 6]~SEPSTR[ 6]+PDINX; 85115000 - SEPSTR[ 7]~SEPSTR[ 7]+TOTALSEGSIZE; 85116000 - SVINFO~SVINFOTOG; 85116500 - DKADDR~1; 85117000 - INFDX~INFFX~ 85117990 - POOLX~POOLMOM~PDINX~TOTALSEGSIZE~SEPFX~SEPAX~GT2~0; 85118000 - REWIND(SEPF); 85118500 - REWIND(INFF); 85119000 - DO TEMPSTACK[GT2]~0 UNTIL (GT2~GT2+1)>MAXTEMP; 85122000 - TIME1~TIME(1); 85124000 - TIME2~TIME(2); 85125000 - GO COMPILING; 85126000 - END; 85127000 -COMMENT THIS IS FIRST TIME ENTRY, WE HAVE TO TAKE CARE OF THE GLOBAL 85128000 - DECLARATIONS AND STORE THE PARAMETERS WHICH CONCERN THE GLOBALS; 85129000 - GINFO~NEXTINFO; 85130000 - GADDL~NEXTADDL; 85131000 - GLOBALDECLARATIONS; % THIS COMPILED THE GLOBAL DECLARATIONS 85132000 - IF (GT1~TAKE(GINFO)).CLASS=0 THEN GINFO~GT1.LINK; 85133000 - SEPSTR[ 1]~CARDCOUNT; % SEPSTR[ 0]: ACCUMULATED CARDCOUNT 85134000 - SEPSTR[ 3]~SCANCOUNT; % SEPSTR[ 2]: ACCUMULATED SCANCOUNT 85135000 - SEPSTR[ 5]~ERRORCOUNT; % SEPSTR[ 4]: ACCUMULATED ERRORCOUNT 85136000 - SEPSTR[ 8]~TIME1; 85137000 - SEPSTR[ 9]~TIME2; 85138000 - SEPARATOG~TRUE; % SEPARATED COMPILING OF THE OUTER MOST BLOCK 85139000 -COMPILING: 85140000 -COMMENT NOW WE ARE HERE TO DO SOME MORE INITIAL SETTINGS, THEN, COMES 85141000 - TO THE BIG JOB --- SEPARATED COMPILING OF THE PROCEDURE. SINCE85141100 - THE "SEPARATOG" IS TRUE, THE PROCEDURE "DECLARATIONS" WILL 85141200 - COMPILE ONLY ONE PROCEDURE AT A TIME; 85141300 - STACKTOP[0]~MAXSTACK[0]~2; 85142000 - STACKTOP[2]~MAXSTACK[2]~GLOBLCNT.[36:12]; 85143000 - DECLARATIONS; 85144000 - IF ELCLASS!SEMICOLON THEN FLAG(858); 85145000 -END OF SEPARATED COMPILING; 85146000 - FILE SPO 11(1,10); 85149000 -PROCEDURE PRINTAIL; 85150000 -BEGIN 85151000 - 85152000 - FORMAT GOOD ("||B6500 ESPOL: COMPILATION", 85153000 - *(" OF PROCEDURE ",""",*A1,A*,"""),X1,A3), 85154000 - BAD ("||B6500 ESPOL:"I4" ERRORS", 85155000 - *(" IN COMPILING PROCEDURE ",""",*A1,A*,"""), 85156000 - A1), 85157000 - NED ("NO",*(". OF")," ERRORS DETECTED", 85158000 - *("= "I4", SEE SEQ, NO. "2A4)/ 85159000 - "CORE SIZE = "I6" WORDS."X6, 85160000 - "D0-STACK SIZE = ("I6" + "I3") WORDS."/ 85161000 - "PROGRAM HAD "I6" CARD IMAGES, WITH "I7 85162000 - " SYNTACTIC ITEMS."/ 85163000 - "COMPILATION TIME WAS "F8.1" SECONDS ELAPSED," 85164000 - F8.1" SECONDS PROCESSING."/ 85165000 - " RATE WAS "F8.1" CARDS/SEC."); 85166000 - REAL STREAM PROCEDURE Z(N); VALUE N; 85167000 - BEGIN 85168000 - DI~LOC Z; DI~DI+7; SI~LOC N; DS~CHR; DI~DI-Z; DS~Z CHR; 85169000 - END OF Z; 85170000 - WRITE(LINE[DBL],NED,GT1~1&REAL(ERRORCOUNT = 0)[1:47:1], 85171000 - GT1, FOR GT2 ~ GT1 STEP -3 WHILE GT2 > 0 DO 85172000 - [ERRORCOUNT,REEL(LASTSEQUENCE+2,4), 85173000 - REEL(LASTSEQUENCE+131074,4)],CORESIZE,PDINX, 85174000 - S0,CARDCOUNT, SCANCOUNT,(TIME(1)-TIME1)/60, 85175000 - GT1 ~(TIME(2)-TIME2)/60,CARDCOUNT/GT1); 85176000 - IF ERRORCOUNT ! 0 THEN 85177000 - WRITE(SPO,BAD,ERRORCOUNT, 85178000 - GT1~1&REAL(NOT SEPARATOG)[1:47:1], 85179000 - FOR GT2~GT1 STEP -1 WHILE GT2>0 DO 85180000 - [GT4~REAL((GT3~SEPSTR[12]).[1:5]=7), 85181000 - FOR GT5~GT4 STEP -1 WHILE GT5>0 DO GT3.[6:6], 85182000 - GT3.[1:5]-GT4,Z(GT3)], 85183000 - "*") ELSE 85184000 - WRITE(SPO,GOOD, 85185000 - GT1~1&REAL(NOT SEPARATOG)[1:47:1], 85186000 - FOR GT2~GT1 STEP -1 WHILE GT2>0 DO 85187000 - [GT4~REAL((GT3~SEPSTR[12]).[1:5]=7), 85188000 - FOR GT5~GT4 STEP -1 WHILE GT5>0 DO GT3.[6:6], 85189000 - GT3.[1:5]-GT4,Z(GT3)], 85190000 - "OK~"); 85191000 - IF SEPARATOG THEN WRITE(LINE[PAGE]); 85191500 -END OF PRINT TAIL; 85192000 -PROCEDURE SEPWRAPUP; 85193000 -BEGIN 85194000 -ARRAY PRT,DIR[0:29]; 85195000 -LABEL PRNTAIL; 85196000 - IF POOLX>0 THEN FLUSHPOOL; 85197000 -COMMENT MAKE A PCW FOR THE OUTER MOST BLOCK AND PLACE IT ON THE TOP OF 85203000 - D1-STACK, THEN CONVERT THE PDPRT INTO SEGMENT DESCRIPTORS AND PLACE 85204000 - THEM INTO D1-STACK ACCORDING TO THEIR SEGMENT NUMBERS. 85205000 - NOTE: NOTHING BUT ONE SEGMENT DECRIPTOR SHOULD BE IN PDPRT[*]; 85206000 - GLOBALPCW(GETSPACE(-1).[36:12],2,0,0); 85207000 - CORESIZE~(L+5) DIV 6; 85207100 - IF ERRORCOUNT!0 THEN 85207200 - BEGIN 85207300 - CLOSE(TEMP,PURGE); 85207400 - GO TO PRNTAIL; 85207500 - END; 85207600 - PRT[DIR[4]~PDINX]~PCW; 85208000 - FOR N~0 STEP 1 WHILE N0 THEN 85216000 - BEGIN 85217000 - READ SEEK(SEPF[0]); 85218000 - DO BEGIN 85219000 - READ(SEPF,30,AY[*]); 85220000 - WRITE(TEMP,30,AY[*]); 85221000 - DKADDR~DKADDR + 1; 85222000 - READ(SEPF); 85223000 - END UNTIL (GT1~GT1-15){0 85224000 - END; 85225000 - IF SEPAX>0 THEN 85226000 - BEGIN 85227000 - WRITE(TEMP,30,SEPA[*]); 85228000 - DKADDR~DKADDR+1; 85229000 - END; 85230000 - FOR GT1~5 STEP 1 UNTIL 29 DO SEPA[GT1]~0; 85231000 - SEPA[ 0]~"SEPFILE"; 85232000 - SEPA[ 1]~SEPFX+SEPAX.[24:23]; 85233000 - SEPA[ 2]~GLOBLCNT; 85234000 - SEPA[ 3]~NEXTINFO&GINFO[18:33:15]&(DKADDR-N)[01:31:17]; 85235000 - WRITEFILE(TEMP,INFO,GINFO,NEXTINFO-1); 85236000 - DKADDR~(NEXTINFO-GINFO+29) DIV 30 + DKADDR; 85237000 - SEPA[ 4]~NEXTADDL&GADDL[18:33:15]&(DKADDR-N)[01:31:17]; 85238000 - WRITEFILE(TEMP,ADDL,GADDL,NEXTADDL-1); 85239000 - DKADDR~(NEXTADDL-GADDL+29) DIV 30 + DKADDR; 85240000 - IF SVINFO THEN 85240100 - BEGIN 85240200 - WRITESVINFO(TEMP); 85240300 - DIR[12]~DKADDR&REAL(SVINFOTOG)[1:47:1]; 85240400 - END; 85240500 - WRITE(TEMP[N],30,SEPA[*]); 85241000 - REWIND(TEMP); 85242000 - WRITE(TEMP,30,DIR[*]); 85243000 - LOCK(TEMP,RELEASE); 85244000 - IF NOT LISTOG.[46:1] THEN 85245000 - PRNTAIL: PRINTAIL; 85246000 - IF STEPI=ENDV THEN 85247000 - BEGIN 85248000 - COMPOUNDTAIL; % THIS WILL WRAP UP THE SCANNER 85249000 - IF ERRORCOUNT~SEPSTR[4]+ERRORCOUNT!0 OR 85250000 - NOT LISTOG.[46:1] THEN 85251000 - BEGIN 85252000 - CARDCOUNT ~ SEPSTR[ 0]+CARDCOUNT; 85253000 - SCANCOUNT ~ SEPSTR[ 2]+SCANCOUNT; 85254000 - PDINX ~ SEPSTR[ 6]+PDINX; 85255000 - TOTALSEGSIZE ~ SEPSTR[ 7]+TOTALSEGSIZE; 85256000 - TIME1 ~ SEPSTR[ 8]; 85257000 - TIME2 ~ SEPSTR[ 9]; 85258000 - SEPARATOG~FALSE; 85258500 - PRINTAIL; 85259000 - END ELSE 85260000 - SEPARATOG~FALSE; 85261000 - END ELSE I~I-1; 85262000 -END OF SEPWRAPUP; 85263000 - PROCEDURE EPUNCH(X,Y,A); VALUE X,Y; INTEGER X,Y; ARRAY A[0]; 85270000 - COMMENT EPUNCH IS PART OF THE WRAPUP ACTION FOR DECKTOG. IT 85271000 - TRANSLATES FROM EBCDIC CODE--FOUR BYTES PER WORD IN THE ARRAY 85272000 - A--INTO EBCDIC CARD CODE(12 BITS PER COLUMN) AS A BINARY-CARD 85273000 - IMAGE. THE GLOBAL 256-WORD ARRAY TA CONTAINS THE TRANSLATION 85274000 - TABLE; 85275000 - BEGIN 85276000 - DEFINE U=LASTUSED#, T = SETSIZE#; 85277000 - IF Y = 2 THEN X ~ X - 1; 85278000 - DO FLOG((T ~ TA[(U~ A[X]).[16:8]]).[36:1], 85279000 - TA[U.[40:8]] & TA[U.[32:8]] [24:36:12] 85280000 - & T [1:37:11] & TA[U.[24:8]] [12:36:12], A[X]) 85281000 - UNTIL X ~ X - 1 < 0; 85282000 - WRITE(DECK,20,A[*]); 85283000 - A[0] ~ 0; MOVE(19,A[0],A[1]); 85284000 - END EPUNCH; 85285000 - 89900000 - 89901000 - 89902000 -COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 90000000 - INITIALIZATION 90001000 - * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;90002000 -PROCEDURE PROGRAM; 90002100 -BEGIN LABEL NEXTPROCEDURE; 90002200 - TIME1~TIME(1); TIME2~TIME(2); 90003000 - BUMPWORD~229375; 90004000 - CLCR~MKABS(CBUFF[9]); 90005000 - LASTUSED~NXTELBT~1; 90006000 - LASTSEQUENCE~MKABS(SEQNUMBER); 90007000 - LISTOG~BOOLEAN(3); 90008000 - BLANKOUT(2,SEQNUMBER); 90009000 - BUMPCHAR~32768;% 90010000 - ACCUMSTART~MKABS(ACCUM[1])&4[30:45:3]; 90011000 - FILL STACKMASK[*] WITH 90012000 - OCT1777700000, 90013000 - OCT1777720000, 90014000 - OCT0777710000, 90015000 - OCT0777730000, 90016000 - OCT0377704000, 90017000 - OCT0377724000, 90018000 - OCT0377714000, 90019000 - OCT0377734000, 90020000 - OCT0177702000, 90021000 - OCT0177722000, 90022000 - OCT0177712000, 90023000 - OCT0177732000, 90024000 - OCT0177706000, 90025000 - OCT0177726000, 90026000 - OCT0177716000, 90027000 - OCT0177736000, 90028000 - OCT0077701000, 90029000 - OCT0077721000, 90030000 - OCT0077711000, 90031000 - OCT0077731000, 90032000 - OCT0077705000, 90033000 - OCT0077725000, 90034000 - OCT0077715000, 90035000 - OCT0077735000, 90036000 - OCT0077703000, 90037000 - OCT0077723000, 90038000 - OCT0077713000, 90039000 - OCT0077733000, 90040000 - OCT0077707000, 90041000 - OCT0077727000, 90042000 - OCT0077717000, 90043000 - OCT0077737000; 90044000 - TEN[0]~1.0; COMMENT STARTING TO INITIALIZE THE POWERS OF TEN; 90045000 - FOR I~1 STEP 1 UNTIL 68 DO 90046000 - DOUBLE(TEN[I-1],ELBAT[I-1],10.0,0,|,~,TEN[1],ELBAT[I]); 90047000 - FOR I~16 STEP 1 UNTIL 68 DO 90048000 - IF BOOLEAN(ELBAT[I].[9:1])THEN TEN[I].[9:39]~TEN[I].[9:39]+1; 90049000 - FILL OPS [*] WITH 90050000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90051000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90052000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90053000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90054000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90055000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90056000 - 0, 0, 0,"VALC", 0, 0, 0, 0, 0, 0, 90057000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90058000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90059000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90060000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90061000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90062000 - 0, 0, 0, 0, 0, 0, 0,"NAMC","ADD ","SUBT", 90063000 - "MULT","DIVD","IDIV","RDIV","NTIA","NTGR","LESS","GREQ","GRTR","LSEQ", 90064000 - "EQUL","NEQL","CHSN","MULX","LAND","LOR ","LNOT","LEQV","SAME","VARI", 90065000 - "BSFT","DBST","FLTR","DFTR","ISOL","DISO","INSR","DINS","BRST","DBRS", 90066000 - "BRFL","BRTR","BRUN","EXIT","STBR","NXLN","INDX","RETN","DBFL","DBTR", 90067000 - "DBUN","ENTR","EVAL","NXLV","MKST","STFF","ZERO","ONE ","LT8 ","LT16", 90068000 - "PUSH","DLET","EXCH","DUPL","STOD","STON","OVRD","OVRN", 0,"LOAD", 90069000 - "LT48","MPCW","SCLF","DSLF","SCRT","DSRT","SCRS","DSRS","SCRF","DSRF", 90070000 - "SCRR","DSRR","ICVD","ICVU","SNGT","SNGL","XTND","IMKS","TEED","PACD", 90071000 - "EXSD","TWSD","TWOD","SISO","SXSN","ROFF","TEEU","PACU","EXSU","TWSU", 90072000 - "TWOU","EXPU","RTFF","HALT","TLSD","TGED","TGTD","TLED","TEQD","TNED", 90073000 - "TUND", 0,"TLSU","TGEU","TGTU","TLEU","TEQU","TNEU","TUNU", 0, 90074000 - "CLSD","CGED","CGTD","CLED","CEQD","CNED", 0, 0,"CLSU","CGEU", 90075000 - "CGTU","CLEU","CEQU","CNEU","NOOP","NVLD", 0, 0, 0, 0, 90076000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90077000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90078000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90079000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90080000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90081000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90082000 - 0, 0,"JOIN","SPLT","IDLE","SINT","EEXI","DEXI", 0, 0, 90083000 - "SCNI","SCND", 0, 0,"WHOI","HEYU", 0, 0, 0, 0, 90084000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90085000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90086000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90087000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90088000 - 0, 0, 0, 0, 0,"NTGD", 0, 0, 0,"OCRX", 90089000 - 0, 0, 0, 0, 0,"LOG2", 0, 0, 0, 0, 90090000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90091000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90092000 - 0, 0, 0, 0, 0, 0, 0, 0, 0,"IRWL", 90093000 - "PCWL","MVST", 0, 0, 0, 0,"STAG","RTAG","RSUP","RSDN", 90094000 - "RPRR","SPRR","RDLK","CBON","LODT","LLLU","SRCH", 0, 0, 0, 90095000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90096000 - 0, 0, 0, 0,"USND","UABD","TWFD","TWTD","SWFD","SWTD", 90097000 - 0,"TRNS","USMU","UABU","TWFU","TWTU","SWFU","SWTU", 0, 0, 90098000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90099000 - 0, 0, 0, 0, 0, 0,"SLSD","SGED","SGTD","SLED", 90100000 - "SEQD","SNED", 0, 0,"SLSU","SGEU","SGTU","SLEU","SEQU","SNEU", 90101000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90102000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90103000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90104000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90105000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90106000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90107000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90108000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90109000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90110000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90111000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90112000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90113000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90114000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90115000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90116000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90117000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90118000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90119000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90120000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90121000 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90122000 - "MINS","MFLT","SFSC","SRSC","RSTF","ENDF","MVNU","MCHR","INOP","INSG", 90123000 - "SFDC","SRDC","INSU","INSC","ENDE", 90124000 - 0; 90125000 - FILL SPECIAL[*] WITH OCT0600000000170000, % 0 90128000 - OCT0610000000170400, % 1 90129000 - OCT0620000000171000, % 2 90130000 - OCT0630000000171400, % 3 90131000 - OCT0640000000172000, % 4 90132000 - OCT0650000000172400, % 5 90133000 - OCT0660000000173000, % 6 90134000 - OCT0670000000173400, % 7 90135000 - OCT0700000000174000, % 8 90136000 - OCT0710000000174400, % 9 90137000 - OCT0430000530075401, % # 90138000 - OCT1000000534076002, % @ 90139000 - OCT0770000000067400, % 90140000 - OCT0720000634075003, % : 90141000 - OCT0760212700067000, % > 90142000 - OCT0000211700064400, % } 90143000 - OCT0530200420047000, % + 90144000 - OCT1010000004140400, % A 90145000 - OCT1020000004141000, % B 90146000 - OCT1030000004141400, % C 90147000 - OCT1040000004142000, % D 90148000 - OCT1050000004142400, % E 90149000 - OCT1060000004143000, % F 90150000 - OCT1070000004143400, % G 90151000 - OCT1100000004144000, % H 90152000 - OCT1110000004144400, % I 90153000 - OCT0560000544045410, % . 90154000 - OCT1330000610070000, % [ 90155000 - OCT0460000670050000, % & 90156000 - OCT0500000300046400, % ( 90157000 - OCT0740210700046000, % < 90158000 - OCT1370000664044000, % ~ 90159000 - OCT0000202704000000, % | 90160000 - OCT1120000004150400, % J 90161000 - OCT1130000004151000, % K 90162000 - OCT1140000004151400, % L 90163000 - OCT1150000004152000, % M 90164000 - OCT1160000004152400, % N 90165000 - OCT1170000004153000, % O 90166000 - OCT1200000004153400, % P 90167000 - OCT1210000004154000, % Q 90168000 - OCT1220000004154400, % R 90169000 - OCT0440000410055404, % $ 90170000 - OCT0520000604056000, % * 90171000 - OCT0550201420060000, % - 90172000 - OCT0510000624056405, % ) 90173000 - OCT0730000370057000, % ; 90174000 - OCT0000213700044400, % { 90175000 - OCT0400000010040000, % 90176000 - OCT0570203704060400, % / 90177000 - OCT1230000004161000, % S 90178000 - OCT1240000004161400, % T 90179000 - OCT1250000004162000, % U 90180000 - OCT1260000004162400, % V 90181000 - OCT1270000004163000, % W 90182000 - OCT1300000004163400, % X 90183000 - OCT1310000004164000, % Y 90184000 - OCT1320000004164400, % Z 90185000 - OCT0540000620065400, % , 90186000 - OCT0450000540066006, % % 90187000 - OCT0000215700054400, % ! 90188000 - OCT0750214700077000, % = 90189000 - OCT1350000630065000, % ] 90190000 - OCT0420000240077407; % " 90191000 -COMMENT HEADINGS FOR FOLLOWING TABLE ALGKEY TYPE PARADESC; 90192000 - FILL QALGORYTHM [*] WITH"20T6INSE","RT ",% 0 NON 3 90193000 - "21S6REMO","VE ",% 1 NON 2 90194000 - "22T6DELI","NK ",% 2 NON 3 90195000 - "23|8ALLO","CATE ",% 3 REF 0 90196000 - "14K4NEXT", % 4 REF 2 90197000 - "15K4LAST", % 5 REF 2 90198000 - "26K5FIRS","T ",% 6 REF 2 90199000 - "27L5PRIO","R ",% 7 REF 3 90200000 - "2825EMPT","Y ",% 8 BOO 2 90201000 - "1924FULL", % 9 BOO 2 90202000 - "2#I#POPU","LATION ";% 10 INT 1 90203000 -COMMENT *** SOME OF THE PARAMETER DESCRIPTORS ARE SUSPECT. THIS TABLE 90204000 - MUST NOT BE CHANGED WITHOUT CHECKING PROCEDURE STANDSEARCH, 90205000 - NOTE THAT FIRST CHARACTER IN FIRST WORD OF AN ENTRY 90206000 - INDICATES NUMBER OF WORDS IN THAT ENTRY (1 OR 2); 90207000 - FILL INFO[ 1,*] WITH 90208000 - OCT0000220676300000,"23AND0", % 25690209000 - OCT0000000436000000,"35ARRA","Y ", % 25890210000 - OCT0000000312000000,"35BEGI","N ", % 26190211000 - OCT0000314426000000,"37BOOL","EAN ", % 26490212000 - OCT0000000560000000,"22BY00", % 26790213000 - OCT0000000306000000,"24CASE", % 26990214000 - OCT0000000416000000,"37COMM","ENT ", % 27190215000 - OCT0000000446000000,"36DEFI","NE ", % 27490216000 - OCT0000204706000000,"23DIV0", % 27790217000 - OCT0000000322000000,"22DO00", % 27990218000 - OCT0000316426000001,"36DOUB","LE ", % 28190219000 - OCT0000000406000000,"24ELSE", % 28490220000 - OCT0000000376000000,"23END0", % 28690221000 - OCT0000223676000000,"23EQV0", % 28890222000 - OCT0000000472000000,"35EVEN","T ", % 29090223000 - OCT0000000646000000,"38EXTE","RNAL ", % 29390224000 - OCT0000260232000000,"35FALS","E ", % 29690225000 - OCT0000000432000000,"35FIEL","D ", % 29990226000 - OCT0000000360000000,"24FILL", % 30290227000 - OCT0000000342000000,"23FOR0", % 30490228000 - OCT0000000652000000,"37FORW","ARD ", % 30690229000 - OCT0000000332000000,"22GO00", % 30990230000 - OCT0000000326000000,"22IF00", % 31190231000 - OCT0000000676100000,"23IMP0", % 31390232000 - OCT0000000526000000,"22IN00", % 31590233000 - OCT0000207426000003,"37INTE","GER ", % 31790234000 - OCT0000000502000000,"39INTE","RRUPT ", % 32090235000 - OCT0000224702000000,"22IS00", % 32390236000 - OCT0000000452000000,"35LABE","L ", % 32590237000 - OCT0000000466000000,"36LAYO","UT ", % 32890238000 - OCT0000000272000000,"36LOCK","ED ", % 33190239000 - OCT0000205706000000,"23MOD0", % 33490240000 - OCT0000000516000000,"37MONI","TOR ", % 33690241000 - OCT0000222662000000,"23NOT0", % 33990242000 - OCT0000000226000000,"24NULL", % 34190243000 - OCT0000000656000000,"22OF00", % 34390244000 - OCT0000000316000000,"22ON00", % 34590245000 - OCT0000221676200000,"22OR00", % 34790246000 - OCT0000000564000000,"39OVER","WRITE ", % 34990247000 - OCT0000000442000000,"23OWN0", % 35290248000 - OCT0000000506000000,"37PICT","URE ", % 35490249000 - OCT0000000426000006,"37POIN","TER ", % 35790250000 - OCT0000000456000000,"39PROC","EDURE ", % 36090251000 - OCT0000000476000000,"35QUEU","E ", % 36390252000 - OCT0000315426000002,"24REAL", % 36690253000 - OCT0000000426000004,"39REFE","RENCE ", % 36890254000 - OCT0000000356000000,"37REPL","ACE ", % 37190255000 - OCT0000000462000000,"24SAVE", % 37490256000 - OCT0000000512000000,"23SET0", % 37690257000 - OCT0000000352000000,"24SCAN", % 37890258000 - OCT0000000550000000,"24STEP", % 38090259000 - OCT0000000364000000,"24SWAP", % 38290260000 - OCT0000000602000000,"23TAG0", % 38490261000 - OCT0000000640000000,"24THEN", % 38690262000 - OCT0000000336000000,"24THRU", % 38890263000 - OCT0000000556000000,"22TO00", % 39090264000 - OCT0000261230000000,"24TRUE", % 39290265000 - OCT0000000400000000,"35UNTI","L ", % 39490266000 - OCT0000000576000000,"35USIN","G ", % 39790267000 - OCT0000000346000000,"35WHIL","E ", % 40090268000 - OCT0000000572000000,"24WITH", % 40390269000 - OCT0000000426000005,"24WORD", % 40590270000 - OCT0000000264000000,"35WORD","S ", % 40790271000 - OCT0000000522000000,"35VALU","E ", % 41090272000 - OCT0000243024500000,"24EXIT", % 41390273000 - OCT0000516054500000,"36MYSE","LF ", % 41590274000 - OCT0000506024500000,"35ALLO","W ", % 41890275000 - OCT0000507024500000,"38DISA","LLOW ", % 42190276000 - OCT0000504024500000,"35PAUS","E ", % 42490277000 - OCT0000517024500000,"35HEYO","U ", % 42790278000 - OCT0000505024500016,"35TIME","R ", % 43090279000 - OCT0000326054500010,"35XSIG","N ", % 43390280000 - OCT0000336040500000,"36TOGG","LE ", % 43690281000 - OCT0000327040500000,"38OVER","FLOW ", % 43990282000 - OCT0000247024500010,"36RETU","RN ", % 44290283000 - OCT0000206054500010,"36ENTI","ER ", % 44590284000 - OCT0000673054500010,"24ONES", % 44890285000 - OCT0000613054500010,"38FIRS","TONE ", % 45090286000 - OCT0000512054500010,"36SCAN","IN ", % 45390287000 - OCT0150236050500010,"23ABS0", % 45690288000 - OCT0150226050500010,"24NABS", % 45890289000 - OCT0150236044500033,"24DABS", % 46090290000 - OCT0150226044500033,"35DNAB","S ", % 46290291000 - OCT0000607044500033,"38DINT","EGER ", % 46590292000 - OCT0000337024500000,"24STOP", % 46890293000 - OCT0000513024500020,"37SCAN","OUT ", % 47090294000 - OCT0000000250300074,"24SIZE", % 47390295000 - OCT0000000250000100,"24LOCK", % 47590296000 - OCT0000000250000104,"24BUSY", % 47790297000 - OCT0000000250000124,"36UNLO","CK ", % 47990298000 - OCT0000000250000110,"24BUZZ", % 48290299000 - OCT0000000250000120,"3@BUZZ","CONTROL ", % 48490300000 - OCT0000000260000000,"35CAUS","E ", % 48790301000 - OCT0000000260000001,"24WAIT", % 49090302000 - OCT0000000260000012,"23SET0", % 49290303000 - OCT0000000260000013,"35RESE","T ", % 49490304000 - OCT0000000260000016,"23FIX0", % 49790305000 - OCT0000000260000017,"24FREE", % 49990306000 - OCT0000000260000024,"36ENAB","LE ", % 50190307000 - OCT0000000260000025,"37DISA","BLE ", % 50490308000 - OCT0000000260000036,"58HAPP","ENED ", % 50790309000 - 2; 90310000 - FILL INFO[ 2,*] WITH 90311000 - OCT0000000260000037,"39AVAI","LABLE ", % 51290312000 - OCT0000000260000050,"3#SECO","NDWORD ", % 51590313000 - OCT0000000260000062,"39STOR","EITEM ", % 51890314000 - OCT0000000140500007,"39REGI","STERS ", % 52190315000 - OCT0000002140500012,"35STAC","K ", % 52490316000 - OCT0000002154500012,"39WORD","STACK ", % 52790317000 - OCT0000002154500007,"3@STAC","KVECTOR ", % 53090318000 - OCT0000004154500007,"36MEMO","RY ", % 53390319000 - OCT0000004154500007,"21M000", % 53690320000 - OCT0000657024500016,"39MOVE","STACK ", % 53890321000 - OCT0000502044500020,"24JOIN", % 54190322000 - OCT0000513024500012,"23IIO0", % 54390323000 - OCT0000177054500001,"24NAME", % 54590324000 - OCT0000672050500002,"38READ","LOCK ", % 54790325000 - OCT0000000050500004,"36BINA","RY ", % 55090326000 - OCT0000000050500003,"37DECI","MAL ", % 55390327000 - OCT0000676054500023,"3#MASK","SEARCH ", % 55690328000 - OCT0000675054500027,"3#LIST","LOOKUP ", % 55990329000 - 0; 90330000 - FILL ADDL[0,*] WITH 0, 90331000 - OCT0000000110300002, 90332000 - OCT0000000104300003, 90333000 - OCT0000000104300000, 90334000 - OCT0000000110300005, 90335000 - OCT0000000104300006, 90336000 - OCT0000000104300000, 90337000 - OCT0000000000000001, 90338000 - OCT0000000000000001, 90339000 - OCT0000000104300000, 90340000 - OCT0000000000000002, 90341000 - OCT0000000140300001, 90342000 - OCT0000000104300000, 90343000 - OCT0000000000000056, 90344000 - OCT0000000000000001, 90345000 - OCT0000000110300000, 90346000 - OCT0000000000000002, 90347000 - OCT0000000104300000, 90348000 - OCT0000000104300000, 90349000 - OCT0000000000000003, 90350000 - OCT0000000104300000, 90351000 - OCT0000000104300000, 90352000 - OCT0000000140300001, 90353000 - OCT0000000000000003, 90354000 - OCT0000000110300000, 90355000 - OCT0000000140300001, 90356000 - OCT0000000104300000, 90357000 - OCT0000000000000001, 90358000 - OCT0000000100300000, 90359000 - 0; 90360000 - NEXTADDL~30; 90399000 - %***THE PRECEDING CARD IS --NOT-- SUPPLIED BY OPTAB/BLDR*** 90399001 - COMMENT NOW LINK UP INFO AND STACKHEAD; 91000000 - NEXTINFO ~ 257; GT1 ~ 0; 91001000 - WHILE GT1 ~ TAKE(NEXTINFO ~ NEXTINFO + GT1.CONL) ! 0 DO 91002000 - IF GT2 ~ GT1.ALFACNT ! 0 THEN 91003000 - PUT(GT1 & STACKHEAD[SCRAM ~ GT2 MOD 125][3:33:15], 91004000 - STACKHEAD[SCRAM] ~ NEXTINFO); 91005000 - COMMENT AND PUT QUESTION MARKS IN OPS FOR UNDEFINED OPERAT0RS; 91006000 - FOR GT1~0 STEP 1 UNTIL 767 DO IF OPS[GT1]=0 THEN OPS[GT1]~ 91007000 - 3195660; 91008000 - OPS[768] ~ "LINK"; 91009000 - FIRSTINFO ~ NEXTINFO; 91009100 - CONTEXT ~ 2; 91010000 - MAXDISP ~ 2023; 91011000 - COUNTQALG~STARTNSQ; 91011500 - SAVED ~ TRUE; 91013000 - LASTADDL ~ - 32767; 91013100 - GT2 ~ 0; COMMENT INITIALIZE DEFINED TO STANDARD IDS.; 91014000 - FOR GT1 ~ 0 STEP 10 UNTIL 80 91015000 - DO DEFINFO[GT1] ~ "3A 0"&(GT2~GT2+1)[30:42:6]&12[36:42:6]; 91016000 - ERRORTOG ~ MACRO ~ TRUE; 91017000 - SEPARATOG~SVINFOTOG~BOOLEAN(-2); % AVAILABLE FOR SETTING 91017900 - I~0; NCR~READACARD; 91018000 - STEPIT; 91018100 - IF REAL(SEPARATOG)<0 THEN 91018200 - BEGIN 91018300 - SEPARATOG~FALSE; 91018400 - IF ELCLASS!BEGINV THEN 91018500 - DO UNTIL STEPI=BEGINV; 91018600 - WRITE(TEMP); 91018700 - STACKTOP[0]~S0; 91018730 - SEGNO~5; 91018760 - END ELSE 91018900 - BEGIN 91019000 -COMMENT IN THE SEPARATED COMPILING, THE OUTER MOST BLOCK OF THE MAIN 91019001 - PROCEDURE IS GIVEN RUNNING LEVEL "SEPLEVEL". WHICH IS 3 OR 91019002 - HIGHER. GLOBALS ARE GIVEN D2-STACK REFERENCES FROM (2,2) AND 91019003 - UP. REFERENCES TO D0, D1 AND D2 STACKS ARE SAME AS IN THE 91019004 - NORMAL COMPILATION. DURING BINDING PROCESS, THE "GLOBLCNT" 91019005 - TELLS THE DIFFERENCE OF GLOBALS FROM LOCALS IN THE D2-STACK; 91019006 - GLOBLCNT~1&2[33:45:3]; 91019100 - CURRENT~SEPLEVEL-1; 91019200 - END; 91019300 - TEMPADDR~STATE~ 91019900 - BEGINCTR ~ SCANCOUNT ~ 1; 91020000 - FIRSTX ~ LASTX ~ FIRSTMT ~ -1; 91023000 - POOLX ~ 0 ; 91025000 - STARTINFO~NINFOO~NEXTINFO; 91026000 - STARTADDL~NEXTADDL; 91027000 - IF SVINFOTOG THEN SVINFO~TRUE ELSE SVINFOTOG~FALSE; 91028000 - 91028100 - 91028200 -COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 92000000 - COMPILE THE OUTER BLOCK, AND THEY THAT DWELL THEREIN 92001000 - * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;92002000 - IF REAL(SEPARATOG)=2 THEN 92002100 - BEGIN 92002200 - NEXTPROCEDURE: 92002300 - DO BEGIN 92002350 - SEPARATEDCOMPILING; 92002400 - SEPWRAPUP; 92002500 - END UNTIL NOT SEPARATOG; 92002550 - GO TO ENDOFITALL; 92002600 - END; 92002700 - DECLARATIONS; 92003000 - FIRSTATEMENT; 92004000 - COMPOUNDTAIL; 92005000 - IF SVINFO THEN 92005100 - BEGIN 92005150 - WRITEFILE(INFF,INFO,STARTINFO,NEXTINFO-1); 92005200 - WRITEFILE(INFF,ADDL,STARTADDL,NEXTADDL-1); 92005250 - INFD[(INFDX~INFDX+2).LINKR,INFDX.LINKC]~ 92005300 - (GTI1~(NEXTINFO-STARTINFO+29)DIV 30+INFFX)& 92005350 - INFFX[18:33:15]; 92005400 - INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC]~ 92005450 - (NEXTINFO-1)&STARTINFO[18:33:15]; 92005500 - INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC]~ 92005550 - (NEXTADDL-1)&STARTADDL[18:33:15]; 92005600 - INFFX~(NEXTADDL-STARTADDL+29) DIV 30 + GTI1; 92005650 - END; 92005700 - PURGE(256); 92006000 -END PROGRAM; 92007000 - PROGRAM; 92899000 - BEGIN COMMENT THE WRAPUP BLOCK; 92900000 - DEFINE PRT = INFO#, TAG=ADDL#, DISK=CODE#, 92901000 - Z = RESULT#, R=COUNT#, J=CONTEXT#, 92901100 - STACKSIZE = CSZ#, MOM=MAXCSZ#, AD=QGT1#, 92901200 - X = KLASSF#, ROW=LINKR#, COL=LINKC#; 92901300 - PROCEDURE RITE(A,X,TX,N,AT); VALUE X,TX,N,AT; ARRAY A[0,0]; 92902000 - INTEGER X,TX,N,AT; 92903000 - BEGIN 92904000 - LABEL INN,ON; 92904100 - DEFINE BITS = (IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB)#; 92905000 - DEFINE BUMP = IF B ~ B + 1 } 6 THEN 92906000 - BEGIN B ~ B - 6; W ~ W + 1 END BUMP#,D=ELBAT[W],B#, 92907000 - I = SCRAM #, 92907100 - G(G1)=TAG[G1.LINKR,G1.LINKC]#, 92907200 - AA(AA1)=A[AA1.LINKR,AA1.LINKC]#, 92907300 - W = GT3#, B = GT4#, BYTES= 8 BITS#; 92908000 - STREAM PROCEDURE INSERTBYTE(V,W,B); VALUE V,B; 92909000 - BEGIN SI~LOC W; SI~SI-2; SKIP 4 SB; DI~W; B(SKIP 8 DB); BYTES 92910000 - END INSERTBYTE; 92911000 - BOOLEAN STREAM PROCEDURE UNEQUAL(A,B); 92911100 - BEGIN SI ~ A; DI ~ B; IF 8 SC ! DC THEN TALLY~1; UNEQUAL~TALLY 92911200 - END UNEQUAL; 92911300 - STREAM PROCEDURE MOVEBYTES(N,F,FS,T,TS); VALUE N,FS,TS; 92912000 - BEGIN SI ~F; FS(SKIP 8 SB); DI~T; TS(SKIP 8 DB); N(BYTES) END; 92913000 - IF DECKTOG THEN 92913310 - BEGIN 92913320 - I ~ X; 92913330 - ON: 92913340 - IF I ~ I + 1 { N THEN 92913350 - IF TX < 0 THEN GO INN ELSE 92913360 - IF G[X] = G[I] THEN 92913370 - INN: 92913380 - IF NOT UNEQUAL(AA[X],AA[I]) THEN GO ON; 92913390 - IF NOT TB1 ~ I - X > 10 THEN I ~ MIN(X + 10, N)ELSE X~X+1;92913400 - ELBAT[0] ~ (I - X).[28:16] & (1 - REAL(TB1)) [28:47:1] 92913410 - & 11 [21:44:4]; 92913420 - ELBAT[1] ~ 0 & AT[20:28:20] & (I-X) [16:44:4]; 92913430 - AT ~ AT + I - X; 92913440 - W ~ 1; B ~ 5; 92913450 - DO BEGIN 92913460 - INSERTBYTE(IF TX<0 THEN 243 ELSE G[X]+240, D); 92913470 - IF B ~ B + 1 = 6 THEN BEGIN B ~ 2; W~W+1 END; 92913480 - R ~ 0; 92913490 - DO BEGIN 92913500 - MOVEBYTES(Z ~ 6-MAX(R,B),AA[X],R,D); 92913510 - IF B~B+Z=6 THEN BEGIN B~2; W~W+1 END; 92913520 - END UNTIL R~R+Z } 6; 92913530 - END UNTIL X~X+1 } I OR TB1; 92913540 - IF TB1 THEN 92913542 - BEGIN ELBAT[3].[32:16]~62357; MOVE(4,LBUFF[5],ELBAT[4]); 92913544 - W ~ 7; B ~ 5; X ~ I; AT ~ AT + 1; 92913546 - END SMEAR CARD CODE COPYING; 92913548 - EPUNCH(W,B,ELBAT); 92913550 - IF I < N THEN GO ON; 92913560 - W ~ B ~ 0; 92913570 - END DECKTOG ACTION ELSE 92913580 - WHILE N > 0 DO 92914000 - BEGIN 92915000 - IF TX } 0 THEN 92916000 - BEGIN 92917000 - MOVEBYTES(1,TAG[TX.LINKR,TX.LINKC],5,D); 92918000 - TX ~ TX + 1; 92919000 - END ELSE 92920000 - INSERTBYTE(3,D); 92921000 - BUMP; 92922000 - INSERTBYTE(0,D); BUMP; 92923000 - MOVEBYTES(6,A[X.LINKR,X.LINKC],0,D); 92924000 - X ~ X + 1; 92925000 - W ~ W + 1; 92926000 - N ~ N - 1; 92927000 - IF W > 30 THEN 92928000 - BEGIN 92929000 - WRITE(DISK[DKADDR],30,ELBAT[*]); 92930000 - MOVE(45,ELBAT[30],ELBAT[0]); 92931000 - W ~ W -30; DKADDR ~ DKADDR + 1; 92932000 - END N LOOP; 92933000 - END W LOOP; 92933100 - END RITE; 92939000 - PROCEDURE M12(N,A,S,B,X); VALUE N,S,X; ARRAY A[*],B[*,*]; 92940000 - INTEGER N,S,X; 92941000 - BEGIN 92942000 - MOVE(GT1~MIN(256-X.LINKC,N),A[S],B[X.LINKR,X.LINKC]); 92943000 - IF N ~ N - GT1 > 0 THEN 92944000 - MOVE(N,A[S+GT1],B[(X~X+GT1).LINKR,X.LINKC]) 92945000 - END M12; 92946000 - PROCEDURE M22(N,A,AX,B,BX); VALUE N,AX,BX; INTEGER N,AX,BX; 92947000 - ARRAY A,B[0,0]; 92948000 - BEGIN 92949000 - INTEGER P; 92950000 - DO BEGIN 92951000 - MOVE(P~MIN(256-AX.LINKC,256-BX.LINKC,N), 92952000 - A[AX.LINKR,AX.LINKC],B[BX.LINKR,BX.LINKC]); 92953000 - AX ~ AX + P; BX ~ BX+P; 92954000 - END UNTIL N ~ N - P { 0; 92955000 - END M22; 92956000 - LABEL DD; 92957000 -COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 93000000 - GIVE IT TO THE OUTSIDE WORLD---MAYBE 93001000 - * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;93002000 - IF POOLX > 0 THEN FLUSHPOOL; 93002100 - WHILE L MOD 6 ! 0 DO EMIT(NVLD); 93003000 - EDOC[(L~L DIV 6).ROW,L.COL] ~ CORESIZE~(J~(STACKSIZE~STACKTOP 93004000 - [0]) + SAVESIZE) + L; 93005000 - EDOC[L.ROW,L.COL].[09:17]~EDOC[L.ROW,L.COL] + 1; 93005100 - DKADDR ~ 366; L ~ L+ 1; 93005200 - COMMENT DKADDR IS NOW THE STARTING DISKADDRESS IN THE CODE 93006000 - FILE OF OVERLAYABLE STUFF. 93007000 - CORESIZE IS THE AMOUNT OF SAVE CORE. 93008000 - J IS THE START OF THE OUTER-BLOCK CODE SEGMENT. 93009000 - STACKSIZE IS THE SIZE OF THE LEVEL-ZERO START, AND 93010000 - THE START OF SAVE DATA. 93011000 - L IS NOW THE NUMBER OF WORDS IN THE SAVE CODE SEGMENT; 93012000 - PRT[0,0] ~ 0; M22(J-1,PRT,0,PRT,1); 93012100 - TAG[0,0] ~ 0; M22(J-1,TAG,0,TAG,1); 93012200 - IF FIRSTX < 0 THEN FIRSTX ~ FIRSTMT; 93012900 - GLOBALPCW(3,SEGNO,FIRSTX,1); 93013000 - IF SVINFO THEN 93013010 - INFD[(GTI1~INFDX-3).LINKR,GTI1.LINKC]~PCW; 93013020 - FLOG(1,0&REAL(NOT FALSE)[8:28:20],PRT[0,4]); TAG[0,4] ~ 5; 93013040 - FLOG(1,J&L[8:23:20],PRT[0,SEGNO]); TAG[0,SEGNO]~3; 93013100 - PRT[0,0] ~ -(0&CORESIZE[10:31:17]); 93013200 - FLOG(1,CORESIZE+1&CORESIZE[10:31:17],PRT[0,1]); 93013230 - TAG[0,0] ~ TAG[0,1] ~ 3; 93013300 - SAVEL ~ IF SAVEL ! 0 THEN (SAVEL+5) DIV 6 ELSE 4; 93013400 - INZCODE[0,0].[10:17] ~ INZCODE[SAVEL.ROW,SAVEL.COL] ~ SAVEL; 93013500 - T ~ 8190 - CORESIZE - SAVEL ~ SAVEL + 1; 93013600 - INZCODE[SAVEL.ROW,SAVEL.COL] ~ 0& SAVEL ~T[7:28:20]&1[27:47:1];93013700 - PRT[0,6] ~ CORESIZE & 1[6:47:1]; 93013800 - IF ERRORCOUNT!0 OR NOT LISTOG.[46:1] THEN PRINTAIL; 93014000 - X ~ I ~ STACKSIZE; 93035000 - IF ERRORCOUNT ! 0 THEN GO TO ENDOFITALL; 93036000 - CLOSE(LINE); 93037000 - IF DECKTOG THEN 93038000 - BEGIN 93039000 - FILL TA[*] WITH 93040000 - COMMENT INTERNAL TO EBCDIC CARD CODE; 93041000 - OCT5403,OCT4401,OCT4201,OCT4101,OCT4041,OCT4021,OCT4011,OCT4005,93042000 - OCT4003,OCT4403,OCT4203,OCT4103,OCT4043,OCT4023,OCT4013,OCT4007,93043000 - OCT6403,OCT2401,OCT2201,OCT2101,OCT2041,OCT2021,OCT2011,OCT2005,93044000 - OCT2003,OCT2403,OCT2203,OCT2103,OCT2043,OCT2023,OCT2013,OCT2007,93045000 - OCT3403,OCT1401,OCT1201,OCT1101,OCT1041,OCT1021,OCT1011,OCT1005,93046000 - OCT1003,OCT1403,OCT1203,OCT1103,OCT1043,OCT1023,OCT1013,OCT1007,93047000 - OCT7403,OCT0401,OCT0201,OCT0101,OCT0041,OCT0021,OCT0011,OCT0005,93048000 - OCT0003,OCT0403,OCT0203,OCT0103,OCT0043,OCT0023,OCT0013,OCT0007,93049000 - OCT0000,OCT5401,OCT5201,OCT5101,OCT5041,OCT5021,OCT5011,OCT5005,93050000 - OCT5003,OCT4402,OCT4202,OCT4102,OCT4042,OCT4022,OCT4012,OCT4006,93051000 - OCT4000,OCT6401,OCT6201,OCT6101,OCT6041,OCT6021,OCT6011,OCT6005,93052000 - OCT6003,OCT2402,OCT2202,OCT2102,OCT2042,OCT2022,OCT2012,OCT2006,93053000 - OCT2000,OCT1400,OCT3201,OCT3101,OCT3041,OCT3021,OCT3011,OCT3005,93054000 - OCT3003,OCT1402,OCT6000,OCT1102,OCT1042,OCT1022,OCT1012,OCT1006,93055000 - OCT7000,OCT7401,OCT7201,OCT7101,OCT7041,OCT7021,OCT7011,OCT7005,93056000 - OCT7003,OCT0402,OCT0202,OCT0102,OCT0042,OCT0022,OCT0012,OCT0006,93057000 - OCT5402,OCT5400,OCT5200,OCT5100,OCT5040,OCT5020,OCT5010,OCT5004,93058000 - OCT5002,OCT5001,OCT5202,OCT5102,OCT5042,OCT5022,OCT5012,OCT5006,93059000 - OCT6402,OCT6400,OCT6200,OCT6100,OCT6040,OCT6020,OCT6010,OCT6004,93060000 - OCT6002,OCT6001,OCT6202,OCT6102,OCT6042,OCT6022,OCT6012,OCT6006,93061000 - OCT3402,OCT3400,OCT3200,OCT3100,OCT3040,OCT3020,OCT3010,OCT3004,93062000 - OCT3002,OCT3001,OCT3202,OCT3102,OCT3042,OCT3022,OCT3012,OCT3006,93063000 - OCT7402,OCT7400,OCT7200,OCT7100,OCT7040,OCT7020,OCT7010,OCT7004,93064000 - OCT7002,OCT7001,OCT7202,OCT7102,OCT7042,OCT7022,OCT7012,OCT7006,93065000 - OCT5000,OCT4400,OCT4200,OCT4100,OCT4040,OCT4020,OCT4010,OCT4004,93066000 - OCT4002,OCT4001,OCT5203,OCT5103,OCT5043,OCT5023,OCT5013,OCT5007,93067000 - OCT3000,OCT2400,OCT2200,OCT2100,OCT2040,OCT2020,OCT2010,OCT2004,93068000 - OCT2002,OCT2001,OCT6203,OCT6103,OCT6043,OCT6023,OCT6013,OCT6007,93069000 - OCT1202,OCT3401,OCT1200,OCT1100,OCT1040,OCT1020,OCT1010,OCT1004,93070000 - OCT1002,OCT1001,OCT3203,OCT3103,OCT3043,OCT3023,OCT3013,OCT3007,93071000 - OCT1000,OCT0400,OCT0200,OCT0100,OCT0040,OCT0020,OCT0010,OCT0004,93072000 - OCT0002,OCT0001,OCT7203,OCT7103,OCT7043,OCT7023,OCT7013,OCT7007,93073000 -0; 93074000 - FILL ELBAT[*] WITH 93074000 - "F340A220","F3","FEFE9544","A200F301",%CARD 1 OF LDR 93075000 - "DFDFDFDF","DFF70000","00784004","F3800FFF", 93075100 - "F00000F3","06002095","4BA34012","2000F000", 93075200 - "06F3B241","20029C04","F304B795","4AB7A1F3", 93075300 - "20009810","1808F39E","064020BA","A2F3A004", 93075400 - "F3002096","06954AF3","A12000B3","2021F392",%CARD 2 93075500 - "00069340","26F3BB40","06B9A1A0","F304B5B5", 93075600 - "B00020F3","AE401000","2040F30F","95BCABDF", 93075700 - "DFF34040","40404040","F7000A00","384025F7", 93075800 - "28","254040","40404040","40404040", 93075900 - "F5800000","F0203540","000000F0","2033F3A2", 93076000 - "0001F020","29F30024","0002954B","F3FEFE95", 93076100 - "44A200F3","02960695","4AA1F300","01402FBD", 93076200 - "B7F3B79A","2714B69A","F32B0140","23BDB6F3", 93076300 - "A0000DB6","D4A3F3DF","A3404040","40401220", 93076400 - "F5880000","602005F3","40000040","4F300",%XFR CARD 93076500 - 0,"BC402FB0","A6F3BA40","2FB1A695", 93076600 - "F3B7D4A3","40000040","4004F300","9800", 93076700 - "25404040"; 93076800 - FOR T~0 STEP 1 UNTIL 74 DO 93080000 - ELBAT[T] ~(C ~ ELBAT[T]).[44:4] & C [40:36:4] & C[36:32:4]93081000 - &C[32:26:4] &C[28:20:4] &C[24:14:4] &C[20:8:4] 93082000 - &C[16:2:4] + C.[43:1] &C[43:37:1] &C[39:31:1] 93083000 - &C[35:25:1] &C[31:19:1] &C[27:13:1] &C[23:7:1] 93084000 - &C[19:1:1] | 9; 93085000 - EPUNCH(19,6,ELBAT); MOVE(40,ELBAT[20],ELBAT[0]); 93090000 - EPUNCH(19,6,ELBAT); MOVE(20,ELBAT[40],ELBAT[0]); 93091000 - EPUNCH(19,6,ELBAT); MOVE(14,ELBAT[60],LBUFF[0]); 93092000 - END DECKTOG PRELIMINARIES; 93099000 - WHILE PDINX ~ PDINX - 1 } 0 DO 93100000 - BEGIN AD ~ T ~ 0; 93101000 - MOM ~ (C ~ PDPRT[PDINX.LINKR,PDINX.LINKC]).[36:12]; 93102000 - CASE C.[2:3] OF 93103000 - BEGIN 93104000 - BEGIN COMMENT CASE 0 = DATA DESCRIPTOR; 93105000 - DD: 93105100 - IF C.[23:13] ! 0 THEN 93106000 - IF BOOLEAN(C.[8:1]) THEN 93107000 - BEGIN 93108000 - READ SEEK(TEMP[C.[23:13]]); 93109000 - AD ~ X; 93110000 - J ~ C.[10:13]; 93111000 - FOR I ~ 0 STEP 30 UNTIL J - 1 DO 93112000 - BEGIN READ(TEMP,30,ELBAT[*]); 93113000 - M12(T~MIN(30,J-I),ELBAT,0,PRT,X); 93114000 - X ~ X + 1; 93115000 - END; 93116000 - END SAVE ARRAYS ELSE 93117000 - BEGIN 93118000 - READ SEEK(TEMP[C.[23:13]]); 93119000 - AD ~ DKADDR; 93121000 - J ~ (C.[10:13] + 29) DIV 30; 93122000 - WHILE J ~ J - 1 } 0 DO 93123000 - BEGIN 93124000 - READ(TEMP,30,ELBAT[*]); 93125000 - WRITE(CODE[DKADDR],30,ELBAT[*]); 93126000 - DKADDR ~ DKADDR + 1; 93127000 - END END NONSAVE ARRAYS ELSE 93128000 - COMMENT TEMP ADDRESS = 0; 93129000 - IF C.[8:1]=1 AND C.[10:13]!0 THEN 93129100 - X ~ (AD ~ X) + C.[10:13]; 93130000 - AD ~ AD & C[15:10:13] & C[7:6:1] & C[4:7:1]; 93131000 - AD.[28:2] ~3|REAL(C.[8:1]=0 AND C.[23:13]!0); 93131010 - AD.[1:1] ~ REAL(C.[10:13]=0); 93131100 - FLOG(C.[8:1],AD,PRT[MOM.LINKR,MOM.LINKC]); 93132000 - T ~ 5 93133000 - END DATA DESCRIPTOR; 93134000 - COMMENT CASE 1 IS ALSO DATA DESCRIPTOR; 93135000 - GO TO DD; 93135100 - COMMENT CASE 2 = D. P. VARIABLE; 93136000 - T ~ TAG[(MOM+1).LINKR,(MOM+1).LINKC] ~ 2; 93137000 - COMMENT CASE 3 = PTR VARIABLE; 93138000 - BEGIN 93139000 - PRT[MOM.LINKR,MOM.LINKC] ~ 0; 93140000 - T ~ 5 93141000 - END POINTER VARIABLE; 93142000 - ; COMMENT CASE 4 IS NULL; 93143000 - ; COMMENT CASE 5 IS NULL; 93144000 - COMMENT CASE 6 = SEGMENT DESCRIPTOR; 93145000 - BEGIN 93146000 - READ SEEK(TEMP[C.[23:13]]); 93147000 - AD ~ DKADDR; 93148000 - J ~ (C.[10:13]+29) DIV 30; 93149000 - WHILE J ~ J-1 } 0 DO 93150000 - BEGIN 93151000 - READ(TEMP,30,ELBAT[*]); 93152000 - WRITE(CODE[DKADDR],30,ELBAT[*]); 93153000 - DKADDR ~ DKADDR + 1; 93154000 - END; 93155000 - PRT[MOM.LINKR,MOM.LINKC]~AD&C[15:10:13]& 93156000 - 1[2:47:1]; 93156001 - T ~ 3 93157000 - END SEGMENT DESCRIPTOR; 93158000 - COMMENT CASE 7 = PROGRAM CONTROL WORD; 93159000 - BEGIN 93160000 - PRT[MOM.LINKR,MOM.LINKC] ~ C.[24:12] & 93161000 - ((T~C.[7:17])DIV 6)[15:35:13]& 93162000 - (I MOD 6) [12:9:3] & C[28:6:1] & 93163000 - 1[33:47:1]; 93164000 - T ~ 7 93165000 - END PCW CASE 93166000 - END CASES OF PDPRT ENTRIES; 93167000 - TAG[MOM.LINKR,MOM.LINKC] ~ T 93168000 - END ANALYSIS OF PDPRT ENTRIES; 93169000 - PRT[0,2] ~ X ~ DKADDR + 1; 93200000 - GT3 ~ GT4 ~ DKADDR ~ ELBAT[0] ~ 0; 93201000 - MOVE(50,ELBAT[0],ELBAT[1]); 93202000 - RITE(PRT,0,0,STACKSIZE + SAVESIZE,0); 93202100 - RITE(EDOC,0,-1,L,STACKSIZE + SAVESIZE); 93202200 - RITE(INZCODE,0,-1,8190-CORESIZE,STACKSIZE+SAVESIZE+L); 93202250 - WHILE GT3 | 6 + GT4 > 0 DO 93202300 - BEGIN 93203000 - WRITE(DISK[DKADDR],30,ELBAT[*]); 93204000 - MOVE(45,ELBAT[30],ELBAT[0]); 93205000 - GT3 ~ GT3 - 30; 93205050 - DKADDR ~ DKADDR + 1; 93205100 - END; 93205200 - IF SVINFO THEN 93220000 - BEGIN 93221000 - READ SEEK(DISK[DKADDR~X]); 93221500 - WRITESVINFO(DISK); 93222000 - REWIND(DISK); 93223000 - READ(DISK,30,AY[*]); 93224000 - AY[0].[28:20]~X; 93225000 - WRITE(DISK,30,AY[*]); 93226000 - END; 93227000 - IF DECKTOG THEN 93228000 - BEGIN 93229000 - MOVE(14,LBUFF[0],ELBAT[0]); 93230000 - ELBAT[4] ~ SEGNO.[34:6] &(FIRSTX DIV 6)[23:35:13] 93240000 - & 33 [36:42:6] & (I ~ FIRSTX MOD 6)[20:45:3]; 93241000 - ELBAT[5].[16:8] ~ SEGNO; 93242000 - EPUNCH(13,6,ELBAT); 93243000 - END PUNCHING TRANSFER CARD ELSE 93244000 - LOCK(DISK); 93500000 - END OF THE WRAPUP BLOCK; 94000000 - ENDOFITALL: 94001000 -% 94001500 - CLOSE(TAPE); 94001600 - IF NEWTOG THEN 94010000 - BEGIN 94011000 - FILL SEPA[*] WITH "END;END."," L A S T"," C A R D"," I M A G", 94012000 - " E O N N"," E W T ","A P E "," ", 94013000 - " ","99999999"; 94014000 - WRITE(NEWTAPE,10,SEPA[*]); 94015000 - END; 94016000 -END OF ESPOL COMPILER. . . . . . 98888888 + B 6 5 0 0 I M P L E M E N T A T I O N L A N G U A G E 00001000 + C 0 M P I L E R 00002000 + 1/68 00003000 + DIRECTORY BY SECTION: 00004000 + 0 COMMENTARY & ERROR MESSAGE CODES. 00005000 + 1 NON-PROCEDURAL DECLARATIONS 00006000 + 2 STREAM PROCEDURES AND FORWARD DECLARATIONS. 00007000 + 3 THE SCANNER 00008000 + 4 THE EMITTERS & SERVICE ROUTINES 00009000 + 5 GENERAL COMPONENTS & EXPRESSIONS 00010000 + 6 STATEMENTS 00011000 + 7 DECLARATIONS 00012000 + 8 SYNTAX CONTROLLERS (BLOCK & STATEMENT) 00013000 + 9 INITIALIZATION AND WRAPUP 00014000 + ERROR NUMBERS (USUALLY) HAVE THE NUMBER OF THE SECTION IN WHICH 00015000 + DETECTED AS THE FIRST DIGIT. 00016000 + 100 UNKNOWN IDENTIFIER. 00100000 + 101 STATEMENT SCANNER SCREWED UP. 00101000 + 102 PRIMARY SCANNER SCREWED UP 00102000 + 103 BOOPRIM SCANNER SCREWED UP. 00103000 + 199 PROCEDURE HAS NOT YET BEEN CODED 00199000 + 300 SCAN IDENTIFIER OR NUMBER OF > 63 CHARACTERS. 00300000 + 301 TABLE ILLEGAL CONSTRUCT. 00301000 + 302 HOOK TOO MUCH NESTING OF DEFINES AND THINGS. 00302000 + 303 TABLE NUMBER IS TOO LARGE. 00303000 + 304 UNHOOK EXTRANEOUS CROSSHATCH OR SOMETHING LIKE THAT. 00304000 + 305 ASSOCIATE MISSING "(" OR "[". 00305000 + 306 ASSOCIATE MISSING ")" OR "]" OR TOO MANY PARAMETERS. 00306000 + 307 GOBBLE INVALID STRING CHARACTER. 00307000 + 308 GOBBLE INVALID STRING CODE OR ILLEGAL STRING SYNTAX. 00308000 + 400 EMITTERS TOO MUCH CODE IN THIS SEGMENT 00400000 + 401 EMITV/N DISPLACEMENT TOO BIG 00401000 + 402 SUBSCRIBER MISSING BRACKET OR SUBSCRIPT. 00402000 + 403 DOTTER EXPRESSION NOT ARITHMETIC. 00403000 + 404 DOTIT "." PERIOD NOT FOLLOWED BY FIELD IDENTIFIER. 00404000 + 405 PURGE LABEL DECLARED FORWARD NOT SEEN 00405000 + 406 PURGE PROCEDURE DECLARED FORWARD NOT SEEN 00406000 + 407 GETSPACE ILLEGAL ADDRESS-PART VALUE. 00407000 + 408 GETSPACE ILLEGAL ADDRESS-PART SYNTAX. 00408000 + 410 GETSPACE TOO MANY STACK CELLS AT THIS LEVEL. 00410000 + 415 GETSTACK TOO MANY TEMPORARIES IN USE AT ONE TIME 00415000 + 501 IFCLAUSE MISSING "THEN". 00501000 + 502 CASEHEAD EXPRESSION NOT ARITHMETIC. 00502000 + 503 CASEHEAD MISSING "OF". 00503000 + 504 IFEXP MISSING "ELSE". 00504000 + 505 EXPRESSION EXPRESSION IS NOT OF REQUIRED TYPE. 00505000 + 506 CASEXP MISSING "(". 00506000 + 507 CASEXP MISSING ")". 00507000 + 508 RELATION THIS EXPRESSION MAY NOT APPEAR IN A RELATION. 00508000 + 509 RELATION THIS RELATION MAY USE ONLY "=" OR "!". 00509000 + 510 RELATION MISSING "FOR" IN STRING RELATION. 00510000 + 511 RELATION ILLEGAL EXPRESSION TYPE. 00511000 + 512 BEXP EXPRESSION NOT BOOLEAN TYPE. 00512000 + 513 AEXP IF EXPRESSION NOT ARITHMETIC TYPE. 00513000 + 514 SIMPARITH ARRAY EXPRESSION MAY NOT BE SIGNED. 00514000 + 515 TERM ARRAY AND WORD EXPRESSIONS MAY NOT BE OPERATED UPON 00515000 + 516 BOOSEC CANT NEGATE AN EXPR UNLESS ITS BOOLEAN. 00516000 + 517 BOOCOMP EXPRESSION NOT BOOLEAN. 00517000 + 518 REXP VARIABLE NOT REFERENCE TYPE. 00518000 + 519 REXP NOT ENOUGH SUBSCRIPTS ON REFERENCE ARRAY. 00519000 + 520 REXP REF EXPR CANT START WITH THIS TYPE IDENTIFIER. 00520000 + 521 REXP EXPRESSION NOT OF TYPE REFERENCE. 00521000 + 522 REXP MISSING ")". 00522000 + 523 REXP CASE EXPR NOT OF TYPE REFERENCE. 00523000 + 524 REXP IF EXPRESSION NOT OF TYPE REFERENCE. 00524000 + 525 REXP REF EXPR CANT START WITH THIS QUANTITY. 00525000 + 526 REXP MISSING "(". 00526000 + 527 REXP CANT TRANSFER THIS TO TYPE REFERENCE. 00527000 + 528 REXP NOT ENOUGH SUBSCRIPTS. 00528000 + 529 VARIABLE REGISTER ASSIGNMENT MUST BE LEFT-MOST ASSIGNMENT. 00529000 + 530 VARIABLE LEFT BRACKET DOES NOT FOLLOW ARRAY IDENTIFIER. 00530000 + 531 VARIABLE FIELD DESIGNATOR IS NOT LEFT-MOST IN LEFT-PART LIST. 00531000 + 532 VARIABLE A PROCEDURE IDENTIFIER IS USED OUTSIDE OF ITS SCOPE. 00532000 + 533 LAYITOUT "&" NOT FOLLOWED BY LAYOUT. 00533000 + 534 LAYITOUT MISSING "(". 00534000 + 535 LAYITOUT MISSING ")". 00535000 + 537 ENTRYEXP NOT YET CODED 00537000 + 538 VARIABLE A VARIABLE IS NOT FOLLOWED BY A REPLACEMENT OPERATOR.00538000 + 539 VARIABLE A READ ONLY ARRAY MAY NOT BE STORED INTO. 00539000 + 540 PEXP EXPRESSION NOT POINTER TYPE. 00540000 + 541 PTRCOMP SKIP PART NOT INTEGER OR REAL EXPRESSION. 00541000 + 542 ITEMREFERENCE INCORRECT SYNTAX FOR AN ITEM REFERENCE 00542000 + 543 ENTRYEXPR INCORRECT SYNTAX FOR ENTRY EXPRESSION 00543000 + 544 LAYITOUT EXPRESSION NOT OF REQUIRED TYPE. 00544000 + 545 VARIABLE POINTER IDENTIFIER MAY NOT BE SUBSCRIPTED. 00545000 + 546 SETVARIABLE CANNOT MIX SETS OF VARYING SIZES IN SAME EXP 00546000 + 547 SETVARIABLE MISSING REPLACEMENT OPERATOR 00547000 + 548 VARIABLE REGISTERS MAY NOT BE PARTIAL FIELDED. 00548000 + 549 ARRAYROW MISSING LEFT BRACKET. 00549000 + 550 ARRAYROW ARRAY ROW MUST HAVE 1 ASTERISK. 00550000 + 551 LONGSTRING TOO MANY STRING CHARACTERS OR MISSING QUOTE. 00551000 + 552 STRINGSOURCE STRING MUST BE 4-, 6- OR 8-BIT CHARACTERS. 00552000 + 553 ARITHCOMP DOUBLE EXPRESSION MAY NOT BE DOTTED. 00553000 + 554 TERM SIMPARITH WORD EXPRESSIONS CONSIST OF WORD PRIMARY ONLY 00554000 + 567 VARIABLE EVENTS MAY NOT BE PARTIAL FIELDED 00567000 + 573 REPLACESTMT UPDATE ON ARITHMETIC SOURCE VALID ONLY FOR UNITS=DIGI00573000 + 574 SUBSCRIBER ACTUAL SUBSCRIPT(S) MUST PRECEDE ROW DESIGNATOR(S). 00574000 + 575 VARIABLE FIELDS MAY NOT BE DUPLICATED AND LOADED. 00575000 + 576 BITFIDDLE MISSING "(". 00576000 + 577 BITFIDDLE MISSING ",". 00577000 + 578 BITFIDDLE BAD BIT NUMBER. 00578000 + 579 BITFIDDLE MISSING ")". 00579000 + 600 CASESTMT MISSING ":". 00600000 + 601 CASESTMT MISSING "BEGIN". 00601000 + 602 CASESTMT TOO MANY STATEMENTS. 00602000 + 603 PROCALL ILLEGAL USE OF PROCEDURE IDENTIFIER 00603000 + 604 PROCALL EITHER ACTUAL AND FORMAL PARAMETERS DO NOT AGREE AS 00604000 + TO NUMBER OR EXTRA RIGHT PARENTHESIS 00604500 + 605 ACTUALPARAPART ACTUAL AND FORMAL ARRAYS DO NOT HAVE SAME NUMBER OF 00605000 + DIMENSIONS 00605500 + 607 ACTUALPARAPART NO ACTUAL PARAMETERS MAY START WITH A QUANTITY OF 00607000 + THIS TYPE 00607500 + 608 FORSTMT IMPROPER FOR INDEX VARIABLE 00608000 + 609 FORSTMT MISSING UNTIL OR WHILE IN STEP ELEMENT 00609000 + 610 FORSTMT MISSING DO IN FOR CLAUSE 00610000 + 611 FORSTMT MISSING LEFT ARROW FOLLOWING INDEX VARIABLE 00611000 + 612 LABELR MISSING COLON 00612000 + 613 LABELR THE LABEL WAS NOT DECLARED IN THIS BLOCK 00613000 + 614 LABELR THE LABEL HAS ALREADY OCCURED 00614000 + 615 GOSTMT LABEL OR CASE DOES NOT FOLLOW GO TO 00615000 + 616 GOSTMT IMPROPER GO TO WITH CASE 00616000 + 617 GOSTMT MISSING "(" 00617000 + 618 GOSTMT ONLY A LABEL MAY APPEAR IN THE LIST 00618000 + 619 GOSTMT MISSING ")" 00619000 + 620 ACTUALPARAPART ACTUAL PARAMETER IS INTRINSIC PROCEDURE (NOT ERROR) 00620000 + 621 ACTUALPARAPART TEMPORARY ABSENCE OF CODE FOR THIS (NOT ERROR) 00621000 + 622 ACTUALPARAPART THE ACTUAL AND FORMAL PARAMETERS DO NOT AGREE AS TO 00622000 + TYPE 00622500 + 623 ACTUALPARAPART ILLEGAL PARAMETER DELIMETER 00623000 + 624 COMPOUNDTAIL MISSING SEMICOLON OR END. 00624000 + 645 COMPOUNDTAIL EXTRA END. 00625000 + 626 COMPOUNDTAIL MISSING END. 00626000 + 628 QALGORITHM THIS ALGORITHM IS NOT VALID FOR THIS QUEUE 00628000 + 629 QALGORITHM MISSING ACTUAL PARAMETER PART IN EXPLICIT CALL 00629000 + 630 QALGORITHM FIRST ACTUAL PARAMETER OF QALGORITHM IS ILLEGAL 00630000 + 631 FORSTMT ILLEGAL FOR CLAUSE 00631000 + 632 FORSTMT ILLEGAL EXPRESSION TYPE 00632000 + 633 QALGORITHM TOO MANY ACTUAL PARAMETERS 00633000 + 634 QALGORITHM ILLEGAL PARAMETER DELIMETER (IN THE BROAD SENSE) 00634000 + 635 QALGORITHM TOO MANY ACTUAL PARAMETERS OR SOMETHING 00635000 + 636 REPLACESTMT POINTER IDENTIFIER REQUIRED. 00636000 + 637 REPLACESTMT MISSING KEY WORD "BY". 00637000 + 638 REPLACESTMT SIMPLE ARITHMETIC VARIABLE REQUIRED. 00638000 + 639 REPLACESTMT MISSING WHILE OR UNTIL CLAUSE. 00639000 + 640 REPLACESTMT RELATIONAL OPERATOR OR IN EXPECTED. 00640000 + 641 REPLACESTMT SET IDENTIFIER REQUIRED. 00641000 + 642 REPLACESTMT PICTURE IDENTIFIER REQUIRED. 00642000 + 643 SCANSTMT POINTER IDENTIFIER REQUIRED. 00643000 + 644 SCANSTMT SIMPLE ARITHMETIC VARIABLE REQUIRED. 00644000 + 645 SCANSTMT CONDITION MISSING. 00645000 + 646 SCANSTMT RELATIONAL OPERATOR OR IN EXPECTED. 00646000 + 647 SCANSTMT SET IDENTIFIER REQUIRED. 00647000 + 648 QALGORITHM BUSY AND SIZE MUST BE USED AS PRIMARIES 00648000 + 649 QALGORITHM INCORRECT USAGE OF UNTYPED QUEUE ALGORITHM 00649000 + 651 REPLACESTMT NUMBER OF CHARACTERS IN THE STRING EXCEEDS LENGTH OF 00650000 + THE ARRAY. 00651000 + 652 REPLACESTMT MISSING LEFT BRACKET. 00652000 + 653 REPLACESTMT SHOULD BE A ROW 00653000 + 654 REPLACESTMT POINTER CANNOT BE UPDATED BY SUBCRIPTED VARIABLE. 00654000 + 655 REPLACESTMT MUST BE A PICTURE ID. 00655000 + 656 FILLSTMT TOO MANY WORDS OF INITIAL VALUES. 00656000 + 657 FILLSTMT INITIAL VALUE MUST BE NUMBER OR STRING. 00657000 + 658 FILLSTMT MISSING RIGHT PARENTHESIS. 00658000 + 659 FILLSTMT ARRAY ROW REQUIRED. 00659000 + 660 FILLSTMT MISSING "WITH". 00660000 + 661 SWAPSTMT MISSING LEFT PARENTHESIS. 00661000 + 662 SWAPSTMT ARRAYID OR SUBARRAY DESIGNATOR REQUIRED. 00662000 + 663 SWAPSTMT MISSING COMMA. 00663000 + 664 SWAPSTMT MISSING RIGHT PARENTHESIS. 00664000 + 665 SWAPSTMT NUMBER OF UNSPECIFIED SUBSCRIPTS MUST AGREE. 00665000 + 666 THRUSTMT MISSING DO IN A THRU CLAUSE 00666000 + 667 FORSTMT MISSING UNTIL FOLLOWING A BY ELEMENT 00667000 + 668 FORSTMT CONTROL VARIABLE IS NOT SIMPLE IN BY ELEMENT LIST 00668000 + 669 QALGORITHM BUZZ IS UNTYPED 00669000 + 670 EVENTINTRINSIC THE PARAMETER MUST BE AN EVENT DESIGNATOR 00670000 + 671 EVENTINTRINSIC THE PARAMETER MUST BE AN INTERRUPT ID 00671000 + 672 EVENTINTRINSIC MISSING LEFT OR RIGHT PARENTHESIS 00672000 + 680 EVENTINTRINSIC SECONDWORD EXPECTS EVENT OR DP PARAMETER 00680000 + 700 IDLIST THIS ID ALREADY DECLARED IN THIS BLOCK. 00700000 + 701 MERRIMAC PARENTHESES PROBLEM. 00701000 + 702 MERRIMAC INCORRECT TYPE OF PROCEDURE OR MONITORED ITEM. 00702000 + 703 FIELDPART INCORRECT "FIELD PART". 00703000 + 704 FIELDER INCORRECT "FIELD" - VALUE OR SYNTAX. 00704000 + 705 LAYOUTDEC INCORRECT "LAYOUT PART" 00705000 + 706 LAYOUTDEC "FIELD VALUE" IS NOT UNSIGNED INTEGER 00706000 + 707 LAYOUTDEC ILLEGAL LAYOUT PART 00707000 + 708 PUTOGETHER TOTAL ALPHA LONGER THAN 2047 CHARACTERS 00708000 + 709 00709000 + 710 DEFINEDEC MISSING EQUAL 00710000 + 711 QUEUEDEC ILLEGAL MULTIPLE USE 0F IDENTIFIER 00711000 + 712 QUEUEDEC MISSING ENTRY DESCRIPTION 00712000 + 713 QUEUEDEC MULTIPLE USE 0F SAME ALGORITHM ID IN QUEUE DEC 00713000 + 714 QUEUEDEC INCORRECT USAGE OF STANDARD QUEUE ALGORITHM 00714000 + 715 QUEUEDEC THIS CONSTRUCT NOT CODED AS YET (NOT ERROR) 00715000 + 717 ARRAYDEC THIS CONSTRUCT NOT CODED AS YET (NOT ERROR) 00717000 + 718 READONLYARRAYDEC ARRAY WORD MISSING. 00718000 + 719 READONLYARRAYDEC IDENTIFIER DECLARED BEFORE. 00719000 + 720 INITIALIZEARRAY MISSING LEFT PARANTHESIS. 00720000 + 721 INITIALIZEARRAY NOT A NUMBER OR A LOGICAL VALUE. 00721000 + 722 INITIALIZEARRAY TOO BIG AN INTEGER. 00722000 + 723 INITIALIZEARRAY MISSING RIGHT PARANTHESIS. 00723000 + 724 ARRAYDEC IDENTIFIER DECLARED BEFORE. 00724000 + 725 ARRAYDEC MORE THAN ONE IDENTIFIER DECLARED BEFORE +. 00725000 + 726 ARRAYDEC MISSING LEFT BRACKET. 00726000 + 727 ARRAYDEC IF YOU KNOW WHAT IT MEANS IMPLEMENT IT. 00727000 + 728 ARRAYDEC MISSING RIGHT BRACKET. 00728000 + 729 ARRAYDEC MISSING SEMICOLON. 00729000 + 730 PROCEDUREDEC PROCEDURE TYPE DIFFERS FROM FORWARD DECLARATION. 00730000 + 731 PROCEDUREDEC PROCEDURE IDENTIFIER ALREADY USED IN THIS BLOCK. 00731000 + 732 PROCEDUREDEC A PARAMETER WAS NOT SPECIFIED. 00732000 + 733 PROCEDUREDEC NUMBER OF PARAMETERS DIFFERS FROM FORWARD DEC. 00733000 + 734 PROCEDUREDEC SPECTEICATION DIFFERS FROM FORWARD DECLARATION. 00734000 + 735 PROCEDUREDEC THIS PROCEDURE WAS ALREAOY DECLARED FORWARD. 00735000 + 736 PROCEDUREDEC MISSING ";" OR "(" AFTER PROCEDURE IDENTIFIER. 00736000 + 737 FMLPARAPART ILLEGAL PAPAMETER DELIMITER. 00737000 + 738 FMLPARAPART MISSING "; " AFTER FORMAL PARAMETER LIST. 00738000 + 739 FMLPARAPART NOT VALID PARAMETER IDENTIFIER. 00739000 + 740 FMLPARAPART MISSING ";" IN SPECIFICATION PART. 00740000 + 741 FMLPARAPART ILLEGAL SPECIFIER OR COMBINATION OF SPECIFIERS. 00741000 + 742 FMLPARAPART TOO MANY ":"S. 00742000 + 743 FMLPARAPART ID NOT FORMAL, OR ALREADY SPECIFIED. 00743000 + 744 FMLPARAPART MISSING "[" IN ARRAY SPECIFICATION. 00744000 + 745 FMLPARAPART ILLEGAL BOUND SPECIFIER. 00745000 + 746 FMLPARAPART MISSING "]" IN ARRAY SPECIFICATION. 00746000 + 747 DEFINEDEC FUNNY PARAMETER. 00747000 + 748 DEFINEDEC MORE THAN 9 DEFINE PARAMETERS. 00748000 + 749 DEFINEDEC MISSING "(". 00749000 + 750 QUEUEDEC MORE THAN 32767 ITEMS 00750000 + 751 QUEUEDEC INCORRECT SYNTAX FOR LOCKING SPECIFICATION 00751000 + 752 QUEUEDEC MISSING RIGHT BRACKET IN SIZE SPECIFICATION 00752000 + 753 QUEUEDEC ILLEGAL SYNTAX FOR QUEUE ARRAY BOUND 00753000 + 756 PICTUREDEC ILLEGAL REPEAT PART VALUE. 00756000 + 757 PICTUREDEC MISSING ")" IN REPEAT PART. 00757000 + 758 PICTUREDEC PICTURE ID ALREADY USED IN THIS BLOCK. 00758000 + 759 PICTUREDEC MISSING "(" AFTER PICTURE ID. 00759000 + 760 PICTUREDEC ILLEGAL PICTURE CHARACTER. 00760000 + 783 IDLIST EVENT MAY NOT HAVE INITIAL VALUE 00783000 + 784 FMLPARAPART THIS ID HAS APPEARRED IN THE VALUE PART. 00784000 + 785 INTERRUPTDEC MISSING EVENT DESIGNATOR 00785000 + 786 INTERRUPTDE C MISSING "ON" OR COLON 00786000 + 787 INTERRUPTDEC MISSING COMMA 00787000 + 788 PROCEDUREDEC PROCEDURE FOR SEPARATED COMPILING CANNOT BE EXTERNAL.00788000 + 789 PROCEDUREDEC PROCEDURE FOR SEPARATED COMPILING CANNOT BE FORWARD. 00789000 + 790 PROCEDUREDEC GLOBAL PROCEDURE SHOULDNT HAVE A BODY. 00790000 + 791 PROCEDUREDEC TOO MANY GLOBAL DECLARATIONS. 00791000 + 800 DECLARATIONS MISSING ";" AFTER DECLARATION. 00800000 + 801 DECLARATIONS ILLEGAL COMBINATION OF DECLARATORS. 00801000 + 802 DECLARATIONS "SAVE" MAY NOT BE USED THIS WAY. 00802000 + 803 DECLARATIONS "OWN" MAY NOT BE USED THIS WAY. 00803000 + 804 STATEMENT UNRECOGNIZABLE STATEMENT STARTER. 00804000 + 805 STATEMENT DECLARATIONS SHOULD PRECEDE STATEMENTS. 00805000 + 806 STATEMENT MISSING "UNTIL" IN DO STATEMENT. 00806000 + 807 STATEMENT MISSING "DO" IN WHILE STATEMENT. 00807000 + 808 PRIMARY NO PRIMARY MAY START THIS WAY. 00808000 + 809 PRIMARY MISSING ")". 00809000 + 810 PRIMARY SOMEBODY GOOFED, SOMEWHERE. 00810000 + 811 PRIMARY ILLEGAL TRANSFER TYPE. 00811000 + 812 PRIMARY MISSING "(". 00812000 + 813 PRIMARY ILLEGAL EXPR TYPE IN TRANSFER FUNCTION. 00813000 + 814 PRIMARY ILLEGAL SECOND EXPRESSION IN TRANSFER FUNCTION. 00814000 + 815 PRIMARY TIMER AND XSIGN MAY NOT BE READ/ MISSING "+". 00815000 + 816 PRIMARY WRONG TYPE EXPRESSION IN REGISTER ASSIGNMENT. 00816000 + 617 BOOPRIM NO PRIMARY STARTS LIKE THIS. 00817000 + 818 BOOPRIM SOMEBODY GOOFED. 00818000 + 819 BOOPRIM MISSING ")". 00819000 + 820 BOOPRIM MISSING "(". 00820000 + 821 BOOPRIM ILLEGAL EXPRESSION TYPE IN TRANSFER FUNCTION. 00821000 + 822 PTRPRIM COMPILER ERROR. 00822000 + 823 PTRPRIM MISSING ")". 00823000 + 824 PTRPRIM CASE EXPRESSION NOT POINTER TYPE. 00824000 + 825 PTRPRIM POINTER PRIMARY CANNOT START WITH THIS. 00825000 + 826 MAKEPOINTER MISSING "(" 00826000 + 827 MAKEPOINTER MUST BE ARRAY IDENTIFIER. 00827000 + 828 MAKEPOINTER MUST BE ARRAY ROW. 00828000 + 829 MAKEPOINTER MUST BE ONE-DIMENSIONAL ARRAY. 00829000 + 830 MAKEPOINTER MISSING ")" 00830000 + 831 SETPRIM MISSING RIGHT PARENTHESIS 00831000 + 833 MAKEPOINTER CHARACTER SIZE MUST BE LITERAL 4, 6 OR 8. 00833000 + 834 BOOPRIM EXPRESSION BEFORE "IN" MUST BE POINTER OR SINGLE 00834000 + 835 BOOPRIM SET IDENTIFIER REQUIRED AFTER "IN". 00835000 + 836 STATEMENT HAPPENED AND AVAILABLE ARE BOOLEAN INTRINSICS 00836000 + 837 BOOPRIM THIS EVENT INTRINSIC IS UNTYPED 00837000 + 838 DECLARATIONS NOTHING BUT PROCEDURES CAN BE SEPARATELY COMPILED. 00838000 + 839 DECLARATIONS NO SAVE PROCEDURE CAN BE SEPARATELY COMPILED 00839000 + 840 DECLARATIONS NO "OWN" DEC IS PERMITTED IN SEPAR. COMPILATION 00840000 + 841 DECLARATIONS NO "VALUE" DEC IS PERMITTED IN SEPAR. COMPILATION 00841000 + 850 GLOBALDECLARATIONS ILLEGAL GLOBAL DECLARATION FOR SEPARATED COMPILE00850000 + 851 GLOBALDECLARATIONS MISSING SEMICOLON ON GLOBAL DECLARATION. 00851000 + 852 GLOBALDECLARATIONS ARRAY ID ALREADY DECLARED OR MISSING. 00852000 + 853 GLOBALDECLARATIONS MISSING "[" IN ARRAY DECLARATION. 00853000 + 854 GLOBALDECLARATIONS ILLEGAL BOUND SPECIFIER. 00854000 + 855 GLOBALDECLARATIONS MISSING "]" IN ARRAY DECLARATION. 00855000 + 856 GLOBALDECLARATIONS GLOBAL ID ALREADY DECLARED OR MISSING. 00856000 + 857 GLOBALDECLARATIONS TOO MANY GLOBAL DECLARATIONS. 00857000 + 858 SEPARATEDCOMPILING MISSING SEMICOLON AFTER LAST "END" OF PROCEDURE.00858000 + 900 QUEUEDEC MISSING SPECIFICATION IN FORMAL ITEM LIST. 00900000 + 921 GENMICRO REPEAT } 65535. 00921000 + 922 PICTUREDEC EXTRANEOUS ( IN PICTURE (INVALID REPEAT PART). 00922000 + 923 REPLACESTMT MISSING ")". 00923000 + 924 PICTUREGEN MISSING ",". 00924000 + 925 PICTUREGEN MISSING EXPRESSION. 00925000 + 926 PICTUREGEN MISSING ")". 00926000 +COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 10003000 + NON-PROCEDURAL DECLARATIONS 10004000 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;10005000 +BEGIN 10006000 + INTEGER ERRORCOUNT; % NUMBER OF ERROR MESSAGES GIVEN. 10007000 +BOOLEAN DONSBUG; % PRT 26 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%10008000 + REAL PRT27; COMMENT SEQUENCE NUMBER%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%; 10008100 + FILE IN CARD (5,10); % CARD INPUT 10009000 + FILE IN TAPE DISK SERIAL (2,10,150); 10010000 + SAVE FILE NEWTAPE DISK SERIAL [20:3000] 10011000 + (2,10,150,SAVE 10);% NEW SRCE10012000 + SAVE FILE CODE DISK [20:1250 ] (4,30,SAVE 100);%FINAL 10013000 + FILE TEMP DISK SERIAL[20:200]"TEMP""CODE"(2,30,150,SAVE 100); 10014000 + FILE LINE 4 "6500MCP" "LISTING" (3,17); 10015000 + SAVE FILE INFOUT DISK SERIAL[4:128]"MCP""GLOBALS"(2,256,SAVE 10); 10015100 + FILE INFIN DISK SERIAL "MCP""GLOBALS"(2,256); 10015200 + FILE DECK "ESPOL""DECK" (2,20,SAVE 10); 10015900 +% SCANNER VARIABLES 10016000 + INTEGER NCR, % POINTS TO NEXT CHAR TO BE SCANNED. 10017000 + FCR, % POINTS TO FIRST CHAR CURRENT ID OR NR. 10018000 + LCR, % POINTS TO SEQ NR CURRENT RECORD, 10019000 + CLCR, % POINTS TO SEQ NR CURRENT CARD RECORD. 10020000 + TLCR, % POINTS TO SEQ NR CURRENT TAPE RECORD. 10021000 + CONTEXT, % USED BY THE COMPILER TO TELL THE SCANNER 10022000 + % WHAT TO DO: 10023000 + %0=DECLARATIONS (GLOBAL IDS UNKNOWN) 10024000 + %1=SPECIFICATIONS 10025000 + %2=STATEMENTS & EXPRESSIONS 10026000 + %3=END COMMENTARY 10027000 + SCRAM, % SCRAMBLE INDEX OF LAST THING SEEN. 10028000 + COUNT, % SIZE OF LAST THING SCANNED. 10029000 + I, % SCAN POINTER FOR CURRENT ITEM. 10030000 + NXTELBT, % NEXT AVAILABLE WORD IN ELBAT. 10031000 + ELCLASS, % ELBAT[I].CLASS 10032000 + RESULT, % WHAT SCAN FOUND OR IS TO LOOK FOR. 10033000 + LASTUSED, % REMEMBERS WHERE THE LAST RECORD COME FROM10034000 + %1=CARD (ONLY) 10035000 + %2=CARD (INSERT WITH TAPE) 10036000 + %3=CARD PATCHING TAPE 10037000 + %4=TAPE WITH CARD WAITING. 10038000 + %5=TAPE-RAN OUT OF CARDS. 10039000 + % >5 IS INFO INDEX OF DEFINED STUFF. 10040000 + CARDCOUNT, % JUST WHAT IT SAYS. 10041000 + SCANCOUNT, % NUMBER OF CALLS ON TABLE 10042000 + DEFINECTR, % LEVEL OF DEFINE DFCL NESTING. 10043000 + DEFINEINDEX, % TOP OF DEFINEARRAY. 10044000 + TCOUNT, % PREVIDUS COUNT, SOMETIMES. 10045000 + LASTSEQUENCE; % ADDRESS OF LAST SEQUENCE NUMBER SEEN. 10046000 + % +1 IS VOID SEQ NR. 10047000 + % +2 IS ERROR SEQ NR. 10048000 + REAL C, % VALUE OF LAST CONSTANT. 10049000 + T, % TEMP FOR NUMBER CONVERSION. 10050000 + THI, 10051000 + TLO, 10052000 + NHI, 10053000 + NLO, 10054000 + SPEC, % "SPECIAL" WORD FOR CURRENT CHARACTER 10055000 + SEQNUMBER, % CURRENT SEQUENCE NUMBER. 10056000 + VOIDNUMBER, % VOID SEQUENCE NUMBER. 10057000 + ERRSEQNUMBER; % ERROR SEQUENCE NUMBER. 10058000 + ARRAY SPECIAL[0:63], % SPECIAL-CHARACTER INFO. 10059000 + INFO[0:127,0:255], % ALL WE KNOW ABOUT EVERYTHING 10060000 + ADDL[0:127,0:255], % IS IN INFO AND ADDL 10061000 + STACKHEAD[0:124], % ASSORTED LIST HEADS. 10062000 + ELBAT[0:75]; % THE WINDOW BETWEEN THE SCANNER & COMPILER10063000 + BOOLEAN LISTOG,SEQ, % SUNDRY OUTPUT TOGGLES 10064000 + DECKTOG, 10064100 + VOIDING, % --AND INPUT TYPES, TOO. 10065000 + PRTOG,RESEQTOG, 10066000 + SEPARATOG, % SEPARATED COMPILATION OF PROCEDURES. 10066100 + % <0: AVAILABLE FOR SETTING BY $-CARD 10066101 + % =2: GLOBAL DECLARATION TIME 10066102 + % =1: SEPARATED PROCEDURE COMPILING TIME 10066103 + % =0: REGULAR COMPILING 10066104 + % =4: INSIDE SEPARATED PROCEDURE COMPILING 10066105 + SVINFOTOG, % INFO & ADDL TO BE SAVED ON CODE FILE 10066200 + % <0: AVAILABLE FOR SETTING BY $-CARD 10066201 + % =0: RESET, INFO & ADDL NOT SAVED GENERALY10066202 + % =1: SET, INFO & ADDL SAVED UNCONDITIONAL 10066203 + DEBUGTOG, 10067000 + DUMPTOG, 10068000 + NOJUMPTOG, 10068500 + ENDTOG, 10069000 + INFOTOG,SAVETOG, 10069100 + LISTING, 10069200 + POOLTOG, 10069300 + NEWTOG; 10070000 + ALPHA Q; % ACCUM[1] OF LAST ID-TYPE THING. 10071000 + INTEGER ACCUMSTART, % ABS ADDRESS OF ACCUM[1].[18:6] 10072000 + ACCUMINX, % ABS ADDRESS OF END OF ACCUMED BLOB 10073000 + BUMPCHAR, % CONSTANT 32768 , @100000 10074000 + BUMPWORD; % CONSTANT 229375, @677777 10075000 + INTEGER CSZ; COMMENT STRING CHARACTER SIZE; 10075100 + INTEGER MAXCSZ; COMMENT MAX STRING CHAR SIZE IN CURRENT STRING; 10075200 + BOOLEAN LEFTY; COMMENT TRUE IFF STRING IS LEFT JUSTIFIED; 10075300 + BOOLEAN LITERALS; % TO KEEP PEOPLE HONEST ON IN LINE FIELDS, ETC. 10075350 + DEFINE DEFAULTSIZE = 6#; %DEFAULT STRING SIZE -- NOT ALL REFERENCES****10075400 + SAVE ARRAY ACCUM[0:10]; % WHAT THE SCANNER FOUND 10076000 + ALPHA CHR; % USUALLY THE NEXT CHARACTER TO BE SCANNED 10077000 + DEFINE STEPNCR=NCR~(IF NCRPTRID THEN 10136000 + GIT(TAKE(BOUND1)).NODIM ELSE 0 ELSE 0#; 10136100 +COMMENT THESE ARE THE FIELDS IN ADDL ENTRIES THAT ARE USED BY DEFINE, 10137000 + FIELD AND LAYOUT. ;10138000 + DEFINE LAYINIT =[ 7: 1]# % IF = 1, NEXT ADDL ENTRY IS INITIAL VALUE 10139000 + ,LAYCODE =[ 8: 8]# % FIELDV OR TAGV (LAYOUT ONLY) 10140000 + ,LAYAEXP =[16:16]# % EXP FOR STARTING BIT 10141000 + , LAYLTA=[16: 1]# % IF = 1 LAYLNA IS THE LITERAL OTHERWISE 10142000 + % LAYLNA POINTS TO TEXT FOR ARITH EXP 10143000 + , LAYLNA=[17:15]# 10144000 + ,LAYBEXP =[32:16]# % EXP FOR NUMBER OF BITS 10145000 + , LAYLTB=[32: 1]# % SEE LAYLTA 10146000 + , LAYLNB=[33:15]# 10147000 + ,STARTBIT =[ 9: 6]#%STARTING BIT FOR BIT OPERATORS - INFO.DISP 10148000 + ,NOOFBITS =[15: 6]#%NUMBER OF BITS FOR BIT OPERATORS - INFO.DISP10149000 + ; 10150000 + REAL KLASSF, % CLASS IN LOW ORDER 7 BITS 10151000 + TYPEF, % TYPE IN LOW ORDER 3 BITS 10152000 + ADDRSF; % ADDRESS IN LOW ORDER 19 BITS 10153000 + BOOLEAN FORMALF, % FML BIT OF ELBAT WORD 10154000 + ITEMF, % QBIT OF ELBAT WORD 10154100 + VONF; % VAL BIT OF ELBAT WORD 10155000 + SAVE ARRAY DEFINEARRAY [0:47]; % FOR SCANNING DEFINDIDS 10156000 + BOOLEAN MACRO; COMMENT - FALSE IF SCANNING ACTUAL SYMBOL LIST.; 10157000 + ARRAY DEFINFO [0:89]; % DEFINE PARAMETER IDS ETC. NO. IDS{9 10158000 + % ALPHA TEXT TO ADDL VARIABLES 10159000 +INTEGER NEXTCHAR, % NEXT AVAILABLE CHAR IN ADDL 10160000 + % 30:15 ADDL INDEX 10161000 + % 45: 3 CHARACTER WITHIN ADDL INDEX 10162000 + REMCOUNT, % NUMBER OF 6-BIT CHARACTER POSITIONS IN AN ADDL10163000 + % ROW 10164000 + CHARCOUNT; % TOTAL NUMBER OF CHARACTERS INSERTED IN ADDL 10165000 + % BY A GIVEN CALL ON TEXT. 10166000 +BOOLEAN BADSTUFF; % ALPHA LONGER THAN 2047 CHARACTERS (TOTAL) 10167000 + COMMENT DEFINES FOR PARAMETERS TO TEXT 10168000 + DEFINFV ;10169000 + DEFINE FIELDEXPA = DEFINEV + 1#, 10170000 + LAYEXPA = FIELDEXPA #, 10171000 + FIELDEXPB = DEFINEV + 2#, 10172000 + LAYEXPB = DEFINEV + 3#; 10173000 + INTEGER N; % SCRATCH 10174000 + REAL GT1,GT2,GT3,GT4,GT5; % SCRATCH 10175000 + REAL QGT1; %USED IN QUEUEDEC TO REPLACE GT1 10175500 + BOOLEAN TB1; % SCRATCH 10176000 + BOOLEAN ERRORTOG; 10177000 +BOOLEAN ARRAYDECTOG; %ARRAYDEC IN BLOCK 10177400 +DEFINE BLOCKEXITPCW=10#; %PCW FOR BLOCKEXIT IN (0,12) 10177600 +DEFINE GOTOSOLVERPCW=11#; % PCW FOR GOTOSOLVER IN (0,13) 10177700 + BOOLEAN DONE, SAVED; 10178000 + BOOLEAN FLAGS; 10179000 + DEFINE DPTOG = FLAGS.[45:1]#, 10179100 + STRINGSOURCEFLAG = FLAGS.[46:1]#, 10179110 + DEFINESFLAG = FLAGS.[44:1]#, 10179120 + THIFLAG = FLAGS.[46:1]#, 10179200 + TLOFLAG = FLAGS.[47:1]#; 10179300 + DEFINE WRITELBUFF=WRITE(LINE[DBL],17,LBUFF[*])#; 10180000 + INTEGER DEFINEADDR; % ADDRESS OF DEFINEARRAY[0] 10181000 + ARRAY TEN[0:68]; % POWERS OF TEN 10182000 + DEFINE BUMPL= L~L+3#; 10183000 + DEFINE INDXCHK=IF LASTINDEX=L-1 THEN IF GET(L~L-1)=NXLV THEN EMIT(INDX)10183300 + ELSE L~L+1 ELSE#; 10183500 +COMMENT VARIABLE SOMETIMES ISSUES NXLV RATHER THAN INDX; 10183510 + DEFINE STUFF = EMIT(STFF)#; 10183540 + DEFINE ANEVENT = EVENTID AND (GT1~ELBAT[I]).TYPE! 10183560 + FORMALNAMEQ#; 10183580 + ARRAY EDOC[0:31,0:255]; % CODE ACCUMULATED FOR CURRENT SEG 10184000 + ARRAY INZCODE[0:31,0:255]; COMMENT EDOC FOR "SAVE 1" PROCEDURES; 10184100 + INTEGER SAVEL; COMMENT L FOR INZCODE; 10184200 + INTEGER CURRENT, % CURRENT ADDRESSING LEVEL 10185000 + STATE, 10186000 + MAXDISP , % MAXIMUM DISPLACEMENT FOR CURRENT LEVEL 10187000 + LLMASK; % INVERTED ADDRESSING-LEVEL, FOR VALC,ETC10188000 + INTEGER MODE; 10189000 + INTEGER CSTATE; 10190000 + DEFINE S0 = 128#; % INITIAL SIZE OF D0 - STACK 10190050 +%%%%%%%%%%%%%%%%%%%%%% FOR SEPARATED COMPILATION %%%%%%%%%%%%%%%%%%%%%%%10190100 + FILE SEPF DISK SERIAL[20:300](2,30,150); 10190110 + ARRAY SEPA[0:29] % SEPARATED COMPILING INFORMATION (2-WDS/LEVEL) 10190120 + ,SEPSTR[0:12] % INFORMATION STORAGE IN BETWEEN SEP. PROCEDURES10190130 + ,AY[0:29] % SRATCH ARRAY. 10190140 + ; 10190150 + REAL GLOBLCNT % COUNT OF GLOBALS IN A SEPARATED COMPILATION 10190160 + ,GINFO % STARTING INFO INDEX OF GLOBALS 10190170 + ,GADDL % STARTING ADDL INDEX OF GLOBALS 10190180 + ,PCW % PCW WHICH JUST HAS BEEN EMITED BY "EMITPCW" 10190190 + ,SEPAX % CURRENT SEPA[*] INDEX 10190200 + ,SEPFX % CURRENT SEPF-RECORD INDEX 10190210 + ,TOTALSEGSIZE % TOTAL SEGMENT SIZE 10190213 + ,CORESIZE % THIS IS NOT FOR SEPARATED COMPILING ONLY 10190217 + ; 10190220 + DEFINE ENTERSEPA(ENTERSEPA1,ENTERSEPA2,ENTERSEPA3) = 10190230 + IF REAL(SEPARATOG)=4 THEN 10190240 + IF ERRORCOUNT=0 THEN 10190250 + BEGIN 10190260 + SEPA[SEPAX ]~PCW&SEGNO[01:37:11]; 10190270 + SEPA[SEPAX+1]~ENTERSEPA1&ENTERSEPA2[19:32:16]& 10190280 + ENTERSEPA3[03:32:16]; 10190290 + IF SEPAX~SEPAX+2}30 THEN 10190300 + BEGIN 10190310 + WRITE(SEPF,30,SEPA[*]); 10190320 + SEPFX~SEPFX+15; 10190330 + SEPAX~0; 10190340 + END; 10190350 + END#; 10190360 + DEFINE DKADDR=TEMPADDR#; % TEMP DISK FILE ADDRESS 10190365 + DEFINE SEPLEVEL=3#; % RUNNING LEVEL OF OUTER MOST BLOCK OF PROCEDURE10190380 + FORMAT GFMT(X4,"GLOBAL=(02,0",A4,")"); 10190390 + DEFINE GLOBALINDEX = IF PRTOG THEN WRITE(LINE[DBL],GFMT,O(GLOBLCNT))#;10190400 +%%%%%%%%%%%%%%%%%%% END OF FOR SEPARATED COMPILATION %%%%%%%%%%%%%%%%%%%10190498 +% 10190499 +%%%%%%%%%%%%%%%%%%%%%%%% FOR EXTERNAL PROCEDURE %%%%%%%%%%%%%%%%%%%%%%%%10190600 + FILE INFF DISK SERIAL[20:1500](2,30,150); % SAVE INFO FILE 10190610 + ARRAY INFD[0:15,0:255] % SAVE INFO DIRECTORY 10190620 + ; 10190630 + REAL STARTINFO % STARTINFO INFO INDEX OF THE PROGRAM 10190640 + ,STARTADDL % ARTINFO ADDL INDEX OF THE PROGRAM 10190650 + ,EXTRNLCNT % EXTERNAL PROCEDURE COUNT 10190660 + ,LASTEXT % INDEX OF INFO[*] OF THE LAST EXTERNAL PROC 10190661 + ,INFFX % RECORD INDEX OF INFF FILE 10190662 + ,INFDX % WORD INDEX OF INFO[*] 10190664 + ; 10190670 + BOOLEAN SVINFO % INFO & ADDL TO BE SAVED FOR THIS CURRENT LEVEL10190680 + ,XTRNL % EXTERNAL PROCEDURE 10190682 + ; 10190690 +%%%%%%%%%%%%%%%%%%%% END OF FOR EXTERNAL PROCEDURE %%%%%%%%%%%%%%%%%%%%%10190998 +% 10190999 + REAL COUNTQALG, % COUNT OF NO. OF NON STANDARD Q ALGORITMS ENCOUNT- 10191000 + % ERED AT A GIVEN LEVEL. INITIALISED TO STARTNSQ AT 10192000 + % BLOCK ENTRY AND UPDATED BY 1 EACH TIME NON STANDARD10193000 + % ALGORITHM ENCOUNTERED. UNIQUE IDENTIFICATION OF 10194000 + % Q ALGORITHM ID AT ANY LEVEL 10195000 + PCL, 10195500 + INVISIBLE; % POINTS TO INFO ENTRY OF FIRST INVISIBLE ITEM AFTER 10196000 + % SPECPART HAS PROCESSED Q ENTRY DESCRIPTION 10197000 + BOOLEAN FIXCALL % FALSE IF FIX CALLED FROM STATEMENT. 10197200 + % ALTERNATIVE IS TO PASS PARAMETER TO 10197220 + % EVENT INTRINSIC 10197240 + ; 10197260 + DEFINE STARTNSQ = 511#;%UPPER LIMIT ON NUMBER OF STANDARD Q ALGORITHMS10197300 + ARRAY QALGORYTHM [0:19]; % DO NOT EXPAND BOUND BEYOND 62 10198000 +COMMENT ONE ENTRY OF ONE OR TWO WORDS PER STANDARD Q ALGORITHM WITH 10199000 + FIRST WORD HAVING FOLLOWING FIELDS; 10200000 + DEFINE ALGKEY = [6:6]#, % FIELD FOR ALGORITHM IDENT 10201000 + ALGTIPE = [12:3]#, % FIELD FOR ALGORITHM TYPE 10202000 + ALGPD = [15:3]#, % FIELD FOR PARAMETER DESCRIPTION10203000 + NOWORDS = [4:1]#; % NUMBER OF WORDS IN THIS ENTRY 10204000 + DEFINE MAXQALG= 19#; % NUMBER OF ENTRIES IN QALGORYTHM 10205000 + ALPHA ARRAY OPS[0:768]; % OPERATOR MNEMONICS FOR BUGOUT 10206000 + DEFINE VALC= 63#,NAMC=127#,ADD =128#,SUBT=129#,MULT=130#,DIVD=131#,10207000 + IDIV=132#,RDIV=133#,NTIA=134#,NTGR=135#,LESS=136#,GREQ=137#,GRTR=138#,10208000 + LSEQ=139#,EQUL=140#,NEQL=141#,CHSN=142#,MULX=143#,LAND=144#,LOR =145#,10209000 + LNOT=146#,LEQV=147#,SAME=148#,VARI=149#,BSET=150#,DBST=151#,FLTR=152#,10210000 + DFTR=153#,ISOL=154#,DISO=155#,INSR=156#,DINS=157#,BRST=158#,DBRS=159#,10211000 + BRFL=160#,BRTR=161#,BRUN=162#,EXIT=163#,STBR=164#,NXLN=165#,INDX=166#,10212000 + RETN=167#,DBFL=168#,DBTR=169#,DBUN=170#,ENTR=171#,EVAL=172#,NXLV=173#,10213000 + MKST=174#,STFF=175#,ZERO=176#,ONE =177#,LT8 =178#,LT16=179#,PUSH=180#,10214000 + DLET=181#,EXCH=182#,DUPL=183#,STOD=184#,STON=185#,OVRD=186#,OVRN=187#,10215000 + LOAD=189#,LT48=190#,MPCW=191#,SCLF=192#,DSLF=193#,SCRT=194#,DSRT=195#,10216000 + SCRS=196#,DSRS=197#,SCRF=198#,DSRF=199#,SCRR=200#,DSRR=201#,ICVD=202#,10217000 + ICVU=203#,SNGT=204#,SNGL=205#,XTND=206#,IMKS=207#,TEED=208#,PACD=209#,10218000 + EXSD=210#,TWSD=211#,TWOD=212#,SISO=213#,SXSN=214#,ROFF=215#,TEEU=216#,10219000 + PACU=217#,EXSU=218#,TWSU=219#,TWOU=220#,EXPU=221#,RTFF=222#,HALT=223#,10220000 + TLSD=224#,TGED=225#,TGTD=226#,TLED=227#,TEQD=228#,TNED=229#,TUND=230#,10221000 + TLSU=232#,TGEU=233#,TGTU=234#,TLEU=235#,TEQU=236#,TNEU=237#,TUNU=238#,10222000 + CLSD=240#,CGEQ=241#,CGTD=242#,CLED=243#,CEQD=244#,CNED=245#,CLSU=248#,10223000 + CGEU=249#,CGTU=250#,CLEU=251#,CEQU=252#,CNEU=253#,NOOP=254#,NVLD=255#,10224000 + JOIN=322#,SPLT=323#,IDLE=324#,SINT=325#,EEXI=326#,DEXI=327#,SCNI=33O#,10225000 + SCNO=331#,WHOI=334#,HEYU=335#,NTGD=385#,OCRX=389#,LOG2=395#,IRWL=429#,10226000 + PCWL=430#,MVST=431#,STAG=436#,RTAG=437#,RSUP=438#,RSDN=439#,RPRR=440#,10227000 + SPRR=441#,RDLK=442#,CBON=443#,LODT=444#,LLLU=445#,SRCH=446#,USND=464#,10228000 + UABD=465#,TWFD=466#,TWTD=467#,SWFD=468#,SWTD=469#,TRNS=471#,USNU=472#,10229000 + UABU=473#,TWFU=474#,TWTU=475#,SWFU=476#,SWTU=477#,SLSD=496#,SGED=497#,10230000 + SGTD=498#,SLED=499#,SEQD=500#,SNED=501#,SLSU=504#,SGEU=505#,SGTU=506#,10231000 + SLEU=507#,SEQU=508#,SNEU=509#,MINS=720#,MFLT=721#,SFSC=722#,SRSC=723#,10232000 + RSTF=724#,ENDF=725#,MVNU=726#,MCHR=727#,INOP=728#,INSG=729#,SFDC=730#,10233000 + SRDC=731#,INSU=732#,INSC=733#,ENDE=734#; 10234000 + DEFINE UNKNOWNID = 0#, 10235000 + FORMALID = 1#, 10236000 + FIELDID = 2#, 10237000 + EVENTID = 3#, 10238000 + LAYOUTID = 4#, 10239000 + PROCID = 5#, 10240000 + LABELID = 6#, 10241000 + DEFINDID = 7#, 10242000 + BOOPROCID = 8#, 10243000 + DPPROCID = 9#, 10244000 + REALPROCID = 10#, 10245000 + INTPROCID = 11#, 10246000 + REFPROCID = 12#, 10247000 + WORDPROCID = 13#, 10248000 + PTRPROCID = 14#, 10249000 + BOOID = 15#, 10250000 + DPID = 16#, 10251000 + REALID = 17#, 10252000 + INTID = 18#, 10253000 + REFID = 19#, 10254000 + WORDID = 20#, 10255000 + PTRID = 21#, 10256000 + BOOARRAYID = 22#, 10257000 + DPARRAYID = 23#, 10258000 + REALARRAYID = 24#, 10259000 + INTARRAYID = 25#, 10260000 + REFARRAYID = 26#, 10261000 + WORDARRAYID = 27#, 10262000 + PCID = 28#, 10263000 + BOOROAID = 29#, 10264000 + DPROAID = 30#, 10265000 + REALROAID = 31#, 10266000 + INTROAID = 32#, 10267000 + EVENTARRAYID = 33#, 10268000 + QUEUEARRAYID = 34#, 10269000 + REGID = 35#, 10270000 + QUEUEID = 36#, 10271000 + NULLV = 37#, 10272000 + TRUTHV = 38#, 10273000 + NUMBER = 39#, 10274000 + STRNGCON = 40#, 10275000 + QALGID = 42#, 10277000 + INTERRUPTID = 43#, 10278000 + INTRINSICEVENT = 44#, 10279000 + WORDV = 45#, 10280000 + LOCKEDV = 46#, 10281000 + STRING = 47#, 10282000 + LFTPRN = 48#, 10283000 + CASEV = 49#, 10284000 + BEGINV = 50#, 10285000 + ONV = 51#, 10286000 + DOV = 52#, 10287000 + IFV = 53#, 10288000 + GOV = 54#, 10289000 + THRUV = 55#, 10290000 + FORV = 56#, 10291000 + WHILEV = 57#, 10292000 + SCANV = 58#, 10293000 + REPLACEV = 59#, 10294000 + FILLV = 60#, 10295000 + SWAPV = 61#, 10296000 + SEMICOLON = 62#, 10297000 + ENDV = 63#, 10298000 + UNTILV = 64#, 10299000 + ELSEV = 65#, 10300000 + DOLLAR = 66#, 10301000 + COMMENTV = 67#, 10302000 + ADDOP = 68#, 10303000 + TYPEV = 69#, 10304000 + FIELDV = 70#, 10305000 + ARRAYV = 71#, 10306000 + OWNV = 72#, 10307000 + DEFINEV = 73#, 10308000 + LABELV = 74#, 10309000 + PROCV = 75#, 10310000 + SAVEV = 76#, 10311000 + LAYV = 77#, 10312000 + EVENTV = 78#, 10313000 + QUEUEV = 79#, 10314000 + ENTERRUPT = 80#, 10315000 + PITCHER = 81#, 10316000 + MONITORV = 83#, 10318000 + VALUEV = 84#, 10319000 + INV = 85#, 10320000 + CROSSHATCH = 86#, 10321000 + ATSIGN = 87#, 10322000 + PERCENT = 88#, 10323000 + PERIODV = 89#, 10324000 + STEPV = 90#, 10325000 + TOV = 91#, 10326000 + BYV = 92#, 10327000 + OVERITE = 93#, 10328000 + WITHV = 94#, 10329000 + USING = 95#, 10330000 + TAGV = 96#, 10331000 + FACTOP = 97#, 10332000 + LFTBRKT = 98#, 10333000 + QUESTIONMK = 99#, 10334000 + COMMA = 100#, 10335000 + RTPARN = 101#, 10336000 + RTBRKT = 102#, 10337000 + COLON = 103#, 10338000 + THENV = 104#, 10339000 + EXTERNALV = 105#, 10340000 + FORWARDV = 106#, 10341000 + OFV = 107#, 10342000 + NOTOP = 108#, 10343000 + ASSNOP = 109#, 10344000 + AMPERSAND = 110#, 10345000 + LOGOP = 111#, 10346000 + RELOP = 112#, 10347000 + MULOP = 113#, 10348000 + DEFINEP = 114#; 10349000 +DEFINE DIGIT = 0#, 10350000 + LETTER = 1#, 10351000 + SPASE = 2#, 10352000 + BOOV = 0#, 10353000 + DPV = 1#, 10354000 + REALV = 2#, 10355000 + INTV = 3#, 10356000 + REFV = 4#, 10357000 + WDV = 5#, 10358000 + PTRV = 6#; 10359000 + DEFINE FS=0#, % CALLS ON VARIABLE: STATEMENT 11000000 + FP=1#, % PRIMARY 11001000 + FL=2#, % ACTUAL PARAPART 11002000 + FR=3#; % FOR STATEMENTRT 11003000 +DEFINE INCR = 7 #, 11003300 + INCRTWICE = 14 #; 11003600 +% TYPE FIELD VALUES 11004000 + DEFINE FORMALNAMEP = 2#, 11005000 + FORMALNAMEQ = 6#, 11006000 + FORMALVALUEP= 3#, 11007000 + FORMALVALUEQ= 7#, 11008000 + LOCALTYPE = 0#, 11009000 + WITHINBODY = 1#, 11010000 + F0RWARD = 4#, 11011000 + INTRINSIC = 5#; 11012000 + DEFINE IDMAX = QUEUEID #; 11013000 + DEFINE MINDEC = TYPEV#, MAXDEC = VALUEV#; 11014000 + INTEGER NEXTINFO, % POINTS TO NEXT HOLE IN INFO 11015000 + NINFOO, % POINTS TO START OF INFO ENTRIES FOR 11016000 + % CURRENT BLOCK. 11017000 + NEXTADDL, % POINTS TO NEXT SPOT IN ADDL. 11018000 + LASTADDL, 11018100 + RSVDX, %%%%%%%%%%%%%%%%%%%% KLUDGE%%%%%%%%%%%%%%% 11019000 + LASTINFO; % POINTS TO LAST ENTRY IN INFO. 11020000 + DEFINE GLOBAL=0#; % OUTERMOST ADDRESSING LEVEL. 11021000 + BOOLEAN GTB1; % TEMP FREE-FOR-ALL 11022000 + INTEGER LASTNOT; % USUALLY POINTS JUST BEYOND LAST LNOT 11023000 + % OR RELOP. USED BY EMITNOT TO 11024000 + % OPTIMISER A LITTLE. 11025000 + INTEGER LASTINDEX; % USUALLY POINTS AT TWE LAST SUBSCRIPTING 11026000 + % OPERATOR, SO THE ACTUALPARAPART CAN CALL 11027000 + % THINGS BY NAME. 11028000 + INTEGER BEGINCTR; 11029000 + DEFINE DTYPE = ETYPE#; 11030000 + DEFINE EVENTINTRINSICID = INTRINSICEVENT#, 11030300 + INTERRUPTV = ENTERRUPT#; 11030800 + INTEGER ADRCPL; % SCRATCH FOR EMITTERS. 11031000 + DEFINE ATYPE = REALV#, % TYPES OF EXPRESSIONS: S.P. ARITH-REAL 11032000 + BTYPE = BOOV#, % BOOLEAN 11033000 + ITYPE = INTV#, % INTEGER 11034000 + ETYPE = DPV#, % D.P. ARITH 11035000 + RTYPE = REFV#, % REFERENCE 11036000 + PTYPE = PTRV#, % POINTER 11037000 + WTYPE = WDV#, 11037500 + XTYPE = 0#; % ARRAY 11038000 + COMMENT NOTE THAT AN ARRAY EXPRESSION IS GIVEN BY A TYPE < XTYPE. 11039000 + THE VALUE OF TYPE IS -(NUMBER OF DIMENSIONS LEFT) - 11040000 + (TYPE OF ARRAY) |32768; 11041000 +DEFINE PROCD = 6# 11042000 + ; 11043000 + DEFINE ARAYTPE = [30:3]#, % TYPE FIELD FOR EXPRSS VALUE FOR ARRAYS 11044000 + ARAYDIM = [33:15]#; % NO OF DIMENSIONS ASSOCIATED WITH ARAYTYPE 11045000 + DEFINE EMITLINK = EMIT3#; 11046000 + DEFINE EMITO = EMIT#; 11047000 + DEFINE ENABLEKEY = 20# 11047100 + , DISABLEKEY= 21# 11047200 + , SETKEY = 10# 11047300 + , RESETKEY = 11# 11047400 + , CAUSEKEY = 0# 11047500 + , WAITKEY = 1# 11047600 + , FIXKEY = 14# 11047700 + , FREEKEY = 15# 11047800 + , HAPPENEDKEY= 30# 11047900 + , AVAILABLEKEY= 31# 11047950 + ,SECONDWORDKEY=40# 11047960 + , STOREITEMKEY= 50# 11047970 + ; 11047980 + DEFINE INSERTKEY =0# % KEY FOR INSERT ALGORITHM 11048000 + ,ALLOCATEKEY =3#; % KEY FOR ALLOCATE ALGORITHM 11049000 + DEFINE SIZEKEY =15# % KEY FOR SIZE ALGORITHM/PROPERTY 11049100 + ,LOCKKEY =16# % KEY FOR LOCKED ALGORITHM/PROPERTY 11049200 + ,BUSYKEY =17# % KEY FOR BUSY ALGORITHM/PROPERTY 11049300 + ,BUZZKEY =16# % KEY FOR BUZZ ALGORITHM 11049330 + ,BUZZCONTROLKEY=20# % 11049360 + ,UNLOCKKEY =21# % KEY FOR UNLOCK ALGORITHM/PROPERTY 11049400 + ; 11049450 + INTEGER LASTX, % L OF LAST EXECUTABLE CODE BEFORE THE 11050000 + % CURRENT NON-EXEC: -1 IF CURRENT IS 11051000 + % EXECUTABLE. 11052000 + FIRSTX, % L OF FIRST EXECUTABLE CODE IN THE SEGMEMT11053000 + % -1 IF NONE YET. 11054000 + 11055000 + FIRSTMT; % L OF FIRST STATEMENT OF CURRENT BLOCK. 11056000 + ARRAY PDPRT[0:15,0:255]; 11057000 + INTEGER PDINX; 11058000 + DEFINE PPINX=PDINX.[36:4],PDINX.[40:8]#; 11059000 + COMMENT PDPRT TS USED AT THE END OF COMPILATION TO BUILD THE LEVEL-ZERO11060000 + STACK FOR THE PROGRAM. PDINX IS THE INDEX OF THE NEXT SLOT 11061000 + IN PDPRT. ENTRIES IN PDPRT CONTAIN THE FOLLOWING FIELDS: 11062000 + [36:12] MOM ADDRESS. THE DISPLACEMENT RELATIVE TO D[0]. 11063000 + NOTICE THAT PDINX BEARS NO RELATIONSHIP TO THIS VALUE11064000 + (OR TO ANY OTHER, FOR THAT MATTER). 11065000 + [23:13] RELATIVE DISK ADDRESS OF THE RELEVENT SEGMENT, IF 11066000 + THERE IS ONE. THIS ADDRESS REFERS TO THE TEMPORARY 11067000 + CODE FILE, AND IS CONVERTED TO A CORE ADDRESS, FOR 11068000 + SAVE STUFF, OR A DISK ADDRESS. THIS FIELD IS 11069000 + APPLICABLE TO DATA AND SEGMENT-DESCRIPTOR ENTRIES. 11070000 + [24:12] SEGMENT DESCRIPTOR ADDRESS, APPLICABLE TO PCWS ONLY. 11071000 + [10:13] SIZE, FOR DATA AND SEGMENT DESCRIPTORS. 11072000 + [ 7:17] L, FOR PCW ENTRIES. 11073000 + [ 6: 1] NCSF FOR PCW (1 => CONTROL STATE). 11074000 + [ 4: 3] OPERAND-SIZE FIELD FOR DATA DESCRIPTOR. 11075000 + 1 = PCW OF EXTERNAL PROCEDURE 11075500 + [ 8: 1] PRESENCE BIT, FOR SEGMENT AND DATA DESCRIPTORS. 11076000 + IF ON, THE SEGMENT WILL BE LOADED AT H/L. 11077000 + [ 2: 3] TYPE OF ENTRY: 11078500 + 0 = DATA DESC. 11079000 + 1 = DATA DESC ALSO. 11079500 + 2 = DOUBLE-PRECISION VARIABLE. 11080000 + 3 = POINTER VARIABLE. 11081000 + 4 = SEGMENT DESC OF EXTERNAL PROCEDURE 11081500 + 6 = SEGMENT DESC. 11082000 + 7 = PROG CTL WORD. 11083000 + [ 7, 1] READ-ONLY BIT FOR DATA DESC. 11084000 + ; 11085000 + DEFINE PDPRTDISPF=[36:12]# 11085200 + ,PDPRTSIZEF=[10:13]# 11085400 + ; 11085600 + INTEGER TEMPADDR; COMMENT REL ADDR INTO TEMP CODE FILE; 11086000 +DEFINE ERROR(ERROR1) = BEGIN ERR(ERROR1); GO TO EXIT END#; 11086010 + LABEL ENDOFITALL; 11087000 + DEFINE USINGV= USING#; 11087500 + DEFINE LFTPARN=LFTPRN#; 11087550 + INTEGER SAVESIZE; % AMOUNT OF SAVE ARRAYS DECLARED 11088000 + DEFINE POOLMAX = 511#; 11100000 + ALPHA ARRAY POOL[0:7, 0:255]; 11101000 + INTEGER POOLMOM, POOLX; 11102000 + ALPHA ARRAY TA [0:POOLMAX]; 11103000 + INTEGER TAX; 11104000 + DEFINE DEL=DLET#; 11104300 + DEFINE BRSET=BRST#; 11104500 + DEFINE CONTROLBUZZKEY=BUZZCONTROLKEY#; 11104800 +DEFINE MAXTEMP = 39#; 11105000 + ARRAY TEMPSTACK[0:MAXTEMP]; 11106000 + BOOLEAN FIGS; COMMENT SHOULD BE TRUE IFF EMITTING FIXUP CODE; 11106100 + DEFINE EVNTV = 100# % ANALOGOUS TO REALV,ATYPE,BOOV, 11107000 + , EVTYPE = EVNTV # % BTYPE BUT USED IN MORE RESTRIC-11108000 + ; % TED WAY FOR EVENTS 11109000 +COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 20000000 + STREAM PROCEDURE DECLARATIONS 20001000 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;20002000 + INTEGER STREAM PROCEDURE EXAMINE(PTR); VALUE PTR; 20003000 + BEGIN SI~PTR; DI~LOC PTR; DI~DI-1; DS~CHR END; 20004000 + INTEGER STREAM PROCEDURE SKIPFORWARD(PTR,BY); VALUE PTR,BY; 20005000 + BEGIN SI~PTR; SI~SI+BY; SKIPFORWARD~SI END; 20006000 + INTEGER STREAM PROCEDURE MKABS(X); 20007000 + BEGIN SI~X; MKABS~SI END; 20008000 + INTEGER STREAM PROCEDURE MOVECHRS(N,F,T); VALUE N,F,T; 20009000 + BEGIN SI~F; DI~T; DS~N CHR ; MOVECHRS~DI END MOVECHRS; 20010000 + BOOLEAN STREAM PROCEDURE EQUAL(A,B); VALUE A,B; 20011000 + BEGIN SI~A; DI~B; IF 8 SC=DC THEN TALLY~1; EQUAL~TALLY END; 20012000 + BOOLEAN STREAM PROCEDURE GREATER(A,B); VALUE A,B; 20013000 + BEGIN SI~A; DI~B; IF 8 SC>DC THEN TALLY~1; GREATER~TALLY END; 20014000 + STREAM PROCEDURE MOVEIT(F,T); VALUE T; 20015000 + BEGIN SI~F; DI~T; DS~WDS END MOVEIT; 20016000 + STREAM PROCEDURE SEQERR(S,B); VALUE S; 20017000 + BEGIN DI~B; DS~12 LIT" SEQERR"; SI~S; DS~8 CHR END SEQERR; 20018000 + STREAM PROCEDURE BLANKOUT(N,D); VALUE N; 20019000 + BEGIN DI~D; DS~8 LIT " "; SI~D; DS~N WDS END BLANKOUT; 20020000 + STREAM PROCEDURE CONVERTOUT(N,D); VALUE N,D; 20021000 + BEGIN DI~D; SI~LOC N; DS~8 DEC END CONVERTOUT; 20022000 + STREAM PROCEDURE EDITLINE(FCR,LST,V,SEG,C,L,BUF); 20023000 + VALUE FCR,LST,V,SEG,C,L ; 20024000 + BEGIN LABEL B, C, T, P, L; 20025000 + DI~BUF; DS~16 LIT" "; SI~FCR; DS~9 WDS; DS~8 LIT" "; BUF~DI; 20026000 + DS~WDS; DS~6 LIT" "; 20027000 + V(DI~DI-6; SI~LOC SEG; DS~3 DEC; DS~LIT":"; DS~4 DEC; 20028000 + DS~LIT":"; DS~DEC); 20029000 + DI~BUF; DI~DI-2; CI~CI+LST; GO B; GO B; GO C; GO P; GO T; 20030000 + GO T; GO L; 20030100 + T:DS~LIT"T"; GO B; 20031000 + C:DS~LIT"C"; GO B; 20032000 + P:DS~LIT"P"; GO B; 20033000 + L:DS~LIT"L"; 20033100 + B: 20034000 + END EDITLINE; 20035000 + STREAM PROCEDURE ZOT(C,AT); VALUE C, AT; 20036000 + BEGIN SI~LOC AT; SI~SI-1; DI~AT; DS~CHR; END ZOT; 20037000 + STREAM PROCEDURE MOVECHARACTERS(N,F,FS,T,TS); VALUE N,FS,TS; 20038000 + BEGIN SI~F; SI~SI+FS; DI~T; DI~DI+TS; DS~N CHR END; 20039000 + STREAM PROCEDURE MOVECHARACTERACCUM(N,F,FS,T,TS); VALUE N,FS,TS; 20040000 + BEGIN SI ~ F; SI ~ SI+FS; SI~SI+4; DI~T; DI~DI+TS; DS ~ N CHR END; 20041000 + BOOLEAN STREAM PROCEDURE OCTALCONVERT(A,C,S,T); VALUE A,C,S; 20042000 + BEGIN SI~A; DI~T; 3(DS~S RESET); 20043000 + C(IF SC<"0" THEN TALLY~1 ELSE IF SC>"7" THEN TALLY~1; 20044000 + SKIP 3 SB; 20045000 + 3(IF SB THEN DS~SET ELSE DS~RESET; SKIP SB)); 20046000 + OCTALCONVERT~TALLY 20047000 + END OCTALCONVERT; 20048000 + INTEGER STREAM PROCEDURE INPUTCONVERT(A,S,C); VALUE S,C; 20049000 + BEGIN SI~A; SI~SI+S; DI~LOC INPUTCONVERT; DS~C OCT END ICV; 20050000 + INTEGER STREAM PROCEDURE SEQCONVERT(LCR); VALUE LCR; 20050100 + BEGIN SI ~ LCR; DI ~ LOC SEQCONVERT; DS ~ 8 OCT; END SEQ CONVERT; 20050200 + BOOLEAN STREAM PROCEDURE CMPCHRNEQL(N,A,B); VALUE N; 20051000 + BEGIN SI~A; DI~B; IF N SC!DC THEN TALLY~1; CMPCHRNEQL~TALLY END; 20052000 + STREAM PROCEDURE MOVE(N,F,T); VALUE N; 20053000 + BEGIN LOCAL M; SI~LOC N; SI~SI+4; SI~SC; M~SI; 20054000 + SI~F; DI~T; DS~N WDS; M(DS~32 WDS; DS~32 WDS) 20055000 + END SUPER MOVE; 20056000 + STREAM PROCEDURE MOVE8BITS(FROM,SK,T0); VALUE SK; 20057000 + BEGIN SI ~ FROM; SK(SKIP 8 SB); DI ~ T0; DI ~ DI + 6; SKIP 4 DB; 20058000 + 8(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB); 20059000 + END MOVE 8 BITS; 20060000 + BOOLEAN STREAM PROCEDURE CMPCHREQL(N,A,B); VALUE N; 20061000 + BEGIN SI~A; DI~B; IF N SC=DC THEN TALLY~1; CMPCHREQL~TALLY END; 20062000 + STREAM PROCEDURE INSERT(N,STUFF,AT,PLUS); VALUE N,STUFF,PLUS; 20063000 + BEGIN SI ~ LOC AT; SI ~ SI - N; DI ~ AT; DI ~ DI + PLUS; DS~N CHR 20064000 + END INSERT; 20065000 + STREAM PROCEDURE ZN9N(OC,N,ZS,AT,PLUS); VALUE OC,N,ZS,PLUS; 20066000 + BEGIN SI~LOC OC; DI~AT; DI~DI+PLUS; AT~DI; 20067000 + DS~N DEC; DI~AT; DS~ZS FILL 20068000 + END ZN9N; 20069000 + REAL STREAM PROCEDURE REEL(P,N); VALUE P,N; 20070000 + BEGIN DI ~ LOC P; DI ~ DI - N; SI ~ P; DS ~ N CHR END; 20071000 + STREAM PROCEDURE FLOG(F,V,T); VALUE F,V; 20072000 + BEGIN DI ~ LOC V; DS ~ F SET; DI ~ T; SI ~ LOC V; DS ~ WDS END; 20073000 + STREAM PROCEDURE MOVEBITS(FROM,NR,SSK,T,DSK); VALUE NR,SSK, DSK; 20074000 + BEGIN SI ~ FROM; SKIP SSK SB; 20075000 + DI ~ T; SKIP DSK DB; NR(IF SB THEN DS ~ SET ELSE DS ~ RESET; 20076000 + SKIP SB) 20077000 + END BIT MOVER; 20078000 +BOOLEAN STREAM PROCEDURE FLAGBIT(A); 20079000 +BEGIN 20080000 + SI ~ A; 20081000 + IF SB THEN 20082000 + BEGIN TALLY ~ 1; DI ~ A; DS ~ RESET END; 20083000 + FLAGBIT ~ TALLY; 20084000 +END FLAGBIT; 20085000 + BOOLEAN STREAM PROCEDURE BIT(N)" OF "(WORD); VALUE N,WORD; 20086000 + BEGIN SI ~ LOC WORD; SKIP N SB; IF SB THEN TALLY ~ 1; BIT ~ TALLY; 20087000 + END BIT RETREIVER; 20088000 + STREAM PROCEDURE LABELINE(A,N,L); VALUE N; 20100000 + BEGIN SI ~ A; DI ~ L; SI ~ SI + 4; DS ~ N CHR; 20101000 + DS ~ 21LIT " SEEMS TO BE A LABEL." 20102000 + END LABELINE; 20103000 + PROCEDURE DUMPIT(A); ARRAY A[0]; 24000000 +; 24001000 +SAVE ARRAY SCRATCH [0:14]; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%24002000 +PROCEDURE DONBUG (W, LI, LA); VALUE W, LI, LA; INTEGER LI,LA; ALPHA W; 24003000 + BEGIN 24004000 + OWN BOOLEAN BEFORE; 24005000 + FORMAT FLI (A6, " INFO ", 7I6), FLA (A6," ADDL ", 7I6); 24006000 + LIST LLI(W, LI, GT1.MONF, GT1.[9:6], GT1.[15:6], GT1.CLASS, 24007000 + GT1.TYPE, GT1.LINK), 24008000 + LLA(W, LA, GT1.LAYINIT, GT1.LAYCODE, GT1.LAYLTA, 24009000 + GT1.LAYLNA, GT1.LAYLTB, GT1.LAYLNB); 24010000 + IF DONSBUG AND NOT BEFORE 24011000 + THEN BEGIN 24012000 + FORMAT F ("INFO FIELDS ARE: INDEX, MONF, 9:6, 15:6,",24013000 + " CLASS, TYPE, LINK",/, 24014000 + "ADDL FIELDS ARE: INDEX, LAYINIT, LAYCODE, ", 24015000 + "LAYLTA, LAYLNA, LAYLTB, LAYLNB",/); 24016000 + BEFORE ~ TRUE; 24017000 + WRITE (LINE[DBL], F); 24018000 + END; 24019000 + IF DONSBUG 24020000 + THEN IF LI > 0 24021000 + THEN BEGIN 24022000 + GT1 ~ INFO [LI.LINKR, LI.LINKC]; 24023000 + WRITE (LINE[DBL], FLI, LLI); 24024000 + END 24025000 + ELSE IF LI < 0 AND LA ! 0 24026000 + THEN BEGIN 24027000 + BLANKOUT (14, SCRATCH); 24028000 + MOVE (ENTIER(ABS(LI) DIV 8 + 1), 24029000 + ADDL [LA.LINKR, LA.LINKC], SCRATCH); 24030000 + WRITE (LINE[DBL], 15, SCRATCH[*]); 24031000 + END 24032000 + ELSE IF LI = 0 24033000 + THEN BEGIN 24034000 + GT1 ~ ADDL[LA.LINKR, LA.LINKC]; 24035000 + WRITE (LINE[DBL], FLA, LLA); 24036000 + END; 24037000 + END DONBUG; 24038000 +COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 25000000 + FORWARD PROCEDURE DECLARATIONS 25001000 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;25002000 + INTEGER PROCEDURE SCAN; FORWARD; %0400400025003000 + INTEGER PROCEDURE READACARD; FORWARD; %0405700025004000 + PROCEDURE DATIME; FORWARD; %0412500025005000 + PROCEDURE GNC; FORWARD; %0414500025006000 + PROCEDURE CONVERTINTO(H,L); 25007000 + REAL H,L ; FORWARD; %0415000025008000 + PROCEDURE FLAG(N); VALUE N; INTEGER N; FORWARD; %0600500025009000 + PROCEDURE DOLLARCARD; FORWARD; 25010000 + PROCEDURE DEBLANK; FORWARD; %0434200025011000 + INTEGER PROCEDURE GETSPACE(L); VALUE L; INTEGER L;FORWARD; %0605100025012000 + PROCEDURE STEPIT; FORWARD; % 25013000 + INTEGER PROCEDURE STEPI; FORWARD; % 25014000 + PROCEDURE EMIT(OP); VALUE OP; INTEGER OP; FORWARD; % 25015000 + PROCEDURE EMITB(B,F,T); 25016000 + VALUE B,F,T; INTEGER B,F,T; FORWARD; % 25017000 + PROCEDURE EMITV(A); VALUE A; INTEGER A; FORWARD; 25018000 + PROCEDURE EMITN(A); VALUE A; INTEGER A; FORWARD; 25019000 + PROCEDURE EMITNUMBER(N,F); VALUE N,F; REAL N,F; FORWARD; 25020000 +DEFINE EMITNUM(EMITNUM1) = EMITNUMBER(EMITNUM1,0)#; 25020100 + PROCEDURE EMITD(A,B,N); VALUE A,B,N; 25021000 + INTEGER A,B,N; FORWARD; 25022000 + DEFINE EMITI(EMITI1,EMITI2)=EMIT2P(ISOL,EMITI1,EMITI2) #, 25023000 + EMITR(EMITR1,EMITR2)=EMIT2P(INSR,EMITR1,EMITR2) #; 25024000 + 25025000 + 25026000 + PROCEDURE ERR(N); VALUE N; INTEGER N; FORWARD; 25027000 + PROCEDURE EMITDP(H,L); VALUE H,L; 25028000 + REAL H,L; FORWARD; 25029000 + PROCEDURE EMITPAIR(A,O); VALUE A,O; 25030000 + INTEGER A,O; FORWARD; 25031000 + PROCEDURE EMITNOT; FORWARD; 25032000 + REAL PROCEDURE TAKE(N); VALUE N; INTEGER N; FORWARD; 25033000 + PROCEDURE PUT(N,X); VALUE N,X; 25034000 + INTEGER N,X; FORWARD; 25035000 + BOOLEAN PROCEDURE IFCLAUSE; FORWARD; 25036000 + INTEGER PROCEDURE CASEHEAD; FORWARD; 25037000 + PROCEDURE CASETAIL(M,B,P); VALUE M,B,P; 25038000 + INTEGER M,B,P; FORWARD; 25039000 + INTEGER PROCEDURE EXPRSS; FORWARD; 25040000 + INTEGER PROCEDURE IFEXP; FORWARD; 25041000 + PROCEDURE EXPRESSION(T); VALUE T; 25042000 + INTEGER T; FORWARD; 25043000 + INTEGER PROCEDURE CASEXP; FORWARD; 25044000 + PROCEDURE EMIT3(S); VALUE S; 25045000 + INTEGER S; FORWARD; 25046000 + INTEGER PROCEDURE GET3(L); VALUE L; INTEGER L; FORWARD; 25047000 + PROCEDURE BEXP; FORWARD; 25048000 + INTEGER PROCEDURE AEXP; FORWARD; 25049000 + PROCEDURE RELATION(T); VALUE T; INTEGER T;FORWARD; 25050000 + INTEGER PROCEDURE BOOSEC; FORWARD; 25051000 + PROCEDURE BOOCOMP; FORWARD; 25052000 + REAL PROCEDURE REXP(BOO); VALUE BOO; BOOLEAN BOO; FORWARD; 25053000 + REAL PROCEDURE PEXP(BOO); VALUE BOO; BOOLEAN BOO; FORWARD; 25054000 + PROCEDURE STATEMENT; FORWARD; 25055000 +DEFINE PUTNBUMP(PUTNBUMP1)=BEGIN PUTADDL(PUTNBUMP1,NEXTADDL); 25056000 + IF DUMPTOG THEN PADDLYOUROWN (NEXTADDL)END#; 25056001 +PROCEDURE PADDLYOUROWN(GNU); VALUE GNU; INTEGER GNU; 25056010 +BEGIN FORMAT F("NEXTADDL THINKS IT EQUALS "I9" AND IT REALLY IS "I9); 25056020 + WRITE(LINE,F,GNU,NEXTADDL) END; 25056030 + PROCEDURE COMPOUNDTAIL; FORWARD; 25057000 + PROCEDURE JUMPCHKX; FORWARD; 25058000 + PROCEDURE JUMPCHKNX; FORWARD; 25059000 + PROCEDURE IDLIST(A,B,C,D,E); VALUE A,B,C,D,E; 25060000 + BOOLEAN E; INTEGER B,C,D; REAL A; FORWARD; 25061000 + BOOLEAN PROCEDURE ENTER(A,B,C,D); VALUE A,B,C,D; 25062000 + BOOLEAN D; INTEGER A,B,C; FORWARD; 25063000 + PROCEDURE READONLYARRAYDEC(B,A); 25064000 + VALUE B,A; 25065000 + BOOLEAN B; INTEGER A; FORWARD; 25066000 + PROCEDURE MERRIMAC; FORWARD; 25067000 + PROCEDURE PICTUREDEC(S); VALUE S; 25068000 + BOOLEAN S; FORWARD; 25068100 + INTEGER PROCEDURE TEXT (FROM, FINAL); VALUE FROM, FINAL; 25069000 + INTEGER FROM, FINAL;FORWARD; 25070000 + PROCEDURE LAYOUTDEC; FORWARD; 25071000 + PROCEDURE DEFINEDEC; FORWARD; 25072000 + PROCEDURE FIELDEC; FORWARD; 25073000 + PROCEDURE PROCEDUREDEC(S,T); VALUE S,T; 25074000 + BOOLEAN S; INTEGER T; FORWARD; 25075000 + PROCEDURE ARRAYDEC(S,O,T); VALUE S,O,T; 25076000 + BOOLEAN S,O; INTEGER T; FORWARD; 25077000 + DEFINE EVENTDEC(EVENTDEC1)=IDLIST(EVENTDEC1,LOCALTYPE,EVENTID, 25078000 + EVNTV,TRUE)#; 25078100 + PROCEDURE QUEUEDEC(L); VALUE L; INTEGER L;FORWARD; 25079000 + REAL PROCEDURE PROCALL(F,C); VALUE F,C; BOOLEAN F; REAL C; 25080000 + FORWARD; 25080100 + PROCEDURE LABELR; FORWARD; 25081000 + REAL PROCEDURE VARIABLE(F); VALUE F; INTEGER F; FORWARD; 25082000 + PROCEDURE QSTMT; FORWARD; 25083000 + PROCEDURE LONGSTRING; FORWARD; 25083100 + PROCEDURE STRINGSOURCE; FORWARD; 25083200 + PROCEDURE BLOCK; FORWARD; 25084000 + PROCEDURE IFSTMT; FORWARD; 25085000 + PROCEDURE GOSTMT; FORWARD; 25086000 + PROCEDURE FORSTMT; FORWARD; 25087000 + PROCEDURE HOOK(X); VALUE X; INTEGER X; FORWARD; 25089000 + PROCEDURE UNHOOK; FORWARD; 25090000 + REAL PROCEDURE GIT(X); VALUE X; INTEGER X; FORWARD; 25091000 + INTEGER PROCEDURE FACTOR(T); VALUE T; INTEGER T; FORWARD; 25091900 + INTEGER PROCEDURE TERM(T); VALUE T; INTEGER T; FORWARD; 25092000 + INTEGER PROCEDURE SIMPARITH(T); VALUE T; INTEGER T; 25093000 + FORWARD; 25094000 + INTEGER PROCEDURE PRIMARY; FORWARD; 25095000 + INTEGER PROCEDURE SUBSCRIBER(W,N); VALUE W,N; 25096000 + INTEGER W,N; FORWARD; 25097000 + PROCEDURE DOTTER (T); VALUE T; REAL T; FORWARD; 25098000 + INTEGER PROCEDURE DOTIT; FORWARD; 25099000 + PROCEDURE LAYITOUT(T); VALUE T; INTEGER T;FORWARD; 25100000 + PROCEDURE ACTUALPARAPART(FBIT,INDEX,AD,FROM);VALUE FBIT,INDEX,AD,FROM; 25101000 + BOOLEAN FBIT,FROM; INTEGER INDEX; REAL AD; FORWARD; 25102000 + INTEGER PROCEDURE INSERTPCW; FORWARD; 25103000 + PROCEDURE EMITPCW(LEVEL,AD,STATE,SEG ); 25104000 + VALUE LEVEL,AD,STATE,SEG; 25105000 + INTEGER LEVEL,AD,STATE,SEG; FORWARD; 25106000 + INTEGER PROCEDURE BOOPRIM; FORWARD; 25107000 + REAL PROCEDURE PTRPRIM(BOO); VALUE BOO; BOOLEAN BOO; FORWARD; 25108000 + PROCEDURE PTRCOMP; FORWARD; 25109000 + PROCEDURE ENTRYEXPR; FORWARD; 25110000 + PROCEDURE SEGMENT(A, B, C); VALUE A, B; INTEGER A, B; 25111000 + ARRAY C[0, 0]; FORWARD; 25112000 + PROCEDURE WRITEFILE(F,A,X0,X1); VALUE X0,X1; REAL X0,X1; 25112300 + FILE F; ARRAY A[0,0]; FORWARD; 25112600 + INTEGER PROCEDURE NEWSEG(X); VALUE X; INTEGER X; FORWARD; 25113000 + PROCEDURE PURGE(T); VALUE T; INTEGER T; FORWARD; 25114000 + PROCEDURE DECLARATIONS; FORWARD; 25115000 + PROCEDURE GLOBALPCW(A,S,L,C); VALUE A,S,L,C; 25116000 + INTEGER A,S,L,C; FORWARD; 25117000 + PROCEDURE INITIALIZEARRAY(A); VALUE A; 25118000 + INTEGER A; FORWARD; 25119000 + PROCEDURE PLACE(W,X);VALUE W,X; REAL W,X; FORWARD; 25120000 + INTEGER PROCEDURE FORMALPARAPART(Q); VALUE Q; 25121000 + BOOLEAN Q; FORWARD; 25122000 + PROCEDURE SEGDICT(S,A,L,P);VALUE S,A,L,P; 25123000 + INTEGER S,A,L,P; FORWARD; 25124000 + PROCEDURE QALGORITHM(PARINFO,ADDLADRES,FROM); VALUE PARINFO,ADDLADRES, 25125000 + FROM; INTEGER PARINFO,ADDLADRES; BOOLEAN FROM; FORWARD; 25126000 + 25127000 + PROCEDURE PUTADDL(ENTRY,LINK); VALUE ENTRY; INTEGER LINK;REAL ENTRY; 25128000 + FORWARD; 25129000 + PROCEDURE DIDDLENTER(K); VALUE K; REAL K; FORWARD; 25130000 + PROCEDURE DSTROYNVISIBLE(LASTITEM); VALUE LASTITEM; INTEGER LASTITEM; 25131000 + FORWARD; 25132000 + INTEGER PROCEDURE EMITSPACE(LEVEL);VALUE LEVEL;INTEGER LEVEL; 25133000 + FORWARD; 25134000 + 25135000 + INTEGER PROCEDURE STANDSEARCH; FORWARD; 25136000 + BOOLEAN PROCEDURE ASSOCIATE (SPEC); VALUE SPEC; 25137000 + INTEGER SPEC; FORWARD; 25138000 + PROCEDURE ITEMREFERENCE(F); VALUE F; INTEGER F; FORWARD; 25139000 + INTEGER PROCEDURE QARRAYBOUND(LEVEL,BADTOG);VALUE LEVEL,BADTOG; 25140000 + INTEGER LEVEL; BOOLEAN BADTOG; FORWARD; 25141000 + PROCEDURE EMIT1P(OP,A); VALUE OP,A; 25141100 + INTEGER OP,A; FORWARD; 25141200 + PROCEDURE EMIT2P(OP,A,B); VALUE OP,A,B; 25142000 + INTEGER OP,A,B; FORWARD; 25143000 + PROCEDURE EMIT3P(OP,A,B,C); VALUE OP,A,B,C; 25144000 + INTEGER OP,A,B,C; FORWARD; 25145000 + PROCEDURE EMIT4P(OP,A,B,C,D); 25146000 + VALUE OP,A,B,C,D ; 25147000 + INTEGER OP,A,B,C,D ; FORWARD; 25148000 + INTEGER PROCEDURE GETSTACK; FORWARD; 25149000 + PROCEDURE RTNSTACK(ADR); VALUE ADR; REAL ADR; FORWARD; 25150000 + INTEGER PROCEDURE PICTUREGEN(A,B,C); VALUE A,B,C; 25151000 + BOOLEAN A,B; INTEGER C; FORWARD; 25152000 + PROCEDURE EMITMICRO(A); VALUE A; ALPHA A; FORWARD; 25153000 + ALPHA PROCEDURE HEXOUT(A); VALUE A; ALPHA A; FORWARD; 25154000 + PROCEDURE PRINTSPACE(X,L,D); VALUE X,L,D; 25155000 + ALPHA X,L,D; FORWARD; 25156000 + BOOLEAN PROCEDURE GOBBLE(B); VALUE B; BOOLEAN B; FORWARD; 25160000 + PROCEDURE INTERRUPTDEC; FORWARD; 25161000 + BOOLEAN PROCEDURE ITEMONLY(VBIT,SCLASS);VALUE VBIT,SCLASS; 25162000 + BOOLEAN VBIT;INTEGER SCLASS; FORWARD; 25163000 + PROCEDURE EVENTINTRINSIC; FORWARD; 25164000 + PROCEDURE EMITBUZEVENT; FORWARD; 25165000 + INTEGER PROCEDURE EMITDESC(LEVEL);VALUE LEVEL;INTEGER LEVEL; 25166000 + FORWARD; 25167000 +PROCEDURE MAKEARRAYROW; FORWARD; 25168000 +COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 30000000 + THE SCANNER 30001000 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;30002000 +COMMENT THE NEXT SECTION CONTAINS THE SCANNER. IT IS COMPOSED OF THREE30003000 + MAIN PROCEDURES: TABLE, SCAN, AND READACARD. ITS PURPOSE IS TO, 30004000 + EACH TIME IT IS CALLED, GET THE NEXT LOGICAL ENTITY OF THE SOURCE 30005000 + PROGRAM, AND PRESENT IT TO THE CALLER. THE SOURCE PROGRAM COMES IN 30006000 + CHUNKS: USUALLY THE CHUNK IS A CARD-IMAGE FROM EITHER THE CARD OR 30007000 + THE TAPE FILE. HOWEVER, SOME CHUNKS ARE TEXTS FROM A DEEINE: THESE 30008000 + COME, A WORD AT A TIME, FROM ADDL. READACARD IS IN CHARGE OF 30009000 + FINDING THE NEXT CHUNK: IN FACT, VIRTUALLY ALL THE SOURCE-LANGUAGE 30010000 + MANAGEMFNT IS HANDLED BY READACARD, INCLUDING NORMAL LISTING, 30011000 + VOIDING, SEQUEWCE DIDDLING, ETC., UNDER CONTROL OF SCAN AND TABLE. 30012000 + SCAN IS RESPONSIBLE FOR GETTING AN ITEM FROM THE SOURCE AS 30013000 + PRESENTED BY READACARD: AN ITEM MAY BE 1) A SPECIAL CHARACTER, 2) A 30014000 + NUMBER, OR 3) AN IDENTIFIER. HOWEVER, SCAN-S LIFE IS COMPLICATED BY30015000 + THE POSSIBILITY THAT A NUMBER OR IDENTIFIER MAY BE SPLIT ACROSS 30016000 + CHUNKS OF SOURCE. IN ANY CASE, THE ITEM IS PLACED INTO ACCUM, IN 30017000 + BASICALLY THE SAME FORM AS AN INFO ENTRY (SEE BELOW), AND GIVEN TO 30018000 + TABLE FOR FURTHER PROCESSING. 30019000 + TABLE IS THE ONE THAT DOES THE DIRTY WORK OF TRANSLATING THE 30020000 + SOURCE-LANGUAGE ITEMS INTO A USABLE INTERNAL FORM, AND HANDLING THE 30021000 + FUNNY CASES. THE NAME "TABLE" IS DERIVED FROM ITS FUNCTION IN THE 30022000 + COMPILER: IT PRODUCES A NUMBER (CALLED THE CLASS) OF AN ITEM, 30023000 + MAINLY BY LOOKING IT UP SOMEWHERE. FOR THE BENEFIT OF THE COMPILER 30024000 + PROPER, IT MAINTAINS A TABLE, CALLED "ELBAT", CONTAINING THE 30025000 + INTERNAL REPRESENTATIONS OF THE SOURCE ITEMS. FOR OBVIOUS REASONS, 30026000 + THEN, THE INTERNAL REPRESENTATION OF AN ITEM IS CALLED ITS ELBAT- 30027000 + WORD. TABLE TRIES TO GUARANTEE THAT AT LEAST THE TEN MOST-RECENTLY-30028000 + SCANNED ITEMS ARE REPRESENTED. 30029000 + THE ELBAT WORD CONTAINS THE FOLLOWING FIELDS: 30030000 + ADDRESS : THE ADDRESS FIELD, FOR THINGS THAT HAVE ADDRESSES, 30031000 + IS JUST THAT. IT CONTAINS TWO SUBFIELDS, ADDRESSING 30032000 + LEVEL AND DISPLACEMENT. FOR OTHER THINGS, LIKE 30033000 + OPERATORS, IT CONTAINS OTHER VALUES: 30034000 + A.FOR ARITHMETIC, LOGICAL, AND RELATIONAL OPERATORS, 30035000 + THE OPERATOR CODE. 30036000 + B.FOR "TRUE" AND "FALSE", ONE AND ZERO. 30037000 + C.FOR INTRINSICS (WHERE POSSIBLE), THE OPERATOR. 30038000 + THESE OPERATORS USE ONLY THE DISP PART. 30038100 + TYPE : USED TO DISCRIMINATE AMONG LOCAL, OWN, FORMAL, ETC. 30039000 + RSVD : EQUALS ONE FOR RESERVED WORDS. 30040000 + F1 : HAS NO STANDARD MEANING 30041000 + CLASS: THE MAJOR CLASSIFICATION OF THE QUANTITY. THIS IS 30042000 + THE PRIMARY VALUE USED BY THE COMPILER TO ANALYZE THE30043000 + SYNTAX OF THE PROGRAM. 30044000 + LINK : FOR IDENTIFIERS, THE INFO INDEX OF ITS ENTRY. 30045000 + ELBAT WORDS COME FROM DIFFERENT PLACES, DEPENDING ON THE KIND 30046000 + OF ITEM. FOR NUMBERS, THEY ARE BUILT BY TABLE. FOR SPECIAL 30047000 + CHARACTERS, THEY COME FROM AN ARRAY CALLED "SPECIAL"* WHICH IS 30048000 + INDEXED BY THE CHARACTER ITSELF. NOTE THAT THIS WORD IS GOTTEN FROM30049000 + SPECIAL BY SCAN, AND IS LEFT IN SPEC: ALSO NOTE THAT SOME SPECIAL 30050000 + CHARACTERS--LIKE ., :, $--REQUIRE SPECIAL CONSIDERATION. FOR THESE 30051000 + CASES, THE LINK FIELD HAS A NON-ZERO VALUE. 30052000 + FOR IDENTIFIERS, THE ELBAT WORD COMES DIRECTLY FROM THE FIRST 30053000 + WORD OF THE INFO ENTRY: HOWEVER, THE LINK FIELD IS CHANGED IN THE 30054000 + PROCESS. A BASIC INFO ENTRY CONTAINS, ALSO, THE IDENTIFIER 30055000 + ; 30056000 + COMMENT SCAN GETS THE NEXT ENTITY FROM THE SOURCE STRING AND PLACES IT 31000000 + INTO ACCUM, REPORTING ON WHAT IT FOUND BOTH THROUGH ITS 31001000 + VALUE AND RESULT; 31002000 + INTEGER PROCEDURE SCAN; 31003000 + BEGIN 31004000 + LABEL AROUND; 31005000 + LABEL BACK; 31005100 + COUNT ~ ACCUM[1] ~ 0; RCOUNT ~ 63; 31006000 + ACCUMINX ~ ACCUMSTART; % POINTS TO START OF ACCUM 31007000 + DEBLANK; 31008000 + COMMENT CHR NOW CONTAINS THE FIRST CHARACTER OF THE ENTITY31009000 + WE ARE SEEKING, AND NCR HAS ITS ADDRESS. WE NOW 31010000 + LOOK TO SEE WHAT WE HAVE; 31011000 + IF SCAN~RESULT~(SPEC~SPECIAL[CHR]).CLASSRESULT; 31021000 + IF COUNT>RCOUNT THEN COMMENT TOO BIG--; 31022000 + BEGIN FLAG(300); COUNT~RCOUNT END; 31023000 + COMMENT WE HAVE FOUND THE END OF SOMETHING: EITHER 31024000 + THE ID/NR OR THE CARD. WE SAVE WHAT WE FOUND31025000 + AND THEN DECIDE WHAT TO DO WITH IT; 31026000 + ACCUMINX ~ MOVECHRS(COUNT, FCR,ACCUMINX); 31027000 + COMMENT NOW SEE WHETHER WE HIT END OF CARD; 31028000 + IF NCR=LCR THEN 31029000 + BEGIN 31030000 + COMMENT END OF CARD. WE READ ANOTHER AND SEE IF THIS 31031000 + ID/NR IS CONTINUED; 31032000 +BACK: 31032100 + NCR~( FCR~READACARD)+BUMPWORD; 31033000 + RCOUNT~RCOUNT-COUNT; 31034000 + COUNT ~ -1; 31035000 + GO AROUND 31036000 + END ELSE IF CHR = "%" THEN GO BACK; 31037000 + ACCUM[1].CHRCNT~COUNT~ COUNT + 63 - RCOUNT; 31038000 + END BUILDING IDS AND NRS ELSE 31039000 + BEGIN 31040000 + COMMENT A SPECIAL CHARACTER, SO WE PUT IT INTO ACCUM; 31041000 + ACCUM[1].[23:7]~CHR+64; 31042000 + BUMPNCR; 31043000 + ACCUM[0]~SPEC 31044000 + END SPECIAL CHARACTERS 31045000 + END SCAN; 31046000 + COMMENT READACARD FINDS THE NEXT HUNK OF SOURCE LANGUAGE TO BE SCANNED,31047000 + RETURNING ITS ADDRESS. IT READS CARDS, MERGING WITH TAPE 31048000 + IF NECESSARY, HANDLES VOID, LIST, NEW TAPE, RESEQUENCING, 31049000 + AND SEQUENCE CHECKING. IT ALSO DIGS OUT DEFINE-STUFF AND 31050000 + PUTS WHERE THEY CAN BE SEEN; 31051000 + INTEGER PROCEDURE READACARD; 31052000 + BEGIN 31053000 + LABEL EOFC,EOFT,BACK,C,T,EXIT; 31054000 + LABEL LISTEM; 31054100 + IF DONE THEN 31055000 + BEGIN READACARD~ (LCR~CLCR-8) -1; 31056000 + GO TO EXIT 31057000 + END; 31058000 + IF LASTUSED { 5 THEN GO BACK; 31059000 + COMMENT MUST BE RESCANNING A DEFINE--MOVE IT FROM ADDL TO 31060000 + WHEREVER THE LAST WORD WAS; 31061000 + MOVEIT(ADDL[(LASTUSED~LASTUSED+1).LINKR,LASTUSED.LINKC], 31062000 + READACARD~LCR-1); 31063000 + GO TO EXIT; 31064000 + COMMENT NOW THE END-OF-FILE ROUTINES FOR CARD AND TAPE; 31065000 + EOFC: IF GTI1~LASTUSED=1 THEN GTI1~MKABS(CARD(0)); 31066000 + COMMENT FORCE EOF NO LABEL IF CARD-ONLY, OTHERWISE USE 31067000 + TAPE-ONLY; 31068000 + LASTUSED~5; 31069000 + IF GTI1=3 THEN GO TO C COMMENT TBUFF WASNT VALID; 31070000 + ELSE GO TO T; 31071000 + EOFT: IF LASTUSED=5 THEN GT1~MKABS(TAPE(0)) ELSE CLOSE(TAPE); 31072000 + LASTUSED~1; COMMENT CARDS ONLY; 31073000 + GO TO T; 31074000 + BACK: IF LASTUSED{3 THEN READ(CARD,10,CBUFF[*])[EOFC]; 31075000 + C: IF LASTUSED}3 THEN READ(TAPE,10,TBUFF[*])[EOFT]; 31076000 + T: IF LASTUSED=1 THEN LCR~CLCR ELSE 31077000 + IF LASTUSED=5 THEN LCR~TLCR ELSE 31078000 + IF GREATER(CLCR,TLCR) THEN 31079000 + BEGIN LCR~TLCR; LASTUSED~4 END ELSE 31080000 + BEGIN LCR~CLCR; 31081000 + IF EQUAL(CLCR,TLCR) THEN LASTUSED~3 ELSE LASTUSED~2 31082000 + END CARD SELECTION; 31083000 + COMMENT LCR NOW POINTS TO THE SEQUENCE NUMBER OF THE NEXT 31084000 + CARD TO BE USED; 31085000 + IF VOIDING THEN 31086000 + IF GREATER(LASTSEQUENCE+1,LCR) THEN GO BACK 31087000 + ELSE VOIDING~FALSE 31088000 + COMMENT IF WE HAD SEEN A $ VOID, WE JUST CLEARED IT BY 31089000 + GOING BACK TO READ AGAIN UNLESS THE VOID WAS 31090000 + SATISFIED; 31091000 + ELSE 31091100 + IF LISTING THEN 31091200 + IF GREATER(LASTSEQUENCE+1,LCR) THEN 31091300 + BEGIN SEQ ~ FALSE; 31091310 + BLANKOUT(2,LBUFF[14]); 31091320 + GO LISTEM; 31091330 + END 31091340 + ELSE LISTING~FALSE; 31091400 + IF SEQ~GREATER(LASTSEQUENCE,LCR) THEN SEQERR(LASTSEQUENCE, 31092000 + LBUFF[14]) ELSE BLANKOUT(2,LBUFF[14]); 31093000 + COMMENT SET UP SEQUENCE ERROR MESSAGE IF NECESSARY; 31094000 + GTI1~MOVECHRS(8,LCR,LASTSEQUENCE); 31095000 + COMMENT SAVE OFF THE SEQUENCE NUMBER; 31096000 + IF LISTOG OR NEWTOG OR SEQ THEN 31097000 + IF EXAMINE(READACARD~LCR-9)!"$" THEN 31098000 + BEGIN COMMENT WRITE THE CARD OUT SOMEWHERE; 31099000 + IF RESEQTOG THEN % CHANGE THE SEQUENCE NR. 31100000 + BEGIN CONVERTOUT(RESEQNR,LCR); 31101000 + RESEQNR ~ RESEQNR + RESEQINC 31102000 + END RESEQUENCING; 31103000 + IF NEWTOG THEN % WRITE IT ONTO NEWTAPE 31104000 + IF LASTUSED<4 THEN WRITE(NEWTAPE,10,CBUFF[*]) 31105000 + ELSE WRITE(NEWTAPE,10,TBUFF[*]); 31106000 + LISTEM: 31106100 + IF LISTOG OR SEQ THEN % WRITE IT ON THE PRINTER 31107000 + BEGIN 31108000 + IF LISTOG.[46:1] THEN DATIME; % FIRST LINE 31109000 + EDITLINE(LCR-9,IF LISTING THEN 6 ELSE LASTUSED,1, 31110000 + SEGNO,L DIV 6,GTI1+L MOD 6, LBUFF); 31111000 + WRITELBUFF; 31112000 + END LISTING; 31113000 + IF LISTING THEN GO BACK; 31113100 + END SOURCE OUTPUT ELSE ELSE READACARD ~ LCR - 9; 31114000 + PRT27 ~ SEQCONVERT(LCR); 31114010 + ZOT("%",LCR); 31115000 + CARDCOUNT ~ CARDCOUNT + 1; 31116000 + EXIT: 31117000 + END READACARD; 31118000 + PROCEDURE DATIME; % PRODUCES HEADING LINE FOR LISTING. 31119000 + BEGIN 31120000 + INTEGER DAY,MO,DA,YR,HR,MN; 31121000 + LABEL OWT; 31122000 + FORMAT DT(X25,"B 6 5 0 0 E S P 0 L C 0 M P I L A T I 0 N,",31123000 + A8,"DAY, ",2(I2,"/"),I2,", ",A2,":"A2" H."); 31124000 + DA~(((DAY~TIME(0)).[30:6]|10)+DAY.[36:6])|10+DAY.[42:6]; 31125000 + YR~HR+DAY.[18:6]|10+DAY.[24:6]; 31126000 + FOR DAY~31,REAL(YR MOD 4=0)+28,31,30,31,30,31,31,30,31,30 DO 31127000 + IF DA{DAY THEN GO OWT ELSE 31128000 + BEGIN MO~MO+1; DA~DA-DAY END; 31129000 + OWT: IF MO<2 THEN BEGIN MN~MO+11; HR~YR-1 END ELSE MN~MO-1; 31130000 + MO~MO+1; 31131000 + DAY~((MN|26-2)DIV 10+DA+HR+HR DIV 4) MOD 7; 31132000 + HR~(HR~TIME1 DIV 216000)MOD 10+(HR DIV 10)|64; 31133000 + MN~(MN~(TIME1 DIV 3600)MOD 60)MOD 10 +(MN DIV 10)|64; 31134000 + WRITE(LINE[DBL],DT,IF DAY=3 THEN " THURS" ELSE IF DAY<3 THEN 31135000 + IF DAY=1 THEN " TUES" ELSE IF DAY<1 THEN" MON"ELSE 31136000 + "WEDNES"ELSE IF DAY=5 THEN" SATUR"ELSE IF DAY<5 THEN 31137000 + " FRI"ELSE " SUN",MO,DA,YR,HR,MN); 31138000 + LISTOG~LISTOG AND TRUE; 31139000 + END DATIME; 31140000 + PROCEDURE GNC; % GET NEXT CHARACTER & PUT IT INTO ACCUM 31141000 + BEGIN 31142000 + ACCUMINX ~ MOVECHRS(1,NCR,ACCUMINX); 31143000 + COUNT ~ COUNT+1; BUMPNCR 31144000 + END GNC; 31145000 + BOOLEAN FONY; % CAUSES TABLE TO STUTTER PROPERLY. 31145100 +BOOLEAN FIELDING; %KEEPS TABLE FROM STUTTERING IMPROPERLY. 31145200 + INTEGER PROCEDURE TABLE(P); VALUE P; INTEGER P; 31146000 + COMMENT TABLE IS THE REAL SCANNER: IT PRE-PROCESSES THE 31147000 + RAW SOURCE LANGUAGE BY LOOKING UP IDENTIFIERS, TRYING31148000 + TO CLASSIFY THEM, BY CONVERTING NUMBERS, AND BY 31149000 + GENERALLY REPLACING THINGS BY ELBAT WORDS REPRESENTIN31150000 + THEM. IT PERFORMS OTHER TRANSFORMATIONS ON THE TEXT, 31151000 + SUCH AS INITIATING AND TERMINATING DEFINE-EXPANSION, 31152000 + DELETING COMMENTS, AND OTHER GOOD STUFF; 31153000 + BEGIN 31154000 + LABEL RESCAN, COMPLAIN, FAKEIT, ON, FOUND,FPART,FINISHNUMBER;31155000 + LABEL FINISH, INN, AWAY; 31155100 + OWN REAL HIDYPLACE; 31155200 + LABEL UNRECURSE, THERE, SOMEWHERE; 31155300 + INTEGER HOOKUP; 31156000 + IF P < 0 THEN GO RESCAN ELSE 31156100 + WHILE P}NXTELBT DO 31157000 + BEGIN 31158000 + IF FONY THEN GO INN; 31158100 + RESCAN: IF SCAN>SPASE THEN COMMENT SPECIAL CHARACTER; 31159000 + BEGIN ENDTOG ~ FALSE; 31160000 + CASE SPEC.LINKC OF 31161000 + BEGIN ; COMMENT CASE 0= NO FUNNY BUSINESS; 31162000 + COMMENT CASE 1= CROSSHATCH; 31163000 + IF DEFINECTR = 0 31164000 + THEN BEGIN COMMENT TRY TO UNHOOK DEFINE; 31165000 + UNHOOK; 31166000 + GO RESCAN 31167000 + END CROSSHATCH CASE; 31168000 + COMMENT CASE 2=ATSIGN. BUILD OCTAL; 31169000 + IF P = -2 THEN GO UNRECURSE ELSE 31169100 + IF DEFINECTR = 0 THEN 31170000 + BEGIN DEBLANK; DPTOG ~ FALSE; 31171000 + IF CHR<8 THEN 31172000 + BEGIN 31172100 + IF SCAN = DIGIT THEN 31173000 + IF COUNT { 16 THEN 31174000 + IF COUNT ! 16 OR ACCUM[1].FIRSTCHR { 3 THEN 31175000 + IF NOT OCTALCONVERT(ACCUMSTART,COUNT,16-COUNT, 31176000 + THI) THEN GO FINISHNUMBER; 31177000 + COMPLAIN: FLAG(301); GO RESCAN 31178000 + END 31178100 + END AT SIGN; 31179000 + COMMENT CASE 3=COLON. CHECK FOR :=; 31180000 + BEGIN 31181000 + DEBLANK; 31182000 + IF CHR="=" THEN 31183000 + BEGIN CHR~"~"; 31184000 + FAKEIT: RESULT~(ACCUM[0]~SPEC~SPECIAL[CHR]).CLASS; 31185000 + ACCUM[1].FIRSTCHR ~ CHR; 31185100 + BUMPNCR 31186000 + END OF SUBSTITUTE CHARACTER; 31187000 + END COLON CASE; 31188000 + COMMENT CASE 4=DOLLAR. CALL WALLY; 31189000 + BEGIN DOLLARCARD; GO RESCAN END; 31190000 + COMMENT CASE 5=RIGHT PAREN.; 31191000 + BEGIN 31192000 + DEBLANK; 31193000 + IF CHR=""" THEN COMMENT A FUNNY COMMA, I HOPE; 31194000 + BEGIN 31195000 + DO BUMPNCR UNTIL EXAMINE(NCR)="""; 31196000 + BUMPNCR; 31197000 + DEBLANK; 31198000 + IF CHR!"(" THEN GO COMPLAIN; 31199000 + CHR~","; 31200000 + GO FAKEIT 31201000 + END FUNNY COMMA 31202000 + END RIGHT PAREN CASE; 31203000 + BEGIN COMMENT PERCENT; 31204000 + IF NCR!LCR-9 THEN 31204100 + NCR ~ READACARD; 31205000 + GO TO RESCAN; 31205100 + END; 31205300 + COMMENT CASE 7=QUOTE. MAKE A STRING; 31206000 + UNRECURSE: IF P < 0 THEN 31206100 + BEGIN TABLE~RESULT; GO AWAY END ELSE 31206200 + BEGIN 31207000 + MAXCSZ ~ CSZ ~ DEFAULTSIZE; 31208000 + SPEC.CLASS ~ IF GOBBLE(FALSE) THEN STRING 31209000 + ELSE STRNGCON; 31210000 + END QUOTE CASE; 31214000 + COMMENT CASE 8=PERIOD; 31215000 + IF P = -2 THEN GO UNRECURSE ELSE 31215100 + IF EXAMINE(NCR){9 AND CONTEXT!3 THEN 31216000 + IF DEFINECTR = 0 THEN 31217000 + BEGIN THI~TLO~TCOUNT~C~REAL(FLAGS~FALSE); 31218000 + GO TO FPART 31219000 + END PERIOD CASE 31220000 + 9 IS MULTIPLY TRY FOR TWO; 31221000 + IF DEFINECTR = 0 THEN 31222000 + BEGIN 31223000 + DEBLANK; 31224000 + IF CHR = "|" THEN 31225000 + BEGIN BUMPNCR; SPEC.ADDRESS ~ MULX END 31226000 + END MULTIPLY CASE 31227000 + END 31228000 + END SPECIAL CHARACTER CASES ELSE 31229000 + IF RESULT=LETTER THEN COMMENT IDENTIFIER-TYPE THING; 31230000 + BEGIN 31231000 + IF (GT1~(SPEC~STACKHEAD[SCRAM~(Q~ACCUM[1])MOD 125]) 31232000 + .LINKR) + GT2~SPEC.LINKC ! 0 THEN 31233000 + DO IF(SPEC~INFO[GT1,GT2]).[18:30] = Q THEN 31234000 + IF COUNT < 5 THEN GO ON ELSE 31235000 + IF CMPCHREQL(COUNT-4,ACCUM[2],INFO[GT1,GT2+1]) 31236000 + THEN 31237000 + ON: BEGIN 31238000 + SPEC ~(GT3 ~ INFO[GT1,GT2-1])>1[33:41:7] 31239000 + &(GT2-1)[40:40:8]; 31240000 + GO TO FOUND 31241000 + END 31242000 + UNTIL (GT1~SPEC.CONR)+GT2~SPEC.CONC = 0; 31243000 + SPEC ~ 0; COMMENT WE DID NOT FIND IT; 31244000 + FOUND: 31245000 + IF SPEC.CLASS = COMMENTV THEN 31246000 + IF CONTEXT!3 OR DEFINECTR!0 THEN 31247000 + BEGIN WHILE EXAMINE(NCR)!";" DO BUMPNCR; 31248000 + BUMPNCR; 31249000 + GO RESCAN 31250000 + END COMMENT REMOVER; 31251000 + IF CONTEXT { 1 THEN 31252000 + IF SPEC.LINK > RSVDX THEN %%%%%%%KLUDGE%%%%%%%%%%%% 31253000 + IF SPEC.RSVD =0 THEN 31254000 + IF SPEC .LINK < NINFOO THEN 31255000 + SPEC.CLASS ~ UNKNOWNID; 31256000 + IF DEFINECTR = 0 THEN 31256900 + IF CONTEXT!3 THEN 31257000 + IF SPEC.CLASS = DEFINDID THEN 31258000 + BEGIN 31259000 + LITERALS ~ FALSE; 31259100 + HOOKUP ~ GT3.LINK; 31260000 + IF GT1 ~ SPEC.ADDRESS ! 0 31261000 + THEN BEGIN 31262000 + HOOKUP ~ HOOKUP & NEXTINFO[18:33:15]; 31263000 + IF ASSOCIATE (SPEC.ADDRESS) 31264000 + THEN GO RESCAN; 31265000 + END; 31266000 + HOOK(HOOKUP); 31267000 + GO RESCAN; 31268000 + END START OF DEFINE SCAN; 31269000 + END IDENTIFIER TYPES ELSE 31270000 + IF DEFINECTR = 0 THEN 31271000 + BEGIN COMMENT NUMBERS; 31272000 + TCOUNT~NLO~TLO~NHI~REAL(FLAGS ~ FALSE); 31273000 + IF COUNT=1 THEN THI~ACCUM[1].FIRSTCHR ELSE 31274000 + CONVERTINTO(THI,TLO); 31275000 + IF P < 0 THEN GO FINISHNUMBER; 31275050 + IF NOT FIELDING THEN IF CONTEXT!3 THEN 31275055 + IF COUNT { 3 THEN 31275060 + IF HOOKUP~TABLE(-2)=PERIODV THEN GO THERE ELSE 31275100 + IF HOOKUP = ATSIGN THEN GO SOMEWHERE ELSE 31275140 + IF HOOKUP ! STRNGCON THEN GO FINISHNUMBER ELSE 31275150 + BEGIN MAXCSZ ~ 0; 31275160 + SPEC.CLASS ~ IF GOBBLE(THI MOD 10 = 0 OR 31275200 + BOOLEAN(2)) 31275250 + THEN STRING ELSE STRNGCON; 31275300 + GO FINISH 31275600 + END; 31275700 + IF CHR = "." THEN 31276000 + BEGIN BUMPNCR; 31277000 + THERE: DOUBLE(THI, TLO, 1.0, 0, |, ~, THI, TLO); 31278000 + IF EXAMINE(NCR){9 THEN 31279000 + BEGIN 31280000 + FPART: IF SCAN!DIGIT THEN GO COMPLAIN; 31281000 + IF COUNT=1 THEN NHI~ACCUM[1].FIRSTCHR ELSE 31282000 + CONVERTINTO(NHI,NLO); 31283000 + TCOUNT~COUNT 31284000 + END FRACTION PART; 31285000 + END DOT PART; 31286000 + IF EXAMINE(NCR)="@" THEN 31287000 + BEGIN BUMPNCR; 31288000 + SOMEWHERE: DPTOG ~ EXAMINE(NCR) = "@"; 31289000 + IF DPTOG THEN BUMPNCR; 31289100 + IF SCAN=ADDOP THEN 31290000 + BEGIN T~CHR; IF SCAN!DIGIT THEN GO COMPLAIN31291000 + END SIGN OF EXPONENT ELSE 31292000 + IF RESULT!DIGIT THEN GO COMPLAIN; 31293000 + IF COUNT=1 THEN C~ACCUM[1].FIRSTCHR ELSE 31294000 + CONVERTINTO(C,GTI1); 31295000 + IF T="-" THEN C~-C; 31296000 + END EXPONENT PART ELSE C~T~0; 31297000 + COMMENT THE NUMBER IS SPLIT ALL APART: 31298000 + HIGH LOW SIZE 31299000 + INTEGER THI TLO - 31300000 + FRACTION NHI NLO TCOUNT 31301000 + EXPONENT C JUNK COUNT 31302000 + NOW IT IS TIME TO PUT THE PIECES TOGETHER; 31303000 + DPTOG~(GT1~THI|1.0).[3:6]+(NHI|1.0).[3:6]< 31304000 + REAL(NHI|THI!0)|13 OR DPTOG; 31305000 + IF ABS(GT1.[3:6]>1[1:2:1]+(T~TEN[ABS(C)]).[3:6] 31306000 + &C[1:1:1]+12)>63 THEN 31307000 + FLAG(303) COMMENT NUMBER IS TOO BIG; ELSE 31308000 + BEGIN COMMENT THE NUMBER FITS: PUT THE INTEGER AND 31309000 + FRACTION PARTS TOGETHER; 31310000 + IF TCOUNT>0 THEN 31311000 + IF DPTOG THEN BEGIN 31312000 + FOR N~0 STEP 16 UNTIL TCOUNT DO 31313000 + DOUBLE(THI,TLO,TEN[MIN(TCOUNT-N,16)],0,|, 31314000 + ~,THI,TLO); 31315000 + DOUBLE(THI,TLO,NHI,NLO,+,~,THI,TLO) 31316000 + END OP ELSE 31317000 + THI~THI|TEN[TCOUNT]+NHI; 31318000 + COMMENT THE NUMBER IS IN (THI,TLO) AS AN 31319000 + INTEGER (MAYBE NORMALIZED, BUT WITH ZEROES 31320000 + TO THE RIGHT OF THE OCTAL POINT). WE NOW 31321000 + ADJUST IT BY THE APPROPRIATE POWER OF TEN. 31322000 + NOTE THAT ONLY THE POWERS 0 THRU 16 OF TEN 31323000 + (@0 THRU @16) CAN BE REPRESENTED EXACTLY IN31324000 + A SINGLE WORD, SO WE USE ONLY THOSE VALUES 31325000 + FOR DP CONVERSION; 31326000 + IF DPTOG THEN 31327000 + IF C~C-TCOUNT<0 THEN 31328000 + FOR N~0 STEP -16 UNTIL C DO 31329000 + DOUBLE(THI,TLO,TEN[MIN(N-C,16)],0,/, 31330000 + ~,THI,TLO) 31331000 + ELSE 31332000 + FOR N~0 STEP 16 UNTIL C DO 31333000 + DOUBLE(THI,TLO,TEN[MIN(C-N,16)],0,|, 31334000 + ~,THI,TLO) 31335000 + ELSE 31336000 + IF C~C-TCOUNT<0 THEN THI~THI/TEN[-C] ELSE 31337000 + IF C!0 THEN THI~TEN[C]|THI; 31338000 + END PUTTING PIECES TOGETHER; 31339000 + FINISHNUMBER: 31340000 + COMMENT HERE WE SHOULD THINK ABOUT CLASSIFYING THE 31341000 + NUMBER, ONCE WE DECIDE WHAT CLASSIFICATIONS 31342000 + WE NEED; 31343000 + SPEC.CLASS ~ NUMBER; 31344000 + FINISH: 31344900 + END NUMBERS; 31345000 + IF P < 0 THEN COMMENT GOBBLE IS RUNNING,31345010 + SO WE LEAVE THINGS LAYING AROUND 31345020 + TO PICK UP--IF GOBBLE DIDNT TURN 31345030 + OFF FONY; 31345040 + BEGIN 31345100 + FONY ~TRUE; 31345110 + RCOUNT ~ COUNT; 31345150 + TABLE ~ SPEC.CLASS; 31345160 + HIDYPLACE ~ SPEC; 31345170 + GO AWAY; 31345190 + INN: FONY ~ FALSE; 31345500 + SPEC ~ HIDYPLACE; 31345550 + COUNT ~ RCOUNT; 31345600 + END; 31345990 + COMMENT NOW WE HAVE SOMETHING, SO WE PUT THE CODED 31346800 + VERSION INTO ELBAT; 31347000 + ELBAT[NXTELBT]~SPEC; 31348000 + COMMENT CHECK THAT ELBAT IS NOT FULL. IF 31349000 + IT IS, DIDDLE IT SO THAT IT WONT 31350000 + OVERFLOW. BE SURE TO SAVE THE LAST 31351000 + 10 THINGS SEEN; 31352000 + IF NXTELBT~NXTELBT+1 > 74 THEN 31353000 + IF MACRO THEN 31354000 + BEGIN 31355000 + MOVE(10,ELBAT[65],ELBAT[0]); 31356000 + NXTELBT~10; I~I-65; P~P-65; 31357000 + END ELBAT ADJUSTMENT; 31358000 + SCANCOUNT ~ SCANCOUNT + 1; 31359000 + END OF WHILELOOP ON P VS NXTELBT; 31360000 + COMMENT NOW WE KNOW THAT ELBAT[P] IS VALID; 31361000 + IF TABLE ~ ELBAT[P].CLASS = COMMENTV THEN 31362000 + BEGIN THI ~ GIT(GT1~ELBAT[P]); 31363000 + FLAGS ~ BOOLEAN(GT1.[1:3]); 31364000 + IF DPTOG THEN TLO~GIT(GT1.LINK -1); 31364100 + IF GT1.[4:1]=1 THEN 31364200 + NEXTADDL ~ NEXTADDL -REAL(DPTOG) -1; 31364300 + ELBAT[P].CLASS ~ TABLE ~ NUMBER; 31365000 + END; 31365100 +AWAY: 31365900 + END TABLE; 31366000 + PROCEDURE DEBLANK; 31367000 + BEGIN 31368000 + LABEL INN, ON; 31368100 + INTEGER STREAM PROCEDURE UB(NCR); VALUE NCR; 31369000 + BEGIN LABEL L; 31370000 + SI~NCR; 31371000 + IF SC=" " THEN BEGIN L: SI~SI+1; IF SC=" " THEN GO L END; 31372000 + UB ~ SI 31373000 + END UB; 31374000 + ON: WHILE NCR ~ UB(NCR) = LCR DO INN: NCR ~ READACARD; 31375000 + IF CHR ~ EXAMINE(NCR) = "%" THEN GO INN; 31375500 + IF CHR = "#" THEN IF DEFINECTR = 0 THEN 31375600 + BEGIN BUMPNCR; UNHOOK; GO ON END; 31376000 + END; 31377000 + COMMENT AND THEN THERE ARE THESE GUYS, AGAIN; 31378000 + PROCEDURE STEPIT; ELCLASS~TABLE(I~I+I); 31379000 + INTEGER PROCEDURE STEPI; STEPI~ELCLASS~TABLE(I~I+1); 31380000 + PROCEDURE CONVERTINTO(HI,LO); REAL HI,LO; 31381000 + COMMENT CONVERTS THE NUMBER IN ACCUM INTO INTERNAL FORM, 31382000 + IN H AND L. IT TRIES TO KEEP THINGS INTEGER; 31383000 + BEGIN REAL J,K; 31384000 + HI~INPUTCONVERT(ACCUM[1],4,N~COUNT.[45:3]); 31385000 + WHILE K 47 THEN FLAG (302) ELSE 31397000 + BEGIN INDEX ~ INDEX - 1; 31398000 + DEFINEARRAY[DEFINEINDEX] ~ LASTUSED & INDEX [3:18:30]; 31399000 + LASTUSED ~ INDEX.[33:15]; 31400000 + DEFINEARRAY[DEFINEINDEX + 2] ~ -NCR 31401000 + & LCR [12:30:18] 31402000 + & DEFINECTR [4:40:8]; 31403000 + DEFINECTR ~ 0; 31404000 + IF DEFINEADDR = 0 THEN DEFINEADDR ~ MKABS(DEFINEARRAY)-1; 31405000 + LCR ~ (DEFINEINDEX ~ DEFINEINDEX + 3) + DEFINEADDR; 31406000 + NCR ~ READACARD 31407000 + END HOOKING UP A DEFINE TYPE ACTION; 31408000 + PROCEDURE UNHOOK; 31409000 + COMMENT UNHOOK RETURNS THE SCANNER FROM A DEFINE-TYPE ACTION, BY 31410000 + UNDOING THE WORK OF HOOK; 31411000 + IF DEFINEINDEX { 0 THEN FLAG(304) ELSE 31412000 + BEGIN 31413000 + LCR ~ (GT1 + DEFINEARRAY[DEFINEINDEX -1]).[12:18]; 31414000 + NCR ~ GT1.[30:18]; 31415000 + DEFINECTR ~ GT1.[4:8]; 31416000 + LASTUSED~(GT1+DEFINEARRAY[DEFINEINDEX+DEFINEINDEX-3]).[33:15]; 31417000 + IF (GT1 ~ GT1.[3:15]) ! 0 THEN 31418000 + BEGIN NEXTADDL ~ TAKE(GT1).LINK; PURGE(-NEXTINFO + GT1) END; 31418100 + END UNHOOKING THE DEFINE ACTION; 31419000 +PROCEDURE DOLLARCARD; 31420000 + COMMENT THIS CODE HANDLES $ CONTROL CARD OPTIONS; 31421000 + BEGIN LABEL QUIT; 31422000 + LABEL LISTEM; 31422100 + ZOT("[", LCR); 31422900 + LCR~LCR+BUMPCHAR; 31423000 + COUNT~RESULT~ACCUM[1]~0; N~SCAN; 31424000 + Q~ACCUM[1]; 31425000 + IF Q="4VOID" THEN 31426000 + BEGIN VOIDING~TRUE; 31427000 + LISTEM: 31427100 + DEBLANK; 31428000 + GT1~MOVECHRS(8,NCR,LASTSEQUENCE+1); 31429000 + COMMENT STORES VOID SEQUENCE NO.; 31430000 + NCR ~ LCR.[CF]; N ~ SCAN; 31430100 + GO QUIT; 31431000 + END; 31432000 + IF Q="7LIST" THEN 31432100 + BEGIN LISTING~TRUE; GO LISTEM END; 31432200 + IF Q="4DUMP" THEN 31433000 + IF SCAN ! LETTER THEN 31434000 + BEGIN DUMPIT(LBUFF); GO QUIT END ELSE 31435000 + BEGIN DUMPTOG ~ ACCUM[1] = "2ON00"; GO QUIT END; 31436000 + IF Q="4TAPE" THEN 31437000 + BEGIN 31437100 + IF LASTUSED=1 THEN LASTUSED~3; 31437200 + TLCR~MKABS(TBUFF[9]); 31437300 + END ELSE 31437400 + BEGIN IF Q!"4CARD" THEN GO QUIT; 31438000 + IF LASTUSED}5 THEN ELSE LASTUSED~1; 31439000 + END; 31440000 + LISTOG.[47:1]~FALSE; 31441000 + INFOTOG~SAVETOG~ 31441100 +DONSBUG ~ %%%%%%%%%%%%%%%%%%%% 31442000 + PRTOG~NEWTOG~RESEQTOG~DEBUGTOG~FALSE; 31443000 + DO BEGIN 31444000 + COUNT~RESULT~ACCUM[1]~0; N~SCAN; 31445000 + Q~ACCUM[1]; 31446000 + IF Q = "4LIST" THEN LISTOG.[47:1] ~ TRUE ELSE 31447000 + IF Q="3NEW0" THEN NEWTOG~TRUE ELSE 31448000 + IF Q="3SEQ0" THEN RESEQTOG~TRUE ELSE 31449000 + IF Q="3PRT0" THEN PRTOG~TRUE ELSE 31450000 + IF RESULT=DIGIT THEN CONVERTINTO(RESEQNR,GT1) ELSE 31451000 + IF RESULT=ADDOP THEN 31452000 + BEGIN 31453000 + N ~ SCAN; 31454000 + IF RESULT= DIGIT THEN CONVERTINTO(RESEQINC,GT1);31455000 + END ELSE 31458000 + IF Q="#PROC" THEN 31458100 + BEGIN 31458200 + IF REAL(SEPARATOG)<0 THEN SEPARATOG~BOOLEAN(2); 31458300 + END ELSE 31458400 + IF Q="6SVIN" THEN 31458500 + BEGIN 31458600 + IF REAL(SVINFOTOG)<0 THEN SVINFOTOG~TRUE; 31458700 + END ELSE 31458800 + IF Q="6DEBU" THEN DEBUGTOG~TRUE ELSE 31459000 + IF Q = "7DONS" THEN DONSBUG ~ TRUE ELSE 31460000 + IF Q ="4INFO" THEN INFOTOG ~ TRUE ELSE 31460100 + IF Q ="4SAVE" THEN SAVETOG ~ TRUE ELSE 31460200 + IF Q = "4POOL" THEN POOLTOG ~ TRUE ELSE 31460300 + IF Q = "4DECK" THEN DECKTOG ~ POOLTOG ~ TRUE ELSE 31460900 + IF Q!"4TAPE" THEN GO QUIT; 31461000 + END 31462000 + UNTIL FALSE; 31463000 +QUIT: 31464000 + END DOLLARDCARD; 31465000 +BOOLEAN PROCEDURE ASSOCIATE (SPEC); VALUE SPEC; INTEGER SPEC; 31466000 + BEGIN COMMENT ASSOCIATE CHECKS THE PARAMETERIZED DEFINE SYNTAX31467000 + AT INVOCATION TIME AND FORCES THE DECLARATION OF A PHONY 31468000 + DEFINED ID THAT POINTS TO THE TEXTUAL MATERIAL ASSOCIATED 31469000 + WITH THE PARAMETER. THE ID HAS THE FORM: "ANQO", WHERE 31470000 + A IS THE LETTER "A", N IS THE LEFT TO RIGHT SEOUENTIAL 31471000 + APPEARANCE NUMBER OF THE PARAMETER AND Q IS A QUESTION 31472000 + MARK. ;31473000 + DEFINE SCAT = IF E ! 0 THEN ERR(E); 31474000 + ASSOCIATE ~ TRUE; 31475000 + GO QUIT;#, 31476000 + LASTI = LASTINFO.LINKR, LASTINFO.LINKC#; 31477000 + LABEL QUIT; 31478000 + INTEGER T, J, E, FINAL, SAVELCLASS; 31479000 + INTEGER CONTEX; 31479100 + DOUBLE (CONTEXT, 3, ~, CONTEX, CONTEXT); 31479200 + SAVELCLASS ~ ELCLASS; 31479500 + ASSOCIATE ~ FALSE; 31480000 + MACRO ~ FALSE; 31481000 + DEFINECTR ~ DEFINECTR + 1; 31481100 + IF ELCLASS ~ TABLE (NXTELBT) = LFTPRN 31482000 + THEN FINAL ~ RTPARN 31483000 + ELSE IF ELCLASS = LFTBRKT 31484000 + THEN FINAL ~ RTBRKT 31485000 + ELSE BEGIN E ~ 305; SCAT END; 31486000 + NXTELBT ~ NXTELBT -1; 31487000 + DO BEGIN 31488000 + ELCLASS ~ TABLE(NXTELBT); 31489000 + NXTELBT ~ NXTELBT -1; 31490000 + MACRO ~ FALSE; 31491000 + IF -(T ~ TEXT(DEFINEP, FINAL)) > 0 31492000 + THEN BEGIN SCAT END 31493000 + ELSE BEGIN 31494000 + Q ~ 31495000 + ACCUM [1] ~ DEFINFO [J]; 31496000 + COUNT ~ 3; 31497000 + SCRAM ~ Q MOD 125; 31498000 + GTB1 ~ ENTER(0,LOCALTYPE,DEFINDID,FALSE); 31499000 + INFO[LASTI].LINK ~ T; 31500000 +DONBUG ("ASSOCI", LASTINFO, 0); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 31501000 + END; 31502000 + END UNTIL J ~ J + 10 > SPEC OR ELCLASS ! COMMA; 31503000 + IF ELCLASS ! FINAL THEN BEGIN E ~ 305; SCAT END; 31504000 +QUIT: 31505000 + CONTEXT ~ CONTEX; 31505100 + DEFINECTR ~ DEFINECTR - 1; 31505200 + MACRO ~ TRUE; 31506000 + ELCLASS ~ SAVELCLASS; 31506500 + END OF ASSOCIATE; 31507000 +BOOLEAN PROCEDURE SYNTAXCK(ELBATCLASS,ERRNO); 31508000 + VALUE ELBATCLASS,ERRNO; 31508100 + REAL ELBATCLASS,ERRNO; 31508200 + BEGIN 31508300 + IF SYNTAXCK ~ (ELBATCLASS!TABLE(I)) THEN 31508400 + ERR(ERRNO); 31508500 + END SYNTAXCK; 31508600 + BOOLEAN PROCEDURE GOBBLE(FROM); VALUE FROM; BOOLEAN FROM; 31510000 + COMMENT GOBBLE GETS UP TO 48 BITS OF STRING FROM THE SOURCE AND 31511000 + PACKS IT INTO ACCUM, THI, AND THIFLAG. IT RETURNS FALSE 31512000 + IF IT FOUND THE END OF THE STRING. GOBBLE MANAGES TO 31513000 + WORRY ABOUT CONCATENATED STRINGS WITH SIZE CODES, AND 31514000 + THINGS LIKE THAT. 31515000 + FROM IS TRUE IF THE STRING IS LEFT-JUSTIFIED (OR IS A 31516000 + CONTINUATION). THE [46:1] OF FROM IS TURNED ON(BY 31517000 + TABLE) TO START A NON-BCL STRING: GOBBLE WILL 31518000 + RETURN TRUE IN[46:1] IF THE NUMBER IN THI IS NOT A 31519000 + VALID STRING TYPE. 31520000 + COUNT WILL BE LEFT CONTAINING THE NUMBER OF BITS HANDLED. 31521000 + CSZ IS THE FRAME SIZE OF THE STRING(1,2,3,4,6,7,8); 31522000 + BEGIN 31523000 + LABEL ROUND,BYE,ECH,INN,OWT,START,WAY; 31524000 + REAL S; INTEGER T, C; 31525000 + DEFINE NEXTCR = BUMPNCR ELSE NCR#; 31525100 + DEFINE TABLET=BEGIN C~COUNT; T~ TABLE(-1); COUNT~C END#; 31525200 + COUNT ~ ACCUM[9] ~ 0; 31526000 + FLAGS ~ BOOLEAN(ACCUM[2]~0); 31527000 + LEFTY ~ FROM; 31527100 + S ~ CONTEXT; CONTEXT ~ 5; 31527200 + CHR ~ EXAMINE(NCR); 31528000 + COMMENT IF TABLE FINDS AN INTEGER AND A ", HE CALLS 31529000 + US WITH [46:1] TRUE; 31530000 + IF FROM.[46:1] THEN GO TO START; 31531000 + ROUND: COMMENT CHR CONTAINS THE NEXT CHARACTER TO BE 31532000 + CONSIDERED; 31533000 + CASE CSZ OF 31534000 + BEGIN COMMENT DEPENDING ON THE FRAME SIZE, CHECK AND/OR 31535000 + TRANSLATE THE CHARACTER; 31536000 + GO ECH; COMMENT INVALID; 31537000 + IF CHR > 1 THEN GO ECH; COMMENT BINARY; 31538000 + IF CHR > 3 THEN GO ECH; COMMENT QUATERNARY; 31539000 + IF CHR > 7 THEN GO ECH; COMMENT OCTAL; 31540000 + IF CHR > 9 THEN COMMENT HEXADECIMAL; 31541000 + IF CHR < "A" THEN GO ECH ELSE 31542000 + IF CHR > "F" THEN GO ECH ELSE CHR ~ CHR - 7; 31543000 + GO ECH; COMMENT INVALID; 31544000 + ; COMMENT BCL; 31545000 + COMMENT THE ASCII(CSZ=7) AND EBCDIC(CSZ=8) 31546000 + TRANSLATIONS ARE IN THE ARRAY SPECIAL; 31547000 + IF CHR ~ SPECIAL[CHR].ASCF = 0 THEN GO ECH; 31548000 + IF CHR ~ SPECIAL[CHR].EBCDF = 0 THEN 31549000 + ECH: FLAG(307) 31550000 + END CASES OF CHARACTER SIZE; 31551000 + COMMENT CHR NOW HAS THE CHARACTER TO BE PLACED INTO 31552000 + ACCUM; 31553000 + MOVEBITS(CHR,GT2 ~ IF CSZ=7 THEN 8 ELSE CSZ, 31554000 + 48-GT2, ACCUM[9], COUNT); 31555000 + COUNT ~ COUNT + GT2; 31556000 + COMMENT WE MUST NOW LOOK FOR THE END OF THE STRING, 31557000 + SO THAT WE WILL PROPERLY HANDLE A STRING WITH 31558000 + EXACTLY 48 BITS; 31559000 + IF CHR ~ EXAMINE(NEXTCR) = """ THEN 31560000 + BEGIN 31561000 + COMMENT THFRE IS A QUOTE, SO WE GO PAST IT AND LOOK 31562000 + SOME MORE; 31563000 + BUMPNCR; 31564000 + IF DEFINECTR ! 0 THEN GO OWT; 31564100 + TABLET; 31565000 + IF T ! NUMBER THEN 31566000 + IF T ! STRNGCON THEN GO OWT ELSE 31566100 + BEGIN 31567000 + COMMENT THERE ARE TWO QUOTES, MEANING A CONCATEN- 31568000 + ATION. WE PREPARE TO CHANGE FRAME SIZE TO 6; 31569000 + THI ~ DEFAULTSIZE; GO INN; % OR SOMETHING. 31570000 + END; 31571000 + FONY ~ FALSE; 31572000 + TABLET; IF T ! STRNGCON THEN GO BYE; 31583000 + START: COMMENT THERE IS A QUOTE, SO WE EXAMINE THE NUMBER 31584000 + IN THI TO SEE IF IT IS A VALID STRING CODE; 31585000 + IF THI > 480 THEN GO BYE; 31586000 + IF GT1 ~ (IF THI MOD 10 = 0 THEN THI DIV 10 ELSE THI)=0 31586500 + THEN GO BYE; 31587000 + IF GT1 < 10 THEN C ~ GT1 ELSE 31587500 + IF C ~ GT1 MOD 10 { GT1 ~ GT1 DIV 10 THEN GO BYE; 31588000 + IF C } 9 THEN GO BYE; 31588500 + IF (C~ REAL(C=7)+C)/GT1 MOD 1 ! 0 THEN GO BYE; 31589000 + IF C > MAXCSZ THEN MAXCSZ ~ C; 31590000 + IF GT1 < 1 THEN GO BYE; 31591000 + IF GT1 = 5 THEN 31592000 +BYE: COMMENT WE HAVE AN INVALID SIRING CODE; 31593000 + BEGIN FLAG(0308); GO OWT END; 31594000 + COMMENT WE PASSED ALL THE TESTS, SO WE HAVE A NEW 31611000 + FRAME SIZE; 31612000 + IF THI ~ GT1 } 9 THEN GO BYE; 31615000 +INN: COMMENT NOW WE FUDGE THE BIT COUNTER, SO THAT THE NEW31616000 + FRAMES START IN THE RIGHT PLACE; 31617000 + COUNT ~ ABS(ENTIER(-COUNT/THI)) | THI; 31618000 + IF (CSZ ~ THI) > MAXCSZ THEN 31619000 + MAXCSZ ~ IF CSZ = 7 THEN 8 ELSE CSZ; 31619100 + THI ~ 0; 31620000 + CHR ~ EXAMINE(NCR); 31621000 + COMMENT NOW EVERYTHING IS SET UP AS IF THE QUOTE 31622000 + NONSENSE HAD NEVER HAPPENED; 31623000 + END OF NONTERMINAL QUOTE HANDLING; 31624000 + COMMENT WE MAY NOW CHECK FOR 48 BITS; 31625000 + IF COUNT < 48 THEN GO ROUND; 31626000 + COMMENT WE DIDNT FIND THE TERMINATOR OF THE STRING, 31627000 + BUT WF HAVE BITTEN OFF A COMPLETE MOUTHFUL OF 31628000 + STUFF. WE RETURN TRUE TO THE GUY WHO IS GOING 31629000 + TO SWALLOW; 31630000 + GOBBLE ~ TRUE; 31631000 +OWT: COMMENT ACCUM HAS AS MUCH STRING AS WE ARE GOING TO 31632000 + HANDLE, SO WE PUT THE STUFF INTO THI. IT MAY BE31633000 + EITHER LEFT OR RIGHT JUSTIFIED; 31634000 + IF COUNT } 48 OR FROM THEN 31635000 + BEGIN COMMENT LEFT JUSTIFIED: THE MOST-SIGNIFICANT BIT GETS31636000 + HANDLED WITH EXTREME CARE; 31637000 + THIFLAG ~ FLAGBIT(ACCUM[9]); 31638000 + DEFINESFLAG ~ THIFLAG; 31638100 + THI ~ ACCUM[9]; 31639000 + END ELSE 31640000 + BEGIN 31641000 + THI ~ 0; 31642000 + MOVEBITS(ACCUM[9], COUNT, 0, THI, 48-COUNT); 31643000 + DEFINESFLAG ~ FLAGBIT(ACCUM[9]); 31643100 + END; 31644000 + CONTEXT ~ S; 31645000 +END GOBBLE; 31646000 +COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 40000000 + THE EMITTERS 40001000 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;40002000 + ALPHA PROCEDURE O(A); VALUE A; REAL A; 40003000 + O~A.[45:3]&A[39:42:3]&A[33:39:3]&A[27:36:3]&A[21:33:3] 40004000 + &A[15:30:3]&A[9:27:3]&A[3:24:3]; 40005000 + COMMENT BUGOUT FORMATS AND PRINTS DEBUGGING INFO-NOTE THAT THE PARAMS 40006000 + HAVE DIFFERENT MEANINGS AT DIFFENT CALLS; 40007000 + PROCEDURE BUGOUT(F,OP,P1,P2,P3); VALUE F,OP,P1,P2,P3; 40008000 + INTEGER F,OP,P1,P2,P3; 40009000 + BEGIN 40010000 + INTEGER I; 40011000 + ALPHA HEGS; 40012000 + DEFINE Q(Q1)=(O(Q1) & 29[24:43:5])#, H = HEXOUT #; 40012100 + LABEL L0,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,WAY; 40012200 + SWITCH SW ~ L0,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10; 40012300 + BLANKOUT(16,LBUFF); 40013000 + HEGS ~ " "; 40014000 + IF FIGS THEN BEGIN 40015000 + INSERT(2,"**",LBUFF[7],0); 40016000 + IF FIGS.[46:1] THEN FIGS ~ FALSE END; 40017000 + I ~ IF F = 7 THEN P1 ELSE L; 40017100 + INSERT(4,H(I DIV 6), LBUFF[7],3); % PIR - HEX 40018000 + INSERT(2,(I ~ I MOD 6) + ":0", LBUFF[7],7); 40018100 + INSERT(4,OPS[IF F = 7 THEN 768 ELSE OP],LBUFF[8],3); 40019000 + 40019100 + 40019200 + GO TO SW[F + 1]; GO WAY; 40020000 + L2: P2 ~ (P1 DIV 6) & I ~ P1 MOD 6[32:45:3];% BRANCH OP 40021000 + GO TO L10; 40021100 + L7: P1 ~ P2; % LINK 40022000 + L10: I ~ P1 MOD 6 + ":0"; 40023000 + INSERT(6,I + H(P1 DIV 6 | 256), LBUFF[9],1); % 10 =MPCW 40023100 + IF F = 10 THEN GO TO L9; 40023200 + 40023300 + HEGS.[12:24] ~ H(P2); 40023400 + GO TO L0; 40023500 + L1: P1 ~ OP; OP ~ VARI; GO TO L3; % VARIANT OP 40024000 + L8: % 4 PARAMS 40025000 + INSERT(2,H(P3.[16:8]),LBUFF[11],4); 40025100 + L5: % 3 PARAMS 40026000 + HEGS ~ H(P3); 40026100 + L4: % 2 PARAMS 40027000 + HEGS.[24:12] ~ H(P2); 40027100 + L3: % 1 PARAM 40027200 + HEGS.[12:12] ~ H(P1); 40027300 + L0: % PRIMARY 40027400 + INSERT(8, HEGS & H(OP) [1:37:11], LBUFF[10],4); 40027500 + GO WAY; 40027600 + L9: % LT48 40027700 + 40027800 + INSERT(2,H(OP),LBUFF[10],4); 40027820 + INSERT(GTI1~ 5 - L MOD 6, "FFFFF", LBUFF[10], 6); 40027840 + INSERT(GTI1,"FFFFF",LBUFF[10],6+GTI1); 40027860 + INSERT(6, H(P2),LBUFF[10],6+GTI1+GTI1); 40027900 + INSERT(6, H(P3),LBUFF[11],4+GTI1+GTI1); 40028000 + GO WAY; 40028100 + L6: % VALC/NAMC 40028200 + INSERT(4,"(00," + H(P1 | 16), LBUFF[9],1); 40028300 + 40028400 + INSERT(5, H(P2|16)+ ")", LBUFF[9],5); 40028500 + 40028600 + INSERT(4, H(P3), LBUFF[10],4); 40028700 + WAY: WRITELBUFF; 40029000 + END OF BUGOUT; 40030000 + COMMENT GET RETURNS A SYLLABLE FROM EDOC; 40031000 + INTEGER PROCEDURE GET(L); VALUE L; INTEGER L; 40032000 + BEGIN 40033000 + MOVE8BITS(EDOC[(GT1~L DIV 6).[35:5],GT1.[40:8]],GTI1~L MOD 6,L)40034000 + ; GET ~ L.[40:8] 40035000 + END GET; 40036000 + COMMENT PUTSYL PUTS A SYLLABLE INTO EDOC, THE OBJECT COOE ARRAY; 40037000 + PROCEDURE PUTSYL(SYL); VALUE SYL; INTEGER SYL; 40038000 + BEGIN 40039000 + REAL GT1;%FOR WALLY 40040000 + STREAM PROCEDURE PUTS(S,W,B); VALUE S,B; 40041000 + BEGIN DI~W; B(SKIP 8 DB); SI~LOC W; SI~SI-2; SKIP 4 SB; 40042000 + 8(IF SB THEN DS~SET ELSE DS~RESET; SKIP SB) 40043000 + END PUTS; 40044000 + PUTS(SYL,EDOC[(GT1~L DIV 6).[35:5],GT1.[40:8]],GTI1~L MOD 6) 40045000 + END PUTSYL; 40046000 + COMMENT EMIT EMITS ONE OR TWO SYLLABLES, AS IT THINKS APPROPRIATE; 40047000 + PROCEDURE EMIT(OP); VALUE OP; INTEGER OP; 40048000 + BEGIN 40049000 + IF DEBUGTOG THEN 40050000 + BUGOUT(REAL(OP MOD 512 > 255),OP,0,0,0); 40051000 + IF OP > 255 THEN 40052000 + IF OP < 512 THEN BEGIN PUTSYL(VARI); L ~ L + 1 END; 40053000 + PUTSYL(OP); 40053100 + IF L ~ L + 1 > 49150 THEN FLAG(400) 40053200 + END EMIT; 40054000 + COMMENT EMITV EMITS A VALUE-CALL ON THE LOCATION GIVEN BY ITS PARAM, A.40055000 + THE FORMAT OF A(BOTH FOR EMIIV AND EMITN) IS THAT OF THE 40056000 + ADDRESS FIELD OF AN ELBAT-WORD. IN PARTICULAR, [36:12] IS THE 40057000 + DISPLACEMENT, AND [31:5] IS THE LEVEL; 40058000 + PROCEDURE EMITV(A); VALUE A; INTEGER A; 40059000 + BEGIN 40060000 + LITERALS ~ FALSE; 40060100 + IF ADRCPL ~ A.[36:12] & A[35:29:1] > MAXDISP THEN FLAG(401); 40061000 + ADRCPL ~ STACKMASK[A.[31:5]].[CF] + ADRCPL; 40062000 + IF DEBUGTOG THEN 40063000 + BUGOUT(6,VALC,A.[31:5],A.[36:12]&A[35:29:1],ADRCPL); 40064000 + PUTSYL(ADRCPL.[34:6]); L~L+1; PUTSYL(A); 40065000 + IF L~L+1>49150 THEN FLAG(400); 40066000 + END EMITV; 40067000 + COMMENT EMITN EMITS A NAME-CALL. SEE THE EMITV COMMENT FOR DETAILS; 40068000 + PROCEDURE EMITN(A);VALUE A; INTEGER A; 40069000 + BEGIN 40070000 + LITERALS ~ FALSE; 40070100 + IF ADRCPL ~ A.[36:12] & A[35:29:1] > MAXDISP THEN FLAG(401); 40071000 + ADRCPL ~ STACKMASK[A.[31:5]].[CF] + ADRCPL + 16384; 40072000 + IF DEBUGTOG THEN 40073000 + BUGOUT(6,NAMC,A.[31:5],A.[36:12]&A[35:29:1],ADRCPL); 40074000 + PUTSYL(ADRCPL.[32:8]); L ~ L+ 1 ; PUTSYL(ADRCPL); 40075000 + IF L~L+1}49150 THEN FLAG(400); 40076000 + END EMITN; 40077000 + PROCEDURE EMITB(B,F,T); VALUE B,F,T; INTEGER B,F,T; 40078000 + BEGIN 40079000 + INTEGER TL; 40080000 + TL~L; L~F-3; 40081000 + IF DEBUGTOG THEN 40082000 + BEGIN FIGS ~ F ! TL OR TB1 ~ FIGS; 40082100 + BUGOUT(2,B,T,0,0); 40082200 + FIGS ~ TB1 AND NOT TB1.[46:1]; 40082300 + END; 40082400 + PUTSYL(B); L~L+1; 40083000 + PUTSYL((T DIV 1536)&(GTI1~T MOD 6)[40:45:3]); L ~L + 1; 40084000 + PUTSYL(T DIV 6); 40085000 + L ~ TL; 40086000 + END EMITR; 40087000 + PROCEDURE EMITD(A,B,N); VALUE A,B,N; INTEGER A,B,N; 40088000 + IF N - A = 1 THEN 40089000 + EMIT2P(INSR,B,N) ELSE 40090000 + EMIT3P(FLTR,A,B,N); 40091000 + ALPHA PROCEDURE HEXOUT(N); VALUE N; ALPHA N; 40092000 + COMMENT HEXOUT CONVERTS HALF OF A WORD (24 BITS) INTO BCL-CODED 40093000 + HEXADECIMAL (CHARACTERS 0-9, A-F). IT FIRST PLACES EACH 40094000 + 4-BIT DIGIT (OR HEXIT) INTO ONE 6-BIT CHARACTER. THEN 40095000 + IT ADDS "6" TO EACH CHARACTER: ANY CHARACTER WHICH 40096000 + OVERFLOWS INTO THE 16S BIT REQUIRES CONVERSION TO A LETTER40097000 + WE "AND" THE SUM WITH "+"S TO CATCH THAT BIT, AND SHIFT 40098000 + THE RESULT RIGHT BY FOUR BITS. MULTIPLYING THIS RESULT BY40099000 + SEVEN YIELDS A 7 IN EACH CHARACTER-POSITION NEEDING TO BE 40100000 + CONVERTED. THE CONVERSION IS ACCOMPLISHED BY ADDING THIS 40101000 + PRODUCT TO THE RESULT OF THE FIRST (CHAR + HEXIT) 40102000 + OPERATION; 40103000 + HEXOUT ~ REAL( BOOLEAN((N ~ N.[44:4] & N[38:40:4] & N [32:36:4] 40104000 + & N [26:32:4] & N[20:28:4] & N[14:24:4]) + "666666") 40105000 + AND BOOLEAN("++++++")).[12:32] | 7 + N; 40106000 + 40107000 + 40108000 + 40109000 + 40110000 +PROCEDURE EMITNUMBER(N,STRINGSOURCEFLAG); VALUE N, STRINGSOURCEFLAG; 40111000 + REAL N, STRINGSOURCEFLAG; 40111100 + BEGIN 40112000 + LABEL ON; 40113000 + REAL GT1; % FOR TALLY 40114000 + BOOLEAN S; 40115000 + IF BOOLEAN(STRINGSOURCEFLAG) OR N.[2:30] ! 0 THEN GO ON; 40121000 + S ~ BOOLEAN(N.[1:1]); N ~ ABS(N); 40122000 + IF N=0 THEN EMIT(ZERO) ELSE 40123000 + IF N=1 THEN EMIT(ONE) ELSE 40124000 + 40125000 + IF N.[9:31]=0 THEN 40126000 + EMIT1P(LT8,N) ELSE 40127000 + 40128000 + 40129000 + 40130000 + IF N.[9:23]=0 THEN 40131000 + EMIT2P(LT16,N.[32:8],N.[40:8]) ELSE 40132000 + BEGIN 40137000 + ON: IF DEBUGTOG THEN BUGOUT(9,LT48 ,0,N.[1:23] 40138000 + & STRINGSOURCEFLAG [24:47:1],N.[24:24]); 40138100 + PUTSYL(LT48); WHILE(L~L+1)MOD 6 ! 0 DO PUTSYL(NVLD); 40138200 + FLOG(STRINGSOURCEFLAG,N,EDOC[(GT1~L DIV 6).LINKR, 40139000 + GT1.LINKC]); 40140000 + IF L ~ L + 6 } 49150 THEN FLAG(400) 40141000 + END LT48; 40142000 + 40143000 + 40144000 + IF S THEN EMIT(CHSN) 40145000 + END EMITNUM; 40146000 + PROCEDURE EMITDP(H,J); VALUE H,J; REAL H,J; 40147000 + BEGIN 40148000 + EMITNUM(H); 40149000 + IF J = 0 AND J.[1:8] = 0 THEN EMIT(XTND) ELSE 40150000 + BEGIN EMITNUM(J); EMIT(JOIN) END; 40151000 + END EMITDP; 40152000 + PROCEDURE EMITPAIR(A,O); VALUE A,O; INTEGER A,O; 40153000 + BEGIN EMITN(A); EMIT(O) END EMITPAIR; 40154000 + PROCEDURE EMITNOT; 40155000 + COMMENT EMITNOT SOMETIMES EMITS AN LNOT. AT OTHER TIMES, DEPENDING 40156000 + ON THE VALUE OF LASTNOT, IT WILL CANCEL AN LNOT THAT HAD 40157000 + JUST BEEN EMITTED, OR IT WILL INVERT A RELATIONAL 40158000 + OPERATOR; 40159000 + IF LASTNOT = L THEN COMMENT LAST THING WAS AN LNOT; 40160000 + BEGIN L ~ L - 1; LASTNOT ~ 0; FIGS ~ BOOLEAN(3) END ELSE 40161000 + IF LASTNOT = -L AND GET(L-1) ! SAME THEN 40162000 + BEGIN 40162100 + FIGS ~ TRUE; 40162200 + EMIT(REAL(BOOLEAN(GET(L~L-1)) EQV NOT TRUE).[40:8]); 40163000 + FIGS ~ FALSE; 40163100 + COMMENT "EQV NOT TRUE" COMPLEMENTS THE LOW-ORDER BIT, 40164000 + WHICH IS SUFFICIENT TO INVERT THE RELATION; 40165000 + END ELSE 40165100 + COMMENT OUT OF LUCK. GOT TO EMIT SOMETHING; 40166000 + BEGIN EMIT(LNOT); LASTNOT ~ L END EMITNOT; 40167000 + INTEGER PROCEDURE GET3(L); VALUE L; INTEGER L; 40168000 + COMMENT GET3 RETURNS THE THREE SYLLABLES IN EDOC AT L; 40169000 + GET3 ~ GET(L+2) & GET(L+1)[32:40:8] & GET(L)[24:40:8]; 40170000 + PROCEDURE EMIT3(LINK); VALUE LINK; INTEGER LINK; 40171000 + COMMENT EMIT3, ALSO KNOWN AS EMITLINK, EMITS THREE SYLLABLES. IF 40172000 + WE ARE LISTING THE CODE, THE LISTING WILL SAY THAT IT IS A 40173000 + LINK; 40174000 + BEGIN 40175000 + IF DEBUGTOG THEN BUGOUT(7, LINK.[24:8],L,LINK.[32:16],0); 40176000 + PUTSYL(LINK.[24:8]); IF L~L+1 } 49148 THEN FLAG(400); 40177000 + PUTSYL(LINK.[32:8]); L ~ L + 1; 40178000 + PUTSYL(LINK); L ~ L + 1; 40179000 + END EMITLINK; 40180000 + PROCEDURE EMIT1P(OP,A); VALUE OP,A; INTEGER OP,A; 40181000 + BEGIN 40182000 + IF OP > 255 THEN 40183000 + IF OP < 512 THEN EMIT(VARI); 40184000 + IF DEBUGTOG THEN BUGOUT(3,OP,A,0,0); 40185000 + PUTSYL(OP); L~L + 1; PUTSYL(A); 40186000 + IF L ~ L + 1 } 49150 THEN FLAG(400) 40187000 + END; 40188000 + PROCEDURE EMIT2P(OP,A,B); VALUE OP,A,B; INTEGER OP,A,B; 40189000 + BEGIN 40190000 + IF OP > 255 THEN 40191000 + IF OP < 512 THEN EMIT(VARI); 40192000 + IF DEBUGTOG THEN BUGOUT(4,OP,A,B,0); 40193000 + PUTSYL(OP); L ~ L + 1; PUTSYL(A); L ~ L + 1; PUTSYL(B); 40194000 + IF L ~ L + 1 } 49150 THEN FLAG(400) 40195000 + END EMIT2P; 40196000 + PROCEDURE EMIT3P(OP,A,B,C); VALUE OP,A,B,C; INTEGER OP,A,B,C; 40197000 + BEGIN 40198000 + IF OP > 255 THEN 40199000 + IF OP < 512 THEN EMIT(VARI); 40200000 + IF DEBUGTOG THEN BUGOUT(5,OP,A,B,C); 40201000 + PUTSYL(OP); L ~ L + 1; PUTSYL(A); L ~ L + 1; 40202000 + PUTSYL(B); L ~ L + 1; PUTSYL(C); 40203000 + IF L ~ L + 1 } 49150 THEN FLAG(400) 40204000 + END EMIT3P; 40205000 + PROCEDURE EMIT4P(OP,A,B,C,D); VALUE OP,A,B,C,D; 40206000 + INTEGER OP,A,B,C,D; 40207000 + BEGIN 40208000 + IF OP } 256 THEN IF OP < 512 THEN EMIT(VARI); 40208100 + IF DEBUGTOG THEN BUGOUT(8,OP,A,B,C&D[16:40:8]); 40209000 + PUTSYL(OP); L ~ L + 1; PUTSYL(A); L ~ L + 1; PUTSYL(B); 40210000 + L ~ L + 1; PUTSYL(C); L ~ L + 1; PUTSYL(D); 40211000 + IF L ~ L + 1 > 49150 THEN FLAG(400); 40212000 + END EMIT4P; 40213000 + PROCEDURE EMITBUZEVENT; 40214000 +COMMENT EMITS CODE WHICH BUZZES LOCK BIT IN AN EVENT. CODE HAS 40215000 + PREVIOUSLY BEEN EMITTED TO PLACE POINTER(INDEXED DD OR IRW) TO 40216000 + EVENT IN TOS. THE BUZZ IS IN NORMAL STATE; 40217000 + BEGIN 40218000 + INTEGER TI1; 40219000 + EMIT(ZERO); 40220000 +COMMENT **** 40220200 + EMIT(EEXI); 40221000 + TI1~L; 40222000 + EMIT(DEL); 40223000 + EMIT(DUPL); 40224000 + EMIT(ONE); 40225000 + EMIT(RDLK); 40226000 + EMIT(DUPL); 40227000 +COMMENT IN TOS AT THIS POINT-TWO POINTERS TO EVENT,TWO COPIES OF FIRST 40228000 + WORD OF EVENT; 40229000 + EMITB(BRTR,BUMPL,TI1); % END OF EVENT BUZZ LOOP 40230000 + EMIT(ZERO); EMIT(STAG); %ZOT THE D.P. TAG 40230500 +COMMENT **** 40230520 + EMIT(DEXI); 40231000 +COMMENT IN TOS AT THIS POINT-POINTER TO EVENT(IRW OR INDEXED DD),FIRST 40232000 + WORD OF EVENT(WITH DOUBLE TAG); 40233000 + END EMITBUZEVENT; 40234000 + PROCEDURE EMITMICRO(WORD); VALUE WORD; ALPHA WORD; 40236000 + BEGIN 40237000 + DEFINE P1 = WORD.[35:8]#, 40238000 + P2 = WORD.[27:8]#, 40239000 + P3 = WORD.[19:8]#, 40240000 + OP = WORD.[44:4]+719 #, 40241000 + N = WORD.[17:2]#; 40242000 + INTEGER J; 40243000 + J ~ WORD.[1:16]; 40244000 + DO CASE REAL(J!0)|4 + N OF 40245000 + BEGIN 40246000 + EMIT(OP); 40247000 + EMIT1P(OP,P1); 40248000 + EMIT2P(OP,P1,P2); 40249000 + EMIT3P(OP,P1,P2,P3); 40250000 + EMIT1P(OP,MIN(J,255)); 40251000 + EMIT2P(OP,MIN(J,255),P1); 40252000 + EMIT3P(OP,MIN(J,255),P1,P2); 40253000 + EMIT4P(OP,MIN(J,255),P1,P2,P3) 40254000 + END CASE UNTIL J ~ J - 255 { 0; 40255000 + END EMITMICRO; 40256000 + PROCEDURE PRINTSPACE(ID,LL,DISP); VALUE ID,LL,DISP; 40260000 + ALPHA ID,LL,DISP; 40261000 + BEGIN INTEGER X; DEFINE H = HEXOUT #; 40262000 + BLANKOUT(16,LBUFF); 40263000 + IF ID ! 0 THEN 40264000 + IF ID < 0 THEN INSERT(X~6, ID,LBUFF[0],0) ELSE 40265000 + MOVECHARACTERS(X~TAKE(ID+1).CHRCNT,INFO[ID.LINKR,ID.LINKC+1],4,40266000 + LBUFF[0],0); 40267000 + INSERT(5,H(LL|16)+"=(00,",LBUFF[ID~X.[39:6]],X~X.[45:3]); 40268000 + INSERT(5,H(DISP|16)+")",LBUFF[ID],X+5); 40269000 + 40270000 + 40271000 + WRITELBUFF; 40272000 + END PRINTSPACE; 40273000 +COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 44000000 + SERVICE ROUTINES 44001000 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;44002000 + COMMENT FLAG WRITES ERROR MESSAGES ON THE PRINTER, USUALLY; 44003000 + PROCEDURE FLAG(NR); VALUE NR; INTEGER NR; 44004000 + IF ERRORTOG THEN 44004100 + BEGIN STREAM PROCEDURE EDITERR(N,C,W,L,S); VALUE N,C,S; 44005000 + BEGIN 44006000 + DI ~ L; 8(DS ~ 2 LIT ">"); 44(DS ~ 2 LIT " "); 44007000 + 8(DS ~ 2 LIT "<"); DS ~ 2 LIT " "; SI ~ S; DS ~ 8 CHR; 44008000 + DI~W; DI~DI+C; DS~14 LIT"~ERROR NUMBER "; 44009000 + SI~LOC N; DS~3 DEC; DS~LIT"."; SI~S;SI~SI-16;DI~S; DS~WDS;44010000 + END; 44011000 + STREAM PROCEDURE PREPERR(LBUFF); 44012000 + BEGIN DI ~ LBUFF; DS ~ 16 LIT ".DEFINED TO BE: "; 44013000 + 38(DS ~ 4 LIT " ") 44014000 + END PREPERR; 44015000 + INTEGER J,K,C,W,START; 44016000 + IF DEFINEINDEX>0 THEN 44017000 + BEGIN GT1~(GT2~DEFINEARRAY[2]).[30:18]; % GT1=NCR 44018000 + GT2~GT2.[12:18]; % GT2=LCR 44019000 + GT3~DEFINEARRAY[0] % GT3=LASTUSED 44020000 + END ELSE 44021000 + BEGIN GT1~NCR; GT2~LCR; GT3~LASTUSED END; 44022000 + IF NOT LISTOG THEN 44023000 + BEGIN IF LISTOG.[46:1] THEN DATIME; LISTOG~FALSE; 44024000 + BLANKOUT(16, LBUFF); 44024100 + ZOT(EXAMINE(LASTSEQUENCE),GT2); 44025000 + EDITLINE(GT2-9,GT3,0,0,0,0,LBUFF); 44026000 + ZOT("%",GT2); 44027000 + WRITELBUFF 44028000 + END FORCED LISTING; 44029000 + EDITERR(NR,GT1.[30:3],LBUFF[GT1-GT2+11],LBUFF,LASTSEQUENCE 44030000 + +2); 44031000 + WRITELBUFF; 44032000 + FOR J ~ 3 STEP 3 UNTIL DEFINEINDEX DO 44033000 + BEGIN PREPERR(LBUFF); K ~ 1; 44034000 + IF J < DEFINEINDEX THEN 44035000 + BEGIN W ~ DEFINEARRAY[J].[CF]; 44036000 + C ~ DEFINEARRAY[J+2].[30:3] 44037000 + END ELSE 44038000 + BEGIN W ~ LASTUSED; C ~ NCR.[30:3] END; 44039000 + IF W - START ~ DEFINEARRAY[J-3].[FF] > 8 THEN START ~W-8; 44040000 + WHILE START ~ START + 1 < W DO 44041000 + MOVE(1,ADDL[START.LINKR,START.LINKC],LBUFF[K~K+1]); 44042000 + MOVECHARACTERS(C,DEFINEARRAY[J-2],0,LBUFF[K+1],0); 44043000 + WRITELBUFF 44044000 + END OF PRINTING DEFINED STUFF; 44045000 + ERRORCOUNT~ERRORCOUNT+1; 44046000 + IF DUMPTOG THEN DUMPIT(LBUFF); 44047000 + ERRORTOG ~ FALSE; 44047100 + END FLAG; 44048000 + INTEGER PROCEDURE GETSPACE(LEVEL); VALUE LEVEL; INTEGER LEVEL; 44049000 + COMMENT GETSPACE ASSIGNS STACK SPACE AND RETURNS THE ADDRESS-FIELD 44050000 + VALUE FOR THAT SPACE. THE PARAMETER, LEVEL, INDICATES THE 44051000 + ADDRESSING LEVEL AT WHICH THE SPACE IS TO BE ALLOCATED. 44052000 + HOWEVER, IF AN ADDRESS PART IS GIVEN IN THE SOURCE, IT WILL 44053000 + OVERRIDE THE NORMAL ALLOCATION: IF THE PARAMETER HAS ITS SIGN 44054000 + BIT ON, HOWEVER, WE WILL NOT LOOK FOR AN ADDRESS PART. THE 44055000 + EXPONENT-SIGN BIT IS ON IF TWO SPACES ARE NEEDED, AS FOR 44055100 + DOUBLE PRECISION. THE 44055200 + CALLER IS INFORMED OF THE EXISTANCE OF THE ADDRESS PART VIA THE44056000 + SIGN BIT OF THE RESULT; 44057000 + BEGIN 44058000 + INTEGER ADRF; COMMENT THE DISPLACEMENT FIELD; 44059000 + INTEGER N; COMMENT # SPACES NEEDED; 44059100 + LABEL ON; 44060000 + BOOLEAN B; 44061000 + N ~ LEVEL.[2:1] + 1; 44061100 + IF B ~ LEVEL.[1:1] = 0 THEN 44062000 + IF TABLE(I+1) = RELOP THEN % ADDR PART JUST MIGHT BE THERE. 44063000 + IF ELBAT[I+1].DISP ! EQUL THEN 44064000 + FLAG(408) ELSE % OOPS--WRONG RELATIONAL. 44065000 + BEGIN STEPIT; % PAST THE "=". 44066000 + ADRF~CONTEXT; CONTEXT~2; %LET THE SCANNER WORK RIGHT. 44067000 + STEPIT; % GET THE NEXT THING. 44068000 + CONTEXT ~ ADRF; % UNFUTZ THE SCANNER. 44069000 + IF ELCLASS < IDMAX THEN % ID COPY ADDRESS 44070000 + IF ELBAT[I].ADDRESS = 0 THEN % BUT THE ADDRESS IS BAD NEWS44071000 + FLAG(407) ELSE 44072000 + IF ELBAT[I].LINK < FIRSTINFO THEN FLAG(408) ELSE 44072100 + BEGIN 44073000 + LEVEL ~ ELBAT[I].LVEL; 44074000 + ADRF ~ -ELBAT[I].DISP & ELBAT[I] [35:2:1]; 44075000 + IF TABLE(I+1) = ADDOP THEN 44075100 + BEGIN 44075200 + STEPIT; 44075300 + IF STEPI ! NUMBER THEN FLAG(408) ELSE 44075400 + ADRF ~(IF ELBAT[I-1].ADDRESS=ADD THEN -THI 44075500 + ELSE THI) + ADRF; 44075600 + END; 44075700 + GO ON 44076000 + END IDENTIFIER AS ADDRESS PART; 44077000 + IF ELCLASS ! LFTPRN THEN 44078000 + FLAG(408) ELSE 44079000 + BEGIN 44080000 + IF STEPI = ADDOP THEN % IS + OR - 44081000 + IF ELBAT[I].ADDRESS ! SUBT THEN % 44082000 + FLAG(408) ELSE % IT WAS +: ERROR 44083000 + IF STEPI ! NUMBER THEN % NOT A NUMBER IS BAD. 44084000 + FLAG(408) ELSE % 44085000 + LEVEL ~ LEVEL - THI ELSE % NUMBER IS RELATIVE. 44086000 + IF ELCLASS ! NUMBER THEN % WAS NOT SIGN (+ OR -). 44087000 + FLAG(408) ELSE 44088000 + LEVEL ~ THI; % UNSIGNED NR IS ABSOLUTE. 44089000 + IF LEVEL < 0 OR 44090000 + LEVEL > CURRENT THEN 44091000 + FLAG(407); 44092000 + IF STEPI ! RTPARN THEN % CHECK FOR DISPLACEMENT. 44093000 + IF ELCLASS ! COMMA THEN 44094000 + FLAG(408) ELSE 44095000 + BEGIN 44096000 + IF STEPI ! NUMBER THEN 44097000 + FLAG(408) ELSE ADRF ~-THI; 44098000 + IF STEPI ! RTPARN THEN FLAG(408); 44099000 + GO ON 44100000 + END ELSE % NO DISP GIVEN 44101000 + BEGIN 44102000 + IF STACKTOP[LEVEL] ~-(ADRF~-STACKTOP[LEVEL])+ N 44103000 + > MAXSTACK[LEVEL] THEN 44104000 + MAXSTACK[LEVEL] ~ STACKTOP[LEVEL]; 44105000 + GO ON 44106000 + END; END; END ABNORMAL ALLOCATION; 44107000 + IF STACKTOP[LEVEL~ABS(LEVEL)] ~(ADRF ~ STACKTOP[LEVEL]) + N 44108000 + > MAXSTACK[LEVEL] THEN 44109000 + MAXSTACK[LEVEL] ~ STACKTOP[LEVEL]; 44110000 + ON: IF ABS(ADRF) > MAXDISP THEN FLAG(410); 44111000 + IF PRTOG THEN IF NOT B THEN PRINTSPACE(0,LEVEL,ADRF); 44112000 + GETSPACE ~ ADRF & LEVEL [30:42:6] & ADRF [29:35:1]; 44113000 + END GETSPACE; 44114000 + PROCEDURE MOVECODE(E,T); ARRAY E,T[0,0]; 44115000 + BEGIN REAL Q; STREAM PROCEDURE FAKEIT(T,Q); 44116000 + BEGIN SI~LOC T; DI~Q; DS~WDS; TALLY~1; Q~TALLY; CI~CI+Q; 44117000 + DS ~ 48 LIT 44118000 + "10YH+A|8+A-E+E0@8EH)*/}V|8+AYH+A-E+E0@8E}V4A4A4(" 44119000 + END FAKEIT; FAKEIT(T,Q) 44120000 + END MOVECODE; 44121000 + REAL PROCEDURE TAKE(N); VALUE N; INTEGER N; 44122000 + TAKE ~ INFO[N.LINKR, N.LINKC]; 44123000 + PROCEDURE PUT( ENTRY,AT); VALUE ENTRY,AT; INTEGER ENTRY,AT; 44124000 + INFO[AT.LINKR, AT.LINKC] ~ ENTRY; 44125000 + PROCEDURE JUMPCHKX; 44126000 + COMMENT JUMPCHKX AND JUMPCHKNX HANDLE BRANCHING AROUND NON-EXECUTABLE 44127000 + CODE, SUCH AS PROCEDURE DECLARATIONS, THUNKS, ETC. JUMPCHKX 44128000 + IS CALLED IMMEDIATELY PRIOR TO EMITTING EXECUTABLE CODE: HE 44129000 + WILL, IF THERE HAS BEEN ANY NON-EXECUTABLE CODE EMITTED, GO 44130000 + BACK AND FIX UP A BRANCH. HE ALSO NOTICES WHETHER THIS IS THE 44131000 + FIRST EXECUTABLE CODE, AND REMEMBERS WHERE IT IS; 44132000 + IF FIRSTX < 0 THEN % FIRST EXECUTABLE CODE 44133000 + FIRSTX ~ L ELSE % SO MARK IT. 44134000 + IF LASTX } 0 THEN % THERE IS A BRANCH HANGING 44135000 + BEGIN EMITB(BRUN,LASTX, L); % SO FILL IT IN. 44136000 + IF FIRSTMT < 0 THEN % WE HAVENT DONE A STATEMENT YET 44137000 + LASTX ~ -1 % SO FORGET LASTX. 44138000 + END JUMPCHKX; 44139000 + PROCEDURE JUMPCHKNX; 44140000 + COMMENT JUMPCHKNX IS CALLED PRIOR TO EMITTING NON-EXECUTABLE CODE. HE 44141000 + LEAVES TRACKS, IF NECESSARY, FOR JUMPCHKX TO USE; 44142000 + IF FIRSTX } 0 THEN % THERE HAS BEEN EXECUTABLE CODE 44143000 + IF FIRSTMT } 0 THEN % WE HAVE SEEN A STATEMENT 44145100 + EMITB(BRUN,LASTX~BUMPL,FIRSTMT) ELSE 44145200 + IF LASTX < 0 THEN LASTX ~ BUMPL; 44145300 + 44146000 + 44147000 + 44148000 + 44149000 + 44150000 + PROCEDURE PUTADDL(ENTRY,LINK); VALUE ENTRY; 44151000 + INTEGER LINK; 44152000 + REAL ENTRY; 44153000 + BEGIN 44154000 +COMMENT PUTADDL INSERTS ENTRY AT LINK IN ADDL AND THEN UPDATES LINK BY 44155000 + ONE: 44156000 + ADDL[LINK.LINKR,LINK.LINKC] ~ ENTRY; 44157000 + LINK ~ LINK+1 44158000 + END PUTADDL; 44159000 + REAL PROCEDURE GIT(X); VALUE X; INTEGER X; 44160000 + COMMENT GIT RETURNS ADDL[X]; 44161000 + GIT ~ ADDL[X.LINKR,X.LINKC]; 44162000 + DEFINE RANGE(RANGE1,RANGE2)= 44163000 + ((RANGE1){ ELCLASS AND (RANGE2)} ELCLASS)#; 44164000 + 44165000 +COMMENT SCATTERELBAT CARVES UP THE ELBATWORD; 44166000 +PROCEDURE SCATTERELBAT; 44167000 + BEGIN 44168000 + REAL T; 44169000 + T ~ ELBAT[I]; 44170000 + KLASSF ~ T.CLASS; 44171000 + TYPEF ~ T.TYPE; 44172000 + FORMALF ~TYPEF=FORMALNAMEP OR TYPEF=FORMALNAMEQ; 44173000 + VONF ~ TYPEF=FORMALVALUEP OR TYPEF=FORMALVALUEQ; 44174000 + ITEMF ~ TYPEF=FORMALNAMEQ OR TYPEF=FORMALVALUEQ; 44174100 + ADDRSF ~ T.ADDRESS; 44175000 +COMMENT*** NOT ALL FIELDS ARE REFERENCED THIS MAY BE CHANGED; 44176000 + END SCATTERELBAT; 44177000 + PROCEDURE SEGMENT(IDINX, SIZE, EDOC); VALUE IDINX, SIZE; 44178000 + INTEGER IDINX, SIZE; ARRAY EDOC[0, 0]; 44178100 + COMMENT SEGMENT COPIES EDOC INTO THE TEMPORARY CODE FILE,TEMP. IT 44179000 + ALSO PUTS A MESSAGE OUT, ONTO THE PRINTER FILE, IF WE ARE 44180000 + LISTING THE PROGRAM. IDINX IS THE INFO INDEX OF THE ID OF THE 44181000 + SEGMENT, IF APPLICABLE, OR ZERO IF THE SEGMENT IS NOT NAMED; 44182000 + BEGIN 44183000 + INTEGER I,M; 44184000 + DEFINE CNT= CHRCNT#, LBUF= LBUFF#; 44185000 + IF LISTOG THEN 44186000 + BEGIN 44187000 + BLANKOUT(16,LBUFF); 44188000 + IF IDINX = 0 THEN INSERT(5,"BLOCK",LBUFF[12],4) ELSE 44189000 + IF IDINX =-1 THEN INSERT(5," DATA",LBUFF[12],4) ELSE 44189100 + MOVECHARACTERS(I~TAKE(IDINX).CNT,INFO[IDINX.LINKR, 44190000 + IDINX.LINKC],4,LBUF[13-(I+7).[41:4]], 44191000 + IF I MOD 8 ! 0 THEN 8 - I MOD 8 ELSE 0); 44192000 + INSERT(2,"IS",LBUF[13],2); 44193000 + ZN9N(SIZE,4,3,LBUF[13],5); 44194000 + INSERT(5,"LONG.",LBUFF[14],2); 44195000 + WRITELBUFF 44196000 + END LISTOG ACTION; 44197000 + IF ERRORCOUNT = 0 THEN 44197100 + WRITEFILE(TEMP,EDOC,0,SIZE-1); 44205000 + TEMPADDR ~ (SIZE+29) DIV 30 + TEMPADDR 44206000 + END SEGMENT; 44207000 +PROCEDURE ERR(N); VALUE N; INTEGER N; 44208000 + COMMENT ERR, IS THE SAME AS FLAG EXCEPT THAT IT MAKES AN ATTEMPT TO 44209000 + RECOVER FROM ERROR SITUATIONS BY SEARCHING FOR A SEMICOLON, 44210000 + END, OR BEGIN 44211000 + N- ERROR NUMBER; 44212000 + BEGIN FLAG(N); 44213000 + I~I-1; 44214000 + IF N=400 THEN GO ENDOFITALL; 44215000 + DO IF STEPI=BEGINV THEN STATEMENT 44216000 + UNTIL ELCLASS=ENDV OR ELCLASS=SEMICOLON; 44217000 + END ERR; 44218000 + PROCEDURE PLACE(WORD)" INTO ADDL AT "(INX); VALUE WORD,INX; 44219000 + REAL WORD,INX; 44220000 + ADDL[INX.LINKR,INX.LINKC] ~ WORD; 44221000 + PROCEDURE SEGDICT(SEGNO,DKADDR,SIZE,PBIT); 44222000 + VALUE SEGNO,DKADDR,SIZE,PBIT; 44223000 + INTEGER SEGNO,DKADDR,SIZE,PBIT; 44224000 + COMMENT SEGDICT MAKES A PDPRT ENTRY FOR A PROGRAM SEGMENT. 44225000 + IF LISTING IS GOING ON, WITH "PRTOG" TURNED ON, THEN HE 44226000 + MAKES REMARKS ON THE PRINTER FILE ABOUT THE ENTRIES; 44227000 + BEGIN 44228000 + LABEL HAIRY; 44228100 + PDPRT[PDINX.LINKR,PDINX.LINKC]~ SEGNO& 44229000 + DKADDR[23:35:13]& 44230000 + SIZE[10:35:13]& 44231000 + (IF XTRNL THEN 4 ELSE 6)[2:45:3] & 44231100 + PBIT[8:47:1]; 44232000 + PDINX ~ PDINX + 1; 44233000 + IF PRTOG THEN 44234000 + BEGIN 44235000 + BLANKOUT(16,LBUFF); 44236000 + INSERT(3,"(0,",LBUFF[7],0); 44242100 + INSERT(5,HEXOUT(SEGNO|16)+")",LBUFF[7],3); 44242200 + INSERT(7,"SEGDESC",LBUFF[8],3); 44242300 + INSERT(6,HEXOUT(SIZE.[32:16]&PBIT[24:47:1]),LBUFF[10],6); 44242400 + INSERT(6,HEXOUT(DKADDR&SIZE[24:44:4]),LBUFF[11],4); 44242500 + INSERT(1,3,LBUFF[10],4); 44242600 + WRITELBUFF 44243000 + END END OF SEGMENT DICTIONARY ENTRY; 44244000 +PROCEDURE FLUSHPOOL; 44244100 +BEGIN 44244150 + LABEL TOMAKEABLOCK; 44244160 + PDPRT[PPINX] ~ POOLMOM & TEMPADDR[23:35:13] & 44244200 + (POOLX~POOLX+1)[10:35:13]&1[7:47:1]&REAL(POOLTOG)[8:47:1]; 44244250 + PDINX ~ PDINX+1; 44244300 + IF POOLTOG THEN SAVESIZE ~ SAVESIZE +POOLX; 44244320 + SEGMENT(-1, POOLX, POOL); 44244350 + POOLX ~ POOLMOM ~ 0; 44244400 +END FLUSHPOOL; 44244450 + INTEGER PROCEDURE NEWSEG(AT); 44245000 + VALUE AT; INTEGER AT; 44246000 + COMMENT NEWSEG DOES THE HOUSEKEEPING STUFF INVOLVED WITH FINDING A 44247000 + NEW SEGMENT NUMBER AND INFORMING THE PROGRAMMER; 44248000 + BEGIN 44249000 + INTEGER N; 44250000 + NEWSEG ~ N~ GETSPACE(-0); 44251000 + IF LISTOG THEN 44252000 + BEGIN 44253000 + BLANKOUT(16,LBUFF); 44254000 + INSERT(2,"IS", LBUFF[12],6); 44255000 + INSERT(7,"SEGMEMT",LBUFF[13],1); 44256000 + INSERT(5,HEXOUT (N),LBUFF[14],1); 44257000 + IF AT = 0 THEN 44258000 + INSERT(5,"BLOCK",LBUFF[12],0) ELSE 44259000 + MOVECHARACTERS(GT1~TAKE(AT).CHRCNT, INFO[AT.LINKR,AT.LINKC44260000 + ],4,LBUFF[5],61 - GT1); 44261000 + WRITELBUFF 44262000 + END END NEW SEGMENT NUMBER ASSIGNMENT; 44263000 + PROCEDURE GLOBALPCW(MOM,SEGNO,L,STATE); 44264000 + VALUE MOM,SEGNO,L,STATE; INTEGER MOM,SEGNO,L,STATE; 44265000 + COMMENT GLOBALPCW MAKES A PDPRT ENTRY FOR A LEVEL-0 PROGRAM 44266000 + CONTROL WORD, AND NOTES THAT FACT ON THE PRINTER(SOMETIMES44267000 + ; 44268000 + BEGIN LABEL ECH; 44269000 + DEFINE H = HEXOUT#; 44269050 + IF SEPARATOG THEN 44269100 + IF PRTOG THEN 44269200 + BEGIN 44269300 + SEGNO~PCW.[35:13]; 44269400 + L ~PCW.[15:13]|6 + PCW.[12:3]; 44269500 + END ELSE ELSE 44269600 + BEGIN 44269700 + IF SVINFO THEN 44269800 + PCW~SEGNO&(L DIV 6)[15:35:13]&(GTI1~L MOD 6)[12:45:3]& 44269900 + STATE[28:47:1]&1[33:47:1]; 44269990 + PDPRT[PDINX.LINKR,PDINX.LINKC]~MOM & 44270000 + SEGNO[24:36:12]& 44271000 + L[7:31:17]& 44272000 + (IF XTRNL THEN 1 ELSE 7)[2:45:3]& 44272100 + STATE[6:47:1]; 44273000 + PDINX ~ PDINX + 1; 44274000 + END; 44274010 + IF PRTOG THEN 44275000 + BEGIN 44276000 + BLANKOUT(16,LBUFF); 44277000 + GTI1 ~ L MOD 6; 44285000 + INSERT(3,"(0,",LBUFF[7],0); 44285100 + INSERT(5,H(MOM|16)+")",LBUFF[7],3); 44285200 + INSERT(3,"PCW",LBUFF[8],3); 44285300 + INSERT(6,H((L~L DIV 6)|256)+GTI1+832,LBUFF[9],1); 44285400 + INSERT(6,H(L.[35:9]>I1[36:45:3]),LBUFF[10],6); 44285500 + INSERT(6,H(SEGNO&1[33:47:1]&STATE[28:47:1]&L[24:44:4]), 44285600 + LBUFF[11],4); 44285700 + INSERT(1,7,LBUFF[10],4); 44285800 + WRITELBUFF 44286000 + END END OF REMEMBERING A GLOBAL PCW; 44287000 + PROCEDURE FIRSTATEMENT; 44288000 + COMMENT FIRSTATEMENT IS CALLED TO MARK THE EXISTENCE OF THE FIRST 44289000 + STATEMENT IN A BLOCK OR PROCEDURE; 44290000 + BEGIN 44290100 + IF FIRSTX < 0 THEN FIRSTMT ~ L ELSE 44291000 + EMITB(BRUN,IF LASTX < 0 THEN LASTX ~ BUMPL ELSE LASTX, 44292000 + FIRSTMT ~ L); 44293000 + IF CURRENT > 0 THEN 44293100 + BEGIN EMIT(ZERO); EMITNUM(6); EMIT(STAG) END; 44293200 + 44293300 + EMIT(PUSH) END; 44294000 +PROCEDURE FILLPOOL; 44300000 +BEGIN REAL I; 44301000 + IF POOLMOM = 0 THEN POOLMOM ~ GETSPACE(-0) ELSE 44302000 + IF POOLX+TAX > POOLMAX THEN 44303000 + BEGIN 44304000 + FLUSHPOOL; 44305000 + POOLX ~ 0; POOLMOM ~ GETSPACE(-0); 44306000 + END; 44307000 + EMITNUM(POOLX); 44308000 + EMITN(POOLMOM); 44309000 + EMIT(INDX); 44310000 + EMITNUM(MAXCSZ DIV 2); EMITR(42, 3); 44310300 + POOLX ~ (GT2~POOLX)+TAX; 44311000 + DO 44312000 + BEGIN 44312100 + MOVE(I~MIN( TAX.LINKC,256-TAX.LINKC),TA, 44313000 + POOL[GT2.LINKR,GT2.LINKC]) ; 44314000 + GT2 ~ GT2 + I; 44314100 + END 44314200 + UNTIL TAX~TAX-I { 0; 44315000 +END FILLPOOL; 44316000 + INTEGER PROCEDURE GETSTACK; 44317000 + BEGIN 44318000 + REAL GT1,GT2; 44319000 + LABEL EXIT; 44320000 + FOR GT1 ~ 0 STEP 1 UNTIL MAXTEMP DO 44321000 + BEGIN 44321100 + IF GT2~TEMPSTACK[GT1] = 0 THEN 44322000 + IF CURRENT = 0 THEN 44322100 + BEGIN GETSTACK ~TEMPSTACK[GT1] ~ - GETSPACE(-0); 44322200 + GO EXIT; 44322300 + END ELSE 44322400 + BEGIN 44323000 + EMITLINK(0&BRUN[24:40:8]); GT2 ~ L; 44323090 + JUMPCHKX; 44323100 + GETSTACK~TEMPSTACK[GT1]~-GETSPACE(- CURRENT); 44324000 + EMIT(ZERO); 44324100 + JUMPCHKNX; 44324200 + EMITB(GET(GT2-3),GT2,L); 44324300 + GO TO EXIT; 44325000 + END; 44326000 + IF GT2 > 0 THEN 44327000 + BEGIN 44328000 + IF GT2.[31:5] = CURRENT THEN 44329000 + BEGIN 44330000 + GETSTACK~TEMPSTACK[GT1]~ -GT2; 44331000 + IF PRTOG THEN PRINTSPACE 44331100 + (-"TEMP ",CURRENT,GT2.[36:12]); 44331200 + GO TO EXIT; 44332000 + END; 44333000 + END; 44334000 + END; 44334100 + FLAG(415); 44334200 + EXIT: 44335000 + END GETSTACK; 44336000 + PROCEDURE RTNSTACK(ADR); VALUE ADR; REAL ADR; 44350000 + FOR GT1 ~ 0 STEP 1 UNTIL MAXTEMP DO 44351000 + IF TEMPSTACK[GT1] = ADR THEN 44352000 + BEGIN 44354000 + TEMPSTACK[GT1] ~ ABS(ADR); 44355000 + GT1 ~ MAXTEMP + 1; 44356000 + END; 44357000 + BOOLEAN PROCEDURE FUTZALABEL; 46000000 + COMMENT FUTZALABEL TRIES TO DO A DEFAULT DECLARATION ON THE 46001000 + THING IN ACCUM, AS A LABELID. IT RETURNS TRUE IFF IT 46002000 + FAILS; 46003000 + BEGIN LABEL PHONY; 46004000 + FUTZALABEL ~ TRUE; COMMENT PREPARE FOR FAILURE; 46005000 + IF ELBAT[I].LINK < NINFOO THEN COMMENT NOT LOCAL; 46006000 + IF NOT BOOLEAN(ELBAT[I].RSVD) THEN COMMENT NOT RESERVED; 46007000 + BEGIN 46008000 + IF LISTOG THEN 46009000 + BEGIN 46010000 + BLANKOUT(14,LBUFF[2]); 46011000 + LABELINE(ACCUM[1],COUNT,LBUFF[0]); 46012000 + WRITELBUFF; 46013000 + END; 46014000 + FUTZALABEL ~ ENTER(0&CURRENT[30:42:6],F0RWARD,LABELID, 46015000 + FALSE); 46016000 + COMMENT WITH THOSE PARAMETERS, ENTER IS FALSE; 46017000 + PUT(GT1 ~ TAKE(LASTINFO) & 0 [33:33:15] , LASTINFO); 46018000 + ELBAT[I] ~ GT1 & LASTINFO [33:33:15]; 46019000 + ELCLASS ~ LABELID; 46020000 + END END FUTZALABEL; 46021000 + BOOLEAN PROCEDURE IFCLAUSE; 50000000 + COMMENT IFCLAUSE TAKES CARE OF " IF THEN", MORE OR LESS. THE 50001000 + CALLER GETS TO BUMP L AND/OR EMIT THE BRANCH. IFCLAUSE 50002000 + WILL, HOWEVER, TELL THE GUY WHAT KIND OF BRANCH TO DO: 50003000 + BRTR OR BRFL; 50004000 + BEGIN STEPIT; COMMENT PAST THE "IF"; 50005000 + BEXP; 50006000 + IF IFCLAUSE ~ LASTNOT = L THEN EMITNOT; 50007000 + IF ELCLASS = THENV THEN STEPIT ELSE FLAG(501) 50008000 + END IFCLAUSE; 50009000 + INTEGER PROCEDURE CASEHEAD; 50010000 + COMMENT CASEHEAD DOES THE SYNTAX-CHECKING AND EMITS SOME OF THE CODE50011000 + FOR THE "CASE OF" CONSTRUCT. IT RETURNS L FOR THE 50012000 + REST OF THE CODE, AND LEAVES SPACE ENOUGH IN EDOC; 50013000 + BEGIN STEPIT; COMMENT PAST THE "CASE"; 50014000 + IF AEXP { XTYPE THEN FLAG(502); 50015000 + IF ELCLASS = OFV THEN STEPIT ELSE FLAG(503); 50016000 + EMIT(DUPL); EMIT(DUPL); EMIT(ZERO); 50017000 + EMIT(GREQ); EMIT(EXCH); 50018000 + L ~ (CASEHEAD ~ L) + 12; 50019000 + END FIRST PART OF CASE HEAD CONSTRUCT; 50020000 + PROCEDURE CASETAIL(MAX,BASE,PLACE); 50021000 + VALUE MAX,BASE,PLACE ; 50022000 + INTEGER MAX,BASE,PLACE ; 50023000 + COMMENT CASETAIL GOES BACK AND PICKS UP WHERE CASEHEAD LEFT OFF. 50024000 + PLACE IS THE L FOR THE FIXUPS, MAX IS THE NUMBER OF ENTRYS50025000 + IN THE BRANCH TABLE, AND BASE IS THE L OF THE BASE OF THE 50026000 + BRANCH TABLE; 50027000 + BEGIN INTEGER LO; 50028000 + LO ~ L; L ~ PLACE; 50029000 + FIGS ~ TRUE; 50029100 + EMITNUM(MAX); EMIT(LSEQ); EMIT(LAND); EMIT(EXCH); 50030000 + EMITNUM(BASE DIV 3); EMIT(ADD); EMIT( DBTR); 50031000 + EMIT(NVLD); 50032000 + L ~ LO 50033000 +; FIGS ~ FALSE; 50033100 + END SECOND PART OF CASE HEAD CODE; 50034000 + PROCEDURE GOGEN(LABELBAT,BRANCHTYPE); 50035000 + VALUE LABELBAT,BRANCHTYPE; 50036000 + REAL LABELBAT,BRANCHTYPE; 50037000 + BEGIN 50038000 + IF (GT1 ~ TAKE(LABELBAT)).TYPE = F0RWARD THEN 50039000 + BEGIN 50040000 + EMITLINK(GT1 & BRANCHTYPE [24:40:8]); 50041000 + PUT(GT1&(L-3)[32:32:16],LABELBAT); 50042000 + END ELSE 50043000 + EMITB(BRANCHTYPE,BUMPL,GT1.[32:16]); 50044000 + END GOGEN; 50045000 + BOOLEAN PROCEDURE SIMPGO; 50046000 + BEGIN 50047000 + LABEL EXIT,INN; 50048000 + IF ELCLASS = GOV THEN 50049000 + BEGIN 50050000 + IF STEPI = TOV THEN STEPIT; 50051000 + IF ELCLASS = LABELID THEN 50052000 + IF ELBAT[I].LINK } NINFOO THEN 50053000 + BEGIN 50054000 + SIMPGO ~ TRUE; 50055000 + GO TO EXIT; 50056000 + END ELSE GO INN ELSE 50057000 + IF FUTZALABEL THEN 50058000 + INN: 50058900 + BEGIN I ~ I - 1; ELCLASS ~ GOV END ELSE SIMPGO ~ TRUE50059000 + END; 50060000 + EXIT: 50061000 + END SIMPGO; 50062000 + PROCEDURE EMITPCW(LEVEL,AD,STATE,SEG ); 50063000 + VALUE LEVEL,AD,STATE,SEG; 50064000 + INTEGER LEVEL,AD,STATE,SEG; 50065000 + COMMENT EMITPCW GENERATES CODE TO MAKE A PCW IN THE STACK; 50066000 + BEGIN 50067000 + 50069000 + LABEL AWAY; 50069100 + PCW ~ SEG & LEVEL [29:43:5] & (AD DIV 6) [15:35:13] 50070000 + & GTI1 ~ AD MOD 6 [12:45:3] & STATE [28:47:1]; 50071000 + IF SEPARATOG THEN GO AWAY; 50071100 + IF DEBUGTOG THEN 50072000 + BUGOUT(10,IF XTRNL THEN LT48 ELSE MPCW,AD,PCW.[1:23],PCW.[24: 50073000 + 24]); 50074000 + PUTSYL(IF XTRNL THEN LT48 ELSE MPCW); 50075000 + WHILE (L ~ L + 1) MOD 6 ! 0 DO PUTSYL(NVLD); 50076000 + EDOC[(L DIV 6).LINKR,(L DIV 6).LINKC] ~ PCW; 50077000 + IF L ~ L + 6 } 49150 THEN FLAG(400); 50078000 + AWAY: 50078900 + END EMITPCW; 50079000 +PROCEDURE WRITEFILE(DKFL,ARY,STARTINX,LASTINX); 50080000 + VALUE STARTINX,LASTINX; 50081000 + REAL STARTINX,LASTINX; 50082000 + FILE DKFL; 50083000 + ARRAY ARY[0,0]; 50084000 +BEGIN 50085000 + DEFINE WRITEDKFL = BEGIN 50086000 + WRITE(DKFL,30,AY[*]); 50087000 + GT1~0; 50088000 + END#; 50089000 + REAL N,GT1,GT2; 50090000 + REAL GP1; 50091000 + LABEL START; 50092000 + GP1~STARTINX.LINKC; 50093000 + GO TO START; 50094000 + DO BEGIN 50095000 + IF (GT1~GT1+N)=30 THEN WRITEDKFL; 50096000 + GP1~IF GT2~STARTINX.LINKC=0 THEN 0 50097000 + ELSE GP1+N; 50098000 + START: MOVE(N~MIN(30-GT1,256-GT2,LASTINX-STARTINX+1), 50099000 + ARY[STARTINX.LINKR,GP1],AY[GT1]); 50100000 + END UNTIL (STARTINX~STARTINX+N)>LASTINX; 50101000 + IF N>0 THEN WRITE(DKFL,30,AY[*]); 50102000 +END OF WRITE FILE; 50103000 +PROCEDURE MAKEARRAYROW; 50200000 + BEGIN 50201000 + REAL T, N, ELBW; 50202000 + LABEL AWAY; 50203000 + IF STEPI}BOOARRAYID AND ELCLASS 1 THEN 50204300 + FLAG(828); 50204350 + IF T!N THEN EMIT(INDX) ELSE 50204400 + BEGIN EMITN(ELBW.ADDRESS); 50204450 + IF ELBW.TYPE=FORMALNAMEP THEN EMIT(EVAL); 50204460 + EMIT(LOAD); 50204470 + END; 50204480 + GO AWAY; 50204500 + END; 50204550 + END; 50204650 + IF T ~ AEXP } XTYPE THEN 50205000 + BEGIN 50206000 + IF T = WTYPE THEN GO AWAY; 50207000 + IF LASTINDEX + 1 = L THEN 50208000 + IF GET(L ~ L - 1) = NXLV THEN 50209000 + BEGIN 50210000 + FIGS ~ TRUE; 50210100 + EMIT(INDX); 50210200 + FIGS ~ FALSE; 50210300 + GO AWAY; 50210350 + END; 50210400 + FLAG(827); 50211000 + END ELSE 50212000 + IF T.[33:15] ! 1 THEN FLAG(829); 50213000 +AWAY: 50214000 + END MAKEARRAYROW; 50222000 +COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 51000000 + EXPRESSIONS 51001000 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;51002000 + INTEGER PROCEDURE EXPRSS; 51003000 + COMMENT EXPRSS COMPILES AN EXPRESSION OF SOME SORT: GENERALLY, IT 51004000 + WILL GOBBLE AS MUCH AS IT CAN. IT RETURNS A VALUE TELLING51005000 + WHAT IT DID: 51006000 + ATYPE: SINGLE-PRECISION ARITHMETIC 51007000 + HTYPE: BOOLEAN 51008000 + ETYPE: EXTENDED-PRECISION ARITHMETIC 51009000 + RTYPE: REFERENCE 51010000 + PTYPE: POINTER 51011000 + WTYPE : WORD 51011500 + XTYPE: ARRAY (INDEXABLE); 51012000 + IF ELCLASS = IFV THEN 51013000 + BEGIN IF GT1 ~ EXPRSS ~ IFEXP ! BTYPE THEN 51014000 + IF ELCLASS = RELOP THEN 51015000 + BEGIN RELATION(GT1); EXPRSS ~ BTYPE END 51016000 + END ELSE 51017000 + IF EXPRSS ~ BOOSEC = BTYPE THEN 51018000 + WHILE ELCLASS = LOGOP DO BOOCOMP; 51019000 + INTEGER PROCEDURE IFEXP; 51020000 + COMMENT IFEXP CDMPILES A CONDITIONAL EXPRESSION, AND RETURNS THE 51021000 + TYPE THEREOF. HE ALSO FIXES ANY SINGLE VS DOUBLE PROBLEM;51022000 + BEGIN BOOLEAN B; 51023000 + INTEGER T,TL; 51024000 + B ~ IFCLAUSE; 51025000 + TL ~ BUMPL; 51026000 + IFEXP ~ T ~ EXPRSS; 51027000 + EMITB(IF B THEN BRTR ELSE BRFL,TL,TL~BUMPL); 51028000 + IF ELCLASS ! ELSEV THEN FLAG(504) ELSE STEPIT; 51029000 + EXPRESSION(T); 51030000 + EMITB(BRUN,TL,L); 51031000 + LASTINDEX ~ LASTNOT ~ 0; 51032000 + COMMENT THE ABOVE FUTZING IS TO KEEP CODE DIDDLERS FROM 51033000 + BACKING UP INTO THE CONDITIONAL EXPRESSION; 51034000 + END IFEXP; 51035000 + BOOLEAN PROCEDURE SIMPLEX(KIND); VALUE KIND; INTEGER KIND; 51035100 + COMMENT SIMPLEX COMPILES AN EXPRESSION AND RETURNS THE BIT FROM 51035200 + KIND CORRESPONDING TO THE TYPE THEREOF; 51035300 + SIMPLEX ~ BIT(47 -(IF T~EXPRSS < XTYPE THEN 46 ELSE T),KIND); 51035500 + PROCEDURE EXPRESSION(TYPE); VALUE TYPE; INTEGER TYPE; 51036000 + COMMENT EXPRESSION COMPILES AN EXPR OF THE SPECIFIED TYPE: IF 51037000 + A SINGLE-DOUBLE MISMATCH OCCURS, THE EXPR IS ADJUSTED, 51038000 + OTHER MISMATCHES ARE FLAGGED; 51039000 + BEGIN LABEL ECH; 51040000 + IF TYPE = BTYPE THEN BEXP ELSE 51041000 + IF TYPE=RTYPE OR TYPE.[18:15]=RTYPE THEN GT1~REXP(FALSE) ELSE 51042000 + IF TYPE = WTYPE THEN GT2 ~ EXPRSS ELSE 51042500 + IF TYPE=PTYPE OR TYPE.[18:15]=PTYPE THEN GT1 ~ PEXP(FALSE) ELSE51043000 + IF GT1 ~ AEXP ! TYPE THEN 51044000 + IF(TYPEITYPE OR GT1=BTYPE) AND GT1!WTYPE THEN 51126000 + FLAG(513) 51127000 + END ELSE 51128000 + AEXP ~ SIMPARITH(0); 51129000 + INTEGER PROCEDURE SIMPARITH(T); VALUE T; INTEGER T; 51130000 + COMMENT SIMRARITH COMPILES A SIMPLE ARITHMETIC (OR ARRAY) EXPRESSION, 51131000 + AT LEAST TO THE POINT OF DOING THE ADDING-TYPE OPERATORS. 51132000 + FOR THE CASES WHERE TRE FIRST PRIMARY HAS BEEN COMPILED, T 51133000 + IS PASSED AS OTHER-THAN-ZERO, BEING THE TYPE OF THAT THING. 51134000 + SIMPARITH, AS USUAL, RETURNS THE TYPE OF THE THING; 51135000 + BEGIN 51136000 + INTEGER OP; 51137000 + LABEL AWAY; 51138000 + IF T = 0 THEN 51139000 + BEGIN 51140000 + IF ELCLASS = ADDOP THEN 51141000 + BEGIN OP ~ ELBAT[I].DISP; STEPIT END; 51142000 + IF T ~ TERM(0) < XTYPE THEN 51143000 + IF OP = 0 THEN GO AWAY ELSE FLAG(514); 51144000 + IF OP = SUBT THEN EMIT(CHSN); 51145000 + END ELSE 51146000 + BEGIN IF ELCLASS=FACTOP THEN T ~ FACTOR(T); 51146500 + IF ELCLASS = MULOP THEN T ~ TERM(T); 51147000 + END; 51147500 + WHILE ELCLASS = ADDOP DO 51148000 + BEGIN 51149000 + IF T=WTYPE THEN FLAG(554); 51149500 + OP ~ ELBAT[I].DISP; STEPIT; 51150000 + IF GT1~TERM(0)=WTYPE THEN FLAG(554)ELSE 51151000 + IF GT1=DTYPE THEN T~DTYPE ELSE 51151500 + IF T ! DTYPE THEN T ~ ATYPE; 51152000 + EMIT(OP) 51153000 + END; 51154000 + AWAY: SIMPARITH ~ T 51155000 + END SIMPARITH; 51156000 + INTEGER PROCEDURE TERM(T); VALUE T; INTEGER T; 51157000 + COMMENT TERM HANDLES EITHER ONE ARRAY DESIGNATOR OR A SERIES OF ONE OR 51158000 + MORE PRIMARIES SEPARATED BY MULTIPLYING OPERATORS. IT RETURNS 51159000 + AND GETS PASSED TO JUST LIKE SIMPARITH DOES; 51160000 + BEGIN 51161000 + INTEGER OP; 51162000 + LABEL AWAY; 51163000 + IF T = 0 THEN 51164000 + IF T ~ FACTOR(0) < XTYPE THEN GO AWAY; 51165000 + WHILE ELCLASS = MULOP DO 51166000 + BEGIN 51167000 + IF T =WTYPE THEN FLAG(554); 51167500 + OP ~ ELBAT[I].DISP; STEPIT; 51168000 + IF GT1~FACTOR(0) ELBW.TYPE THEN BOOCOMP ELSE GO ON; 51198000 + ON: IF ELBW.ADDRESS = 0 THEN COMMENT IMP IS A FUNNY; 51199000 + BEGIN EMITNOT; EMIT(LAND); EMIT(LNOT); LASTNOT ~ L END 51200000 + ELSE EMIT(ELBW.ADDRESS); 51201000 + END UNTIL ELBAT[I] ! ELBW; 51202000 + END BOOLEAN COMPLETION; 51203000 + INTEGER PROCEDURE ARITHCOMP(T); VALUE T; INTEGER T; 51204000 + COMMENT ARITHCOMP COMPLETES AN ARITHMETIC EXPRESSION; 51205000 + BEGIN 51206000 + IF ELCLASS = PERIODV THEN COMMENT THE "." OPERATOR; 51206100 + BEGIN IF T = ETYPE THEN FLAG(553); 51206200 + IF STEPI = TAGV THEN BEGIN EMIT(RTAG); 51206250 + IF T!WTYPE THEN T~ITYPE; STEPIT; END ELSE 51206270 + IF GT1 ~ DOTIT = 0 THEN EMIT(DISO) ELSE 51206300 + EMITI(GT1.[36:6], GT1.[42:6]); 51206400 + END; 51206500 + WHILE ELCLASS=AMPERSAND DO LAYITOUT (T); 51207000 + IF T=BTYPE THEN BEGIN 51207300 + IF ELCLASS!THENV AND ELCLASS!COMMA AND (ELCLASSELSEV) THEN BOOCOMP 51207500 + END ELSE 51207600 + 51208000 + IF T =PTYPE THEN PTRCOMP ELSE 51209000 + T ~SIMPARITH (T); 51209500 + ARITHCOMP ~ T 51210000 + END ARITHCOMP; 51211000 +REAL PROCEDURE REXP(BOO); VALUE BOO; BOOLEAN BOO; %BOO IS A KLUDGE 51212000 + COMMENT REXP HANDLES A REFERENCE EXPRESSION. INASMUCH AS THERE ARE NO 51213000 + REFERENCE OPERATORS (EXCEPT ~, WHICH VARIABLE GETS TO HANDLE), 51214000 + THIS IS ALL OF THE REFERENCE-EXPRESSION SYSTEM; 51215000 + BEGIN INTEGER T; 51216000 + LABEL FINI; 51216100 + REXP ~ RTYPE; 51216200 + IF ELCLASS { IDMAX THEN COMMENT WE MAKE A PRELIMINARY TEST TO 51217000 + DIVIDE BETWEEN IDS AND OTHERS; 51218000 + IF ELCLASS=REFID OR ELCLASS=WORDID THEN 51219000 + BEGIN IF(GT1~VARIABLE(FP)).[18:15]!RTYPE AND GT1!WTYPE 51220000 + THEN BEGIN 51220500 + IF BOO AND REXP ~ GT1 = ATYPE THEN GO FINI 51220600 + ELSE FLAG(518) END END ELSE 51220700 + IF ELCLASS}BOOPROCID AND ELCLASS{PTRPROCID THEN BEGIN 51221000 + IF GT1~PROCALL(TRUE,ELCLASS-BOOPROCID)!RTYPE AND GT1!WTYPE THEN51221300 + FLAG(520) END ELSE 51221500 + IF ELCLASS=REFARRAYID OR ELCLASS=WORDARRAYID THEN 51222000 + BEGIN IF(GT1~VARIABLE(FP)).[18:15]!RTYPE AND GT1!WTYPE 51223000 + THEN FLAG(519) END ELSE 51223500 + IF ELCLASS = QUEUEID THEN ENTRYEXPR ELSE 51224000 + IF ELCLASS = QUEUEARRAYID THEN ENTRYEXPR ELSE 51225000 + FLAG(520) ELSE COMMENT THATS ALL THE ID-TYPE THINGS, 51226000 + NOW WE WORK ON THE OTHERS; 51227000 + IF ELCLASS = NULLV THEN % MAKE A GUESS 51228000 + BEGIN EMIT(ZERO); 51229000 + EMITNUM(5); 51230000 + EMIT(STAG); 51231000 + EMITNUM(3); EMITR(47,2); 51231100 + STEPIT 51232000 + END NULLV ELSE 51233000 + IF ELCLASS=QALGID THEN QALGORITHM(0,0,TRUE) ELSE 51233500 + IF ELCLASS = LFTPRN THEN 51234000 + BEGIN STEPIT; 51235000 + IF (GT1~EXPRSS).[FF]!RTYPE AND GT1!RTYPE AND GT1!WTYPE 51236000 + THEN FLAG(521); 51236100 + IF ELCLASS ! RTPARN THEN FLAG(522); 51237000 + STEPIT 51238000 + ;GO TO FINI; 51238100 + END PARENS ELSE 51239000 + IF ELCLASS = CASEV THEN 51240000 + BEGIN IF GT1~CASEXP!RTYPE AND GT1!WTYPE THEN FLAG(523) END ELSE51241000 + IF ELCLASS = IFV THEN 51242000 + BEGIN IF GT1~IFEXP!RTYPE AND GT1!WTYPE THEN FLAG(524) END ELSE 51243000 + IF ELCLASS ! TYPEV THEN FLAG(525) ELSE 51244000 + IF TAKE(ELBAT[I]).LINK ! REFV THEN FLAG(525) ELSE 51245000 + IF STEPI ! LFTPRN THEN FLAG(526) ELSE 51246000 + BEGIN STEPIT; 51247000 + IF GTB1~(T~AEXP)!WTYPE AND T}XTYPE THEN FLAG(527) ELSE 51248000 + IF T.[CF] !1 AND T!WTYPE THEN FLAG(528) ELSE 51249000 + IF ELCLASS ! RTPARN THEN FLAG(522); 51250000 + STEPIT 51251000 + END; 51252000 + WHILE ELCLASS=AMPERSAND DO LAYITOUT(ATYPE); 51252700 + FINI: 51252999 + END REFERENCE EXPRESSION; 51253000 + PROCEDURE ENTRYEXPR; 51254000 + BEGIN COMMENT HANDLES ENTRY EXPRESSIONS, MOST OF THE WORK IS 51254200 + DONE BY QALGORITHM AND ACTUALPARAPART; 51254250 + INTEGER ADDLADRES; 51254500 + LABEL QUIT; 51254700 + ADDLADRES ~ TAKE(ELBAT[I]).LINK; 51255000 + IF ELCLASS = QUEUEARRAYID THEN 51255200 + ADDLADRES ~ ADDLADRES+1; 51255500 +COMMENT *** FIRST WORD OF ADDL FOR A QUEUE ARRAY CONTAINS INFORMATION 51255700 + ON BOUNDS; 51255750 + GT1.NOPAR ~ GIT(ADDLADRES).ITMNOF; 51255900 + IF STEPI ! LFTPRN THEN BEGIN FLAG(543); GO QUIT END; 51256000 + QALGORITHM(1,ADDLADRES,TRUE); 51256200 +COMMENT 1 SAYS CALL IS FROM ENTRYEXP, TRUE SAYS CALL IS NOT FROM 51256220 + STMT, QALGORITHM INVOKES IMPLICIT CALL ON THE ALLOCATE ALL- 51256240 + ORITHM ASSOCIATED WITH THE QUEUE. ALLOCATE GETS SPACE FOR A 51256260 + QUEUE ENTRY AND QALGORITHM EXITS WITH AN INDEXABLE DATA 51256270 + DESCRIPTOR POINTING TO THIS SPACE IN THE TOP OF THE STACK; 51256290 + ACTUALPARAPART(FALSE,ADDLADRES,GT1,FALSE); 51257000 +COMMENT FIRST PARAMETER SAYS QUEUE IS NOT FORMAL, LAST PARAMETER SAYS51257500 + CALL IS FROM ENTRYEXP. ACTUALPARAPART PASSES ACTUAL PARAME 51257520 + -TERS (OR IRWS POINTING TO THEM) TO THE SPACE REFERENCED BY 51257540 + THE DD IN THE TOP OF THE STACK; 51257560 + QUIT: END ENTRYEXPR; 51258000 +REAL PROCEDURE PEXP(BOO); VALUE BOO; BOOLEAN BOO; %BOO IS A KLUDGE 51259000 + BEGIN 51260000 + LABEL EXIT; 51261000 + IF ELCLASS = IFV THEN 51262000 + BEGIN 51263000 + IF PEXP ~ GT1 ~ IFEXP ! PTYPE AND GT1 ! WTYPE THEN 51264000 + BEGIN IF GT1 = ITYPE THEN PEXP~ GT1 ~ ATYPE; 51264050 + IF NOT (BOO AND GT1=ATYPE) THEN FLAG(540); 51264100 + END; 51264150 + IF GT1 = WTYPE THEN PEXP ~ PTYPE; 51264200 + GO TO EXIT; 51265000 + END; 51266000 + PEXP ~ PTRPRIM(BOO); 51267000 + IF ELCLASS = ADDOP THEN PTRCOMP; 51268000 +EXIT: 51269000 + WHILE ELCLASS=AMPERSAND DO LAYITOUT(ATYPE); 51269700 + END PEXP; 51270000 +PROCEDURE PTRCOMP; 51271800 + BEGIN 51272000 + REAL OP; 51273000 + LABEL EXIT; 51274000 + IF ELCLASS ! ADDOP THEN GO TO EXIT; 51275000 + OP ~ ELBAT[I].DISP; 51276000 + STEPIT; 51277000 + IF T ~ AEXP ! ITYPE AND T ! ATYPE THEN FLAG(541); 51278000 + EMIT(EXPU); 51279000 + EMIT(IF OP = ADD THEN SFDC ELSE SRDC); 51280000 +EXIT: 51281000 + END PTRCOMP; 51282000 +PROCEDURE LONGSTRING; 51300000 +BEGIN 51301000 + DEFINE BUMPTAX=IF TAX~TAX+1}POOLMAX THEN ERROR(551)#; 51302000 + LABEL EXIT; 51303000 + TAX ~ 0; 51305000 + DO BEGIN FLOG(THIFLAG,THI,TA[TAX]); 51306000 + BUMPTAX; 51306100 + END 51306200 + UNTIL NOT GOBBLE(TRUE); 51307000 + FLOG(THIFLAG, THI, TA[TAX]); 51308000 + BUMPTAX; 51308100 + COUNT ~ (TAX-1)|48+COUNT; 51309000 + EXIT: 51311000 +END LONGSTRING; 51312000 +PROCEDURE STRINGSOURCE; 51313000 +BEGIN COMMENT COMPILES LONG AND SHORT STRINGS AS SOURCES FOR 51314000 + REPLACE STATEMENTS AND STRING RELATIONS; 51315000 +REAL STREAM PROCEDURE FILLWORD(S,N,R,B,SK,D); 51316000 + VALUE N, R, B, SK; 51317000 +BEGIN 51318000 + DI ~ D; 51319000 + R(SI ~ S; SKIP SK SB; 51320000 + N(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB)); 51321000 + SI ~ S; SKIP SK SB; 51322000 + 8(IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB); 51323000 + DI ~ D; SI ~ D; 51324000 + IF SB THEN BEGIN TALLY ~ 1; DS ~ RESET END; 51324100 + FILLWORD ~ TALLY; 51324200 +END FILLWORD; 51325000 + REAL FLG; 51325100 + IF ELCLASS = STRING THEN 51326000 + BEGIN LONGSTRING; FILLPOOL END ELSE 51327000 + BEGIN 51328000 + IF COUNT = 48 OR LEFTY THEN BEGIN 51328010 + FLG ~ REAL(THIFLAG); GT1 ~ THI; 51328020 + END ELSE 51328030 + FLG ~ FILLWORD(THI, COUNT, 48 DIV COUNT, GTI1 ~ 48 MOD 51328100 + COUNT, IF LEFTY THEN 0 ELSE 48 - COUNT, GT1); 51329000 + EMITNUMBER(GT1, FLG); 51330000 + END; 51331000 + COUNT ~ (COUNT+MAXCSZ-1) DIV MAXCSZ; 51332000 + IF MAXCSZ < 4 THEN FLAG(0552); 51333000 +END STRINGSOURCE; 51334000 +PROCEDURE ARRAYROW; 51335000 +BEGIN 51336000 + LABEL EXIT; 51337000 + REAL NDIMS, ELBW; 51338000 + ELBW ~ ELBAT[I]; 51339000 + NDIMS ~ BOUND(ELBW); 51340000 + IF STEPI ! LFTBRKT THEN ERROR(0549); 51341000 + IF SUBSCRIBER(ELBW.ADDRESS, NDIMS) ! 1 THEN ERROR(0550); 51342000 + IF NDIMS = 1 THEN EMITN(ELBW.ADDRESS); 51343000 + EXIT: 51344000 +END ARRAYROW; 51345000 + INTEGER PROCEDURE FACTOR(T); VALUE T; INTEGER T; 51401000 + COMMENT FACTOR WORKS LIKE SIMPARITH AND TERM, HANDLING THE * (RAISED- 51402000 + TO-THE-POWER) OPERATOR; 51403000 + BEGIN 51404000 + INTEGER N; 51404100 + DEFINE T1 = NHI#, T2 = NLO#, L1 = RCOUNT#, L2 = REMCOUNT#; 51404200 + LABEL ON, ROUND; 51405000 + BOOLEAN MINUS; 51406000 + IF T = 0 THEN 51407000 + IF T ~ PRIMARY < XTYPE OR T = WTYPE THEN GO ON; 51408000 + IF ELCLASS = FACTOP THEN 51409000 + IF T = ITYPE THEN T ~ ATYPE; 51410000 + ROUND: 51410500 + WHILE ELCLASS = FACTOP DO 51411000 + BEGIN 51412000 + N ~ REAL(MINUS ~ FALSE); 51413000 + IF STEPI = ADDOP THEN 51414000 + BEGIN MINUS ~ ELBAT[I].DISP = SUBT; STEPIT END; 51415000 + IF ELCLASS ! NUMBER THEN 51416000 + BEGIN 51416020 + IF N ~ PRIMARY ! ITYPE THEN 51416040 + IF N < XTYPE THEN FLAG(573) ELSE EMIT(NTGR); 51416060 + EMITPAIR(T1 ~ GETSTACK, OVRN); 51416080 + EMIT1P(BRST,46); 51416100 + L1 ~ L; EMITPAIR(T2 ~ GETSTACK, OVRN); 51416120 + EMIT(LOG2); EMIT(ONE); EMIT(LSEQ); 51416140 + L2 ~ BUMPL; 51416160 + EMITV(T2); EMITB(BRFL,BUMPL,L+1); EMIT(DUPL); 51416180 + EMIT(DUPL); EMIT(MULT); EMITV(T2); EMITI(38,38); 51416200 + EMITB(BRUN,BUMPL,L1); EMITB(BRTR,L2,L); EMITV(T2); 51416220 + L1 ~ BUMPL; EMITV(T1); EMIT1P(BRST,46); EMIT(CBON); 51416240 + L2 ~ L; EMIT(ONE); EMIT(SUBT); EMITPAIR(T2,STON); 51416260 + EMIT(ONE); EMIT(GREQ); 51416280 + N ~ BUMPL; EMIT(MULT); EMITV(T2); 51416300 + EMITB(BRUN,BUMPL,L2); EMITB(BRFL,L1,L); EMIT(DLET); 51416320 + EMIT(ONE); EMITB(BRFL,N,L); EMITV(T1); 51416340 + EMIT(ZERO); EMIT(LESS); 51416360 + EMITB(IF MINUS THEN BRTR ELSE BRFL,BUMPL,L+3); 51416380 + EMIT(ONE); EMIT(EXCH); EMIT(DIVD); 51416400 + RTNSTACK(T1); RTNSTACK(T2); 51416420 + GO ROUND 51416440 + END X TO THE NONCONSTANT; 51416460 + IF THI.[3:6] ! 0 THEN FLAG(573); 51417000 + WHILE THI.[9:38] ! 0 DO 51418000 + BEGIN 51419000 + EMIT(DUPL); 51420000 + IF BOOLEAN(THI) THEN 51421000 + BEGIN N ~ N + 1; EMIT(DUPL) END; 51422000 + EMIT(MULT); 51423000 + THI ~ THI.[9:38]; 51424000 + END; 51425000 + IF BOOLEAN(THI) THEN 51426000 + WHILE N ~ N - 1 > 0 DO EMIT(MULT) ELSE 51427000 + BEGIN EMIT(DLET); EMIT(ONE) END; 51428000 + IF MINUS THEN 51429000 + BEGIN EMIT(ONE); EMIT(EXCH); EMIT(DIVD) END; 51430000 + STEPIT; 51430100 + END; 51431000 + ON: FACTOR ~ T; 51432000 + END; 51433000 + INTEGER PROCEDURE BITFIDDLE(S); VALUE S; BOOLEAN S; 51450000 + COMMENT THIS IS THE "SET" AND "RESET" HANDLER. S TELLS US WHICH; 51451000 + BEGIN 51454000 + LABEL ECH, OWT; 51455000 + IF STEPI ! LFTPRN THEN FLAG(576); 51456000 + STEPIT; 51457000 + BITFIDDLE ~ EXPRSS; COMMENT THESE GUYS ARE TYPE-TRANSPARENT; 51458000 + IF ELCLASS ! COMMA THEN FLAG(577); 51460000 + IF STEPI = NUMBER THEN 51461000 + BEGIN 51462000 + IF RESULT ! RTPARN THEN GO OWT; 51463000 + IF THI > 47 THEN GO ECH; 51465000 + IF THI.[1:8] ! 0 THEN 51466000 + ECH: FLAG(578) ELSE 51467000 + EMIT1P(IF S THEN BSET ELSE BRST,THI); 51468000 + STEPIT; 51469000 + END STATIC KIND OF BITFIDDLE ELSE 51470000 + OWT: BEGIN 51471000 + IF AEXP < XTYPE THEN GO ECH; 51472000 + EMIT(IF S THEN DBST ELSE DBRS); 51473000 + END; 51474000 + IF ELCLASS ! RTPARN THEN FLAG(579); 51475000 + STEPIT; 51476000 + END BITFIDDLE; 51477000 +PROCEDURE MONITER (ELBW); 57000000 + VALUE ELBW; 57001000 + REAL ELBW; 57002000 + BEGIN COMMENT MONITER SETS UP PARAMETERS AND ISSUES A CALL ON 57003000 + A TYPED PROCEDURE WHOSE ADDRESS 1S KEPT IN THE LINK FIELD 57004000 + OF THE INFO WORD. THE FIRST PARAMETER IS THE FIRST 57005000 + 7 (5500) OR FEWER CHARACTERS OF THE IDENTIFIER AND THE 57006000 + SECOND IS THE VALUE BEING ASSIGNED TO THE VARIABLE AND 57007000 + RETURNED BY THE PROCEDURE. 57008000 + ;57009000 + EMITN (TAKE (GT3 ~ ELBW.LINK).LINK); 57010000 + EMIT (EXCH); 57011000 + EMIT (IMKS); 57012000 + GT1 ~ TAKE (GT3 + 1); 57013000 + IF GT2 ~ GT1.CHRCNT > 7 THEN GT2 ~ 7; 57014000 + GT1 ~ " "; 57015000 + MOVECHARACTERS (GT2, INFO[GT3.LINKR,GT3.LINKC+1], 4, GT1, 1); 57016000 + EMITNUM (GT1); 57017000 + EMIT (EXCH); 57018000 + EMIT (ENTR); 57019000 + END MONITER; 57020000 + 5702050057141000 +REAL PROCEDURE VARIABLE(F); 57021000 + VALUE F; 57022000 + INTEGER F; 57023000 +BEGIN 57024000 + REAL ADDRS,ELBW,DIALS,TYP,T; 57025000 + BOOLEAN ARY,FORMAL,ADDRSTOG,QUE,FLD; 57026000 + DEFINE SBPT = [33:33:15] #, 57026020 + TIPE = [18:33:15] #; 57026040 + DEFINE SBT=TYP#; 57026100 + LABEL A1,A2,ASSGN,FEILD,AWAY; 57027000 + FORMAL~TYP~(ELBW~ELBAT[I]).TYPE=FORMALNAMEP OR TYP=FORMALNAMEQ;57029000 + IF RANGE(BOOPROCID,PTRPROCID) THEN 57030000 + BEGIN 57031000 + T~ELCLASS-BOOPROCID; 57032000 + IF TYP!WITHINBODY THEN BEGIN ERR(532); GO AWAY END; 57033000 + ELBW.ADDRESS~ADDRS~GIT(TAKE(ELBW)).ADDRESS; 57034000 + STEPIT; ADDRSTOG~TRUE; GO TO ASSGN; 57035000 + END; 57036000 + ADDRS~ELBW.ADDRESS; 57037000 + T~IF ELCLASS=EVENTID OR ARY~ELCLASS=EVENTARRAYID THEN EVNTV 57038000 + ELSE ELCLASS-( 57039000 + IF RANGE(BOOID,PTRID) THEN BOOID ELSE 57040000 + IF ARY~RANGE(BOOARRAYID,WORDARRAYID) THEN BOOARRAYID ELSE 57041000 + IF ARY~RANGE(BOOROAID,INTROAID) THEN BOOROAID ELSE 57042000 + (ELCLASS+1)); 57043000 + IF T<0 THEN BEGIN ERR(111); GO AWAY END; 57044000 + IF QUE~TYP=FORMALNAMEQ OR TYP=FORMALVALUEQ THEN 57045000 + BEGIN 57046000 + ITEMREFERENCE(F); 57047000 + IF T=EVNTV THEN EMIT(LOAD) ELSE 57048000 + IF FORMAL THEN EMIT(EVAL); 57049000 + IF F=FR THEN GO AWAY; 57050000 + END ELSE STEPIT; 57051000 + IF ARY THEN 57052000 + BEGIN 57053000 + IF ADDRS=0 AND TYP=INTRINSIC THEN ARY~BOOLEAN(3); % REG, 57054000 + SBT~-GIT(TAKE(ELBW)).NODIM; 57055000 + IF ELCLASS=LFTBRKT THEN 57056000 + IF-SBT=SBT~SUBSCRIBER(IF QUE OR ADDRS=4 THEN 0 ELSE ADDRS,57057000 + -SBT) THEN SBT~-SBT; % AN EMPTY ARRAY IDENTIFIER. 57058000 + IF SBT!0 THEN 57059000 + BEGIN 57060000 + IF REAL(ARY)=3 THEN BEGIN ERR(529); GO AWAY END; 57061000 + T~-0&(T)TIPE&(SBT)SBPT; % THIS MAKES IT < "XTYPE". 57062000 + SBT ~ SBT.[1:1]; % AN EMPTY ARRAY IDENTIFIER. 57063000 + END ELSE 57064000 + ARY~ARY AND BOOLEAN(2); 57065000 + IF F=FR THEN BEGIN EMIT(INDX); GO TO AWAY END; 57065400 + IF F=FS THEN 57065500 + IF FLD~ELCLASS=PERIODV THEN GO TO A1; 57065700 + IF ELCLASS=ASSNOP THEN 57066000 + A1: BEGIN 57067000 + IF NOT ARY THEN 57068000 + IF ELBW.CLASS}BOOROAID THEN FLAG(539); 57069000 + IF BOOLEAN(SBT) THEN 57070000 + IF QUE THEN ELSE 57071000 + BEGIN 57072000 + EMITN(ADDRS); 57073000 + IF FORMAL THEN EMIT(EVAL); 57074000 + END ELSE 57075000 + BEGIN 57076000 + IF ADDRS=4 THEN EMITN(4); 57077000 + IF REAL(ARY)!2 THEN EMIT(INDX); 57078000 + END; 57079000 + IF FLD THEN GO TO FEILD; GO TO ASSGN; 57080000 + END; 57081000 + IF F=FS THEN BEGIN ERR(538); GO AWAY END; 57081500 + IF QUE THEN GO AWAY; 57082000 + IF ARY THEN 57083000 + IF BOOLEAN(SBT) THEN 57084000 + BEGIN 57085000 + EMITN(ADDRS); 57086000 + IF FORMAL THEN EMIT(EVAL); 57087000 + EMIT(LOAD); 57088000 + END ELSE EMIT(NXLN) ELSE 57089000 + IF REAL(ARY)=2 THEN EMIT(RPRR) ELSE 57090000 + IF ADDRS=4 THEN EMIT(LODT) ELSE 57091000 + BEGIN 57092000 + IF T>ITYPE AND T!EVNTV THEN EMIT(INDX); 57093000 + EMIT(IF T=WTYPE THEN LODT ELSE 57094000 + IF T>ITYPE AND T!EVNTV THEN NXLN ELSE NXLV); 57095000 + END; GO AWAY; 57096000 + END; 57097000 + IF F=FR THEN 57097100 + BEGIN 57097200 + EMITN(ADDRS); IF FORMAL THEN EMIT(EVAL); GO AWAY ; 57097300 + END; 57097400 + IF F=FS THEN 57097500 + IF FLD~ELCLASS=PERIODV THEN GO TO A2; 57097600 + IF ELCLASS=ASSNOP THEN 57098000 + A2: BEGIN 57099000 + IF QUE THEN ELSE 57100000 + IF FORMAL THEN EMITPAIR(ADDRS,EVAL) ELSE ADDRSTOG~TRUE; 57101000 + IF FLD THEN GO TO FEILD; 57102000 + ASSGN: IF STEPI=FACTOP THEN 57103000 + BEGIN 57104000 + STEPIT; 57105000 + FEILD: IF REAL(ARY)=2 THEN 57106000 + BEGIN EMIT(DUPL); EMIT(RPRR) END ELSE 57107000 + BEGIN 57108000 + IF ADDRSTOG THEN 57108200 + IF T>ITYPE AND T!EVNTV THEN 57108400 + BEGIN EMITN(ADDRS); ADDRSTOG~FALSE END ELSE 57108600 + EMITV(ADDRS); 57108800 + IF ADDRSTOG THEN ELSE 57109000 + BEGIN 57109200 + EMIT(DUPL); 57109500 + EMIT(IF T=WTYPE THEN LODT ELSE LOAD); 57110000 + END; 57111000 + END; 57112000 + IF FLD THEN 57113000 + BEGIN 57113020 + IF STEPI=TAGV THEN 57113040 + BEGIN DIALS~-2; STEPIT END ELSE DIALS~DOTIT; 57113060 + IF ELCLASS=ASSNOP THEN STEPIT ELSE 57113080 + BEGIN ERR(538); GO AWAY END; 57113100 + EXPRESSION(IF T=BTYPE THEN BTYPE ELSE ATYPE); 57113120 + IF DIALS=-2 THEN EMIT(STAG) ELSE 57113140 + IF DIALS=0 THEN EMIT(DINS) ELSE 57113160 + EMITR(DIALS.[36:6],DIALS.[42:6]); 57113180 + END ELSE GT1~ARITHCOMP(T); 57113200 + END ELSE EXPRESSION(T); 57114000 + IF ELBW.MONF=1 THEN MONITER(ELBW); 57114500 + IF REAL(ARY)=2 THEN EMIT(SPRR) ELSE 57115000 + BEGIN 57116000 + IF ADDRSTOG THEN EMITN(ADDRS) ELSE 57117000 + IF T>ITYPE AND T!EVNTV OR ARY THEN EMIT(EXCH); 57118000 + IF T>ITYPE AND T!EVNTV OR ARY THEN 57118300 + EMIT(IF F=FS THEN OVRD ELSE OVRN) ELSE 57118500 + EMIT(IF F=FS THEN STOD ELSE STON); 57119000 + END; 57120000 + GO AWAY; 57120500 + END; 57121000 + IF F=FS THEN BEGIN ERR(538); GO AWAY END; 57121500 + IF QUE THEN GO AWAY; 57122000 + IF T>ITYPE AND T!EVNTV THEN 57123000 + BEGIN 57124000 + EMITN(ADDRS); 57125000 + IF FORMAL THEN EMIT(EVAL); 57126000 + EMIT(IF T=WTYPE THEN LODT ELSE LOAD); 57127000 + END ELSE 57128000 + EMITV(ADDRS); 57129000 + AWAY: 57130000 + IF VARIABLE~T =PTYPE OR T=RTYPE THEN 57131000 + VARIABLE ~ -1&(T)TIPE; 57131100 +END OF VARIABLE; 57132000 +PROCEDURE LAYITOUT (TYPE); VALUE TYPE; INTEGER TYPE; 57142000 + BEGIN COMMENT 57143000 + ;57144000 + REAL ELBW, ADDLWD; 57145000 + REAL DIALS; 57145050 + DEFINE ELCLAS = ELCLASS #; 57145100 + BOOLEAN SIMPLE; 57146000 + INTEGER ADDLJ, ADDLN, T, S, N; 57147000 + INTEGER NEXTCLS; 57147100 + LABEL EXPR1, EXPR2, EXPR3; 57147200 + LABEL WAY; 57147500 + LABEL NEXT, QUIT; 57148000 + DEFINE ADDLI = ADDLJ.LINKR, ADDLJ.LINKC #, 57149000 + SCAT = DO UNTIL STEPI = SEMICOLON; GO QUIT#; 57150000 + STEPIT; 57151000 + IF (ELBW ~ TAKE (ELBAT[I].LINK)).CLASS ! LAYOUTID 57152000 + THEN 57153000 + BEGIN 57153010 + EXPRESSION(TYPE); 57153020 + IF ELCLASS ! LFTBRKT THEN GO WAY; 57153030 + LITERALS ~ TRUE; 57153035 + IF STEPI!NUMBER THEN GO EXPR1; 57153040 + IF TABLE(I+1)=COLON THEN BEGIN 57153045 + S ~ THI; STEPIT END ELSE BEGIN 57153050 + EXPR1: S ~ -1; IF NOT SIMPLEX(14) THEN GO WAY END; 57153055 + IF ELCLASS ! COLON THEN GO WAY; 57153060 + IF STEPI!NUMBER THEN GO EXPR2; 57153065 + IF T~TABLE(I+1)=COLON OR T=RTBRKT THEN BEGIN 57153070 + IF S<0 THEN GO EXPR2; T~THI; STEPIT END ELSE BEGIN 57153075 + EXPR2: IF S}0 THEN EMITNUM(S); S ~ -1; 57153080 + IF NOT SIMPLEX(14) THEN GO WAY END; 57153085 + IF ELCLASS=COLON THEN BEGIN 57153090 + IF STEPI!NUMBER THEN GO EXPR3; 57153100 + IF TABLE(I+1)=RTBRKT THEN BEGIN 57153110 + IF S<0 THEN GO EXPR3; N ~ THI; STEPIT; 57153120 + IF S}48 OR T}48 OR N>48 THEN FLAG(704); 57153125 + EMITD(S,T,N) END ELSE BEGIN 57153130 + EXPR3: IF S}0 THEN BEGIN EMITNUM(S); EMITNUM(T) END; 57153140 + IF NOT SIMPLEX(14) THEN GO WAY; 57153150 + EMIT(DFTR) END 57153160 + END THE TWO COLON CASE ELSE 57153170 + IF S}0 THEN BEGIN IF S}48 OR T>48 THEN FLAG(704); 57153175 + EMIT2P(INSR, S, T) END ELSE BEGIN 57153180 + EMIT(RSUP); EMIT(DINS) END; 57153185 + IF LITERALS THEN WAY: FLAG(533); 57153190 + IF ELCLASS = RTBRKT THEN STEPIT ELSE 57153200 + BEGIN 57153210 + WHILE ELCLASS!RTBRKT AND ELCLASS!SEMICOLON DO 57153220 + STEPIT; 57153230 + FLAG(533); 57153240 + END; 57153250 + GO QUIT 57153260 + END; 57153270 + IF STEPI ! LFTPRN 57154000 + THEN BEGIN FLAG (534); SCAT END; 57155500 + ADDLJ ~ ELBW.LINK - 1; 57156000 + ADDLN ~ ELBW.ADDRESS; 57157000 + ELCLASS ~ COMMA; 57157100 +NEXT: WHILE ADDLJ ~ ADDLJ + 1 < ADDLN DO 57158000 + BEGIN 57159000 + IF ELCLASS!RTPARN THEN 57159040 + IF ELCLASS!COMMA THEN FLAG(535); 57159060 + DIALS ~ 0; 57159100 + DEBLANK; 57160000 + ADDLWD ~ ADDL[ADDLI]; 57161000 + IF CHR = "*" 57162000 + THEN BEGIN 57163000 + ELCLAS ~ TABLE (I~I+2); 57164000 + ADDLJ ~ ADDLJ + ADDLWD.LAYINIT; 57165000 + IF ELCLAS= RTPARN THEN ADDLJ~ADDLN; 57165500 + GO NEXT; 57166000 + END; 57167000 + IF SIMPLE ~ ADDLWD.LAYLTA = 0 AND ADDLWD.LAYLTB = 0 57168000 + AND T ~ ADDLWD.LAYCODE = FIELDID 57169000 + THEN BEGIN 57170000 + S ~ ADDLWD.LAYLNA; 57171000 + N ~ ADDLWD.LAYLNB; 57172000 + END 57173000 + ELSE IF T ! TAGV 57174000 + THEN IF T = LAYOUTID 57175000 + THEN IF (GT1 ~ TAKE (ADDLWD.LINK)).ADDRESS ! 0 57176000 + THEN BEGIN 57177000 + S ~ GT1.STARTBIT; 57178000 + SIMPLE ~ TRUE; 57179000 + N ~ GT1.NOOFBITS; 57180000 + END 57181000 + ELSE DIALS ~ GIT (GT1.LINK) & 1[1:47:1] 57182000 + ELSE DIALS ~ ADDLWD & 1 [1:47:1]; 57183000 + IF ELCLAS ! RTPARN THEN DEBLANK; 57183100 + IF CHR = "," OR CHR =")" OR ELCLAS = RTPARN 57184000 + THEN BEGIN 57184100 + IF NEXTCLS~ELCLAS!RTPARN THEN NEXTCLS~STEPI; 57184150 + IF N =1 AND T! TAGV AND SIMPLE THEN 57184175 + BEGIN IF N ~ ADDLWD.LAYINIT ! 0 THEN 57184200 + BEGIN 57184250 + N ~ GIT(ADDLJ ~ ADDLJ + 1).[47:1]; 57184300 + EMIT1P(BSET&(1-N)[44:47:1],S); 57184400 + END; 57184450 + GO TO NEXT 57184500 + END ELSE 57184600 + IF ADDLWD.LAYINIT = 0 57185000 + THEN GO NEXT 57186000 + ELSE BEGIN 57187000 + IF DIALS !0 57187100 + THEN DOTTER (DIALS); 57187200 + ADDLJ ~ ADDLJ + 1; 57187300 + EMITNUM (ADDL[ADDLI]) 57187400 +; ELCLAS ~ NEXTCLS; 57187450 + END 57187500 + END 57187600 + ELSE BEGIN 57188000 + IF DIALS ! 0 57188010 + THEN DOTTER (DIALS); 57188020 + STEPIT; 57188025 + IF AEXP < XTYPE 57188030 + THEN FLAG(544) 57188100 + ELSE BEGIN 57188200 + 57188300 + ADDLJ ~ ADDLJ + ADDLWD.LAYINIT; 57188400 + END; 57188500 + END; 57188600 + IF T =TAGV 57189000 + THEN EMIT (STAG) 57190000 + ELSE IF SIMPLE THEN EMITR (S, N) ELSE EMIT (DINS); 57191000 + END; 57192000 + 57192100 + IF ELCLASS ! RTPARN THEN BEGIN FLAG(535); SCAT END ELSE STEPIT;57193000 +QUIT: 57194000 + END LAYITOUT; 57195000 +INTEGER PROCEDURE SUBSCRIBER (ADDRESS, BOUNDS); 57196000 + VALUE ADDRESS, BOUNDS; 57197000 + INTEGER ADDRESS,BOUNDS; 57198000 + BEGIN COMMENT SUBSCRIBER HANDLES A SUBSCRIPT LIST INCLUDING 57199000 + THE ENCLOSING BRACKETS. IT RETURNS THE NUMBER OF ASTER- 57200000 + ISKS (SUBSCRIPTS NOT SEEN), AND EMITS NXLN-S FOR ALL 57201000 + ACTUAL SUBSCRIPTS EXCEPT THE FINAL ONE. WHEN ADDRESS IS 57202000 + NON-ZERO, A NAME IS EMITTED AFTER THE FIRST SUBSCRIPTS 57203000 + ARITHMETIC EXPRESSION HAS BEEN COMPILED. BOUNDS IS THE 57204000 + NUMBER OF DECLARED DIMENSIONS. 57205000 + ;57206000 + INTEGER BDS, NOTBDS; 57207000 + BOOLEAN FIRST; 57208000 + FIRST ~ ADDRESS !0; 57209000 + IF ELCLASS ! LFTBRKT 57210000 + THEN BEGIN ERR(402); SUBSCRIBER ~ 0; END 57211000 + ELSE BEGIN 57212000 + DO BEGIN 57213000 + STEPIT; 57214000 + IF ELCLASS ! FACTOP 57215000 + THEN BEGIN 57216000 + IF AEXP < XTYPE THEN FLAG (505); 57217000 + IF NOTBDS ! 0 THEN FLAG (574); 57217100 + BDS ~ BDS + 1; 57218000 + IF FIRST 57219000 + THEN BEGIN 57220000 + FIRST ~ FALSE; 57221000 + EMITN (ADDRESS); 57222000 + END; 57223000 + IF BDS!BOUNDS AND TABLE(I+1)! 57224000 + FACTOP THEN EMIT(NXLN); 57224010 + END 57225000 + ELSE BEGIN NOTBDS ~ NOTBDS + 1; STEPIT END;57226000 + END UNTIL ELCLASS ! COMMA; 57227000 + IF ELCLASS ! RTBRKT 57228000 + OR BDS + (SUBSCRIBER ~ NOTBDS) ! BOUNDS 57229000 + THEN ERR (402) ELSE 57230000 + STEPIT; 57231000 + END; 57232000 + LASTINDEX ~ L; 57233000 + END SUBSCRIBER; 57234000 +PROCEDURE DOTTER (DIALS); 57235000 + VALUE DIALS; 57236000 + REAL DIALS; 57237000 + BEGIN 57238000 + INTEGER D; 57239000 + FOR D ~ DIALS.LAYAEXP, DIALS.LAYBEXP 57240000 + DO IF D.LAYLTB = 0 57241000 + THEN EMITNUM (D.LAYLNB) 57242000 + ELSE BEGIN 57243000 + HOOK (D.LAYLNB); 57244000 + STEPIT; 57245000 + IF AEXP < XTYPE THEN FLAG (403); 57246000 + IF ELCLASS = SEMICOLON THEN UNHOOK; 57247000 + END; 57248000 + IF DIALS > 0 THEN STEPIT; 57249000 + END DOTTER; 57250000 +INTEGER PROCEDURE DOTIT; 57251000 + BEGIN COMMENT WHEN DOTIT RETURNS A ZERO, CODE WILL HAVE BEEN 57252000 + EMITTED TO INITIALIZE THE STACK TO THE PROPER VARIABLES 57253000 + SO THAT THE CALLER MAY EMIT A DINS 0R DISO AT SOME LATER 57254000 + TIME. WHEN DOTIT IS NON-ZERO IT CONTAINS THE STARTING BIT57255000 + 36:6 AND NUMBER OF BITS 42:6. 57256000 + 57257000 + ;57258000 + LABEL WAY, EXPR1, EXPR2; 57258100 + INTEGER S, T; 57258200 + IF ELCLASS ! FIELDID 57259000 + THEN 57260000 + IF ELCLASS ! LFTBRKT THEN GO WAY ELSE 57260010 + BEGIN 57260020 + LITERALS ~TRUE; 57260025 + IF STEPI!NUMBER THEN GO EXPR1; 57260030 + IF TABLE(I+1)=COLON THEN BEGIN S ~ THI; STEPIT END ELSE 57260035 + EXPR1: BEGIN S ~ -1; IF NOT SIMPLEX(14) THEN GO WAY END; 57260040 + IF ELCLASS!COLON THEN GO WAY; 57260045 + IF STEPI!NUMBER THEN GO EXPR2; 57260050 + IF TABLE(I+1)=RTBRKT THEN BEGIN 57260055 + IF S<0 THEN GO EXPR2; T ~ THI; STEPIT; 57260060 + IF S}48 OR T>48 THEN FLAG(704); 57260065 + DOTIT ~ T & S[36:42:6] END ELSE BEGIN 57260070 + EXPR2: IF S}0 THEN EMITNUM(S); 57260080 + IF NOT SIMPLEX(14) THEN GO WAY END; 57260090 + IF ELCLASS ! RTBRKT THEN GO WAY; 57260100 + STEPIT; 57260105 + IF LITERALS THEN 57260110 + WAY: FLAG(404); 57260120 + END 57260140 + ELSE BEGIN 57261000 + IF DOTIT ~ ELBAT[I].ADDRESS = 0 57262000 + THEN DOTTER(GIT(TAKE(ELBAT[I].LINK).LINK)) 57263000 + ELSE STEPIT; 57263100 + END; 57264000 + END DOTIT; 57265000 + PROCEDURE ITEMREFERENCE(F); VALUE F; INTEGER F; 57266000 + BEGIN COMMENT (MCS 1); 57267000 +COMMENT GOBBLES UP AN ITEM REFERENCE AND LEAVES A THING LOOKING LIKE AN 57268000 + ACTUAL PARAMETER IN THE TOP OF THE STACK- I.E. AN IRW FOR A NAME57269000 + ITEM AND A VALUE FOR A VALUE ITEM 57269500 + F TELLS WHO CALLED AS IN VARIABLE 57269530 + ; 57269590 + INTEGER NEXTCLASS, % HOLDS CLASS OF NEXT THING AFTER ITEM 57270000 + INDEX, % INDEX OF ITEM WITHIN ENTRY 57271000 + QUEUECLASS; % QUEUEID OR QUEUEARRAYID 57272000 + REAL ITEMINFO, % HOLDS FIRST WORD OF ITEM INFO 57273000 + QUEUEINFO; % FIRST WORD OF QUEUE OR QUEUE ARRAY INFO 57274000 + REAL GT1; % HOLDS CLASS OF ITEM 57274500 + LABEL ON,QUIT,FINI; 57275000 + INDEX~(ITEMINFO+TAKE(ELBAT[I])).QINDEXF; 57276000 + N ~ ITEMINFO.LINK; 57277000 + QUEUECLASS~(QUEUEINFO~TAKE(IF(GT1~ ITEMINFO.CLASS) 57278000 + >EVENTARRAYID OR GT1 0 AND FSN >0 THEN COMMENT FIRST STMT IS DUMMY; 60037000 + BEGIN 60037100 + S ~ GET3(L ~ S - 3); COMMENT PICK UP LAST LINK; 60037200 + WHILE L MOD 3 ! 0 DO EMIT(NOOP); 60037300 + T ~ L; 60037400 + EMITLINK(S); COMMENT PUT THE LINK BACK; 60037500 + S ~ L; 60037600 + END ELSE 60037700 + BEGIN 60037800 + WHILE L MOD 3 ! 0 DO EMIT(NVLD); 60037900 + T ~ L; 60038000 + END; 60038100 + CASETAIL(N~N-1, T , LT); 60039000 + IF N > SN THEN 60039100 + IF N > LN THEN N ~ N - 1; COMMENT LAST STMT IS DUMMY; 60039200 + LT ~ (N+1)| 3 + T; COMMENT COMPUTE EXIT POINT ADDRESS; 60040000 + 60041000 + 60041900 + 6004200060020000 + 60042100 + WHILE L < LT DO EMITB(BRUN,BUMPL,LT); 60043000 + FIGS ~ TRUE; 60043100 + WHILE LCTR ~ LCTR - 1 } 0 DO 60044000 + BEGIN 60045000 + L ~ (E ~ GIT( NEXTADDL ~ NEXTADDL - 1)).DISP | 3 + T; 60046000 + GOGEN(E,BRUN); 60047000 + END OF LABELS; 60048000 +IF FSN } 0 THEN 60049000 + DO BEGIN 60050000 + SN ~ GET3(S - 3); 60051000 + EMITB(BRUN,S,LT); 60052000 + EMITB(BRUN,(SN.[24:8] + 1)|3+ T,S ~ SN.[32:16]); 60053000 + END STATEMENTS UNTIL SN.[24:8] { FSN; 60054000 + L ~ LT; 60066000 + FIGS ~ FALSE; 60066100 + COMPOUNDTAIL 60067000 + END CASE STATEMENT; 60068000 + PROCEDURE FORSTMT; 60069000 + BEGIN OWN REAL B,STMTSTART,REGO,RETURNSTORE,ADDRES,V,VRET,BRET; 60070000 + OWN BOOLEAN SIGNA,SIGNB,SIGNC,INT, 60071000 + BYE, 60071100 + CONSTANA,CONSTANB,CONSTANC; 60072000 + DEFINE SIMPLEB = SIGNC #, FORMALV = SIGNA #, 60073000 + SIMPLEV = CONSTANA #, A = V # , Q = REGO #, 60074000 + K = BRET #; 60075000 + LABEL EXIT; 60076000 + REAL T1,T2,T3,T4; 60077000 + PROCEDURE PLUG(C,A); VALUE C,A; REAL A; BOOLEAN C; 60078000 + IF C THEN EMITNUM(A) ELSE EMITV(A.ADDRESS); 60079000 + BOOLEAN PROCEDURE SIMPLE(B,A,S); 60080000 + BOOLEAN B,S; REAL A; 60081000 + BEGIN 60082000 + S ~ IF STEPI ! ADDOP THEN FALSE ELSE 60083000 + ELBAT[I].DISP = SUBT; 60084000 + IF ELCLASS= ADDOP THEN STEPIT; 60085000 + IF ELCLASS } NUMBER AND ELCLASS { STRNGCON THEN 60086000 + BEGIN 60087000 + SIMPLE ~ NOT DPTOG; 60088000 + ELBAT[I] ~ K&COMMENTV[21:41:7]; 60089000 + ADDL[K.LINKR,K.LINKC] ~ A ~ THI; 60090000 + B ~ TRUE; 60091000 + K ~ K + 1; 60092000 + END ELSE 60093000 + BEGIN 60094000 + B ~ FALSE; 60095000 + A ~ ELBAT[I]; 60096000 + SIMPLE ~ ELCLASS } DPID AND ELCLASS{INTID 60097000 + END; 60098000 + STEPIT; 60099000 + END SIMPLE; 60100000 + PROCEDURE TEST; 60101000 + BEGIN 60102000 + IF NOT CONSTANB THEN 60103000 + BEGIN 60104000 + EMITO(SUBT); 60105000 + IF SIMPLEB THEN EMITV(B.ADDRESS) ELSE 60106000 + BEGIN 60107000 + EMITNUM((L+9)DIV 3); 60108000 + EMITB(BRUN,BUMPL,B); 60109000 + WHILE L MOD 3 ! 0 DO EMIT(NVLD); 60110000 + END; 60111000 + EMITO(MULT); EMITNUM(0); 60112000 + END; 60113000 + EMITO(IF SIGNB THEN GREQ ELSE LSEQ); 60114000 + END TEST; 60115000 + BOOLEAN PROCEDURE SIMPI(ALL); VALUE ALL; REAL ALL; 60116000 + BEGIN 60117000 + REAL T; 60118000 + ADDRES ~ ALL.ADDRESS; 60119000 + FORMALV~ ALL.TYPE = FORMALNAMEP; 60120000 + IF T ~ ALL.CLASS > INTARRAYID 60121000 + OR T < BOOID 60122000 + OR T = REFID 60123000 + OR T = PTRID THEN ERR(REAL(T!0)|508 + 100); 60124000 + INT ~ T = INTID OR T = INTARRAYID; 60125000 + SIMPI ~ T { INTID; 60126000 + END SIMPI; 60127000 + PROCEDURE STORE(S); VALUE S; BOOLEAN S; 60128000 + BEGIN 60129000 + IF FORMALV THEN 60130000 + BEGIN 60131000 + S ~ FALSE; 60132000 + END ELSE 60133000 + EMITN(ADDRES); 60134000 + IF INT THEN BEGIN EMIT(EXCH); EMIT(NTGR) END; 60135000 + EMITO(STOD + REAL(S)); 60136000 + END STORE; 60137000 + PROCEDURE CALL(S); VALUE S; BOOLEAN S; 60138000 + BEGIN 60139000 + IF SIMPLEV THEN 60140000 + IF S THEN EMITV(ADDRES) ELSE 60141000 + EMITPAIR(ADDRES,EVAL) ELSE 60142000 + BEGIN 60143000 + EMITNUM((L+9) DIV 3); 60144000 + EMITB(BRUN,BUMPL,V); 60145000 + WHILE L MOD 3 ! 0 DO EMIT (NVLD); 60146000 + IF S THEN EMIT(NXLV); 60147000 + END; 60148000 + END CALL; 60149000 + PROCEDURE FORLIST(NUMLE); VALUE NUMLE; BOOLEAN NUMLE; 60150000 + BEGIN 60151000 + INTEGER BACKFIX,FORWARDBRANCH,FOOT,STOREFIX; 60152000 + LABEL BRANCH,EXIT; 60153000 + STOREFIX ~ L; 60154000 + BACKFIX ~ V + REAL(SIMPLEV) - 1; 60155000 + IF GT1 ~ AEXP { XTYPE THEN 60156000 + BEGIN 60157000 + ERR(632); GO TO EXIT; 60158000 + END; 60159000 + VRET ~ L; 60160000 + IF ELCLASS = BYV THEN 60161000 + BEGIN 60161010 + IF GT1 ! ITYPE THEN EMIT(NTGR); 60161015 + IF NOT SIMPLEV THEN 60161020 + BEGIN 60161030 + ERR(668); GO TO EXIT; 60161040 + END; 60161060 + STEPIT; 60161070 + EXPRESSION(ITYPE); 60161080 + EMITR(47,12); 60161090 + IF ELCLASS ! UNTILV THEN 60161140 + BEGIN 60161150 + ERR(667); GO TO EXIT; 60161160 + END; 60161180 + STEPIT; 60161185 + EXPRESSION(ITYPE); 60161190 + EMIT(ONE); 60161200 + EMIT(ADD); 60161210 + EMITR(35,16); 60161220 + EMITNUM(4); 60161250 + EMIT(STAG); 60161260 + EMITN(ADDRES); 60161270 + EMIT(STOD); 60161280 + IF ELCLASS ! DOV THEN 60161290 + BEGIN 60161300 + ERR(610); GO TO EXIT; 60161310 + END; 60161330 + BACKFIX ~ L; 60161340 + EMITN(ADDRES); 60161350 + STOREFIX ~ L; 60161360 + EMITLINK(0&STBR[24:40:8]); 60161370 + EMIT(DLET); 60161380 + STEPIT; 60161390 + STATEMENT; 60161400 + EMITB(BRUN,BUMPL,BACKFIX); 60161410 + EMITB(GET(STOREFIX),STOREFIX+3,L); 60161420 + GO TO EXIT; 60161430 + END; 60161440 + IF ELCLASS = STEPV THEN 60161999 + BEGIN 60162000 + BACKFIX ~ BUMPL; 60163000 + IF FORMALV THEN 60164000 + IF SIMPLEV THEN CALL(FALSE) ELSE 60164100 + WHILE L MOD 3 ! 0 DO EMIT(NVLD); 60164200 + CALL(TRUE); BACKFIX.[2:1] ~ 1; 60164300 + IF I > 70 THEN 60165000 + BEGIN 60166000 + NXTELBT ~ 1; 60167000 + I ~ 0; 60168000 + END ELSE 60169000 + REGO ~ I; 60170000 + IF SIMPLEB ~ SIMPLE(CONSTANB,B,SIGNB) 60171000 + AND (ELCLASS = UNTILV 60172000 + OR ELCLASS = WHILEV) THEN 60173000 + PLUG(CONSTANB,B) ELSE 60174000 + BEGIN 60175000 + I ~ IF I < 4 THEN 0 ELSE REGO; 60176000 + STEPIT; 60177000 + SIGNB ~ CONSTANB ~ FALSE; 60178000 + EMITO(ZERO); 60179000 + B ~ L; 60180000 + IF AEXP { XTYPE THEN 60181000 + BEGIN 60182000 + ERR(632); GO TO EXIT; 60183000 + END; 60184000 + EMITO(EXCH); 60185000 + BRET ~ L; 60186000 + EMIT(DBUN); 60187000 + END; 60188000 + EMITO(ADD + REAL(SIGNB)); 60189000 + EMITB(BRUN,BACKFIX,L); 60190000 + IF ELCLASS = UNTILV THEN 60191000 + BEGIN 60192000 + STORE(TRUE); 60193000 + IF FORMALV THEN CALL(TRUE); 60194000 + STEPIT; 60195000 + IF AEXP { XTYPE THEN 60196000 + BEGIN 60197000 + ERR(632); GO TO EXIT; 60198000 + END; 60199000 + TEST; 60200000 + END ELSE 60201000 + BEGIN 60202000 + IF ELCLASS ! WHILEV THEN 60203000 + BEGIN 60204000 + ERR(609); 60205000 + GO TO EXIT 60206000 + END; 60207000 + STEPIT; 60208000 + STORE(FALSE); 60209000 + BEXP; 60210000 + END; 60211000 + END ELSE 60212000 + BEGIN 60213000 + STORE(FALSE); 60214000 + IF ELCLASS = WHILEV THEN 60215000 + BEGIN 60216000 + STEPIT; 60217000 + BEXP; 60218000 + END ELSE 60219000 + BEGIN 60220000 + ERR(631); 60221000 + GO TO EXIT; 60222000 + END; 60223000 + END; 60224000 + EMITLINK(0&BRFL[24:40:8]); 60225000 + BRANCH: FORWARDBRANCH ~ L; 60226000 + IF ELCLASS = COMMA THEN 60227000 + BEGIN 60228000 + ERR(631); 60229000 + END ELSE 60230000 + BEGIN 60231000 + IF ELCLASS ! DOV THEN 60232000 + BEGIN 60233000 + ERR(610); 60234000 + GO TO EXIT; 60235000 + END; 60236000 + STEPIT; 60237000 + STATEMENT; 60238000 + IF BACKFIX.[2:1] = 1 AND FORMALV 60238100 + AND NOT SIMPLEV THEN 60238200 + BEGIN 60238300 + EMITNUM((BACKFIX+2) DIV 3); 60238400 + EMITB(BRUN,BUMPL,V); 60238500 + END ELSE 60238600 + EMITB(BRUN,BUMPL,BACKFIX); 60239000 + EMITB(GET(FORWARDBRANCH - 3), 60240000 + FORWARDBRANCH, 60241000 + L); 60242000 + END; 60243000 + EXIT: 60244000 + END FORLIST; 60245000 + NXTELBT ~ 1; I ~ 0; 60246000 + STEPIT; 60247000 + IF SIMPI(VRET ~ ELBAT[I]) THEN 60248000 + BEGIN 60249000 + IF STEPI ! ASSNOP THEN 60250000 + BEGIN 60251000 + ERR(611); 60252000 + GO TO EXIT; 60253000 + END; 60254000 + T1 ~ L; 60255000 + IF FORMALV THEN EMITN(ADDRES); 60256000 + K ~ NEXTADDL; 60257000 + IF SIMPLE(CONSTANA,A,SIGNA) THEN 60258000 + IF ELCLASS = STEPV OR BYE~ELCLASS=BYV THEN 60259000 + IF SIMPLE(CONSTANB,B,SIGNB) THEN 60260000 + IF ELCLASS = UNTILV THEN 60261000 + IF SIMPLE(CONSTANC,Q,SIGNC) THEN 60262000 + IF ELCLASS = DOV THEN 60263000 + BEGIN 60264000 + IF CONSTANA AND CONSTANB AND CONSTANC AND 60265000 + NOT(SIGNA OR SIGNB OR SIGNC ) AND 60266000 + A.[1:31]=0 AND Q.[1:31]=0 AND B.[1:36]=060267000 + % THE ABOVE CARD SHOULD BE CHANGED LATER TO ALLOW FOR TWELVE BITS 60267100 + % WORTH OF INCREMENT VALUE. . . . . 60267200 + AND BYE 60267300 + THEN 60268000 + BEGIN 60269000 + IF A > Q THEN 60270000 + BEGIN 60271000 + T1 ~ BUMPL; 60272000 + STEPIT; 60273000 + STATEMENT; 60274000 + EMITB(BRUN,T1,L); 60275000 + GO TO EXIT; 60276000 + END; 60277000 + EMITNUM(A&Q[12:32:16]&B[1:37:11]);60278000 + EMITNUM(4); 60279000 + EMIT(STAG); 60280000 + EMITN((T1~VRET).ADDRESS); 60281000 + EMIT(STOD); 60282000 + T2 ~ L; 60283000 + STEPIT; 60284000 + STATEMENT; 60285000 + EMITN(T1.ADDRESS); 60286000 + EMITB(STBR,BUMPL,L+4); 60287000 + EMIT(DLET); 60288000 + EMITB(BRUN,BUMPL,T2); 60289000 + GO TO EXIT; 60290000 + END; 60291000 + IF NOT BYE THEN 60291100 + BEGIN 60291200 + PLUG(CONSTANA,A); 60292000 + IF SIGNA THEN EMITO(CHSN); 60293000 + RETURNSTORE ~ BUMPL; 60294000 + STMTSTART ~ L; 60295000 + STEPIT; 60296000 + T1 ~ RETURNSTORE&STMTSTART[8:28:20]; 60297000 + T1.[7:1] ~ REAL(CONSTANB); 60298000 + T1.[6:1] ~ REAL(CONSTANC); 60299000 + T1.[5:1]~ REAL(SIGNB); 60300000 + T1.[4:1] ~ REAL(SIGNC); 60301000 + T2 ~ VRET; 60302000 + T3 ~ B; 60303000 + T4 ~ Q; 60304000 + STATEMENT; 60305000 + SIGNC ~ BOOLEAN(T1.[4:1]); 60306000 + SIGNB ~ BOOLEAN(T1.[5:1]); 60307000 + CONSTANC ~ BOOLEAN(T1.[6:1]); 60308000 + CONSTANB ~ BOOLEAN(T1.[7:1]); 60309000 + STMTSTART ~ T1.[8:20]; 60310000 + RETURNSTORE ~ T1.[28:20]; 60311000 + VRET ~ T2; 60312000 + B ~ T3; 60313000 + Q ~ T4; 60314000 + SIMPLEV ~ SIMPI(VRET); 60315000 + IF FORMALV THEN EMITN(ADDRES); 60316000 + EMITV(ADDRES); 60317000 + PLUG(CONSTANB,B); 60318000 + EMITO(ADD + REAL(SIGNB)); 60319000 + EMITB(BRUN,RETURNSTORE,L); 60320000 + STORE(TRUE); 60321000 + IF FORMALV THEN CALL(TRUE); 60322000 + PLUG(CONSTANC,Q); 60323000 + IF SIGNC THEN EMITO(CHSN); 60324000 + SIMPLEB ~ TRUE; 60325000 + TEST; 60326000 + EMITB(BRTR,BUMPL,STMTSTART); 60327000 + GO TO EXIT; 60328000 + END; 60328100 + END; 60329000 + I ~ 2; K ~ 0; 60330000 + SIMPLEV ~ SIMPI(VRET); 60331000 + V ~ T1; 60332000 + END ELSE 60333000 + BEGIN 60334000 + V ~ BUMPL; 60335000 + 60336000 + SIMPLEV ~ FALSE; 60337000 + FORMALV ~ TRUE; 60338000 + VRET ~ VARIABLE(FR); 60339000 + EMIT(EXCH); 60340000 + EMIT(DBUN); 60341000 + WHILE L MOD 3 ! 0 DO EMIT(NVLD); 60341100 + VRET ~ L; L ~ V-3; FIGS ~ TRUE; 60341200 + EMIT2P(LT16, VRET DIV 768, VRET MOD 768 DIV 3); 60341300 + FIGS ~ FALSE; L ~ VRET; 60341400 + IF ELCLASS ! ASSNOP THEN 60342000 + BEGIN 60343000 + ERR(611); 60344000 + GO TO EXIT; 60345000 + END; 60346000 + END; 60347000 + STEPIT; 60348000 + FORLIST(FALSE); 60349000 + EXIT: 60350000 + K ~ 0; 60351000 + END FORSTMT; 60352000 + PROCEDURE LABELR; 60353000 + BEGIN 60354000 + LABEL EXIT,ROUND; 60355000 + REAL GT1; 60356000 + DEFINE ELBATWORD = GT1 #, 60357000 + LINK = GT2 #, 60358000 + INDEX = GT3 #, 60359000 + ADDITIONAL= GT4 #, 60360000 + NEXTLINK = GT5 #; 60361000 + DO BEGIN 60362000 + IF STEPI ! COLON THEN 60363000 + BEGIN 60364000 + ERR(612); 60365000 + GO TO EXIT; 60366000 + END; 60367000 + IF (ELBATWORD~ELBAT[I-1]).[33:15] < NINFOO THEN 60368000 + BEGIN 60369000 + FLAG(613); 60370000 + GO TO ROUND; 60371000 + END; 60372000 + LINK ~ (ADDITIONAL ~ INDEX ~ TAKE(ELBATWORD)) 60373000 + .[32:16]; 60374000 + IF ADDITIONAL.TYPE ! F0RWARD THEN 60375000 + BEGIN 60376000 + FLAG(614); 60377000 + GO TO ROUND; 60378000 + END; 60379000 + WHILE LINK ! 0 DO 60380000 + BEGIN 60381000 + NEXTLINK ~ GET3(LINK); 60382000 + EMITB(NEXTLINK.[24:8],LINK+3,L); 60383000 + LINK ~ NEXTLINK.[32:16]; 60384000 + END; 60385000 + PUT(INDEX&L[32:32:16]&0[29:45:3],ELBATWORD); 60386000 + ROUND: 60387000 + ERRORTOG ~ TRUE; 60388000 + END UNTIL STEPI ! LABELID; 60389000 + EXIT: 60390000 + END LABELR; 60391000 + PROCEDURE IFSTMT; 60392000 + BEGIN 60393000 + REAL T1,T2,T3; 60394000 + LABEL INN, GRONK, ON; 60394100 + LABEL EXIT; 60395000 + T3 ~ REAL(IFCLAUSE).[47:1]; 60396000 + IF SIMPGO THEN 60397000 + BEGIN 60398000 + GOGEN(ELBAT[I], BRTR-T3); 60399000 + IF STEPI = ELSEV THEN 60400000 + BEGIN 60401000 + STEPIT; 60402000 + IF SIMPGO THEN 60403000 + BEGIN 60404000 + 60405000 + GOGEN(ELBAT[I],BRUN); 60406000 + STEPIT; 60407000 + GO TO EXIT; 60408000 + END; 60409000 + 60409200 + 60409300 + STATEMENT; 60409400 + GO TO EXIT; 60409500 + 60409600 + END; 60410000 + 60411000 + GO TO EXIT; 60412000 + END; 60413000 + IF ELCLASS } SEMICOLON AND ELCLASS { UNTILV THEN GO GRONK; 60413050 + T2 ~ T1 ~ BUMPL; 60413100 + IF ELCLASS = ELSEV THEN 60413150 + IF STEPI < SEMICOLON OR ELCLASS > ELSEV THEN 60413200 + IF SIMPGO THEN GO ON ELSE 60413250 + BEGIN T3 ~ 1 - T3; STATEMENT; GO INN END ELSE 60413300 + BEGIN 60413350 + L ~ L - 3; 60413400 + GRONK: EMIT(DLET); 60413450 + GO TO EXIT; 60413500 + END; 60413550 + 60414000 + STATEMENT; 60415000 + IF ELCLASS ! ELSEV THEN 60416000 + BEGIN 60417000 +INN: 60417500 + EMITB(BRFL+T3,T1,L); 60418000 + GO TO EXIT; 60419000 + END; 60420000 + STEPIT; 60421000 + IF SIMPGO THEN 60422000 + BEGIN 60423000 + T2 ~ L; 60424000 +ON: 60424500 + L ~ T1 - 3; 60425000 + FIGS ~ TRUE; 60425100 + GOGEN(ELBAT[I],BRFL + T3); 60426000 + L ~ T2; 60427000 + FIGS ~ FALSE; 60427100 + STEPIT; 60428000 + GO TO EXIT; 60429000 + END; 60430000 + T2 ~ BUMPL; 60431000 + EMITB(BRFL+T3,T1,L); 60432000 + STATEMENT; 60433000 + EMITB(BRUN,T2,L); 60434000 + EXIT: 60435000 + END IFSTMT; 60436000 + PROCEDURE GOSTMT; 60437000 + BEGIN 60438000 + REAL LT,S,N; 60439000 + REAL ELBW,GT1; 60439500 + REAL PCWADDR; 60439700 + DEFINE NEXTADDL = LASTADDL#; %HERE BEE MORE DRAGONS 60439800 + BOOLEAN TB1; 60440000 + LABEL EXIT, ON; 60441000 + LABEL CASECASE,CONTINUECASE; 60442000 + IF STEPI = TOV THEN STEPIT; 60443000 + IF ELCLASS = LABELID THEN TB1 ~ TRUE ELSE 60444000 + IF ELCLASS = CASEV THEN GO ON ELSE 60445000 + IF NOT TB1 ~ NOT FUTZALABEL THEN 60445100 + BEGIN 60446000 + ERR(615); 60447000 + GO TO EXIT; 60448000 + END; 60449000 + IF (ELBW~ELBAT[I]).LINK0 THEN IF ELCLASS!LFTPRN THEN IF T1!HALT THEN 60515000 + FLAG(604); 60515100 + CASE T2 OF 60516000 + BEGIN 60517000 + EMIT(T1); 60517100 + BEGIN 60518100 + IF STEPI=UNKNOWNID THEN FLAG(622); 60518110 + K~ELBAT[I]; 60518120 + IF GT1~TABLE(I+1)=LFTBRKT OR GT1=ATSIGN THEN 60518130 + BEGIN 60518140 + GT1~VARIABLE(FR); 60518150 + END ELSE 60518160 + BEGIN 60518170 + EMITN(K.ADDRESS); 60518180 + IF K.TYPE=FORMALNAMEP OR 60518190 + K.TYPE=FORMALNAMEQ THEN 60518200 + IF K.CLASS>BOOID AND 60518210 + (K.CLASS 0 THEN 60518980 + IF ELCLASS ! RTPARN THEN FLAG(623) ELSE STEPIT; 60518990 + GO TO SKIP2; 60519000 + END ELSE GO SKIP1; 60520000 + END; 60521000 + EMIT(MKST); 60522000 + IF TYPEF=FORMALNAMEQ 60522200 + THEN ITEMREFERENCE(FP) 60522300 + ELSE BEGIN EMITN(ADDRSF);STEPIT;END; 60522350 +COMMENT ITEMREFERENCE LEAVES IRW POINTING TO PCW IN TOS; 60522400 +SKIP1: 60523000 + N~(GT1~IF NOT FORMALF THEN GIT(ADDLADRES) ELSE 0).NOPAR; 60524000 +COMMENT THERE IS NO ADDL ENTRY FOR A FORMAL PROCEDURE; 60524100 + IF ELCLASS = LFTPRN THEN 60525000 + ACTUALPARAPART(FORMALF,ADDLADRES,GT1,TRUE) ELSE 60526000 + IF N!0 THEN ERR(604); 60527000 + IF T3=INTRINSIC THEN 60528000 + BEGIN 60528100 + IF T1.[30:6]=0 THEN EMIT(T1) ELSE 60528200 + BEGIN % PICK UP SYLLABLE FROM ADDL 60528250 + T2~T1.[30:6]; 60528300 + T2~ADDL[T2.LINKR,T2.LINKC]; 60528400 + EMIT1P(T1,T2); 60528500 + END; 60528600 + 60528700 + GO SKIP2 60528800 + END; 60528900 + EMIT(ENTR); 60529000 +SKIP2: IF TB1 AND NOT FROM THEN EMIT(DLET); 60530000 +COMMENT A CALL ON A FUNCTION FROM STMT REQUIRES A DLET ON RETURN; 60531000 + FINI: END PROCALL; 60532000 +INTEGER RETNBUG; COMMENT KLUDGE FOR BUG IN RETN OP; 6053290060533XXX + PROCEDURE ACTUALPARAPART(FBIT,INDEX,AD,FROM); 60533000 + VALUE FBIT,INDEX,AD,FROM; 60534000 + BOOLEAN FBIT,FROM; 60535000 + INTEGER INDEX; 60536000 + REAL AD; 60537000 +COMMENT ACTUALPARAPART IS RESPONSIBLE FOR CONSTRUCTING ALL CALLS ON PAR-60538000 + AMETERS.IT HANDLES THE ENTIRE PARAMETER LIST WITH ONE 60539000 + CALL. IT IS ALSO RESPONSIBLE FOR CHECKING FOR NON-CORRE-60540000 + SPONDENCE OF THE ACTUAL AND FORMAL PARAMETERS. 60541000 + FBIT TELLS IF THE PROCEDURE BEING CALLED IS FORMAL OR 60542000 + NOT 60543000 + AD IS FIRST ADDL WORD FOR PROCEDURE OR QUEUE 60544000 + FROM TRUE IF CALL FROM PROCALL.FALSE IF FROM ENTRYEXP 60544100 + INDEX IS THE INDEX INTO ADDL (-VE IF FROM STOREITEM) 60545000 + ; 60545500 + BEGIN 60546000 + INTEGER PCTR,ACLASS,SCLASS; 60547000 + BOOLEAN INTRINSICFLAG %TURNED ON FOR INTRINSIC 60547500 + ,STOREITEMFLAG %TURNED ON FOR STOREITEM CALL 60547600 + ; 60547700 + 60548000 + 60549000 + 60550000 + DEFINE FL=FR#; 60550500 + 60551000 + 60552000 +COMMENT PCTR IS A COUNT OF THE NUMBER OF PARAMETERS COMPILED. 60553000 + ACLASS IS THE CLASS OF THE ACTUAL PARAMETER 60554000 + SCLASS IS THE CLASS OF THE FORMAL PARAMETER; 60555000 + REAL WHOLE; 60556000 +COMMENT WHOLE CONTAINS THE ELBAT WORD OF THE ACTUAL PARAMETERS; 60557000 + BOOLEAN VBIT,VP; 60558000 +COMMENT VBIT TELLS WHETHER THE PARAMETER IS TO BE CALLED BY 60559000 + VALUE OR BY NAME 60560000 + VP TELLS WHETHER PROCEDURE HAS VARIABLE NO. OF PARAMS; 60561000 + LABEL ANOTHER,NORMAL,STORE,LRTS,CERR,NMCALL,VE,LOADPAR,NAMCPAR60562000 + ,LP,DIMCHECK,COMMON,HANDLEARRAY,FINI,BS; 60563000 + REAL T1,T2,T3,T4,T5,T6,T7; 60564000 + BOOLEAN ITEMFLAG; %SET FOR ACTUALS WHICH ARE ITEM REFERENCES 60564100 +COMMENT *** THE FOLLOWING TWO MECHANISMS MIGHT PROFITABLY BE OPTIMISED; 60564200 + DEFINE NOTWORDARRAY=(ACLASS!WORDARRAYID OR SCLASSWORDARRAYID) AND (SCLASS!WORDARRAYID 60564400 + OR ACLASSEVENTARRAYID 60564500 + OR ACLASS=PCID)#, 60564600 + NOTWORDPROCID=(ACLASS!WORDPROCID OR SCLASSPTRPROCID) AND (SCLASS!WORDPROCID60564800 + OR ACLASSPTRPROCID)#, 60564850 + NOTFORMALWORDARRAY=SCLASS!WORDID AND SCLASS!WORDARRAYID# 60564855 + ; 60564900 +COMMENT *** PERHAPS THESE CAN BE REDUCED; 60565000 + LABEL 60566000 + L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,L16,L17,L18,L19,L20, 60567000 + L21,L22,L23,L24,L25,L26,L27,L28,L29,L30,L31,L32,L33,L34,L35, 60568000 + L36,L37,L38,L40,L41,L42; 60569000 + DEFINE BOTTOM = 4#; 60570000 + SWITCH S ~L6 ,L7 ,L8 ,L9 ,L10 ,L11 ,L12 ,60571000 + L13 ,L40 ,L14 ,L15 ,L16 ,L17 ,L18 ,L19 ,L41 ,60572000 + L20 ,L21 ,L22 ,L23 ,L24 ,L25 ,L42 ,L26 ,L27 ,60573000 + L28 ,L29 ,L30 ,L31 ,L32 ,L33 ,L34 ,L35 ,L36 ,60574000 + %THIS PATCH FOR L37 MAKES STRNGCON LOOK LIKE NUMBER. USE THE 60574008 + %OPTAB SWITCH AS SOON AS WE GET A 6500. 60574009 + L37 ,L37 ; 60574100 +COMMENT THESE LABELS ARE ALL SCREWED UP. THERE IS NO CORRESPONDENCE 60575000 + BETWEEN THE NUMBERS IN THE LABELS AND THE CLASS VALUES IT 60576000 + WOULD BE WORTHWHILE CHANGING TO MNEMONIC LABELS LATER; 60577000 + 60578000 + COMMENT FOLLOWING MUST BE REMOVED LATER; 60579000 + FORMAT FMT ( " DEBUG ",3I6); 60580000 + FORMAT FMT1(" DEBUG ",4I9); COMMENT REMOVE LATER; 60580500 + INTEGER TEMPNO; 60581000 + INTEGER LOC; % LOCATION OF PCW IN THE SEGMENT, A WORD INDEX. 60581300 + BOOLEAN RETERN; 60581500 + DEFINE DEBUGLINE=IF DONSBUG THEN WRITE(LINE[DBL],FMT,ACLASS,SCLASS, 60582000 + TEMPNO)#; 60582001 + COMMENT END OF DEBUG DECLARATIONS; 60583000 + IF DONSBUG THEN 60583500 + WRITE (LINE[DBL],FMT,AD.NOPAR,N,10); COMMENT REMOVE LATER; 60584000 + INTRINSICFLAG ~ TYPEF=INTRINSIC; 60584500 + IF (STOREITEMFLAG~INDEX<0) THEN INDEX~ABS(INDEX); 60584800 + PCTR ~ 1; 60585000 + IF AD< 0 THEN BEGIN VP ~ TRUE;EMIT(ZERO) END ELSE VP~FALSE; 60586000 +COMMENT PROCEDURE HAS VARIABLE NUMBER OF PARAMETERS; 60587000 + ANOTHER:ACLASS ~ STEPI; WHOLE ~ ELBAT[I]; SCATTERELBAT; 60588000 +COMMENT SETUP FIELDS OF ACTUAL PAR;60589000 + IF FBIT OR VP THEN 60590000 + BEGIN VBIT ~ FALSE; SCLASS ~ FORMALID END 60591000 + ELSE 60592000 + BEGIN 60593000 + T7 ~ GIT(INDEX+PCTR); 60594000 + VBIT~((IF FROM THEN T7 ELSE T7~TAKE(T7.LINK)).TYPE 60594300 + =FORMALVALUEQ OR T7.TYPE=FORMALVALUEP); 60594500 + 60594600 + IF DONSBUG THEN 60594650 + WRITE(LINE[DBL],FMT,T7.TYPE,T7.CLASS,11); COMMENT REMOVE LATER; 60595000 +COMMENT *** ADDL WORDS OF PROCEDURE CONTAIN ELBAT WORDS FOR FORMAL 60596000 + PARAMETERS WHEREAS ADDL WORDS FOR QUEUE CONTAIN LINK TO60596100 + ITEM ELBATWORDS IS THIS DISTINCTION NECESSARY; 60596200 + IF SCLASS~ T7.CLASS{INTROAID AND SCLASS}REALPROCID THEN 60597000 + IF(SCLASS-REALPROCID) MOD INCR=1 THEN SCLASS~SCLASS-160598000 + ; 60599000 +COMMENT *** WHEN NOT FORMAL OR VARIABLE PARAMETER OBTAIN VBIT,SCLASS60600000 + FROM THE ADDL ENTRY FOR THE PROCEDURE. SCLASS MAY BE 60601000 + MODIEIED TO ELIMINATE DISTINCTION BETWEEN REAL AND INTE-60602000 + GER. NOTE DEPENDENCE UPON CLASS RELATIVITIES; 60603000 + 60604000 + IF NOT FROM AND NOT STOREITEMFLAG THEN 60604300 + BEGIN EMIT(DUPL);EMITNUM(T7.QINDEXF);EMIT(INDX) END;60604500 +COMMENT ACTUALPARAPART IS CALLED FROM ENTRYEXP WITH AN 60604800 + INDEXABLE DD IN THE TOP OF THE STACK, ALL ACTUAL 60604810 + PARAMETERS MUST BE PASSED TO THE SPACE REFERENCED BY60604820 + THIS DD (SEE BELOW). AT THIS POINT - I.E. AT THE 60604830 + BEGINNING OF PROCESSING FOR ALL PARAMETERS, AN 60604840 + INDEXED DD IS POINTING TO THE HOLE IN THE SPACE 60604850 + WHERE THE NEXT PARAMETER WILL BE PLACED; 60604860 + END; 60605000 + TEMPNO ~ 1; DEBUGLINE; COMMENT REMOVE LATER; 60606000 + IF NOT (ITEMFLAG~ITEMONLY(VBIT,SCLASS)) THEN 60606500 + IF T1~TABLE(I+1)!COMMA THEN 60607000 + IF T1 ! RTPARN THEN 60608000 +COMMENT THE ACTUAL PARAMETER HAS MORE THAN ONE LOGICAL QUANTITY60609000 + HENCE A DIFFERENT ANALYSIS IS REQUIRED; 60610000 + BEGIN 60611000 + IF ACLASS QUEUEARRAYID THEN 60612000 + BEGIN 60613000 +COMMENT THE ACTUAL PARAMETER DOES NOT START WITH AN ARRAY 60614000 + NAME, HENCE IT IS GENERAL EXPRESSION; 60615000 + NORMAL: IF VBIT OR VP OR ACLASS=EVENTARRAYID THEN 60616000 + VE: BEGIN COMMENT VALUE CALL OR REFERENCE CALL EPRSION;60617000 + T1~IF ELCLASS!EVENTID AND ELCLASS!EVENTARRAYID 60618000 + THEN EXPRSS ELSE VARIABLE(FP); 60618030 + IF DONSBUG THEN 60618050 + WRITE(LINE[DBL],FMT1,ELCLASS,T1.ARAYTPE,T1.ARAYDIM,16); 60618500 + IF VP OR ACLASS=EVENTARRAYID THEN INDXCHK 60619000 + END 60620000 + ELSE 60621000 + BEGIN COMMENT NAME CALL EXPRESSION; 60622000 + NMCALL: T2~ BUMPL; 60623000 +COMMENT T2 NOW HOLDS LOCATION FOR JUMP AROUND EXPRESSION;60624000 + T3 ~ INSERTPCW; 60625000 +COMMENT INSERTPCW CAUSES PCW TO BE PLACED BELOW 60626000 + MARKSTACK; 60627000 + T1~IF ELCLASS!EVENTID AND ELCLASS!EVENTARRAYID 60628000 + THEN EXPRSS ELSE VARIABLE(FP); 60628030 + IF DONSBUG THEN 60628050 + WRITE(LINE[DBL],FMT1,ELCLASS,T1.ARAYTPE,T1.ARAYDIM,15); 60628500 +COMMENT NOTE THAT PROTECTION AGAINST AN ATTEMPT TO STORE 60629000 + INTO AN EXPRESSION (INSIDE A PROCEDURE) IS PROV- 60630000 + IDED BY HARDWARE AND NOT (AS ON THE 5500) BY COM-60631000 + PILED CODE; 60632000 + INDXCHK; 60633000 +EMITN(RETNBUG~GETSTACK); EMIT(OVRD);EMITPAIR(RETNBUG,STFF); 6063390060634XXX +RTNSTACK(RETNBUG); 6063392060634YYY + EMIT(RETN); 60634000 + ENTERSEPA((LOC~T2 DIV 6 + 1),L,(LOC|6+9)); 60634100 +COMMENT THIS IS FOR SEPARATED COMPILING ONLY; 60634200 + EMITB(BRUN,T2,L); EMITN(T3); STUFF; 60634300 +COMMENT FINISH CODE AND COMPLETE BRANCH. AN IRW REFEREN- 60635000 + CING PCW PLACED IN STACK; 60636000 + END NAME CALL EXPRESSION; 60637000 + IF NOT BOOLEAN(T1.[01:01])%THEN IT"S NOT AN ARRAY. 60638000 + THEN ACLASS~(IF T1!EVTYPE THEN T1~BOOID ELSE 60638300 + EVENTID) 60638600 + ELSE 60638800 +COMMENT *** EXPRSS RETURNS TYPEPCID THEN ACLASS~ACLASS-INCRTWICE 60664000 + ELSE ACLASS~ACLASS-INCR; 60665000 + IF ACLASS= INTID THEN ACLASS~ REALID; 60666000 +COMMENT ACLASS NOW IS CLASS WHICH WOULD BE RETURNED BY EXPRSS; 60667000 +COMMENT *** THIS CODE IS KLUDEGY AND MAY BE WRONG- RECONSIDER LATER; 60668000 + GO TO BS; 60669000 + END NAME CALL SINGLY SUBSCRIPTED VARIABLE 60670000 + END ACTUAL PARAMETER WITH MORE THAN ONE LOGICAL QUANT;60671000 +COMMENT IF WE REACH THIS POINT THE ACTUAL PARAMETER IS A SINGLE 60672000 + LOGICAL QUANTITY; 60673000 + IF NOT ITEMFLAG THEN STEPIT; 60674000 + GO TO S[ACLASS-BOTTOM]; 60675000 + IF ACLASS=EVENTID THEN GO TO NAMCPAR; 60676000 + IF ACLASS=0 THEN FLAG(100) 60677000 + ELSE 60678000 + CERR: COMMENT ILLEGAL ACTUAL PARAMETERS FLAGGED HERE; 60679000 + L7:L8:L33: BEGIN FLAG(607); ERRORTOG ~ TRUE; GO TO COMMON END; 60680000 + L26: COMMENT PICTURE ID; 60681000 + IF FORMALF THEN EMITPAIR(ADDRSF,LOAD) ELSE 60682000 + COMMENT IF THE PICTURE WAS FORMAL, WE PASS IT ALONG. 60682020 + OTHERWISE WE GEN UP A THUNK; 60682040 + BEGIN 60682060 + T4 ~ 0 & (CURRENT+1) [30:42:6]; 60682080 + T2 ~ BUMPL; 60682100 + EMITPAIR(T4+2,LOAD); EMITPAIR(T4+3,LOAD); 60682120 + T5 ~ PICTUREGEN(FALSE,TRUE,TAKE(ELBAT[I-1]).LINK); 60682140 + EMITPAIR(T4+4,STOD); 60682160 + EMIT(RETN); 60682180 + T3 ~ INSERTPCW; 60682200 + EMITNUM(T5); 60682220 + EMIT(GREQ); 60682240 + EMITB(BRTR,BUMPL,T2); 60682260 + EMIT(NVLD); 60682280 + EMITB(BRUN,T2,L); 60682300 + EMITN(T3); STUFF 60682320 + END; 60682340 + GO TO BS; 60682360 + LOADPAR:IF VBIT THEN 60683000 + BEGIN 60683100 + %PATCH TO MAKE INTEGERS LOOK LIKE REALS--RATCHFORD, 11-16-68. 60683150 + I~I-2; STEPIT; 60683200 + IF ACLASS~EXPRSS+BOOID{INTROAID AND ACLASS}REALPROCID THEN 60683300 + IF (ACLASS-REALPROCID) MOD INCR=1 THEN ACLASS~ACLASS-1; 60683400 + END ELSE 60683500 + NAMCPAR: IF ITEMFLAG THEN ELSE BEGIN EMITN(ADDRSF); 60684000 + IF FORMALF THEN EMIT(LOAD) ELSE STUFF END; 60684500 + BS: IF SCLASS ! ACLASS THEN 60685000 + IF SCLASS ! FORMALID THEN 60686000 + IF SCLASS!WORDID AND ACLASS!WORDID THEN 60686200 + IF NOTWORDARRAY THEN 60686400 + IF NOTWORDPROCID THEN 60686600 +COMMENT ACTUAL AND FORMAL PARAMETERS DO NOT AGREE; 60687000 + BEGIN TEMPNO ~ 2; DEBUGLINE; FLAG(622); GO TO CERR; COMMENT FIX UP;END;60688000 + COMMON: 60689000 +COMMENT NEXT PARAMETER WILL BE EXAMINED; 60690000 + PCTR ~ PCTR+1; 60691000 + 60692000 + IF NOT FROM THEN 60692100 + BEGIN 60692200 +COMMENT WE ARE PROCESSING AN ENTRY EXPRESSION. PARAMETER IS IN TOP 60692300 + OF STACK, INDEXED DD IN SECOND WORD FROM TOP AND INDEXABLE 60692310 + DD IN THIRD WORD FROM TOP; 60692320 + EMIT(EXCH); 60692400 + EMIT(OVRD); 60692500 +COMMENT PARAMETER HAS BEEN TRANSFERRED TO SPACE FOR ENTRY.INDEX- 60692600 + ABLE DD POINTING TO THIS SPACE IS IN TOP OF STACK; 60692610 + END ENTRY EXPRESSION CASE; 60692700 + IF ELCLASS= COMMA THEN 60692750 + GO TO ANOTHER; 60692800 + 60692900 + IF ELCLASS ! RTPARN THEN BEGIN ERR (623);GO TO FINI END; 60693000 + IF NOT FBIT AND NOT VP THEN 60694000 + IF FROM AND AD.NOPAR+1!PCTR THEN 60695000 + BEGIN COMMENT WRONG NUMBER OF PARAMETERS; 60696000 + IF DONSBUG THEN 60696050 + WRITE(LINE[DBL],FMT,PCTR,AD.NOPAR,12); COMMENT REMOVE LATER; 60697000 + ERR(604); GO TO FINI 60698000 + END; 60699000 + STEPIT; GO TO FINI; 60700000 + L6: 60701000 +COMMENT PROCEDURE; 60702000 + TEMPNO ~ 3; DEBUGLINE; COMMENT REMOVE LATER; 60703000 + TB1~ TRUE; 60704000 + IF FORMALF THEN GO TO NAMCPAR; 60705000 + LP: IF TYPEF = INTRINSIC THEN BEGIN FLAG(620);GO TO CERR END; 60706000 +COMMENT ***INTRINSIC PROCEDURE AS ACTUAL PARAMETER- FIX UP LATER; 60707000 + IF T1 ~ GIT(WHOLE~TAKE(WHOLE).LINK).NOPAR =0 THEN 60708000 + BEGIN 60709000 +COMMENT THE PROCEOURE BEING PASSED HAS ZERO PARAMETERS; 60710000 + IF TB1 THEN GO TO NAMCPAR; COMMENT PROCID OR DPPROCID; 60711000 + IF NOT FBIT AND NOT VP THEN 60712000 + BEGIN 60713000 + TEMPNO ~ 4; DEBUGLINE; COMMENT REMOVE LATER; 60714000 + ACLASS ~ ACLASS+INCR; 60715000 + IF SCLASS{PTRPROCID THEN SCLASS~SCLASS+INCR; 60716000 + END; 60717000 +COMMENT *** ACTUAL PARAMETER IS ZERO PARAMETER FUNCTION-MAY BE PASSED60718000 + AS EXPRESSION IRRESPECTIVE OF CLASS OF FORMAL PARAMETER. 60719000 + CONVENIENT TO MODIFY(WHEN NECESSARY) SCLASS RATHER THAN 60720000 + ACLASS, NOTE DEPENDENCE ON RELATIVITIES OF CLASSES; 60721000 + GO TO LOADPAR 60722000 + END CASE OF ZERO PARAMETERS; 60723000 + TB1 ~ TRUE; 60724000 + FOR T2~1 STEP 1 UNTIL T1 60725000 + DO BEGIN 60726000 + IF (T3~GIT(WHOLE+T2)).TYPE=FORMALVALUEQ OR 60727000 + T3.TYPE=FORMALVALUEP THEN 60727100 +COMMENT THE T2-TH PARAMETER TO THE PROCEDURE BEING PASSED IS 60728000 + VALUE; 60729000 + BEGIN 60730000 + IF TB1 THEN 60731000 + BEGIN 60732000 +COMMENT THIS IS THE FIRST VALUE PARAMETER. WE CONSTRUCT 60733000 + THUNK HERE TO ENSURE THAT WHEN THIS PROCEDURE IS 60734000 + CALLED,ITS PARAMETERS THAT ARE VALUE GET CALLED BY60735000 + VALUE. THIS ONLY OCCURS WITH FIRST VALUE PARMETER;60736000 + TB1~FALSE ; COMMENT TURN OFF FOR FUTURE VAL PARS;60737000 + T5 ~ BUMPL; 60738000 + T6 ~ INSERTPCW; 60739000 + EMIT(MKST); 60739100 + EMITN(ADDRSF); 60739200 + FOR T4~2 STEP 1 WHILE T4{T2 DO 60739300 + BEGIN 60739400 +COMMENT SINCE WE FIND THE 1ST VALUE PARAMETER, WE RE-DO 60739500 + THOSE NAME CALLS WHICH WE DIDNOT CARE BEFORE; 60739600 + EMITN(T4&(CURRENT+1)[30:42:6]); 60739700 + STUFF; 60739800 + END; 60739900 + END CASE FOR FIRST VALUE PARAMETER; 60740000 +COMMENT WE CAN NOW BUILD CODE FOR VALUE CALL EVALUATION; 60741000 + EMITV((T2+1)&(CURRENT+1)[30:42:6]); 60742000 + END CASE FOR ANY VALUE PARAMETER ELSE 60743000 + IF TB1 THEN ELSE 60743100 + BEGIN 60743200 +COMMENT SINCE THERE ARE VALUE PARAMETERS, WE HAVE TO ALSO 60743300 + PASS THE NAME PARAMETERS; 60743400 + EMITN((T2+1)&(CURRENT+1)[30:42:6]); 60743500 + STUFF; 60743600 + END; 60743700 + END CHASING OF PARAMETERS TO PROCEDURE BEING PASSED; 60744000 + IF NOT TB1 THEN 60745000 + BEGIN 60746000 +COMMENT THERE WERE VALUE CALLS SO THUNK MUST BE COMPLETED; 60747000 + EMIT(ENTR); 60747500 + EMIT(IF RETERN THEN RETN ELSE EXIT); 60748000 + ENTERSEPA((LOC~T5 DIV 6 + 1),L,(LOC|6+9)); 60748500 +COMMENT FOR SEPARATED COMPILING ONLY, TEST IS IN THE DEFINE; 60748501 + EMITB(BRUN,T5,L); 60749000 + ADDRSF ~ T6 60750000 + END CASE OF VALUE PARAMETERS TO PROCEDURE BEING PASSED; 60751000 + TEMPNO ~ 5; DEBUGLINE; COMMENT REMOVE LATER; 60752000 + GO TO NAMCPAR; COMMENT MUST BE NAME CALL; 60753000 + L12: ACLASS~ REALPROCID; COMMENT CHANGE INTEGER TO REAL ID; 60754000 + L9:L10:L11:L13:L14:L40: 60755000 +COMMENT ALL TYPED PROCEDURES PROCESSED HERE; 60756000 + IF FORMALF THEN COMMENT PROCEDURE BEING PASSED IS FORMAL; 60757000 + BEGIN 60758000 + IF SCLASS>PTRPROCID THEN ACLASS~ACLASS+INCR; 60759000 +COMMENT *** THE FORMAL PARAMETER DOES NOT CALL FOR A PROCEDURE SO IT 60760000 + MUST CALL FOR AN EXPRESSION, NOTE USE OF RELATIVITIES; 60761000 + IF VBIT THEN BEGIN EMITV(ADDRSF);GO TO BS END 60762000 + ELSE GO TO NAMCPAR; 60763000 + END CASE WHERE PROCEDURE BEING PASSED IS FORMAL; 60764000 + RETERN~TRUE; 60764500 + TB1~ACLASS=DPPROCID; GO TO LP; 60765000 +COMMENT NO ZERO PARAMETER FUNCTION OPTIMIZATION FOR DPPROCID; 60765300 + L19:L20:L41: COMMENT REFERENCE,POINTER,WORD IDS; 60765500 + IF VBIT AND NOT ITEMFLAG THEN BEGIN EMITN(ADDRSF);EMIT(IF 60765600 + ACLASS=WORDID THEN LODT ELSE LOAD);GO TO BS END ELSE 60765800 + GO TO NAMCPAR; 60765850 + L18: ACLASS ~ REALID; 60766000 + L15:L16:L17: 60767000 +COMMENT ALL TYPED IDS PROCESSED HERE; 60768000 + IF VBIT THEN BEGIN IF ITEMFLAG THEN ELSE EMITV(ADDRSF); 60769000 + GO TO BS END ELSE GO TO NAMCPAR; 60770000 + L24:L30:ACLASS~ REALARRAYID; 60771000 +COMMENT INTEGER ARRAYS CHANGED TO REAL; 60772000 + GO TO HANDLEARRAY; 60773000 + L32: ACLASS~ REFARRAYID; COMMENT QUEUARRAYS LOOK LIKE REFARRAYS; 60774000 + GO TO HANDLEARRAY; 60775000 + L27:L28:L29: 60776000 + ACLASS ~ ACLASS-INCR; 60777000 +COMMENT ***READ ONLY ARRAYS NOW LOOK LIKE REGULAR ARRAYS. 60778000 + ; 60779000 + HANDLEARRAY: 60780000 + L21:L22:L23:L25:L31:L42: 60781000 +COMMENT ARRAYS HANDLED HERE; 60782000 + IF NOT ITEMFLAG THEN 60782500 + EMITN(ADDRSF); 60783000 + IF INTRINSICFLAG AND VBIT THEN EMIT(LODT) ELSE 60784000 + 60784001 + IF NOT ITEMFLAG THEN IF FORMALF THEN EMIT(LOAD) ELSE STUFF; 60784300 +COMMENT AN INTRINSIC VALUE CALL EXPECTS THE DD; 60784600 + T1.ARAYDIM ~ GIT(TAKE(WHOLE).LINK).NODIM; 60785000 + GO TO DIMCHECK; 60786000 + L34: COMMENT QUEUEID; 60787000 + ACLASS ~ REFID; 60788000 + GO TO LOADPAR; 60789000 + L35: COMMENT NULLV; 60790000 + EMIT(ZERO);EMITNUM(5);EMIT(STAG);GO TO BS; 60791000 +COMMENT *** FORMAT OF NULLV NOT YET DETERMINED; 60792000 + L36: COMMENT TRUTHV; 60793000 + ACLASS ~ BOOID; EMIT(ADDRSF); GO TO BS; 60794000 + L37: COMMENT NUMBER; 60795000 + I ~ I-2; STEPIT; 60796000 + IF SCLASS = FORMALID THEN T1~EXPRSS ELSE 60796500 + EXPRESSION(SCLASS-BOOID); 60797000 + IF DONSBUG THEN 60797050 + WRITE(LINE[DBL],FMT1,ELCLASS,T1.ARAYTPE,T1.ARAYDIM,16); 60797500 + ACLASS ~ SCLASS; 60798000 + GO TO BS; 60799000 +L38: 60800000 +COMMENT *** HANDLING OF DOUBLE PRECISION NUMBERS RAISES SOME PROBLEMS AT60801000 + PRESENT HENCE KLUDGE.CHANGE AS SOON AS POSSIBLE; 60802000 + FINI : END ACTUALPARAPART; 60803000 +INTEGER PROCEDURE INSERTPCW; 60804000 +COMMENT INSERTPCW CAUSES PCW TO BE PLACED BELOW MARKSTACK AND RETURNS 60805000 + ITS LOCATION; 60806000 + 60806010 + IF CURRENT = 0 THEN 60806100 + BEGIN 60806150 + JUMPCHKNX; 60806180 + GLOBALPCW(INSERTPCW~GETSPACE(-0),SEGNO,L,STATE); 60806200 + END ELSE 60806250 + BEGIN 60807000 + JUMPCHKX; COMMENT THIS IS BLOCKHEAD CODE; 60807500 + INSERTPCW ~ GETSPACE(-CURRENT); 60808000 + EMITPCW(CURRENT+1,(L DIV 6)|6+15,STATE,SEGNO); 60809000 + JUMPCHKNX; 60809500 + END INSERTPCW; 60810000 + 60810010 + BOOLEAN PROCEDURE ITEMONLY(VBIT,SCLASS);VALUE VBIT,SCLASS; 60810020 + BOOLEAN VBIT; INTEGER SCLASS; 60810040 +COMMENT WHEN THE ACTUAL PARAMETER IS EITHER: 60810060 + OR60810080 + @ OR60810100 + 60810120 + (WHERE ITEM IS PROCEDURE EITHERUNTYPED OR 60810140 + TYPED WITH FORMAL PARAMETER TYPED 60810160 + PROCEDURE ALSO) 60810170 + IT IS COMPILED AND THE VALUE TRUE IS RETURNED.OTHER- 60810180 + WISE FALSE IS RETURNED; 60810200 + BEGIN 60810220 + LABEL FINI; 60810230 + BOOLEAN NAMEFLAG; 60810240 + INTEGER ELCLAS; 60810260 + IF KLASSF=NUMBER THEN BEGIN ITEMONLY~FALSE ;GO FINI;END; 60810270 + IF (ITEMONLY~ 60810280 + ((NAMEFLAG~TYPEF=FORMALNAMEQ) OR TYPEF=FORMALVALUEQ) AND 60810300 + (((ELCLAS~ 60810320 + TABLE(I+1))=ATSIGN AND TABLE(I+2)=REFID) OR 60810340 + (ELCLAS=COMMA OR ELCLAS=RTPARN) OR60810350 + 60810360 + 60810380 + KLASSF=PROCID OR 60810400 + (RANGE(BOOPROCID,PTRPROCID) AND SCLASS}BOOPROCID AND 60810420 + SCLASS{PTRPROCID))) 60810440 + THEN 60810460 + BEGIN 60810480 + ITEMREFERENCE(FP); 60810500 + IF NAMEFLAG 60810520 + THEN IF VBIT 60810540 + THEN EMIT (IF KLASSF=WORDID THEN LODT ELSE 60810560 + LOAD) 60810580 + ELSE 60810600 + ELSE IF VBIT 60810620 + THEN 60810640 + IF ELCLASS!PERIODV THEN ELSE 60810642 + BEGIN 60810644 + IF STEPI = TAGV THEN 60810646 + BEGIN EMIT(RTAG); STEPIT END ELSE60810647 + IF GT1~DOTIT =0 THEN EMIT(DISO) 60810648 + ELSE 60810650 + EMITI(GT1.[36:6],GT1.[42:6]); 60810652 + END 60810654 + ELSE INDXCHK 60810660 + END; 60810680 +FINI: 60810690 + END ITEMONLY; 60810700 +PROCEDURE COMPOUNDTAIL; 60811000 + COMMENT COMPOUNDTAIL COMPILES COMPOUNDTAILS. IT ALSO ELIMINATES 60812000 + COMMENTS FOLLOWING ENDS. AFTER ANY ERROR, ERROR MESSAGES ARE 60813000 + SUPPRESSED. COMPOUNDTAIL IS PARTIALLY RESPONSIBLE FOR 60814000 + RESTORING THE ABILITY TO WRITE ERROR MESSAGES. SOME CARE IS 60815000 + ALSO TAKEN TO PREVENT READING BEYOND THE "END."; 60816000 + BEGIN LABEL ANOTHER; 60817000 + I~I-1; 60818000 +ANOTHER: ERRORTOG~TRUE; % ALLOW ERROR MESSAGES 60819000 + CONTEXT ~ 2; 60820000 + STEPIT; 60821000 + STATEMENT; 60822000 + IF ELCLASS=SEMICOLON THEN GO ANOTHER; 60823000 + IF ELCLASS!ENDV THEN 60824000 + BEGIN ERR(624); % MISSING SEMICOLON OR END 60825000 + GO ANOTHER; 60826000 + END; 60827000 + ENDTOG~TRUE; 60828000 + DO CONTEXT~3 % END COMMENTARY 60829000 + UNTIL STEPI } SEMICOLON AND ELCLASS { ELSEV OR NOT ENDTOG; 60830000 + ENDTOG~FALSE; 60831000 + CONTEXT ~ 2; 60832000 + IF BEGINCTR~BEGINCTR-1!0 EQV ELCLASS=PERIODV THEN 60833000 + BEGIN IF BEGINCTR=0 THEN 60834000 + BEGIN FLAG(625); % EXTRA END 60835000 + BEGINCTR~1; GO ANOTHER; 60836000 + END; 60837000 + FLAG(626); % MISSING END 60838000 + END; 60839000 + IF ELCLASS=PERIODV THEN 60840000 + BEGIN 60841000 + CBUFF[0] ~ "ND;END."&"E"[1:43:5]; 60842000 + DONE~TRUE; 60843000 + NCR~READACARD; 60844000 + ELBAT[I~I-2]~SPECIAL[46]; 60845000 + ELCLASS~SEMICOLON; 60846000 + END; 60847000 + END COMPOUNDTAIL; 60848000 + PROCEDURE QSTMT; 60851000 +COMMENT COMPILES THE QUEUE ASSIGNMENT STATEMENT 60852000 + THE QUEUE ASSIGNMENT STATEMENT IS OF THE FORM: 60853000 + ::= WHERE 60854000 + ::=/[INDEX] 60856000 + MOST OF THE WORK IS DONE BY QALGORITHM; 60857000 + BEGIN COMMENT (MCS 1); 60858000 + DEFINE ADDLADRES = N#, % LINK TO ADDL ENTRY FOR Q 60859000 + PARINFO = GT1#; % INFORMATION ON PARAMETERS TO 60860000 + % INSERT 60861000 + % =2 ONE PARAMETER ONLY 60862000 + % =3 TWO PARAMETERS 60863000 + PARINFO ~ 2; 60864000 + ADDLADRES ~ TAKE(ELBAT[I]).LINK; 60865000 + IF ELCLASS= QUEUEARRAYID THEN 60866000 + ADDLADRES ~ ADDLADRES + 1; 60867000 +COMMENT *** FIRST WORD OF ADDL FOR A QUEUE ARRAY CONTAINS INFOR- 60868000 + MATION ON BOUNDS; 60869000 + IF STEPI = LFTBRKT THEN PARINFO ~ 3; 60870000 + QALGORITHM (PARINFO, ADDLADRES,FALSE) 60871000 + END QSTMT MCS1 ; 60872000 + PROCEDURE QALGORITHM(PARINFO,ADDLADRES,FROM); VALUE PARINFO,ADDLADRES, 60873000 + FROM; 60874000 + INTEGER PARINFO, % =0 EXPLICIT CALL I AT ALGORITHM ID 60875000 + % =1 IMPLICIT CALL ON ALLOCATE, I AT LFTPRN60876000 + % =2 IMPLICIT CALL ON INSERT,I AT ASSNOP 60877000 + % =3 IMPLICIT CALL ON INSERT,I AT LFTBRKT 60878000 + ADDLADRES; % HOLDS LINK TO FIRST (QUEUEID) OR 60879000 + % SECOND (QEUEARRAYID) WORD OF QADDL FOR 60880000 + % IMPLICIT CALLS 60881000 + BOOLEAN FROM; % FALSE IF CALL IS FROM STATEMENT 60882000 +COMMENT COMPILES CODE FOR EXPLICIT OR IMPLICIT CALLS ON QUEUE ALGORITHMS60883000 + DETERMINES THE NUMBER AND TYPE OF ACTUAL PARAMETERS TO BE PASSED60884000 + WHEN THERE ARE FEWER ACTUAL PARAMETERS THAN REQUIRED CONSTRUCTS 60885000 + APPROPRIATE DUMMY PARAMETERS 60886000 + THIS PROCEDURE IS CALLED FROM QSTMT TO HANDLE IMPLICIT CALL 60887000 + ON INSERT. IT IS ALSO CALLED TO HANDLE THE IMPLICIT ALLOCATE 60888000 + ASSOCIATED WITH AN ENTRY EXPRESSION. 60888500 + THE FACILITIES SIZE,BUSY,LOCK AND UNLOCK ARE HANDLED HERE 60889000 + HOWEVER IN-LINE CODE RATHER THAN PROCEDURE ENTRY IS RESULT 60890000 + NOTE THAT BUSY,LOCK AND UNLOCK CAN REFERENCE OTHER THAN QUEUES 60890500 + HOWEVER IT IS CONVENIENT TO HANDLE THEM HERE 60890505 + ; 60890800 +COMMENT *** SHOULD THIS PROCEDURE HANDLE BOTH IMPLICIT AND EXPLICIT 60891000 + CALLS; 60892000 + BEGIN COMMENT (MCS 1); 60893000 + INTEGER KEY, % ALGORITHM KEY 60894000 + DESCPARA,% PARAMETER DESCRIPTION 60895000 + NOPAR, % NUMBER OF PARAMETERS 60896000 + TYPEA; % TYPE OF ALGORITHM 60897000 + INTEGER ARRAY ACTUALP[1:2]; %HOLDS CLASS OF FORMAL PAR 60898000 + BOOLEAN MISSINGACTUAL; % SET WHEN FEWER ACTUAL THAN 60899000 + % FORMAL PARAMETERS 60899050 + BOOLEAN NOTQUEUE %INDICATES NON Q 60899500 + , TB %SCRATCH 60899600 + , ISVALUE %INDICATES VALUE ITEMREFRNCE60899700 + , BUZZF %INDICATES BUZZ ALGORITHM 60899800 + ; 60899900 + DEFINE BUZF=BUZZF#; 60900000 + BOOLEAN GTB1; %SCRATCH 60900500 + INTEGER N; 60900550 + LABEL ON,QUIT,ENDPAR,STAP,FINISH,FINI,EMITENTER,ANOTHER; 60901000 + LABEL ISRTPARN,WHEREFROM,CONTINUE; 60901500 + REAL ELCLAS; 60901520 + LABEL RESIGN,LOCKL; 60901530 + REAL GT4,GT5; 60901540 + LABEL CONTINU ; 60901545 + REAL GT1,GT2,GT3; 60901550 +COMMENT FOLLOWING MUST BE REMOVED LATER; 60901551 +FORMAT FMT4 (" ITEMINFO ", 10I9); 60901552 +INTEGER DT1,DT2,DT3,DT4,TEMPNO; 60901553 + DEFINE DEBUG = IF DONSBUG THEN#; 60901554 +DEFINE 60901555 +D4 = DEBUG WRITE(LINE[DBL],FMT4,TD.ADDRESS,TD.ALGNO,TD.TYPE,TD.PARADESC 60901556 +,TEMPNO,DT1,DT2,DT3,DT4)#; 60901557 +REAL TD; 60901558 + MISSINGACTUAL~FALSE; 60902000 +COMMENT*** NOTQUEUE~TB~ISVALUE~BUZZF~FALSE; %IMPLIED BY PREVIOUS STMNT 60902500 + GT3~0; 60902600 + IF PARINFO ! 0 THEN GT2~GIT(ADDLADRES); 60902800 + IF PARINFO = 0 60903000 + THEN 60904000 + BEGIN COMMENT (MCS 2) EXPLICIT CALL; 60905000 + KEY~(GT1~TAKE(ELBAT[I])).ALGNO; 60906000 + IF STEPI ! LFTPRN THEN BEGIN FLAG(629);GO QUIT END; 60907000 + GTB1~KEY}LOCKKEY AND KEY{UNLOCKKEY; 60907500 + IF STEPI!QUEUEID AND ELCLASS!QUEUEARRAYID 60908000 + THEN BEGIN COMMENT MCS2AA; 60908200 + NOTQUEUE~TRUE ; 60908400 + IF NOT GTB1 THEN GO RESIGN; 60908600 + IF((ELCLAS~ELCLASS)}BOOID AND ELCLASS{PTRID60908700 + )60908750 + THEN IF(ISVALUE~(GT2~(GT5~TAKE(ELBAT[I])60908800 + ).TYPE)=FORMALVALUEQ) OR 60908801 + GT2=FORMALNAMEQ 60908900 + THEN BEGIN ITEMREFERENCE(FP); 60909000 + GO TO LOCKL;END 60909030 + ELSE BEGIN GT3~ELBAT[I].ADDRESS; 60909050 + GO CONTINU ;END; 60909100 +TEMPNO~5;DT1~ELCLASS;DT2~ELCLAS;D4; 60909200 + IF(ISVALUE~((ELCLAS~(ELCLASS-INCR))}BOOID 60909300 + AND ELCLAS{WORDID)) 60909400 + THEN IF VARIABLE(FP)[]~61018000 + REVERSES THE ORDER OF PARAMETERS REQUIRED BY INSERT 61019000 + HENCE WE MUST EXCHANGE THE TWO ACTUAL PARAMETERS; 61020000 + EMIT (ENTR); 61021000 + IF TYPEA ! PROCD AND NOT FROM THEN EMIT(DLET); 61022000 +COMMENT WHEN CALL IS FROM STATEMENT AND WE HAVE A TYPED 61023000 + ALGORITHM THEN WE MUST DELETE RESULT; 61024000 + GO FINI; 61025000 + QUIT: FLAG(635); 61025200 + ERRORTOG~TRUE; 61025400 + FINI: END MCS 1 QALGORITHM; 61025600 + PROCEDURE EVENTINTRINSIC; 61026000 +COMMENT THE ELBAT WORD OF THE EVENT INTRINSIC HAS A KEY IN FIELD "KIND"61026005 + WHICH IDENIFIES THE PARTICULAR INTRINSIC. THIS PROCEDURE 61026010 + FIRST CHECKS THE PARAMETER(S), THEN TAKES THE FOLLOWING ACTION:61026015 + CAUSE ONE PARAMETER ONLY. EMITS CODE TO ENTER THE MCP 61026020 + WAIT PROCEDURE "EVENTHANDLER", PASSING AS PARAMETERS 61026025 + THE KEY(BY VALUE) AND THE EVENT (BY NAME) 61026030 + 61026035 + 61026040 + SET TURNS ON (SET) OR OFF THE HAPPENED BIT IN THE 61026045 + RESET EVENT REFERENCED BY EACH PARAMETER 61026050 + 61026055 + 61026060 + FIX TURNS ON (FIX) OR OFF THE AVAILABLE BIT IN THE 61026065 + FREE EVENT REFERENCED BY EACH PARAMETER 61026070 + 61026075 + 61026080 + ENABLE TURNS ON MCP SOFTWARE INTERRUPT LOCK (IN KNOWN 61026085 + DISABLE LOCATION IN MCP STACK) THUS PREVENTING MCP 61026090 + ACCESS TO EVENT INTERRUPT QUEUE. TURNS ON 61026095 + (ENABLE) OR OFF THE ENABLE BIT IN THE INTERRUPT 61026100 + REFERENCED BY EACH PARAMETER. TURNS OFF MCP 61026105 + SOFTWARE INTERRUPT LOCK 61026110 + NOTE THE PARAMETER(S) TO ENABLE AND DISABLE ARE 61026115 + INTERRUPTS RATHER THAN EVENTS, HOWEVER IT IS 61026120 + CONVENIENT TO HANDLE THEM HERE 61026125 + 61026130 + 61026135 + HAPPENED CAN HAVE ONLY ONE PARAMETER. RETURNS VALUE OF 61026140 + AVAILABLE HAPPENED OR AVAILABLE BIT FOR THE EVENT REFER- 61026145 + ENCED BY THE PARAMETER.EQUIVALENT TO BOOLEAN 61026150 + PROCEDURE 61026155 + 61026157 + 61026159 + SECONDWORD LEAVES SECOND WORD OF EVENT OR DOUBLE ON TOS 61026161 + PRESUMES EVENT HAS BEEN LOCKED PREVIOUSLY 61026163 + 61026170 + 61026172 + STOREITEM NOT REALLY AN EVENT INTRINSIC BUT CONVENIENT TO 61026174 + HANDLE IT HERE.CALLS ACTUALPARAPART WHICH TREATS61026176 + FIRST PARAMETER(WHICH MUST BE AN ITEM REFERENCE 61026178 + ) AS FORMAL AND SECOND AS ACTUAL PARAMETER 61026180 + 61026197 + 61026198 + 61026199 + ; 61026200 +BEGIN 61026300 + INTEGER KEY % TELLS WHICH INTRINSIC 61026400 + ; 61026500 + LABEL RESIGN 61026600 + , FINI 61026630 + , CHECK 61026640 + ; 61026650 + BOOLEAN TB1 61026700 + ; 61026800 + 61027000 + REAL GT1 61027100 + , GT2 61027150 + ; 61027200 + DEFINE SOFTWAREINTERRUPTLOCK = 17# %FIXED MCP LOCATION 61027300 + , ISOLATEHAPPEN = 1,1# %ISOLATE FOR HAPPEN BIT61027310 + , EMITI(EMITI1) =EMIT2P(ISOL,EMITI1)#%FAKE OUT BILL 61027315 + , ENABLEP = 46# % ENABLE BIT POSITION 61027320 + , AVAILABLEP = 2# %AVAILABLE BIT POSITION61027330 + , HAPPENEDP = 1# %HAPPENED BIT POSITION 61027340 + , LOCKBITP = 0 # 61027345 + , ISOLATEAVAILABLE= 2,1# %ISOLATE AVAILABLE BIT 61027360 + , EVENTHANDLER = 15# %FIXED MCP LOCATION 61027380 + , INDXNLOADCHK=BEGIN IF GET(L-1)=LOAD THEN 61027382 + L~L-1 ELSE INDXCHK END# 61027384 + ; 61027400 + TB1 ~ ELBAT[I] < 0; ELBAT[I] ~ ABS(ELBAT[I]); 61027410 + KEY~TAKE(ELBAT[I]).KIND; 61027500 + IF STEPI!LFTPARN THEN GO RESIGN ; 61027600 + CASE KEY DIV 10 OF 61027700 + BEGIN COMMENT MCS 1; 61027800 + 61027820 + 61027840 + BEGIN COMMENT CAUSE AND WAIT; 61027900 + EMIT (MKST); 61028000 + EMITN(EVENTHANDLER); 61028100 + IF STEPI=ANEVENT 61028200 + THEN BEGIN EMITN((GT1:=ELBAT[I]).ADDRESS); 61028300 + IF GT1.TYPE = FORMALNAMEP THEN 61028310 + EMIT(EVAL) ELSE EMIT(STFF); STEPIT; 61028320 + END 61028330 + ELSE IF VARIABLE(FP) =EVTYPE THEN INDXNLOADCHK 61028400 + ELSE FLAG(670); 61028450 + EMITBUZEVENT; 61028452 +COMMENT IN TOS AT THIS POINT-POINTER TO EVENT (IRW OR INDEXED DD),61028454 + FIRST WORD OF EVENT (WITH DOUBLE TAG); 61028456 + EMITNUM(KEY); 61028500 + EMIT(ENTR); 61028550 + END ; % CAUSE,WAIT 61028600 + 61028700 + 61028750 + DO 61028800 + BEGIN COMMENT SET AND RESET 61028900 + FIX AND FREE ;61029000 + IF STEPI=ANEVENT 61029100 + THEN BEGIN EMITN((GT1:=ELBAT[I]).ADDRESS); 61029200 + IF GT1.TYPE = FORMALNAMEP THEN 61029210 + EMIT(EVAL); STEPIT; 61029220 + END 61029230 + ELSE IF ELCLASS=EVENTID OR ELCLASS=EVENTARRAYID THEN 61029400 + IF VARIABLE(FP)=EVTYPE THEN INDXNLOADCHK 61029500 + ELSE FLAG(670) 61029505 + ELSE IF KEY=SETKEY OR KEY=RESETKEY THEN 61029510 + BEGIN 61029520 + EXPRESSION(ATYPE); 61029525 + IF ELCLASS!COMMA THEN FLAG(670); 61029530 + STEPIT; 61029532 + IF ELCLASS = NUMBER AND NOT DPTOG THEN 61029534 + IF TABLE(I+1)=RTPARN 61029535 + THEN 61029536 + BEGIN 61029538 + EMIT1P(IF KEY=SETKEY THEN BSET 61029540 + ELSE BRST, THI DIV 1); 61029542 + STEPIT; 61029544 + IF NOT TB1 THEN EMIT(DLET); 61029546 + GO CHECK; 61029548 + END; 61029550 + GT1 ~ AEXP; 61029552 + EMIT(IF KEY=SETKEY THEN DBST ELSE DBRS); 61029554 + IF TB1 THEN ELSE EMIT(DLET); 61029555 + GO TO CHECK; 61029560 + END 61029570 + ELSE FLAG(670); 61029600 +COMMENT AT THIS POINT WE HAVE TO EMIT CODE FOR BUZZING EVENT; 61029610 + EMITBUZEVENT; 61029620 +COMMENT IN TOS AT THIS POINT-POINTER TO EVENT(IRW OR INDEXED DD), 61029640 + FIRST WORD OF EVENT(WITH DOUBLE TAG); 61029660 + L ~ L - 3; % COVER THE ZERO STAG 61029700 + FIGS ~ TRUE; 61029710 + EMIT1P(BRSET,LOCKBITP); 61029800 + FIGS ~ FALSE; 61029810 + IF KEY=FIXKEY AND FIXCALL THEN 61029820 +BEGIN EMIT(DUPL); EMIT2P(ISOL,AVAILABLEP,1);EMIT(RSDN); END; 61029840 + EMIT1P(IF KEY = SETKEY OR KEY=FIXKEY THEN BSET ELSE BRSET,61029850 + IF KEY =FIXKEY OR KEY =FREEKEY THEN AVAILABLEP ELSE 61029900 + HAPPENEDP); 61029950 + EMIT(OVRD); 61030000 + END UNTIL ELCLASS!COMMA; % FINISH SET,RESET 61030300 + % FIX,FREE 61030400 + 61030430 + 61030460 + BEGIN COMMENT ENABLE AND DISABLE; 61030500 + EMIT(ONE); 61030600 + EMITN(SOFTWAREINTERRUPTLOCK); 61030700 + EMIT(STOD); 61030800 +COMMENT *** MAYBE WE NEED A READ WITH LOCK. I HOPE THIS LOCKP OUT 61030900 + ALL INTERRUPT BASHERS EXCEPT THOSE WHO ONLY WANT TO TURN 61031000 + THE LOCK; 61031100 + DO 61031200 + BEGIN COMMENT MCS 2; 61031300 + IF STEPI!INTERRUPTID THEN FLAG(671); 61031400 + EMITN(GT1~ELBAT[I].ADDRESS); 61031500 + EMIT(LODT); 61031600 + EMIT1P(IF KEY =ENABLEKEY THEN BSET ELSE BRSET 61031700 + ,ENABLEP); 61031800 + EMITN(GT1); 61031900 + EMIT(OVRD); 61032000 + STEPIT 61032100 + END UNTIL ELCLASS!COMMA; 61032200 + EMIT(ZERO); 61032300 + EMITN(SOFTWAREINTERRUPTLOCK); 61032400 + EMIT(STOD); 61032500 + END; % ENABLE, 61032600 + % DISABLE 61032700 + 61032800 + 61032900 + BEGIN COMMENT HAPPENED,AVAILABLE; 61033000 + STEPIT; 61033100 + IF VARIABLE(FP)!EVTYPE THEN FLAG(670); 61033200 + IF KEY =HAPPENEDKEY THEN EMITI(ISOLATEHAPPEN) 61033300 + ELSE EMITI(ISOLATEAVAILABLE); 61033350 + 61033380 + END; % HAPPENED,AVAILABLE; 61033400 + 61033430 + 61033460 + 61033462 + 61033464 + BEGIN COMMENT SECONDWORD; 61033466 + STEPIT; 61033467 + IF GT1~VARIABLE(FP)!EVTYPE AND GT1!ETYPE THEN FLAG(680); 61033468 + EMIT(SPLT ); 61033470 + EMIT(EXCH);EMIT(DLET); 61033480 +COMMENT THE SECOND WORD WITH SP TAG IS NOW IN TOS; 61033482 + END; % SECONDHALF 61033490 + 61033492 + 61033494 + 61033500 + BEGIN COMMENT STOREITEM; 61033503 + STEPIT; 61033506 + GT1~ TAKE(ELBAT[I]); 61033507 + ITEMREFERENCE(FP); INDXNLOADCHK; 61033511 + ACTUALPARAPART ( 61033513 + FALSE , 61033516 + 61033519 + - ((GT2 ~ TAKE ( 61033522 + IF(GT3~GT1.CLASS)>EVENTARRAYID 61033525 + OR GT30 OR NEWDP>0 OR NEWCT>0 OR COMMAFLAG THEN 61179000 + BEGIN OP ~ OP + 8; UPDATETOG ~ TRUE; END; 61180000 + EMIT(OP); 61181000 + IF NOT UPDATETOG THEN GO TO EXIT; 61182000 + IF NEWCT ! -1 THEN 61183000 + IF NEWCT = 0 THEN EMIT(DLET) ELSE 61184000 + EMITPAIR(NEWCT.ADDRESS, STOD); 61185000 + DOSP: 61186000 + IF NEWSP}0 THEN 61186500 + IF NEWSP = 0 THEN EMIT(DLET) ELSE 61187000 + EMITPAIR(NEWSP.ADDRESS, OVRD); 61188000 + IF COMMAFLAG THEN 61189000 + CONTINUE: 61190000 + BEGIN 61191000 + NEWCT ~ NEWSP ~ 0; 61192000 + COMMAFLAG ~ UPDATETOG ~ FALSE; 61193000 + GO TO SOURCEPART; 61194000 + END; 61195000 + DODP: 61196000 + IF NEWDP = 0 THEN EMIT(DLET) ELSE 61197000 + EMITPAIR(NEWDP.ADDRESS, OVRD); 61198000 + GO TO EXIT; 61199000 +PTRFORCOUNT: 61200000 + STEPIT; TYPE ~ AEXP; 61201000 + IF ELCLASS=WORDV OR OVERITOG~ELCLASS=OVERITE THEN 61202000 + BEGIN 61203000 + STEPIT; 61204000 + OP ~ TWSD + REAL(OVERITOG); NEWCT ~ -1; 61205000 + GO TO EMITOP; 61206000 + END; 61207000 +DOIT: 61207100 + IF ELCLASS = WHILEV OR ELCLASS = UNTILV THEN GO TO CONDITION; 61208000 + IF ELCLASS = WITHV THEN 61209000 + BEGIN 61210000 + MAKEARRAYROW; 61211000 + IF NEWSP < 0 THEN NEWSP ~ 0; IF NEWDP < 0 THEN NEWDP ~ 0;61212000 + OP ~ TRNS - 8|REAL(NEWSP~NEWDP!0 OR ELCLASS=COMMA); 61224000 + UPDATETOG ~ TRUE; NEWCT ~ -1; 61225000 + GO EMITOP; 61226000 + END; 61227000 + OP ~ TUND; 61228000 + GO TO EMITOP; 61229000 +STRINGSORCE: 61230000 + STRINGSOURCE; 61231000 + TYPE ~ COUNT; STEPIT; 61232000 + IF ELCLASS ! FORV THEN 61233000 + BEGIN 61234000 + EMITNUM(TYPE); 61235000 + OP ~ TUND; 61236000 + GO TO EMITOP; 61237000 + END; 61238000 + STEPIT; TYPE ~ AEXP; 61239000 + GO TO UNITS; 61240000 +AEXPSOURCE: 61241000 + IF TYPE!ATYPE AND TYPE!ITYPE AND TYPE!ETYPE AND TYPE!WTYPE THEN61242000 + FLAG(638); 61243000 + IF ELCLASS ! FORV THEN 61244000 + BEGIN 61245000 + EMIT(ONE); OP ~ TWSD; NEWCT ~ -1; 61246000 + GO TO EMITOP; 61247000 + END; 61248000 + STEPIT; TYPE ~ AEXP; 61249000 + IF Q = "6DIGI" THEN 61250000 + BEGIN 61251000 + STEPIT; 61252000 + EMIT(DUPL); EMIT(RSDN); 61253000 + IF ERROR573 THEN 61254000 + BEGIN %AEXP SOURCE W/ UPDATE ARITH VARIABLE 61254100 + ERROR573~FALSE; 61254200 + EMIT(DSRS); %SAVES THE QUOTENT IN THE UPDATE VARIABLE 61254300 + 61254350 + EMIT3(NEWSP.ADDRESS); 61254400 + EMIT(STOD); 61254500 + END ELSE 61254600 + BEGIN 61254610 + EMIT(DSRF); 61254700 + END; 61254720 + EMIT(EXCH); 61254800 + OP ~ UABD; %SOMEBODY OUGHTA ALLOW FOR SIGN SOMETIME. 61255000 + NEWCT ~ - 1; 61256000 + NEWSP ~ 0; 61256100 + GO TO EMITOP; 61257000 + END; 61258000 +UNITS: 61259000 + IF ELCLASS = WORDV THEN 61260000 + BEGIN 61261000 + STEPIT; 61262000 + OP ~ TWSD; NEWCT ~ -1; 61263000 + GO TO EMITOP; 61264000 + END; 61265000 + IF ELCLASS = OVERITE THEN 61266000 + BEGIN 61267000 + STEPIT; 61268000 + OP ~ TWOD; NEWCT ~ -1; 61269000 + GO TO EMITOP; 61270000 + END; 61271000 + IF ELCLASS { IDMAX THEN 61271100 + IF Q = "9CORR" THEN 61271150 + BEGIN 61271200 + INSERT(5,"ECTLY",ACCUM[9],0); 61271250 + IF CMPCHREQL(5,ACCUM[2],ACCUM[9]) THEN 61271300 + BEGIN 61271350 + EMITPAIR(OP ~ GETSTACK, OVRN); 61271400 + EMIT(EXSU); EMIT(SRSC); EMITV(OP); 61271450 + RTNSTACK(OP); STEPIT; 61271500 + END; END; 61271550 + GO DOIT; 61271900 +EXIT: 61274000 +END REPLACESTMT; 61275000 +PROCEDURE FILLDATA(N); VALUE N; INTEGER N; 62020200 +BEGIN 62021000 + DEFINE BUMPTAX=IF TAX~TAX+1}POOLMAX THEN ERROR(0656)#; 62021100 + LABEL EXIT, CHECK, LOOP, STUFF; 62022000 + INTEGER Z,FIRSTX,LASTX, J; 62023000 + FIRSTX ~ TAX; 62024000 + LOOP: 62025000 + IF STEPI ! STRNGCON THEN GO TO STUFF; 62026000 + IF ELCLASS = STRING THEN 62027000 + BEGIN 62028000 + DO BEGIN 62029000 + TA[TAX] ~ THI; BUMPTAX; 62029100 + TA[TAX] ~ REAL(THIFLAG); BUMPTAX; 62029200 + END 62029300 + UNTIL NOT GOBBLE(TRUE); 62030000 + GO TO STUFF; 62031000 + END; 62032000 + IF ELCLASS = ADDOP THEN 62033000 + BEGIN 62033100 + IF STEPI ! NUMBER THEN ERROR(657); 62033200 + IF ELBAT[I-1].DISP = SUBT THEN THI ~ -THI; 62033300 + GO TO STUFF; 62033400 + END; 62033500 + IF ELCLASS ! NUMBER THEN ERROR(657); 62033600 + IF RESULT ! LFTPRN THEN GO STUFF; 62034000 + 62035000 + Z ~ THI; STEPIT; 62036000 + FILLDATA(Z-1); 62037000 + IF ELCLASS ! RTPARN THEN ERROR(0658); 62038000 + GO TO CHECK; 62039000 + STUFF: 62040000 + TA[TAX] ~ THI; BUMPTAX; 62041000 + TA[TAX]~ REAL(THIFLAG); BUMPTAX; 62041100 + IF DPTOG THEN 62042000 + BEGIN TA[TAX] ~ TLO; BUMPTAX;TA[TAX]~REAL(TLOFLAG);BUMPTAX END;62043000 + CHECK: 62044000 + IF STEPI = COMMA THEN GO TO LOOP; 62045000 + LASTX ~ TAX-1; 62046000 + FOR Z~1 STEP 1 UNTIL N DO 62047000 + FOR J ~ FIRSTX STEP 1 UNTIL LASTX DO 62048000 + BEGIN TA[TAX] ~ TA[J]; BUMPTAX END; 62049000 + EXIT: 62050000 +END FILLDATA; 62051000 +PROCEDURE FILLSTMT; 62052000 +BEGIN 62053000 + LABEL EXIT; 62065000 + INTEGER N; 62065500 + STEPIT; 62066000 + IF BOOARRAYID { ELCLASS AND ELCLASS { INTARRAYID THEN 62067000 + ARRAYROW ELSE ERROR(0659); 62068000 + IF ELCLASS ! WITHV THEN ERROR(0660); 62069000 + TAX ~ 0; 62071000 + FILLDATA(0); N ~ TAX; 62072000 + FILLPOOL; 62073000 + EMITNUM(N); EMIT(TWSD); 62074000 + EXIT: 62075000 +END FILLSTMT; 62076000 +PROCEDURE SWAPSTMT; 62100000 +BEGIN 62101000 + LABEL L, EXIT; 62102000 + REAL NA, NB, A, B, T; 62103000 + IF STEPI ! LFTPRN THEN ERROR(0661); 62104000 + IF STEPI < BOOARRAYID OR ELCLASS > INTARRAYID THEN ERROR(0662);62105000 + A ~ ELBAT[I]; NA ~ BOUND(A); A ~ A.ADDRESS; 62106000 + IF STEPI = LFTBRKT THEN 62107000 + BEGIN 62108000 + IF T ~ SUBSCRIBER(A, NA) = 0 THEN FLAG(0662); 62109000 + IF T ! NA THEN 62110000 + BEGIN 62111000 + EMIT(INDX); EMIT(DUPL); EMIT(LOAD); 62112000 + A ~ 0; NA ~ T; 62113000 + END; 62114000 + END; 62115000 + IF ELCLASS ! COMMA THEN ERROR(0663); 62116000 + IF STEPI < BOOARRAYID OR ELCLASS > INTARRAYID THEN ERROR(0662);62117000 + B ~ ELBAT[I]; NB ~ BOUND(B); B ~ B.ADDRESS; 62118000 + IF STEPI = LFTBRKT THEN 62119000 + BEGIN 62120000 + IF T ~ SUBSCRIBER(B, NB) = 0 THEN FLAG(0662); 62121000 + IF T ! NB THEN 62122000 + BEGIN 62123000 + EMIT(INDX); EMIT(DUPL); EMIT(LOAD); 62124000 + B ~ 0; NB ~ T; 62125000 + END; 62126000 + END; 62127000 + IF ELCLASS = RTPARN THEN STEPIT ELSE ERROR(0664); 62128000 + IF A = 0 THEN 62129000 + IF B = 0 THEN 62130000 + BEGIN 62131000 + EMIT(RSDN); EMIT(OVRD); 62132000 + EMIT(EXCH); EMIT(OVRD); 62133000 + END ELSE 62134000 + BEGIN 62135000 + L: EMITN(B); EMIT(LOAD); 62136000 + EMIT(RSDN); EMITN(B); 62137000 + EMIT(OVRD); EMIT(OVRD); 62138000 + END ELSE 62139000 + IF B = 0 THEN 62140000 + BEGIN B ~ A; GO TO L END ELSE 62141000 + BEGIN 62142000 + EMITN(A); EMIT(LOAD); 62143000 + EMITN(B); EMIT(LOAD); 62144000 + EMITN(A); EMIT(OVRD); 62145000 + EMITN(B); EMIT(OVRD); 62146000 + END; 62147000 + IF NA ! NB THEN FLAG(0665); 62148000 + EXIT: 62149000 +END SWAPSTMT; 62150000 + INTEGER PROCEDURE PICTUREGEN(FROM,UP,X); VALUE FROM,UP,X; 65001000 + BOOLEAN FROM,UP; INTEGER X; 65002000 + COMMENT PICTUREGEN GENERATES (SURPRIZE) A PICTURE EDIT-MICRO 65003000 + STRING...OR AN ENTER-EDIT ON A MICRO-STRING IN A TABLE 65004000 + SOMEWHERE. "X" POINTS INTO ADDL, AT THE STUFF FOR THE 65005000 + PICTURE (SEE PICIUREDEC). "UP" IS TRUE IF THE UPDATED 65006000 + POINTERS ARE REQUIRED. "FROM" IS TRUE IF WE ARE CALLED BY65007000 + REPLACESTMT: IF SO, WE HAVE EXPRESSIONS TO COMPILE FOR ANY65008000 + DYNAMIC REPEATS IN THE PICTURE. IF "FROM" IS FALSE, WE 65009000 + ARE CALLED FROM ACTUALPARAPART (Q.V.), AND WE MUST DREAM 65010000 + UP VALUE-CALLS FOR THOSE DYNAMIC THINGS; 65011000 + BEGIN 65012000 + BOOLEAN DOING; COMMENT TRUE IFF WE ARE COMPILING EXPRESSIONS- 65013000 + TURNS OFF WHEN WE RUN OUT; 65014000 + REAL A, OP, N; 65015000 + IF FROM THEN 65016000 + IF DOING ~ STEPI = LFTPRN THEN ELCLASS ~ COMMA; 65017000 + DO BEGIN 65018000 + A ~ GIT(X); X ~ X + 1; 65019000 + IF A.[44:4] = 0 THEN % TABLE-ENTER 65020000 + BEGIN EMITNUM(A.[19:24]); EMITPAIR(A.[1:18],INDX); 65021000 + OP ~ TEED; 65022000 + END TABLE MODE ELSE 65023000 + BEGIN 65024000 + IF A.[1:16] = 65535 THEN % DYNAMIC 65025000 + BEGIN 65026000 + IF FROM THEN 65027000 + IF DOING THEN 65028000 + IF ELCLASS ! COMMA THEN FLAG(924) ELSE 65029000 + BEGIN STEPIT; EXPRESSION(ITYPE) END ELSE 65030000 + FLAG(925) ELSE 65031000 + COMMENT HERE WE DREAM UP A VALC; 65032000 + EMITV(5&(CURRENT+1)[30:42:6] + N); 65033000 + N ~ N + 1; 65034000 + 65035000 + END ELSE 65036000 + EMITNUM(A.[1:16]); % STUPID MACHINE 65037000 + A.[1:16] ~ 0; 65038000 + OP ~ EXSD; 65039000 + END; 65040000 + IF DOING THEN COMMENT CHECK FOR END OF EXPR LIST; 65041000 + IF ELCLASS = RTPARN OR BOOLEAN(A.[43:1]) THEN 65042000 + BEGIN 65043000 + WHILE ELCLASS = COMMA DO 65044000 + BEGIN STEPIT; EXPRESSION(ITYPE); EMIT(DLET) END; 65045000 + IF ELCLASS ! RTPARN THEN FLAG(926) ELSE STEPIT; 65046000 + DOING ~ FALSE; 65047000 + END; 65048000 + IF FROM THEN 65048900 + IF NOT DOING THEN 65049000 + IF ELCLASS = COMMA THEN UP ~ TRUE; 65050000 + EMIT(OP & REAL(UP OR NOT BOOLEAN(A.[43:1]))[44:47:1]); 65051000 + IF OP = EXSD THEN EMITMICRO(A); 65052000 + END UNTIL BOOLEAN(A.[43:1]); 65053000 + PICTUREGEN ~ IF FROM THEN REAL(UP) ELSE N; 65054000 + END PICTUREGEN; 65055000 + PROCEDURE BLOCK; 66000000 + COMMENT BLOCK COMPILES ONE OF THOSE. MOST OF HIS WORK IS KEEPING TRACK66001000 + OF THINGS FOR SEGMENTATION AND NOMENCLATURE NESTING; 66002000 + COMMENT FIRST WHACK, 2/68, MCP *************************************; 66003000 + BEGIN 66004000 + ARRAY TEDOC[0:31,0:255]; 66005000 + INTEGER LO, SEGNOO, NINFOOO, NADDLO, BLKAD,LINFOO, LASTXO, 66006000 + FIRSTXO, FIRSTMTO, POINT; 66007000 + REAL CQAO; 66007100 + BOOLEAN SVINFOO; 66007200 + DEFINE LEVELMASK = STACKMASK #; 66008000 + NADDLO ~ NEXTADDL; 66009000 + NINFOOO ~ NINFOO; 66010000 + NINFOO ~ NEXTINFO; 66011000 + LINFOO ~ LASTINFO; 66012000 + FIRSTMTO ~ FIRSTMT; 66013000 + FIRSTXO ~ FIRSTX; 66014000 + LASTXO ~ LASTX; 66015000 + SEGNOO ~ SEGNO; 66016000 + IF SVINFOTOG THEN ELSE 66016100 +BEGIN 66016200 + SVINFOO~SVINFO; 66016300 + SVINFO~FALSE; 66016400 + END; 66016500 + BEGIN 66017000 + EMIT(MKST); 66018000 + EMITN(BLKAD ~ GETSPACE(-CURRENT)); 66019000 + EMIT(ENTR); 66020000 + POINT ~ BUMPL; 66021000 + IF NOT SAVED THEN 66022000 + IF REAL(SEPARATOG)!4 THEN 66022500 + BEGIN 66023000 + LO ~ L; 66024000 + MOVECODE(TEDOC,EDOC); 66025000 + L ~ 0; 66026000 + SEGNO ~ NEWSEG(0); 66027000 + END; END; 66028000 + FIRSTX ~ LASTX ~ FIRSTMT ~ -1; 66029000 + LASTINDEX ~ LASTNOT ~ 0; 66030000 + IF CURRENT < 31 THEN CURRENT ~ CURRENT + 1 ELSE FLAG(627); 66031000 + MAXDISP ~ LEVELMASK[CURRENT].[FF]; 66032000 + STACKTOP[CURRENT] ~ MAXSTACK[CURRENT] ~ 2; 66033000 + DECLARATIONS; 66034000 + FIRSTATEMENT; 66035000 + 66036000 + 66037000 + COMPOUNDTAIL; 66038000 + IF SVINFO THEN 66038100 + BEGIN 66038105 + WRITEFILE(INFF,INFO,NINFOO,NEXTINFO-1); 66038110 + WRITEFILE(INFF,ADDL,NADDLO,NEXTADDL-1); 66038115 + INFD[(INFDX~INFDX+2).LINKR,INFDX.LINKC] ~ 66038120 + (GTI1~(NEXTINFO-NINFOO+29)DIV 30+INFFX)& 66038125 + INFFX[18:33:15]; 66038130 + INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC] ~ 66038135 + (NEXTINFO-1)&NINFOO[18:33:15]& 66038140 + (NINFOO-STARTINFO)[3:33:15]; 66038145 + INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC] ~ 66038150 + (NEXTADDL-1)&NADDLO[18:33:15]& 66038155 + (NADDLO-STARTADDL)[3:33:15]; 66038160 + INFFX~(NEXTADDL-NADDLO+29) DIV 30 + GTI1; 66038165 + END; 66038170 + NEXTINFO ~ NINFOO; 66040000 + NINFOO ~ NINFOOO; 66041000 + NEXTADDL ~ NADDLO; 66042000 + LASTINFO ~ LINFOO; 66043000 + IF REAL(ARRAYDECTOG AND BOOLEAN(2*CURRENT)) !0 THEN 66043100 + BEGIN 66043200 + EMIT(MKST); 66043300 + EMITN(BLOCKEXITPCW); 66043400 + EMIT(ENTR); 66043500 + ARRAYDECTOG~ARRAYDECTOG AND NOT BOOLEAN(2*CURRENT); 66043540 + END; 66043600 + EMIT(EXIT); 66044000 + PURGE(NEXTINFO); 66044300 + LINFOO~L; % LAST SYLLABLE OF THE LEVEL 66044500 + IF NOT SAVED THEN 66045000 + IF REAL(SEPARATOG)!4 THEN 66045500 + BEGIN 66046000 + WHILE L MOD 6 ! 0 DO EMIT(NVLD); 66047000 + SEGMENT(0, L DIV 6, EDOC); 66048000 + L ~ LO; MOVECODE(TEDOC,EDOC); 66049000 + END; 66050000 + LO ~ IF FIRSTX < 0 THEN FIRSTMT ELSE FIRSTX; 66050100 + DOUBLE(SEGNO,SEGNOO,~,SEGNOO,SEGNO); 66050200 + FIRSTX ~ FIRSTXO; LASTX ~ LASTXO; FIRSTMT ~ FIRSTMTO; 66050300 + IF CURRENT = 1 THEN 66051000 + GLOBALPCW(BLKAD,SEGNO,LO,STATE) ELSE 66052000 + BEGIN 66053000 + IF NOT NOJUMPTOG THEN JUMPCHKX; 66054000 + PCL~L; 66054500 + EMITPCW(CURRENT,LO,STATE,SEGNOO); 66055000 + ENTERSEPA(((L-6) DIV 6),LINFOO,POINT); 66055500 + LO ~ STACKTOP[CURRENT - 1]; 66056000 + BLKAD ~ BLKAD.[36:12]; 66057000 + WHILE BLKAD ~ BLKAD + 1 < LO DO EMIT(ZERO); 66058000 + COMMENT TO RESERVE CELLS FOR THINGS WITH ADDR PARTS; 66059000 + IF NOT NOJUMPTOG THEN JUMPCHKNX; 66059100 + END; 66059200 + EMITB(BRUN, POINT, L); 66060000 + IF SVINFO THEN 66060100 + INFO[(GTI1~INFDX-3).LINKR,GTI1.LINKC]~PCW; 66060200 + IF SVINFOTOG THEN ELSE SVINFO~SVINFO OR SVINFOO; 66060800 + MAXDISP ~ LEVELMASK[CURRENT ~ CURRENT-1].[FF]; 66061000 + CQAO ~ COUNTQALG; COUNTQALG ~ STARTNSQ; 66061100 + 66062000 + END THE BLOCK ROUTINE; 66063000 + PROCEDURE PURGE(T); VALUE T; INTEGER T; 66064000 + BEGIN 66065000 + INTEGER I, J, K, ERR; 66066000 + REAL E; 66067000 + LABEL GRIPE; 66068000 + DEFINE CNT = CHRCNT#; 66069000 + IF T < 0 THEN T ~ - T ELSE 66069050 + FOR GT1 ~ 0 STEP 1 UNTIL MAXTEMP DO 66069100 + IF TEMPSTACK[GT1] .[31:5] = CURRENT THEN 66069200 + TEMPSTACK[GT1] ~ 0; 66069300 + FOR I ~ 0 STEP 1 UNTIL 124 DO 66070000 + WHILE J~STACKHEAD[I]}T DO 66071000 + BEGIN 66072000 + STACKHEAD[I] ~ TAKE(J).CONL; 66073000 + IF(E ~ TAKE(J-1)).CLASS = LABELID THEN 66074000 + BEGIN 66075000 + IF E.TYPE = F0RWARD THEN 66076000 + IF E.LINK ! 0 THEN 66077000 + BEGIN ERR ~ 405; GO GRIPE END 66078000 + ELSE ELSE 66078100 + IF E.DISP!0 THEN 66078200 + BEGIN 66078300 + JUMPCHKX; 66078400 + EMITPCW(E.LVEL,E.[32:16],STATE,SEGNO); 66078500 + EMITPAIR(E.ADDRESS,OVRD); 66078600 + JUMPCHKNX; 66078650 + END; 66078700 + END ELSE 66079000 + IF E.CLASS = PROCID OR E.CLASS } BOOPROCID AND 66080000 + E.CLASS { PTRPROCID THEN 66081000 + IF E.TYPE = F0RWARD THEN 66082000 + BEGIN ERR ~ 406; 66083000 + GRIPE: ERRORTOG ~ TRUE; 66084000 + FLAG(ERR); 66085000 + BLANKOUT(16,LBUFF[0]); 66086000 + INSERT(5,"ERROR",LBUFF[2],0); 66087000 + MOVECHARACTERS(TAKE(J).CNT,INFO[J.LINKR,J.LINKC],4, 66088000 + LBUFF[3],3); 66089000 + INSERT(4,"WAS:",LBUFF[2],6); 66090000 + WRITELBUFF 66093000 + END ELSE ELSE 66094000 +% ARRAY ACTION 66095000 + END END PURGE; 66096000 + PROCEDURE THRUSTMT; 66200000 + BEGIN 66201000 + REAL SAVEL, GT1, SAVESTBR; 66202000 + BOOLEAN TB1,TB2; 66202100 + LABEL EXIT; 66203000 + SAVEL ~ L; 66204100 + IF TB1~STEPI = NUMBER THEN 66205000 + BEGIN 66205100 + DOUBLE(THI,TLO,~,GT1,SAVESTBR); TB2 ~ DPTOG; 66205200 + TB1 ~ TB1 AND TABLE(I+1)=DOV; 66205300 + DOUBLE(GT1,SAVESTBR,~,THI,TLO); DPTOG ~ TB2; 66205400 + END; 66205500 + IF TB1 AND THI.[1:31] = 0 THEN 66208000 + BEGIN 66209000 + EMITNUM(0&1[1:37:11]&THI[12:32:16]); 66210000 + STEPIT; 66211000 + IF ELCLASS ! DOV THEN FLAG(666); 66212000 + EMITNUM(4); 66215000 + EMIT(STAG); 66216000 + EMITPAIR(GT1 ~ GETSTACK, OVRN); 66217100 + SAVEL ~ L; 66219000 + EMITN(GT1); 66220000 + SAVESTBR ~ L; 66221000 + EMITLINK(0&STBR[24:40:8]); 66222000 + EMIT(DLET); 66223000 + STEPIT; 66224000 + STATEMENT; 66225000 + EMITB(BRUN,BUMPL,SAVEL); 66226000 + EMITB(GET(SAVESTBR),SAVESTBR+3,L); 66227000 + GO TO EXIT; 66229000 + END; 66230000 + GT1 ~ AEXP; 66230100 + IF ELCLASS ! DOV THEN FLAG(666); 66230200 + GT1 ~ GETSTACK; 66231000 + SAVEL ~ BUMPL; 66232000 + STEPIT; 66233000 + STATEMENT; 66234000 + EMITV(GT1); 66235000 + EMIT(ONE); 66236000 + EMIT(SUBT); 66237000 + EMITB(BRUN,SAVEL,L); 66238000 + EMITN(GT1); 66239000 + EMIT(OVRN); 66240000 + EMIT(ZERO); 66241000 + EMIT(LSEQ); 66242000 + EMITB(BRFL,BUMPL,SAVEL); 66243000 + EXIT: 66297000 + RTNSTACK(GT1); 66298000 + END THRUSTMT; 66299000 +COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 70000000 + DECLARATIONS 70001000 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *; 70002000 + PROCEDURE IDLIST(SPAZE,TIPE,KLASS,B,C); VALUE SPAZE,TIPE,KLASS,B,C; 70003000 + BOOLEAN C; INTEGER TIPE,KLASS,B; REAL SPAZE; 70004000 + COMMENT IDLIST HANDLES THE ENTRY INTO INFO OF A LIST OF IDENTIFIERS, 70005000 + SEPARATED BY COMMAS. "I" MUST BE POINTING TO THE FIRST ONE, 70006000 + AND MUST NOT HAVE EVER PASSED IT (I.E., YOU MAY NOT "I~I-1", 70007000 + THEN CALL IDLIST). SPAZE GETS PASSED ON TO GETSPACE, Q.V. 70008000 + TIPE IS THE TYPE-FIELD VALUE FOR THE ELBAT WORD, AND KLASS, 70009000 + THEN CLASS FIELD. IF B IS } ZERO, WE WILL PROVIDE AN INITIAL 70010000 + VALUE OF TYPE B(UNLESS ENTER RETURNS TRUE, INDICATING THAT THE 70011000 + PROGRAMMER GAVE AN ADDRESS PART). C IS TRUE IF SPACE IS TO BE 70012000 + ALLOCATED; 70013000 + BEGIN 70014000 + INTEGER CONTEX, T; 70015000 + LABEL INN, OWT; 70015100 + BOOLEAN FAKEY; 70016000 + 70017000 + IF B=DPV OR B=EVNTV THEN SPAZE.[2:1]~ 1; 70017100 + IF CURRENT ! 0 THEN T ~ 1 ELSE 70017200 + IF KLASS=DPID OR KLASS=EVENTID THEN T~2 ELSE 70017300 + IF KLASS = REFID THEN T ~ 0 ELSE 70017400 + IF KLASS = PTRID THEN T ~ 3 ELSE T ~ 1; 70017500 + I ~ I - 1; CONTEX ~ CONTEXT; % FUTZ UP THE SCANNER 70018000 + DO BEGIN 70019000 + CONTEXT ~ 0; % ITS DECLARATION TIME, GANG. 70020000 + IF STEPI ! UNKNOWNID THEN % BUT THIS HAS ALREADY BEEN 70021000 + FLAG(700); % DECLARED. 70022000 + IF NOT ENTER(SPAZE,TIPE,KLASS,C) THEN % 70023000 + IF B > 0 THEN % B IS INITIAL-VALUE TYPE 70024000 + IF TABLE(I+1) = ASSNOP THEN % DID HE GIVE ONE 70025000 + BEGIN % WELL, COMPILE IT 70026000 + IF B=EVNTV THEN FLAG(783); 70026500 + CONTEXT ~ 2; % UNFUTZ THE SCANNER 70027000 + ELCLASS ~ TABLE(I~I+2); % MEANS STEPIT TWICE. 70028000 + JUMPCHKX; 70028100 + EXPRESSION(B); % AND DD THE THING. 70029000 + I ~ I - 1; 70029010 + IF CURRENT = 0 THEN 70029100 + BEGIN 70029200 + EMITPAIR(TAKE(LASTINFO).ADDRESS, 70029300 + IF B < REFV THEN STOD ELSE OVRD); 70029400 + IF(N~IF B = DPV THEN 2 ELSE 70029500 + IF B = REFV THEN 0 ELSE 70029600 + IF B = PTRV THEN 3 ELSE 1)! 1 THEN GO INN 70029700 + END; 70029800 + FAKEY ~ FALSE 70030000 + END ELSE % HE DIDNT GIVE ONE, WE GOTTA DO 70031000 + IF N ~ T ! 1 THEN % ITS A COMPILE-TIME THING 70031100 + BEGIN 70031200 + INN: PDPRT[PDINX.LINKR,PDINX.LINKC]~TAKE(LASTINFO).DISP 70031300 + &REAL(T=0)[8:47:1] 70031310 + &N[2:45:3]; 70031400 + PDINX ~ PDINX + 1; GO OWT 70031500 + END ELSE % THE OBJECT CODE GOTTA DO 70031600 + IF CURRENT ! 0 THEN % BUT IF ITS OUTER BLOCK, DONT DO70031700 + BEGIN JUMPCHKX; EMIT(ZERO); 70032000 + IF KLASS=DPID OR KLASS=EVENTID THEN %MAYBE TWICE 70033000 + EMIT(XTND) ELSE 70034000 + IF KLASS = REFID THEN 70035000 + IF FAKEY THEN 70036000 + BEGIN L ~ L - 1; EMIT(DUPL) END ELSE 70037000 + BEGIN EMITNUM(5); EMIT(STAG); FAKEY ~ TRUE END; 70038000 + END; 70039000 + OWT: 70039500 + PUT(TAKE(LASTINFO)&NEXTINFO[33:33:15],LASTINFO); 70040000 + END UNTIL STEPI ! COMMA; 70041000 + CONTEXT ~ CONTEX 70042000 + END IDLIST; 70043000 + BOOLEAN PROCEDURE ENTER(SPAZE,TIPE,KLASS,B); VALUE SPAZE,TIPE,KLASS,B; 70044000 + BOOLEAN B; INTEGER SPAZE,TIPE,KLASS; 70045000 + COMMENT ENTER PUTS THE IDENTIFIER IN ACCUM INTO INFO, AND LINKS IT IN 70046000 + APPROPRIATELY, MAKING CERTAIN THAT THE ENTRY IS NOT SPLIT 70047000 + ACROSS A ROW BOUND. IF B IS TRUE, SPAZE IS PASSED ON TO 70048000 + GETSPACE, WHICH RETURNS THE ADDRESS-FIELD VALUE: OTHERWISE, 70049000 + SPAZE ITSELF IS THE ADDRESS-FIELD VALUE. TIPE GOES INTO THE 70050000 + TYPE FIELD, AND KLASS INTO THE CLASS FIELD; 70051000 + BEGIN 70052000 + INTEGER N; 70053000 + REAL ELBW; 70054000 + IF ((N ~ (COUNT + 19) DIV 8) + NEXTINFO).LINKR ! 70055000 + NEXTINFO.LINKR THEN 70056000 + PUT(NEXTINFO~(LASTINFO~NEXTINFO)+256-NEXTINFO.LINKC, 70057000 + LASTINFO); 70058000 + ACCUM[1].CONL ~ STACKHEAD[SCRAM]; 70059000 + STACKHEAD[SCRAM] ~ NEXTINFO + 1; 70060000 + MOVE(N-1,ACCUM[1],INFO[NEXTINFO.LINKR,NEXTINFO.LINKC+1]); 70061000 + IF B THEN 70062000 + BEGIN 70062100 + ENTER~SPAZE ~ GETSPACE(SPAZE) < 0; 70062200 + IF PRTOG THEN PRINTSPACE(NEXTINFO,SPAZE.[31:5], 70062300 + SPAZE.[36:12]); 70062400 + END; 70062500 + ELBW.ADDRESS ~ SPAZE; 70063000 + ELBW.CLASS ~ KLASS; 70064000 + ELBW.TYPE ~ TIPE; 70065000 + PUT(ELBW, LASTINFO ~ NEXTINFO); 70066000 + NEXTINFO ~ NEXTINFO + N; 70067000 + END ENTER; 70068000 +PROCEDURE MERRIMAC; 70069000 + BEGIN COMMENT MERRIMAC IS STILL WORKING ON THE MONITOR. 70070000 + ::= MONITOR 70071000 + () 70072000 + THE PROCEDURE IDENTIFIER PARAMETERS ARE CHECKED TO SEE IF THEY 70073000 + ARE BOTH VALUE AND IF THE TYPE OF SECOND PARAMETER IS THE SAME 70074000 + AS THE PROCEDURE. THE MONITOR LIST VARIABLES ARE RE-ENTERED 70075000 + IN INFO (IF FOUND) MARKED AS MONITORED AND WITH A LINK POINT- 70076000 + ING TO THE INFO ENTRY FOR THE PROCEDURE IDENIIFIER. ;70077000 + REAL ELBW, CLAS, PROCLINK; 70078000 + DO BEGIN 70078010 + CONTEXT ~ 2; 70078050 + CLAS ~ STEPI - BOOPROCID; 70079000 + IF RANGE (BOOPROCID, PTRPROCID) 70080000 + THEN BEGIN 70081000 + PROCLINK ~ ELBAT[I].ADDRESS; 70082000 + COMMENT CHECK PARAMETERS %-----------% ;70083000 + IF STEPI ! LFTPRN 70084000 + THEN ERR (701) 70085000 + ELSE DO IF STEPI - BOOID = CLAS 70086000 + OR CLAS = WORDID - BOOID 70086100 + THEN BEGIN 70087000 + GTB1 ~ ENTER((ELBW ~ ELBAT [I]). 70088000 + ADDRESS, ELBW.TYPE, ELBW.CLASS, 70089000 + FALSE); 70090000 + PUT (INFO [(GT1~LASTINFO).LINKR, 70091000 + GT1.LINKC] 70092000 + &1 [1:47:1] 70093000 + &PROCLINK [33:33:15], 70094000 + LASTINFO); 70095000 + END 70096000 + ELSE ERR (702) 70097000 + UNTIL STEPI ! COMMA; 70098000 + IF ELCLASS ! RTPARN THEN ERR (701); 70099000 + STEPIT; 70100000 + END 70101000 + ELSE ERR (702); 70102000 + END UNTIL ELCLASS!COMMA; 70102010 + END MERRIMAC; 70103000 +BOOLEAN PROCEDURE FIELDER (DIALS, SIMPLE); 70104000 + REAL DIALS; 70105000 + BOOLEAN SIMPLE ; 70106000 + BEGIN COMMENT FIELDER HANDLES THE CONSTRUCT: 70107000 + ::= : 70108000 + AS FOUND IN FIELD AND LAYOUT DECLARATIONS, THE SIMPLE CASE IS 70109000 + WHEN BOTH AEXP-S ARE LITERALS, AND IN THIS CASE THE DIAL SET- 70110000 + TINGS ARE FORMATTED SO THAT THEY WILL MAP INTO THE DISP FIELD 70111000 + OF THE ELBAT WORD AND THE LVT BIT IS TURNED ON AND SIMPLE IS 70112000 + SET TRUE. IN THE NOT SIMPLE CASE AN ADDL WORD IS BUILT (IN 70113000 + DIALS) THAT CONTAINS EITHER A DIAL SETTING OR A LINK TO ADDL 70114000 + IF EACH OF TWO FIELDS. IN EITHER CASE FIELDER IS SET FALSE IF 70115000 + A SYNTAX ERROR IS DETECTED. 70116000 + ;70117000 + DEFINE SCAT = BEGIN FIELDER ~ FALSE; GO QUIT END#, 70118000 + LITERAL = NUMBER#; %----------% 70119000 + LABEL QUIT, COLONCHECK, WRAPUP, SECOND; 70120000 + INTEGER S, N; 70121000 + FIELDER ~ SIMPLE ~ TRUE; 70122000 + COMMENT I POINTS AT FIRST COMPONENT OF ARITH EXPR AND HAS NOT70123000 + BEEN STEPPED PAST IT; 70124000 + IF ELCLASS = LITERAL 70125000 + THEN BEGIN 70126000 + DEBLANK; 70127000 + IF CHR = ":" 70128000 + THEN BEGIN 70129000 + IF S ~ THI { 47 70130000 + THEN BEGIN STEPIT; GO COLONCHECK END; 70131000 + FLAG (704); SCAT; 70132000 + END; 70133000 + END; 70134000 + SIMPLE ~ FALSE; 70135000 + IF S ~ -TEXT(FIELDEXPA, COLON) > 0 THEN SCAT; 70136000 +COLONCHECK: 70137000 + IF ELCLASS ! COLON THEN SCAT; 70138000 + IF STEPI = LITERAL 70139000 + THEN BEGIN 70140000 + DEBLANK; 70141000 + IF CHR = "," 70142000 + THEN GO SECOND; 70143000 + IF CHR = ";" OR CHR = ")" OR CHR = "~" 70144000 + THEN BEGIN 70145000 +SECOND: 70146000 + IF N ~ THI { 48 AND N > 0 70147000 + THEN BEGIN STEPIT; GO WRAPUP END; 70148000 + FLAG (704); 70149000 + SCAT; 70150000 + END 70151000 + END; 70152000 + SIMPLE ~ FALSE; 70153000 + IF N ~ -TEXT(FIELDEXPB, SEMICOLON) > 0 THEN SCAT; 70154000 +WRAPUP: IF SIMPLE 70155000 + THEN BEGIN 70156000 + 70157000 + DIALS ~ N & S [36:42:6]; 70158000 + END 70159000 + ELSE DIALS ~ ABS (N) 70160000 + & N [32:1:1] 70161000 + & ABS (S)[17:33:15] 70162000 + & S [16:1:1]; 70163000 +QUIT: COMMENT WHEN SUCCESSFUL I POINTS AT ENTITY AFTER LAST AEXP.; 70164000 + END FIELDER; 70165000 +BOOLEAN PROCEDURE FIELDPART (LSTINFO, DIALS); 70166000 + REAL LSTINFO, DIALS; 70167000 + BEGIN COMMENT FIELDPART HANDLES THE CONSTRUCT: 70168000 + ::= = 70169000 + AND MAY BE DRIVEN BY FIELDEC OR LAYOUTDEC. THE IDENTIFIER IS 70170000 + ENTERED AND LSTINFO IS RETURNED TO THE CALLER. FIELDER RETURNS70171000 + DIALS AND IF THE DIALS AHE NOT SIMPLE THEY ARE NEGATED FOR THE 70172000 + CALLER. WHEN FIELDPART IS TRUE - IT WAS SUCCESSFUL 70173000 + ; 70174000 + INTEGER ELCLAS; 70175000 + BOOLEAN SIMPLE; 70176000 + LABEL QUIT; 70177000 + DEFINE SCAT=DO UNTIL 70178000 + (ELCLAS~STEPI=COMMA AND TABLE (I+2)=RELOP) 70179000 + OR ELCLAS= SEMICOLON; 70180000 + FIELDPART ~ FALSE; 70181000 + GO QUIT#; 70182000 + DEFINE LASTI = LSTINFO.LINKR,LSTINFO.LINKC#; 70183000 + COMMENT T POINTS AT IDENTIFIER.; 70184000 + IF ELCLASS ! UNKNOWNID 70185000 + THEN BEGIN FLAG (700); SCAT END; 70186000 + GTB1 ~ ENTER (0, LOCALTYPE, FIELDID, FALSE); 70187000 + LSTINFO ~ LASTINFO; 70188000 + IF STEPI ! RELOP OR ELBAT[I].DISP ! EQUL 70189000 + THEN BEGIN FLAG (703); SCAT END; 70190000 + FIELDING ~ TRUE; 70190100 + STEPIT; 70191000 + IF FIELDER (DIALS, SIMPLE) 70192000 + THEN BEGIN 70193000 + IF SIMPLE 70194000 + THEN INFO [LASTI].ADDRESS ~ DIALS 70195000 + ELSE BEGIN 70196000 + INFO [LASTI].LINK ~ NEXTADDL; 70197000 + PUTNBUMP (DIALS); 70198000 +DONBUG ("FIELDS", 0, NEXTADDL-1); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70199000 + END; 70200000 + END 70201000 + ELSE BEGIN FLAG (704); SCAT END; 70202000 + FIELDING ~ FALSE; 70202100 + FIELDPART ~ TRUE; 70203000 +QUIT: COMMENT T POINTS AT TERMINATING "," OR SEMICOLON; 70204000 +DONBUG ("FIELDS", LSTINFO,0); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70205000 + END FIELDPART; 70206000 +PROCEDURE FIELDEC; 70207000 + BEGIN COMMENT FIELDEC PROCESSES THE DECLARATION: 70208000 + ::= FIELD 70209000 + WHEN THE DIALS ARE SIMPLE THEY ARE PLACE IN THE ADDRESS PART OF70210000 + THE INFO WORD, OTHERWISE THE LINK POINTS TO A WORD IN ADDL THAT70211000 + CONTAINS A DIAL AND/OR A POINTER TO TEXT IN ADDL. 70212000 + ;70213000 + REAL DIALS; 70214000 + INTEGER LSTINFO; 70215000 + DO BEGIN 70216000 + STEPIT; 70217000 + GTB1 ~ FIELDPART (LSTINFO, DIALS); 70218000 + END UNTIL ELCLASS ! COMMA; 70219000 + END FIELDEC; 70220000 +PROCEDURE LAYOUTDEC; 70221000 + BEGIN COMMENT LAYOUTDEC PROCESSES THE DECLARATION 70222000 + ::= LAYOUT 70223000 + IN ALL CASES THE INFO WORD LINK POINTS TO N ADDL ENTRIES WHERE 70224000 + EACH ENTRY IS SIMILAR TO THE ADDL ENTRIES FOR FIELDEC EXCEPT 70225000 + THAT SIMPLE DIALS ARE ALSO KEPT IN ADDL. SOME OF THE ENTRIES 70226000 + MAY BE INITIAL VALUES. THE ADDRESS PART OF THE INFO WORD CON- 70227000 + TAINS N (THE NUMBER OF ADDL ENTRIES). 70228000 + ;70229000 + INTEGER ADDLI, ELCLAS, CODE, LSTINFO, J; 70230000 + ARRAY TADDL [0:98]; 70231000 + REAL TINFO, DIALS; 70232000 + BOOLEAN SIMPLE, INITIAL; 70233000 + LABEL ON; 70233100 + LABEL BACK, GONE; 70233200 + LABEL EXIT; 70234000 + DEFINE SCAT = 70235000 + BEGIN WHILE ELCLASS!RTPARN AND ELCLASS!SEMICOLON DO 70236000 + STEPIT; 70237000 + IF ELCLASS=RTPARN THEN GO EXIT ELSE GO GONE 70238000 + END # 70239000 + , LITERAL = NUMBER # %------------% 70240000 + , LASTI = LSTINFO.LINKR, LSTINFO.LINKC # 70241000 + , EVERYTHING= CODE [8:40:8] 70242000 + & REAL(INITIAL)[7:47:1]# 70243000 + ; 70244000 + DO BEGIN 70245000 + IF STEPI ! UNKNOWNID 70246000 + THEN BEGIN FLAG (700); SCAT END; 70247000 + GTB1 ~ ENTER (0, LOCALTYPE, LAYOUTID, FALSE); 70248000 + LSTINFO ~ LASTINFO; 70249000 + IF STEPI ! LFTPRN 70250000 + THEN BEGIN FLAG (705); SCAT END; 70251000 + DO BEGIN 70252000 + FIELDING ~ TRUE; 70252100 + STEPIT; 70253000 + FIELDING ~ FALSE; 70253100 + DEBLANK; 70254000 + IF CHR = "=" 70255000 + THEN IF FIELDPART (TINFO, DIALS) 70256000 + THEN BEGIN 70257000 + CODE ~ LAYOUTID; 70258000 + DIALS ~ TINFO; 70259000 + END 70260000 + ELSE BEGIN FLAG (703); END 70261000 + ELSE 70261100 + BACK: 70261150 + IF ELCLASS = UNKNOWNID THEN 70261200 + IF GT1 ~ ELBAT[I] = 0 THEN GO ON ELSE 70261300 + BEGIN 70261400 + ELBAT[I].CLASS ~ ELCLASS ~ (TINFO ~TAKE(GT170261500 + )).CLASS; 70261600 + IF ELCLASS ! DEFINDID THEN GO ON ELSE 70261700 + 70261800 + DIALS ~ TINFO.LINK; 70261900 + IF TINFO.ADDRESS ! 0 THEN 70262000 + BEGIN 70262100 + DIALS.[18:15]~ NEXTINFO; 70262200 + IF ASSOCIATE(TINFO.ADDRESS) THEN 70262300 + GO ON; 70262400 + END; 70262500 + HOOK(DIALS); NXTELBT ~ NXTELBT-1; 70262600 + ELCLASS ~ TABLE(I); 70262700 + GO BACK; 70262800 + END ELSE 70262900 + ON: IF ELCLASS = FIELDID THEN 70263000 + BEGIN 70263100 + CODE ~ LAYOUTID; 70264000 + DIALS ~ ELBAT [I].LINK; 70265000 + STEPIT; 70266000 + END 70267000 + ELSE 70268000 + IF ELCLASS = TAGV 70269000 + THEN BEGIN 70270000 + CODE ~ TAGV; 70271000 + STEPIT; 70272000 + END 70273000 + ELSE 70274000 + BEGIN FIELDING ~ TRUE; 70274100 + IF FIELDER (DIALS, SIMPLE) 70275000 + THEN BEGIN 70276000 + IF SIMPLE 70277000 + THEN DIALS~ 0 &DIALS[26:36:6] 70278000 + &DIALS[42:42:6]; 70279000 + CODE ~ FIELDID; 70280000 + END 70281000 + ELSE BEGIN FLAG (707); SCAT END; 70282000 + FIELDING ~ FALSE END; 70282100 + IF ELCLASS = ASSNOP 70283000 + THEN BEGIN 70284000 + IF STEPI ! LITERAL OR THI < 0 70285000 + THEN BEGIN FLAG (706); SCAT END; 70286000 + INITIAL ~ TRUE; 70287000 + STEPIT; 70288000 + END; 70289000 + TADDL [ADDLI~ADDLI+1]~ ABS (DIALS)& EVERYTHING; 70290000 + IF INITIAL THEN TADDL [ADDLI ~ ADDLI + 1] ~ THI;70291000 + INITIAL ~ SIMPLE ~ FALSE; 70292000 + END 70293000 + UNTIL ELCLASS ! COMMA; 70294000 + IF ELCLASS ! RTPARN THEN FLAG (705); 70295000 + INFO [LASTI] ~ INFO [LASTI] 70296000 + &(NEXTADDL ~ ADDLI)[2:29:19] 70297000 + & NEXTADDL [33:33:15]; 70298000 +DONBUG ("LAYOUT", LSTINFO, 0); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70299000 + WHILE J ~ J + 1 { ADDLI DO PUTNBUMP (TADDL [J]); 70300000 +ADDLI ~ INFO [LASTI].ADDRESS; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70301000 +BEGIN J~INFO[LASTI].LINK-1; WHILE J~J+1< ADDLI DO DONBUG("LAYOUT",0,J); 70302000 +END; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70303000 +EXIT: STEPIT; 70304000 + ADDLI ~ J ~ 0; 70305000 + END 70306000 + UNTIL ELCLASS ! COMMA; 70307000 + GONE: 70307100 + END LAYOUTDEC; 70308000 +PROCEDURE PUTOGETHER (CHAR); 70309000 + REAL CHAR; 70310000 + BEGIN 70311000 + DEFINE ADDLI = (GT1 ~ NEXTCHAR.[30:15]).LINKR, GT1.LINKC#; 70312000 + INTEGER COUNT, EXCESS; 70313000 + REAL GT1; 70314000 + IF (CHARCOUNT ~ (COUNT ~ CHAR.CHRCNT) + CHARCOUNT)> 2047 THEN 70315000 + BEGIN FLAG (708); BADSTUFF ~ TRUE END 70316000 + ELSE BEGIN 70317000 + IF COUNT > REMCOUNT 70318000 + THEN BEGIN 70319000 + COUNT ~ (COUNT -(EXCESS~ REMCOUNT)); 70320000 + MOVECHARACTERACCUM 70321000 + (EXCESS, CHAR, 0, ADDL[ADDLI], 70322000 + NEXTCHAR.[45:3]); 70323000 +DONBUG("PUTOGE", -EXCESS, GT1); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70324000 + NEXTCHAR ~ NEXTCHAR + EXCESS; 70325000 + REMCOUNT ~ 2047; 70326000 + END; 70327000 + MOVECHARACTERACCUM 70328000 + (COUNT, CHAR, EXCESS, ADDL[ADDLI], 70329000 + NEXTCHAR.[45:3]); 70330000 +DONBUG ("PUTOGE",-COUNT, GT1); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%70331000 + NEXTCHAR ~ NEXTCHAR + COUNT; 70332000 + REMCOUNT ~ REMCOUNT - COUNT; 70332500 + END 70333000 + END PUTOGETHER; 70334000 +INTEGER PROCEDURE TEXT (FROM, FINAL); 70335000 + VALUE FROM, FINAL; 70336000 + INTEGER FROM, FINAL; 70337000 + BEGIN COMMENT TEXT HANDLES THE PLACING OF A SEQUENCE OF VALID 70338000 + SYMBOLS IN ADDL. THE PARAMETER FROM DETERMINES HOW THE 70339000 + TRANSFER IS TERMINATED AND THE TERMINATING SYMBOL THAT IS 70340000 + PLACED IN ADDL. CURRENTLY RECOGNIZED FHOM(S) ARE: 70341000 + DEFINEV = #, 70342000 + FIELDEXPA OR LAYEXPA = : 70343000 + FIELDEXPB = <, OR SEMICOLON> 70344000 + IF THE VALUE OF TEXT IS } 0 THEN IT IS THE ADDL INDEX FOR 70345000 + THE TEXT, OTHERWISE AN ERROR HAS OCCURRED. 70346000 + FINAL IS THE ELCLASS FOR A POSSIBLE TERMINATING CHARACTER 70347000 + OR A FUNCTION OF THE NUMBER OF SYMBOLS IN A FORMAL SYMBOL 70348000 + LIST I.E. FINAL DIV 10 + 1 * NO. OF SYMBOLS. 70349000 + ;70350000 + REAL TERMINATE; 70351000 + BOOLEAN TERMINATOR, FIELDPARTA, FIELDPARTB; 70352000 + INTEGER BRAKET, PARENS, PARCOUNT, J; 70353000 + BOOLEAN DEFINPARAM; 70354000 + BOOLEAN GOBBLER; 70354100 + DEFINE FLOGGER = 70354200 + IF REMCOUNT = 0 THEN REMCOUNT ~ 2047; 70354250 + FLOG(DEFINESFLAG,ACCUM[9],ADDL[(GT1~NEXTCHAR.[30:15]).LINKR, 70354300 + GT1.LINKC]); 70354400 + NEXTCHAR ~ (GT3 ~ COUNT DIV 6) + NEXTCHAR; 70354500 + CHARCOUNT ~ GT3 + CHARCOUNT; 70354550 + REMCOUNT ~ REMCOUNT - GT3; 70354575 + DONBUG ("FLOGER",-COUNT DIV 6, GT1);#; %%%%%%%%%%%%%%%%%%%%%%%70354600 + LABEL ON, AWAY; 70355000 + LABEL WAY; 70355100 + INTEGER LASTRESULT, CONTEX; 70356000 + IF FROM =DEFINEV THEN PARCOUNT ~ FINAL; 70357000 + FIELDPARTA ~ FROM = FIELDEXPA; 70358000 + FIELDPARTB ~ FROM =FIELDEXPB; 70359000 + IF DEFINPARAM ~ FROM =DEFINEP THEN TERMINATE ~ "1#000"; 70360000 + CHARCOUNT ~ 0; 70361000 + REMCOUNT ~ (256 - NEXTADDL MOD 256) | 8; 70362000 + NEXTCHAR ~ 0 & NEXTADDL [30:33:15]; 70363000 + DOUBLE (CONTEXT, 3, ~, CONTEX, CONTEXT); 70364000 + WHILE NOT (TERMINATOR OR BADSTUFF) 70365000 + DO BEGIN 70366000 + IF ELCLASS = STRNGCON OR ELCLASS =STRING 70367000 + THEN BEGIN 70367300 + WHILE NEXTCHAR.[45:3] ! 7 70367600 + DO PUTOGETHER ("1 000"); 70368000 + PUTOGETHER (33292288); % 1"000 70368300 + FLOGGER; 70369000 + IF ELCLASS = STRING 70370000 + THEN DO BEGIN 70370300 + GOBBLER ~ GOBBLE (FALSE); 70370600 + FLOGGER; 70371000 + END UNTIL NOT GOBBLER; 70371300 + PUTOGETHER (33292288); % 1"000 70371600 + END 70372000 + ELSE BEGIN 70373000 + IF FROM = DEFINEP AND ELCLASS } LFTPRN 70374000 + OR FIELDPARTB 70375000 + THEN BEGIN 70376000 + PARENS~PARENS+REAL(ELCLASS=LFTPRN); 70377000 + PARENS~PARENS-REAL(ELCLASS=RTPARN); 70378000 + BRAKET~BRAKET+REAL(ELCLASS=LFTBRKT); 70379000 + BRAKET~BRAKET-REAL(ELCLASS=RTBRKT ); 70380000 + END 70381000 + ELSE IF FROM = DEFINEV AND ELCLASS < NULLV 70382000 + THEN IF PARCOUNT ! 0 THEN 70383000 + BEGIN 70384000 + J ~ 1; 70385000 + DO BEGIN 70386000 + IF (GTB1 ~ DEFINFO[J] =ACCUM[1]) 70387000 + AND COUNT < 5 70387100 + THEN GO ON 70388000 + ELSE IF COUNT > 4 70389000 + AND GTB1 70389050 + THEN IF CMPCHREQL (COUNT -4,70389100 + ACCUM[2],DEFINFO[J+1]) 70390000 + THEN BEGIN 70391000 + ON: ACCUM[1]~DEFINFO[J-1]; 70392000 + GO AWAY; 70393000 + END 70394000 + END 70395000 + UNTIL J ~ J + 10 > PARCOUNT; 70396000 + END; 70397000 + AWAY: 70398000 + IF LASTRESULT < SPASE AND RESULT < SPASE 70399000 + THEN PUTOGETHER ("1 000"); 70400000 + PUTOGETHER (ACCUM [1]); 70401000 + IF ELCLASS=SEMICOLON AND FIELDPARTA THEN 70401100 + BEGIN BADSTUFF~TRUE; GO WAY END; 70401200 + END; 70402000 + LASTRESULT ~ RESULT; 70403000 + IF ELCLASS = DEFINEV THEN DEFINECTR ~ DEFINECTR + 1; 70404000 + IF ACCUM[1] ! "1#000" THEN 70404100 + IF MACRO THEN STEPIT 70405000 + ELSE BEGIN ELCLASS~TABLE(NXTELBT); NXTELBT~NXTELBT-1 END; 70406000 + IF TERMINATOR~FROM=DEFINEV AND ELCLASS=CROSSHATCH 70407000 + THEN BEGIN TERMINATE ~ ACCUM [1]; STEPIT; 70408000 + IF DEFINECTR > 1 70409000 + THEN TERMINATOR ~ DEFINECTR ~ DEFINECTR - 70410000 + REAL(ELCLASS ! COMMA) = 0; 70411000 + IF NOT TERMINATOR 70412000 + THEN PUTOGETHER (TERMINATE); 70413000 + END 70414000 + ELSE IF TERMINATOR ~ (FIELDPARTA AND ELCLASS = FINAL)70415000 + OR (FIELDPARTB 70416000 + AND (ELCLASS = FINAL OR ELCLASS = COMMA 70417000 + OR (ELCLASS = RTPARN AND PARENS = 0) 70418000 + OR ELCLASS = ASSNOP)) 70419000 + THEN TERMINATE ~ "1;000" 70420000 + ELSE TERMINATOR ~ DEFINPARAM AND 70421000 + (ELCLASS=COMMA OR ELCLASS=FINAL) 70422000 + AND (BRAKET+PARENS= 0); 70423000 + END; 70424000 + WAY: 70424500 + IF BADSTUFF 70425000 + THEN TEXT ~ - NEXTADDL 70426000 + ELSE BEGIN 70427000 + PUTOGETHER (TERMINATE); 70428000 + TEXT ~ NEXTADDL; 70429000 + END; 70430000 + PUTOGETHER ("1#000"); 70431000 + NEXTADDL ~ (CHARCOUNT + 7) DIV 8 + NEXTADDL; 70432000 + CONTEXT ~ CONTEX; 70433000 + END PLACING TEXT IN ADDL; 70434000 +PROCEDURE DEFINEDEC; 70435000 + BEGIN COMMENT DEFINEDEC PROCESSES THE DECLARATION 70436000 + ::= DEFINE . IF AN IDENTI-70437000 + FIER IS ENTERED, THE MINIMUM ADDL ENTRY IS A #; 70438000 + DEFINE SCAT = DO UNTIL STEPI = CROSSHATCH; 70439000 + IF STEPI = COMMA 70440000 + THEN GO BACK ELSE WHILE ELCLASS ! SEMICOLON DO STEPIT; 70441000 + GO EXIT;#; 70442000 + INTEGER LSTINFO, DEFI; 70443000 + INTEGER CONTEX; 70443100 + LABEL BACK, EXIT; 70444000 + DO BEGIN 70445000 +BACK: BADSTUFF ~ FALSE; 70446000 + DEFINECTR ~ 1; 70447000 + IF STEPI ! UNKNOWNID 70448000 + THEN BEGIN FLAG (700); SCAT END; 70449000 + GTB1 ~ ENTER (0, LOCALTYPE, DEFINDID, FALSE); 70450000 + 70451000 + 70452000 + LSTINFO ~ LASTINFO; 70453000 + IF STEPI = LFTPRN 70454000 + THEN BEGIN %PROCESS PARAMETERS 70455000 + DEFI ~ -9; 70456000 + DO BEGIN 70457000 + IF DEFI ~ DEFI + 10 > 90 70458000 + THEN BEGIN FLAG (749); SCAT END; 70459000 + IF STEPI > NULLV % MUST BE IN ID70460000 + THEN BEGIN FLAG(747); SCAT END; 70461000 + MOVE (GTI1~(Q.CHRCNT+11)DIV 8, 70462000 + ACCUM[1], DEFINFO[DEFI]); 70463000 + END UNTIL STEPI ! COMMA; 70464000 + IF ELCLASS ! RTPARN 70465000 + THEN BEGIN FLAG(749); SCAT END; 70466000 + INFO [(GT1~ LSTINFO).LINKR, 70467000 + GT1.LINKC].ADDRESS ~ DEFI; 70468000 + STEPIT; 70469000 + END; 70470000 + 70471000 + IF ELCLASS ! RELOP OR ELBAT[I].DISP ! EQUL 70472000 + THEN BEGIN 70473000 + FLAG (710); 70474000 + BADSTUFF ~ TRUE; 70475000 + GT1 ~ TEXT (DEFINEV, DEFI); 70476000 + SCAT; 70477000 + END; 70478000 + DOUBLE (CONTEXT, 3, ~, CONTEX, CONTEXT); 70478100 + STEPIT; 70479000 + CONTEXT ~ CONTEX; 70479100 + INFO [LSTINFO.LINKR,LSTINFO.LINKC].LINK ~ NEXTADDL; 70479500 +DONBUG ("DEFINE", LSTINFO, 0); %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 70479600 + 70479700 + IF TEXT (DEFINEV, DEFI) <0 70480000 + THEN BEGIN SCAT END; 70481000 + END UNTIL ELCLASS ! COMMA; 70482000 +EXIT: DEFINECTR ~ 0; 70483000 + END DEFINE DECLARATION; 70484000 + PROCEDURE PROCEDUREDEC(SAV,KLASS); VALUE SAV,KLASS; 70485000 + BOOLEAN SAV; INTEGER KLASS; 70486000 + COMMENT PROCEDUREDEC COMPILES A PROCEDURE DECLARATION. SAV IS TRUE 70487000 + FOR SAVE, AND KLASS IS THE ELCLASS FOR THE THING; 70488000 + BEGIN ARRAY TEDOC[0:31,0:255]; 70489000 + LABEL BYPASS,SGMENT,SAVE1; 70489100 + INTEGER X, Z, 70490000 + PROINFO, % INFO INDEX OF THE ENTRY WE MAKE 70491000 + NINFOOO, % OLD VALUE OF NINFOO 70492000 + SEGNOO, 70493000 + LASTXO, 70494000 + FIRSTXO, 70495000 + FIRSTMTO, LO, 70496000 + PADDL, % ADDL INDEX FOR THE PROCEDURE STUFF 70497000 + PINFO, % FIRST PARAMETER INFO INDEX 70498000 + DSP; % DISPLACEMENT VALUE FOR PARAM ADDRESSES 70499000 + BOOLEAN SEGED, %PROCEDURE BODY IS A SEGMENT 70500000 + SEPARATOGO, % OLD "SEPARATOG" 70500500 + SVINFOO, % OLD "SVINFO" 70500600 + BLOCKED; % BODU IS A BLOCK 70501000 + REAL Y,P, 70502000 + CQAO, % COUNTQALG SAVED HERE 70502100 + ELBW, % ELBAT WORD FOR THE PROCEDURE. 70503000 + FELBW, % ELBAT WORD OF THE FORWARD DEC, IF ANY 70504000 + NP; % FIRST ADDL WORD FOR THE PROCEDURE. 70505000 + DEFINE FWD = FELBW ! 0#; 70506000 + IF SVINFOTOG THEN ELSE 70506200 + BEGIN 70506300 + SVINFOO~SVINFO; 70506400 + SVINFO~FALSE; 70506500 + END; 70506600 + CONTEXT ~ 0; % ITS DECLARATION TIME 70507000 + IF STEPI ! UNKNOWNID THEN % PROCID MATCHES A LOCAL ID 70508000 + IF ELBAT[I].TYPE ! F0RWARD THEN FLAG(731) ELSE 70509000 + IF ELCLASS ! KLASS THEN FLAG(730) ELSE 70510000 + FELBW ~ ELBAT[I]; % ITS OK--WAS DECLARED FWD WITH SAME TYPE 70511000 + IF BOOLEAN(X~REAL(REAL(SEPARATOG AND BOOLEAN(3))!0)) THEN 70511200 + BEGIN 70511400 + IF (GLOBLCNT~GLOBLCNT+1).[16:5]>2 THEN FLAG(791); 70511600 + GLOBALINDEX; % PRINT PRT FOR GLOBAL IF "PRTOG" IS SET 70511800 + END; 70512000 + TB1~ENTER(IF FWD THEN FELBW.ADDRESS ELSE 70512200 + IF BOOLEAN(X) THEN GLOBLCNT ELSE CURRENT, 70512400 + WITHINBODY, KLASS, NOT(FWD OR BOOLEAN(X))); 70512600 + IF SEPARATOGO~SEPARATOG THEN 70512800 + BEGIN 70513000 + SEPSTR[12]~" "; 70513100 + MOVECHARACTERS(X~MIN(7,COUNT),ACCUM[1],4,SEPSTR[12],1); 70513200 + FILL TEMP WITH SEPSTR[12]; 70513300 + SEPSTR[12].[1:5]~X; 70513350 + WRITE(TEMP); % SAVE THE 1ST RECORD FOR DIRECTORY. 70513400 + END; 70513500 + ELBW ~ TAKE(PROINFO ~ LASTINFO) & PADDL ~ NEXTADDL [33:33:15]; 70514000 + PUT(ELBW,PROINFO); 70515000 + PUTNBUMP(0); % RESERVE CELL FOR 1ST ADDL WORD 70516000 + DSP ~ 1; % PREPARE FOR ADDRESS CALCULATIONS 70517000 + NINFOOO ~ NINFOO; 70518000 + X ~ PINFO ~ NINFOO ~ NEXTINFO; 70519000 + CONTEXT ~ 2; 70520000 + IF STEPI = LFTPRN THEN % IF ANY PARAMETERS... 70521000 + NP ~ FORMALPARAPART(FALSE) % THEN HANDLE THEM 70522000 + ELSE 70523000 + IF ELCLASS ! SEMICOLON THEN FLAG(736) ELSE STEPIT; 70524000 + FOR Z ~ 1 STEP 1 UNTIL NP DO % FOR EACH PARAMETER 70525000 + BEGIN % X POINTS TO FIRST PARAM INFO 70526000 + IF (P~Y~TAKE(X)).CLASS = 0 THEN P~Y~TAKE(X~Y); 70527000 + P.LINK ~ P.ADDRESS; % FMLPARAPART PUTS LINK IN 70528000 + P.LVEL ~ CURRENT + 1; % AND WE ASSIGN ADDRESSES 70529000 + P.DISP ~ DSP ~ DSP + 1; 70530000 + PUT(P,X); 70531000 + IF P.CLASS = FORMALID THEN % NO SPECIFICATION FOR THISUN 70532000 + FLAG(732) ELSE % CHANGE TO PURGE-TYPE ACTION 70533000 + IF P.CLASS=DPID OR P.CLASS=EVENTID THEN 70534000 + DSP ~ REAL (P.TYPE = FORMALVALUEP) + DSP ELSE 70535000 + IF P.CLASS } BOOARRAYID AND P.CLASS { EVENTARRAYID THEN 70536000 + P.LINK ~ GIT(P).NODIM; 70537000 + PLACE(P)"INTO ADDL AT"(PADDL + Z); 70538000 + X ~ Y.LINK %X NOW POINTS TO NEXT PARAM ENTRY 70539000 + END OF PARAMETER FUTZING; 70540000 + IF ELCLASS { IDMAX THEN 70540100 + IF X ~ ELBAT[I].LINK } PINFO THEN 70540200 + ELBAT[I].ADDRESS ~ TAKE(X).ADDRESS; 70540300 + IF FWD THEN 70541000 + IF GIT(X ~TAKE(FELBW).LINK).LINK!NP THEN FLAG(733) ELSE 70542000 + FOR Y ~ 1 STEP 1 UNTIL NP DO % CHECK CORRESPONDENCE WITH FWDEC70543000 + IF GIT(X + Y) ! GIT(PADDL + Y) THEN FLAG(734); 70544000 + IF KLASS ! PROCID THEN 70545000 + NP.ADDRESS ~(DSP ~ DSP + 1)&(CURRENT + 1)[30:42:6]; 70546000 + COMMENT THAT SHOULD TAKE CARE OF THE PROCEDURE HEAD. NOW WE TRY 70547000 + FOR A BODY-- OR AT LEAST A "FORWARD"; 70548000 + PLACE(NP,PADDL); 70549000 + IF ELCLASS=EXTERNALV THEN 70549100 + IF SEPARATOG THEN 70549150 + BEGIN % TIME FOR SEPARATED PROCEDURE DECLARATIONS, 70549200 + FLAG(788); % IT SHOULDNT HAVE AN "EXTERNAL" IN ANY SENSE.70549250 + GO BYPASS; 70549300 + END ELSE 70549350 + IF REAL(SEPARATOG)=2 THEN % TIME FOR GLOBAL DECLARATIONS, IT 70549400 + GO BYPASS ELSE % IS A GLOBAL PROC DECLARATION. 70549450 + BEGIN % WE ARE DOING REGULAR COMPILATION, IT IS AN EXTRNL DEC.70549500 + EXTRNLCNT~EXTRNLCNT+REAL(SVINFO~XTRNL~TRUE); 70549550 + SEGNOO~NEWSEG(PROINFO+1); 70549560 + PURGE(NEXTINFO~IF FWD THEN PROINFO ELSE PINFO); 70549570 + IF FWD THEN PROINFO~FELBW.LINK; 70549580 + PUT(TAKE(PROINFO)&LOCALTYPE[29:45:3],PROINFO); 70549590 + NINFOO~NINFOOO; 70549600 + NEXTADDL~IF FWD THEN PADDL ELSE PADDL+NP.LINK+1; 70549610 + SEGDICT(SEGNOO,0,0,0); 70549630 + LO~L; % THE L VALUE OF "MPCW" 70549640 + IF SEGED~SEPARATOG OR CURRENT>0 THEN 70549650 + BEGIN 70549653 + EMITPCW(CURRENT+1,0,STATE,SEGNOO); 70549656 + IF FWD THEN 70549658 + BEGIN 70549660 + EMITN(TAKE(PROINFO).ADDRESS); 70549662 + EMIT(STOD); 70549664 + END; 70549666 + END ELSE 70549668 + GLOBALPCW(ELBW.DISP,SEGNOO,0,STATE); 70549670 + INFD[(GT3~INFDX~INFDX+1).LINKR,INFDX.LINKC]~PCW; 70549680 + INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC]~NEXTINFO& 70549690 + (GT1~((GT2~TAKE(PROINFO+1)).CHRCNT+35)DIV 8) 70549700 + [18:33:15]&KLASS[1:41:7]; 70549710 + INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC]~ 70549720 + PROINFO&(IF SEGED THEN LO&SEGNO[20:35:13] ELSE 70549730 + ELBW.DISP)[5:20:28]; 70549740 + INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC]~ 70549750 + GT2&LASTEXT[3:33:15]; 70549760 + LASTEXT~GT3; 70549770 + IF GT1}5 THEN 70549780 + BEGIN 70549790 + MOVE(GT1-4,INFO[PROINFO.LINKR,PROINFO.LINKC+2], 70549800 + INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC]); 70549810 + INFDX~INFDX+GT1-5; 70549820 + END; 70549825 + XTRNL~FALSE; 70549830 + STEPIT; 70549835 + END ELSE 70549990 + IF ELCLASS = FORWARDV THEN 70550000 + BEGIN 70551000 + IF FWD THEN FLAG(735) ELSE % OOOOOPS...... 70552000 + IF SEPARATOG THEN FLAG(789) ELSE 70552100 + IF REAL(SEPARATOG)!2 THEN % =2: GLOBAL DEC FOR SEPA COMP.70552150 + IF CURRENT>0 THEN 70552200 + BEGIN JUMPCHKX; EMIT(ZERO) END; 70552300 + BYPASS: PURGE(NINFOO); % DISPOSE OF THE PARAM INFO 70553000 + ELBW.TYPE ~ F0RWARD; 70554000 + PUT(ELBW, LASTINFO ~ PROINFO); 70555000 + NEXTINFO ~ NINFOO; 70556000 + NINFOO ~ NINFOOO; 70557000 + NEXTADDL ~ PADDL + NP.LINK + 1; 70558000 + STEPIT; 70558100 + END FORWARD DECLARARATION ELSE 70559000 + IF ELCLASS = NULLV THEN 70559100 + BEGIN 70559200 + ELBW ~ TAKE(ELBAT[I-2]) & ELBW [21:21:7]; 70559300 + PUT(ELBW,LASTINFO ~ PROINFO); 70559400 + NEXTINFO ~ NINFOO; 70559500 + NINFOO ~ NINFOOO; 70559600 + NEXTADDL ~ PADDL + NP.LINK + 1; 70559700 + STEPIT; 70559800 + END ELSE 70559900 + COMMENT THE HEAD GOTS A BODY; 70560000 + BEGIN 70561000 + IF SEPARATOG THEN SEPARATOG~BOOLEAN(4) ELSE 70561100 + IF REAL(SEPARATOG)=2 THEN FLAG(790); 70561200 + MAXDISP ~ STACKMASK[CURRENT ~ CURRENT + 1].[FF]; 70562000 + STACKTOP[CURRENT] ~ MAXSTACK[CURRENT] ~ 70563000 + REAL(KLASS = DPPROCID) + DSP + 1; 70564000 + TB1 ~ SAV; SAV ~ SAVED; SAVED ~TB1; 70565000 + SEGNOO ~ SEGNO; 70566000 + CONTEXT ~ 2; 70567000 + IF ELCLASS = BEGINV THEN 70568000 + IF BLOCKED ~GT1~TABLE(I+1)}MINDEC AND GT1{MAXDEC THEN 70569000 + SGMENT: IF SEGED~NOT SAVED THEN 70570000 + BEGIN % NEW SEGMENT REQUIRED 70571000 + IF REAL(SEPARATOGO)=4 THEN 70571100 + BEGIN 70571200 + SEGED~NOT(SAVED~TRUE); 70571400 + GO TO SAVE1; 70571500 + END ELSE 70571600 + SAVED~SEPARATOGO; 70571700 + SEGNO ~ NEWSEG(PROINFO+1); 70572000 + MOVECODE(TEDOC,EDOC); 70573000 + LO ~ L; L ~ 0; 70574000 + GO TO SAVE1; 70574500 + END; 70575000 + IF SEPARATOGO THEN GO TO SGMENT; 70575050 + SAVE1: IF SAVED.[46:1] THEN 70575100 + BEGIN 70575200 + LO ~ L; SEGNO ~ 1; 70575300 + L ~ IF SAVEL = 0 THEN SAVEL ~18 ELSE SAVEL; 70575400 + MOVECODE(EDOC,INZCODE); 70575500 + END ELSE 70575900 + IF NOT SEGED THEN JUMPCHKNX; 70576000 + LASTXO ~ LASTX; FIRSTXO ~ FIRSTX; FIRSTMTO ~ FIRSTMT; 70577000 + LASTX ~ FIRSTX ~ FIRSTMT ~ -1; 70578000 + X~L; % THIS STORES THE STARTING L FOR SEPARATED COMPILING70578100 + 70579000 + IF KLASS ! PROCID THEN 70580000 + BEGIN 70581000 + JUMPCHKX; %GOT TO INITIALIZE THE VALUE CELL 70582000 + EMIT(ZERO); 70583000 + IF KLASS = DPPROCID THEN EMIT(XTND) ELSE 70584000 + IF KLASS = REFPROCID THEN 70585000 + BEGIN EMITNUM(5); EMIT(STAG) END 70586000 + END; 70587000 + LASTINDEX ~ LASTNOT ~ 0; 70588000 + P~NEXTADDL; 70588500 + NINFOO ~ NEXTINFO; 70589000 + CQAO ~ COUNTQALG; COUNTQALG ~ STARTNSQ; 70589100 + Y ~ STACKTOP[CURRENT - 1]; 70590000 + IF BLOCKED THEN 70591000 + BEGIN 70592000 + BEGINCTR ~ BEGINCTR + 1; 70593000 + DECLARATIONS; 70594000 + FIRSTATEMENT; 70596000 + 70597000 + COMPOUNDTAIL; 70598000 + IF SVINFO THEN 70598100 + BEGIN 70598150 + WRITEFILE(INFF,INFO,NINFOO,NEXTINFO-1); 70598200 + WRITEFILE(INFF,ADDL,P,NEXTADDL-1); 70598250 + INFD[(INFDX~INFDX+2).LINKR,INFDX.LINKC] ~ 70598300 + (GTI1~(NEXTINFO-NINFOO+29)DIV 30+INFFX)& 70598350 + INFFX[18:33:15]; 70598400 + INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC] ~ 70598450 + (NEXTINFO-1)&NINFOO[18:33:15]& 70598500 + (NINFOO-STARTINFO)[3:33:15]; 70598550 + INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC] ~ 70598600 + (NEXTADDL-1)&P[18:33:15]& 70598650 + (P-STARTADDL)[3:33:15]; 70598700 + INFFX~(NEXTADDL-P+29) DIV 30 + GTI1; 70598750 + END; 70598900 + END ELSE 70600000 + BEGIN 70601000 + FIRSTATEMENT; 70601100 + STATEMENT 70601200 + END PROCEDURE BODY; 70601300 + COMMENT SO MUCH FOR THE PROCEDURE. NOW TO CLEAN UP ALL THAT MESS; 70602000 + NINFOO ~ NINFOOO; 70603000 +COMMENT THE FOLLOWING APPLIES TO CODE AT 70616500-700; 70605000 + COMMENT IF A PROCEDURE HAD BEEN DECLARED FORWARD, WE 70606000 + MAKE A COMPLETE NEW ENTRY IN INFO AT THE ACTUAL 70607000 + DECLARATION. THE CODE JUST ABOVE HAS REMOVED THE 70608000 + DUPLICATE ENTRY, AS WELL AS THE PARAMETER ENTRIES; 70609000 + IF REAL(ARRAYDECTOG AND BOOLEAN(2*CURRENT))!0 THEN 70609150 + BEGIN 70609200 + EMIT(MKST); 70609300 + EMITN(BLOCKEXITPCW); 70609400 + EMIT(ENTR); 70609500 + ARRAYDECTOG~ARRAYDECTOG AND NOT BOOLEAN(2*CURRENT); 70609540 + END; 70609600 + IF KLASS = PROCID THEN EMIT(EXIT) ELSE 70610000 + BEGIN 70611000 + IF KLASS=REFPROCID OR KLASS=PTRPROCID OR KLASS 70612000 + =WORDPROCID THEN 70612500 + EMITPAIR(NP.ADDRESS,LODT ) ELSE 70613000 + EMITV(NP.ADDRESS); 70614000 + EMIT(RETN); 70615000 + END; 70616000 + PURGE(NEXTINFO~IF FWD THEN PROINFO ELSE PINFO); 70616500 + NEXTADDL~IF FWD THEN PADDL ELSE PADDL + NP.LINK +1; 70616700 + IF SEGED THEN 70617000 + BEGIN 70618000 + WHILE L MOD 6 ! 0 DO EMIT(NVLD); 70619000 + SEGDICT(SEGNO,TEMPADDR,L DIV 6, 0); 70620000 + SEGMENT( (IF FWD THEN PROINFO ~ FELBW.LINK 70621000 + ELSE PROINFO)+1, L DIV 6, EDOC); 70622000 + MOVECODE(TEDOC,EDOC); 70623000 + DSP~L; % THIS STORES THE LAST L FOR SEPARATED COMPLG70623500 + L ~ LO; LASTINDEX ~ LASTNOT ~ 0; 70624000 + DOUBLE(SEGNO,SEGNOO,~,SEGNOO,SEGNO); 70625000 + END ELSE 70626000 + BEGIN 70626100 + DSP~L; % THIS STORES THE LAST L OF THIS LEVEL 70626120 + IF FWD THEN PROINFO~FELBW.LINK; 70626140 + END; 70626160 + IF SAVED.[46:1] THEN 70626200 + BEGIN 70626300 + MOVECODE(EDOC,INZCODE); 70626400 + SAVEL ~ L; L ~ LO; SEGNO ~ SEGNOO; SEGNOO~ 1; 70626500 + LASTINDEX ~ LASTNOT ~ 0; 70626600 + END; 70626900 + LO ~ IF FIRSTX < 0 THEN FIRSTMT ELSE FIRSTX; 70627000 + FIRSTX ~ FIRSTXO; LASTX ~ LASTXO; 70628000 + COUNTQALG ~ CQAO; 70628100 + FIRSTMT ~ FIRSTMTO; 70629000 + SAVED ~ SAV; 70630000 + IF SEPARATOG~SEPARATOGO THEN 70630300 + EMITPCW(CURRENT,LO,STATE,SEGNOO) ELSE 70630600 + IF CURRENT = 1 THEN 70631000 + GLOBALPCW(ELBW.DISP,SEGNOO,LO,STATE) ELSE 70632000 + BEGIN 70633000 + JUMPCHKX; 70634000 + EMITPCW(CURRENT,LO,STATE,SEGNOO); 70635000 + IF FWD THEN 70635100 + BEGIN 70635150 + EMITN(TAKE(PROINFO).ADDRESS); 70635200 + EMIT(STOD); 70635250 + END; 70635300 + ENTERSEPA(((L-6)DIV 6),DSP,X); 70635500 + X ~ STACKTOP[CURRENT-1]; 70636000 + WHILE Y~Y+1{X DO EMIT(ZERO); 70637000 + END; 70638000 + PUT(TAKE(PROINFO)&LOCALTYPE[29:45:3],PROINFO); 70639000 + IF SVINFO THEN 70639100 + INFD[(GTI1+INFDX-3).LINKR,GTI1.LINKC]~PCW; 70639200 + IF SVINFOTOG THEN ELSE SVINFO~SVINFO OR SVINFOO; 70639800 + MAXDISP ~ STACKMASK[CURRENT ~ CURRENT-1].[FF]; 70640000 + END BODY OF THE PROCEDURE 70641000 + END OF THE PROCEDURE DECLARARION; 70642000 + INTEGER PROCEDURE FORMALPARAPART(Q); VALUE Q; BOOLEAN Q; 70643000 + COMMENT FORMALPARAPZRT HANDLES THE FORMAL PARAMETER LIST, VALUE 70644000 + PART, AND SPECIFICATION PART FOR PROCEDURE AND QUEUE DECS. 70645000 + Q IS TRUE FOR QUEUES. FMLPARAPART RETURNS THE NUMBER OF 70646000 + PARAMETERS, AND SVAES THAT MANY SPOTS IN ADDL. 70647000 + HE LEAVES FUNNY THINGS IN THE ELBAT WORDS IN INFO: 70648000 + THE LINK FIELD POINTS TO THE ELBAT WORD FOR THE NEXT PARAM, AND70649000 + THR LINK-FIELD-VALUE, AS APPROPRIATE, IS IN THE ADDRESS FIELD. 70650000 + THE ADDRESS FIELD IS OTHERWISE MEANINGLESS; 70651000 + BEGIN 70652000 + INTEGER MARK,PJ,T; 70653000 + LABEL ROUND, BACK ,FLUSH, ARRAI, SIMPLE; 70654000 + LABEL SIMPLENV; 70654100 + CONTEXT ~ 0; 70655000 + MARK ~ NEXTINFO; 70656000 + T ~ IF Q THEN FORMALNAMEQ ELSE FORMALNAMEP; 70657000 + DO BEGIN 70658000 +ROUND: IF STEPI ! UNKNOWNID THEN FLAG(739); 70659000 + ERRORTOG ~ TRUE; 70659100 + TB1 ~ 70660000 + ENTER(0,T,FORMALID,FALSE); 70661000 + PUT(TAKE(LASTINFO)&NEXTINFO[33:33:15],LASTINFO); 70662000 + PJ ~ PJ + 1 70663000 + END UNTIL STEPI ! COMMA; 70664000 + IF ELCLASS = COLON THEN 70665000 + BEGIN 70666000 + IF Q THEN 70667000 + IF INVISIBLE } MARK THEN FLAG(742) ELSE 70668000 + INVISIBLE ~ NEXTINFO ELSE FLAG(742); 70669000 + GO ROUND; 70670000 + END; 70671000 + NEXTADDL ~ (FORMALPARAPART ~ PJ) + NEXTADDL; 70672000 + IF ELCLASS ! RTPARN THEN 70673000 + BEGIN 70674000 + FLAG(737); 70675000 + FLUSH: WHILE ELCLASS ! SEMICOLON DO STEPIT; 70676000 + ERRORTOG ~ TRUE; 70676100 + END ELSE 70677000 + STEPIT; 70678000 + IF ELCLASS ! SEMICOLON THEN FLAG(738 ) ELSE STEPIT; 70679000 + CONTEXT ~ 1; 70680000 + T ~ IF Q THEN FORMALVALUEQ ELSE FORMALVALUEP; 70681000 + IF ELCLASS ! VALUEV THEN ELCLASS ~ TABLE(I~I-1) ELSE 70682000 + DO IF STEPI ! FORMALID THEN FLAG(747) ELSE 70683000 + IF GT1~ELBAT[I].TYPE =FORMALVALUEP OR 70683100 + GT1 = FORMALVALUEQ THEN 70683110 + BEGIN FLAG(784); ERRORTOG ~ TRUE END ELSE 70683200 + PUT(TAKE(ELBAT[I])&T[29:44:4],ELBAT[I]) 70684000 + UNTIL STEPI ! COMMA; 70685000 + BACK: MARK ~ 0; 70686000 + CONTEXT ~ 2; 70687000 + IF ELCLASS ! SEMICOLON THEN ERR(740) ELSE STEPIT; 70688000 + CONTEXT ~ 1; 70689000 + IF ELCLASS = TYPEV THEN 70690000 + BEGIN 70691000 + T ~ TAKE(ELBAT[I]).LINK ; 70692000 + IF PJ ~ TABLE(I+1) = PROCV THEN 70693000 + BEGIN T ~ T + BOOPROCID; STEPIT; GO TO SIMPLENV END; 70694000 + IF PJ = ARRAYV THEN 70695000 + BEGIN 70696000 + IF T ~ T ~ BOOARRAYID = PCID THEN FLAG(741); 70697000 + STEPIT; 70698000 + GO TO ARRAI 70699000 + END; 70700000 + IF PJ > IDMAX THEN 70701000 + BEGIN 70702000 + FLAG(741); 70703000 + WHILE ELCLASS>IDMAX AND ELCLASS!SEMICOLON DO STEPIT; 70704000 + IF ELCLASS = SEMICOLON THEN GO BACK 70705000 + END; 70706000 + T ~ T + BOOID; 70707000 + GO TO SIMPLE 70708000 + END; 70709000 + IF ELCLASS = ARRAYV THEN 70710000 + BEGIN T ~ REALARRAYID; GO TO ARRAI END; 70711000 + IF ELCLASS = PROCV THEN 70712000 + BEGIN T ~ PROCID; GO TO SIMPLENV END; 70713000 + IF ELCLASS = PITCHER THEN 70714000 + BEGIN T ~ PCID; 70714100 + SIMPLENV: COMMENT WE ARE HERE TO PROCESS SIMPLE SPECIFICATION THAT 70714200 + DISALLOW VALUE BUSINESS; 70714300 + DO IF STEPI ! FORMALID THEN FLAG(743) ELSE 70714400 + BEGIN 70714500 + IF (GT1~TAKE(ELBAT[I])).TYPE=FORMALVALUEP OR 70714600 + GT1.TYPE=FORMALVALUEQ THEN FLAG(784); 70714610 + PUT(GT1 & T [21:41:7],ELBAT[I]); 70714700 + ERRORTOG ~ TRUE 70714800 + END UNTIL STEPI ! COMMA; 70714900 + GO BACK 70715000 + END; 70715100 + IF ELCLASS = EVENTV THEN 70716000 + BEGIN 70717000 + IF TABLE(I+1) = ARRAYV THEN 70718000 + BEGIN 70719000 + T ~ EVENTARRAYID; 70720000 + STEPIT; 70721000 + ARRAI: IF STEPI ! FORMALID THEN FLAG(743) ELSE 70722000 + PUT((GT1~TAKE(ELBAT[I]))&T[21:41:7]&MARK 70723000 + [6:33:15], MARK ~ ELBAT[I].LINK); 70724000 + IF GT1.TYPE=FORMALVALUEP OR 70724100 + GT1.TYPE=FORMALVALUEQ THEN 70724110 + BEGIN FLAG(784); ERRORTOG ~ TRUE END; 70724200 + IF STEPI = COMMA THEN GO TO ARRAI; 70725000 + IF ELCLASS ! LFTBRKT THEN 70726000 + BEGIN FLAG(744); GO FLUSH END; 70727000 + PJ ~ 0; COMMENT TO COUNT DIMENSIONS; 70728000 + DO IF STEPI ! FACTOP THEN FLAG(745) ELSE PJ~PJ+170729000 + UNTIL STEPI ! COMMA; 70730000 + DO PUT((GT1~TAKE(MARK))&NEXTADDL[6:33:15],MARK) 70731000 + UNTIL MARK ~ GT1.ADDRESS = 0; 70732000 + PUTNBUMP(PJ); 70733000 + IF ELCLASS ! RTBRKT THEN 70734000 + BEGIN FLAG(746 ); GO FLUSH END; 70735000 + IF STEPI ! COMMA THEN GO BACK; 70736000 + GO TO ARRAI 70737000 + END ARRAY SPECIFICATION; 70738000 + T ~ EVENTID; 70739000 + SIMPLE: DO IF STEPI ! FORMALID THEN FLAG(743) ELSE 70740000 + PUT(TAKE(ELBAT[I])&T[21:41:7],ELBAT[I]) 70741000 + UNTIL STEPI ! COMMA; 70742000 + GO BACK 70743000 + END EVENT; 70744000 + IF ELCLASS } MINDEC THEN 70745000 + IF ELCLASS { MAXDEC THEN 70746000 + BEGIN FLAG(741); GO FLUSH END; 70747000 + END FORMAL PARAMETER PART; 70748000 +PROCEDURE READONLYARRAYDEC(SAVEBIT,TYP); VALUE SAVEBIT,TYP; 70749000 + BOOLEAN SAVEBIT; INTEGER TYP; 70750000 + COMMENT THIS CODE HANDLES VALUE ARRAY DECLARATION AS: 70751000 + SAVE VALUE ARRAY() 70752000 + INITIALIZEARRAY PROCEDURE IS CALLED TO CREATE A SEGMENT 70753000 + AND THEN APPROPRIATE PDPRT ENTRIES ARE MADE 70754000 + SAVEBIT - FOR INDICATING SAVE ARRAY 70755000 + TYP - CLASS OF IDENTIFIER TYPE; 70756000 + BEGIN 70757000 + LABEL STRT;% 70757100 + IF STEPI!ARRAYV THEN ERR(718); %ARRAY WORD MISSING 70758000 + TYP~BOOROAID+TYP; %MAKE APPROPRIATE READONLY ARRAY ID CLASS 70759000 +STRT:% 70759100 + IF STEPI!UNKNOWNID THEN ERR(719); %IDENTIFIER DECLARED BEFORE 70760000 + TB1~ENTER(0,LOCALTYPE,TYP,TRUE);%GET STACK AND MAKE INFO ENTRY70761000 + IF STEPI ! ASSNOP THEN FLAG(709); 70761100 + INITIALIZEARRAY(TYP - BOOROAID); % PASS TYPE OF INITIAL VALUE 70762000 + PDPRT[PPINX].[7:1]~1; 70763000 + PDPRT[PPINX].[8:1]~IF SAVEBIT THEN 1 ELSE 0; 70764000 + SAVESIZE~SAVESIZE+PDPRT[PPINX].[10:13]; 70764500 + PDINX~PDINX+1; 70765000 + IF STEPI=COMMA THEN GO TO STRT;% 70766000 + END READONLYARRAYDEC; 70767000 +PROCEDURE INITIALIZEARRAY(KLASS); VALUE KLASS; INTEGER KLASS; 70768000 + COMMENT INITIALIZEARRAY HANDLES THE CONSTRUCT: 70769000 + () 70770000 + WHICH IS USED IN VALUE ARRAY DECLARATION AND ARRAY DECLARATION70771000 + IT USES EDOC ARRAY FOR STORING CONSTANTS AND THEN CALLS 70772000 + SEGMENT FOR CREATING SEGMENT.IT ALSO INSERTS SOME FIELDS IN 70773000 + PDPRT ENTRY 70774000 + KLASS- CLASS OF EXPECTED VALUES(BOOV,DPV,REALV,INTV OR PTRV) 70775000 + KLASS=(READONLYARRAY IDENTIFIER CLASS)-26 OR 70776000 + (ARRAY IDENTIFIER CLASS)-20; 70777000 + BEGIN LABEL QUIT; 70778000 + INTEGER INDEX, TINDEX; 70779000 + ARRAY TEDOC[0:31,0:255]; 70780000 + DEFINE MAXNTGR=549755813887#, 70781000 + EDOCI=INDEX.[35:5],INDEX.[40:8]#; 70782000 + IF STEPI!LFTPRN THEN ERR(720); 70783000 + MOVECODE(EDOC,TEDOC); 70784000 + TAX ~ TINDEX ~ INDEX ~ 0; 70785000 + FILLDATA(0); 70786000 + TINDEX ~ TAX DIV 2; 70787000 + 70788000 + DO BEGIN 70789000 + FLOG (TA[INDEX|2+1], TA[INDEX|2], 70790000 + EDOC[EDOCI]); 70791000 + END UNTIL INDEX ~ INDEX + 1 } TINDEX; 70792000 + INDEX ~ TINDEX; 70793000 + IF ELCLASS!RTPARN THEN ERR(723); %MISSING RIGHT PARANTHESIS 70808000 + PDPRT[PPINX].[23:13]~TEMPADDR; 70808500 + SEGMENT(LASTINFO+1, INDEX, EDOC); 70809000 + MOVECODE(TEDOC,EDOC); 70810000 + PDPRT[PPINX].[10:13]~INDEX; %INSERT ARRAY SIZE FIELD 70811000 + PDPRT[PPINX].[36:12]~INFO[LASTINFO.LINKR,LASTINFO.LINKC]. 70812000 + ADDRESS; 70813000 + INFO[LASTINFO.LINKR,LASTINFO.LINKC].LINK~NEXTADDL; 70814000 + PUTNBUMP(1); 70814500 + IF KLASS=DPV THEN PDPRT[PPINX].[6:1]~1; 70815000 + END INITIALIZEARRAY; 70816000 +PROCEDURE ARRAYDEC(SAVEBIT,OWNBIT,KLASS); 70817000 + VALUE SAVEBIT,OWNBIT,KLASS; 70818000 + BOOLEAN SAVEBIT,OWNBIT; 70819000 + INTEGER KLASS; 70820000 + COMMENT THIS CODE HANDLES OF ARRAY DECLARATION: 70821000 + ARRAY 70822000 + IT ALSO HANDLES THE ARRAY DECLARATION AS A WHOLE BY USING 70823000 + THE INFORMATION PASSED ON THROUGH PARAMETERS. 70824000 + SAVEBIT- FOR INDICATING SAVE ARRAY 70825000 + OWNBIT - FOR INDICATING OWN ARRAY 70826000 + KLASS - CLASS OF ARRAY IDENTIFIER TYPE; 70827000 + BEGIN LABEL LOOP,PASSRTBRKT,QUIT; 70828000 + LABEL FINI,NEXTDIM,CHECKAGAIN,SKIP; 70828500 + INTEGER CONTEX,NOOFID,TCURRENT; 70829000 + INTEGER NOOFDIMS, 70829400 + TNOOFID, %TEMPORARY FOR NOOFID 70829600 + ARRAYTYPE; 70829700 + BOOLEAN ADDRTOG, %ON MEANS ADDRESS PART IN SOURCE 70830000 + DPTOG, %ON MEANS KLASS DP OR EVENT 70830500 + ASTERIKTOG, % FIRST DIMENSION IS ASTERIK; 70830600 + MULTIDIMTOG, 70830700 + PDPRTOG; %GLOBAL SAVE ARRAY- MAKE PDPRT ENTRY 70831000 + INTEGER OL; BOOLEAN CODE; 70831100 + DEFINE SCAT=DO STEPIT UNTIL ELCLASS=COMMA OR ELCLASS=SEMICOLON70832000 + ; I~I-1; GO QUIT;#; 70833000 + DEFINE ARRAYDECPCW=7#; 70833500 + CONTEX~CONTEXT; %FUTZ UP THE SCANNER 70834000 + 70835000 + JUMPCHKX; 70836000 + TCURRENT~CURRENT; %STORES THE CURRENT LEVEL 70838000 + IF KLASS=QUEUEARRAYID THEN 70838500 + BEGIN QUEUEDEC(IF OWNBIT THEN GLOBAL ELSE CURRENT);GO FINI END;70838550 + IF OWNBIT OR (SAVEBIT AND CURRENT=0) THEN %GLOBAL SAVE ARRAY 70839000 + PDPRTOG~TRUE; 70840000 + DPTOG~KLASS=EVENTARRAYID OR KLASS=DPARRAYID; 70840500 +LOOP: 70841000 + NOOFDIMS~1; 70841100 + CONTEXT ~ NOOFID ~ 0; 70841200 + OL ~ L; CODE ~ NOT PDPRTOG; 70841300 + MULTIDIMTOG~ASTERIKTOG~ADDRTOG~FALSE; 70841500 + DO BEGIN 70842000 + IF STEPI!UNKNOWNID THEN 70843000 + BEGIN FLAG(724); SCAT END; %ID DECLARED BEFORE 70844000 + DEBLANK; %INITIALIZED ARRAY 70845000 + IF CHR="~" THEN 70846000 + BEGIN 70847000 + IF KLASS=EVENTARRAYID THEN FLAG(783); 70847500 + IF NOOFID!0 THEN %MORE THAN ONE IDENTIFIER 70848000 + BEGIN FLAG(725); SCAT END;%DECLARED BEFORE ~ 70849000 + TB1~ENTER(0,LOCALTYPE,KLASS,TRUE); 70850000 + STEPIT; 70851000 + INITIALIZEARRAY(KLASS-20); 70852000 + IF CURRENT ! 0 THEN FLAG(717); 70852100 + PDPRT[PPINX].[8:1]~REAL(SAVEBIT OR OWNBIT); 70853000 + SAVESIZE~PDPRT[PPINX].[10:13]+SAVESIZE; 70853500 + PDINX~PDINX+1; 70854000 + GO QUIT; 70855000 + END; 70856000 + NOOFID~NOOFID+1; 70856500 + IF NOT ENTER(TCURRENT,LOCALTYPE,KLASS,TRUE) THEN 70857000 + BEGIN 70858000 + INFO[LASTINFO.LINKR,LASTINFO.LINKC].LINK~NEXTADDL; 70859100 + IF CURRENT=0 AND NOT PDPRTOG THEN 70859130 + PUTNBUMP(INFO[LASTINFO.LINKR,LASTINFO.LINKC].ADDRESS) ELSE 70859160 + PUTNBUMP(1); 70859200 + IF PDPRTOG THEN 70860000 + BEGIN 70861000 + PDPRT[PPINX].[36:12]~INFO[LASTINFO.LINKR,LASTINFO. 70862000 + LINKC].ADDRESS; 70863000 + IF DPTOG THEN PDPRT[PPINX].[6:1]~1; 70864000 + 70865000 + PDPRT[PPINX].[8:1]~1; 70866000 + PDINX~PDINX+1; 70867000 + END; 70868000 + END ELSE 70869000 + ADDRTOG~TRUE; 70870000 + END 70871000 + UNTIL STEPI!COMMA; 70872000 + IF NOT ADDRTOG THEN 70872400 + IF PDPRTOG THEN PDINX~PDINX-NOOFID; 70872500 + IF ELCLASS!LFTBRKT THEN 70873000 + BEGIN FLAG(726); SCAT END; %MISSING LEET BRACKET 70874000 + CONTEXT ~ 2; 70874100 + IF ADDRTOG THEN 70875000 + BEGIN 70876000 + IF TABLE(I+1)!FACTOP THEN 70877000 + BEGIN FLAG(727); %IF YOU.KNOW WHAT IT MEANS, 70878000 + SCAT END; %IMPLEMENT IT. 70879000 + INFO[LASTINFO.LINKR,LASTINFO.LINKC].LINK~NEXTADDL; 70879100 + PUTNBUMP(1); 70879200 + STEPIT; 70879400 + IF TABLE(I+1)!RTBRKT THEN STEPIT; 70879600 + ASTERIKTOG~TRUE; 70879800 + GO CHECKAGAIN; 70880000 + END ELSE 70881000 + IF TABLE(I+1)=FACTOP THEN % [*] SPECIFICATION 70882000 + BEGIN 70882100 + IF SAVEBIT THEN FLAG(727); 70882110 + EMIT(ZERO); 70882200 + EMITNUM(5); 70882300 + EMIT(STAG); 70882400 + STEPIT; 70882600 + IF TABLE(I+1)!RTBRKT THEN STEPIT; 70882700 + ASTERIKTOG~TRUE; 70882750 + GO CHECKAGAIN; 70882800 + END ELSE 70883000 + IF TABLE(I+1)=NUMBER AND TABLE(I+2)=RTBRKT AND PDPRTOG THEN 70883100 + BEGIN 70883200 + DO BEGIN 70883400 + 70883500 + PDPRT[PPINX].[10:13]~THI; 70883600 + PDINX~PDINX+1; 70883700 + SAVESIZE~SAVESIZE+THI; 70883750 + END 70883800 + UNTIL (NOOFID~NOOFID-1)=0; 70883900 + IF TABLE(I+2) ! RTBRKT THEN FLAG(728); 70883910 + GO PASSRTBRKT; 70883930 + END ELSE 70883960 + BEGIN %[AEXP] SPECIFICATION 70884000 + IF SAVEBIT AND CURRENT = 0 THEN FLAG(727); 70884100 + EMIT(ZERO); 70885000 +NEXTDIM: 70885500 + STEPIT; 70886000 + EXPRESSION(ITYPE); %INTEGER=AEXP ON TOP OF STACK 70887000 + CODE ~ TRUE; 70888000 +CHECKAGAIN: 70889050 + IF TABLE(I)=COMMA AND TABLE(I+1)!RTBRKT THEN 70889100 + BEGIN 70889150 + NOOFDIMS~NOOFDIMS + 1; 70889200 + IF TABLE(I+1)!FACTOP THEN 70889300 + BEGIN 70889400 + MULTIDIMTOG~TRUE; 70889500 + GO NEXTDIM; 70889600 + END ELSE 70889620 + BEGIN 70889640 + STEPIT; 70889660 + STEPIT; 70889670 + IF ASTERIKTOG THEN GO CHECKAGAIN 70889680 + ELSE 70889682 + BEGIN 70889684 + MULTIDIMTOG~TRUE; 70889686 + NOOFDIMS~1; 70889687 + END; 70889688 + END; 70889690 + END ELSE 70889700 + IF NOT MULTIDIMTOG AND NOT ASTERIKTOG THEN 70889800 + BEGIN 70889900 + EMITR(39,20); %INSERT SIZE FIELD 70890000 + EMITNUM(5); %5 ON TOP OF STACK 70891000 + EMIT(STAG); %SET TAG FIELD 70892000 + END; 70892500 + END; 70893000 + IF ADDRTOG THEN GO SKIP; 70894000 + IF SAVEBIT AND CURRENT!0 THEN %LOCAL SAVE ARRAY 70895000 + IF MULTIDIMTOG THEN ARRAYTYPE~1 70896000 + ELSE EMIT1P(BSET,0); 70897000 + IF DPTOG THEN % DP OR EVENT ARRAY 70898000 + IF MULTIDIMTOG THEN ARRAYTYPE ~ ARRAYTYPE + 4 70899000 + ELSE EMIT1P(BSET,40); 70900000 + IF MULTIDIMTOG THEN 70901000 + BEGIN 70902000 + EMIT(MKST); 70902300 + EMITN(ARRAYDECPCW); 70902600 + EMITNUM(NOOFDIMS); 70903000 + EMITNUM(NOOFID); 70903100 + EMITNUM(-ARRAYTYPE); 70903200 + EMIT(ENTR); 70903300 + END; 70904000 + 70904100 +SKIP: 70904200 + NEXTADDL~NEXTADDL-NOOFID; 70904250 + TNOOFID~NOOFID; 70904270 + DO BEGIN 70904300 + IF CURRENT=0 AND NOT MULTIDIMTOG AND NOT ADDRTOG THEN70904330 + BEGIN 70904370 + EMITN(ADDL[NEXTADDL.LINKR,NEXTADDL.LINKC]); 70904400 + IF NOOFID>1 THEN EMIT(OVRN) ELSE EMIT(OVRD); 70904500 + END; 70904550 + PUTNBUMP(NOOFDIMS); 70904600 + END UNTIL (NOOFID~NOOFID-1)=0; 70904700 + IF CURRENT!0 AND NOT ADDRTOG THEN 70904900 + WHILE (TNOOFID~TNOOFID-1)>0 DO EMIT(DUPL); %DUPLICATE 70905000 +PASSRTBRKT: 70906000 + WHILE ELCLASS!RTBRKT AND ELCLASS!SEMICOLON DO STEPIT; 70907000 + IF ELCLASS=SEMICOLON THEN 70908000 + BEGIN FLAG(728); I~I-1; %MISSING RIGHT BRACKET 70909000 + SCAT END; 70910000 + QUIT: IF NOT CODE THEN L ~ OL; IF STEPI = COMMA THEN GO LOOP; 70911000 + IF ELCLASS!SEMICOLON THEN ERR(729); %MISSING SEMICOLON 70912000 + CONTEXT~CONTEX; 70913000 +FINI: END ARRAYDEC; 70914000 + PROCEDURE QUEUEDEC (LEVEL); VALUE LEVEL; INTEGER LEVEL; 70915000 +COMMENT SPACE IS OBTAINED FOR THE DESCRIPTOR AT THE HEAD OF THE QUEUE. 70916000 + CODE TO PUT ZERO (QUEUEDEC) OR A SUITABLE DESCRIPTOR(QUEUE ARAY)70917000 + IN THIS SPACE IS EMITTED 70917500 + INFO AND ADDL ENTRIES FOR THE QUEUE ARE AS FOLLOWS: 70918000 + (1) LINK IN FIRST WORD OF INFO POINTS TO ADDL. ADDRESS REFER-70919000 + ENCES A ZERO WORD IN THE STACK 70920000 + (2) THE FIRST WORD OF ADDL CONTAINS: 70921000 + ADDRESS OF LOCK CELL IN ADDRESS FIELD 70922000 + NUMBER OF ALGORITHMS IN FIELD "ALGNOF" 70923000 + NUMBER OF ITEMS IN FIELD "ITMNOF" 70924000 + SIZE OF ENTRY IN FIELD "SIZEF" 70924500 + (3) THERE IS ONE ADDL WORD PER ITEM WITH THE LINK FIELD POIN-70925000 + TING TO THE INFO ENTRY FOR THE RELEVANT ITEM 70926000 + (4) THERE IS ONE ADDL WORD PER Q ALGORITHM WITH: 70927000 + ADDRESS OF PCW IN ADDRESS FIELD 70928000 + ALGORITHM KEY IN FIELD "ALGNO" 70929000 + TYPE OF ALGORITHM IN TYPE FIELD HAVING FOLLOWING VALUES70930000 + ITYPE INTEGER ALGORITHM ID 70931000 + RTYPE REFERENCE ALGORITHM ID 70932000 + BTYPE BOOLEAN ALGORITHM ID 70933000 + PROCD UNTYPED ID 70934000 + PARAMETER DESCRIPTION IN FIELD "PARADESC" 70935000 + =0 NO PARAMETERS 70936000 + =1 ONE PARAMETER,TYPE REFERENCE - ASSOCIATED WITH 70937000 + IMPLIED FORMAL PARAMETER NAME "ENTRY" 70938000 + =2 ONE PARAMETER,TYPE INTEGER - ASSOCIATED WITH IMP-70939000 + LIED FORMAL PARAMETER NAME "INDEX" 70940000 + =3 TWO PARAMETERS THE FIRST ONE ASSOCIATED WITH 70941000 + "ENTRY" AND THE SECOND WITH "INDEX" 70942000 + IF A LINK PART IS SUPPLIED,AN INFO ENTRY OF CLASS REFERENCE, 70943000 + (QUEUEDEC) OR REFERENCE ARRAY (QUEUE ARRAY DECLARATION) 70943300 + AND ADDRESS THAT OF THE QUEUE HEAD DESCRIPTOR IS GENERATED FOR 70944000 + THE LINK IDENTIFIER. THUS NO SPACE IS RESERVED FOR THE LINK 70945000 + EACH ITEM IN THE ENTRY DESCRIPTION HAS AN INFO ENTRY OF THE 70946000 + FOLLOWING FORM: 70947000 + QINDEXF FIELD POSITION OF ITEM IN ENTRY 70948000 + DESCRIPTION 70949000 + LINK FIELD LINK TO ADDL FOR ARRAYS AND PROCE-70950000 + DURES OTHERWISE LINK TO INFO ENTRY70951000 + FOR QUEUE ID 70952000 + ADDL WORD (FOR ARRAYS ONLY) 70953000 + FIELD "NODIM" HOLDS NUMBER OF 70954000 + DIMENSIONS 70955000 + FIELD "QLINK" HOLDS LINK TO INFO 70956000 + ENTRY FOR QUEUE ID 70957000 + IF A SIZE PART IS SUPPLIED, CODE FOR BUILDING AN ABSENT, IND-70958000 + EXABLE, NON SEGMENTED DESCRIPTOR IN THE SPACE RESERVED FOR THE 70959000 + QUEUE ID IS EMITTED.NOTE POSSIBLE CONFLICT WITH ARRAY DESC. 70960000 + EACH ALGORITHM IN THE QUEUE DECLARATION HAS AN INFO ENTRY OF 70961000 + THE FOLLOWING FORM. 70962000 + PARAMETER DESCRIPTION IN FIELD "PARADESC" 70963000 + ALGORITHM KEY IN FIELD "ALGNO" 70964000 + CLASS OF QALGID 70965000 + TYPE OF ALGORIIHM IN TYPE FIELD 70966000 + FIELD STANDF CONTAINS 0 (STANDARD ALGORITHMS) OR 1 70967000 + THE CODE FOR EACH ALGORITHM IS GENERATED BY CALLS ON EXPRESSION 70968000 + OR STATEMENT. THIS IS THE CODE ACCESSED BY THE PCW WHOSE ADDRESS70969000 + IS IN THAT ADDL WORD OF THE QUEUE ID ASSOCIATED WITH THE 70970000 + ALGORITHM 70971000 + THE "ALGORITHM KEY" IS GENERATED AND USED AS FOLLOWS: 70972000 + (1)IF THE ALGORITHM ID IS UNKNOWN AND IF IT IS A STAND-70973000 + ARD ALGORITHM ID THEN THE ALGORITHM KEY IS 70974000 + FOUND BY THE PROCEDURE STANDSEARCH 70975000 + COUNTQALG IS SET TO STARTNSQ AT BLOCK ENTRY. 70976000 + IF THE ALGORITHM ID IS NOT STANDARD THIS COUNTER IS 70977000 + UPDATED AND USED AS THE ALGORITHM KEY 70978000 + (2)IF THE ALGORITHM ID IS KNOWN AND IF ITS PREVIOUS 70979000 + CLASS IS OTHER THAN QALGID THEN SYNTAX ERROR 70980000 + IF ITS PREVIOUS CLASS IS QALGID THEN THE 70981000 + ALGORITHM KEY IS OBTAINED FROM THE INFO ENTRY. 70982000 + IF THIS ALGORITHM KEY MATCHES THAT IN ANY 70983000 + QUEUE ADDL WORD THEN SYNTAX ERROR (MULTIPLE USE OF 70984000 + ALGORITHM ID IN SAME QUEUE DECLARATION). 70985000 + OTHERWISE A NEW ADDL ENTRY FOR THE ALGORITHM IS 70986000 + MADE FOR THE QUEUE. NOTE THAT ONLY ONE INFO ENTRY 70987000 + APPEARS FOR THE QUEUE ALGORITHM ID (AT ANY GIVEN 70988000 + LEVEL) NO MATTER HOW MANY QUEUE DECLARATIONS USE 70989000 + THAT ALGORITHM ID 70990000 + THE LOCKED ALGORITHM IS HANDLED DIFFERENTLY. NO CODE IS GENER 70990100 + -ATED AND THE ONLY ACTIONS ARE TO GET SPACE FOR THE LOCK CELL 70990200 + (WHEN NECESSARY) AND TO PLACE THE ADDRESS OF THE SPACE IN THE 70990300 + FIRST WORD OF ADDL FOR THE QUEUE 70990400 + NOTE THAT QUEUE ARRAYS ARE HANDLED ESSENTIALLY AS QUEUE VARABLES70991000 + NOTE ALSO THAT A QUEUE ARRAY DECLARATION WITHOUT A LINK PART 70992000 + DOES NOT MEAN MUCH AND THAT A SIZE PART WITHIN A QUEUE DECLAR- 70993000 + ATION IS RATHER STRANGE; 70994000 +COMMENT *** THE FOLLOWING FACILITIES HAVE NOT YET BEEN IMPLEMENTED: 70995000 + (1) OWN QUEUES; 70996000 + BEGIN COMMENT (MCS 1); 70997000 + LABEL FINI,RESIGN,ANOTHER,ENDALG,ENDING,ITEMS,QUIT,SIZE, 70998000 + COMPILEALG,LEAVE; 70999000 + LABEL HUNT; 70999500 + REAL ALGTYPE;% HOLDS THE TYPE OF AN ALGORITHM 71000000 + INTEGER QW, % LINK INTO INFO FOR QUEUE 71001000 + LW, % LINK INTO INFO FOR QUEUE "LINK" 71002000 + NOITEMS,% NUMBER OF ITEMS IN QUEUE 71003000 + SPAZE, % ADDRESS OF SPACE FOR Q ID 71004000 + QADDL, % LINK INTO ADDL FOR FIRST Q ADDL ENTRY 71005000 + NEXTQADDL,% RUNNING LINK INTO Q ADDL ENTRIES 71006000 + ALGCOUNT,% NO OF QUEUE ALGORITHMS 71007000 + LASTITEM,% LINK TO INFO ENTRY OF LAST ITEM 71008000 + ITEMINDEX,% INDEX OF ITEM IN ENTRY 71008500 + LOCKADDRESS;% ADDRESS OF LOCK CELL IF ANY 71009000 + INTEGER TI1,TI2; % SCRATCH; 71010000 + BOOLEAN ARAY; % TRUE IF QUEUE ARRAY 71010220 + BOOLEAN BADTOG; % TRUE WHEN BAD BOUND FOR QUEUE ARRAY 71010240 + REAL GT2,GT3; % SCRATCH RENAME GLOBAL SCRATCH 771010300 + DEFINE GT1 = QGT1#; % FIX SOME NOMENCLATURE 71010500 + INTEGER N; %SCRATCH 71010800 + DEFINE QEUEID = QUEUEID #; 71011000 + INTEGER PNEXTADDL, %ALL THESE QUANTITIES USED FOR 71012000 + PNEXTINFO, % STORING INFORMATION BEFORE 71013000 + PLASTINFO; % COMPILATION OF Q ALQORITHM 71014000 +DEFINE SPECPART = FORMALPARAPART#; 71015000 +COMMENT FOLLOWING MUST BE REMOVED LATER; 71015300 +FORMAT FMT1(" QINFO ", 10I9); 71015302 +FORMAT FMT2 ( "Q1ADDL ",10I9); 71015304 +FORMAT FMT3 (" QADDLITEM " ,10I9); 71015306 +FORMAT FMT4 (" ITEMINFO ", 10I9); 71015308 +FORMAT FMT6 (" ITEMINFO ", 10I9); 71015400 +FORMAT FMT7 ( " ITEMADDL ",10I9); 71015402 +FORMAT FMT8 (" ALGINFO " ,10I9); 71015404 +FORMAT FMT9 (10I9); 71015405 +INTEGER DT1,DT2,DT3,DT4,TEMPNO; 71015406 + DEFINE DEBUG=IF DONSBUG THEN#; 71015407 +REAL TD; 71015408 +DEFINE 71015409 +D1= DEBUG WRITE(LINE[DBL],FMT1,TD.ADDRESS,TD.CLASS,TD.TYPE,TD.LINKR, 71015410 +TD.LINKC,TEMPNO,DT1,DT2,DT3,DT4)#, 71015412 +D2= DEBUG WRITE(LINE[DBL],FMT2,TD.ADDRESS,TD.ALGNOF,TD.ITMNOF,TD.SIZEF 71015414 +,TEMPNO,DT1,DT2,DT3,DT4)#, 71015416 +D3 = DEBUG WRITE(LINE[DBL],FMT3,TD.LINK,TEMPNO,DT1,DT2,DT3,DT4)#, 71015418 +D4 = DEBUG WRITE(LINE[DBL],FMT4,TD.ADDRESS,TD.ALGNO,TD.TYPE,TD.PARADESC 71015420 +,TEMPNO,DT1,DT2,DT3,DT4)#, 71015440 +D5=D1#, 71015460 +D6 =DEBUG WRTTE(LINE[DBL],FMT6,TD.QINDEXF,TD.LINK,TEMPNO,DT1,DT2,DT3, 71015480 +TD.CLASS,TD.TYPE,DT4)#, 71015500 +D7 = DEBUG WRITE(LINE[DBL],FMT7,TD.NODIM,TD.QLINK,TEMPNO,DT1,DT2,DT3, 71015502 +DT4)#, 71015504 +D8 =DEBUG WRITE(LINE[DBL],FMT8,TD.PARADESC,TD.ALGNO,TD.CLASS,TD.TYPE, 71015506 +TD.STANDF,TEMPNO,DT1,DT2,DT3,DT4)#, 71015508 +D9 = DEBUG WRITE(LINE[DBL],FMT9,TEMPNO,DT1,DT2,DT3,DT4)#; 71015510 + 71016000 + LOCKADDRESS~INVISIBLE~ALGCOUNT~NOITEMS~0; 71017000 + ITEMINDEX~0; 71017500 + IF (ARAY~ELCLASS=ARRAYV) THEN STEPIT; 71017550 + IF ELCLASS ! UNKNOWNID THEN GO RESIGN; 71018000 + GTB1~ENTER(0,LOCALTYPE,IF ARAY THEN QUEUEARRAYID ELSE QUEUEID71019000 + ,FALSE); 71019500 + QW ~ LW ~ LASTINFO; 71020000 + TI1 ~ -CURRENT; 71021000 +COMMENT ACQUIRE INFO ENTRY FOR QID, SET UP PARAMETER TO GETSPACE FOR 71022000 + NO ADDRESS PART; 71023000 + IF TABLE(I+1) = COLON THEN 71024000 + BEGIN COMMENT (MCS 2); 71025000 +COMMENT A LINK ID IS SUPPLIED; 71026000 + STEPIT; 71027000 + IF STEPI ! UNKNOWNID THEN GO RESIGN; 71028000 + GTB1~ENTER(0,LOCALTYPE,IF ARAY THEN REFARRAYID ELSE 71029000 + REFID ,FALSE); 71029500 + LW ~ LASTINFO; 71030000 + IF ARAY THEN BEGIN INFO[LW.LINKR,LW.LINKC].LINK 71030500 + ~NEXTADDL;PUTNBUMP(1) END; 71030600 +COMMENT LINK GIVES RISE TO REFERENCE ARRAY; 71030605 + TI1 ~ CURRENT; 71031000 + BADTOG~FALSE; 71031500 +COMMENT ACQUIRE INFO ENTRY FOR LINK IO,SET UP PARAMETER TO GET-71032000 + SPACE FOR POSSIBLE ADDRESS PART; 71033000 + END MCS 2 LINK PART; 71034000 + INFO[QW.LINKR,QW.LINKC].ADDRESS 71035000 + ~SPAZE~IF ARAY THEN QARRAYBOUND(TI1,BADTOG) ELSE 71036000 + EMITDESC(TI1); 71036300 + IF BADTOG THEN BEGIN FLAG(753);GO RESIGN END; 71036800 +COMMENT QARRAYBOUND GOBBLES UP ARRAYBOUND AND BUILDS DESCRIPTOR, 71036803 + EMITSPACE MERELY LEAVES HOLE IN STACK. THERE IS AN ERROR 71036805 + IF BOUND SYNTAX INCORRECT; 71036808 + INFO[LW.LINKR,LW.LINKC].ADDRESS ~ SPAZE; 71037000 + 71037500 +COMMENT*** THE Q INFO ENTRY AND THE LINK INFO ENTRY (IF ANY) MUST HAVE 71038000 + SAME ADDRESS SUPPLIED BY GETSPACE; 71039000 + IF STEPI ! LFTPRN THEN GO QUIT; 71040000 + TI1 ~ NEXTINFO; 71041000 + 71041500 + TD~ INFO[LW.LINKR,LW.LINKC];DT1~TI1; D5; % REMOVE 71041600 + ITEMS: IF(NOITEMS~SPECPART(TRUE))>32767 THEN 71042000 + BEGIN FLAG(750); GO QUIT END; 71042500 +COMMENT *** SPECPART ANALYSES ENTRY DESCRIPTION AND RETURNS NUMBER OF 71043000 + ITEMS ENCOUNTERED. BUILDS UP CHAIN OF INFO ENTRIES CONCER- 71044000 + NING ITEMS (POINTED AT BY TI1 ). FALSE SAYS CALL IS FROM 71045000 + QUEUEDEC. INVISIBLE POINTS TO FIRST ENTRY FOR INVISIBLE IT- 71046000 + EMS AT EXIT; 71047000 + INFO[QW.LINKR,QW.LINKC].LINK~QADDL~NEXTADDL; 71048000 + IF ARAY THEN PUTNBUMP(1); 71048500 + QADDL~NEXTADDL; 71048800 + ADDL[QADDL.LINKR,QADDL.LINKC]~0;%5500 KLUDGE REMOVE 6500 71048850 + NEXTADDL~ NEXTADDL+1; 71049000 +COMMENT MUST LEAVE HOLE FOR FIRST QADDL ENTRY; 71050000 + FOR TI2~1 STEP 1 UNTIL NOITEMS DO 71051000 + BEGIN COMMENT (MCS 3) PROCESS ITEMS; 71052000 + IF TI1=INVISIBLE THEN INVISIBLE~NEXTADDL; 71052500 +COMMENT INVISIBLE POINTS TO LINK TO FIRST INVISIBLE ITEM; 71052600 + N~(IF(GT1~TAKE(TI1)).ALLBUTLINK!0 THEN GT1 ELSE 71053000 + (GT1~TAKE(TI1~GT1.LINK))).LINK; 71053500 +COMMENT *** NOTE KLUDGE FOR HOLE IN INFO.MAYBE CAN REMOVE LATER; 71053510 + 71054500 + 71055000 + 71056000 + IF(GT2~GT1.CLASS) >PTRID AND GT2{ EVENTARRAYID THEN 71057000 + BEGIN COMMENT (MCS 2A); 71058000 +COMMENT ARRAY ITEMS HAVE ADDL ENTRIES SUPPLIED BY 71059000 + SPECPART; 71060000 + GT1.LINK~GT1.ADDRESS; 71061000 + ADDL[GT1.LINKR,GT1.LINKC].QLINK~QW; 71062000 + 71062500 + END MCS 2A 71063000 + ELSE 71064000 + GT1.LINK~QW; 71065000 + IF GT2 = FORMALID THEN FLAG(900); %WCP 71065100 + ERRORTOG ~ TRUE; %WCP 71065200 +COMMENT WHEN ITEM IS OTHER THAN ARRAY 71066000 + IT REQUIRES NO ADDL AND LINKS DIRECTLY TO Q71067000 + INFO; 71068000 + GT1.QINDEXF ~ ITEMINDEX; 71069000 + GT1.ITMQAINDXF~TI2-1; 71069200 + ITEMINDEX~ITEMINDEX+(IF(GT2=DPID OR GT2=EVENTID) 71069300 + AND GT1.TYPE!FORMALNAMEQ THEN 2 ELSE 1); 71069350 +COMMENT A DOUBLE PRECISION NUMBER TAKES TWO WORDS; 71069600 + 71069650 +TD~TI1; D3; %REMOVE 71069660 + PUT(GT1,TI1); 71070000 + PUTNBUMP(TI1); 71071000 + 71071502 +COMMENT QUEUE NOW POINTS TO ITEM; 71072000 + TI1~ N; 71073000 + END MCS 3 PROCESS ITEMS; 71074000 + GT1.ITMNOF~NOITEMS; 71074500 + GT1.SIZEF~ITEMINDEX; 71074502 + ADDL[QADDL.LINKR,QADDL.LINKC]~GT1; 71074504 +COMMENT*** SIZE MUST BE AVAILABLE TO ALGORITHMS; 71074510 + LASTITEM~QADDL+NOITEMS; 71075000 +COMMENT INVISIBLE AND LASTITEM USED IN DESTROYING INVISIBLE ITEM INFO71076000 + AFTER PROCESSING ALGORITHMS; 71077000 + SIZE: IF ELCLASS=LFTBRKT THEN 71078000 + BEGIN COMMENT MCS 3A; 71079000 +COMMENT A SIZE PART WAS BEEN SPECIFID AND SO WE MUST EMIT CODE TO 71079400 + BUILD DESCRIPTOR; 71079410 +COMMENT *** THIS PROBABLY WILL NOT WORK AT GLOBAL LEVEL; 71079412 + STEPIT; 71079415 + EMIT(ZERO); 71079600 + EXPRESSION(ITYPE); 71079800 + IF ITEMINDEX>1 THEN BEGIN COMMENT MCS 3B; 71079850 + EMITNUM(ITEMINDEX); 71080000 + 71080200 +COMMENT THE SIZE OF AN ENTRY IS NOW ON TOP OF THE STACK AND 71080300 + THE REQUIRED NUMBER OF ENTRIES IS THE SECOND WORD IN 71080310 + THE STACK; 71081000 + EMIT(MULT) END MCS 3B; 71081500 +COMMENT WE NOW HAVE THE SIZE OF THE REQUIRED AREA ON TOP OF THE71081600 + STACK; 71081610 + EMITR(39,20); 71082000 + EMITNUM(5); 71082500 + EMIT (STAG); 71083000 +COMMENT WE NOW HAVE AN ABSENT,INDEXABLE DATA DESCRIPTOR ON TOP 71083100 + OF THE STACK. WE MUST NOW STORE IT AT HOLE POINTED AT 71083110 + BY SPAZE; 71083120 + EMITN(SPAZE); EMIT (OVRD); 71084000 + IF ELCLASS=RTBRKT THEN STEPIT ELSE GO HUNT; 71084500 +COMMENT *** IS THIS CODE O.K.; 71085000 + END MCS 3A SIZE PART PROCESSING; 71086000 + 71086500 + IF ELCLASS!USINGV THEN GO TO ENDING ELSE 71087000 + BEGIN COMMENT (MCS 4); 71088000 +COMMENT AT THIS POINT WE PROCESS ALGORITHM PART; 71089000 + NEXTQADDL ~ NEXTADDL; 71090000 + ANOTHER: 71091000 + IF STEPI=LOCKEDV THEN 71092000 + BEGIN COMMENT MCS 3A; 71092300 +COMMENT WE HAVE A LOCKING SPECIFICATION; 71092350 + 71092355 + IF STEPI=WITHV THEN 71092400 + BEGIN COMMENT MCS 3B; 71092500 + CONTEXT~2; 71092600 + 71092650 + IF STEPI!QUEUEID AND ELCLASS!QUEUEARRAYID 71092700 + OR ELCLASS=UNKNOWNID 71092750 + THEN BEGIN FLAG(751);GO LEAVE END; 71092780 + GT1~TAKE(ELBAT[I]).LINK; 71092800 + LOCKADDRESS~ GIT(IF ELCLASS=QUEUEID THEN71092900 + GT1 ELSE GT1+1).ADDRESS; 71092950 +COMMENT *** THE FIRST WORD OF ADDL FOR A QUEUE ARRAY71092980 + CONTAINS INFORMATION ON BOUNDS; 71092985 + IF LOCKADDRESS=0 THEN 71093000 + BEGIN FLAG(751);GO LEAVE END; 71093050 +COMMENT THE REFERENCED QUEUE DOES NOT HAVE LOCK;71093055 + CONTEXT~0; 71093080 + 71093085 + STEPIT; 71093088 + END MCS 3B 71093100 + ELSE 71093200 + LOCKADDRESS~EMITSPACE(-CURRENT); 71093300 +COMMENT A NEW LOCK CELL IS REQUIRED; 71093305 + 71093350 + ADDL[QADDL.LINKR,QADDL.LINKC].ADDRESS 71093355 + ~LOCKADDRESS; 71093357 +COMMENT LOCKADDRESS MUST BE AVAILABLE TO ALGORITHMS; 71093358 + GO TO ENDALG 71093400 + END MCS 3A; 71093500 + GT1~0; %5500 FB KLUDGE REMOVE ON 6500 71093550 + ALGCOUNT ~ ALGCOUNT+1; 71093600 + 71093650 + IF ELCLASS!TOV THEN ALGTYPE~0 ELSE 71094000 + BEGIN STEPIT; ALGTYPE~PROCD END; 71095000 + IF ELCLASS = UNKNOWNID THEN 71096000 + BEGIN COMMENT (MCS 5); 71097000 +COMMENT *** THE ALGORITHM ID IS UNKNOWN, HENCE: 71098000 + (1)IT IS STANDARD Q ALG ID NOT YET USED IN ANY OTHER71099000 + Q DECLARATION AT THIS LEVEL OR 71100000 + (2)IT IS FIRST APPEARANCE AT THIS LEVEL OF NON STAN-71101000 + DARD Q ALG ID; 71102000 + TB1~ENTER(0,LOCALTYPE,QALGID,FALSE); 71103000 + GT2 ~ TAKE(LASTINFO); 71104000 + IF(N+STANDSEARCH) =63 THEN 71105000 + BEGIN COMMENT(MCS 6); 71106000 +COMMENT IT IS A NON-STANDARD ALGORITHM; 71107000 + N ~ COUNTQALG ~ COUNTQALG+ 1; 71108000 + TI2~3; GT2.STANDF~1; 71109000 + 71109050 + END MCS 6 71110000 + ELSE 71111000 + BEGIN COMMENT (MCS 7); 71112000 +COMMENT IT IS A STANDARD ALGORITHM; 71113000 + TI2 ~ GT1.ALGPD; 71114000 + GT2.TYPE~GT1.ALGTIPE; 71114500 + GT2.STANDF~0; 71115000 + 71115500 + 71116000 + END MCS 7; 71117000 + GT1.PARADESC ~ TI2; 71118000 + GT2.PARADESC ~ TI2; 71119000 + GT1.ALGNO ~ N; 71120000 + GT2.ALGNO ~ N; 71121000 + 71121500 + PUT(GT2,LASTINFO); 71122000 + GT3~LASTINFO; 71122500 +COMMENT INFO ENTRY FOR ALGORITHM NOW COMPLETE ; 71123000 + END MCS 5 UNKNOWN ID 71124000 + ELSE 71125000 + BEGIN COMMENT (MCS 8); 71126000 +COMMENT *** THE ALGORITHM IS KNOWN; 71127000 + 71127050 + GT3~(GT2~TAKE(ELBAT[I])).ALGNO; 71128000 + IF ELCLASS!QALGID THEN GO LEAVE; 71129000 +COMMENT ONLY Q ALGORITHMS MAY APPEAR MORE THAN ONCE; 71130000 + IF NEXTADDL ! NEXTQADDL THEN 71131000 + FOR TI1~NEXTQADDL STEP 1 UNTIL NEXTADDL-1 DO 71132000 + BEGIN COMMENT(MCS 9); 71133000 +COMMENT THERE HAVE BEEN PREVIOUS ALGORITHMS. MUST 71134000 + CHECK THAN NONE OF THEM HAS SAME KEY; 71135000 + IF ADDL[TI1.LINKR,TI1.LINKC].ALGNO 71136000 + = GT3 THEN 71137000 + BEGIN FLAG(713);GO LEAVE END; 71138000 + END MCS 9 ; 71139000 + TI2~GT2.PARADESC; 71139500 + GT1.ALGNO ~ GT3; 71140000 + GT2.STANDF~0; 71140500 + GT1.PARADESC~TI2; 71141000 + GT3~ELBAT[I]; 71141050 + 71141500 + END MCS 8 ; 71142000 +COMMENT WE HAVE STILL TO STORE ALGORITHM TYPE INTO QUEUE ADDL 71143000 + WORD FOR ALGORITHM AND (FOR NON-STANDARD ALGORITHMS) 71144000 + INTO ALGORITHM INFO ENTRY.FOR STANDARD ALGORITHMS WE 71145000 + CHECK THAT DECLARED AND IMPLICIT TYPES AGREE; 71146000 + GT1.TYPE~ALGTYPE~IF STEPI = IFV THEN BTYPE ELSE 71147000 + IF ELCLASS = RELOP AND ELBAT[I].DISP 71148000 + = SAME THEN RTYPE ELSE 71148100 + IF ELCLASS = RELOP AND ELBAT[I].DISP 71149000 + = EQUL THEN ITYPE ELSE 71150000 + IF ELCLASS=COMMA THEN 71151000 + ALGTYPE ELSE 0; 71152000 + 71152050 + IF (GTB1~ GT2.STANDF = 0) AND ALGTYPE!GT2.TYPE THEN 71153000 + BEGIN FLAG(714); GO LEAVE END; 71154000 + IF NOT GTB1 THEN INFO[GT3.LINKR,GT3.LINKC].TYPE 71154500 + ~ ALGTYPE; 71154530 +COMMENT FOR A NON-STANDARD ALGORITHM,THE TYPE MUST BE ENTERED; 71154560 + COMPILEALG: 71155000 + 71156000 + 71156500 + GT1.ADDRESS~INSERTPCW; 71156800 + PUTNBUMP(GT1); 71157000 + ADDL[QADDL.LINKR,QADDL.LINKC].ALGNOF~ALGCOUNT; 71158000 + 71159000 + 71160000 + IF CURRENT<31 THEN CURRENT~CURRENT+1 ELSE FLAG(627);71161000 + STACKTOP[CURRENT]~MAXSTACK[CURRENT]+2; 71161500 + 71161800 + MAXDISP ~ (GT1~STACKMASK[CURRENT]).MAXDISPF; 71162000 + LLMASK ~ GT1.LLMASKF; 71163000 + PNEXTADDL ~ NEXTADDL; PNEXTINFO ~ NEXTINFO; 71164000 + PLASTINFO ~ LASTINFO; 71165000 +COMMENT *** WHAT ELSE HAS TO BE STORED; 71166000 + CONTEXT ~ 2; 71167000 + IF TI2=1 OR TI2=3 THEN DIDDLENTER(REFID); 71168000 + 71168500 + IF TI2=2 OR TI2=3 THEN DIDDLENTER(INTID); 71169000 + 7116930071169500 + STEPIT; 71169500 +COMMENT DIDDLENTER MAKES UP INFO ENTRIES AND GETSPACE FOR 71170000 + IMPLIED PARAMETERS; 71171000 + IF ALGTYPE ! PROCD 71172000 + THEN BEGIN EXPRESSION(ALGTYPE);EMIT(RETN);END 71172200 + ELSE IF ELCLASS=BEGINV 71172400 + THEN 71173000 + BEGIN 71173200 + BEGINCTR~BEGINCTR+1; 71173400 + IF GT1~TABLE(I+1)}MINDEC AND GT1 71174000 + {MAXDEC 71174200 + THEN BEGIN 71174400 + GT1~BUMPL; 71174420 + NOJUMPTOG~TRUE; 71174422 + BLOCK; 71174430 + NOJUMPTOG~FALSE; 71174432 + EMITB(BRUN,GT1,PCL); 71174440 + EMITB(BRUN,BUMPL,GT1); 71174442 + EMITB(BRUN,GT1+7,L); 71174444 + EMIT(EXIT); 71174450 + END 71174460 + ELSE BEGIN STEPIT; COMPOUNDTAIL; 71174600 + EMIT(EXIT);END; 71174620 + END 71174700 + ELSE BEGIN STATEMENT;EMIT(EXIT);END; 71174800 + NEXTADDL ~ PNEXTADDL; NEXTINFO ~ PNEXTINFO; 71175000 + LASTINFO ~ PLASTINFO; 71176000 +COMMENT *** WHAT ELSE HAS TO BE RESTORED; 71177000 + CURRENT ~ CURRENT-1; 71178000 + MAXDISP~(GT1~STACKMASK[CURRENT]).MAXDISPF; 71179000 + LLMASK ~ GT1.LLMASKF; 71180000 + 71180452 + PURGE(NEXTINFO); 71180500 + 71180550 + CONTEXT ~ 0; 71181000 +COMMENT FINISHED EMITTING CODE FOR ALGORITHM,MUST FIX UP JUMP; 71182000 + 71183000 + ENDALG: IF ELCLASS=COLON THEN GO TO ANOTHER; 71184000 + 71184500 + END MCS 4 PROCESSING OF ALGORITHMS; 71185000 +COMMENT QUEUE IS NOW FINISHED APART FROM SOME CLEARING UP; 71186000 + ENDING: GT1.ADDRESS ~ LOCKADDRESS; 71187000 + GT1.ALGNOF ~ ALGCOUNT; 71188000 + GT1.SIZEF~ITEMINDEX; 71188500 + GT1.ITMNOF ~ NOITEMS; 71189000 + 71189500 + PUTADDL(GT1,QADDL); 71190000 +COMMENT INFO AND ADDL ENTRIES FOR QUEUE ARE NOW COMPLETE,LAST THING 71191000 + WE MUST DO IS DESTROY INFO ENTRIES FOR ANY INVISIBLE ITEMS; 71192000 + IF INVISIBLE ! 0 THEN DSTROYNVISIBLE(LASTITEM); 71193000 + 71193500 + GO FINI; 71194000 + RESIGN: 71195000 +COMMENT ILLEGAL MULTIPLE USE OF IDENTIFIERS OR BAD BOUNDS; 71196000 + FLAG (711); 71197000 + DO UNTIL STEPI = LFTPRN; 71198000 + ERRORTOG~TRUE; 71199000 + GO TO ITEMS; 71200000 + QUIT: 71201000 +COMMENT MISSING ENTRY DESCRIPTION; 71202000 + FLAG(712); 71203000 + DO UNTIL STEPI=LFTBRKT OR ELCLASS 71204000 + =USINGV; 71205000 + ERRORTOG~TRUE; 71206000 + IF ELCLASS = LFTBRKT THEN GO TO SIZE;71207000 + GO TO ANOTHER; 71208000 + LEAVE: 71209000 +COMMENT ILLEGAL MULTIPLE USE OF IDENTIFIERS; 71210000 + FLAG(711); 71211000 + IF STEPI = IFV OR ELCLASS = COMMA OR 71212000 + ELCLASS = RELOP AND 71212500 + (GT1~ELBAT[I].DISP = SAME OR GT1 = EQUL) THEN 71213000 + BEGIN ERRORTOG~TRUE; GO TO COMPILEALG END 71214000 + ELSE 71215000 + DO UNTIL STEPI = COLON OR TABLE(I+1)=SEMICOLON; 71216000 +COMMENT WHAT ELSE CAN I DO; 71217000 + IF ELCLASS= COLON THEN GO TO ANOTHER; 71218000 + GO FINI; 71218050 + HUNT: 71218100 +COMMENT MISSING RIGHT BRACKET SIZE SPEC; 71218200 + FLAG(752); 71218300 + ERRORTOG~ TRUE; 71218400 + DO UNTIL STEPI=USINGV OR ELCLASS 71218500 + =SEMICOLON OR ELCLASS=COLON; 71218600 + IF ELCLASS=COLON OR ELCLASS=USINGV 71218700 + THEN GO TO ANOTHER; 71218800 + FINI: END MCS 1 QUEUEDEC; 71219000 + INTEGER PROCEDURE QARRAYBOUND(LEVEL,BADTOG);VALUE LEVEL,BADTOG; 71220000 + INTEGER LEVEL; % PARAMETER TO GETSPACE 71220300 + BOOLEAN BADTOG; % ERROR INDICATOR 71220600 +COMMENT GOBBLES UP BOUNDS FOR QUEUE ARRAY AND BUILDS DESCRIPTOR,RETURNS 71221000 + ADDRESS OF DESCRIPTOR; 71221300 + BEGIN 71221600 + LABEL QUIT; 71222000 + LABEL FIN; 71222050 + IF STEPI! LFTBRKT THEN GO QUIT ELSE STEPIT; 71222300 + QARRAYBOUND~GT1~GETSPACE(LEVEL); 71222400 + IF ABS (LEVEL)=GLOBAL THEN 71222600 + BEGIN 71222800 + IF ELCLASS!FACTOP THEN GT1.PDPRTSIZEF~THI; 71223000 + PDPRT[PPINX]~GT1; 71223020 + PDINX~PDINX+1; 71223055 + STEPIT; 71223200 + GO FIN; 71223300 + END; 71223400 + JUMPCHKX; 71223500 + EMIT(ZERO); 71223600 + IF ELCLASS ! FACTOP THEN 71223630 + BEGIN 71223660 + EXPRESSION(ITYPE); 71224000 + EMIT(ONE); 71224300 + EMIT(ADD); 71224600 + EMITR(39,20); 71225000 + EMITNUM(5); 71225300 + END ELSE STEPIT; 71225350 + EMIT(STAG); 71225600 + FIN: 71225800 + IF ELCLASS ! RTBRKT THEN 71226000 + QUIT: BADTOG~TRUE; 71226300 + END QARRAYBOUND; 71226600 + PROCEDURE DIDDLENTER(K);VALUE K; REAL K; 71227000 +COMMENT BUILDS AN ENTRY IN INFO AND GETS SPACE FOR THE IMPLICITLY 71228000 + DECLARED QUEUE ALGORITHM FORMAL PARAMETER"ENTRY"(K IS REFID) OR 71229000 + "INDEX"(K IS REALID), RETURNS SPACE ADDRESS; 71230000 + BEGIN 71231000 + INTEGER I; 71232000 + INTEGER OCOUNT,OSCRAM; 71232500 + REAL OACCUM0,OACCUM1,OACCUM2; 71232800 + STREAM PROCEDURE DIDDLE(D,V); VALUE D,V; 71233000 +COMMENT DIDDLE TRANSFERS "ENTRY" OR "INDEX" TO ACCUM; 71234000 + BEGIN 71235000 + DI~D;DI~DI-1;SI~LOC V;SI~SI+2;DS~6 CHR 71236000 + END DIDDLE; 71237000 + ACCUM[1]~0; 71237500 + IF K=REFID THEN DIDDLE(ACCUMSTART,"5ENTRY") ELSE 71238000 + DIDDLE(ACCUMSTART,"5INDEX"); 71239000 + OCOUNT~COUNT;OSCRAM~SCRAM; 71239050 + MOVECHARACTERS(24,ACCUM,0,OACCUM0,0); 71239080 + COUNT~5; 71239500 + SCRAM ~ ACCUM[1] MOD 125; 71239800 + ACCUM[0] ~ 0; 71240000 +COMMENT *** IS THIS REALLY NECESSARY; 71241000 + 71242000 + GTB1~ENTER(0,FORMALVALUEP,K,FALSE); 71243000 + INFO[LASTINFO.LINKR,LASTINFO.LINKC].ADDRESS 71244000 + ~GETSPACE(-CURRENT); 71244300 + COUNT~OCOUNT;SCRAM~OSCRAM; 71244600 + MOVECHARACTERS(24,OACCUM0,0,ACCUM,0); 71244900 + END DIDDLENTER; 71245000 + PROCEDURE DSTROYNVISIBLE (LASTITEM); VALUE LASTITEM; INTEGER LASTITEM; 71246000 +COMMENT REMOVES INVISIBLE ITEMS FROM INFO ON FINISHING QUEUE DECLARATION71247000 + COMPILATION. THE ITEMS ARE REMOVED BY DESTROYING THE FIELDS 71248000 + CHRCNT AND ALFA IN THE SECOND WORD OF INFO.THERE MAY BE BETTER 71249000 + WAYS; 71250000 + BEGIN 71251000 + INTEGER I; 71252000 + 71252500 + FOR I ~ INVISIBLE STEP 1 UNTIL LASTITEM DO 71253000 + INFO[(GT1~GIT(I)).LINKR,GT1.LINKC+1].PARTALFA~0; 71254000 + END; 71255000 + INTEGER PROCEDURE EMITSPACE(LEVEL); VALUE LEVEL ; INTEGER LEVEL; 71256000 + BEGIN COMMENT PUTS HOLE IN STACK; 71257000 + IF ABS(LEVEL)!GLOBAL THEN BEGIN JUMPCHKX;EMIT(ZERO);END; 71258000 + EMITSPACE~GETSPACE(LEVEL); 71259000 + END EMITSPACE; 71260000 + INTEGER PROCEDURE EMITDESC(LEVEL); VALUE LEVEL;INTEGER LEVEL; 71260020 + BEGIN COMMENT PUTS NULL IN STACK; 71260040 + EMITDESC~GT1~GETSPACE(LEVEL); 71260045 + IF ABS(LEVEL)! GLOBAL 71260060 + THEN BEGIN 71260080 + JUMPCHKX; 71260100 + EMIT(ZERO); 71260120 + EMITNUM(5); 71260130 + EMIT(STAG); 71260140 + EMIT1P(BSET,47); 71260160 + END 71260180 + ELSE 71260200 + BEGIN 71260220 + GT1.[8:1]~1; 71260240 + PDPRT[PPINX]~GT1; 71260260 + PDINX~PDINX+1; 71260280 + END 71260300 + END EMITDESC; 71260320 + INTEGER PROCEDURE STANDSEARCH; 71261000 +COMMENT IF ACCUM CONTAINS A STANDARD ALGORITHM RETURNS THE ALGORITHM KEY71262000 + AND PLACES INFORMATION CONCERNING THE ALGORITHM IN GT1. OTHER- 71263000 + WISE RETURNS 63. MAX NUMBER OF STANDARD Q ALGORITHMS THUS IS 63;71264000 + BEGIN 71265000 + INTEGER I; 71266000 + DEFINE GT1 = QGT1#; %FIX UP SOME NOMENCLATURE 71266500 + LABEL ON; 71267000 + FOR I~0 STEP 1 UNTIL MAXQALG-1 DO 71268000 + BEGIN 71269000 + IF(GT1~QALGORYTHM[I]).PARTALFA = Q 71270000 + THEN IF COUNT<5 71271000 + THEN GO ON 71272000 + ELSE IF CMPCHREQL(COUNT-4,ACCUM[2],QALGORYTHM 71273000 + [I+1]) 71274000 + THEN GO ON; 71275000 + I ~ I+GT1.NOWORDS 71276000 + END; 71277000 +COMMENT NO EQUALITY; 71278000 + GT1.ALGKEY ~ 63; 71279000 + ON: STANDSEARCH ~ GT1.ALGKEY; 71280000 + END STANDSEARCH; 71281000 + 71282000 + PROCEDURE PICTUREDEC(S); VALUE S; BOOLEAN S; 72000000 + COMMENT PICTUREDEC GENERATES THE EDIT STRINGS AND OTHER GOOD STUFF 72001000 + FOR A PICTURE DECLARATION. THE PARAMETER, S, IS TRUE IF THE 72002000 + EDIT-STRING ARRAY IS SAVE. THERE IS ONE ARRAY PER DECLARATION,72003000 + SO AS TO REDUCE THE NUMBER OF DESCRIPTORS INVOLVED. 72004000 + THE INFO FOR A LOCAL-TYPE PICTURE POINTS INTO ADDL, AT A 72005000 + REPRESENTATION OF THE CODE TO BE GENERATED. IF THE FIELD 44:472006000 + CONTAINS ZERO, THE PICTURE IS IN A TABLE, 1:18 IS THE ADDRESS 72007000 + OF THE DESCRIPTOR, AND 19:24 IS THE INDEX. IF 44:4 IS NOT ZERO72008000 + THE WORD REPRESENTS A MICRO-OP FOR IN-LINE CODE. SEE 72008100 + EMITMICRO FOR THAT FORMAT. 72008200 + BIT 43 IS ON FOR THE LAST WORD OF THE ENTRY.; 72008300 + BEGIN 72009000 + LABEL INN; 72009100 + LABEL START, X, WAY,BACK; 72010000 + ALPHA CRS,CU ,CNV; 72011000 + INTEGER SZ; % PICTURES CHARACTER SIZE 72011100 + INTEGER TL, CONTEX, TSEG ; 72012000 + OWN COMMENT REMOVE WHEN UPLEVEL STUFF WORKS--MAYBE-----------;72013000 + ALPHA CHAR, NCHR,CNT; 72014000 + OWN INTEGER AD,PCINX; 72014100 + DEFINE OWNBIT = BOOLEAN(AD.[1:1])#; 72014200 + DEFINE GNCH = EXAMINE(BUMPNCR ELSE NCR)#, 72015000 + CB = CRS.[40:8]#, COMMENT BLANK ; 72016000 + CC = CRS.[32:8]#, COMMENT COMMA ; 72017000 + CM = CRS.[24:8]#, COMMENT MINUS-SIGN ; 72018000 + CN = CRS.[16:8]#, COMMENT PERIOD ; 72019000 + CP = CRS.[ 8:8]#; COMMENT PLUS-SIGN ; 72020000 + 72021000 + PROCEDURE GENMICRO(N,REPEAT,OP,P1,P2,P3); 72021010 + VALUE N,REPEAT,OP,P1,P2,P3; 72021020 + INTEGER N,REPEAT,OP,P1,P2,P3; 72021030 + COMMENT GENMICRO IS CALLED TO DECIDE WHEN TO GENERATE 72021040 + TABLE-EDIT VS IN-LINE-EDIT CODE; 72021050 + BEGIN 72021060 + DEFINE CLEANUP = IF EMITTING THEN 72021070 + EMIT(ENDE)#, 72021080 + 72021090 + EMITTING = MODE = 2#, 72021100 + FIRSTIME = MODE = 0#, 72021110 + BADNEWS = MODE = 3#, 72021120 + IDUNNO = MODE = 1#; 72021130 + REAL WORD; 72021140 + OWN REAL MODE; 72021150 + IF REPEAT < 65535 THEN 72021160 + IF REPEAT < 0 THEN REPEAT ~ 65535 ELSE ELSE FLAG(921); 72021170 + WORD ~ (OP-719)&P1[35:40:8]&P2[27:40:8]&P3[19:40:8] 72021180 + &N [17:46:2]&REPEAT[1:32:16]; 72021190 + IF N < 0 THEN 72021200 + BEGIN 72021210 + CLEANUP; 72021220 + PLACE(GIT(NEXTADDL-1)&1[43:47:1],NEXTADDL-1); 72021230 + MODE ~ 0 72021240 + END ELSE 72021250 + IF FIRSTIME OR BADNEWS OR REPEAT > 1020 THEN 72021260 + BEGIN 72021270 + CLEANUP; 72021280 + PUTNBUMP(WORD); 72021290 + MODE ~ 1 & REAL(REPEAT>1020 OR OWNBIT)[46:47:1]; 72021300 + END ELSE 72021310 + BEGIN 72021320 + IF AD = 0 THEN AD ~ SEGNO ~ NEWSEG(PCINX); 72021330 + IF MODE = 1 THEN 72021340 + BEGIN 72021350 + MODE ~ GIT(NEXTADDL ~ NEXTADDL - 1); 72021360 + PUTNBUMP(0&AD[1:30:18] & L [19:24:24]); 72021370 + EMITMICRO(MODE); 72021380 + END; 72021390 + MODE ~ 2; 72021400 + EMITMICRO(WORD); 72021410 + END; 72021420 + END GENMICRO; 72021430 + PROCEDURE REPEAT(N,OP,P1,P2,P3); 72022000 + VALUE N,OP,P1,P2,P3 ; 72023000 + INTEGER N,OP,P1,P2,P3 ; 72024000 + COMMENT REPEAT LOOKS FOR AND CONSOLIDATES MULTIPLE OCCURANCES 72025000 + OF (SOME OF THE) PICTURE CHARACTERS, SO AS TO REDUCE THE 72026000 + AMOUNT OF CODE GENERATED. IT ALSO HANDLES REPEAT PARTS, 72027000 + BY CONSOLIDATING THEM WITH THE REST. THE GLOBAL, CHAR, 72028000 + CONTAINS THE CURRENT PICTURE CHARACTER, AND CNT IS THE 72029000 + COUNTER. 72030000 + N IS THE NUMBER OF PARAMS,P|, TO BE EMITTED. 72031000 + OR IS THE OPERATOR. 72032000 + P| ARE THE PARAMETERS TO THE OPERATOR; 72033000 + BEGIN 72034000 + CNT ~ 1; 72035000 + DO IF NCHR = CHAR THEN 72036000 + BEGIN CNT ~ CNT + 1; NCHR ~ GNCH END ELSE 72037000 + IF NCHR = "(" THEN 72038000 + BEGIN 72039000 + BUMPNCR; 72040000 + IF SCAN=FACTOP THEN 72041000 + BEGIN 72041100 + IF CNT > 1 THEN GENMICRO(N,CNT-1,OP,P1,P2,P3)72041200 + ;GENMICRO(N,-1,OP,P1,P2,P3); CNT ~ 0; 72041300 + END DYNAMIC ELSE 72041400 + IF RESULT = DIGIT THEN 72042000 + BEGIN CONVERTINTO(THI,TLO); 72042100 + IF CNT ~ CNT + THI - 1 > 1048575 THEN FLAG(756) 72043000 + END ELSE FLAG(576); 72043100 + DEBLANK; 72044000 + IF CHR ! ")" THEN 72045000 + BEGIN FLAG(757); NCHR~")" END ELSE 72046000 + NCHR ~ GNCH; 72047000 + END UNTIL NCHR ! "(" AND NCHR ! CHAR; 72048000 + IF CNT>0 THEN GENMICRO(N,CNT,OP,P1,P2,P3); 72049000 + END REPEAT; 72056000 + ARRAY TEDOC[0:7,0:255]; 72057000 + CONTEX ~ CONTEXT; 72058000 + TL ~ L; 72059000 + MOVECODE(TEDOC,EDOC); 72060000 + L ~ AD ~ CONTEXT ~ 0; 72061000 + TSEG ~ SEGNO; 72061100 + IF ELBAT[I-1].CLASS = OWNV THEN AD ~ -0; 72061200 + PCINX ~ ELBAT[I].LINK + 1; 72062000 + SZ~ 6; CRS ~ "10.@3Q "; CU ~ "$"; 72063000 + START: 72064000 + IF STEPI ! UNKNOWNID THEN FLAG(758); 72065000 + TB1 ~ ENTER(AD,LOCALTYPE,PCID,FALSE); 72066000 + PUT(TAKE(LASTINFO) & NEXTADDL [33:33:15],LASTINFO); 72067000 + IF STEPI ! LFTPRN THEN 72068000 + BEGIN ERR(759); GO WAY END; 72069000 + CHAR ~ EXAMINE(NCR) ; GO INN; 72069100 + BACK: NCHR ~ GNCH; 72070000 + DO BEGIN 72071000 + CHAR ~ NCHR; 72072000 + INN: 72072100 + NCHR ~ GNCH; 72073000 + CNV ~ IF SZ= 6 THEN NCHR ELSE 72073100 + IF SZ= 8 THEN SPECIAL[NCHR].EBCDF ELSE 72073200 + IF SZ= 7 THEN SPECIAL[NCHR].ASCF ELSE 72073300 + IF NCHR > 9 THEN NCHR - 7 ELSE NCHR; 72073400 + CASE CHAR OF 72074000 + BEGIN 72075000 + GO X; GO X; GO X; GO X; COMMENT 0->3; 72075100 + BEGIN CU ~ 15; COMMENT 4 ; 72075200 + SZ~ 4; CRS ~ " $}3+!}" 72075300 + END 4; 72075400 + GO X; COMMENT 5 ; 72075500 + BEGIN CU ~ "$"; COMMENT 6 ; 72075600 + SZ ~ 6; CRS ~ "10.@3Q "; 72075700 + END 6; 72075800 + BEGIN CU ~ 36; COMMENT 7 ; 72075900 + SZ~ 7; CRS ~ "2-;@B |" 72076000 + END 7; 72076100 + BEGIN CU ~ 91; COMMENT 8 ; 72076200 + SZ~ 8; CRS ~ "4Z@H6)0" 72076300 + END 8; 72076400 + REPEAT(0,MVNU,0,0,0); COMMENT 9 ; 72077000 + GO X; GO X; GO X; COMMENT #->QUEST.; 72078000 + GENMICRO(0,0,RSTF,0,0,0); COMMENT : ; 72079000 + REPEAT(0,SFSC,0,0,0); COMMENT > ; 72080000 + GO X; GO X; COMMENT }->+; 72081000 + REPEAT(0,MCHR,0,0,0); COMMENT A ; 72082000 + BEGIN CB ~ CNV; GO BACK END; COMMENT B ; 72083000 + BEGIN CC ~ CNV; GO BACK END; COMMENT C ; 72084000 + REPEAT(2,INSC,CB,CC,0); COMMENT D ; 72085000 + REPEAT(3,MFLT,CB,CM,CP); COMMENT E ; 72086000 + REPEAT(3,MFLT,CB,CU,CU); COMMENT F ; 72087000 + GO X; GO X; COMMENT G->H; 72088000 + REPEAT(1,INSU,CN,0,0); COMMENT I ; 72089000 + GO X; GO X; GO X; COMMENT .->&; 72089500 + BEGIN ERR(922); GO WAY END; COMMENT ( ; 72090000 + REPEAT(0,SRSC,0,0,0); COMMENT < ; 72091000 + GO X; GO X; COMMENT ~->|; 72092000 + GENMICRO(2,0,ENDF,CU,CU,0); COMMENT J ; 72093000 + GO X; GO X; COMMENT K->L; 72094000 + BEGIN CM ~ CNV; GO BACK END; COMMENT M ; 72095000 + BEGIN CN ~ CNV; GO BACK END; COMMENT N ; 72096000 + GO X; COMMENT O ; 72097000 + BEGIN CP ~ CNV; GO BACK END; COMMENT P ; 72098000 + BEGIN COMMENT Q ; 72099000 + REPEAT(0,SRDC,0,0,0); 72099100 + GENMICRO(0,0,INOP,0,0,0); 72099200 + END Q; 72100000 + GENMICRO(2,0,ENDF,CM,CP,0); COMMENT R ; 72101000 + GO X; GO X; GO X; COMMENT $->-; 72102000 + BEGIN COMMENT ) ; 72103000 + GENMICRO(-1,0,0,0,0,0); 72104000 + 72105000 + BUMPNCR; 72106000 + DEBLANK; 72107000 + IF CHR = "," THEN GO START ELSE GO WAY; 72108000 + END RIGHT PAREN; 72109000 + GO X; GO X; ; GO X; COMMENT SEMI->/; 72110000 + GENMICRO(2,0,INSG,CM,CP,0); COMMENT S ; 72111000 + GO X; COMMENT T ; 72112000 + BEGIN CU ~ CNV; GO BACK END; COMMENT U ; 72113000 + GO X; GO X; COMMENT V->W; 72114000 + REPEAT(0,SFDC,0,0,0); COMMENT X ; 72115000 + GO X; COMMENT Y ; 72116000 + REPEAT(1,MINS,CB,0,0); COMMENT Z ; 72117000 + GO X; GO X; GO X; GO X; GO X; COMMENT ,->]; 72118000 + DO BEGIN COMMENT " ; 72119000 + CHAR ~ NCHR; 72120000 + CNT ~ 1; 72121000 + WHILE NCHR ~ GNCH = CHAR DO CNT ~ CNT + 1; 72122000 + IF CHAR = """ THEN 72123000 + BEGIN 72124000 + CHAR ~ CHAR & CNT [1:47:1]; 72125000 + CNT ~ CNT DIV 2 72126000 + END; 72127000 + IF CNT ! 0 THEN 72127900 + GENMICRO(1,CNT,INSU,CNV,0,0); 72128000 + CNV ~ IF SZ=6 THEN NCHR ELSE IF SZ=8 THEN 72129000 + SPECIAL[NCHR].EBCDF ELSE IF SZ=7 THEN SPECIAL 72130000 + [NCHR].ASCF ELSE IF NCHR>9 THEN NCHR-7 ELSE 72131000 + NCHR; 72131100 + END GOBBLING STRING UNTIL CHAR < 0 72132000 + END CASES OF PICTURE CHARACTERS 72133000 + END LOOP OF PICTURE ANALYZER UNTIL FALSE; 72134000 + X: COMMENT ERROR EXIT FROM CASE LOOP; 72135000 + ERR(760); 72136000 + WAY: 72137000 + ELCLASS ~ SEMICOLON; 72137100 + CONTEXT ~ CONTEX; 72138000 + IF AD ! 0 THEN 72138100 + BEGIN 72138200 + WHILE L MOD 6 = 0 DO EMIT(NVLD); 72138300 + PDPRT[PDINX.LINKR,PDINX.LINKC] ~ AD & TEMPADDR[23:35:13] 72139000 + &(L DIV 6) [10:35:13] & REAL(S) [8:47:1] 72140000 + & 4 [4:45:3]; 72141000 + PDINX ~ PDINX + 1; 72142000 + SEGNO ~ TSEG; 72142100 + SEGMENT(PCINX, L DIV 6, EDOC); 72143000 + END; 72143100 + MOVECODE(TEDOC, EDOC); 72144000 + L ~ TL 72145000 + END PICTURE DECLARATION ROUTINE; 72146000 + PROCEDURE INTERRUPTDEC; 79000000 +COMMENT HANDLES THE INTERRUPT DECLARATION WHICH HAS THE FOLLOWING : 79001000 + SYNTAX: 79002000 + ::= INTERRUPT 79003000 + ::=/, 79004000 + 79005000 + ::= INTERRUPT IDENTIFIER: 79006000 + ::=ON , 79007000 + ::= 79008000 + ; 79008500 +BEGIN 79009000 + LABEL RESIGN,AGAIN,FINI,QUIT ; 79010000 + INTEGER INTADDR %ADDRESS OF INTERRUPT 1ST WORD 79011000 + ; 79012000 + DEFINE SOFTWAREINTERRUPTDEC =14 # 79013000 + ; 79014000 +DO BEGIN 79015000 +AGAIN: 79016000 + IF STEPI!UNKNOWNID THEN FLAG(700); 79017000 + GTB1~ENTER(0,LOCALTYPE,INTERRUPTID,FALSE); 79018000 + GT1~EMITSPACE(-CURRENT); 79019000 + 79020000 +COMMENT THE FIRST WORD OF AN INTERRUPT IS INITIALLY ZERO; 79021000 + EMIT(MKST); 79022000 + EMITN(SOFTWAREINTERRUPTDEC); 79023000 +COMMENT CODE IS EMITTED FOR A CALL ON AN MCP PROCEDURE; 79024000 + IF STEPI!COLON OR STEPI ! ONV THEN GO RESIGN; 79025000 + CONTEXT~2; 79025500 + IF STEPI=ANEVENT 79026000 + THEN BEGIN EMITN (ELBAT[I].ADDRESS);EMIT(STFF);STEPIT;END 79027000 + ELSE IF VARIABLE(FP)!EVTYPE 79028000 + THEN FLAG(785) 79029000 + ELSE INDXCHK; 79030000 +COMMENT WE MUST HAVE AN EVENT DESIGNATOR OF ONE KIND OR ANOTHER. AN IRW79031000 + OR AN INDEXED 00 POINTING TO EVENT IS NOW IN STACK; 79032000 + IF ELCLASS!COMMA THEN GO QUIT ELSE STEPIT; 79033000 + EMITBUZEVENT; 79033500 + EMIT(ZERO); 79033650 +COMMENT IN TOS AT THIS POINT-POINTER TO EVENT (IRW OR INDEXED DO),FIRST79033700 + WORD OF EVENT (WITH DOUBLE TAG), ZERO; 79033750 + INFO[LASTINFO.LINKR,LASTINFO.LINKC].ADDRESS~ INTADDR~INSERTPCW;79034000 +COMMENT A PCW, REFERENCING THE NON-EXECUTABLE CODE, NOW FOLLOWS THE 79035000 + FIRST INTERRUPT WORD IN THE STACK; 79036000 + STATEMENT; 79038000 + EMIT(EXIT); 79039000 + JUMPCHKX; 79040000 + EMITN(INTADDR); STUFF; 79041000 + EMIT(ENTR); 79042000 +COMMENT THIS COMPLETES CALL UPON SOFTWAREINTERRUPTDEC. TWO PARAMETERS 79043000 + ARE PASSED BY NAME, THE FIRST ONE REFERENCING THE EVENT AND 79044000 + THE SECOND REFERENCING THE INTERRUPT PCW.THE FIRST WORD OF 79045000 + EVENT AND A HOLE FOR THE SECOND WORD ARE PASSED(SEPARATELY) BY 79045300 + VALUE; 79045600 + CONTEXT~0; 79046000 + END UNTIL ELCLASS!COMMA; 79047000 + GO FINI; 79047500 +RESIGN: COMMENT MISSING COLON OR ON; 79048000 + FLAG(786); 79049000 + ERRORTOG~TRUE; 79050000 + DO UNTIL STEPI=SEMICOLON; 79051000 + GO FINI; 79052000 +QUIT: COMMENT MISSING COMMA; 79053000 + ERRORTOG~TRUE; 79054000 + FLAG(787); 79055000 + DO UNTIL STEPI=COMMA OR ELCLASS=SEMICOLON; 79056000 + IF ELCLASS=COMMA THEN GO AGAIN; 79057000 +FINI: 79058000 +END INTERRUPTDEC; 79059000 +COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 80000000 + SYNTAX CONTROLLERS 80001000 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;80002000 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%80003000 + PROCEDURE DECLARATIONS; 80004000 + COMMENT THIS ROUTINE HANDLES THE DECLARATION LIST OF A BLOCK HEAD, 80005000 + BY EXAMINING THE DECLARATORS IN EACH, AND CALLING THE PROPER 80006000 + ROUTINE. BECAUSE OF THE POSSIBILITY OF MULTIPLE DECLARATORS IN80007000 + A DECLARATION(I.E.,"SAVE OWN REAL ARRAY"), WE USE A WIERD 80008000 + ENCODING SCHEME TO REMEMBER THE (VALID) ONES WE HAVE SEEN. 80009000 + THE BOOLEAN, SAVEBIT. IS TRUE IF WE HAVE SEEN "SAVE". THE 80010000 + INTEGER, SEEN, REMEMBERS "OWN","QUEUE","EVENT", AND : 80011000 + FOR , TYP REMEMBERS WHICH (OF "REAL","INTEGER",ETC). 80012000 + AS "OWN" IS INDEPENDENT, IT HAS A BIT BY ITSELF, THE "1" BIT. 80013000 + THE OTHERS, BEING MUTUALLY EXCLUSIVE, HAVE THE VALUES 6, 4, AND80014000 + 2, RESPECTIVELY; 80015000 + BEGIN 80016000 + BOOLEAN SAVEBIT; 80017000 + INTEGER SEEN, TYP; 80018000 + LABEL ON,ROUND,LTYPE,LEVENT,LQUE,LSAV,LOWN,LARRAY,LPROC,LFIELD,80019000 + LDEFIN,LLABEL,LLAY,LPIX,LMON,LVALUE,AWAY; 80020000 + LABEL LINTRP ; 80020500 +% SPACE FOR SWITCH DEC 80022000 + DEFINE BOTTOM = 68#; 80023000 + SWITCH DECSW ~LTYPE ,LFIELD,LARRAY,LOWN ,LDEFIN,LLABEL,LPROC ,80024000 + LSAV ,LLAY ,LEVENT,LQUE ,LINTRP,LPIX ,ON ,LMON ,LVALUE;80025000 + DEFINE CSN = IF SEEN !0THEN FLAG(801) #, 80026000 + CSB = IF SAVEBIT THEN FLAG(802)#, 80027000 + C = CSB ELSE CSN #, 80028000 + OWNBIT = BOOLEAN(SEEN)#; 80029000 + ELCLASS ~ SEMICOLON; 80030000 + ON: IF ELCLASS ! SEMICOLON THEN 80031000 + BEGIN ERR(800); GO AWAY END; 80032000 + ERRORTOG ~ TRUE; 80032100 + SEEN ~ REAL(SAVEBIT ~ FALSE); 80033000 + CONTEXT ~ 2; 80034000 + ROUND: STEPIT; CONTEXT ~ 0; 80035000 + IF SEPARATOG THEN 80035910 + IF ELCLASS!SAVEV THEN IF ELCLASS!TYPEV THEN 80035920 + IF ELCLASS!PROCV THEN BEGIN FLAG(838); GO ON END; 80035930 + GO TO DECSW[ELCLASS - BOTTOM]; 80036000 + IF ELCLASS ! UNKNOWNID THEN 80037000 + IF NOT (SEEN ! 0 OR SAVEBIT) THEN GO AWAY; 80038000 + IF SAVEBIT THEN 80039000 + BEGIN ERR(801); GO AWAY END; 80040000 + CASE SEEN OF BEGIN 80041000 + BEGIN ERR(100); GO AWAY END; % NOTHING 80042000 + BEGIN ERR(801); GO AWAY END; % OWN 80043000 + IDLIST(CURRENT,LOCALTYPE,BOOID+TYP,TYP,TRUE);% TYPE 80044000 + IDLIST(-GLOBAL,LOCALTYPE,BOOID+TYP,TYP,TRUE);% OWN TYPE 80045000 + EVENTDEC(CURRENT); % EVENT 80046000 + EVENTDEC(-GLOBAL); %OWN EVENT 80047000 + QUEUEDEC(CURRENT); % QUEUE 80048000 + QUEUEDEC(GLOBAL) % OWN QUEUE 80049000 + END CASES OF MULTIPLE DECLARATORS; 80050000 + GO ON; 80051000 + LTYPE: IF SEEN > 1 THEN FLAG(801) ELSE SEEN ~ SEEN + 2; 80052000 + TYP ~ TAKE(ELBAT[I]).LINK; 80053000 + GO ROUND; 80054000 + LEVENT: IF SEEN > 1 THEN FLAG(801) ELSE SEEN ~ SEEN + 4; 80055000 + GO ROUND; 80056000 + LQUE: IF SEEN > 1 THEN FLAG(801) ELSE SEEN ~ SEEN + 6; 80057000 + GO ROUND; 80058000 + LSAV: IF SEEN ! 0 OR SAVEBIT THEN FLAG(802); 80059000 + IF TABLE(I+1) = NUMBER THEN 80059100 + BEGIN I ~ I + 1; SAVEBIT ~ BOOLEAN(2|THI+1) END ELSE 80059200 + SAVEBIT ~ TRUE; 80060000 + GO ROUND; 80061000 + LOWN: IF SEEN!0 THEN FLAG(803) ELSE 80062000 + IF REAL(SEPARATOG)=4 THEN FLAG(840) ELSE SEEN~1; 80062500 + GO ROUND; 80063000 + LARRAY: ARRAYDEC(SAVEBIT,OWNBIT,IF SEEN{1 THEN REALARRAYID ELSE 80064000 + IF SEEN{3 THEN BOOARRAYID+TYP ELSE 80065000 + IF SEEN{5 THEN EVENTARRAYID ELSE 80066000 + QUEUEARRAYID); 80067000 + ARRAYDECTOG~ARRAYDECTOG OR BOOLEAN(2*CURRENT); 80067500 + GO ON; 80068000 + LPROC: 80069000 + IF OWNBIT THEN FLAG(803); 80070000 + IF SEEN > 3 THEN FLAG(801); 80071000 + IF SEPARATOG THEN 80071100 + IF SAVEBIT THEN 80071200 + BEGIN FLAG(839); SAVEBIT~FALSE END; 80071300 + PROCEDUREDEC(SAVEBIT,IF SEEN<2 THEN PROCID ELSE 80072000 + BOOPROCID + TYP); 80073000 + IF SEPARATOG THEN GO AWAY ELSE GO ON; 80074000 + LFIELD: 80075000 + C; FIELDEC; GO ON; 80076000 + LDEFIN: 80077000 + C; DEFINEDEC; GO ON; 80078000 +LINTRP : 80078500 + C;INTERRUPTDEC; GO ON; 80078800 + LLABEL: 80079000 + C; 80080000 + STEPIT; 80081000 + SEEN ~ NEXTINFO; 80082000 + IDLIST(0 & CURRENT[30:42:6],F0RWARD,LABELID,-1,FALSE); 80083000 + DO PUT((GT1 ~ TAKE(SEEN))&0[33:33:15],SEEN) 80084000 + UNTIL SEEN ~ GT1.LINK } NEXTINFO; 80085000 + GO ON; 80086000 + LLAY: 80087000 + C; LAYOUTDEC; GO ON; 80088000 + LPIX: 80089000 + IF SEEN > 1 THEN FLAG(801) ELSE 80090000 + IF OWNBIT AND SAVEBIT THEN FLAG(802); 80090100 + PICTUREDEC(SAVEBIT); 80090200 + GO ON; 80090300 + LMON: 80091000 + C; MERRIMAC; GO ON; 80092000 + LVALUE: 80093000 + IF OWNBIT THEN FLAG(803); 80094000 + IF SEEN > 3 THEN FLAG(801); 80095000 + IF SEEN < 2 THEN TYP ~ REALV; 80096000 + IF REAL(SEPARATOG)=4 THEN 80096300 + BEGIN FLAG(841); GO ROUND END; 80096600 + READONLYARRAYDEC(SAVEBIT,TYP); 80097000 + GO ON; 80098000 + AWAY: 80100000 + END OF DECLARATIONS; 80101000 + 80102000 + 80103000 + 80103500 + PROCEDURE STATEMENT; 80104000 + COMMENT STATEMENT HANDLES ONE OF THEM PER CALL, USUALLY BY CALLING 80105000 + THE PROPER PROCEDURE. SOME CASES, HOWEVER, IT HANDLES ITSELF, 80106000 + USUALLY BY RECURSION; 80107000 + BEGIN 80108000 + INTEGER LO; 80109000 + BOOLEAN B; 80110000 + LABEL ERROR; 80111000 + LABEL AROUND, LPROC, LABLE, SCNERR, LTPROC, LID, LARRAY, LREG, 80112000 + LQUEUE, LCASE, LBEGIN, LDO, LIF, LGO, LFOR, LWHILE, 80113000 + LDEC, AWAY, LSETID, LSCAN, LREPL; 80114000 + LABEL LQALG, LTHRU; 80114500 + LABEL LEVIN; 80114800 + DEFINE BOTTOM = 4#; 80115000 + SWITCH STMTSW~LPROC ,LABLE ,SCNERR,LTPROC,LTPROC,LTPROC,LTPROC,80116000 + LTPROC,LTPROC,LTPROC,LID ,LID ,LID ,LID ,LID ,LID ,80117000 + LID ,LARRAY,LARRAY,LARRAY,LARRAY,LARRAY,LARRAY,ERROR ,ERROR ,80118000 + ERROR ,ERROR ,ERROR ,ERROR ,LQUEUE,LREG ,LQUEUE,ERROR ,ERROR ,80119000 + ERROR ,ERROR, ERROR, LQALG ,ERROR ,LEVIN ,ERROR ,ERROR ,ERROR ,80120000 + ERROR ,LCASE ,LBEGIN,LDEC ,LDO ,LIF ,LGO ,LTHRU ,LFOR ,80121000 + LWHILE,LSCAN ,LREPL ,ERROR ,ERROR ,AWAY ,AWAY ,AWAY ,AWAY ,80122000 + SCNERR,SCNERR,ERROR ,LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,80123000 + LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,LDEC ,80123100 + LDEC ; 80123200 + AROUND: 80124000 + IF ELCLASS { IDMAX THEN 80124100 + IF ELCLASS ! LABELID THEN 80124110 + IF ELBAT[I].LINK < NINFOO THEN COMMENT TRY FOR LABEL; 80124200 + BEGIN 80124300 + MOVE(9,ACCUM[1],SCRATCH); 80124400 + IF TABLE(I+1) = COLON THEN 80124500 + BEGIN 80124600 + MOVE(9,SCRATCH,ACCUM[1]); 80124700 + COUNT ~ ACCUM[1].CHRCNT; 80124750 + IF NOT FUTZALABEL THEN GO TO LABLE 80124800 + END END; 80124900 + GO TO STMTSW[ELCLASS - BOTTOM]; 80125000 + ERROR: 80125100 + ERR(804); 80126000 + GO AWAY; 80127000 + LPROC: COMMENT PROCEDURE; 80128000 + GT1 ~ PROCALL(FALSE,XTYPE); 80129000 + GO AWAY; 80130000 + LEVIN: COMMENT EVENT INTRINSIC; 80130100 + IF GT1~TAKE(ELBAT[I]).KIND=HAPPENEDKEY OR GT1=AVAILABLEKEY 80130150 + OR GT1=SECONDWORDKEY THEN FLAG(836); 80130155 + FIXCALL~FALSE; 80130157 + EVENTINTRINSIC; 80130200 + GO AWAY; 80130250 + LQALG: COMMENT QUEUE ALGORITHM; 80130300 + QALGORITHM(0,0,FALSE); 80130310 + GO AWAY; 80130320 + LABLE: COMMENT LABELID; 80131000 + LABELR; 80132000 + GO AROUND; 80133000 + SCNERR: COMMENT SCANNER ERROR; 80134000 + ERR(101); 80135000 + GO AWAY; 80136000 + LTPROC: COMMENT TYPED PROCEDURE; 80137000 + GT1 ~ PROCALL(FALSE,XTYPE); 80138000 + COMMENT PROCALL MAY CALL VARIABLE OR GEN PROC. ENTRY; 80139000 + GO AWAY; 80140000 + LREG: COMMENT REGISTER; 80141000 + LARRAY: COMMENT ARRAY; 80142000 + LID: COMMENT VARIABLE; 80143000 + GT1 ~ VARIABLE(FS); 80144000 + GO AWAY; 80145000 + LQUEUE: COMMENT QUEUE OR QUEUE ARRAY; 80146000 + QSTMT; 80147000 + GO AWAY; 80148000 + LCASE: COMMENT "CASE"; 80149000 + CASESTMT; 80150000 + GO AWAY; 80151000 + LBEGIN: COMMENT "BEGIN"; 80152000 + BEGINCTR ~ BEGINCTR + 1; 80153000 + IF GT1 ~ TABLE(I+1) } MINDEC AND GT1 { MAXDEC THEN 80154000 + BLOCK ELSE 80155000 + BEGIN 80156000 + STEPIT; 80157000 + COMPOUNDTAIL 80158000 + END; 80159000 + GO AWAY; 80160000 + LDO: COMMENT "DO". COMPILE HERE; 80161000 + LO ~ L; STEPIT; 80162000 + STATEMENT; 80163000 + IF ELCLASS ! UNTILV THEN 80164000 + BEGIN ERR(806); GO AWAY END; 80165000 + STEPIT; 80166000 + BEXP; 80167000 + IF B ~ L = LASTNOT THEN EMITNOT; 80168000 + EMITB(IF B THEN BRTR ELSE BRFL,BUMPL,LO); 80169000 + GO AWAY; 80170000 + LIF: COMMENT "IF"; 80171000 + IFSTMT; 80172000 + GO AWAY; 80173000 + LGO: COMMENT "GO"; 80174000 + GOSTMT; 80175000 + GO AWAY; 80176000 + LFOR: COMMENT "FOR"; 80177000 + FORSTMT; 80178000 + GO AWAY; 80179000 + LTHRU: COMMENT " THRU"; 80179100 + THRUSTMT; 80179200 + GO AWAY; 80179300 + LWHILE: COMMENT "WHILE"; 80180000 + STEPIT; LO ~ L; 80181000 + BEXP; 80182000 + IF ELCLASS ! DOV THEN 80183000 + BEGIN ERR(807); GO AWAY END; 80184000 + STEPIT; 80185000 + IF LASTNOT = L THEN B ~ BOOLEAN(-L~L+2) 80186000 + ELSE B ~ BOOLEAN(BUMPL); 80187000 + STATEMENT; 80188000 + EMITB(BRUN,BUMPL,LO); 80189000 + EMITB(IF B.[1:1] THEN BRTR ELSE BRFL,ABS(REAL(B)),L); 80190000 + GO AWAY; 80191000 + LDEC: COMMENT DECLARATION; 80192000 + FLAG(805); 80193000 + LO ~ BUMPL; DECLARATIONS; 80194000 + IF L = LO THEN L ~ L - 3 ELSE 80194100 + BEGIN JUMPCHKNX; EMITB(BRUN,LO,L) END; 80194200 + GO AWAY; 80195000 +LSCAN: COMMENT "SCAN"; 80196000 + SCANSTMT; 80197000 + GO AWAY; 80198000 +LREPL: COMMENT "REPLACE"; 80200000 + REPLACESTMT; 80201000 + GO AWAY; 80201100 + AWAY: 80202000 + END THE STATEMENT ROUTINE; 80203000 + INTEGER PROCEDURE PRIMARY; 80204000 + COMMENT PRIMARY COMPILES AN ARITHMETIC OR ARRAY PRIMARY; 80205000 + BEGIN 80206000 + REAL LT1,LT2; 80207000 + LABEL ERROR, LDPROC, LAPROC, LIPROC, LDVAR, DT, LAVAR, AT, 80208000 + LIVAR, IT, LARR, LREG, LNUM, LPAREN, SUBSCRIBE, LCASE, 80209000 + SCNERR, LTYPE, DOTTY, ON, WAY; 80210000 + LABEL LQALG; 80211500 + LABEL LEVIN; 80211530 + LABEL LWPROC,WT,LWVAR; 80211550 + DEFINE BOTTOM = 6#; 80212000 + SWITCH PRIMSW~SCNERR,ERROR ,LDPROC,LAPROC,LIPROC,ERROR ,LWPROC,80213000 + ERROR ,ERROR ,LDVAR ,LAVAR , LIVAR ,LARR ,LWVAR ,LARR ,LARR ,80214000 + LARR ,LARR ,LARR ,LARR ,LARR ,ERROR ,LARR ,LARR ,LARR ,80215000 + LARR ,ERROR ,ERROR ,LREG ,ERROR ,ERROR ,ERROR ,LNUM ,LNUM ,80216000 + ERROR ,LQALG ,ERROR ,LEVIN ,ERROR ,ERROR ,ERROR ,LPAREN,LCASE ,80217000 + ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,80218000 + ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,SCNERR,SCNERR,80219000 + ERROR ,LTYPE ; 80219100 + SWITCH PROCSW ~ DT, AT, IT, ERROR, WT; 80219200 + GO TO PRIMSW[ELCLASS - BOTTOM]; 80220000 + IF ELCLASS = 0 THEN FLAG(100) ELSE 80221000 + ERROR: 80222000 + FLAG(808); 80223000 + GO WAY; 80224000 +LEVIN: COMMENT EVTNTINTRINSIC; 80224020 + IF GT1~TAKE(ELBAT[I]).KIND!SECONDWORDKEY AND 80224040 + GT1!SETKEY AND GT1!RESETKEY THEN FLAG(836); 80224050 + IF GT1=SETKEY OR GT1=RESETKEY THEN 80224055 + BEGIN PRIMARY~LT1~BITFIDDLE(GT1=SETKEY); GO SUBSCRIBE END; 80224057 + EVENTINTRINSIC; 80224060 + GO TO AT; 80224080 + LQALG: COMMENT QUEUE ALGORITHM; 80224200 + IF ELBAT[I].TYPE!ITYPE THEN GO TO ERROR; 80224210 + QALGORITHM(0,0,TRUE); 80224220 + GO TO IT; 80224230 + LDPROC: COMMENT D.P. PROC ID; 80225000 + LAPROC: COMMENT REAL PROC ID; 80228000 + LIPROC: COMMENT INTEGER PROC ID; 80231000 + LWPROC: COMMENT WORD PROCEDURE ID; 80233200 + GO TO PROCSW[GT1 ~ PROCALL(TRUE,ELCLASS-BOOPROCID)]; 80233400 +COMMENT SOME PROCEDURES CHANGE TYPE ON YOU; 80233450 + IF GT1 < 0 THEN GO TO LARR; 80233500 + GO TO ERROR; 80233600 + LDVAR: COMMENT DP ID; 80234000 + IF (GT1~VARIABLE(FP))!DTYPE AND GT1!WTYPE THEN FLAG(810); 80235000 + DT: 80236000 + PRIMARY ~ DTYPE; 80237000 + GO WAY; 80238000 + LAVAR: COMMENT REAL ID; 80239000 + IF (GT1~VARIABLE(FP))!ATYPE AND GT1!WTYPE THEN FLAG(810); 80240000 + AT: 80241000 + PRIMARY ~ ATYPE; 80242000 + GO DOTTY; 80243000 + LIVAR: COMMENT INTEGER ID; 80244000 + IF (GT1~VARIABLE(FP))!ITYPE AND GT1!WTYPE THEN FLAG(810); 80245000 + IT: 80246000 + PRIMARY ~ ITYPE; 80247000 + GO DOTTY; 80248000 + LWVAR: COMMENT WORD ID; 80248300 + GT1~VARIABLE(FP); 80248400 +WT: PRIMARY~LT1~GT1; 80248500 + GO DOTTY; 80248800 + LARR: COMMENT ARITHMETIC ARRAY ID; 80249000 + IF PRIMARY ~ VARIABLE(FP) = DTYPE THEN GO WAY ELSE GO DOTTY; 80250000 + LREG: COMMENT REGISTER ID; 80251000 + LT1 ~ ELBAT[I].ADDRESS; 80252000 + IF STEPI ! ASSNOP THEN BEGIN FLAG(815); GO WAY END; 80253000 + STEPIT; 80254000 + PRIMARY ~ AEXP; 80255000 + EMIT(DUPL); EMIT(RSDN); EMIT(LT1); 80256000 + GO ON; 80257000 + LNUM: COMMENT NUMBER; 80258000 + 80258100 + IF DPTOG THEN 80259000 + BEGIN EMITDP(THI,TLO); 80260000 + PRIMARY ~ DTYPE; 80261000 + STEPIT; 80261100 + GO WAY 80262000 + END DP; 80263000 + EMITNUMBER(THI, REAL(THIFLAG)); 80264000 + PRIMARY ~ IF THI.[1:8] = 0 THEN ITYPE ELSE ATYPE; 80265000 + STEPIT; 80266000 + GO ON; 80267000 + LCASE: COMMENT "CASE"; 80268000 + PRIMARY ~ LT1 ~ CASEXP; 80269000 + GO SUBSCRIBE; 80270000 + LPAREN: COMMENT A PARENTHETICAL EXPRESSION; 80272000 + STEPIT; 80273000 + PRIMARY ~ LT1 ~ AEXP; 80274000 + IF ELCLASS ! RTPARN THEN BEGIN FLAG(809); GO WAY END; 80275000 + STEPIT; 80275500 + COMMENT THE EXPRESSION(S) IN THE PARENS MAY HAVE BEEN INDEXABLE, 80276000 + AND MAY BE FOLLOWED HERE BY A SUBSCRIPT LIST; 80277000 + SUBSCRIBE: 80278000 + IF LT1 < XTYPE THEN 80279000 + IF ELCLASS ! LFTBRKT THEN GO DOTTY ELSE 80280000 + BEGIN COMMENT THE SUBSCRIPT LIST; 80281000 + IF GT1 ~ SUBSCRIBER(0,LT1.[CF]) ! 0 THEN 80282000 + BEGIN PRIMARY ~ LT1>1[33:CF]; 80283000 + EMIT(NXLN); GO DOTTY 80284000 + END; 80285000 + IF PRIMARY ~ LT1 ~ LT1.[FF] = RTYPE THEN 80286000 + BEGIN EMIT(INDX); EMIT(LOAD) END ELSE 80287000 + IF LT1=WTYPE THEN BEGIN EMIT(INDX);EMIT(LODT) END ELSE 80287500 + EMIT(NXLV); 80288000 + END OF SUBSCRIPTED APRAY EXPRESSION; 80289000 + IF LT1 = DTYPE THEN GO WAY ELSE GO DOTTY; 80290000 +SCNERR: COMMENT OOPS; 80291000 + FLAG(102); 80292000 + GO DOTTY; 80293000 +LTYPE: COMMENT A TYPE DECLARATOR; 80294000 + IF LT1~TAKE(ELBAT[I]).LINK > PTRV OR LT1=BOOV THEN 80295000 + BEGIN FLAG(811); STEPIT; GO TO LPAREN END; 80296000 + IF STEPI ! LFTPRN THEN 80297000 + BEGIN FLAG(812); GO WAY END; 80298000 + STEPIT; 80299000 + IF LT2 ~ EXPRSS = LT1 THEN FLAG(813) ELSE 80300000 + IF ELCLASS ! COMMA THEN 80302000 + IF LT1 = INTV THEN EMIT(NTGR) ELSE 80304000 + IF LT1 = DPV THEN EMIT(XTND) ELSE 80305000 + IF LT1 = REALV AND LT2 = DTYPE THEN EMIT(SNGL) ELSE ELSE 80306000 + BEGIN STEPIT; 80307000 + IF GT1~EXPRSSITYPE AND GT1! WTYPE 80308000 + THEN FLAG(814); 80308500 + IF LT2 = PTYPE THEN 80309000 + BEGIN 80310000 + IF LT1 = REALV THEN EMIT(SISO) ELSE 80311000 + BEGIN EMIT(ICVD); 80312000 + EMIT(IF LT1 = INTV THEN NTGR ELSE XTND) 80313000 + END END ELSE 80314000 + IF LT1 ! DPV THEN FLAG(814) ELSE 80315000 + IF GT1 = DTYPE THEN FLAG(814) ELSE EMIT(JOIN) 80316000 + END; 80317000 + PRIMARY ~ LT1; 80318000 + IF ELCLASS ! RTPARN THEN FLAG(809); STEPIT; 80319000 + IF LT1 = DTYPE THEN GO WAY; 80320000 + DOTTY: 80321000 + IF ELCLASS = PERIODV THEN 80322000 + BEGIN PRIMARY ~ATYPE; 80323000 + IF STEPI=TAGV 80323500 + THEN BEGIN EMIT(RTAG); STEPIT END ELSE 80323800 + IF GT1 ~ DOTIT = 0 THEN EMIT(DISO) ELSE 80324000 + EMITI(GT1.[36:6],GT1.[42:6]) 80325000 + END; 80326000 + ON: 80327000 + WHILE ELCLASS = AMPERSAND DO LAYITOUT(ATYPE); 80328000 + WAY: 80329000 + END PRIMARY; 80330000 + INTEGER PROCEDURE BOOPRIM; 80331000 + COMMENT THE BOOLEAN PRIMARY ROUTINE WILL COMPILE A BOOLEAN PRIMARY IF 80332000 + IT CAN: OTHERWISE, IT CONTENTS ITSELF WITH A REFERENCE, 80333000 + POINTER, OR ARITHMETIC EXPRESSION; 80334000 + BEGIN 80335000 + INTEGER T; 80336000 + REAL QATIPE; 80336500 + BOOLEAN GTB1; 80336550 + LABEL LBPROC,LBARR,LBVAR,LTRUTH,LCASE,LPAREN,LB,LTYPE,LREF, 80337000 + LPTR,LARITH,RC,DOTTY,ON,WAY,SCNERR,ERROR; 80338000 + LABEL LSETID,LSTRNG,BOOTYPE; 80339000 + LABEL LQALG; 80339500 + LABEL LWPROC,LWARR,LWVAR; 80339550 + LABEL LEVIN; 80339555 + LABEL LRARR; 80339580 + DEFINE BOTTOM = 6#; 80340000 + SWITCH BPSWCH~SCNERR,LBPROC,LARITH,LBPROC,LARITH,LREF ,LWPROC,80341000 + LPTR ,LBVAR ,LARITH,LARITH,LARITH,LREF ,LWVAR ,LPTR ,LBARR ,80342000 + LARITH,LARITH,LARITH,LRARR ,LWARR ,ERROR ,LBARR ,LARITH,LARITH,80343000 + LARITH,ERROR ,LREF ,LARITH,LREF ,LREF ,LTRUTH,LARITH,LARITH,80344000 + ERROR ,LQALG ,ERROR ,LEVIN ,ERROR ,ERROR ,ERROR ,LPAREN,LCASE ,80345000 + ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,80346000 + ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,ERROR ,SCNERR,SCNERR,80347000 + LARITH,LTYPE ; 80347100 + T ~ BTYPE; 80348000 + GO TO BPSWCH[ELCLASS - BOTTOM]; 80349000 + IF ELCLASS = UNKNOWNID THEN FLAG(100) ELSE 80350000 + ERROR: FLAG(817); 80351000 + STEPIT; GO WAY; 80352000 + SCNERR: FLAG(103); GO WAY; 80353000 + LQALG: COMMENT QUEUE ALGORITHM; 80353200 + IF (QATIPE~ ELBAT[I].TYPE)=PROCD THEN GO TO ERROR; 80353210 + IF QATIPE = ITYPE THEN GO TO LARITH; 80353230 + IF QATIPE = RTYPE THEN GO TO LREF; 80353240 +COMMENT IT IS BOOLEAN TYPE QUEUE ALGORITHM; 80353260 + QALGORITHM(0,0,TRUE); 80353270 + GO DOTTY; 80353290 + LWPROC: COMMENT WORD PROCEDURE; 80353295 + 80353298 + LBPROC: COMMENT BOOLEAN PROCEDURE; 80354000 + T ~ PROCALL(TRUE,ELCLASS-BOOPROCID); 80355000 + IF (GTB1 ~ T>BTYPE AND T 1 THEN 80439300 + FLAG(833) ELSE 80439400 + NSR: BEGIN EMITNUM(ELBW); EMITR(42,3) END ELSE 80439500 + IF ELCLASS ! FACTOP THEN 80439600 + BEGIN IF GT1 ~ PEXP(TRUE) ! PTYPE AND GT1 ! WTYPE THEN 80439700 + FLAG(833) ELSE EMITD(42,42,3); I~I-1 END; 80439750 + IF STEPI = RTPARN THEN STEPIT ELSE FLAG(830); 80439800 +XIT: 80441000 + END MAKEPOINTER; 80442000 +REAL PROCEDURE PTRPRIM(BOO); VALUE BOO; BOOLEAN BOO; %BOO IS A KLUDGE 80443000 + BEGIN LABEL FONY; 80444000 + IF ELCLASS = PTRID OR ELCLASS = WORDID THEN 80445000 + BEGIN 80446000 + IF (GT1~VARIABLE(FP)).[18:15]!PTYPE AND GT1!WTYPE 80447000 + THEN BEGIN 80447100 + IF GT1 = ITYPE THEN GT1 ~ ATYPE; 80447150 + IF BOO AND PTRPRIM ~ GT1 = ATYPE THEN 80447200 + GO FONY ELSE FLAG(822) END 80447300 + END ELSE 80448000 + IF ELCLASS}BOOPROCID AND ELCLASS{PTRPROCID THEN 80449000 + BEGIN IF GT1~PROCALL(TRUE,ELCLASS-BOOPROCID)!PTYPE 80449500 + AND GT1!WTYPE THEN FLAG(825) END ELSE 80449600 + IF ELCLASS = LFTPRN THEN 80450000 + BEGIN 80451000 + STEPIT; GT1 ~ PEXP(FALSE); 80452000 + IF ELCLASS = RTPARN THEN STEPIT ELSE FLAG(823); 80453000 + END ELSE 80454000 + IF ELCLASS = CASEV THEN 80455500 + BEGIN 80456000 + IF PTRPRIM ~ GT1 ~ CASEXP ! PTYPE OR GT1 ! WTYPE THEN 80457000 + BEGIN IF GT1=ITYPE THEN PTRPRIM~GT1~ATYPE; 80457050 + IF NOT (BOO AND GT1 = ATYPE) THEN FLAG(824); 80457100 + END; 80457150 + IF GT1 = WTYPE THEN PTRPRIM ~ PTYPE; GO FONY; 80457200 + END ELSE 80458000 + IF ELCLASS = TYPEV AND TAKE(ELBAT[I]).LINK = PTRV THEN 80459000 + MAKEPOINTER ELSE 80460000 + IF BOO THEN 80460100 + IF GT1 ~AEXP = ATYPE OR GT1 = ITYPE THEN 80460200 + BEGIN PTRPRIM~ATYPE;GO FONY END ELSE ERR(825) ELSE 80460250 + ERR(825); 80461000 + PTRPRIM ~ PTYPE; 80461050 + FONY: 80461100 + END PTRPRIM; 80462000 +PROCEDURE WRITESVINFO(DF); 80472000 + FILE DF; 80473000 +BEGIN 80473500 + LABEL DUMMY; 80473800 + AY[0]~"SVINFO"&REAL(SVINFOTOG)[1:47:1]; 80474000 + AY[1]~EXTRNLCNT&LASTEXT[18:33:15]; 80475000 + AY[2]~(INFDX+60)DIV 30 + DKADDR; 80476000 + AY[3]~STARTADDL&STARTINFO[18:33:15]; 80477000 + FOR GT1~4 STEP 1 UNTIL 29 DO AY[GT1]~0; 80478000 + WRITE(DF,30,AY[*]); 80479000 + WRITEFILE(DF,INFD,0,INFDX); 80480000 + REWIND(INFF); 80481000 + FOR GT1~1 STEP 1 UNTIL INFFX DO 80482000 + BEGIN 80483000 + READ(INFF,30,AY[*]); 80484000 + WRITE(DF,30,AY[*]); 80485000 + END; 80486000 +END OF WRITESVINFO; 80487000 +PROCEDURE GLOBALDECLARATIONS; 85000000 +COMMENT ................................................................85001000 +: THIS IS THE ROUTINE WHICH HANDLS THE GLOBAL DECLARATIONS FOR THE :85002000 +:SEPARATED COMPILATION. EXCEPT THE GLOBAL PROCEDURE DECLARATIONS, :85003000 +:WHICH SHOULD HAVE THE SAME SYNTATICAL CONSTRUCTS AS IN THE FORWARD :85004000 +:DECLARATIONS AND ARE STORED IN INFO AS LOCALTYPES, THE OTHER GLOBAL :85005000 +:DECLARATIONS SHOULD HAVE THE SAME SYNTATICAL CONSTRUCTS AS THOSE IN :85006000 +:THE FORMAL SPEC PART, AND ARE STORED IN INFO AS FORMALNAMES. :85007000 +: -------- J. C. PAO 07/16/68 --------:85008000 +:......................................................................;85009000 +BEGIN 85010000 + REAL MARK,T,PJ,GT1; 85011000 + DEFINE ENTERINFO = 85011100 + BEGIN 85011120 + IF (GLOBLCNT~GLOBLCNT+1).[16:5]>2 THEN 85011140 + FLAG(857); 85011160 + TB1~ENTER(GLOBLCNT,FORMALNAMEP,T,FALSE); 85011180 + GLOBALINDEX; 85011200 + END#; 85011210 + LABEL ON,ROUND,PROC,ARRAI,SKIP,ENTR,AWAY, 85011500 + LTYPE,LFIELD,LARRAY,LOWN,LDFN,LLBL,LPROC,LSAVE,LLAY,LEVNT, 85012000 + LQUE,LINTRP,LPIX,LMON,LVALUE; 85013000 + SWITCH LDEC~LTYPE,LFIELD,LARRAY,LOWN,LDFN,LLBL,LPROC,LSAVE,LLAY, 85014000 + LEVNT,LQUE,LINTRP,LPIX,ON,LMON,LVALUE; 85015000 + ELCLASS~SEMICOLON; 85016000 + I~I-1; 85017000 + ON: IF ELCLASS!SEMICOLON THEN ERR(851); 85018000 + ERRORTOG~TRUE; 85019000 + CONTEXT~2; 85020000 + ROUND: STEPIT; CONTEXT~0; 85021000 + GO TO LDEC[ELCLASS-TYPEV+1]; 85022000 + IF ELCLASS!BEGINV THEN 85023000 + LOWN: 85024000 + LSAVE: 85026000 + LMON: 85027000 + LVALUE: 85028000 + LQUE: 85028200 + LINTRP: 85028300 + BEGIN 85029000 + FLAG(850); 85030000 + GO ON; 85031000 + END ELSE GO AWAY; 85032000 + LTYPE: T~TAKE(ELBAT[I]).LINK; 85033000 + IF PJ~TABLE(I+1)=PROCV THEN 85034000 + BEGIN 85035000 + T~T+BOOPROCID; STEPIT; 85036000 + PROC: PROCEDUREDEC(FALSE,T); GO ON; 85037000 + END; 85038000 + IF PJ=ARRAYV THEN 85039000 + BEGIN 85040000 + IF (T~T+BOOARRAYID)>WORDARRAYID THEN FLAG(850); 85040100 + STEPIT; 85040200 + GO TO ARRAI; 85040300 + END; 85040400 + IF PJ>IDMAX THEN 85040500 + BEGIN 85040600 + FLAG(850); GO TO SKIP; 85040700 + END; 85040800 + T~T+BOOID; GO TO ENTR; 85041000 + LARRAY: T~REALARRAYID; GO TO ARRAI; 85042000 + LDFN: DEFINEDEC; GO ON; 85043000 + LLAY: LAYOUTDEC; GO ON; 85044000 + LFIELD: FIELDEC; GO ON; 85045000 + LLBL: T~LABELID; GO TO ENTR; 85048000 + LPIX: T~PCID; GO TO ENTR; 85049000 + LPROC: T~PROCID; GO TO PROC; 85054000 + LEVNT: IF TABLE(I+1)=ARRAYV THEN 85055000 + BEGIN 85056000 + T~EVENTARRAYID; 85057000 + STEPIT; 85058000 + ARRAI: MARK~0; 85059000 + DO 85060000 + IF STEPI!UNKNOWNID THEN FLAG(852) ELSE 85061000 + BEGIN 85062000 + ENTERINFO; 85063000 + PUT(TAKE(LASTINFO)&MARK[33:33:15],MARK~LASTINFO); 85064000 + END UNTIL STEPI!COMMA; 85065000 + IF ELCLASS!LFTBRKT THEN 85066000 + BEGIN 85067000 + FLAG(853); 85068000 + SKIP: WHILE ELCLASS!SEMICOLON DO STEPIT; 85069000 + GO ON; 85070000 + END; 85071000 + PJ~0; % TO COUNT DIMENSIONS OF THE ARRAYS SCANNED SO FAR.85072000 + DO IF STEPI!FACTOP THEN FLAG(854) ELSE PJ~PJ+1 85073000 + UNTIL STEPI!COMMA; 85074000 + DO PUT((GT1~TAKE(MARK))&NEXTADDL[33:33:15],MARK) 85075000 + UNTIL MARK~GT1.LINK=0; 85076000 + PUTNBUMP(PJ); 85077000 + IF ELCLASS!RTBRKT THEN 85078000 + BEGIN FLAG(855); GO SKIP END; 85079000 + IF STEPI=COMMA THEN GO TO ARRAI ELSE GO ON; 85080000 + END OF ARRAY DECLARATIONS; 85081000 + T~EVENTID; 85082000 + ENTR: DO IF STEPI!UNKNOWNID THEN FLAG(856) ELSE 85083000 + ENTERINFO 85083500 + UNTIL STEPI!COMMA; 85085000 + GO ON; 85086000 + AWAY: 85087000 +END OF GLOBALDECLARATIONS; 85088000 + 85089000 + 85090000 + 85091000 +PROCEDURE SEPARATEDCOMPILING; 85100000 +COMMENT ................................................................85101000 +: THIS IS THE ROUTINE WHICH CONTROLS THE SEPARATED COMPILING. :85102000 +: -------- J. C. PAO 07/19/68 --------:85103000 +:......................................................................;85104000 +BEGIN 85105000 + LABEL COMPILING; 85106000 +COMMENT IF SEPARATOG IS TRUE, IT IS NOT THE FIRST TIME ENTRY. THERE IS85107000 + NO GLOBAL DECLARATIONS, BUT INSTEAD, WE HAVE TO RE-INITIALIZE ALL 85108000 + THE PARAMETERS FOR THE SUCCESSIVE SEPARATED COMPILING; 85109000 + IF SEPARATOG THEN 85110000 + BEGIN 85111000 + SEPSTR[ 0]~SEPSTR[ 0]+CARDCOUNT -(CARDCOUNT ~SEPSTR[ 1]); 85112000 + SEPSTR[ 2]~SEPSTR[ 2]+SCANCOUNT -(SCANCOUNT ~SEPSTR[ 3]); 85113000 + SEPSTR[ 4]~SEPSTR[ 4]+ERRORCOUNT-(ERRORCOUNT~SEPSTR[ 5]); 85114000 + SEPSTR[ 6]~SEPSTR[ 6]+PDINX; 85115000 + SEPSTR[ 7]~SEPSTR[ 7]+TOTALSEGSIZE; 85116000 + SVINFO~SVINFOTOG; 85116500 + DKADDR~1; 85117000 + INFDX~INFFX~ 85117990 + POOLX~POOLMOM~PDINX~TOTALSEGSIZE~SEPFX~SEPAX~GT2~0; 85118000 + REWIND(SEPF); 85118500 + REWIND(INFF); 85119000 + DO TEMPSTACK[GT2]~0 UNTIL (GT2~GT2+1)>MAXTEMP; 85122000 + TIME1~TIME(1); 85124000 + TIME2~TIME(2); 85125000 + GO COMPILING; 85126000 + END; 85127000 +COMMENT THIS IS FIRST TIME ENTRY, WE HAVE TO TAKE CARE OF THE GLOBAL 85128000 + DECLARATIONS AND STORE THE PARAMETERS WHICH CONCERN THE GLOBALS; 85129000 + GINFO~NEXTINFO; 85130000 + GADDL~NEXTADDL; 85131000 + GLOBALDECLARATIONS; % THIS COMPILED THE GLOBAL DECLARATIONS 85132000 + IF (GT1~TAKE(GINFO)).CLASS=0 THEN GINFO~GT1.LINK; 85133000 + SEPSTR[ 1]~CARDCOUNT; % SEPSTR[ 0]: ACCUMULATED CARDCOUNT 85134000 + SEPSTR[ 3]~SCANCOUNT; % SEPSTR[ 2]: ACCUMULATED SCANCOUNT 85135000 + SEPSTR[ 5]~ERRORCOUNT; % SEPSTR[ 4]: ACCUMULATED ERRORCOUNT 85136000 + SEPSTR[ 8]~TIME1; 85137000 + SEPSTR[ 9]~TIME2; 85138000 + SEPARATOG~TRUE; % SEPARATED COMPILING OF THE OUTER MOST BLOCK 85139000 +COMPILING: 85140000 +COMMENT NOW WE ARE HERE TO DO SOME MORE INITIAL SETTINGS, THEN, COMES 85141000 + TO THE BIG JOB --- SEPARATED COMPILING OF THE PROCEDURE. SINCE85141100 + THE "SEPARATOG" IS TRUE, THE PROCEDURE "DECLARATIONS" WILL 85141200 + COMPILE ONLY ONE PROCEDURE AT A TIME; 85141300 + STACKTOP[0]~MAXSTACK[0]~2; 85142000 + STACKTOP[2]~MAXSTACK[2]~GLOBLCNT.[36:12]; 85143000 + DECLARATIONS; 85144000 + IF ELCLASS!SEMICOLON THEN FLAG(858); 85145000 +END OF SEPARATED COMPILING; 85146000 + FILE SPO 11(1,10); 85149000 +PROCEDURE PRINTAIL; 85150000 +BEGIN 85151000 + 85152000 + FORMAT GOOD ("||B6500 ESPOL: COMPILATION", 85153000 + *(" OF PROCEDURE ",""",*A1,A*,"""),X1,A3), 85154000 + BAD ("||B6500 ESPOL:"I4" ERRORS", 85155000 + *(" IN COMPILING PROCEDURE ",""",*A1,A*,"""), 85156000 + A1), 85157000 + NED ("NO",*(". OF")," ERRORS DETECTED", 85158000 + *("= "I4", SEE SEQ, NO. "2A4)/ 85159000 + "CORE SIZE = "I6" WORDS."X6, 85160000 + "D0-STACK SIZE = ("I6" + "I3") WORDS."/ 85161000 + "PROGRAM HAD "I6" CARD IMAGES, WITH "I7 85162000 + " SYNTACTIC ITEMS."/ 85163000 + "COMPILATION TIME WAS "F8.1" SECONDS ELAPSED," 85164000 + F8.1" SECONDS PROCESSING."/ 85165000 + " RATE WAS "F8.1" CARDS/SEC."); 85166000 + REAL STREAM PROCEDURE Z(N); VALUE N; 85167000 + BEGIN 85168000 + DI~LOC Z; DI~DI+7; SI~LOC N; DS~CHR; DI~DI-Z; DS~Z CHR; 85169000 + END OF Z; 85170000 + WRITE(LINE[DBL],NED,GT1~1&REAL(ERRORCOUNT = 0)[1:47:1], 85171000 + GT1, FOR GT2 ~ GT1 STEP -3 WHILE GT2 > 0 DO 85172000 + [ERRORCOUNT,REEL(LASTSEQUENCE+2,4), 85173000 + REEL(LASTSEQUENCE+131074,4)],CORESIZE,PDINX, 85174000 + S0,CARDCOUNT, SCANCOUNT,(TIME(1)-TIME1)/60, 85175000 + GT1 ~(TIME(2)-TIME2)/60,CARDCOUNT/GT1); 85176000 + IF ERRORCOUNT ! 0 THEN 85177000 + WRITE(SPO,BAD,ERRORCOUNT, 85178000 + GT1~1&REAL(NOT SEPARATOG)[1:47:1], 85179000 + FOR GT2~GT1 STEP -1 WHILE GT2>0 DO 85180000 + [GT4~REAL((GT3~SEPSTR[12]).[1:5]=7), 85181000 + FOR GT5~GT4 STEP -1 WHILE GT5>0 DO GT3.[6:6], 85182000 + GT3.[1:5]-GT4,Z(GT3)], 85183000 + "*") ELSE 85184000 + WRITE(SPO,GOOD, 85185000 + GT1~1&REAL(NOT SEPARATOG)[1:47:1], 85186000 + FOR GT2~GT1 STEP -1 WHILE GT2>0 DO 85187000 + [GT4~REAL((GT3~SEPSTR[12]).[1:5]=7), 85188000 + FOR GT5~GT4 STEP -1 WHILE GT5>0 DO GT3.[6:6], 85189000 + GT3.[1:5]-GT4,Z(GT3)], 85190000 + "OK~"); 85191000 + IF SEPARATOG THEN WRITE(LINE[PAGE]); 85191500 +END OF PRINT TAIL; 85192000 +PROCEDURE SEPWRAPUP; 85193000 +BEGIN 85194000 +ARRAY PRT,DIR[0:29]; 85195000 +LABEL PRNTAIL; 85196000 + IF POOLX>0 THEN FLUSHPOOL; 85197000 +COMMENT MAKE A PCW FOR THE OUTER MOST BLOCK AND PLACE IT ON THE TOP OF 85203000 + D1-STACK, THEN CONVERT THE PDPRT INTO SEGMENT DESCRIPTORS AND PLACE 85204000 + THEM INTO D1-STACK ACCORDING TO THEIR SEGMENT NUMBERS. 85205000 + NOTE: NOTHING BUT ONE SEGMENT DECRIPTOR SHOULD BE IN PDPRT[*]; 85206000 + GLOBALPCW(GETSPACE(-1).[36:12],2,0,0); 85207000 + CORESIZE~(L+5) DIV 6; 85207100 + IF ERRORCOUNT!0 THEN 85207200 + BEGIN 85207300 + CLOSE(TEMP,PURGE); 85207400 + GO TO PRNTAIL; 85207500 + END; 85207600 + PRT[DIR[4]~PDINX]~PCW; 85208000 + FOR N~0 STEP 1 WHILE N0 THEN 85216000 + BEGIN 85217000 + READ SEEK(SEPF[0]); 85218000 + DO BEGIN 85219000 + READ(SEPF,30,AY[*]); 85220000 + WRITE(TEMP,30,AY[*]); 85221000 + DKADDR~DKADDR + 1; 85222000 + READ(SEPF); 85223000 + END UNTIL (GT1~GT1-15){0 85224000 + END; 85225000 + IF SEPAX>0 THEN 85226000 + BEGIN 85227000 + WRITE(TEMP,30,SEPA[*]); 85228000 + DKADDR~DKADDR+1; 85229000 + END; 85230000 + FOR GT1~5 STEP 1 UNTIL 29 DO SEPA[GT1]~0; 85231000 + SEPA[ 0]~"SEPFILE"; 85232000 + SEPA[ 1]~SEPFX+SEPAX.[24:23]; 85233000 + SEPA[ 2]~GLOBLCNT; 85234000 + SEPA[ 3]~NEXTINFO&GINFO[18:33:15]&(DKADDR-N)[01:31:17]; 85235000 + WRITEFILE(TEMP,INFO,GINFO,NEXTINFO-1); 85236000 + DKADDR~(NEXTINFO-GINFO+29) DIV 30 + DKADDR; 85237000 + SEPA[ 4]~NEXTADDL&GADDL[18:33:15]&(DKADDR-N)[01:31:17]; 85238000 + WRITEFILE(TEMP,ADDL,GADDL,NEXTADDL-1); 85239000 + DKADDR~(NEXTADDL-GADDL+29) DIV 30 + DKADDR; 85240000 + IF SVINFO THEN 85240100 + BEGIN 85240200 + WRITESVINFO(TEMP); 85240300 + DIR[12]~DKADDR&REAL(SVINFOTOG)[1:47:1]; 85240400 + END; 85240500 + WRITE(TEMP[N],30,SEPA[*]); 85241000 + REWIND(TEMP); 85242000 + WRITE(TEMP,30,DIR[*]); 85243000 + LOCK(TEMP,RELEASE); 85244000 + IF NOT LISTOG.[46:1] THEN 85245000 + PRNTAIL: PRINTAIL; 85246000 + IF STEPI=ENDV THEN 85247000 + BEGIN 85248000 + COMPOUNDTAIL; % THIS WILL WRAP UP THE SCANNER 85249000 + IF ERRORCOUNT~SEPSTR[4]+ERRORCOUNT!0 OR 85250000 + NOT LISTOG.[46:1] THEN 85251000 + BEGIN 85252000 + CARDCOUNT ~ SEPSTR[ 0]+CARDCOUNT; 85253000 + SCANCOUNT ~ SEPSTR[ 2]+SCANCOUNT; 85254000 + PDINX ~ SEPSTR[ 6]+PDINX; 85255000 + TOTALSEGSIZE ~ SEPSTR[ 7]+TOTALSEGSIZE; 85256000 + TIME1 ~ SEPSTR[ 8]; 85257000 + TIME2 ~ SEPSTR[ 9]; 85258000 + SEPARATOG~FALSE; 85258500 + PRINTAIL; 85259000 + END ELSE 85260000 + SEPARATOG~FALSE; 85261000 + END ELSE I~I-1; 85262000 +END OF SEPWRAPUP; 85263000 + PROCEDURE EPUNCH(X,Y,A); VALUE X,Y; INTEGER X,Y; ARRAY A[0]; 85270000 + COMMENT EPUNCH IS PART OF THE WRAPUP ACTION FOR DECKTOG. IT 85271000 + TRANSLATES FROM EBCDIC CODE--FOUR BYTES PER WORD IN THE ARRAY 85272000 + A--INTO EBCDIC CARD CODE(12 BITS PER COLUMN) AS A BINARY-CARD 85273000 + IMAGE. THE GLOBAL 256-WORD ARRAY TA CONTAINS THE TRANSLATION 85274000 + TABLE; 85275000 + BEGIN 85276000 + DEFINE U=LASTUSED#, T = SETSIZE#; 85277000 + IF Y = 2 THEN X ~ X - 1; 85278000 + DO FLOG((T ~ TA[(U~ A[X]).[16:8]]).[36:1], 85279000 + TA[U.[40:8]] & TA[U.[32:8]] [24:36:12] 85280000 + & T [1:37:11] & TA[U.[24:8]] [12:36:12], A[X]) 85281000 + UNTIL X ~ X - 1 < 0; 85282000 + WRITE(DECK,20,A[*]); 85283000 + A[0] ~ 0; MOVE(19,A[0],A[1]); 85284000 + END EPUNCH; 85285000 + 89900000 + 89901000 + 89902000 +COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 90000000 + INITIALIZATION 90001000 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;90002000 +PROCEDURE PROGRAM; 90002100 +BEGIN LABEL NEXTPROCEDURE; 90002200 + TIME1~TIME(1); TIME2~TIME(2); 90003000 + BUMPWORD~229375; 90004000 + CLCR~MKABS(CBUFF[9]); 90005000 + LASTUSED~NXTELBT~1; 90006000 + LASTSEQUENCE~MKABS(SEQNUMBER); 90007000 + LISTOG~BOOLEAN(3); 90008000 + BLANKOUT(2,SEQNUMBER); 90009000 + BUMPCHAR~32768;% 90010000 + ACCUMSTART~MKABS(ACCUM[1])&4[30:45:3]; 90011000 + FILL STACKMASK[*] WITH 90012000 + OCT1777700000, 90013000 + OCT1777720000, 90014000 + OCT0777710000, 90015000 + OCT0777730000, 90016000 + OCT0377704000, 90017000 + OCT0377724000, 90018000 + OCT0377714000, 90019000 + OCT0377734000, 90020000 + OCT0177702000, 90021000 + OCT0177722000, 90022000 + OCT0177712000, 90023000 + OCT0177732000, 90024000 + OCT0177706000, 90025000 + OCT0177726000, 90026000 + OCT0177716000, 90027000 + OCT0177736000, 90028000 + OCT0077701000, 90029000 + OCT0077721000, 90030000 + OCT0077711000, 90031000 + OCT0077731000, 90032000 + OCT0077705000, 90033000 + OCT0077725000, 90034000 + OCT0077715000, 90035000 + OCT0077735000, 90036000 + OCT0077703000, 90037000 + OCT0077723000, 90038000 + OCT0077713000, 90039000 + OCT0077733000, 90040000 + OCT0077707000, 90041000 + OCT0077727000, 90042000 + OCT0077717000, 90043000 + OCT0077737000; 90044000 + TEN[0]~1.0; COMMENT STARTING TO INITIALIZE THE POWERS OF TEN; 90045000 + FOR I~1 STEP 1 UNTIL 68 DO 90046000 + DOUBLE(TEN[I-1],ELBAT[I-1],10.0,0,|,~,TEN[1],ELBAT[I]); 90047000 + FOR I~16 STEP 1 UNTIL 68 DO 90048000 + IF BOOLEAN(ELBAT[I].[9:1])THEN TEN[I].[9:39]~TEN[I].[9:39]+1; 90049000 + FILL OPS [*] WITH 90050000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90051000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90052000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90053000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90054000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90055000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90056000 + 0, 0, 0,"VALC", 0, 0, 0, 0, 0, 0, 90057000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90058000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90059000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90060000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90061000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90062000 + 0, 0, 0, 0, 0, 0, 0,"NAMC","ADD ","SUBT", 90063000 + "MULT","DIVD","IDIV","RDIV","NTIA","NTGR","LESS","GREQ","GRTR","LSEQ", 90064000 + "EQUL","NEQL","CHSN","MULX","LAND","LOR ","LNOT","LEQV","SAME","VARI", 90065000 + "BSFT","DBST","FLTR","DFTR","ISOL","DISO","INSR","DINS","BRST","DBRS", 90066000 + "BRFL","BRTR","BRUN","EXIT","STBR","NXLN","INDX","RETN","DBFL","DBTR", 90067000 + "DBUN","ENTR","EVAL","NXLV","MKST","STFF","ZERO","ONE ","LT8 ","LT16", 90068000 + "PUSH","DLET","EXCH","DUPL","STOD","STON","OVRD","OVRN", 0,"LOAD", 90069000 + "LT48","MPCW","SCLF","DSLF","SCRT","DSRT","SCRS","DSRS","SCRF","DSRF", 90070000 + "SCRR","DSRR","ICVD","ICVU","SNGT","SNGL","XTND","IMKS","TEED","PACD", 90071000 + "EXSD","TWSD","TWOD","SISO","SXSN","ROFF","TEEU","PACU","EXSU","TWSU", 90072000 + "TWOU","EXPU","RTFF","HALT","TLSD","TGED","TGTD","TLED","TEQD","TNED", 90073000 + "TUND", 0,"TLSU","TGEU","TGTU","TLEU","TEQU","TNEU","TUNU", 0, 90074000 + "CLSD","CGED","CGTD","CLED","CEQD","CNED", 0, 0,"CLSU","CGEU", 90075000 + "CGTU","CLEU","CEQU","CNEU","NOOP","NVLD", 0, 0, 0, 0, 90076000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90077000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90078000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90079000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90080000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90081000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90082000 + 0, 0,"JOIN","SPLT","IDLE","SINT","EEXI","DEXI", 0, 0, 90083000 + "SCNI","SCND", 0, 0,"WHOI","HEYU", 0, 0, 0, 0, 90084000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90085000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90086000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90087000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90088000 + 0, 0, 0, 0, 0,"NTGD", 0, 0, 0,"OCRX", 90089000 + 0, 0, 0, 0, 0,"LOG2", 0, 0, 0, 0, 90090000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90091000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90092000 + 0, 0, 0, 0, 0, 0, 0, 0, 0,"IRWL", 90093000 + "PCWL","MVST", 0, 0, 0, 0,"STAG","RTAG","RSUP","RSDN", 90094000 + "RPRR","SPRR","RDLK","CBON","LODT","LLLU","SRCH", 0, 0, 0, 90095000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90096000 + 0, 0, 0, 0,"USND","UABD","TWFD","TWTD","SWFD","SWTD", 90097000 + 0,"TRNS","USMU","UABU","TWFU","TWTU","SWFU","SWTU", 0, 0, 90098000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90099000 + 0, 0, 0, 0, 0, 0,"SLSD","SGED","SGTD","SLED", 90100000 + "SEQD","SNED", 0, 0,"SLSU","SGEU","SGTU","SLEU","SEQU","SNEU", 90101000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90102000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90103000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90104000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90105000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90106000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90107000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90108000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90109000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90110000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90111000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90112000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90113000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90114000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90115000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90116000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90117000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90118000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90119000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90120000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90121000 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90122000 + "MINS","MFLT","SFSC","SRSC","RSTF","ENDF","MVNU","MCHR","INOP","INSG", 90123000 + "SFDC","SRDC","INSU","INSC","ENDE", 90124000 + 0; 90125000 + FILL SPECIAL[*] WITH OCT0600000000170000, % 0 90128000 + OCT0610000000170400, % 1 90129000 + OCT0620000000171000, % 2 90130000 + OCT0630000000171400, % 3 90131000 + OCT0640000000172000, % 4 90132000 + OCT0650000000172400, % 5 90133000 + OCT0660000000173000, % 6 90134000 + OCT0670000000173400, % 7 90135000 + OCT0700000000174000, % 8 90136000 + OCT0710000000174400, % 9 90137000 + OCT0430000530075401, % # 90138000 + OCT1000000534076002, % @ 90139000 + OCT0770000000067400, % 90140000 + OCT0720000634075003, % : 90141000 + OCT0760212700067000, % > 90142000 + OCT0000211700064400, % } 90143000 + OCT0530200420047000, % + 90144000 + OCT1010000004140400, % A 90145000 + OCT1020000004141000, % B 90146000 + OCT1030000004141400, % C 90147000 + OCT1040000004142000, % D 90148000 + OCT1050000004142400, % E 90149000 + OCT1060000004143000, % F 90150000 + OCT1070000004143400, % G 90151000 + OCT1100000004144000, % H 90152000 + OCT1110000004144400, % I 90153000 + OCT0560000544045410, % . 90154000 + OCT1330000610070000, % [ 90155000 + OCT0460000670050000, % & 90156000 + OCT0500000300046400, % ( 90157000 + OCT0740210700046000, % < 90158000 + OCT1370000664044000, % ~ 90159000 + OCT0000202704000000, % | 90160000 + OCT1120000004150400, % J 90161000 + OCT1130000004151000, % K 90162000 + OCT1140000004151400, % L 90163000 + OCT1150000004152000, % M 90164000 + OCT1160000004152400, % N 90165000 + OCT1170000004153000, % O 90166000 + OCT1200000004153400, % P 90167000 + OCT1210000004154000, % Q 90168000 + OCT1220000004154400, % R 90169000 + OCT0440000410055404, % $ 90170000 + OCT0520000604056000, % * 90171000 + OCT0550201420060000, % - 90172000 + OCT0510000624056405, % ) 90173000 + OCT0730000370057000, % ; 90174000 + OCT0000213700044400, % { 90175000 + OCT0400000010040000, % 90176000 + OCT0570203704060400, % / 90177000 + OCT1230000004161000, % S 90178000 + OCT1240000004161400, % T 90179000 + OCT1250000004162000, % U 90180000 + OCT1260000004162400, % V 90181000 + OCT1270000004163000, % W 90182000 + OCT1300000004163400, % X 90183000 + OCT1310000004164000, % Y 90184000 + OCT1320000004164400, % Z 90185000 + OCT0540000620065400, % , 90186000 + OCT0450000540066006, % % 90187000 + OCT0000215700054400, % ! 90188000 + OCT0750214700077000, % = 90189000 + OCT1350000630065000, % ] 90190000 + OCT0420000240077407; % " 90191000 +COMMENT HEADINGS FOR FOLLOWING TABLE ALGKEY TYPE PARADESC; 90192000 + FILL QALGORYTHM [*] WITH"20T6INSE","RT ",% 0 NON 3 90193000 + "21S6REMO","VE ",% 1 NON 2 90194000 + "22T6DELI","NK ",% 2 NON 3 90195000 + "23|8ALLO","CATE ",% 3 REF 0 90196000 + "14K4NEXT", % 4 REF 2 90197000 + "15K4LAST", % 5 REF 2 90198000 + "26K5FIRS","T ",% 6 REF 2 90199000 + "27L5PRIO","R ",% 7 REF 3 90200000 + "2825EMPT","Y ",% 8 BOO 2 90201000 + "1924FULL", % 9 BOO 2 90202000 + "2#I#POPU","LATION ";% 10 INT 1 90203000 +COMMENT *** SOME OF THE PARAMETER DESCRIPTORS ARE SUSPECT. THIS TABLE 90204000 + MUST NOT BE CHANGED WITHOUT CHECKING PROCEDURE STANDSEARCH, 90205000 + NOTE THAT FIRST CHARACTER IN FIRST WORD OF AN ENTRY 90206000 + INDICATES NUMBER OF WORDS IN THAT ENTRY (1 OR 2); 90207000 + FILL INFO[ 1,*] WITH 90208000 + OCT0000220676300000,"23AND0", % 25690209000 + OCT0000000436000000,"35ARRA","Y ", % 25890210000 + OCT0000000312000000,"35BEGI","N ", % 26190211000 + OCT0000314426000000,"37BOOL","EAN ", % 26490212000 + OCT0000000560000000,"22BY00", % 26790213000 + OCT0000000306000000,"24CASE", % 26990214000 + OCT0000000416000000,"37COMM","ENT ", % 27190215000 + OCT0000000446000000,"36DEFI","NE ", % 27490216000 + OCT0000204706000000,"23DIV0", % 27790217000 + OCT0000000322000000,"22DO00", % 27990218000 + OCT0000316426000001,"36DOUB","LE ", % 28190219000 + OCT0000000406000000,"24ELSE", % 28490220000 + OCT0000000376000000,"23END0", % 28690221000 + OCT0000223676000000,"23EQV0", % 28890222000 + OCT0000000472000000,"35EVEN","T ", % 29090223000 + OCT0000000646000000,"38EXTE","RNAL ", % 29390224000 + OCT0000260232000000,"35FALS","E ", % 29690225000 + OCT0000000432000000,"35FIEL","D ", % 29990226000 + OCT0000000360000000,"24FILL", % 30290227000 + OCT0000000342000000,"23FOR0", % 30490228000 + OCT0000000652000000,"37FORW","ARD ", % 30690229000 + OCT0000000332000000,"22GO00", % 30990230000 + OCT0000000326000000,"22IF00", % 31190231000 + OCT0000000676100000,"23IMP0", % 31390232000 + OCT0000000526000000,"22IN00", % 31590233000 + OCT0000207426000003,"37INTE","GER ", % 31790234000 + OCT0000000502000000,"39INTE","RRUPT ", % 32090235000 + OCT0000224702000000,"22IS00", % 32390236000 + OCT0000000452000000,"35LABE","L ", % 32590237000 + OCT0000000466000000,"36LAYO","UT ", % 32890238000 + OCT0000000272000000,"36LOCK","ED ", % 33190239000 + OCT0000205706000000,"23MOD0", % 33490240000 + OCT0000000516000000,"37MONI","TOR ", % 33690241000 + OCT0000222662000000,"23NOT0", % 33990242000 + OCT0000000226000000,"24NULL", % 34190243000 + OCT0000000656000000,"22OF00", % 34390244000 + OCT0000000316000000,"22ON00", % 34590245000 + OCT0000221676200000,"22OR00", % 34790246000 + OCT0000000564000000,"39OVER","WRITE ", % 34990247000 + OCT0000000442000000,"23OWN0", % 35290248000 + OCT0000000506000000,"37PICT","URE ", % 35490249000 + OCT0000000426000006,"37POIN","TER ", % 35790250000 + OCT0000000456000000,"39PROC","EDURE ", % 36090251000 + OCT0000000476000000,"35QUEU","E ", % 36390252000 + OCT0000315426000002,"24REAL", % 36690253000 + OCT0000000426000004,"39REFE","RENCE ", % 36890254000 + OCT0000000356000000,"37REPL","ACE ", % 37190255000 + OCT0000000462000000,"24SAVE", % 37490256000 + OCT0000000512000000,"23SET0", % 37690257000 + OCT0000000352000000,"24SCAN", % 37890258000 + OCT0000000550000000,"24STEP", % 38090259000 + OCT0000000364000000,"24SWAP", % 38290260000 + OCT0000000602000000,"23TAG0", % 38490261000 + OCT0000000640000000,"24THEN", % 38690262000 + OCT0000000336000000,"24THRU", % 38890263000 + OCT0000000556000000,"22TO00", % 39090264000 + OCT0000261230000000,"24TRUE", % 39290265000 + OCT0000000400000000,"35UNTI","L ", % 39490266000 + OCT0000000576000000,"35USIN","G ", % 39790267000 + OCT0000000346000000,"35WHIL","E ", % 40090268000 + OCT0000000572000000,"24WITH", % 40390269000 + OCT0000000426000005,"24WORD", % 40590270000 + OCT0000000264000000,"35WORD","S ", % 40790271000 + OCT0000000522000000,"35VALU","E ", % 41090272000 + OCT0000243024500000,"24EXIT", % 41390273000 + OCT0000516054500000,"36MYSE","LF ", % 41590274000 + OCT0000506024500000,"35ALLO","W ", % 41890275000 + OCT0000507024500000,"38DISA","LLOW ", % 42190276000 + OCT0000504024500000,"35PAUS","E ", % 42490277000 + OCT0000517024500000,"35HEYO","U ", % 42790278000 + OCT0000505024500016,"35TIME","R ", % 43090279000 + OCT0000326054500010,"35XSIG","N ", % 43390280000 + OCT0000336040500000,"36TOGG","LE ", % 43690281000 + OCT0000327040500000,"38OVER","FLOW ", % 43990282000 + OCT0000247024500010,"36RETU","RN ", % 44290283000 + OCT0000206054500010,"36ENTI","ER ", % 44590284000 + OCT0000673054500010,"24ONES", % 44890285000 + OCT0000613054500010,"38FIRS","TONE ", % 45090286000 + OCT0000512054500010,"36SCAN","IN ", % 45390287000 + OCT0150236050500010,"23ABS0", % 45690288000 + OCT0150226050500010,"24NABS", % 45890289000 + OCT0150236044500033,"24DABS", % 46090290000 + OCT0150226044500033,"35DNAB","S ", % 46290291000 + OCT0000607044500033,"38DINT","EGER ", % 46590292000 + OCT0000337024500000,"24STOP", % 46890293000 + OCT0000513024500020,"37SCAN","OUT ", % 47090294000 + OCT0000000250300074,"24SIZE", % 47390295000 + OCT0000000250000100,"24LOCK", % 47590296000 + OCT0000000250000104,"24BUSY", % 47790297000 + OCT0000000250000124,"36UNLO","CK ", % 47990298000 + OCT0000000250000110,"24BUZZ", % 48290299000 + OCT0000000250000120,"3@BUZZ","CONTROL ", % 48490300000 + OCT0000000260000000,"35CAUS","E ", % 48790301000 + OCT0000000260000001,"24WAIT", % 49090302000 + OCT0000000260000012,"23SET0", % 49290303000 + OCT0000000260000013,"35RESE","T ", % 49490304000 + OCT0000000260000016,"23FIX0", % 49790305000 + OCT0000000260000017,"24FREE", % 49990306000 + OCT0000000260000024,"36ENAB","LE ", % 50190307000 + OCT0000000260000025,"37DISA","BLE ", % 50490308000 + OCT0000000260000036,"58HAPP","ENED ", % 50790309000 + 2; 90310000 + FILL INFO[ 2,*] WITH 90311000 + OCT0000000260000037,"39AVAI","LABLE ", % 51290312000 + OCT0000000260000050,"3#SECO","NDWORD ", % 51590313000 + OCT0000000260000062,"39STOR","EITEM ", % 51890314000 + OCT0000000140500007,"39REGI","STERS ", % 52190315000 + OCT0000002140500012,"35STAC","K ", % 52490316000 + OCT0000002154500012,"39WORD","STACK ", % 52790317000 + OCT0000002154500007,"3@STAC","KVECTOR ", % 53090318000 + OCT0000004154500007,"36MEMO","RY ", % 53390319000 + OCT0000004154500007,"21M000", % 53690320000 + OCT0000657024500016,"39MOVE","STACK ", % 53890321000 + OCT0000502044500020,"24JOIN", % 54190322000 + OCT0000513024500012,"23IIO0", % 54390323000 + OCT0000177054500001,"24NAME", % 54590324000 + OCT0000672050500002,"38READ","LOCK ", % 54790325000 + OCT0000000050500004,"36BINA","RY ", % 55090326000 + OCT0000000050500003,"37DECI","MAL ", % 55390327000 + OCT0000676054500023,"3#MASK","SEARCH ", % 55690328000 + OCT0000675054500027,"3#LIST","LOOKUP ", % 55990329000 + 0; 90330000 + FILL ADDL[0,*] WITH 0, 90331000 + OCT0000000110300002, 90332000 + OCT0000000104300003, 90333000 + OCT0000000104300000, 90334000 + OCT0000000110300005, 90335000 + OCT0000000104300006, 90336000 + OCT0000000104300000, 90337000 + OCT0000000000000001, 90338000 + OCT0000000000000001, 90339000 + OCT0000000104300000, 90340000 + OCT0000000000000002, 90341000 + OCT0000000140300001, 90342000 + OCT0000000104300000, 90343000 + OCT0000000000000056, 90344000 + OCT0000000000000001, 90345000 + OCT0000000110300000, 90346000 + OCT0000000000000002, 90347000 + OCT0000000104300000, 90348000 + OCT0000000104300000, 90349000 + OCT0000000000000003, 90350000 + OCT0000000104300000, 90351000 + OCT0000000104300000, 90352000 + OCT0000000140300001, 90353000 + OCT0000000000000003, 90354000 + OCT0000000110300000, 90355000 + OCT0000000140300001, 90356000 + OCT0000000104300000, 90357000 + OCT0000000000000001, 90358000 + OCT0000000100300000, 90359000 + 0; 90360000 + NEXTADDL~30; 90399000 + %***THE PRECEDING CARD IS --NOT-- SUPPLIED BY OPTAB/BLDR*** 90399001 + COMMENT NOW LINK UP INFO AND STACKHEAD; 91000000 + NEXTINFO ~ 257; GT1 ~ 0; 91001000 + WHILE GT1 ~ TAKE(NEXTINFO ~ NEXTINFO + GT1.CONL) ! 0 DO 91002000 + IF GT2 ~ GT1.ALFACNT ! 0 THEN 91003000 + PUT(GT1 & STACKHEAD[SCRAM ~ GT2 MOD 125][3:33:15], 91004000 + STACKHEAD[SCRAM] ~ NEXTINFO); 91005000 + COMMENT AND PUT QUESTION MARKS IN OPS FOR UNDEFINED OPERAT0RS; 91006000 + FOR GT1~0 STEP 1 UNTIL 767 DO IF OPS[GT1]=0 THEN OPS[GT1]~ 91007000 + 3195660; 91008000 + OPS[768] ~ "LINK"; 91009000 + FIRSTINFO ~ NEXTINFO; 91009100 + CONTEXT ~ 2; 91010000 + MAXDISP ~ 2023; 91011000 + COUNTQALG~STARTNSQ; 91011500 + SAVED ~ TRUE; 91013000 + LASTADDL ~ - 32767; 91013100 + GT2 ~ 0; COMMENT INITIALIZE DEFINED TO STANDARD IDS.; 91014000 + FOR GT1 ~ 0 STEP 10 UNTIL 80 91015000 + DO DEFINFO[GT1] ~ "3A 0"&(GT2~GT2+1)[30:42:6]&12[36:42:6]; 91016000 + ERRORTOG ~ MACRO ~ TRUE; 91017000 + SEPARATOG~SVINFOTOG~BOOLEAN(-2); % AVAILABLE FOR SETTING 91017900 + I~0; NCR~READACARD; 91018000 + STEPIT; 91018100 + IF REAL(SEPARATOG)<0 THEN 91018200 + BEGIN 91018300 + SEPARATOG~FALSE; 91018400 + IF ELCLASS!BEGINV THEN 91018500 + DO UNTIL STEPI=BEGINV; 91018600 + WRITE(TEMP); 91018700 + STACKTOP[0]~S0; 91018730 + SEGNO~5; 91018760 + END ELSE 91018900 + BEGIN 91019000 +COMMENT IN THE SEPARATED COMPILING, THE OUTER MOST BLOCK OF THE MAIN 91019001 + PROCEDURE IS GIVEN RUNNING LEVEL "SEPLEVEL". WHICH IS 3 OR 91019002 + HIGHER. GLOBALS ARE GIVEN D2-STACK REFERENCES FROM (2,2) AND 91019003 + UP. REFERENCES TO D0, D1 AND D2 STACKS ARE SAME AS IN THE 91019004 + NORMAL COMPILATION. DURING BINDING PROCESS, THE "GLOBLCNT" 91019005 + TELLS THE DIFFERENCE OF GLOBALS FROM LOCALS IN THE D2-STACK; 91019006 + GLOBLCNT~1&2[33:45:3]; 91019100 + CURRENT~SEPLEVEL-1; 91019200 + END; 91019300 + TEMPADDR~STATE~ 91019900 + BEGINCTR ~ SCANCOUNT ~ 1; 91020000 + FIRSTX ~ LASTX ~ FIRSTMT ~ -1; 91023000 + POOLX ~ 0 ; 91025000 + STARTINFO~NINFOO~NEXTINFO; 91026000 + STARTADDL~NEXTADDL; 91027000 + IF SVINFOTOG THEN SVINFO~TRUE ELSE SVINFOTOG~FALSE; 91028000 + 91028100 + 91028200 +COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 92000000 + COMPILE THE OUTER BLOCK, AND THEY THAT DWELL THEREIN 92001000 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;92002000 + IF REAL(SEPARATOG)=2 THEN 92002100 + BEGIN 92002200 + NEXTPROCEDURE: 92002300 + DO BEGIN 92002350 + SEPARATEDCOMPILING; 92002400 + SEPWRAPUP; 92002500 + END UNTIL NOT SEPARATOG; 92002550 + GO TO ENDOFITALL; 92002600 + END; 92002700 + DECLARATIONS; 92003000 + FIRSTATEMENT; 92004000 + COMPOUNDTAIL; 92005000 + IF SVINFO THEN 92005100 + BEGIN 92005150 + WRITEFILE(INFF,INFO,STARTINFO,NEXTINFO-1); 92005200 + WRITEFILE(INFF,ADDL,STARTADDL,NEXTADDL-1); 92005250 + INFD[(INFDX~INFDX+2).LINKR,INFDX.LINKC]~ 92005300 + (GTI1~(NEXTINFO-STARTINFO+29)DIV 30+INFFX)& 92005350 + INFFX[18:33:15]; 92005400 + INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC]~ 92005450 + (NEXTINFO-1)&STARTINFO[18:33:15]; 92005500 + INFD[(INFDX~INFDX+1).LINKR,INFDX.LINKC]~ 92005550 + (NEXTADDL-1)&STARTADDL[18:33:15]; 92005600 + INFFX~(NEXTADDL-STARTADDL+29) DIV 30 + GTI1; 92005650 + END; 92005700 + PURGE(256); 92006000 +END PROGRAM; 92007000 + PROGRAM; 92899000 + BEGIN COMMENT THE WRAPUP BLOCK; 92900000 + DEFINE PRT = INFO#, TAG=ADDL#, DISK=CODE#, 92901000 + Z = RESULT#, R=COUNT#, J=CONTEXT#, 92901100 + STACKSIZE = CSZ#, MOM=MAXCSZ#, AD=QGT1#, 92901200 + X = KLASSF#, ROW=LINKR#, COL=LINKC#; 92901300 + PROCEDURE RITE(A,X,TX,N,AT); VALUE X,TX,N,AT; ARRAY A[0,0]; 92902000 + INTEGER X,TX,N,AT; 92903000 + BEGIN 92904000 + LABEL INN,ON; 92904100 + DEFINE BITS = (IF SB THEN DS ~ SET ELSE DS ~ RESET; SKIP SB)#; 92905000 + DEFINE BUMP = IF B ~ B + 1 } 6 THEN 92906000 + BEGIN B ~ B - 6; W ~ W + 1 END BUMP#,D=ELBAT[W],B#, 92907000 + I = SCRAM #, 92907100 + G(G1)=TAG[G1.LINKR,G1.LINKC]#, 92907200 + AA(AA1)=A[AA1.LINKR,AA1.LINKC]#, 92907300 + W = GT3#, B = GT4#, BYTES= 8 BITS#; 92908000 + STREAM PROCEDURE INSERTBYTE(V,W,B); VALUE V,B; 92909000 + BEGIN SI~LOC W; SI~SI-2; SKIP 4 SB; DI~W; B(SKIP 8 DB); BYTES 92910000 + END INSERTBYTE; 92911000 + BOOLEAN STREAM PROCEDURE UNEQUAL(A,B); 92911100 + BEGIN SI ~ A; DI ~ B; IF 8 SC ! DC THEN TALLY~1; UNEQUAL~TALLY 92911200 + END UNEQUAL; 92911300 + STREAM PROCEDURE MOVEBYTES(N,F,FS,T,TS); VALUE N,FS,TS; 92912000 + BEGIN SI ~F; FS(SKIP 8 SB); DI~T; TS(SKIP 8 DB); N(BYTES) END; 92913000 + IF DECKTOG THEN 92913310 + BEGIN 92913320 + I ~ X; 92913330 + ON: 92913340 + IF I ~ I + 1 { N THEN 92913350 + IF TX < 0 THEN GO INN ELSE 92913360 + IF G[X] = G[I] THEN 92913370 + INN: 92913380 + IF NOT UNEQUAL(AA[X],AA[I]) THEN GO ON; 92913390 + IF NOT TB1 ~ I - X > 10 THEN I ~ MIN(X + 10, N)ELSE X~X+1;92913400 + ELBAT[0] ~ (I - X).[28:16] & (1 - REAL(TB1)) [28:47:1] 92913410 + & 11 [21:44:4]; 92913420 + ELBAT[1] ~ 0 & AT[20:28:20] & (I-X) [16:44:4]; 92913430 + AT ~ AT + I - X; 92913440 + W ~ 1; B ~ 5; 92913450 + DO BEGIN 92913460 + INSERTBYTE(IF TX<0 THEN 243 ELSE G[X]+240, D); 92913470 + IF B ~ B + 1 = 6 THEN BEGIN B ~ 2; W~W+1 END; 92913480 + R ~ 0; 92913490 + DO BEGIN 92913500 + MOVEBYTES(Z ~ 6-MAX(R,B),AA[X],R,D); 92913510 + IF B~B+Z=6 THEN BEGIN B~2; W~W+1 END; 92913520 + END UNTIL R~R+Z } 6; 92913530 + END UNTIL X~X+1 } I OR TB1; 92913540 + IF TB1 THEN 92913542 + BEGIN ELBAT[3].[32:16]~62357; MOVE(4,LBUFF[5],ELBAT[4]); 92913544 + W ~ 7; B ~ 5; X ~ I; AT ~ AT + 1; 92913546 + END SMEAR CARD CODE COPYING; 92913548 + EPUNCH(W,B,ELBAT); 92913550 + IF I < N THEN GO ON; 92913560 + W ~ B ~ 0; 92913570 + END DECKTOG ACTION ELSE 92913580 + WHILE N > 0 DO 92914000 + BEGIN 92915000 + IF TX } 0 THEN 92916000 + BEGIN 92917000 + MOVEBYTES(1,TAG[TX.LINKR,TX.LINKC],5,D); 92918000 + TX ~ TX + 1; 92919000 + END ELSE 92920000 + INSERTBYTE(3,D); 92921000 + BUMP; 92922000 + INSERTBYTE(0,D); BUMP; 92923000 + MOVEBYTES(6,A[X.LINKR,X.LINKC],0,D); 92924000 + X ~ X + 1; 92925000 + W ~ W + 1; 92926000 + N ~ N - 1; 92927000 + IF W > 30 THEN 92928000 + BEGIN 92929000 + WRITE(DISK[DKADDR],30,ELBAT[*]); 92930000 + MOVE(45,ELBAT[30],ELBAT[0]); 92931000 + W ~ W -30; DKADDR ~ DKADDR + 1; 92932000 + END N LOOP; 92933000 + END W LOOP; 92933100 + END RITE; 92939000 + PROCEDURE M12(N,A,S,B,X); VALUE N,S,X; ARRAY A[*],B[*,*]; 92940000 + INTEGER N,S,X; 92941000 + BEGIN 92942000 + MOVE(GT1~MIN(256-X.LINKC,N),A[S],B[X.LINKR,X.LINKC]); 92943000 + IF N ~ N - GT1 > 0 THEN 92944000 + MOVE(N,A[S+GT1],B[(X~X+GT1).LINKR,X.LINKC]) 92945000 + END M12; 92946000 + PROCEDURE M22(N,A,AX,B,BX); VALUE N,AX,BX; INTEGER N,AX,BX; 92947000 + ARRAY A,B[0,0]; 92948000 + BEGIN 92949000 + INTEGER P; 92950000 + DO BEGIN 92951000 + MOVE(P~MIN(256-AX.LINKC,256-BX.LINKC,N), 92952000 + A[AX.LINKR,AX.LINKC],B[BX.LINKR,BX.LINKC]); 92953000 + AX ~ AX + P; BX ~ BX+P; 92954000 + END UNTIL N ~ N - P { 0; 92955000 + END M22; 92956000 + LABEL DD; 92957000 +COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 93000000 + GIVE IT TO THE OUTSIDE WORLD---MAYBE 93001000 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;93002000 + IF POOLX > 0 THEN FLUSHPOOL; 93002100 + WHILE L MOD 6 ! 0 DO EMIT(NVLD); 93003000 + EDOC[(L~L DIV 6).ROW,L.COL] ~ CORESIZE~(J~(STACKSIZE~STACKTOP 93004000 + [0]) + SAVESIZE) + L; 93005000 + EDOC[L.ROW,L.COL].[09:17]~EDOC[L.ROW,L.COL] + 1; 93005100 + DKADDR ~ 366; L ~ L+ 1; 93005200 + COMMENT DKADDR IS NOW THE STARTING DISKADDRESS IN THE CODE 93006000 + FILE OF OVERLAYABLE STUFF. 93007000 + CORESIZE IS THE AMOUNT OF SAVE CORE. 93008000 + J IS THE START OF THE OUTER-BLOCK CODE SEGMENT. 93009000 + STACKSIZE IS THE SIZE OF THE LEVEL-ZERO START, AND 93010000 + THE START OF SAVE DATA. 93011000 + L IS NOW THE NUMBER OF WORDS IN THE SAVE CODE SEGMENT; 93012000 + PRT[0,0] ~ 0; M22(J-1,PRT,0,PRT,1); 93012100 + TAG[0,0] ~ 0; M22(J-1,TAG,0,TAG,1); 93012200 + IF FIRSTX < 0 THEN FIRSTX ~ FIRSTMT; 93012900 + GLOBALPCW(3,SEGNO,FIRSTX,1); 93013000 + IF SVINFO THEN 93013010 + INFD[(GTI1~INFDX-3).LINKR,GTI1.LINKC]~PCW; 93013020 + FLOG(1,0&REAL(NOT FALSE)[8:28:20],PRT[0,4]); TAG[0,4] ~ 5; 93013040 + FLOG(1,J&L[8:23:20],PRT[0,SEGNO]); TAG[0,SEGNO]~3; 93013100 + PRT[0,0] ~ -(0&CORESIZE[10:31:17]); 93013200 + FLOG(1,CORESIZE+1&CORESIZE[10:31:17],PRT[0,1]); 93013230 + TAG[0,0] ~ TAG[0,1] ~ 3; 93013300 + SAVEL ~ IF SAVEL ! 0 THEN (SAVEL+5) DIV 6 ELSE 4; 93013400 + INZCODE[0,0].[10:17] ~ INZCODE[SAVEL.ROW,SAVEL.COL] ~ SAVEL; 93013500 + T ~ 8190 - CORESIZE - SAVEL ~ SAVEL + 1; 93013600 + INZCODE[SAVEL.ROW,SAVEL.COL] ~ 0& SAVEL ~T[7:28:20]&1[27:47:1];93013700 + PRT[0,6] ~ CORESIZE & 1[6:47:1]; 93013800 + IF ERRORCOUNT!0 OR NOT LISTOG.[46:1] THEN PRINTAIL; 93014000 + X ~ I ~ STACKSIZE; 93035000 + IF ERRORCOUNT ! 0 THEN GO TO ENDOFITALL; 93036000 + CLOSE(LINE); 93037000 + IF DECKTOG THEN 93038000 + BEGIN 93039000 + FILL TA[*] WITH 93040000 + COMMENT INTERNAL TO EBCDIC CARD CODE; 93041000 + OCT5403,OCT4401,OCT4201,OCT4101,OCT4041,OCT4021,OCT4011,OCT4005,93042000 + OCT4003,OCT4403,OCT4203,OCT4103,OCT4043,OCT4023,OCT4013,OCT4007,93043000 + OCT6403,OCT2401,OCT2201,OCT2101,OCT2041,OCT2021,OCT2011,OCT2005,93044000 + OCT2003,OCT2403,OCT2203,OCT2103,OCT2043,OCT2023,OCT2013,OCT2007,93045000 + OCT3403,OCT1401,OCT1201,OCT1101,OCT1041,OCT1021,OCT1011,OCT1005,93046000 + OCT1003,OCT1403,OCT1203,OCT1103,OCT1043,OCT1023,OCT1013,OCT1007,93047000 + OCT7403,OCT0401,OCT0201,OCT0101,OCT0041,OCT0021,OCT0011,OCT0005,93048000 + OCT0003,OCT0403,OCT0203,OCT0103,OCT0043,OCT0023,OCT0013,OCT0007,93049000 + OCT0000,OCT5401,OCT5201,OCT5101,OCT5041,OCT5021,OCT5011,OCT5005,93050000 + OCT5003,OCT4402,OCT4202,OCT4102,OCT4042,OCT4022,OCT4012,OCT4006,93051000 + OCT4000,OCT6401,OCT6201,OCT6101,OCT6041,OCT6021,OCT6011,OCT6005,93052000 + OCT6003,OCT2402,OCT2202,OCT2102,OCT2042,OCT2022,OCT2012,OCT2006,93053000 + OCT2000,OCT1400,OCT3201,OCT3101,OCT3041,OCT3021,OCT3011,OCT3005,93054000 + OCT3003,OCT1402,OCT6000,OCT1102,OCT1042,OCT1022,OCT1012,OCT1006,93055000 + OCT7000,OCT7401,OCT7201,OCT7101,OCT7041,OCT7021,OCT7011,OCT7005,93056000 + OCT7003,OCT0402,OCT0202,OCT0102,OCT0042,OCT0022,OCT0012,OCT0006,93057000 + OCT5402,OCT5400,OCT5200,OCT5100,OCT5040,OCT5020,OCT5010,OCT5004,93058000 + OCT5002,OCT5001,OCT5202,OCT5102,OCT5042,OCT5022,OCT5012,OCT5006,93059000 + OCT6402,OCT6400,OCT6200,OCT6100,OCT6040,OCT6020,OCT6010,OCT6004,93060000 + OCT6002,OCT6001,OCT6202,OCT6102,OCT6042,OCT6022,OCT6012,OCT6006,93061000 + OCT3402,OCT3400,OCT3200,OCT3100,OCT3040,OCT3020,OCT3010,OCT3004,93062000 + OCT3002,OCT3001,OCT3202,OCT3102,OCT3042,OCT3022,OCT3012,OCT3006,93063000 + OCT7402,OCT7400,OCT7200,OCT7100,OCT7040,OCT7020,OCT7010,OCT7004,93064000 + OCT7002,OCT7001,OCT7202,OCT7102,OCT7042,OCT7022,OCT7012,OCT7006,93065000 + OCT5000,OCT4400,OCT4200,OCT4100,OCT4040,OCT4020,OCT4010,OCT4004,93066000 + OCT4002,OCT4001,OCT5203,OCT5103,OCT5043,OCT5023,OCT5013,OCT5007,93067000 + OCT3000,OCT2400,OCT2200,OCT2100,OCT2040,OCT2020,OCT2010,OCT2004,93068000 + OCT2002,OCT2001,OCT6203,OCT6103,OCT6043,OCT6023,OCT6013,OCT6007,93069000 + OCT1202,OCT3401,OCT1200,OCT1100,OCT1040,OCT1020,OCT1010,OCT1004,93070000 + OCT1002,OCT1001,OCT3203,OCT3103,OCT3043,OCT3023,OCT3013,OCT3007,93071000 + OCT1000,OCT0400,OCT0200,OCT0100,OCT0040,OCT0020,OCT0010,OCT0004,93072000 + OCT0002,OCT0001,OCT7203,OCT7103,OCT7043,OCT7023,OCT7013,OCT7007,93073000 +0; 93074000 + FILL ELBAT[*] WITH 9307450093074000 + "F340A220","F3","FEFE9544","A200F301",%CARD 1 OF LDR 93075000 + "DFDFDFDF","DFF70000","00784004","F3800FFF", 93075100 + "F00000F3","06002095","4BA34012","2000F000", 93075200 + "06F3B241","20029C04","F304B795","4AB7A1F3", 93075300 + "20009810","1808F39E","064020BA","A2F3A004", 93075400 + "F3002096","06954AF3","A12000B3","2021F392",%CARD 2 93075500 + "00069340","26F3BB40","06B9A1A0","F304B5B5", 93075600 + "B00020F3","AE401000","2040F30F","95BCABDF", 93075700 + "DFF34040","40404040","F7000A00","384025F7", 93075800 + "28","254040","40404040","40404040", 93075900 + "F5800000","F0203540","000000F0","2033F3A2", 93076000 + "0001F020","29F30024","0002954B","F3FEFE95", 93076100 + "44A200F3","02960695","4AA1F300","01402FBD", 93076200 + "B7F3B79A","2714B69A","F32B0140","23BDB6F3", 93076300 + "A0000DB6","D4A3F3DF","A3404040","40401220", 93076400 + "F5880000","602005F3","40000040","4F300",%XFR CARD 93076500 + 0,"BC402FB0","A6F3BA40","2FB1A695", 93076600 + "F3B7D4A3","40000040","4004F300","9800", 93076700 + "25404040"; 93076800 + FOR T~0 STEP 1 UNTIL 74 DO 93080000 + ELBAT[T] ~(C ~ ELBAT[T]).[44:4] & C [40:36:4] & C[36:32:4]93081000 + &C[32:26:4] &C[28:20:4] &C[24:14:4] &C[20:8:4] 93082000 + &C[16:2:4] + C.[43:1] &C[43:37:1] &C[39:31:1] 93083000 + &C[35:25:1] &C[31:19:1] &C[27:13:1] &C[23:7:1] 93084000 + &C[19:1:1] | 9; 93085000 + EPUNCH(19,6,ELBAT); MOVE(40,ELBAT[20],ELBAT[0]); 93090000 + EPUNCH(19,6,ELBAT); MOVE(20,ELBAT[40],ELBAT[0]); 93091000 + EPUNCH(19,6,ELBAT); MOVE(14,ELBAT[60],LBUFF[0]); 93092000 + END DECKTOG PRELIMINARIES; 93099000 + WHILE PDINX ~ PDINX - 1 } 0 DO 93100000 + BEGIN AD ~ T ~ 0; 93101000 + MOM ~ (C ~ PDPRT[PDINX.LINKR,PDINX.LINKC]).[36:12]; 93102000 + CASE C.[2:3] OF 93103000 + BEGIN 93104000 + BEGIN COMMENT CASE 0 = DATA DESCRIPTOR; 93105000 + DD: 93105100 + IF C.[23:13] ! 0 THEN 93106000 + IF BOOLEAN(C.[8:1]) THEN 93107000 + BEGIN 93108000 + READ SEEK(TEMP[C.[23:13]]); 93109000 + AD ~ X; 93110000 + J ~ C.[10:13]; 93111000 + FOR I ~ 0 STEP 30 UNTIL J - 1 DO 93112000 + BEGIN READ(TEMP,30,ELBAT[*]); 93113000 + M12(T~MIN(30,J-I),ELBAT,0,PRT,X); 93114000 + X ~ X + 1; 93115000 + END; 93116000 + END SAVE ARRAYS ELSE 93117000 + BEGIN 93118000 + READ SEEK(TEMP[C.[23:13]]); 93119000 + AD ~ DKADDR; 93121000 + J ~ (C.[10:13] + 29) DIV 30; 93122000 + WHILE J ~ J - 1 } 0 DO 93123000 + BEGIN 93124000 + READ(TEMP,30,ELBAT[*]); 93125000 + WRITE(CODE[DKADDR],30,ELBAT[*]); 93126000 + DKADDR ~ DKADDR + 1; 93127000 + END END NONSAVE ARRAYS ELSE 93128000 + COMMENT TEMP ADDRESS = 0; 93129000 + IF C.[8:1]=1 AND C.[10:13]!0 THEN 93129100 + X ~ (AD ~ X) + C.[10:13]; 93130000 + AD ~ AD & C[15:10:13] & C[7:6:1] & C[4:7:1]; 93131000 + AD.[28:2] ~3|REAL(C.[8:1]=0 AND C.[23:13]!0); 93131010 + AD.[1:1] ~ REAL(C.[10:13]=0); 93131100 + FLOG(C.[8:1],AD,PRT[MOM.LINKR,MOM.LINKC]); 93132000 + T ~ 5 93133000 + END DATA DESCRIPTOR; 93134000 + COMMENT CASE 1 IS ALSO DATA DESCRIPTOR; 93135000 + GO TO DD; 93135100 + COMMENT CASE 2 = D. P. VARIABLE; 93136000 + T ~ TAG[(MOM+1).LINKR,(MOM+1).LINKC] ~ 2; 93137000 + COMMENT CASE 3 = PTR VARIABLE; 93138000 + BEGIN 93139000 + PRT[MOM.LINKR,MOM.LINKC] ~ 0; 93140000 + T ~ 5 93141000 + END POINTER VARIABLE; 93142000 + ; COMMENT CASE 4 IS NULL; 93143000 + ; COMMENT CASE 5 IS NULL; 93144000 + COMMENT CASE 6 = SEGMENT DESCRIPTOR; 93145000 + BEGIN 93146000 + READ SEEK(TEMP[C.[23:13]]); 93147000 + AD ~ DKADDR; 93148000 + J ~ (C.[10:13]+29) DIV 30; 93149000 + WHILE J ~ J-1 } 0 DO 93150000 + BEGIN 93151000 + READ(TEMP,30,ELBAT[*]); 93152000 + WRITE(CODE[DKADDR],30,ELBAT[*]); 93153000 + DKADDR ~ DKADDR + 1; 93154000 + END; 93155000 + PRT[MOM.LINKR,MOM.LINKC]~AD&C[15:10:13]& 93156000 + 1[2:47:1]; 93156001 + T ~ 3 93157000 + END SEGMENT DESCRIPTOR; 93158000 + COMMENT CASE 7 = PROGRAM CONTROL WORD; 93159000 + BEGIN 93160000 + PRT[MOM.LINKR,MOM.LINKC] ~ C.[24:12] & 93161000 + ((T~C.[7:17])DIV 6)[15:35:13]& 93162000 + (I MOD 6) [12:9:3] & C[28:6:1] & 93163000 + 1[33:47:1]; 93164000 + T ~ 7 93165000 + END PCW CASE 93166000 + END CASES OF PDPRT ENTRIES; 93167000 + TAG[MOM.LINKR,MOM.LINKC] ~ T 93168000 + END ANALYSIS OF PDPRT ENTRIES; 93169000 + PRT[0,2] ~ X ~ DKADDR + 1; 93200000 + GT3 ~ GT4 ~ DKADDR ~ ELBAT[0] ~ 0; 93201000 + MOVE(50,ELBAT[0],ELBAT[1]); 93202000 + RITE(PRT,0,0,STACKSIZE + SAVESIZE,0); 93202100 + RITE(EDOC,0,-1,L,STACKSIZE + SAVESIZE); 93202200 + RITE(INZCODE,0,-1,8190-CORESIZE,STACKSIZE+SAVESIZE+L); 93202250 + WHILE GT3 | 6 + GT4 > 0 DO 93202300 + BEGIN 93203000 + WRITE(DISK[DKADDR],30,ELBAT[*]); 93204000 + MOVE(45,ELBAT[30],ELBAT[0]); 93205000 + GT3 ~ GT3 - 30; 93205050 + DKADDR ~ DKADDR + 1; 93205100 + END; 93205200 + IF SVINFO THEN 93220000 + BEGIN 93221000 + READ SEEK(DISK[DKADDR~X]); 93221500 + WRITESVINFO(DISK); 93222000 + REWIND(DISK); 93223000 + READ(DISK,30,AY[*]); 93224000 + AY[0].[28:20]~X; 93225000 + WRITE(DISK,30,AY[*]); 93226000 + END; 93227000 + IF DECKTOG THEN 93228000 + BEGIN 93229000 + MOVE(14,LBUFF[0],ELBAT[0]); 93230000 + ELBAT[4] ~ SEGNO.[34:6] &(FIRSTX DIV 6)[23:35:13] 93240000 + & 33 [36:42:6] & (I ~ FIRSTX MOD 6)[20:45:3]; 93241000 + ELBAT[5].[16:8] ~ SEGNO; 93242000 + EPUNCH(13,6,ELBAT); 93243000 + END PUNCHING TRANSFER CARD ELSE 93244000 + LOCK(DISK); 93500000 + END OF THE WRAPUP BLOCK; 94000000 + ENDOFITALL: 94001000 +% 94001500 + CLOSE(TAPE); 94001600 + IF NEWTOG THEN 94010000 + BEGIN 94011000 + FILL SEPA[*] WITH "END;END."," L A S T"," C A R D"," I M A G", 94012000 + " E O N N"," E W T ","A P E "," ", 94013000 + " ","99999999"; 94014000 + WRITE(NEWTAPE,10,SEPA[*]); 94015000 + END; 94016000 +END OF ESPOL COMPILER. . . . . . 98888888