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 O 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 DEFINEV ;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=330#,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 =18# % 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~8 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 DEFINE: 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 MANAGEMENT IS HANDLED BY READACARD, INCLUDING NORMAL LISTING, 30011000 VOIDING, SEQUENCE 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 O L C O M P I L A T I O 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; 31227000140621PK 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 DP 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+1); 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 N 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); 31550000140621PK 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 WE 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 CODE 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); 40254000140621PK 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 30(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 BTYPE: 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 IS 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 OR 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 MODIFIED 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 PROCEDURE 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; 62026000140621PK 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 DO 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 ARE 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 FROM(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 THE 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; 72132000140621PK 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 DD),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 80049000140621PK 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[I],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 "BSET","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","USNU","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 OPERATORS; 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; 93166000140608PK 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 99999980