github.com/pkimpel.retro-b5500
1
0
Fork 0
mirror of https://github.com/pkimpel/retro-b5500.git synced 2026-02-13 11:44:33 +00:00
Code Releases Activity
Files
4ca4f5add47101404dffa67c433ee40bb6aadc95
pkimpel.retro-b5500/source/B65ESPOL/SOURCE.alg_m
Paul Kimpel 356fb5584e Commit release 1.03: 
1. Alter method of writing disk sectors to IndexedDB, to avoid dragging along the entire 16KB IO Unit buffer area and unintentionally inflating host disk usage by 30-60X (ouch). This was causing Quota Exceeded errors in recent versions of Firefox.
2. Add onabort traps in B5500DiskUnit to catch QuotaExceeded errors.
3. Modify delay-deviation adjustment mechanism in B5500SetCallback to avoid oscillating between positive and negative cumulative deviations.
4. Correct tape reel angular motion in B5500MagTapeDrive, especially during reverse tape movement.
5. Fix bug with reporting memory parity error during tape I/O, should that ever occur.
6. Reset CPA Algol Glyphs option in default system configuration template.
7. Allow tools/B5500LibMaintDecoder to examine an entire .bcd tape image file instead of just the first 64KB.
8. Add USE SAVEPBT to default options in tools/COLDSTART-XIII deck.
9. Eliminate extraneous "schema update successful" alert when altering a disk subsystem configuration.
10. Commit minor corrections to source/B65ESPOL/SOURCE.alg_m from Richard Fehlinger.
2015-08-22 16:46:22 -07:00

10174 lines
914 KiB
Plaintext
Raw Blame History

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
625 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
817 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 NCR<BUMPWORD THEN BUMPCHAR ELSE -BUMPWORD)+NCR#;10078000
% NCR IS AN ABSOLUTE ADDRESS WITH THE 10079000
% CHARACTER POINTER IN 30:3. STEPNCR BUMPS 10080000
% NCR BY ONE CHAR. 10081000
DEFINE BUMPNCR= IF STEPNCR=LCR THEN NCR~READACARD#; 10082000
% IN ADDITION, BUMPNCR SWITCHES TO A NEW 10083000
% CARD WHEN NECESSARY 10084000
INTEGER RCOUNT, % USUALLY 63-COUNT. 10085000
GTI1, % JUNK CELL, USUALLY TO INTEGERIZE THINGS. 10086000
L, % SYLLABLE COUNTER, USED BY THE EMITTERS: 10087000
% INCLUDED HERE BECAUSE IT GETS ON LISTING 10088000
SEGNO, % CURRENT PROGRAM-SEGMENT NUMBER. 10089000
RESEQNR, % NEXT SEQ NR WHEN BESEQUENCING. 10090000
RESEQINC; % INCREMENT WHEN RESEQUENCING. 10091000
SAVE ARRAY CBUFF, % CARD IMAGE FROM CARD READER. 10092000
TBUFF[0:9]; % CARD IMAGE FROM TAPE FILE. 10093000
ARRAY 10094000
STACKMASK, % MAX DISP IN [18:15], LL IN[33:15] 10095000
STACKTOP, % CURRENT ASSIGNMENT FOR EACH LEVEL 10096000
MAXSTACK[0:31], % MAX STACK SIZE FOR EACH ADDR LEVEL 10097000
LBUFF[0:16]; % FOR BUILDING PRINT IMAGES. 10098000
DEFINE MAXDISPF = [18:15]#, 10099000
LLMASKF = [33:15]#; 10100000
INTEGER TIME1, TIME2; % THE TIME WHEN WE BEGAN 10101000
INTEGER SETSIZE; % NUMBER OF WORDS IN SET 10101100
REAL FIRSTINFO; 10101200
% THESE ARE THE FIELDS IN ELBAT WORDS, INFO ENTRIES, ETC. 10102000
DEFINE MONF =[ 1: 1]# % =1 IF MONITORED 10103000
,ADDRESS =[ 2:19]# % 10104000
, LVEL =[ 3: 6]# % ADDRESSING OR LEXICOGRAPHIC LEVEL 10105000
, DISP =[ 9:12]# % DISPLACEMENT WITHIN LEVEL 10106000
,CLASS =[21: 7]# % 10107000
,RSVD =[28: 1]# % =1 IF RESERVED NAME 10108000
,TYPE =[29: 4]# % 10109000
,LINK =[33:15]# % POINTER TO ADDL OR INFO 10114000
, LINKR =[33: 7]# % ROW 10115000
, LINKC =[40: 8]# % COLUMN 10116000
,EBCDF =[32: 8]# % EBCDIC REPRESENTATION OF CHARACTER-- 10116100
,ASCF =[ 1: 8]# % ASCII -- APPEAR IN "SPECIAL" ONLY 10116200
,CONL =[ 3:15]# % CONGRUENCY LINK 10117000
,CONR =[ 3: 7]# % -- ROW 10118000
,CONC =[10:8]# % -- COLUMN 10119000
,CHRCNT =[18: 6]# 10120000
,ALFA =[24:24]# 10121000
,ALFACNT =[18:30]# 10122000
,FIRSTCHR =[24: 6]# 10123000
,CF = 33:15 # 10124000
,FF = 18:15 # 10125000
,NOPAR =[40:8]# % NUMBER OF PARAMETERS FOR A PROCEDURE 10126000
,NODIM =[40:8]# % NUMBER OF DIMENSIONS FOR AN ARRAY 10127000
,PARTALFA= [18:30]# % CHRCNT PLUS ALFA 10128000
,ALGNOF = CLASS# % FIELD FOR NO OF ALGORITHMS 10129000
,QLINK = ADDRESS# % IN ITEM ADDL,POINTING TO Q INFO10130000
,ITMNOF =LINKR# %FIELD FOR NUMBER OF ITEMS 10131000
,SIZEF =LINKC# %FIELD FOR SIZE OF ENTRY 10131300
,ALGNO = [33:13]# %FIELD FOR ALGORITHM KEY 10132000
,PARADESC= [46:2]# %FIELD FOR PARAMETER DESCRIPIION 10133000
,QINDEXF =[2:10]# 10133100
,ITMQAINDXF =[12:9]# 10133150
,STANDF = ADDRESS# % =0 STANDARD,=1 NON STANDARD ALG10133500
,ALLBUTLINK = [1:32]# %ALL ELBAT EXCEPT LINK 10133520
,KIND = [40:8]# %WHICH EVENT INTRINSIC 10133540
; 10134000
DEFINE BOUND (BOUND1) = 10135000
IF (BOUND1).CLASS<REGID THEN IF (BOUND1).CLASS>PTRID 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]).CLASS<SPASE THEN 31012000
BEGIN 31013000
COMMENT IT WAS A LETTER OR DIGIT, SO WE SHALL BUILD AN 31014000
IDENTIFIER OR NUMBER. THE PSEUDO-CLASSES FOR 31015000
DIGIT AND LETTER ARE SUCH THAT THE STATEMENT AT 31016000
AROUND WILL COUNT THE NUMBER OF THE RIGHT KINDS OF31017000
CHARACTERS; 31018000
FCR~NCR; % REMEMBER WHERE IT STARTED 31019000
AROUND: DO COUNT~COUNT+1 UNTIL SPECIAL[CHR~EXAMINE(STEPNCR)].CLASS31020000
>RESULT; 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])&GT1[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]&GT1[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<COUNT DO 31386000
BEGIN IF (J~(K~INPUTCONVERT(ACCUM[N.[42:3]+1],N.[45:3]+4,8)) 31387000
+HI|100000000){549755813887 THEN HI~J ELSE 31388000
DOUBLE(HI,LO,@8,0,|,K,0,+,~,HI,LO); 31389000
N~N+8 31390000
END LOOP 31391000
END CONVERTINTO; 31392000
PROCEDURE HOOK(INDEX); VALUE INDEX; INTEGER INDEX; 31393000
COMMENT HOOK CAUSES THE SCANNER TO START USING A PART OF ADDL AS 31394000
THE SOURCE OF THE SYMBOLIC. INDEX IS THE LOCATION IN ADDL31395000
OF THE BEGINNING; 31396000
IF DEFINEINDEX > 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]&GTI1[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 <BEXP> 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 <AEXP> 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<INTROAID AND ELCLASS!PCID THEN 50204000
BEGIN 50204100
N~BOUND(ELBW ~ ELBAT[I]); 50204150
IF TABLE(I+1) = LFTBRKT THEN 50204200
BEGIN STEPIT; 50204250
IF T~SUBSCRIBER(ELBW.ADDRESS,N) > 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(TYPE<XTYPE AND GT1<XTYPE) AND (TYPE.ARAYTPE=WTYPE OR 51044500
GT1.ARAYTPE=WTYPE) THEN ELSE 51044800
IF TYPE = ITYPE THEN 51045000
IF GT1 = ATYPE OR GT1 = ETYPE THEN EMIT(NTGR) 51046000
ELSE GO ECH 51047000
ELSE 51048000
IF TYPE = ETYPE THEN 51049000
IF GT1 = ATYPE OR GT1 = ITYPE OR GT1=WTYPE THEN EMIT(XTND)51050000
ELSE GO ECH 51051000
ELSE 51052000
IF TYPE = ATYPE THEN 51053000
IF GT1 = ETYPE THEN EMIT(SNGL) ELSE 51054000
IF GT1 = ITYPE THEN ELSE GO ECH 51055000
ELSE ECH: 51056000
IF GT1!WTYPE THEN FLAG(505) ELSE 51056500
51057000
END EXPRESSION; 51058000
INTEGER PROCEDURE CASEXP; 51059000
COMMENT CASEXP WILL COMPILE A CASE EXPRESSION, AND RETURN THE TYPE 51060000
THEREOF; 51061000
BEGIN INTEGER LT )"A TEMP FOR L USED FOR DIFFERENT THINGS"( 51062000
S )"USED FOR CREATING AND CHASING LINKS "( 51063000
T )"EXPRESSION TYPE, THEN TEMP FOR S "( 51064000
N; COMMENT EXPRESSION COUNTER; 51065000
LT ~ CASEHEAD; 51066000
IF ELCLASS = LFTPRN THEN STEPIT ELSE FLAG(506); 51067000
S ~ L; COMMENT S POINTS, IN TURN, TO THE START OF EACH 51068000
EXPRESSION; 51069000
CASEXP ~ T ~ EXPRSS; 51070000
EMIT3(S); S ~ L; COMMENT SAVE S IN EDOC, AND SAVE L IN S; 51071000
WHILE ELCLASS = COMMA DO 51072000
BEGIN STEPIT; 51073000
EXPRESSION(T); 51074000
N ~ N + 1; 51075000
EMIT3(S); S ~ L; 51076000
END EXPRESSION LIST; 51077000
WHILE L MOD 3 ! 0 DO EMIT(NVLD); COMMENT ADJUST FOR BRANCH TBL;51078000
CASETAIL(N,L,LT); COMMENT FIX UP HEAD CODE; 51079000
L ~ LT ~ 3 | N + L + 3; COMMENT COMPUTE EXIT POINT ADDRESS; 51080000
DO BEGIN 51081000
T ~ GET3(S-3); COMMENT GET OLD S; 51082000
EMITB(BRUN,S,L); COMMENT FIX EXIT BRANCH; 51083000
EMITB(BRUN,LT,S~T); COMMENT FIX TABLE BRANCH; 51084000
LT ~ LT - 3 51085000
END UNTIL N ~ N - 1 < 0; 51086000
IF ELCLASS ! RTPARN THEN FLAG(507) ELSE STEPIT; 51087000
END CASE EXPRESSION HANDLER; 51088000
PROCEDURE RELATION(T); VALUE T; INTEGER T; 51089000
COMMENT GUESS WHAT THIS GUY HANDLES... 51090000
T IS THE TYPE OF THE FIRST EXPRESSION(REFERENCE, POINTER, OR 51091000
ARITHMETIC), WHICH HAS ALREADY BEEN COMPILED; 51092000
BEGIN 51093000
INTEGER OP; 51094000
LABEL EXIT; 51094100
LABEL ON; 51094200
OP ~ ELBAT[I].DISP; 51095000
STEPIT; 51096000
IF T=ITYPE OR T=ATYPE OR T=DTYPE OR (T=WTYPE AND OP=SAME) THEN 51097000
BEGIN COMMENT ARITHMETIC TYPES; 51098000
IF GT1~AEXP<XTYPE OR (GT1=WTYPE AND OP!SAME)THEN FLAG(508)51099000
END ELSE 51100000
IF T = RTYPE THEN 51101000
BEGIN COMMENT REFERENCE RELOP MUST BE = OR !; 51102000
IF OP ! EQUL AND OP ! NEQL THEN FLAG(509); 51103000
T ~ REXP(FALSE); GO ON; 51104000
51104100
END ELSE 51105000
IF T = PTYPE THEN 51106000
BEGIN COMMENT POINTER OR STRING RELATION; 51107000
IF ELCLASS = STRING OR ELCLASS = STRNGCON THEN 51107100
BEGIN COMMENT STRING RELATION; 51107200
STRINGSOURCE; T ~ COUNT; 51107300
IF STEPI ! FORV THEN EMITNUM(T) ELSE 51107400
BEGIN STEPIT; EXPRESSION(ATYPE) END; 51107500
EMIT(OP-LESS+CLSD); EMIT(RTFF); 51107600
GO EXIT; 51107610
END ELSE 51107700
BEGIN 51107800
T ~ PEXP(TRUE); 51108000
IF ELCLASS = FORV THEN 51109000
BEGIN COMMENT STRING RELATION; 51110000
STEPIT; 51111000
EXPRESSION(ATYPE); 51112000
IF T=ATYPE THEN BEGIN 51112100
EMITPAIR(T~GETSTACK,OVRN); EMIT(EXSU); 51112200
EMIT(SRSC); EMITV(T); RTNSTACK(T) END; 51112300
EMIT(OP-LESS+CLSD); EMIT(RTFF); 51113000
GO EXIT; 51113100
END ELSE 51114000
IF T =ATYPE THEN ERR(510) ELSE 51114100
BEGIN 51115000
ON: 51115050
EMIT(SAME); 51115100
IF OP = NEQL THEN EMITNOT ELSE 51115200
IF OP ! EQUL THEN FLAG(510); 51115300
GO TO EXIT; 51115310
END; 51115400
END; 51116000
END ELSE FLAG(511); 51117000
EMIT(OP); 51118000
LASTNOT ~ -L; COMMENT ALLOW EMITNOT TO NEGATE RELOP; 51119000
EXIT: 51119100
END RELATION; 51120000
PROCEDURE BEXP; 51121000
IF GT1 ~ EXPRSS ! BTYPE AND GT1 ! WTYPE THEN FLAG(512); 51122000
INTEGER PROCEDURE AEXP; 51123000
IF ELCLASS = IFV THEN 51124000
BEGIN 51125000
IF(AEXP~GT1~IFEXP>ITYPE 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)<XTYPE OR GT1 = WTYPE THEN FLAG(515) ELSE 51169000
IF GT1 = DTYPE THEN T ~ DTYPE ELSE 51170000
IF T ! DTYPE THEN 51171000
IF OP = IDIV THEN T ~ ITYPE ELSE 51172000
IF OP = MULX THEN T ~ DTYPE ELSE T ~ ATYPE; 51173000
EMIT(OP); 51174000
END; 51175000
AWAY: TERM ~ T 51176000
END TERM; 51177000
INTEGER PROCEDURE BOOSEC; 51178000
COMMENT BOOSEC GRABS OFF A BOOLEAN SECONDARY, WHICH IS A (POSSIBLY 51179000
NEGATED) BOOLEAN PRIMARY: OF COURSE, ALLOWANCES ARE MADE FOR 51180000
NON-BOOLEAN ACTION; 51181000
IF ELCLASS ! NOTOP THEN BOOSEC ~ BOOPRIM ELSE 51182000
BEGIN STEPIT; 51183000
IF BOOSEC ~ BOOPRIM ! BTYPE THEN FLAG(516); 51184000
EMITNOT 51185000
END BOOLEAN SECONDARY; 51186000
PROCEDURE BOOCOMP; 51187000
COMMENT BOOCOMP COMPLETES A BOOLEAN SOMETHING, WHERE THE SOMETHING MAY 51188000
BE SIMPLE, IMPLICATION, TERM, OR FACTOR, DEPENDING ON THE 51189000
LOGICAL OPERATOR THAT I IS POINTING TO AT ENTRY; 51190000
BEGIN LABEL ON; 51191000
REAL ELBW; 51192000
ELBW ~ ELBAT[I]; 51193000
DO BEGIN 51194000
IF ELBW.ADDRESS = 0 THEN COMMENT IMP OPERATOR-CHECK; 51194100
IF L = ABS(LASTNOT) THEN COMMENT WE CAN OPTIMIZE; 51194200
BEGIN EMITNOT; ELBW.ADDRESS ~ LOR END; 51194300
COMMENT THE "IMP" OPERATOR, AS IN A IMP B, MAY BE CODED IN51194400
(AT LEAST) TWO WAYS: AS NOT(A AND NOT B), OR AS 51194500
(NOT A) OR B. WE DO THE LATTER IFF THE "NOT" WILL51194600
DISAPPEAR: ELSE WE DO THE FORMER, AND HOPE THAT 51194700
SOMEBODY ELSE OPTIMISES; 51194800
STEPIT; 51195000
IF BOOSEC ! BTYPE THEN FLAG(517); 51196000
WHILE ELCLASS = LOGOP DO 51197000
IF ELBAT[I].TYPE > 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 (ELCLASS<SEMICOLON 51207400
OR ELCLASS>ELSEV) 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<BOOARRAYID THEN N 57279000
ELSE GIT(N).QLINK)).CLASS; 57280000
COMMENT ARRAY ITEMS HAVE LINK TO Q IN QLINK OF FIRST ADDL WORD; 57280010
IF (NEXTCLASS~TABLE(I+1))=ATSIGN OR (NEXTCLASS=LFTBRKT 57281000
AND QUEUECLASS=QUEUEARRAYID) 57281500
THEN 57282000
BEGIN COMMENT (MCS 2); 57283000
COMMENT OTHER THAN SINGLE LOGICAL QUANTITY; 57284000
STEPIT; STEPIT; 57285000
IF NEXTCLASS =ATSIGN 57286000
THEN 57287000
BEGIN COMMENT (MCS 3); 57288000
COMMENT WE EXPECT A QUEUEID FOLLOWED BY REF EXPRESSUN;57289000
57290000
EXPRESSION(RTYPE); 57291000
END MCS 3 57292000
ELSE 57293000
BEGIN COMMENT (MCS 4); 57294000
COMMENT WE EXPECT A QUEUEARRAYID FOLLOWED BY AN 57295000
ARITHMETIC EXPRESSION; 57296000
57297000
EXPRESSION(ATYPE); 57298000
EMITN(QUEUEINFO.ADDRESS); 57299000
EMIT(NXLN); 57300000
IF ELCLASS!RTBRKT THEN GO QUIT ELSE STEPIT 57301000
END MCS 4 57302000
END MCS2 57303000
ELSE 57304000
BEGIN COMMENT (MCS 5); 57305000
COMMENT SINGLE LOGICAL OUANTITY; 57306000
57307000
IF QUEUECLASS! QUEUEID THEN GO QUIT; 57308000
EMITN(QUEUEINFO.ADDRESS); 57309000
STEPIT; 57310000
END MCS 5; 57311000
COMMENT WE HAVE NOW TO OBTAIN ITEM; 57312000
EMITNUM(INDEX); 57313000
57314000
COMMENT WE NOW HAVE INDEX AND DESCRIPTOR SITTING ON TOP OF STACK; 57315000
LASTINDEX~L ; 57315500
IF ITEMINFO.TYPE=FORMALNAMEQ OR (GTB1~GT1=WORDID) 57316000
THEN BEGIN EMIT(INDX);EMIT(IF GTB1 THEN LODT ELSE LOAD) 57316200
END % NAME CALL,WORD ITEMS 57316250
ELSE IF F=FS OR ELCLASS=ASSNOP 57316300
THEN EMIT(INDX) 57316400
ELSE IF GT1=REFID OR 57316500
GT1=PTRID THEN BEGIN EMIT(INDX);IF F!FR THEN EMIT(LOAD) END 57316600
ELSE EMIT(NXLV); % EVERYTHING ELSE ARITH OR BOOL 57316800
GO FINI; 57317000
QUIT: 57318000
COMMENT ALL ERRORS PROCESSED HERE; 57319000
FLAG(542);ERRORTOG~TRUE; 57320000
FINI: END MCS 1 ITEMREFERENCE; 57321000
COMMENT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 60000000
STATEMENTS 60001000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *;60002000
PROCEDURE CASESTMT; 60003000
BEGIN 60004000
INTEGER LT,S,T,N,SN,FSN,LCTR,LN ; 60005000
DEFINE E = GT1#, NEXTADDL = LASTADDL#; 60006000
%**************** HERE BEE DRAGONS *********************************60006100
LABEL ON,INN; 60007000
DEFINE FWD = TYPE =F0RWARD#; 60008000
LT ~ CASEHEAD; 60009000
T~ 60009100
SN ~ FSN ~ LN ~ -1; 60010000
S ~ L; 60011000
IF ELCLASS ! BEGINV THEN FLAG(601) ELSE ELCLASS ~ SEMICOLON; 60012000
BEGINCTR ~ BEGINCTR + 1; 60012100
DO BEGIN 60013000
CONTEXT ~ 2; 60014000
IF ELCLASS ! SEMICOLON THEN ERR(600) ELSE 60015000
IF STEPI ! SEMICOLON THEN 60016000
IF ELCLASS ! ENDV THEN 60017000
BEGIN 60018000
IF ELCLASS = GOV THEN 60019000
BEGIN 60020000
IF TABLE(I+1) = TOV THEN NXTELBT ~ NXTELBT - 1; 60021000
IF TABLE(I+1) ! LABELID THEN 60022000
BEGIN I ~ I + 1; 60022100
IF FUTZALABEL THEN I ~ I - 1 ELSE 60022200
BEGIN E ~ ELBAT[I]; I~I-1; GO INN END; 60022300
END ELSE 60022400
IF (E ~ ELBAT[I+1]).LINK } NINFOO THEN 60023000
INN: 60023100
BEGIN E.DISP ~ LN ~ N; 60024000
PUTNBUMP(E); 60025000
LCTR ~ LCTR + 1; 60026000
ELCLASS ~ TABLE(I~I+2); 60027000
IF T < 0 THEN T ~ N; 60027100
GO ON 60028000
END; END; 60029000
STATEMENT; 60030000
EMITLINK(S & SN ~ N [24:40:8]); 60031000
IF FSN < 0 THEN FSN ~ N; 60032000
S ~ L 60033000
END; 60034000
ON: IF N ~ N + 1 = 256 THEN FLAG(602); 60035000
END UNTIL ELCLASS = ENDV; 60036000
IF T > 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]).LINK<NINFOO THEN 60450000
BEGIN 60450100
CASECASE: 60450200
EMIT(ZERO); 60450220
EMIT(DUPL); 60450230
EMIT(MKST); 60450300
EMITN(GOTOSOLVERPCW); 60450400
IF ELBW.DISP=0 THEN 60451000
BEGIN 60452000
PCWADDR~GETSPACE(-ELBW.LVEL); 60453000
GT1~TAKE(ELBW); 60454000
GT1.ADDRESS~PCWADDR; 60455000
IF PRTOG THEN 60455100
PRINTSPACE(ELBW,ELBW.LVEL ,GT1.DISP&GT1[32:2:1]); 60455200
PUT(GT1,ELBW); 60456000
END ELSE 60457000
PCWADDR~ELBW.ADDRESS; 60458000
EMITPAIR(PCWADDR,STFF); 60458100
EMIT(ZERO); 60458200
EMIT(STAG); 60458300
EMIT(ENTR); 60458400
IF TB1 THEN 60459000
BEGIN 60459200
STEPIT; 60459300
GO EXIT; 60459350
END ELSE 60459400
GO CONTINUECASE; 60459600
END; 60459700
IF TB1 THEN 60460000
BEGIN 60461000
GOGEN(ELBAT[I],BRUN); 60462000
STEPIT; 60463000
GO TO EXIT; 60464000
END; 60465000
ON: LT := CASEHEAD; 60466000
IF ELCLASS ! LFTPRN THEN FLAG(817); 60467000
S ~ LASTADDL; 60468000
60469000
60469100
DO BEGIN 60470000
IF STEPI ! LABELID THEN 60471000
IF FUTZALABEL THEN 60471100
BEGIN 60472000
ERR(618); 60473000
GO TO EXIT; 60474000
END; 60475000
IF (ELBW ~ ELBAT[I]).LINK < NINFOO THEN 60476000
BEGIN PUTNBUMP(L); GO TO CASECASE END; 60476500
PUTNBUMP(ELBW); %GOES BOOMP IN THE NIGHT 60477000
CONTINUECASE: 60477500
N~N+1; 60478000
STEPIT; 60479000
END UNTIL ELCLASS ! COMMA; 60480000
WHILE L MOD 3 ! 0 DO EMIT(NVLD); 60481100
CASETAIL(N-1, L, LT); 60482000
LT ~ S; 60482100
DO IF (N ~ GIT(LT)).CLASS = 0 THEN EMITB(BRUN,BUMPL,N) ELSE 60482200
GOGEN(N,BRUN) UNTIL LT ~ LT + 1 } LASTADDL; 60482250
LASTADDL ~ S; 60482300
IF ELCLASS ! RTPARN THEN FLAG(619) ELSE STEPIT; 60483000
EXIT: 60484000
END GOSTMT; 60485000
REAL PROCEDURE PROCALL(FROM, WISH); VALUE FROM, WISH; 60486000
BOOLEAN FROM; REAL WISH; 60486100
COMMENT PROCALL COMPILES CODE FOR ALL PROCEDURE STATEMENTS AND FUNCTION 60487000
CALLS. THE PARAMETER...FROM....TELLS WHO CALLED. IF 60488000
STMT CALLED FROM IS FALSE. PROCALL ALSO HANDLES FUNCTION60489000
NAME ASSIGNMENT OPERATIONS; 60490000
COMMENT WISH TELLS WHAT TYPE OF EXPRESSION WE ARE HOPING FOR; 60490100
BEGIN 60491000
INTEGER ADDLADRES,T1,T2,T3; 60492000
REAL K; 60492100
BOOLEAN TB1; 60493000
LABEL FINI ,SKIP1,SKIP2; 60494000
PROCALL ~ WISH; %UNLESS WE LEARN OTHERWISE 60494100
SCATTERELBAT; 60495000
ADDLADRES ~ TAKE(ELBAT[I]).LINK; 60496000
T1~ADDRSF; 60497000
T2~ADDLADRES; 60498000
T3~TYPEF; 60499000
60500000
COMMENT ADDLADRES HOLDS LINK TO ADDL; 60501000
IF (TB1~ ELCLASS!PROCID) THEN 60502000
IF NOT FORMALF THEN 60503000
IF TABLE(I+1) = ASSNOP THEN 60504000
BEGIN 60505000
GT1~VARIABLE(IF FROM THEN FP ELSE FS);GO TO FINI 60506000
END; 60506050
IF ELCLASS=PROCID AND FROM THEN 60507000
BEGIN ERR(603); GO TO FINI END; 60508000
COMMENT IT IS PROCEDURE IF AND ONLY IF WE COME FROM STMT; 60509000
60510000
IF T3=INTRINSIC THEN 60511000
BEGIN 60512000
STEPIT; 60512100
IF T1 = HALT THEN T2 ~ 7 ELSE 60512200
IF T1 = SRCH THEN T2 ~ 6 ELSE 60512500
IF T1 = RETN THEN T2 ~ 5; 60512600
IF T2 { 7 THEN 60513000
BEGIN 60514000
IF T2>0 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<PTRID AND K.CLASS!WORDID) 60518220
THEN EMIT(EVAL) ELSE EMIT(LOAD); 60518230
STEPIT; 60518232
END; 60518233
END; 60518235
BEGIN 60518240
STEPIT; 60518245
K~AEXP; 60518250
IF ELCLASS! COMMA THEN ERR(609); 60518260
IF STEPI=UNKNOWNID OR 60518270
ELCLASS = NUMBER THEN 60518271
FLAG(622); 60518272
IF (K~ELBAT[I]).LINK<FIRSTINFO THEN FLAG(622); 60518273
IF GT1~TABLE(I+1)=LFTBRKT OR 60518274
GT1 = ATSIGN THEN 60518275
PROCALL~GT1~VARIABLE(FR) ELSE 60518276
BEGIN 60518279
EMITN(K.ADDRESS); 60518280
IF K.TYPE=FORMALNAMEP THEN 60518281
EMIT(LOAD); STEPIT; 60518282
PROCALL := (GT1 := K).CLASS - BOOID END; 60518283
IF GT1<0 OR (GT1~ K.CLASS }BOOARRAYID AND GT1{WORDARRAYID) THEN 60518284
PROCALL ~ WTYPE; 60518285
EMIT(RDLK); 60518289
END; 60518290
BEGIN % DECIMAL 60518300
STEPIT; 60518310
K ~ AEXP; 60518320
EMIT1P(SCRF,12); 60518330
END; 60518340
BEGIN % BINARY 60518350
STEPIT; 60518355
K ~ AEXP; 60518360
EMITNUM(12); 60518380
EMIT(ICVD); 60518390
END; 60518400
BEGIN STEPIT; K~EXPRSS; EMIT(T1) END % RETURN 60518405
;BEGIN % SRCH 60518410
STEPIT; K ~ EXPRSS; 60518420
IF ELCLASS ! COMMA THEN FLAG(623); 60518430
STEPIT; EXPRESSION(K); 60518440
IF ELCLASS ! COMMA THEN FLAG(623); 60518450
MAKEARRAYROW; EMIT(SRCH); 60518460
END 60518470
;IF ELCLASS=LFTPRN THEN BEGIN %STOP(EXP) 60518480
STEPIT; K ~ EXPRSS; 60518490
IF ELCLASS=COMMA THEN BEGIN 60518492
STEPIT; K := EXPRSS END ELSE 60518494
EMIT(ZERO); EMIT(EXCH); 60518495
TB1 ~ BOOLEAN(T2 ~1); 60518500
EMIT(HALT); EMIT(DLET) END ELSE BEGIN 60518510
EMIT(HALT); GO FINI END; 60518520140621PK
END CASES ON T2; 60518970
IF T2 > 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 SCLASS<BOOARRAYID 60564300
OR SCLASS>WORDARRAYID) AND (SCLASS!WORDARRAYID 60564400
OR ACLASS<BOOARRAYID OR ACLASS>EVENTARRAYID 60564500
OR ACLASS=PCID)#, 60564600
NOTWORDPROCID=(ACLASS!WORDPROCID OR SCLASS<BOOPROCID 60564700
OR SCLASS>PTRPROCID) AND (SCLASS!WORDPROCID60564800
OR ACLASS<BOOPROCID OR ACLASS>PTRPROCID)#, 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<BOOARRAYID OR 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 TYPE<O FOR ARRAY EXPRESSIONS, NOTE 60639000
DEPENDENCE ON CLASS RELATIVITIES; 60640000
BEGIN COMMENT ARRAY EXRPESSION CLEANUP; 60641000
ACLASS~ T1.ARAYTPE + BOOARRAYID; 60642000
COMMENT *** EVENT ARRAYS ARE NOT YET CATERED FOR; 60643000
IF ACLASS=INTARRAYID THEN ACLASS~REALARRAYID; 60644000
DIMCHECK: IF ((IF FROM THEN T7 ELSE GIT(T7.LINK)).NODIM) 60645000
!T1.ARAYDIM AND NOTFORMALWORDARRAY THEN 60645500
COMMENT *** ASSUMED THAT FIRST WORD OF ADDL FOR ARRAY FORMAL 60646000
PARAMETER CONTAINS NUMBER OF DIMENSIONS IN NODIM; 60647000
BEGIN FLAG(605); GO TO CERR END 60648000
END ARRAY EXPRESSION CLEANUP; 60649000
IF ACLASS=INTID THEN ACLASS~REALID; 60649500
GO TO BS; 60650000
END OF EXPRESSION CALL CODE; 60651000
COMMENT IF WE REACH THIS POINT THE ACTUAL PARAMETER STARTS 60652000
WITH AN ARRAY NAME FOLLOWED BY SOMETHING ELSE; 60653000
IF VBIT THEN GO TO VE; 60654000
IF TABLE(I+2)!NUMBER OR (GT1~TABLE(I+4)!COMMA AND 60655000
GT1!RTPARN) THEN GO TO NORMAL ELSE 60656000
COMMENT IF WE REACH THIS POINT WE HAVE A ONE DIMENSIONAL 60657000
SUBSCRIPTED VARIABLE - CONSTANT LOWER BOUND CALLED 60658000
BY NAME.WE OPTIMISE BY AVOIDING ACCIDENTAL ENTRY; 60659000
BEGIN 60660000
GT1~VARIABLE(FP);INDXCHK; 60661000
IF ACLASS=WORDARRAYID THEN L~L-2; 60661200
IF ACLASS= EVENTARRAYID THEN ACLASS~EVENTID 60662000
ELSE 60663000
IF ACLASS>PCID 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
<ITEM IDENTIFIER> OR60810080
<ITEM IDENTIFIEP> @ <REFERENCE IDENTIFIER> OR60810100
60810120
<ITEMREFERFNCE> (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
<QUEUE DESIGNATOR>::=<REFERENCE EXPRESSION> WHERE 60854000
<QUEUE DESIGNATOR>::=<QUEUE IDENTIFIER>/<QUEUE ARRAY60855000
IDENTIFIER>[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)<XTYPE OR LASTINDEX 60909500
!L-1 60909600
THEN FLAG(630) 60909605
ELSE GO TO LOCKL; 60910000
TEMPNO~6;DT1~ELCLASS;DT2~ELCLAS;D4; 60910200
RESIGN: FLAG(630);GO QUIT; 60910400
END MCS 2AA LOCK ALGORITHM AND NOT QUEUE 60910600
60910800
ELSE 60911000
BEGIN COMMENT MCS 2AB; 60911400
N~TAKE(ELBAT[I]) .LINK; 60911600
GT2~GIT(ADDLADRES~IF ELCLASS=QUEUEID 60911800
THEN N ELSE N+1); 60912000
END MCS 2AB; 60912200
CONTINU : STEPIT; 60912400
IF NOTQUEUE THEN GO TO LOCKL; 60912600
COMMENT NON QUEUE LOCK,UNLOCK AND BUSY ARE ALSO HANDLED HERE; 60912800
COMMENT ADDLADRES NOW HOLDS ADDRESS OF FIRST RELEVANT QUEUE 60913000
ADDL ENTRY; 60914000
IF KEY=SIZEKEY 60914300
THEN 60914350
BEGIN COMMENT MCS 2A; 60914400
COMMENT MUST PUT ENTRY SIZE IN TOP OF STACK; 60914450
EMITNUM(GT2.SIZEF); 60914500
WHEREFROM: IF NOT FROM THEN 60914550
BEGIN FLAG(648);GO QUIT END; 60914600
ISRTPARN: IF ELCLASS!RTPARN THEN 60914650
BEGIN FLAG(634); GO QUIT END; 60914700
STEPIT; 60914705
GO FINI 60914750
END MCS 2A; 60914800
IF GTB1 60914850
THEN 60914900
BEGIN COMMENT MCS 2B; 60914950
COMMENT MUST FIND OUT IF QUEUE IS LOCKED; 60914955
IF (GT3~GT2.ADDRESS)=0 THEN 60915000
BEGIN FLAG(628); GO QUIT END; 60915050
COMMENT THERE WAS NO LOCK SPECIFICATION IN QDEC; 60915100
60915150
60915152
60915153
60915154
60915155
LOCKL: TB~GT3!0; 60915200
GTB1~(GT4~GT5.TYPE)!FORMALNAMEP 60915225
AND GT5!FORMALNAMEQ; 60915228
TB1~ELCLAS!WORDID; 60915230
IF KEY=BUSYKEY THEN 60915235
BEGIN COMMENT MCS PRB; 60915240
IF ISVALUE 60915245
THEN 60915250
ELSE 60915255
BEGIN 60915260
IF TB AND GTB1 AND TB1 60915270
THEN EMITV(GT3) 60915280
ELSE 60915290
BEGIN IF TB THEN EMITN(GT3);IF NOT TB OR NOT GTB1 THEN EMIT 60915300
(EVAL);EMIT(IF TB1 THEN LOAD ELSE LODT) END; 60915305
END; 60915312
GO WHEREFROM ; 60915313
END MCS 2BB; 60915315
TEMPNO~10;DT1~KEY;DT2~REAL(TB);DT3~REAL(GTB1);DT4~REAL(TB1);D4; 60915318
IF TB 60915320
THEN BEGIN EMITN(GT3);IF NOT GTB1 THEN 60915325
EMIT(EVAL) END 60915330
ELSE 60915335
IF NOT ISVALUE 60915340
THEN EMIT(EVAL) 60915343
ELSE IF TB1 60915346
THEN INDXCHK ELSE L~L-1; 60915350
IF(BUZF~(KEY=BUZZKEY OR KEY=CONTROLBUZZKEY)) 60915352
THEN BEGIN GT2~L;EMIT(DUPL) END; 60915354
60915400
EMITNUM(IF KEY=UNLOCKKEY THEN 0 ELSE 1); 60915450
IF BUZF EQV FROM 60915480
THEN IF BUZF 60915500
THEN FLAG(669) 60915520
ELSE EMIT(IF ELCLASS=DPID THEN 60915540
OVRD ELSE STOD) 60915550
60915555
ELSE BEGIN 60915570
IF KEY =BUZZKEY 60915572
THEN BEGIN 60915574
EMIT(EEXI);EMIT(DEXI );60915576
END; 60915578
EMIT(RDLK); 60915580
END; 60915590
IF KEY=UNLOCKKEY AND FROM THEN EMIT(LNOT);60915600
IF BUZF THEN 60915620
BEGIN 60915640
60915650
60915660
EMITB(BRTR,BUMPL,GT2); 60915670
EMIT(DLET); 60915675
END; 60915680
GO ISRTPARN; 60915700
END MCS 2B; 60915750
DESCPARA ~ GT1.PARADESC; 60916000
END MCS 2 EXPLICIT CALLS 60916500
ELSE IF PARINFO=1 THEN BEGIN DESCPARA~0;KEY~ALLOCATEKEY END 60917000
ELSE 60918000
BEGIN COMMENT (MCS 3) IMPLICIT INSERT; 60919000
KEY ~ INSERTKEY; 60920000
DESCPARA~IF PARINFO=2 THEN 1 ELSE 4 60921000
END MCS 3 ; 60922000
COMMENT KEY HAS BEEN OBTAINED FROM ELBATWORD FOR EXPLICIT CALL AND 60923000
HAS BEEN SET TO ALLOCATEKEY FOR IMPLICIT CALL ON ALLOCATE AND60924000
TO INSERTKEY FOR IMPLICIT CALL ON INSERT 60925000
DESCPARA CONTAINS INFORMATION ON THE KIND AND DISPOSITION 60926000
OF ACTUAL PARAMETERS; 60927000
EMIT(MKST); 60928000
GT1~ADDLADRES+GT2.ITMNOF+1; 60929000
TEMPNO~1;TD~GIT(GT1);DT1~KEY;DT2~GT1;D4; 60929500
GT2 ~ GT2.ALGNOF + GT1-1; 60930000
COMMENT GT1 NOW POINTS TO FIRST AND GT2 TO LAST Q ALG0RITHM ADDL 60931000
ENTRY; 60932000
FOR N~GT1 STEP 1 UNTIL GT2 DO 60933000
IF (GT3 ~ GIT(N)).ALGNO = KEY THEN GO ON; 60934000
COMMENT ERROR - NO MATCH; 60935000
FLAG (628); GO QUIT; 60936000
ON: EMITN (GT3.ADDRESS); 60937000
TYPEA ~ GT3.TYPE; 60938000
IF TYPEA=PROCD AND FROM THEN BEGIN FLAG(649);GO QUIT END; 60938500
COMMENT AN UNTYPED QALGORITHM MAY NOT BE USED AS A PRIMARY; 60938550
COMMENT GT3.ADDRESS HOLDS ADDRESS OF PCW, GT3.TYPE HOLD ALGORITHM 60939000
TYPE; 60940000
NOPAR~ 2; 60941000
ACTUALP[1]~ RTYPE; ACTUALP[2]~ITYPE; 60942000
IF DESCPARA<2 60943000
THEN NOPAR~ DESCPARA 60944000
ELSE IF DESCPARA=2 60945000
THEN BEGIN NOPAR~1; ACTUALP[1]~ITYPE END 60946000
ELSE IF DESCPARA=4 60947000
THEN BEGIN ACTUALP[1]~ITYPE; ACTUALP[2]~RTYPE END; 60948000
COMMENT ***CHECK THIS CODE LATER - WOULD SWITCH BE BETTER; 60949000
60950000
60951000
60952000
N~-1; 60953000
COMMENT AT THIS POINT, I POINTS TO A LFTBRKT OR AN ASSNOP FOR 60954000
AN IMPLIED INSERT CALL AND TO A COMMA OR A RTPRN FOR 60955000
AN EXPLICIT CALL; 60956000
ANOTHER: IF(N~N+1)=NOPAR THEN GO FINISH; 60957000
IF PARINFO=0 60957500
THEN 60958000
BEGIN COMMENT MCS 4; 60958500
IF ELCLASS = COMMA AND (N=0 OR N=1) 60959000
THEN GO CONTINUE ; 60959050
IF ELCLASS=RTPARN THEN BEGIN 60960000
MISSINGACTUAL~TRUE;GO CONTINUE END 60960050
END MCS 4; 60961000
IF PARINFO=3 60961500
THEN 60962000
BEGIN COMMENT MCS 4A; 60962500
IF ELCLASS=LFTBRKT AND N =0 THEN GO 60963000
CONTINUE; 60963050
IF ELCLASS=RTBRKT AND N =1 AND TABLE 60964000
(I+1)=ASSNOP THEN 60964040
BEGIN STEPIT;GO CONTINUE END; 60964080
END MCS 4A; 60964081
IF PARINFO=2 AND ELCLASS=ASSNOP AND N =0 THEN 60965000
GO CONTINUE; 60965030
COMMENT *** ABOVE SWAG OF CODE IS MESSY,MAYBE IT CAN BE 60965050
REPLACED LATER; 60965080
FLAG(634);GO QUIT; 60966000
COMMENT SOMETHING IS WRONG. NOMINALLY AN ILLEGAL PARAMETR60967000
DELIMETER; 60967500
CONTINUE: IF NOT MISSINGACTUAL THEN STEPIT; 60968000
IF(GT1~ACTUALP[N+1]) = RTYPE 60969000
THEN IF MISSINGACTUAL 60970000
THEN 60971000
BEGIN COMMENT(MCS 5); 60972000
COMMENT THE ALGORITHM CALLS FOR A REFERENCE PARAMETER.60973000
THERE IS NO CORRESPONDING ACTUAL PARAMETER. 60974000
THIS IS NOT AN ERROR HOWEVER WE PASS ZERO 60975000
WHICH WILL CAUSE A RUN-TIME ERROR IF 60976000
REFERENCED AS A DESCRIPTOR; 60977000
EMIT(ZERO); 60978000
60979000
60980000
GO TO ANOTHER; 60981000
END MCS 5 MISSING ACTUAL REFERENCE PARAMTER 60982000
ELSE 60983000
BEGIN COMMENT (MCS 6); 60984000
COMMENT NON DUMMY REFERENCE PARAMETER; 60985000
EXPRESSION(RTYPE); 60986000
STAP: 60987000
GO TO ANOTHER 60988000
END MCS 6 NON DUMMY REFERENCE 60989000
ELSE IF MISSINGACTUAL 60990000
THEN 60991000
BEGIN COMMENT (MCS 9); 60992000
COMMENT DUMMY ITYPE PARAMETER. PASS CONTROL WORD; 60993000
EMIT(ZERO); 60994000
EMITNUM(7); 60995000
60996000
EMIT(STAG); 60997000
GO TO ANOTHER 60998000
COMMENT ***; 60999000
END MCS 9 DUMMY ITYPE 61000000
ELSE 61001000
BEGIN COMMENT (MCS 10); 61002000
COMMENT NON DUMMY ITYPE PARAMETER; 61003000
EXPRESSION(ITYPE); 61004000
GO TO ANOTHER; 61005000
END MCS 10 NON DUMMMY ITYPE PARAMETER; 61006000
FINISH: 61007000
COMMENT AT THIS POINT HAVE PASSED ALL PARAMETERS. I SITTING ON 61008000
RTPARN(EXPLICIT CALL) OR ON LFTPARN (IMPLICIT ALLOCATE)61009000
OR ON SOMETHING ELSE (IMPLICIT INSERT).HOWEVER NEED 61010000
CHECK ONLY ON EXPLICIT CALL; 61010050
IF PARINFO = 0 61011000
THEN IF ELCLASS=RTPARN 61012000
THEN STEPIT 61013000
ELSE GO QUIT 61014000
ELSE; 61015000
EMITENTER: IF PARINFO =3 THEN EMIT (EXCH); 61016000
COMMENT:*** AN IMPLICIT CALL ON INSERT OF THE FORM: 61017000
<QUEUE ARRAY IDENTIFIER>[<INDEX>]~<REFERENCE EXPRSSION>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 GT3<BOOARRAYID 61033528
THEN GT1.LINK 61033531
ELSE GIT(GT1.LINK).QLINK 61033534
) ).LINK + 61033537
GT1.ITMQAINDXF+ 61033540
(IF GT2.CLASS=QUEUEID THEN 0 61033543
ELSE 1) 61033546
) , 61033549
1 , 61033552
FALSE ); 61033555
GO FINI; 61033558
END; % STOREITEM 61033561
61033564
61033567
61033570
END MCS1 CASE STATEMENT; 61033580
CHECK: 61033590
IF ELCLASS=RTPARN 61033600
THEN STEPIT 61033700
ELSE 61033800
BEGIN COMMENT MCS 3; 61033900
RESIGN: FLAG(672); 61034000
ERRORTOG~TRUE; 61034100
DO UNTIL STEPI=SEMICOLON 61034200
END MCS 3; 61034300
FINI: 61034350
END EVENTINTRINSIC; 61034400
PROCEDURE SCANSTMT; 61035000
BEGIN 61036000
REAL NEWSP,NEWCT,T,OP; 61037000
LABEL ENTERA,ENTERB,ENTERC,EXIT; 61038000
BOOLEAN WHILETOG; 61039000
STEPIT; 61040000
IF TABLE (I+1) = COLON THEN 61041000
BEGIN 61042000
IF ELCLASS ! PTRID THEN FLAG(643) ELSE 61043000
NEWSP ~ ELBAT[I]; 61044000
STEPIT; STEPIT; 61045000
END; 61046000
GT1 ~ PEXP(FALSE); 61047000
IF ELCLASS ! FORV THEN GO TO ENTERA; 61048000
STEPIT; 61049000
IF TABLE (I+1) = COLON THEN 61050000
BEGIN 61051000
IF ELCLASS ! REALID AND ELCLASS!INTID AND ELCLASS!WORDID 61052000
THEN 61052500
FLAG(644) ELSE NEWCT ~ ELBAT[I]; 61053000
STEPIT; STEPIT; 61054000
END; 61055000
GT1 ~ AEXP; 61056000
ENTERA: IF ELCLASS ! WHILEV AND ELCLASS ! UNTILV THEN 61057000
BEGIN 61058000
ERR(145); GO TO EXIT; 61059000
END; 61060000
WHILETOG ~ ELCLASS = WHILEV; 61061000
IF STEPI ! RELOP THEN GO TO ENTERC; 61062000
OP ~ ELBAT[I].DISP - LESS + SLSD; 61063000
STEPIT; 61064000
GT1 ~ AEXP; 61065000
IF NOT WHILETOG THEN 61066000
IF BOOLEAN(OP) THEN 61067000
OP ~ OP -1 ELSE OP ~ OP + 1; 61068000
ENTERB: IF NEWSP ! 0 OR NEWCT ! 0 THEN 61069000
BEGIN 61069100
EMIT(OP+8); 61070000
IF NEWCT ! 0 THEN 61071000
BEGIN 61072000
EMITN(NEWCT.ADDRESS); 61073000
EMIT(STOD); 61074000
END ELSE EMIT(DLET); 61075000
IF NEWSP ! 0 THEN 61076000
BEGIN 61077000
EMITN(NEWSP.ADDRESS); 61078000
EMIT(OVRD); 61079000
END ELSE EMIT(DLET); 61080000
END ELSE EMIT(OP); 61080100
GO TO EXIT; 61081000
ENTERC: IF ELCLASS ! INV THEN BEGIN ERR(646); GO TO EXIT; END; 61082000
MAKEARRAYROW; 61083000
IF WHILETOG THEN OP ~ SWTD ELSE OP ~ SWFD; 61086000
GO TO ENTERB; 61087000
EXIT: 61088000
END SCANSTMT; 61089000
PROCEDURE REPLACESTMT; 61100000
BEGIN 61101000
LABEL SOURCEPART, CONDITION, EMITOP, PTRFORCOUNT; 61102000
LABEL CONTINUE, DODP, DOSP; 61103000
LABEL DOIT; 61103100
DEFINE FML = [31:1]#; 61104000
LABEL STRINGSORCE, AEXPSOURCE, UNITS, EXIT; 61105000
REAL NEWDP,NEWSP,NEWCT,OP,TYPE; 61106000
BOOLEAN UPDATETOG,WHILETOG, COMMAFLAG, OVERITOG; 61107000
BOOLEAN ERROR573; %TRUE FOR UPDATE ON ARITHMETIC SOURCE 61107500
IF TABLE(I+2) = COLON THEN 61108000
BEGIN 61109000
IF STEPI ! PTRID THEN ERROR(636); 61110000
NEWDP ~ ELBAT[I]; 61111000
STEPIT; 61112000
END; 61113000
STEPIT; GT1 ~ PEXP(FALSE); 61114000
IF ELCLASS ! BYV THEN ERROR(637); 61115000
SOURCEPART: 61116000
IF STEPI = STRING OR ELCLASS = STRNGCON THEN GO TO STRINGSORCE;61117000
IF TABLE(I+1) = COLON THEN 61118000
BEGIN 61119000
IF ELCLASS!PTRID THEN 61120000
BEGIN 61120100
ERROR573~TRUE; %RESET IF WE FIND "DIGITS" LATER. 61120200
NEWSP~ELBAT[I]; 61120300
STEPIT; STEPIT; 61120400
TYPE~EXPRSS; 61120500
GO TO AEXPSOURCE; 61120600
END; 61120700
NEWSP ~ ELBAT[I]; 61121000
STEPIT; STEPIT; GT1 ~ PEXP(FALSE); 61122000
END ELSE 61123000
IF(TYPE ~ EXPRSS) ! PTYPE THEN GO TO AEXPSOURCE; 61124000
IF ELCLASS = FORV THEN 61125000
BEGIN 61126000
IF TABLE(I+2) ! COLON THEN GO TO PTRFORCOUNT; 61127000
IF STEPI ! INTID AND ELCLASS ! REALID THEN ERROR(638); 61128000
NEWCT ~ ELBAT[I]; 61129000
STEPIT; STEPIT; TYPE ~ AEXP; 61130000
END ELSE 61131000
IF ELCLASS = WITHV THEN 61132000
BEGIN 61133000
IF STEPI ! PCID THEN ERROR(655); 61134000
IF BOOLEAN(ELBAT[I].FML) THEN 61135000
BEGIN COMMENT FOR FORMAL PICTURE WE DO A SORT OF 61136000
PROCEDURE ENTRY; 61137000
EMIT(IMKS); EMITPAIR(ELBAT[I].ADDRESS,RSDN); 61138000
IF NEWSP = 0 THEN EMIT(ZERO) ELSE 61139000
EMITPAIR(NEWSP.ADDRESS,STFF); 61140000
OP ~ 0; COMMENT OP WILL COUNT EXPRESSIONS; 61141000
IF STEPI = LFTPRN THEN 61142000
BEGIN 61143000
DO BEGIN 61144000
STEPIT; OP ~ OP + 1; EXPRESSION(ITYPE); 61145000
END UNTIL ELCLASS ! COMMA; 61146000
IF ELCLASS ! RTPARN THEN FLAG(923) ELSE STEPIT; 61147000
END; 61148000
IF NEWSP ! 0 THEN 61149000
BEGIN EMIT(ZERO); EMITPAIR(NEWSP .ADDRESS,OVRD) END; 61150000
EMITNUM(OP); EMIT(ENTR); 61151000
IF ELCLASS = COMMA THEN GO CONTINUE; 61152000
GO TO DODP; 61153000
END FORMAL PICTURE; 61154000
OP ~ PICTUREGEN(TRUE,NEWSP~NEWDP!0,TAKE(ELBAT[I]).LINK); 61155000
COMMAFLAG~ ELCLASS=COMMA; 61156000
IF BOOLEAN(OP) THEN GO DOSP ELSE GO EXIT; 61157000
END; 61158000
IF ELCLASS ! WHILEV AND ELCLASS ! UNTILV THEN ERROR(639); 61159000
CONDITION: 61160000
WHILETOG ~ ELCLASS = WHILEV; 61161000
IF STEPI = RELOP THEN 61162000
BEGIN 61163000
OP ~ ELBAT[I].DISP - LESS + TLSD; 61164000
STEPIT; TYPE ~ AEXP; 61165000
IF NOT WHILETOG THEN 61166000
IF BOOLEAN(OP) THEN 61167000
OP ~OP-1 ELSE OP ~ OP+1; 61168000
END ELSE 61169000
BEGIN 61170000
IF ELCLASS ! INV THEN ERROR(640); 61171000
MAKEARRAYROW; 61172000
IF WHILETOG THEN OP ~ TWTD ELSE OP ~ TWFD; 61175000
END; 61176000
EMITOP: 61177000
COMMAFLAG ~ ELCLASS = COMMA; 61178000
IF NEWSP>0 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 DECLARATION>::= MONITOR <PROCEDURE IDENTIFIER> 70071000
(<MONITOR LIST>) 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
<FIELD> ::= <ARITHMETIC EXPRESSION> : <ARITHMETIC EXPRESSION> 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
<FIELD PART> ::= <FIELD IDENTIFIER> = <FIELD> 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 DECLARATION> ::= FIELD <FIELD PART LIST> 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 DECLARATION> ::= LAYOUT <LAYOUT PART LIST> 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 = <TEXT> #, 70342000
FIELDEXPA OR LAYEXPA = <ARITHMETIC EXPRESSION> : 70343000
FIELDEXPB = <ARITHMETIC EXPRESSION> <, 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 DECLATION> ::= DEFINE <DEFINITION LIST>. 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 <TYPE> VALUE ARRAY(<CONSTANT LIST>) 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
(<CONSTANT LIST>) 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 <ARRAY LIST> OF ARRAY DECLARATION: 70821000
<ARRAY KIND> ARRAY <ARRAY LIST> 70822000
IT ALSO HANDLES THE ARRAY DECLARATION AS A WHOLE BY USING 70823000
THE <ARRAY KIND> 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 DECLARATION> ::= INTERRUPT <INTERRUPT LIST> 79003000
<INTERRUPT LIST> ::=<INTERRUPT SEGMENT>/<INTERRUPT LIST>, 79004000
<INTERRUPT SEGMENT> 79005000
<INTERRUPT SEGMENT>::= INTERRUPT IDENTIFIER:<ON PART> 79006000
<ON PART> ::=ON <EVENT DESIGNATOR>,<STATEMENT> 79007000
<INTERRUPT IDENTIFIER>::=<IDENTIFIER> 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 <TYPE>: 80011000
FOR <TYPE>, 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&GT1[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~EXPRSS<XTYPE OR GT1>ITYPE 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<RTYPE) OR T=BTYPE THEN GO DOTTY; 80356000
IF T=PTYPE THEN PTRCOMP; 80356050
IF T!WTYPE THEN GO DOTTY ELSE IF ELCLASS=RELOP AND 80356100
ELBAT[I].DISP=SAME THEN GO RC ELSE GO DOTTY; 80356150
LEVIN: COMMENT EVENT INTRINSIC; 80356200
IF GT1~TAKE(ELBAT[I]).KIND=SECONDWORDKEY THEN GO TO LARITH; 80356300
IF GT1= SETKEY OR GT1=RESETKEY THEN 80356320
BEGIN T ~ BITFIDDLE(GT1= SETKEY); GO TO LB END; 80356340
IF GT1!HAPPENEDKEY AND GT1!AVAILABLEKEY AND GT1!FIXKEY 80356400
THEN FLAG(837); 80356450
FIXCALL~TRUE; 80356500
EVENTINTRINSIC; 80356600
GO WAY; 80356650
LBARR: COMMENT BOOLEAN ARRAY; 80357000
IF T ~ VARIABLE(FP) < XTYPE THEN GO DOTTY ELSE GO ON; 80358000
LRARR: COMMENT REFERENCE ARRAY; 80358050
IF T~VARIABLE(FP) < XTYPE THEN ELSE GO ON; 80358080
T~ T.[FF]; GO TO DOTTY; 80358090
LWVAR: COMMENT WORD VARIABLE; 80358500
T~VARIABLE(FP); 80358550
GO TO DOTTY; 80358600
LBVAR: COMMENT BOOLEAN VARIABLE; 80359000
IF GT1~VARIABLE(FP)=BTYPE OR GT1=WTYPE THEN GO TO DOTTY; 80360000
FLAG(818); 80361000
GO WAY; 80362000
LTRUTH: COMMENT TRUTH VALUE-TRUE OR FALSE; 80364000
EMIT(ELBAT[I].ADDRESS); 80365000
STEPIT; 80366000
GO ON; 80367000
LCASE: COMMENT SOME SORT OF CASE EXPRESSION; 80368000
T ~ CASEXP; 80369000
GO TO LB; 80370000
LPAREN: COMMENT A PARENTHETICAL EXPRESSION; 80371000
STEPIT; 80372000
T ~ EXPRSS; 80373000
IF ELCLASS ! RTPARN THEN FLAG(819); 80374000
STEPIT; 80375000
LB: COMMENT CHECK FOR FLOATING SUBSCRIPT LIST; 80376000
IF T < XTYPE THEN 80377000
IF ELCLASS ! LFTBRKT THEN GO DOTTY ELSE 80378000
IF GT1 ~ SUBSCRIBER(0,T.[CF]) = 0 THEN T ~ T.[FF] ELSE 80379000
BEGIN T ~ T & GT1[33:CF]; GO DOTTY END; 80380000
COMMENT NOW DO WHAT IS APPROPRIATE FOR THE EXPR;80381000
GTB1~FALSE; 80381500
IF T = BTYPE THEN GO DOTTY; 80382000
IF T = RTYPE THEN GO DOTTY; 80383000
IF T = PTYPE THEN BEGIN PTRCOMP; GO TO DOTTY END; 80384000
IF T=WTYPE THEN GO DOTTY; 80384500
GTB1~TRUE; 80384550
GO DOTTY; 80385000
GO TO RC; 80386000
LTYPE: COMMENT A TYPE (DECLARATOR); 80387000
IF T~TAKE(ELBAT[I]).LINK=BOOV OR T=WDV THEN 80388000
BEGIN 80389000
IF STEPI ! LFTPRN THEN FLAG(820); 80390000
STEPIT; 80391000
IF GT1 ~ EXPRSS = ETYPE THEN EMIT(SNGT) ELSE 80392000
IF GT1 ! ATYPE THEN 80393000
IF GT1! WTYPE THEN 80393500
IF GT1!ITYPE AND T!WDV THEN FLAG(821); 80394000
IF ELCLASS ! RTPARN THEN FLAG(819); 80395000
STEPIT; 80396000
DOTTY: IF ELCLASS!PERIODV 80397000
THEN IF GTB1 80397020
THEN BEGIN T~ARITHCOMP(T);GO TO RC END 80397040
ELSE IF T=RTYPE OR T=PTYPE OR T=WTYPE THEN GO TO RC 80397060
ELSE GO TO ON; 80397080
IF STEPI=TAGV 80397500
THEN BEGIN EMIT(RTAG); STEPIT; END ELSE 80397800
IF GT1 ~ DOTIT = 0 THEN EMIT(DISO) ELSE 80398000
EMITI(GT1.[36:6],GT1.[42:6]); 80399000
IF T=WTYPE OR T=PTYPE OR T=RTYPE THEN 80399300
BEGIN T~ARITHCOMP(ATYPE); GO TO RC END; 80399400
IF GTB1 THEN BEGIN T~ARITHCOMP(T); GO TO RC END; 80399500
IF T } XTYPE THEN GO ON; 80400000
T ~ ARITHCOMP(ATYPE); 80401000
END ELSE 80402000
IF T = REFV THEN 80403000
LREF: COMMENT REFERENCE-TYPE STUFF; 80404000
BEGIN T~ REXP(TRUE); GO TO DOTTY END ELSE 80405000
IF T = PTRV THEN 80406000
LPTR: COMMENT POINTER-TYPE THINGS; 80407000
BEGIN T~ PEXP(TRUE); GO TO DOTTY END ELSE 80408000
LWARR: 80408500
LARITH: COMMENT ARITHMETIC-TYPE THINGS; 80409000
IF T ~ AEXP < XTYPE THEN GO WAY; 80410000
RC: COMMENT WE HAVE AN EXPRESSION, BUT IT IS NOT 80411000
BOOLEAN. WE STILL HAVE A CHANCE TO SAVE THE 80412000
DAY FOR DEAR OLD GEORGE, HOWEVER: IT MAY BE 80413000
A RELATION; 80414000
IF ELCLASS = INV THEN 80414100
BEGIN 80414200
IF T!ATYPE AND T!ITYPE AND T!PTYPE THEN FLAG(834); 80414300
MAKEARRAYROW; 80414400
IF ELCLASS = FORV THEN 80414420
BEGIN 80414430
STEPIT; 80414432
IF T ! PTYPE THEN 80414434
BEGIN EMIT(EXCH); EXPRESSION(ATYPE); 80414436
EMITPAIR(T~GETSTACK,OVRN); EMIT(EXSU); EMIT(SRSC); 80414438
EMIT(EXCH); EMITV(T); RTNSTACK(T); EMIT(EXCH); 80414440
END ELSE 80414442
BEGIN EXPRESSION(ATYPE); EMIT(EXCH) END; 80414444
EMIT(SWTD); EMIT(DLET); EMIT(RTFF); 80414450
T ~ BTYPE; 80414460
GO WAY; 80414470
END; 80414480
IF T ! PTYPE THEN BEGIN 80414490
EMIT(EXCH); EMIT2P(ISOL,DEFAULTSIZE-1,48); 80414500
COMMENT WRAP AROUND IS EXPECTED; 80414550
EMIT(EXCH); 80414590
END; 80414600
EMIT(ONE); EMIT(EXCH); 80414610
EMIT(SWTD); 80414650
EMIT(RTFF); 80414700
T ~ BTYPE; GO ON; 80414800
END; 80414900
IF ELCLASS!RELOP THEN GO TO ON; 80415000
COMMENT GEORGE WHO .....; 80415100
RELATION(T); 80416000
COMMENT ... BOOLE; 80416100
T ~ BTYPE; 80417000
ON: WHILE ELCLASS=AMPERSAND DO LAYITOUT(T); 80418000
WAY: BOOPRIM ~ T 80419000
END BOOLEAN PRIMARY; 80420000
PROCEDURE MAKEPOINTER; 80421000
BEGIN 80422000
LABEL XIT, NSR; 80423000
REAL ELBW, NUMDIMS; 80424000
IF STEPI ! LFTPRN THEN BEGIN ERR(826); GO TO XIT END; 80425000
MAKEARRAYROW; 80426000
IF ELCLASS ! COMMA THEN 80439100
BEGIN ELBW ~ DEFAULTSIZE DIV 2; I ~ I - 1; GO NSR END; 80439150
IF STEPI = NUMBER THEN 80439200
IF THI & 0[44:44:3]!0 OR ABS((ELBW~THI.[44:3])-3) > 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 N<PDINX DO 85209000
PRT[(GT1~PDPRT[N.LINKR,N.LINKC]).[36:12]-2] ~ 85210000
GT1.[23:13]&GT1[15:10:13]; 85211000
DIR[0]~DKADDR&(PDINX+1)[08:28:20]; 85212000
DIR[8].[1:7]~1; % THIS IDENTIFIES "ESPOL PROCEDURE" FILE. 85212500
WRITE(TEMP,30,PRT[*]); DKADDR~DKADDR+1; 85213000
DIR[11]~(N~DKADDR)&SEPLEVEL[01:43:5]; 85214000
WRITE(TEMP); DKADDR~DKADDR+1; 85215000
IF (GT1~SEPFX)>0 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
View Git Blame Copy Permalink