comment STANFORD ALGOL W COMPILER PHASE A - SCAN AND PARSE PASSES MAY 1971 VERSION ;globalprocedureAWXCMPA2(R14);begin;FUNCTION_DECR(6,#0600),ZONE(8,#96F0);STM(R14,R12,B13(12));R4:=R1;R5:=R13;R0:=4096;R1:=R0;R3:=B4(20);BALR(R2,R3);comment GETMAIN;R13:=R0;comment ESTABLISH 4K INITIAL DATA SEGMENT, BASE R13;begin;dummybaseR13;comment SHARED DATA SEGMENT;logicalSYSINF,OLDSAVE,NEWSAVE;array15logicalSAVEAREA;array16integerXFERVECTOR;comment SUPV ENTRY ADDRESSES;array2integerCOMMLIMsynXFERVECTOR(0);integerAPUTLINEsynXFERVECTOR(8);comment WRITE ENTRY;byteCARRCONTsynAPUTLINE(0);comment PRINT CONTROL CHAR;integerAGETCARDsynXFERVECTOR(12);comment READ ENTRY;integerAPUTCARDsynXFERVECTOR(16);comment PUNCH ENTRY;integerAGETMAINsynXFERVECTOR(20);comment GETMAIN ENTRY;integerAFREEMAINsynXFERVECTOR(24);comment FREEMAIN ENTRY;integerAGETTIMEsynXFERVECTOR(28);comment GETTIME ENTRY;integerARUNIDsynXFERVECTOR(60);comment ADDRESS OF SYSTEM ID;byteSYSOPTIONSsynXFERVECTOR(60);comment OPTION INHIBIT BITS;array5integerBASESAVE;comment DATA BASES FOR PASS 2;logicalPHASEFLAGS;comment FLAGS FOR PASS1/PASS2 COMMUNICATION;byteNOGOsynPHASEFLAGS(0);byteNOPASSTWOsynPHASEFLAGS(1);byteSTACKFLAGsynPHASEFLAGS(2);byteDEBUGsynPHASEFLAGS(3);shortintegerLINENO,PAGENO;longrealPKDEC;comment USED WITH CVD;array132byteHEADING;comment PAGE HEADER;array132byteBUFFER;comment PRINT BUFFER;procedurePRINT(R1);comment DETERMINES REQUIRED CONTROL CHARACTER, PRINTS LINE AT (R0);begin;array4logicalSAVE03;STM(R0,R3,SAVE03);R1:=R1-R1;IC(R1,CARRCONT);R2:=LINENO+1;R3:=APUTLINE;ifR1="0"thenbegin;ifR2>=60thenR1:="1"elseR2:=R2+1;;end;ifR1="1"thenbegin;R0:=PAGENO+1;PAGENO:=R0;CVD(R0,PKDEC);MVC(3,HEADING(117),#40202120);ED(3,HEADING(117),PKDEC(6));R0:=@HEADING;BALR(R2,R3);R0:=SAVE03(0);R2:=3;R1:="0";;end;LINENO:=R2;ifR2=60thenMVI("1",CARRCONT)elseMVI("",CARRCONT);BALR(R2,R3);comment LINK TO WRITE;LM(R0,R3,SAVE03);;end;dummybaseR11;comment COMPILER COMMON FORMAT;integerCOMMTIME;shortintegerCOMMLINE,COMMPAGE;array3logicalCOMMFLAGS;byteCHECKFLAGsynCOMMFLAGS(0);comment CODE FOR VALIDITY TESTS;byteDEBUGFLAGsynCOMMFLAGS(1);comment DEBUG SYSTEM OUTPUT;bytePROCCOMPsynCOMMFLAGS(2);comment COMPILING PROC DECL;byteTRACEsynCOMMFLAGS(3);comment COMPILER TRACE OPTION;array2logicalTRACEBITSsynCOMMFLAGS(4);shortintegerBLOCKLISTSIZE,NAMETABLESIZE,NRECCLASS;integerREFRECBASE,IDDIRBASE,IDLISTBASE,INPOINT;integerTREELINK,TREEBASE,TREETOP,EDITBASE;integerTREEORGsynTREETOP;integerXSN;comment LOWEST ASSIGNED EXTERNAL SEGMENT NUMBER;array8characterESDROOT;comment MODULE IDENTIFIER ROOT;array256byteESDICT;comment EXTERNAL PROCEDURE IDENTIFIERS;array512logicalBLOCKLIST;shortintegerBLENGTHsynBLOCKLIST(0);comment LENGTH OF NAMETAB;shortintegerNPOINTsynBLOCKLIST(2);comment POINTER TO NAMETAB;comment *** SIZE OF OTHER TABLES IS DYNAMIC *** ;array3logicalNAMETABLE;shortintegerIDLOC1synNAMETABLE(0);shortintegerIDLOC2synNAMETABLE(2);byteHIERARCHYsynIDLOC2(0);bytePROGSEGsynIDLOC2(1);shortintegerSIMTYPEINFOsynNAMETABLE(4);shortintegerTYPEINFOsynNAMETABLE(6);byteVRsynTYPEINFO(0);byteDIMENsynTYPEINFO(1);byteRCCLNUMBERsynTYPEINFO(1);shortintegerTYPESsynNAMETABLE(8);byteTYPEsynTYPES(0);byteSIMPLETYPEsynTYPES(1);shortintegerIDNOsynNAMETABLE(10);array1shortintegerREFRECLISTsynB5;array1logicalIDDIRsynB3;shortintegerIDLENGTHsynIDDIR;shortintegerIDPOINTsynIDDIR(2);array1byteIDLISTsynB3;logicalTREEsyn0;comment PASS TWO OUTPUT;byteprogramsyn0;comment PASS ONE OUTPUT;closebase;segmentprocedurePASS1(R10);begin;comment PASS 1 -- SCANNER;dummybaseR13;comment WORK AREA SHARED WITH PASS 2;array18logicalSAVEINFO;comment REPEAT PRECEDING DECLARATIONS;array16logicalXFERVECTOR;integerNTBASEsynXFERVECTOR(0);comment COMMON BASE ADDRESS;array5logicalBASESAVE;logicalPHASEFLAGS;shortintegerLINENO,PAGENO;longrealPKDEC;array132byteHEADING;comment PAGE HEADER;array132byteINBUF;array132byteOUTPUTsynINBUF;comment USED FOR ERROR LOG ONLY;array4logicalPRINTEMP;comment * * * LOCAL VARIABLE DECLARATIONS BEGIN HERE * * * ;integerSAVE14,RETADDR;comment REGISTER ALLOCATION R0-R4 GENERAL PURPOSE R5 CONSTANT 1 R6 INDEX TO PASS TWO OUTPUT R7 CURBUF AND NEXTBUF BASE REGISTER R8 INDEX TO NEXT CHARACTER R9 (COUNT-1) OF CHARACTERS REMAINING IN INPUT BUFFER RA-RB PROCEDURE LINKAGE RC-RD DATA BASE REGISTERS RF PROGRAM BASE REGISTER ;integerREGISTER_C1synR5;comment CONSTANT 1;integerREGISTER_PPsynR6;comment PROGRAM POINTER;integerREGISTER_BBsynR7;comment CURBUF/NEXTBUF BASE;logicalARUNVARORGsynB13(#120);comment BLOCK OF SYSTEM VARIABLES;integerRFRCLISTBASE,RFRCLISTLIMIT,PRBASE,PROGLIMIT;integerIDDBASE,IDLBASE;logicalSAVERB;array2logicalSTATE;comment SCANNER STATE FLAGS;byteDECLARFLAGsynSTATE(0),ARRAYFLAGsynSTATE(1),PROCFLAGsynSTATE(4),RECORDFLAGsynSTATE(5),REFERFLAGsynSTATE(6),FARRAYFLAGsynSTATE(7);array2logicalFLAGS;comment COMPILER FLAGS;byteLISTFLAGsynFLAGS(0),TRACEFLAGsynFLAGS(1),EOFsynFLAGS(2),ENDBLOCKsynFLAGS(3),ENDDOTsynFLAGS(4),EFLAGsynFLAGS(5);byteLINEHOLD,BEGINSET;comment LISTING CONTROL;shortintegerNESTLEVEL;comment BEGIN/END NESTING LEVEL;shortintegerSYMBOLINDEX,IDDIRINDEX,IDLISTINDEX;shortintegerBLLIMIT,SCRATCHINDEX;integerLASTIDPTR,LASTIDNO;logicalTYPE;comment FIELD CONTAINING TYPE INFO OF ID BEING PROCESSED;shortintegerBLOCKNO;shortintegerDIMCNT;integerFARRAYPNT;shortintegerERRORCOUNT;array50logicalERRORS;array50shortintegerERRORCODEsynERRORS(0);array50shortintegerERRORLOCsynERRORS(2);equateERRORLIMITsyn4*50-4;integerOUTCHAR,SAVEADD;shortintegerSCOORD;comment SOURCE REFERENCE COORDINATE;shortintegerRECORDNO;shortintegerSIMTYPEINFO;shortintegerRLISTPOINT;array68longrealSYMBUFFERS;integerCURBUFBASE,NEXTBUFBASE;dummybaseBB;comment CURBUF FORMAT;integerCURBUFTYPE,CURBUFCOUNT;array257byteCURBUF;array2logicalCURBUFIsynCURBUF;longrealCURBUFLsynCURBUF;array256byteCURBUF1synCURBUF(1);closebase;dummybaseBB;comment NEXTBUF FORMAT;integerNEXTBUFTYPE,NEXTBUFCOUNT;array257byteNEXTBUF;array2logicalNEXTBUFIsynNEXTBUF;longrealNEXTBUFLsynNEXTBUF;array256byteNEXTBUF1synNEXTBUF(1);closebase;array64integerSTACK;shortintegerSTACKLNGsynSTACK(4);comment LENGTH FIELD OF STACK;shortintegerSTACKINDsynSTACK(6);comment INDEX TO SCRATCH TAB;integerSTACKINDEX;comment POINTER TO TOP OF STACK TABLE;integerSTACKMAX;comment MAXIMUM VALUE OF STACKINDEX;equateSTACKLIMITsyn4*64-8;comment PRIVATE COMMON FIELDS KNOWN TO PASS 1;array6shortintegerSCRATCHNAMETABLEsynNAMETABLE(2);shortintegerSCRNAMETABsynSCRATCHNAMETABLE(0);shortintegerSIMTYPEINsynSCRATCHNAMETABLE(4);integerTYPEINFOsynSCRATCHNAMETABLE(6);shortintegerIDNOSCsynSCRATCHNAMETABLE(10);array1shortintegerREFRCDLISTsynB1;array2shortintegerIDDIRsynB12;shortintegerIDDIRLNGsynIDDIR(0);shortintegerIDDIRINDsynIDDIR(2);bytePROGRAMM4syn0;bytePROGRAMM3syn1;bytePROGRAMM2syn2;bytePROGRAMM1syn3;byteprogramsyn4;FUNCTION_CL(12,#5500);integerHCODE;array512shortintegerHASHID;array2logicalCHAININFO;comment STORAGE CONTROL INFO;integerCHAINsynCHAININFO(0);array0shortintegerCHAINIDsynB11;comment HASH CHAIN TABLE, DYNAMICALLY ALLOCATED;segmentbaseR14;comment *** THIS SEGMENT IS READ-ONLY DATA *** ;longrealDBLANK="";array306shortintegerRESERVED=comment MUST BE WORD ALIGNED;((_1,12,#9301,0,"DO"),(_1,_1,#FF01,12,"GO"),(0,36,#7801,24,"IF"),(_1,48,#7D01,36,"IS"),(_1,_1,#7C01,48,"OF"),(24,_1,#8001,60,"OR"),(_1,_1,#8D01,72,"ABS"),(72,96,#8601,84,"AND"),(_1,_1,#8401,96,"DIV"),(84,_1,#6F0D,108,"END"),(108,132,#9B0A,120,"FOR"),(_1,156,#8501,132,"REM"),(_1,_1,#8801,144,"SHL"),(144,_1,#8901,156,"SHR"),(_1,180,#080F,168,"BITS"),(_1,_1,#7B01,180,"CASE"),(168,_1,#7A01,192,"ELSE"),(_1,_1,#0000,204,"...."),(192,228,#9401,216,"GOTO"),(_1,_1,#8C0B,228,"LONG"),(216,276,#8201,240,"NULL"),(_1,264,#020E,252,"REAL"),(_1,_1,#9C01,264,"STEP"),(252,288,#7901,276,"THEN"),(_1,_1,#8A01,288,"TRUE"),(_1,_1,#6B01,300,"ALGOL"),(300,_1,#6E13,316,"ARRAY"),(316,380,#970C,332,"BEGIN"),(_1,364,#8B01,348,"FALSE"),(_1,_1,#9F01,364,"SHORT"),(348,412,#9D01,380,"UNTIL"),(_1,_1,#7211,396,"VALUE"),(396,_1,#9E01,412,"WHILE"),(_1,_1,#9801,428,"ASSERT"),(428,492,#7514,444,"RECORD"),(_1,_1,#0000,460,"......"),(_1,_1,#7312,476,"RESULT"),(476,_1,#0716,492,"STRING"),(_1,524,#040E,508,"COMPLEX"),(_1,_1,#6C01,524,"FORTRAN"),(508,556,#010E,540,"INTEGER"),(_1,_1,#060E,556,"LOGICAL"),(_1,592,#7115,572,"PROCEDURE"),(_1,_1,#6810,592,"REFERENCE"));shortintegerLLINKsynRESERVED(0),GLINKsynRESERVED(2);byteCODE1synRESERVED(4),CODE2synRESERVED(5);logicalRSVTEXTsynRESERVED(8);array9shortintegerRINDEX=(_1,60,120,240,332,444,540,_1,572);equateISYMBOLINDEXsyn4*204;array204integerNAMETFILL=(#00000C01,#00000000,#0300001B,#00000000,#00000100,#0800001C,#00000000,#00000100,#0800001D,#00000000,#00000200,#0800001E,#00000000,#00000200,#0800001F,#00000000,#00000200,#08000020,#00000000,#00000100,#08000021,#00000000,#00000001,#07060022,#00000000,#00000001,#07080023,#00000000,#00000008,#07010024,#00000000,#00000007,#07010025,#00000000,#00000001,#07070026,#00000000,#00000002,#07010027,#00000000,#00000002,#07010028,#00000000,#00000002,#07010029,#00000000,#00000002,#0701002A,#00000000,#00000003,#0702002B,#00000000,#00000004,#0702002C,#00000000,#00000004,#0702002D,#00000000,#00000005,#0703002E,#00000000,#00000005,#0703002F,#00000000,#00000002,#07040030,#00000000,#00000003,#07050031,#00000000,#00000002,#07020032,#00000000,#00000002,#07020033,#00000000,#00000002,#07020034,#00000000,#00000002,#07020035,#00000000,#00000002,#07020036,#00000000,#00000002,#07020037,#00000000,#00000002,#07020038,#00000000,#00000003,#07030039,#00000000,#00000003,#0703003A,#00000000,#00000003,#0703003B,#00000000,#00000003,#0703003C,#00000000,#00000003,#0703003D,#00000000,#00000003,#0703003E,#00000000,#00000003,#0703003F,#00000000,#00000100,#08000040,#00000000,#000B0001,#07070041,#00000000,#000B0001,#07070042,#00000000,#000B0002,#07070043,#00000000,#000B0002,#07070044,#00000000,#00130003,#07070045,#00000000,#00130003,#07070046,#00000000,#00000001,#07010047,#00000000,#00000100,#0800005E,@ARUNVARORG(#20),#00000000,#00010048,@ARUNVARORG(#20),#00000000,#00010049,@ARUNVARORG(#1C),#00000000,#0001004A,@ARUNVARORG(#18),#00000000,#0002004B,@ARUNVARORG(#00),#00000000,#0003004C,@ARUNVARORG(#08),#00000000,#0003004D,@ARUNVARORG(#10),#00000000,#0003004E,@ARUNVARORG(#24),#00010001,#0009004F,@ARUNVARORG(#28),#00010001,#00090050,@ARUNVARORG(#2C),#00010001,#00090051,@ARUNVARORG(#30),#00010001,#00090052,@ARUNVARORG(#38),#00010001,#00090053,@ARUNVARORG(#3C),#00010001,#00090054,@ARUNVARORG(#40),#00010001,#00090055,@ARUNVARORG(#44),#00010001,#00090056,@ARUNVARORG(#48),#00010001,#00090057,#000D0000,#00500501,#04000058,#000D000C,#00000001,#05060059,#000D0004,#00000001,#0501005A,#000D0008,#00000001,#0501005B,#000D000D,#00000001,#0506005C,#000D000E,#003F0001,#0507005D);equateIIDDIRINDEXsyn2*190;array190shortintegerIDDIRFILL=(6,_7,0,_8,0,_9,0,_10,0,_11,0,_12,0,_13,0,_14,0,_15,0,_16,0,_17,0,_18,0,_19,0,_20,0,_21,0,_22,0,_23,0,_24,0,_25,0,_26,0,_27,0,_28,0,_29,0,_30,0,_31,0,_32,0,_33,5,_39,4,_46,6,_46,3,_52,5,_52,7,_60,8,_69,2,_72,8,_81,5,_87,5,_93,3,_91,7,_101,4,_106,5,_112,7,_375,10,_386,7,_120,7,_132,11,_124,11,_136,3,_132,7,_136,3,_143,2,_153,1,_165,2,_163,2,_185,2,_182,5,_202,7,_147,6,_157,5,_169,6,_176,6,_189,6,_196,9,_206,8,_215,8,_224,8,_233,5,_239,5,_249,9,_243,9,_253,3,_257,11,_269,8,_266,9,_279,6,_286,1,_292,6,_299,10,_290,6,_306,9,_320,3,_303,3,_310,6,_317,6,_143,5,_153,7,_165,8,_185,8,_329,7,_337,7,_345,8,_354,6,_361,5,_367,4,_391);equateIIDLISTINDEXsyn392;array392characterIDLISTFILL=("TRACE","ROUNDTOREAL","EXPONENT","XCPMSG","XCPMARK","XCPACTION","XCPLIMIT","XCPNOTED","EXCEPTION","INTDIVZERO","UNFL","INTOVFL","MAXREAL","PI","LONGEPSILON","MAXINTEGER","INTFIELDSIZE","TIME","LONGBASE16","LONGBASE10","INTBASE16","INTBASE10","WRITECARD","LONGARCTAN","LONGCOS","LONGSINCOSERR","LONGLOG","LONGLNLOGERR","LONGEXPERR","LONGSQRTERR","LONGIMAGPART","LONGREALPART","ENTIER","ROUND","TRUNCATE","DECODE","NUMBER","BITSTRING","ODD","IOCONTROL","READCARD","READON","WRITEON","(MAIN)","ZYXWVUTSRQPONMLKJIHGFEDCBA","");array18bytePSYMBOLS=("?;():=+-*/,<>|#""~.");array18shortintegerPCODE=(#0002,#7009,#6A06,#6707,#9904,#9001,#7E01,#7F01,#7405,#8301,#6908,#8F03,#9103,#7601,#8E00,#8100,#8703,#9217);comment SPECIAL CODES;equateIDCODEsyn#65,GOCODEsyn#FF;byteIDsyn#65,NUMBERsyn#77,stringsyn#81,BITSsyn#8E,SIMPLETYPEsyn#03,SPECCOMMAsyn#66,SPECCOLONsyn#6D,EXPONENTsyn#A1,ASSIGNsyn#9A,GOTOOsyn#94,ENDFILEsyn#92,NEQsyn#A0,GEQsyn#96,LEQsyn#95;byteVOIDsyn0;comment REPLACES DELETED SYMBOLS;comment INSTRUCTIONS TO BE USED WITH EXECUTE INSTRUCTION;array256characterTRTBLANKS=(64(#03),#00,10(#03),#06,18(#03),#07,28(#03),#05,#03,#02,#03,#04,65(#03),9(#01),7(#03),9(#01),8(#03),8(#01),6(#03),10(#02),6(#03));array256characterTRTIDS=(109(#01),#00,83(#01),9(#00),7(#01),9(#00),8(#01),8(#00),6(#01),10(#00),6(#03));comment THE NEXT TWO TRANSLATE TABLES OVERLAP AND MUST BE CONTIGUOUS;array256characterTRRESERVED=(75(0),34,22,4,12,26,12(0),16,6,2,32,14,18,9(0),20,2(0),24,11(0),8,28,2(0),10,30,128(0));array162characterTRCOMMENT=(#01,161(#00));comment SCAN FOR SEMICOLON;array256characterTRTCOMMENTsynTRCOMMENT(_94);array48byteLETTERIDNO=(0,1,2,3,4,5,6,7,8,9,7(0),10,11,12,13,14,15,16,17,18,8(0),19,20,21,22,23,24,25,26,6(0));closebase;procedureOUTCODE(R11);begin;comment R1 HAS CODE TO BE OUTPUT AS 1 BYTE;STC(R1,program(PP));PP:=PP+C1;;end;procedureOUTCODE2(R11);begin;comment R1 HAS CODE TO BE OUTPUT AS 2 BYTES;STC(R1,program(PP+1));R1:=R1shrl8;STC(R1,program(PP));PP:=PP+2;;end;procedureOUTCODE4(R11);begin;comment R2 HAS CODE TO BE OUTPUT AS 4 BYTES;OUTCHAR:=R2;MVC(3,program(PP),OUTCHAR);PP:=PP+4;;end;procedureOUTSTRING(R10);comment MOVE STRING IN CURBUF TO PROGRAM;begin;R1:=CURBUFCOUNT;OUTCODE;EX(R1,MVC(0,program(PP),CURBUF1));PP:=PP+R1+C1;;end;procedureSETTYPE(R10);begin;comment R1 HAS PARTIAL TYPE CODE;ifPROCFLAGthenR1:=R1or#1000elseifRECORDFLAGthenbegin;R2:=RECORDNOshll16;R1:=R1orR2or#500;;end;;end;procedureERROR(R11);begin;comment R4 HAS ERROR NUMBER;R1:=ERRORCOUNT+4;ifR1=ERRORLIMITthenR4:=11;ifR1<=ERRORLIMITthenbegin;ERRORCODE(R1):=R4;ERRORCOUNT:=R1;R4:=SCOORD;ERRORLOC(R1):=R4;;end;;end;procedureSOFTSTOP(R11);gotoENDPROGRAM;segmentprocedureFETCHCARD(R11);begin;comment PRINTS LAST LINE, READS NEW CARD, DETECTS OPTIONS, SETS R8 = ADDRESS OF NEXT CHARACTER, R9 = (NUMBER - 1) CHARACTERS ON CARD;array3logicalSAVE13;STM(R1,R3,SAVE13);ifLISTFLAGandLINEHOLDthenbegin;RESET(LINEHOLD);R0:=@INBUF;PRINT;;end;L:R0:=@INBUF(13);R8:=R0;ifEOFthenbegin;R4:=7;ERROR;SOFTSTOP;;end;R3:=AGETCARD;BALR(R2,R3);comment READ;if~=orR0<0thenbegin;R8:=@INBUF(80);MVI(";",B8);MVI(";",B8(1));R9:=1;SET(EOF);gotoXIT;;end;CLI("@",B8);if=thenbegin;SAVERB:=R11;R11:=NTBASE;CLC(4,"DUMP*",B8(1));if=thenbegin;MVC(0,TRACEFLAG,B8(6));NI(#0F,TRACEFLAG);MVC(0,TRACE,B8(7));NI(#0F,TRACE);CLC(1,B8(9),"");if=thenbegin;R0:=#FFFFFFFF;R1:=R0;;endelsebegin;IC(R1,B8(10));R1:=R1and#F;IC(R2,B8(9));R2:=R2and#F*10S+R1;R0:=#80000000;R1:=R1-R1;SRDL(R0,B2);R0:=R0orTRACEBITS(0);R1:=R1orTRACEBITS(4);;end;STM(R0,R1,TRACEBITS);gotoM;;end;CLC(4,"STACK",B8(1));if=thenbegin;SET(STACKFLAG);gotoM;;end;CLC(3,"LIST",B8(1));if=thenbegin;SET(LISTFLAG);gotoM;;end;CLC(5,"NOLIST",B8(1));if=thenbegin;RESET(LISTFLAG);gotoM;;end;CLC(6,"NOCHECK",B8(1));if=thenbegin;TM(#80,SYSOPTIONS);if=thenRESET(CHECKFLAG);gotoM;;end;CLC(4,"DEBUG",B8(1));if=thenbegin;MVC(0,DEBUGFLAG,B8(7));CLI("0",DEBUGFLAG);if>=thenbegin;NI(#0F,DEBUGFLAG);R2:=@B8(8);;endelsebegin;MVI(4,DEBUGFLAG);R2:=@B8(7);;end;CLI("(",B2);if~=thenR0:=2elsebegin;R0:=R0-R0;R1:=R0;L:R2:=@B2(1);IC(R1,B2(0));ifR1~=")"andR1~=""thenbegin;R1:=R1and#F;R0:=R0*10S+R1;gotoL;;end;;end;XFERVECTOR(40):=R0;gotoM;;end;CLC(5,"SYNTAX",B8(1));if=thenbegin;SET(NOGO);gotoM;;end;CLC(4,"TITLE",B8(1));if=thenbegin;procedureSCAN(R3);begin;ifR1>71orR2>74thengotoM;IC(R0,B8(R1));R1:=@B1(1);;end;MVI("1",CARRCONT);MVC(39,HEADING(40),HEADING(36));R0:="";R1:=6;R2:=43;whileR0~=""""doSCAN;SCAN;S1:STC(R0,HEADING(R2));R2:=@B2(1);SCAN;ifR0~=""""thengotoS1;SCAN;ifR0=""""thengotoS1;gotoM;;end;R11:=SAVERB;gotoN;M:R11:=SAVERB;gotoL;;end;N:SET(LINEHOLD);RESET(BEGINSET);MVC(1,INBUF(5),"--");R9:=71;R1:=SCOORD;CVD(R1,PKDEC);UNPK(3,7,INBUF,PKDEC);OI("0",INBUF(3));MVC(7,INBUF(93),INBUF(85));MVC(7,INBUF(85),"");XIT:LM(R1,R3,SAVE13);;end;procedureSTOP(R1);begin;R4:=12;ERROR;SET(NOPASSTWO);gotoENDPROGRAM;;end;procedureINSERTSYMBOL(R11);begin;comment R2 HAS ID NUMBER AT ENTRANCE;SAVERB:=R11;R11:=NTBASE;R1:=STACKINDEX;R0:=STACKLNG(R1-8)+12;STACKLNG(R1-8):=R0;R0:=TYPE;R1:=SCRATCHINDEX;ifR1R2thenSTOP;EX(R4,MVC(0,B2,CURBUF));R1:=R1shrl1;R4:=HCODE;R2:=HASHID(R4);CHAINID(R1):=R2;HASHID(R4):=R1;FOUND:R2:=R1shrl1;R1:=@ID;OUTCODE;R1:=R2;OUTCODE2;;end;LASTIDNO:=R2;ifDECLARFLAGthenbegin;if~REFERFLAGthenINSERTSYMBOLelsebegin;R1:=RLISTPOINT+2;RLISTPOINT:=R1;R1:=R1+RFRCLISTBASE;REFRCDLIST:=R2;;end;;end;;end;procedureOPENBLOCK(R10);begin;R1:=BLOCKNO+C1;BLOCKNO:=R1;R2:=STACKINDEX;ifR1>BLLIMITorR2>=STACKLIMITthenSTOP;comment TOO MANY BLOCKS OR NESTING TOO DEEP;STACK(R2):=R1;R1:=SCRATCHINDEX;STACK(R2+4):=R1;R2:=R2+8;STACKINDEX:=R2;ifR2>STACKMAXthenSTACKMAX:=R2;;end;procedureCLOSEBLOCK(R10);begin;logicalSAVERB;SAVERB:=R11;R1:=STACKINDEX-8;if<=and~ENDDOTthenbegin;R2:=STACKMAX;L:R2:=R2-8;if<=thenbegin;R4:=4;ERROR;ifENDBLOCKthenPP:=PP-C1;;endelsebegin;R0:=STACK(R2);ifR0=0thengotoL;R3:=SCOORD;SCOORD:=R0;R4:=4;ERROR;SCOORD:=R3;R1:=STACK(R2+4);R0:=@VOID;STC(R0,program(R1-1));R0:=R0-R0;STACK(R2):=R0;;end;gotoXIT;;end;STACKINDEX:=R1;R11:=NTBASE;R3:=STACK(R1)shla2;R0:=STACKLNG(R1);comment R0 = #ID'S*12, R3 = BLOCKLIST INDEX;R2:=SYMBOLINDEX;ifENDBLOCKthenbegin;comment MAKE ENTRY FOR POSSIBLE PROCEDURE;NPOINT(R3):=R2;R4:=R4-R4;NAMETABLE(R2):=R4;NAMETABLE(R2+4):=R4;R4:=#0F000000;NAMETABLE(R2+8):=R4;R2:=R2+12;R4:=R0+12;BLENGTH(R3):=R4;R4:=SCOORD;;endelsebegin;R4:=R4-R4;ifR0=0thenBLOCKLIST(R3):=R0elsebegin;NPOINT(R3):=R2;BLENGTH(R3):=R0;;end;;end;STACK(R1):=R4;R4:=R2+R0;SYMBOLINDEX:=R4;R4:=STACKIND(R1);STACK(R1+4):=PP;SCRATCHINDEX:=R4;R2:=@NAMETABLE(R2);R4:=@SCRATCHNAMETABLE(R4);forR0:=R0-12step_12until0dobegin;R3:=@B2(12);ifR3>=R4thenSTOP;MVC(11,B2,B4);R2:=R3;R4:=R4-12;;end;XIT:R11:=SAVERB;;end;segmentprocedureADVANCESYMBOL(R10);comment CYCLES BUFFERS, FILLS NEXTBUF WITH NEXT TOKEN ATTRIBUTES;begin;procedureNEXTCHAR(R3);comment R0 := NEXT INPUT CHARACTER;begin;R9:=R9-C1;if="0"doADVANCE;ifR0="."thenbegin;ADVANCE;whileR0>="0"doADVANCE;;end;ifR0="@"thenbegin;ADVANCE;ifR0="+"orR0="-"thenADVANCE;ifR0<"0"thenbegin;SAVERB:=R11;R4:=2;ERROR;R11:=SAVERB;;end;whileR0>="0"doADVANCE;;end;ifR0="I"thenADVANCE;ifR0="L"thenADVANCE;ifR2>255thenR2:=255;NEXTBUFCOUNT:=R2;;end;BB:=CURBUFBASE;comment CURBUF IS RELEASED AND REFILLED;R1:=R1-R1;R2:=R1;L1:EX(R9,TRT(0,B8,TRTBLANKS));if=thenbegin;FETCHCARD;gotoL1;;end;R8:=R1;R9:=@INBUF(84)-R8;NEXTBUFTYPE:=R2;caseR2ofbegin;begin;comment 1 => LETTER ;NEXTBUFL:=F01;R2:=R2-R2;R3:=R2;L2:EX(R9,TRT(0,B8,TRTIDS));if=thenbegin;R4:=@NEXTBUF(R3);R3:=R3+R9+C1;ifR3>256thenbegin;R2:=@NEXTBUF(255)-R4;ifR2>=0thenEX(R2,MVC(0,B4,B8));R3:=257;;endelseEX(R9,MVC(0,B4,B8));FETCHCARD;gotoL2;;endelseifR1~=R8thenbegin;R4:=@NEXTBUF(R3);R2:=R1-R8;R3:=R3+R2;R2:=R2-C1;ifR3>256thenbegin;R2:=@NEXTBUF(255)-R4;ifR2>=0thenEX(R2,MVC(0,B4,B8));R3:=256;R2:=R1;R4:=13;ERROR;R1:=R2;;endelseEX(R2,MVC(0,B4,B8));;end;R3:=R3-C1;R8:=R1;R9:=@INBUF(84)-R8;NEXTBUFCOUNT:=R3;ifR3=4thenbegin;CLC(4,NEXTBUF,"BEGIN");if=thenbegin;R1:=NESTLEVEL+C1;NESTLEVEL:=R1;if~BEGINSETthenbegin;SET(BEGINSET);R0:=0;R1:=absR1/10;STC(R0,INBUF(5));OI("0",INBUF(5));;end;R1:=SCOORD+C1;SCOORD:=R1;;end;;endelseifR3=2thenbegin;CLC(2,NEXTBUF,"END");if=thenbegin;R0:=0;R1:=absNESTLEVEL/10;STC(R0,INBUF(6));OI("0",INBUF(6));R1:=NESTLEVEL-C1;NESTLEVEL:=R1;;end;;endelseifR3=6thenbegin;CLC(6,NEXTBUF,"COMMENT");if=thenbegin;L3:EX(R9,TRT(0,B8,TRTCOMMENT));if=thenbegin;FETCHCARD;gotoL3;;endelseifEOFthengotoL1elsebegin;R8:=R1+C1;R9:=@INBUF(84)-R8;ifR9<0thenFETCHCARD;gotoL1;;end;;end;;end;;end;begin;comment 2 => DIGIT OR "'" ;R0:=R0-R0;IC(R0,B8);NUMBERSCAN;;end;begin;comment 3 => PUNCTUATION ;R0:=R0-R0;NEXTBUFCOUNT:=R0;IC(R0,B8);STC(R0,NEXTBUF(0));R9:=R9-C1;if """ ;R2:=NEG_C1;MVI("""",NEXTBUF);R0:=R0-R0;NEXTCHAR;QUOTE:whileR0~=""""and~EOFdobegin;R2:=R2+C1;ifR2<256thenSTC(R0,NEXTBUF1(R2))elseifR2=256thenbegin;SAVERB:=R11;R4:=8;ERROR;R11:=SAVERB;;end;NEXTCHAR;;end;NEXTCHAR;ifR0=""""thenbegin;ifR2<255thenbegin;R2:=R2+C1;STC(R0,NEXTBUF1(R2));;end;NEXTCHAR;gotoQUOTE;;end;ifR2>255thenR2:=255;NEXTBUFCOUNT:=R2;;end;begin;comment 5 => "#" ;MVI("#",NEXTBUF(0));R0:=R0-R0;R1:=R0;L4:NEXTCHAR;ifR0>="A"andR0<="F"thenR0:=R0-#B7elseifR0>="0"andR0<="9"thenR0:=R0and#Felsebegin;NEXTBUFCOUNT:=R1;gotoL5;;end;R1:=R1+C1;ifR1<256thenSTC(R0,NEXTBUF(R1));gotoL4;L5:;end;begin;comment 6 => "." ;R9:=R9-C1;if=thenbegin;R0:=".";R8:=R8-C1;R9:=R9+C1;NUMBERSCAN;R1:=2;;endelsebegin;R1:=0;NEXTBUFCOUNT:=R1;MVI(".",NEXTBUF);R1:=3;;end;NEXTBUFTYPE:=R1;;end;begin;comment 7 => SEMICOLON ;R1:=SCOORD+C1;SCOORD:=R1;MVI(";",NEXTBUF(0));R0:=0;NEXTBUFCOUNT:=R0;R1:=3;NEXTBUFTYPE:=R1;R9:=R9-C1;ifthenbegin;R0:=CURBUFI(0);R4:=RINDEX(R2);ifR2<8thenbegin;whileR4>=0dobegin;CL(R0,RSVTEXT(R4));if=thengotoL;if=0dobegin;CL(R0,RSVTEXT(R4));if=thenbegin;CL(R1,RSVTEXT(R4+4));if=thengotoL;;end;if=0dobegin;R3:=@RSVTEXT(R4);CLC(8,CURBUF,B3);if=thengotoL;if=R0dobegin;MVC(255,B1,B2);R1:=R1+R0;R2:=R2+R0;R3:=R3-R0;;end;ifR3~=0thenbegin;DECR(R3);EX(R3,MVC(0,B1,B2));R1:=@B1(R3+1);;end;;end;segmentprocedureINITIALIZE(R9);begin;R7:=@SYMBUFFERS(0);CURBUFBASE:=R7;R7:=@SYMBUFFERS(272);NEXTBUFBASE:=R7;LM(R0,R1,COMMLIM);R11:=R0;comment OBTAIN COMMON LIMITS;R6:=R1-R0;comment COMMON SIZE;R0:=ISYMBOLINDEX-12shll16or12;BLOCKLIST(0):=R0;R3:=511;BLLIMIT:=R3;R7:=@NAMETABLE;R2:=@NAMETFILL;R1:=R7;R3:=ISYMBOLINDEX;SYMBOLINDEX:=R3;MOVETABLE;forR5:=552step12until732dobegin;R0:=NAMETABLE(R5)and#FFFor#D0000;NAMETABLE(R5):=R0;;end;comment SET R6 TO SIZE OF DYNAMICALLY ALLOCATED COMMON;R6:=@B11(R6)-R7;ifR6>#2AAA8thenR6:=#2AAA8;R5:=R6shra4*3Sand#FFFFF8;R0:=R5-16;SCRATCHINDEX:=R0;R7:=R7+R5;REFRECBASE:=R7;RFRCLISTBASE:=R7;XC(1,B7,B7);R4:=R6shra5and#FFFFF8;R7:=R7+R4;RFRCLISTLIMIT:=R7;R7:=R7+1020;PRBASE:=R7;R1:=R6shra4and#FFFFF8;ifR1<#2000thenR0:=R1elseR0:=#2000;R3:=AGETMAIN;BALR(R2,R3);comment GETMAIN;STM(R0,R1,CHAININFO);R5:=R1*3Sand#FFFFF8;R8:=COMMLIM(4)and#FFFFF8;IDLISTBASE:=R8;IDLBASE:=R8;R3:=IIDLISTINDEX;R0:=NEG_R3;IDLISTINDEX:=R0;R1:=R8-R3;R2:=@IDLISTFILL;MOVETABLE;R8:=R8-R5;IDDIRBASE:=R8;IDDBASE:=R8;R3:=IIDDIRINDEX;IDDIRINDEX:=R3;R1:=R8;R2:=@IDDIRFILL;MOVETABLE;R7:=@B7(4);INPOINT:=R7;PROGLIMIT:=R8;XC(7,STATE,STATE);XC(7,FLAGS,FLAGS);SET(LISTFLAG);RESET(NOGO);MVI(0,TRACE);SET(CHECKFLAG);TM(#20,SYSOPTIONS);if=thenMVI(1,DEBUGFLAG)elseMVI(2,DEBUGFLAG);RESET(DEBUG);RESET(PROCCOMP);MVC(7,ESDROOT,"AWXSC001");XC(7,TRACEBITS,TRACEBITS);RESET(STACKFLAG);RESET(NOPASSTWO);R0:=_4;ERRORCOUNT:=R0;R0:=0;STACKINDEX:=R0;BLOCKNO:=R0;SCOORD:=R0;RLISTPOINT:=R0;DIMCNT:=R0;TYPE:=R0;SIMTYPEINFO:=R0;STACKMAX:=R0;NESTLEVEL:=R0;RESET(LINEHOLD);R0:=1;RECORDNO:=R0;F01:=DBLANK;MVI("",INBUF);MVC(130,INBUF(1),INBUF);XC(255,HASHID,HASHID);MVC(255,HASHID(256),HASHID);MVC(255,HASHID(512),HASHID);MVC(255,HASHID(768),HASHID);R12:=IDDBASE;R11:=CHAIN;R2:=IDDIRINDEX-4;R3:=R2shra1;forR2:=R2step_4until108dobegin;R4:=IDDIRLNG(R2);R1:=IDDIRIND(R2)+IDLBASE;IC(R0,B1(0));R0:=R0and#3F;IC(R1,B1(R4));R1:=R1and#3Fshll3XOR_R0;R1:=R1++R1;R4:=HASHID(R1);CHAINID(R3):=R4;HASHID(R1):=R3;R3:=R3-2;;end;BB:=CURBUFBASE;PP:=PRBASE+1;C1:=1;OPENBLOCK;;end;segmentprocedureCLEANUP(R9);begin;ifLISTFLAGandLINEHOLDthenbegin;RESET(LINEHOLD);R0:=@INBUF;PRINT;;end;SET(ENDDOT);SET(ENDBLOCK);CLOSEBLOCK;R1:=STACKINDEX;whileR1>0dobegin;CLOSEBLOCK;R4:=3;ERROR;comment ERROR NO 3;R1:=STACKINDEX;;end;R0:=31;forR1:=IDDIRINDEX-4step_4untilIIDDIRINDEXdoifR0thenSET(DEBUG);MVC(25,OUTPUT,"EXECUTION_OPTIONS:DEBUG,0");OC(0,OUTPUT(25),DEBUGFLAG);OI("0",CARRCONT);if~CHECKFLAGthenMVC(6,OUTPUT(27),"NOCHECK");R0:=@OUTPUT;PRINT;MVC(39,OUTPUT,OUTPUT(40));MVC(22,HEADING(46),"COMPILATION_DIAGNOSTICS");MVI("1",CARRCONT);R3:=ERRORCOUNT;ifR3>=0thenbegin;SET(NOGO);MVC(25,OUTPUT(1),"ERROR_1XXX_NEAR_COORDINATE");forR3:=0step4untilERRORCOUNTdobegin;R1:=ERRORCODE(R3);CVD(R1,PKDEC);UNPK(2,1,OUTPUT(8),PKDEC(6));OI("0",OUTPUT(10));caseR1ofbegin;MVC(29,OUTPUT(35),"INCORRECTLY_FORMED_DECLARATION");MVC(17,OUTPUT(35),"INCORRECT_CONSTANT");MVC(12,OUTPUT(35),"MISSING""END""");MVC(24,OUTPUT(35),"UNMATCHED""END""(DELETED)");MVC(10,OUTPUT(35),"MISSING"")""");MVC(16,OUTPUT(35),"ILLEGAL_CHARACTER");MVC(16,OUTPUT(35),"MISSING_FINAL"".""");MVC(20,OUTPUT(35),"INVALID_STRING_LENGTH");MVC(18,OUTPUT(35),"INVALID_BITS_LENGTH");MVC(10,OUTPUT(35),"MISSING""(""");MVC(19,OUTPUT(35),"ERROR_TABLE_OVERFLOW");MVC(22,OUTPUT(35),"COMPILER_TABLE_OVERFLOW");MVC(14,OUTPUT(35),"ID_LENGTH>256");MVC(13,OUTPUT(35),"UNEXPECTED"".""");MVC(22,OUTPUT(35),"TOO_MANY_RECORD_CLASSES");;end;R1:=ERRORLOC(R3);CVD(R1,PKDEC);UNPK(3,7,OUTPUT(28),PKDEC);OI("0",OUTPUT(31));MVI("-",OUTPUT(33));OI("0",CARRCONT);R0:=@OUTPUT;PRINT;MVC(40,OUTPUT(35),OUTPUT(75));;end;;end;R3:=RECORDNO;NRECCLASS:=R3;R3:=BLOCKNOshll2;BLOCKLISTSIZE:=R3;R3:=SYMBOLINDEX-12;NAMETABLESIZE:=R3;R1:=@NAMETABLE+SYMBOLINDEX+19and#FFFFF8;R2:=REFRECBASE;R3:=RLISTPOINT+2;REFRECBASE:=R1;MOVETABLE;R1:=R1+7and#FFFFF8+1024;comment ALLOW LIT TABLE SPACE;R2:=INPOINT;R3:=R6+11and#FFFFF8-INPOINT;INPOINT:=R1;MOVETABLE;R1:=R1+7and#FFFFF8;TREEBASE:=R1;R1:=IDDIRINDEX+255and#FFFF00;R1:=@IDDIR(R1);R2:=IDLISTBASE+IDLISTINDEXand#FFFFF8;R0:=R2-256;ifR0>R1thenforR1:=R1-256step_256untilIDDIRBASEdobegin;R2:=R2-256;MVC(255,B2,B1);;end;IDDIRBASE:=R2;LM(R0,R1,CHAININFO);R3:=AFREEMAIN;BALR(R2,R3);;end;SAVE14:=R14;RETADDR:=R10;INITIALIZE;FETCHCARD;ADVANCESYMBOL;comment PRIME SCANNER;comment * * * MAIN PASS1 ROUTINE BEGINS HERE * * * ;L:ADVANCESYMBOL;R3:=CURBUFTYPE;ifPP>=PROGLIMITthenSTOP;comment MEMORY OVERFLOW;caseR3ofbegin;begin;comment 1 => IDENTIFIER, RESERVED WORD ;MATCHRESERVED;ifR3~=0thenbegin;PROCESSID;gotoL;;end;;end;begin;comment 2 => NUMBER ;R2:=CURBUFCOUNT;ifR2=0thenbegin;CLI("@",CURBUF1(0));if~=thenbegin;IC(R1,CURBUF1(0));OUTCODE;;end;;endelsebegin;R1:=@NUMBER;OUTCODE;OUTSTRING;;end;gotoL;;end;begin;comment 3 => PUNCTUATION ;R1:=R1-R1;R2:=R1;IC(R2,CURBUF(0));IC(R1,TRRESERVED(R2));IC(R2,PCODE(R1+1));IC(R1,PCODE(R1));;end;begin;comment 4 => STRING LITERAL (") ;R1:=@string;OUTCODE;R1:=CURBUFCOUNT;ifR1<0thenbegin;R4:=8;ERROR;R1:=R1-R1;CURBUFCOUNT:=R1;;end;OUTSTRING;gotoL;;end;begin;comment 5 => BITS LITERAL (#) ;R1:=@BITS;OUTCODE;R1:=CURBUFCOUNT;R0:=0;R2:=R0;ifR1=0orR1>8thenbegin;R4:=9;ERROR;;endelseforR3:=1step1untilR1dobegin;IC(R0,CURBUF(R3));R2:=R2shll4orR0;;end;OUTCODE4;gotoL;;end;;end;comment HERE R1 = OUTPUT CODE, R2 = PROCESSING CODE;L1:caseR2ofbegin;OUTCODE;comment SYMBOLS NEEDING NO PROCESSING;1begin;comment INVALID CHARACTERS ;2R4:=6;ERROR;;end;begin;comment ~, >, < ;3R2:=R2-R2;IC(R2,CURBUF(0));BB:=NEXTBUFBASE;CLI("=",NEXTBUF);if~=thenOUTCODEelsebegin;ifR2="~"thenR1:=@NEQelseifR2=">"thenR1:=@GEQelseR1:=@LEQ;OUTCODE;ADVANCESYMBOL;;end;;end;begin;comment : ;4BB:=NEXTBUFBASE;CLI("=",NEXTBUF);if=thenbegin;R1:=@ASSIGN;OUTCODE;ADVANCESYMBOL;;endelsebegin;CLI(":",NEXTBUF);if=thenbegin;R1:=@SPECCOLON;OUTCODE;ADVANCESYMBOL;;endelsebegin;OUTCODE;R1:=PP-LASTIDPTR;ifR1=2orR1=4thenbegin;R1:=#100;TYPE:=R1;R1:=0;SIMTYPEINFO:=R1;R2:=LASTIDNO;INSERTSYMBOL;;end;;end;;end;;end;begin;comment * ;5BB:=NEXTBUFBASE;CLI("*",NEXTBUF);if=thenbegin;R1:=@EXPONENT;OUTCODE;ADVANCESYMBOL;;endelsebegin;OUTCODE;ifFARRAYFLAGthenbegin;R1:=DIMCNT+C1;DIMCNT:=R1;;end;;end;;end;begin;comment ( ;6ifARRAYFLAGthenbegin;RESET(ARRAYFLAG);RESET(DECLARFLAG);ifPROCFLAGthenSET(FARRAYFLAG);;end;OUTCODE;;end;begin;comment ) ;7OUTCODE;R1:=STATE(4);ifR1~=0thenbegin;ifREFERFLAGthenbegin;RESET(REFERFLAG);R1:=RLISTPOINT+2;RLISTPOINT:=R1;R2:=R2-R2;R1:=R1+RFRCLISTBASE;REFRCDLIST:=R2;ifR1>=RFRCLISTLIMITthenSTOP;;endelseifRECORDFLAGthenbegin;RESET(RECORDFLAG);RESET(DECLARFLAG);;endelseifPROCFLAGthenbegin;ifFARRAYFLAGthenbegin;RESET(FARRAYFLAG);R1:=DIMCNT;R11:=NTBASE;forR2:=SCRATCHINDEX+12step12untilFARRAYPNTdoSTC(R1,TYPEINFO(R2+1));R1:=R1-R1;DIMCNT:=R1;;endelsebegin;CLOSEBLOCK;RESET(PROCFLAG);RESET(DECLARFLAG);;end;;end;;end;;end;begin;comment , ;8ifDECLARFLAGthenR1:=@SPECCOMMA;OUTCODE;;end;begin;comment SEMICOLON;9OUTCODE;RESET(DECLARFLAG);RESET(REFERFLAG);RESET(ARRAYFLAG);RESET(FARRAYFLAG);R1:=0;SIMTYPEINFO:=R1;SETTYPE;TYPE:=R1;;end;begin;comment FOR;10OUTCODE;OPENBLOCK;BB:=NEXTBUFBASE;ifC1=NEXTBUFTYPEthenbegin;ADVANCESYMBOL;MATCHRESERVED;ifR3=0thenbegin;comment RESERVED WORD - SAVE CODES & CLOSE BLOCK;array2integerCODESAVE;STM(R1,R2,CODESAVE);CLOSEBLOCK;LM(R1,R2,CODESAVE);gotoL1;;end;PROCESSID;R3:=#0601;TYPE:=R3;INSERTSYMBOL;R3:=R3-R3;TYPE:=R3;;end;CLOSEBLOCK;;end;begin;comment LONG ;11BB:=NEXTBUFBASE;ifC1=NEXTBUFTYPEthenbegin;R4:=NEXTBUFCOUNT;ifR4=3thenbegin;CLC(3,NEXTBUF,"REAL");if~=thengotoX;R1:=3;;endelseifR4=6thenbegin;CLC(6,NEXTBUF,"COMPLEX");if~=thengotoX;R1:=5;;endelsegotoX;SET(DECLARFLAG);SETTYPE;TYPE:=R1;ADVANCESYMBOL;R1:=@SIMPLETYPE;OUTCODE;R1:=TYPEand#F;;end;X:OUTCODE;;end;begin;comment BEGIN ;12OUTCODE;OPENBLOCK;;end;begin;comment END;13OUTCODE;SET(ENDBLOCK);CLOSEBLOCK;RESET(ENDBLOCK);BB:=NEXTBUFBASE;ifC1=NEXTBUFTYPEthenbegin;ADVANCESYMBOL;MATCHRESERVED;ifR3=0thengotoL1;;end;;end;begin;comment INTEGER, REAL, COMPLEX, LOGICAL (R1 = TYPE) ;14SET(DECLARFLAG);SETTYPE;TYPE:=R1;R0:=R0-R0;SIMTYPEINFO:=R0;R1:=@SIMPLETYPE;OUTCODE;R1:=TYPEand#F;OUTCODE;;end;begin;comment BITS;15SET(DECLARFLAG);SETTYPE;TYPE:=R1;R1:=@SIMPLETYPE;OUTCODE;R1:=8;OUTCODE;BB:=NEXTBUFBASE;CLI("(",NEXTBUF);if=thenbegin;DECODELENGTH;ifR1>=0andR1~=32thenbegin;R4:=1;ERROR;;end;;end;;end;begin;comment REFERENCE;16OUTCODE;R1:=RLISTPOINT+2;SIMTYPEINFO:=R1;R1:=9;SETTYPE;TYPE:=R1;SET(DECLARFLAG);BB:=NEXTBUFBASE;CLI("(",NEXTBUF);if=thenbegin;ADVANCESYMBOL;SET(REFERFLAG);;endelsebegin;R4:=10;ERROR;;end;;end;begin;comment VALUE;17OUTCODE;R1:=#1000000orTYPE;TYPE:=R1;;end;begin;comment RESULT;18OUTCODE;R1:=#2000000orTYPE;TYPE:=R1;;end;begin;comment ARRAY;19OUTCODE;SET(ARRAYFLAG);ifPROCFLAGthenbegin;R2:=SCRATCHINDEX;FARRAYPNT:=R2;;end;R1:=#000200orTYPE;TYPE:=R1;;end;begin;comment RECORD;20OUTCODE;R1:=RECORDNO+1;RECORDNO:=R1;ifR1>15thenbegin;R4:=15;ERROR;;end;R1:=R1shll16or#0400;TYPE:=R1;SET(RECORDFLAG);SET(DECLARFLAG);;end;begin;comment PROCEDURE;21OUTCODE;SET(DECLARFLAG);ifPROCFLAGthenbegin;R1:=TYPEor#1300;TYPE:=R1;;endelsebegin;R1:=TYPEor#0300;TYPE:=R1;BB:=NEXTBUFBASE;ifC1=NEXTBUFTYPEthenbegin;ADVANCESYMBOL;MATCHRESERVED;ifR3=0thengotoL1;BB:=NEXTBUFBASE;CLI("(",NEXTBUF);BB:=CURBUFBASE;if~=thenbegin;PROCESSID;OPENBLOCK;CLOSEBLOCK;;endelsebegin;R1:=BLOCKNO+1shll16orTYPE;TYPE:=R1;PROCESSID;R1:=R1-R1;TYPE:=R1;OPENBLOCK;SET(PROCFLAG);;end;R1:=BLOCKNO;ifR1=2thenbegin;R11:=NTBASE;SET(PROCCOMP);MVC(7,ESDROOT,"#####001");R1:=CURBUFCOUNT;ifR1>4thenR1:=4;EX(R1,MVC(0,ESDROOT,CURBUF));;end;;end;;end;;end;begin;comment STRING;22SET(DECLARFLAG);SETTYPE;TYPE:=R1;R1:=@SIMPLETYPE;OUTCODE;R1:=7;OUTCODE;BB:=NEXTBUFBASE;CLI("(",NEXTBUF);if~=thenR1:=16elsebegin;DECODELENGTH;ifR1<0thenR1:=C1elseifR1=0orR1>256thenbegin;R4:=1;ERROR;R1:=C1;;end;;end;OUTCODE;R1:=R1-C1;SIMTYPEINFO:=R1;;end;begin;comment . ;23ifEOFthengotoENDPROGRAMelsebegin;R4:=14;ERROR;;end;;end;;end;gotoL;ENDPROGRAM:R1:=@ENDFILE;OUTCODE;CLEANUP;R10:=RETADDR;;end;comment END OF PASS 1;segmentprocedurePASS2(R10);begin;integerREGISTER_IsynR7,JsynR8;comment STACK POINTERS;logicalRASAVE;integerSAVE14,METABASE;integerCOMMONBASEsynXFERVECTOR(0);integerSCOORD;comment SOURCE TEXT COORDINATE;byteFLAG,ERRFLAG;byteUNDECLFLAG,COMMONFLAG;byteSIMTYPE,STRINGLENGTH;integervalue;array0byteEDITCODEsyn0;comment COMPILED EDITING STRING;integerEDITINDEX,NODEINDEX,OLDINPOINT,OLDEDIT;integerNODECHAIN;comment PTR TO LAST COUNT IN EDITCODE;integerCHARTLEVEL;comment GRAPHIC NESTING LEVEL;byteSIGN;integerSCALE;longrealFCONV;comment FOR CONVERSION;array2longrealNUMBUFFER;longrealNUMVALUEsynNUMBUFFER(8);integerINUMVALUEsynNUMVALUE(4),NUMVALHIGHsynNUMVALUE(0);longrealDECsynPKDEC;integerHEXsynPKDEC;dummybaseR12;comment ALLOCATED FROM WORK SPACE;array8logicalPARSEREG;comment PARSE LOOP REGISTER IMAGE;integerR3SAVEsynPARSEREG(8);integerRULENUMBERsynPARSEREG(16);integerR6SAVEsynPARSEREG(20);integerISAVEsynPARSEREG(24),JSAVEsynPARSEREG(28);integerOUTBASE;comment BASE OF CURRENT TREE SEGMENT;integerPLIMIT;comment MAXIMUM P INDEX;array0longrealPALIGN;comment ALIGN P;array0logicalP;comment OUTPUT WORK AREA, SIZE IS DYNAMIC;byteOPsynP;byteCONVsynP(1);shortintegerPOINTERsynP(2);shortintegerPSTACKsynP;closebase;array32shortintegerDISPLAY;comment STATIC LINK CHAIN;integerBN,BLC;comment BLOCK NO., NESTING LEVEL;integerHN;comment HIERARCHY NUMBER;integerIHN;comment IMPLICIT SUBROUTINE HN;integerDISPLAYORG;comment SEGMENT DISPLAY ORIGIN;integerDRELAD;comment LOCAL VARIABLE BASE;integerSN,SNC;comment MAXIMUM, CURRENT SEGMENT NO.;shortintegerCTPNT;comment CONSTANTTABLE POINTER;shortintegerLITPNT;comment LITERALTABLE POINTER;shortintegerCTORG,LITORG;array0logicalLITERALTABLEsynB3;comment LITERALS (DYNAMIC);integerLITBASE;array96byteS;comment PARSER SYMBOL STACK;array96byteS2;comment STACK OF RELATIONS;array96longrealV;comment INTERPRETATION STACK;logicalV12synV(0);shortintegerV1synV(0);shortintegerV2synV(2);comment BOTH TYPE FIELDS;byteV21synV2(0);comment TYPE;byteV22synV2(1);comment SIMPLE TYPE;shortintegerV34synV(4);comment REGISTER FIELDS;byteV3synV34(0);comment GENERAL REGISTER COUNT;byteV4synV34(1);comment FLOATING REGISTER COUNT;shortintegerV5synV(6);comment OUTPUT POINTER FIELD;array96longrealT;comment EDITCODE INTERPRETATION STACK;logicalVAsynT(0);comment ATTRIBUTE BITS;shortintegerT0synVA(0);integerVXsynT(4);comment EDITCODE POINTER;integerLABELADDR;array256integerCONSTANTTABLE;shortintegerCINFOsynCONSTANTTABLE;byteCLENGTHsynCONSTANTTABLE;byteCTYPEsynCONSTANTTABLE(1);shortintegerCADDRsynCONSTANTTABLE(2);integerTREELENGTH,INPOINTSAVE;segmentbaseR14;comment *** READ ONLY CONSTANTS *** ;array7longrealPOWER10=(#41A0000000000000L,#4264000000000000L,#4427100000000000L,#475F5E1000000000L,#4E2386F26FC10000L,#5B4EE2D6D415B85BL,#76184F03E93FF9F5L);equateLSSsyn#1,GTRsyn#2,EQLsyn#3;equateDPDORGsyn40;comment STACK MARK LENGTH;array8byteMASK=("",5(#20),2("")),MASK2=("",3(#20),2(#21),2(""));array256byteINPUTSW=(10,2(0),8,97(0),3,10(1),9,6(1),5,9(1),6,12(1),7,8(1),9,11(1),30(0),9(2),7(0),9(2),8(0),8(2),6(0),10(4),6(0));array16characterTRANSTABLE=("0123456789ABCDEF");array48byteLETTERIDNO=(0,1,2,3,4,5,6,7,8,9,7(0),10,11,12,13,14,15,16,17,18,8(0),19,20,21,22,23,24,25,26,6(0));array10byteLENGTHTABLE=(0,2(4),2(8),16,1,0,2(4));array17shortintegerBITTABLE=(#0,#1,#2,#4,#8,#10,#20,#40,#80,#100,#200,#400,#800,#1000,#2000,#4000,#8000);array10shortintegerINCREASE=(0,1,#100,#100,#200,#200,1,2,1,1);equateIDCODEsyn#65,NUMBERCODEsyn#77,STRINGCODEsyn#81,ENDFILEsyn#92,APARHEADsyn#1C,TPROCHDsyn#0A;byteCOLON1syn#99;equatecomment SYMBOLS DISTINGUISHED IN ERROR RECOVERY;BEGINCODEsyn#97,ENDCODEsyn#6F,SCOLCODEsyn#70,BHCODEsyn#29,BBCODEsyn#28,BBEXPCODEsyn#21,CASESEQCODEsyn#2D,PROCNTsyn#0C,PROCDCLsyn#08,GOTOCODEsyn#94,LPARCODEsyn#6A,FORCODEsyn#9B,FORCLCODEsyn#2E,FORLISTCODEsyn#30,FORHDsyn#2F,BNDLSTHDsyn#07;equateTRACEINDEXsyn540;comment TRACE NT INDEX;array3shortintegerMOVE=(#D200S,@BUFFER(75),@B1),ERRMOVE=(#D200S,@BUFFER(65),@B1),ERRMOVE1=(#D200S,@BUFFER(36),@B1),MOVE31=(#D200S,@B3,@B1),MOVE14=(#D200S,@B1,@B4),COMPARE24=(#D500S,@B2,@B4),TREEMOVE=(#D200S,@B2(4),@B4),MOVE24=(#D200S,@B2,@B4),MOVENUMBER=(#D200S,@NUMVALUE,@B5);bytePLUSsyn1;byteMINUSsyn2;byteTIMESsyn3;byteDIVIDEsyn4;byteEXPONsyn5;byteLCOLONEQsyn6;shortintegerLASSIGN=@LCOLONEQ;byteACOLONEQsyn7;shortintegerAASSIGN=@ACOLONEQ;byteSCOLONEQsyn8;shortintegerSASSIGN=@SCOLONEQ;byteRCOLONEQsyn9;shortintegerRASSIGN=@RCOLONEQ;byteSTEPUNTILsyn12;byteDIVsyn13;byteREMsyn14;byteLESSsyn15;byteLESSEQsyn16;byteGREATERsyn17;byteGTEQsyn18;byteEQUALsyn19;byteUNEQsyn20;byteLCOLONEQ2syn22;byteACOLONEQ2syn23;byteSCOLONEQ2syn24;byteRCOLONEQ2syn25;byteAPPARENsyn29;byteINDXsyn30;byteREFXsyn31;byteIFEXPsyn32;byteCOMMAsyn33;byteLCOMMAsyn34;byteSHLsyn35;byteSHRsyn36;byteBBBsyn37;byteENDDsyn38;bytePCLsyn39;byteSUBSTRINGsyn40;byteBARsyn41;byteAPCOMMAsyn42;byteRCOMMAsyn43;byteARCOMMAsyn44;byteARPARENsyn45;byteRPARENsyn46;byteLOGORsyn47;byteBITORsyn48;byteLOGANDsyn49;byteBITANDsyn50;byteITERSTsyn51;byteITERST2syn52;byteFORLISTsyn53;byteFORCLsyn54;byteENDFORLISTsyn55;byteUJIFEXPsyn56;byteUJsyn57;byteCLLsyn58;byteIFSTsyn59;byteCOLONsyn60;byteISsyn61;byteIFST2syn62;byteWHILEOPsyn64;byteWHILESTsyn65;byteIFJsyn66;comment UNARY OPERATORS;byteUMINUSsyn67;byteABSSsyn68;byteLOGNOTsyn71;byteBITNOTsyn72;byteASSERTsyn73;byteEXITsyn74;byteGOTOOsyn75;byteCARDsyn79;shortintegerCARDD=@CARD;byteCASEIDXsyn80;shortintegerCASEIDXX=@CASEIDX;byteUCOUNTsyn81;comment TERMINAL NODES;byteBEGINNsyn83;byteINUMBERsyn85;byteNUMBERsyn86;byteIDsyn87;byteLABELIDsyn88;byteARRAYIDsyn89;byteFUNCIDsyn90;shortintegerFUNCIDD=@FUNCID;byteRCCLIDsyn91;byteFIELDIDsyn92;byteCONIDsyn93;byteFTNsyn94;bytePROCDCsyn95;byteCONTROLsyn97;byteBITTsyn98;byteSTRINGGsyn99;byteTRUEsyn100;byteFALSEsyn101;byteWHILEEsyn102;byteNULsyn103;byteNULLSTsyn104;byteARRAYDCsyn105;byteARSTARsyn106;byteSTFUNCIDsyn107;byteSTPROCIDsyn108;byteIFFsyn109;bytecomment EDIT CODE CONTROL OPERATORS;JBsyn#00,JCsyn#01,PVsyn#02,SEMI1syn#A3,UPOSsyn#A4,UNEGsyn#A5,SPACECODEsyn#A6,NTABsyn#DA,LTAB0syn#DB,RTAB0syn#DC,JDsyn#EA,JADsyn#EB,JPDsyn#EC,FDsyn#ED,VRSTOPsyn#EE,JLOOPsyn#EF,LTABsyn#FA,LTAB1syn#FB,COUNTCODEsyn#FC,COUNTCODE1syn#FD,RTABsyn#FE,RTAB1syn#FF;array163shortintegerMTB=(0,1,2,13,31,43,44,56,73,74,75,102,108,119,120,136,185,195,208,220,221,238,245,253,261,262,269,294,303,338,365,366,379,390,396,403,426,427,428,433,443,483,512,513,518,519,542,552,570,583,590,591,601,626,632,633,634,635,696,697,728,729,748,749,762,768,769,770,780,790,800,806,811,817,823,824,825,826,827,828,829,830,831,832,833,834,835,836,837,838,839,840,841,842,843,844,845,846,847,848,849,850,892,893,894,900,901,954,955,956,957,958,959,960,966,967,968,969,975,981,986,993,994,999,1006,1007,1008,1014,1020,1021,1026,1031,1032,1033,1034,1035,1041,1042,1043,1048,1053,1059,1065,1070,1071,1072,1073,1080,1081,1087,1088,1089,1094,1100,1101,1102,1108,1115,1120,1127,1133,1134,1135);array163shortintegerRMAP=(0,61,122,183,244,61,305,366,427,0,488,61,549,610,671,732,793,854,305,61,915,976,1037,366,610,366,1098,1159,1220,1281,1342,366,1403,1464,366,1525,0,1586,1647,1708,1769,1830,1891,1952,2013,2074,2013,2135,366,2196,366,2013,2257,2318,2379,0,2379,2440,2501,2562,2623,2684,1159,2196,1037,0,1952,2745,2806,2867,1037,1159,2(1037),27(0),2928,2989,3050,2989,3111,3172,2(3233),366,2989,1159,3294,2989,3355,2989,3416,2989,3477,1159,366,3538,3599,366,3660,3721,3(3782),2(2501),5(3843),2(3904),2(1159),2(3904),1159,3(3965),4026,4087,4148,2(3965),4209,1342,1891,4270,2989,366,4331,366,3904,3965,3904,4392);array163byteCMAP=(0,1,2,3,4,1,2,2,5,0,3(6),7,5(8),1,3(2),9,10,4(9),11,12,13,11,14,14,15,0,16,17,18,9,9,19,20,12,5(18),21,18,18,22,23,0,24,15,25,26,27,28,29,30,9,0,31,9,9,32,9,14,14,18,27(0),33,34,35,4,36,37,38,38,10,39,40,41,42,39,43,44,2,45,46,11,10,47,11,10,48,49,49,48,50,15,4(51),28,52,52,5(14),3(48),53,54,18,48,48,55,18,56,57,18,58,59,18,14,48,52,60);array163byteBBCONTEXT=comment BASIC BLOCK DELIMITERS;(10(2),1,18(2),3(0),12(2),3(0),4(2),0,111(2));array167byteATTRTB=(14(0),5,1,2(0),5,32(0),6,0,1,2,4,2(0),4,2(0),2(4),2(0),2(4),0,6,4,2,2(0),4,2,6(3),0,2(2),3(3),0,4,0,2(1),5(3),2,3(3),0,4,0,2,2(1),3(2),2(1),3(0),4,0,2,0,4,0,4,0,2(4),6,0,4,2(0),2,4,0,2,0,2(4),0,4,2(0),1,0,4,3(0),2(3),0,1,0,4,0,6,0,4,3,0,4,1,2,1,2,0,4,0);array163byteLCTYPE=comment LEFT CONTEXT TYPE HINTS;(7(0),#11,2(0),4,12(0),#11,0,#19,#11,0,3,0,2(1),3(0),4,12(0),#11,0,#11,0,#11,48(0),8(0),#11,6(0),#11,0,#11,4(0),#11,2(0),2(#11),#16,2(0),3(#11),2(#16),2(#11),2(0),2(#11),0,3(2),#10,2(0),2(2),3(0),2,0,2(#11),0,#13,2,#11,0);equateOPSsyn109;comment FIRST INFORMATIVE OPERATOR (::);array54byteRCTYPE=comment RIGHT CONTEXT TYPE HINTS;(#11,6(0),#11,0,#11,5(0),#11,#19,2(#11),#16,2(0),3(#11),#16,0,2(#18),5(0),3(#11),3(0),2(#11),3(0),#15,0,2(#11),2(0),2(#11),0);array163byteLC1=(7(0),53,0,0,54,12(0),53,0,53,53,0,53,0,54,53,0,0,53,53,4(0),53,7(0),53,0,53,0,53,56(0),53,6(0),60,3(0),53,0,0,53,0,0,3(58),0,0,5(60),62,62,0,0,62,62,0,3(56),3(0),56,56,0,54,0,54,0,53,0,53,62,56,62,0);array163byteRC1=(103(0),53,0,53,64,0,0,53,0,53,53,3(0),59,0,53,0,0,53,53,0,53,4(57),0,0,4(59),0,61,61,5(0),3(57),0,53,0,57,57,3(0),63,0,0,53,0,0,57,61,0);array1136bytePRTB=(2(255),0,2,1,0,2,2,102,101,2,11,255,1,3,101,2,10,2,3,110,101,6,16,2,3,113,101,12,28,255,1,4,103,3,12,2,4,102,101,4,14,2(255),2,6,102,101,6,17,1,6,106,7,18,255,4,7,53,109,53,103,5,15,4,7,53,109,53,105,7,19,3(255),1,10,38,8,20,0,10,8,21,1,10,54,8,22,2,10,107,129,8,23,2,10,108,129,8,24,255,1,11,112,10,25,255,0,12,11,0,2,12,13,103,11,26,2(255),0,14,13,0,2,14,102,101,14,41,1,14,112,15,0,255,2,15,3,101,14,35,3,15,3,114,101,14,36,3,15,3,115,101,14,37,3,15,3,113,101,14,38,4,15,3,114,115,101,14,39,2,15,113,101,14,40,3,15,3,110,101,18,44,255,0,16,13,0,1,16,112,15,0,255,2,17,116,103,16,42,2,17,116,105,17,0,255,1,18,106,17,0,2,18,102,101,18,45,2(255),1,20,103,19,46,2,20,102,101,20,48,1,20,112,21,0,255,2,21,3,101,20,49,255,3,22,106,3,101,20,47,255,3,23,53,24,103,191,52,2(255),2,25,53,103,192,55,255,2,26,53,103,192,56,2,26,116,103,192,57,2,26,53,105,26,59,2,26,116,105,26,60,255,0,27,190,102,0,27,39,130,255,2,28,53,103,27,62,2,28,37,103,27,63,1,28,103,27,64,2,28,53,105,28,66,2,28,37,105,28,67,1,28,105,28,68,255,2,29,30,54,182,69,0,29,38,123,1,29,38,38,124,1,29,44,38,125,2,29,44,38,38,126,2(255),2,31,53,103,182,70,2,31,53,105,31,74,255,1,32,106,31,73,1,32,151,45,152,255,1,33,111,190,104,255,2,34,53,103,190,105,255,2,35,53,103,185,89,1,35,103,185,90,2,35,53,105,35,116,1,35,105,35,117,3(255),0,38,37,0,255,0,39,38,0,1,39,122,44,150,255,2,40,53,111,190,103,1,40,111,39,135,2,40,37,111,39,136,2,40,53,112,33,137,2,40,37,112,40,139,1,40,42,40,140,1,40,112,40,141,255,0,41,40,138,2,41,1,112,41,143,2,41,5,112,41,144,2,41,8,112,41,145,2,41,19,112,41,146,2(255),0,43,39,129,2(255),1,45,111,38,127,2,45,37,111,38,128,2,45,37,112,45,153,1,45,112,45,154,255,0,46,38,119,1,46,38,38,120,255,3,47,50,53,147,46,155,1,47,147,46,156,1,47,105,48,159,255,2,48,53,147,46,157,2,48,53,105,48,160,255,2,49,154,54,47,158,2(255),0,51,38,121,1,51,38,38,122,255,2,52,53,103,39,132,2,52,162,103,39,133,2,52,53,105,52,166,2,52,162,105,52,167,255,1,53,122,30,72,4(255),2,57,144,56,183,76,2,57,160,56,183,77,2,57,143,56,183,78,2,57,149,56,183,79,2,57,150,56,183,80,2,57,145,56,183,81,2,57,125,69,183,82,2,57,126,58,185,85,2,57,127,58,185,86,2,57,128,58,185,87,2(255),2,59,116,60,187,93,2,59,131,60,187,94,2,59,132,60,187,95,2,59,133,60,187,96,2,59,134,60,187,97,2(255),2,61,161,62,189,99,2,61,136,62,189,100,2,61,137,62,189,101,2(255),2,63,154,54,43,148,2,63,154,43,43,149,255,1,64,106,23,53,3(255),0,67,191,51,1,67,106,26,58,255,0,68,27,61,1,68,106,28,65,255,0,69,185,88,1,69,106,35,115,255,1,70,106,25,0,255,0,71,190,0,255,1,72,106,34,114,255,1,73,106,52,165,28(255),0,101,193,1,0,101,66,2,0,101,67,3,0,101,68,4,0,101,69,5,0,101,70,6,0,101,71,7,0,101,72,8,0,101,73,9,1,101,153,42,147,3(255),1,104,101,4,13,2(255),2,106,3,101,14,29,3,106,3,114,101,14,30,3,106,3,115,101,14,31,4,106,3,114,115,101,14,32,3,106,3,113,101,14,33,2,106,113,101,14,34,3,106,3,110,101,18,43,0,106,34,113,7(255),1,113,101,12,27,4(255),1,117,101,22,50,255,1,118,119,24,54,255,0,119,190,111,255,2,120,53,121,29,71,2(255),0,122,44,151,255,2,123,53,124,32,75,3(255),1,126,58,185,83,255,1,127,58,185,84,2(255),0,129,185,91,255,0,130,185,92,5(255),1,135,60,188,98,3(255),0,138,190,106,255,0,139,190,107,255,1,140,62,190,108,255,1,141,62,190,110,255,0,142,190,112,4(255),2,146,8,146,36,118,2(255),1,148,66,39,131,3(255),0,151,41,142,255,1,152,54,39,134,3(255),1,155,101,49,161,255,2,156,53,157,50,162,255,0,157,50,163,255,2,158,53,147,51,164,255,1,159,62,190,109,4(255));array4453byteMATRIX=(102(0),3,53(0),3,6(0),2,52(0),3,5(0),3,0,0,3,3,51(0),3,3,59(0),3,0,0,3,32(0),1,0,1,0,3(1),6(0),3,3(0),1,0,1,3(0),1,1,3(0),1,8(0),1,0,0,1,1,4(0),1,46(0),3,11(0),3,16(0),1,0,1,0,3(1),0,3,1,0,1,0,0,3,0,0,1,0,1,0,1,0,1,1,3(0),1,3,0,0,2,4(0),1,0,0,1,1,0,0,2,0,1,12(0),3,1,28(0),1,3(0),2,54(0),3,59(0),3,2,5(0),3,22(0),3,1,37(0),3,53(0),2,5(0),3,63(0),3,50(0),3,3,5(0),3,22(0),3,1,93(0),3,32(0),1,0,1,0,3(1),6(0),3,3(0),1,0,1,3(0),1,1,3(0),1,6(0),3,0,1,0,0,1,1,4(0),1,15(0),2,10(0),2,13(0),2,2,3(0),2,2,0,0,2,2,0,3(2),0,4(2),3(0),2,2,10(0),1,0,1,0,3(1),3,1,1,0,1,0,3,3(0),1,0,1,0,1,0,1,1,0,3,3,1,8(0),1,0,0,1,1,4(0),1,14(0),1,0,1,3,3(1),0,3,1,0,1,0,1,3(0),1,0,1,0,1,0,1,1,0,2,2,1,0,0,2,2,4(0),1,1,0,1,1,0,0,2,0,1,14(0),1,0,1,0,3(1),7(0),3,0,0,1,0,1,3(0),1,1,3(0),1,8(0),1,0,0,1,1,4(0),1,42(0),3,17(0),3,45(0),3,29(0),1,0,1,0,3(1),6(0),3,3(0),1,0,1,3(0),1,1,0,3,3,1,8(0),1,0,0,1,1,4(0),1,40(0),3,3,3(0),3,3,54(0),2,2,3(0),2,2,11(0),2,42(0),2,2,3(0),2,2,5(0),3,5(0),2,16(0),1,0,1,0,3(1),3,1,1,3,1,0,3,3(0),1,0,1,0,1,0,1,1,3(0),1,0,0,3,3,4(0),1,0,0,1,1,4(0),1,6(0),3,3(1),3,1,0,0,2,0,2,0,8(2),0,2,3(0),2,0,2,0,2,0,2,2,3(0),2,0,0,2,2,1,3(0),2,0,0,2,2,4(0),2,14(0),2,0,2,0,8(2),0,2,3(0),2,0,2,0,2,0,2,2,3(0),2,0,0,2,2,4(0),2,0,0,2,2,4(0),2,40(0),2,2,3(0),2,2,5(0),2,5(0),2,16(0),1,0,1,5(0),3,1,0,1,9(0),1,0,0,1,0,2,2,3(0),2,2,11(0),2,0,1,14(0),1,0,1,4(0),3,1,1,0,1,9(0),1,0,0,1,6(0),3,3,13(0),1,26(0),3,14(0),3,17(0),3,3(0),1,1,58(0),3,12(0),1,0,1,0,3(1),6(0),3,3(0),1,0,1,3(0),1,1,3(0),1,8(0),1,0,0,1,1,4(0),1,4(0),3,10(0),3,24(0),3,3,3(0),3,3,3(0),1,0,3,6(0),3,4(0),3,11(0),2,10(0),2,13(0),2,2,3(0),2,2,3(0),2,0,2,5(0),2,2,3(0),2,2,49(0),3,3,21(0),2,10(0),2,13(0),2,2,3(0),2,2,3(0),2,0,3(2),3(0),2,2,3(0),2,2,45(0),3,6(0),3,19(0),2,10(0),2,13(0),2,2,3(0),2,2,0,0,2,2,0,3(2),0,2,0,2,2,3(0),2,2,53(0),3,18(0),2,10(0),2,13(0),2,2,3,0,0,2,2,0,0,2,2,0,3(2),0,4(2),0,0,3(2),11(0),2,10(0),2,13(0),2,2,3,0,0,2,2,0,0,2,2,0,3(2),0,4(2),3(0),2,2,11(0),2,10(0),2,13(0),2,2,3,0,0,2,2,3(0),2,0,3(2),3(0),2,2,3(0),2,2,8(0),2,2,0,2,10(0),2,12(0),4(2),0,0,2,2,0,0,2,2,0,3(2),0,4(2),0,3,3(2),34(0),3,37(0),2,10(0),2,11(0),2,0,3(2),0,7(2),0,3(2),0,4(2),0,0,3(2),10(0),2,0,2,0,6(2),0,2,0,2,3(0),2,0,2,0,2,0,2,2,0,3(2),6(0),2,0,2,0,0,2,2,4(0),2,4(0),2,3(0),3,1,4(0),2,0,2,0,6(2),0,2,0,2,3(0),2,0,2,0,2,0,2,2,0,3(2),4(0),3,0,2,0,2,0,0,2,2,4(0),2,4(0),2,50(0),3,11(0),6(2),0,0,2,0,2,0,8(2),0,2,2,0,0,2,0,2,0,2,0,2,2,3(0),2,2,0,3(2),3(0),2,0,0,2,2,0,0,2,0,2,38(0),3,9(0),3,26(0),1,4(0),1,12(0),3,1,4(0),1,0,3,3,1,8(0),1,8(0),1,51(0),3,23(0),2,0,5(2),0,2,2,0,2,0,2,3(0),2,0,2,0,2,0,2,2,0,3(2),0,0,2,2,4(0),2,2,0,2,2,0,0,2,0,2,14(0),2,0,2,0,3(2),0,2,2,0,2,0,0,2,0,0,2,0,2,0,2,0,2,2,0,3(2),0,0,2,2,4(0),2,0,0,2,2,0,0,2,0,2,42(0),2,17(0),2,37(0),3,1,36(0),1,4(0),1,10(0),3,1,0,1,4(0),1,3(0),1,8(0),1,8(0),1,14(0),1,4(0),1,12(0),3,1,4(0),1,3(0),1,8(0),1,8(0),1,14(0),1,4(0),1,14(0),3,3(0),1,3(0),1,8(0),1,8(0),1,14(0),1,4(0),1,1,8(0),3,0,1,0,1,3(0),1,1,3(0),1,8(0),1,0,0,1,1,4(0),1,8(0),1,1,3,1,35(0),1,27(0),2,0,2,5(0),2,2,0,2,9(0),2,0,0,2,0,2,2,3(0),2,2,11(0),2,0,2,36(0),3,0,1,28(0),6(2),0,0,2,0,2,0,8(2),0,2,3(0),2,0,2,0,2,0,2,2,3(0),2,0,0,3(2),3(0),2,0,0,2,2,4(0),2,14(0),1,0,1,0,3(1),4(0),3,0,0,3,0,0,1,0,1,0,1,0,1,1,3(0),1,8(0),1,0,0,1,1,4(0),1,14(0),2,0,2,0,3(2),6(0),2,3(0),2,0,2,3(0),2,2,3(0),2,8(0),2,0,0,2,2,4(0),2,40(0),3,3,24(0));closebase;segmentbaseR6;comment SYMBOLS OF GRAMMAR;array1992characterMETATABLE=("","","","","","","","","","","","","","","","","","","","","",",)REFERENCE(,","(ALGOL_______FORTRAN::ARRAY","END;PROCEDURE___VALUE_______RESULT","*RECORD|IF","THEN________ELSE________CASE________OF__________IS","+-ORNULL","/DIV_________REM_________AND~","SHL_________SHR_________TRUE________FALSE_______LONG","ABS<=>",".DO__________GOTO<=>=","BEGIN_______ASSERT::=FOR","STEP________UNTIL_______WHILE_______SHORT~=","**;+-");closebase;byteMULTDEFsyn1;byteUNDECLsyn2;byteSYNTAXERRORsyn3;byteRCCLERRORsyn4;byteTYPE3ERRORsyn5;byteAPARERRORsyn6;byteARRAYERRORsyn7;byteDATAERRORsyn8;byteFIELDERRORsyn9;byteLENGTHERRORsyn10;byteREFERRORsyn11;byteHIERARCHYERRORsyn12;byteBLOCKEXPERRORsyn13;byteREFRECERRORsyn14;bytePROCERRORsyn15;byteTYPEERRORsyn16;byteRESULTERRORsyn17;bytePPROCERRORsyn18;byteRELATIONERRORsyn19;byteARRAY2ERRORsyn20;byteCONSTANTERRORsyn21;byteSTRINGERRORsyn22;byteTABLEERRORsyn23;byteNPROCERRORsyn24;byteCONVERRsyn25;byteINDEXERRORsyn26;byteTYPE1ERRORsyn27;byteTYPE2ERRORsyn28;bytePRECERRORsyn29;byteASSIGNERRORsyn30;byteNAMEWARNsyn31;byteVAR2ERRORsyn32;segmentprocedureERROR(R10);begin;array6logicalREGSAVE;longrealDEC;byteSTACKDUMP;procedureIDWRITE(R5);begin;R3:=IDDIRBASE;R1:=R1shla2;R2:=IDLENGTH(R1);R1:=IDPOINT(R1)+IDLISTBASE;;end;procedureMETAWRITE(R5);begin;R1:=R1*12S+METABASE;R2:=@B1(12);L:DECR(R2);CLI("",B2);if=thengotoL;R2:=R2-R1;;end;procedureOPERANDERROR(R3);begin;MVC(28,BUFFER(35),"INCORRECT_OPERAND_TYPE(S)FOR");METAWRITE;EX(R2,ERRMOVE);;end;STM(R1,R6,REGSAVE);MVC(130,BUFFER(1),BUFFER);ifR0>=0thenSET(NOGO);R0:=absR0;RESET(STACKDUMP);R3:=R0;CVD(R0,PKDEC);MVC(25,BUFFER(1),"ERROR_2XXX_NEAR_COORDINATE");UNPK(2,1,BUFFER(8),PKDEC(6));OI("0",BUFFER(10));caseR3ofbegin;begin;MVC(29,BUFFER(35),"MORE_THAN_ONE_DECLARATION_OF""");IDWRITE;EX(R2,ERRMOVE);R4:=@BUFFER(R2+66);MVC(14,B4,"""IN_THIS_BLOCK");;end;ifR1=0thengotoLelsebegin;MVI("""",BUFFER(35));IDWRITE;EX(R2,ERRMOVE1);R4:=@BUFFER(R2+37);MVC(13,B4,"""IS_UNDEFINED");;end;begin;MVC(12,BUFFER(35),"SYNTAX_ERROR");SET(STACKDUMP);R6SAVE:=R6;;end;MVC(34,BUFFER(35),"IDENTIFIER_MUST_BE_RECORD_CLASS_ID");MVC(20,BUFFER(35),"MISMATCHED_PARAMETER");MVC(37,BUFFER(35),"INCORRECT_NUMBER_OF_ACTUAL_PARAMETERS");MVC(19,BUFFER(35),"INCORRECT_DIMENSION");MVC(18,BUFFER(35),"DATA_AREA_EXCEEDED");MVC(26,BUFFER(35),"INCORRECT_NUMBER_OF_FIELDS");MVC(27,BUFFER(35),"INCOMPATIBLE_STRING_LENGTHS");MVC(23,BUFFER(35),"INCOMPATIBLE_REFERENCES");MVC(23,BUFFER(35),"BLOCKS_NESTED_TOO_DEEPLY");MVC(41,BUFFER(35),""";""SHOULD_NOT_FOLLOW_EXPRESSION(WARNING)");MVC(36,BUFFER(35),"REFERENCE_MUST_REFER_TO_RECORD_CLASS");MVC(36,BUFFER(35),"EXPRESSION_MISSING_IN_PROCEDURE_BODY");MVC(28,BUFFER(35),"IMPROPER_COMBINATION_OF_TYPES");MVC(34,BUFFER(35),"RESULT_PARAMETER_MUST_BE_A_VARIABLE");MVC(39,BUFFER(35),"PROPER_PROCEDURE_ENDS_WITH_AN_EXPRESSION");begin;R6SAVE:=R6;MVI("""",BUFFER(35));R1:=R6;METAWRITE;EX(R2,ERRMOVE1);R4:=@BUFFER(R2+37);MVC(16,B4,"""CANNOT_FOLLOW""");R4:=@B4(17);R1:=R1-R1;IC(R1,S(I));METAWRITE;EX(R2,MVC(0,B4,B1));R4:=@B4(R2+1);MVC(5,B4,"""HERE");;end;MVC(24,BUFFER(35),"ARRAY_ID_USED_INCORRECTLY");MVC(31,BUFFER(35),"TOO_MANY_CONSTANTS_IN_PROCEDURE");MVC(23,BUFFER(35),"INCORRECT_STRING_LENGTH");MVC(23,BUFFER(35),"COMPILER_TABLE_OVERFLOW");MVC(18,BUFFER(35),"TOO_MANY_PROCEDURES");begin;MVC(20,BUFFER(35),"CONSTANT_OUT_OF_RANGE");R6SAVE:=R6;;end;MVC(39,BUFFER(35),"INDEX_OF_ARRAY_OR_STRING_MUST_BE_INTEGER");begin;R1:=R1-R1;R2:=JSAVE;IC(R1,S(R2));OPERANDERROR;;end;begin;R1:=R1-R1;R2:=ISAVE+JSAVEshra1;IC(R1,S(R2));OPERANDERROR;;end;MVC(39,BUFFER(35),"INCORRECT_PARENTHESIZATION_OF_EXPRESSION");MVC(25,BUFFER(35),"ASSIGNMENT_INCOMPATIBILITY");begin;MVC(4,BUFFER(1),".NOTE");MVC(33,BUFFER(35),"NAME_PARAMETER_SPECIFIED(WARNING)");;end;MVC(34,BUFFER(35),"SIMPLE_VARIABLE_ID_USED_INCORRECTLY");;end;R6:=R6SAVE;R2:=SCOORD;ifR6=SCOLCODEorR6=BEGINCODEthenDECR(R2);CVD(R2,DEC);UNPK(3,7,BUFFER(28),DEC);OI("0",BUFFER(31));MVI("-",BUFFER(33));OI("0",CARRCONT);R0:=@BUFFER;PRINT;MVC(130,BUFFER(1),BUFFER);MVC(12,BUFFER(3),"(FOUND_NEAR""");R2:=R2-R2;R0:=R2;R3:=OLDEDIT-1;if5thenbegin;R0:=@ASSIGNERROR;ERROR;;endelseifR0=1thenbegin;R0:=@ASSIGNERROR;ERROR;;endelseifR0=0thenbegin;R0:=@PPROCERROR;ERROR;;endelseifR0<=3thenbegin;ifR1>3thenbegin;R0:=@ASSIGNERROR;ERROR;;endelseSTC(R0,CONV(R9));;endelseifR1>5thenbegin;R0:=@ASSIGNERROR;ERROR;;endelseSTC(R0,CONV(R9));R0:=@ACOLONEQ;;endelseifR1=7thenbegin;R1:=V1(J+8);ifR1>R4thenbegin;R0:=@LENGTHERROR;ERROR;;endelseifR1=1024thenbegin;R0:=@CONSTANTERROR;ERROR;;endelsebegin;CINFO(R1):=R0;R0:=R0and#FF;R2:=LITPNT;ifR0=3orR0=5thenR2:=R2+7shrl3shll3elseifR0~=7thenR2:=R2+3shrl2shll2;R0:=R2-LITORG;CADDR(R1):=R0;R0:=R1;R1:=@LITERALTABLE(R2);EX(R5,MOVE14);R2:=@B2(R5+1);LITPNT:=R2;R5:=R0-CTORG;R0:=R0+4;CTPNT:=R0;;end;L:R0:=0;LM(R1,R3,R1SAVE);;end;procedureNULLSTATEMENT(R10);comment PLACE "NULLST" IN TREE AND EDITCODE;begin;R9:=@B9(4);R0:=@NULLST;STC(R0,OP(R9));R3:=EDITINDEX-1;EDITINDEX:=R3;R0:=@SPACECODE;STC(R0,B3(0));;end;procedureDECLARETEST(R10);comment FINDS NAMETABLE ENTRY FOR ID IN V1(I). INSERTS NAMETABLE INDEX IN V1(J), TYPES IN V2(J);begin;logicalRASAVE;array4logicalSAVEREGS;STM(R1,R4,SAVEREGS);R1:=V1(I);R2:=BLC;whileR2>=0dobegin;R4:=DISPLAY(R2);R3:=NPOINT(R4);R4:=BLENGTH(R4)+R3;whileR3=OPSthenIC(R0,RCTYPE(R10-OPS));ifR0>R3thenR3:=R0;whileR3=0dobegin;DECR(R1);IC(R3,S(R1-1));IC(R3,LCTYPE(R3));;end;;end;ifR3>=#10thenR4:=R3and#Felsebegin;R4:=R4-R4;R1:=R1shla3;caseR3ofbegin;IC(R4,V22(R1-8));IC(R4,V22(R1-16));begin;R1:=V34(R1-8);comment APAR HEAD;ifR1~=0thenIC(R4,SIMPLETYPE(R1));;end;begin;R1:=V1(R1-8);IC(R4,SIMPLETYPE(R1));;end;;end;;end;ifR10=LPARCODEorR4=0thenR4:=R4or#0300;;end;R10:=RASAVE;R3:=R3-R3;X:T0(J):=R2;V1(J):=R3;V2(J):=R4;LM(R1,R4,SAVEREGS);;end;procedureDECLAREID(R10);comment FINDS NAMETABLE ENTRY IN CURRENT BLOCK FOR ID IN V1(I). INSERTS NAMETABLE INDEX IN V1(J);begin;logicalRASAVE;R1:=V1(I);R2:=BLC;whileR2>=2dobegin;R4:=DISPLAY(R2);R3:=NPOINT(R4);R4:=BLENGTH(R4)+R3;whileR3=PLIMITthenbegin;R0:=@TABLEERROR;ERROR;gotoEXIT;;end;STC(R0,OP(R9));R1:=V5(R8)-OUTBASE;POINTER(R9):=R1;V5(R8):=R9;comment SAVE OUTPUT POINTER;;end;procedureCARDOUT(R10);begin;R9:=@B9(4);R0:=@CARD;STC(R0,OP(R9));V5(R8):=R9;R2:=SCOORD;POINTER(R9):=R2;;end;procedureEDITCOUNT(R4);comment STEP NODEINDEX, PLACE COUNT IN EDITCODE;begin;R1:=NODEINDEX+4;NODEINDEX:=R1;R3:=EDITINDEX-4;R1:=EDITBASE-R3;EDITINDEX:=R3;MVC(1,EDITCODE(R3),NODECHAIN(2));NODECHAIN:=R1;STC(R0,EDITCODE(R3+3));R1:=CHARTLEVEL;STC(R1,EDITCODE(R3+2));;end;procedureTREECOUNT(R4);comment PLACE UNARY COUNT OPERATOR IN TREE, SET V5(J);begin;R9:=@B9(4);R0:=@UCOUNT;R1:=NODEINDEX;STC(R0,OP(R9));POINTER(R9):=R1;V5(J):=R9;;end;procedureOUTCOUNT(R10);comment PLACE 'COUNT' IN EDITCODE AND TREE;begin;R0:=@COUNTCODE;EDITCOUNT;TREECOUNT;;end;procedureOUTRTAB(R10);comment PLACE 'COUNT & RTAB' IN EDITCODE AND TREE;begin;R1:=CHARTLEVEL+3;CHARTLEVEL:=R1;R0:=@RTAB;EDITCOUNT;TREECOUNT;;end;procedureOUTLTAB(R10);comment PLACE LTAB IN EDITCODE, COUNT IN TREE;begin;R1:=CHARTLEVEL-3;CHARTLEVEL:=R1;ifDEBUGthenbegin;R0:=@LTAB;EDITCOUNT;R0:=@UCOUNT;R1:=NODEINDEX;R9:=@B9(4);STC(R0,OP(R9));POINTER(R9):=R1;;endelsebegin;R3:=EDITINDEX-1;EDITINDEX:=R3;MVI(LTAB0,EDITCODE(R3));;end;;end;procedureOUTLTABX(R10);comment PLACE LTAB1 IN EDITCODE, COUNT IN TREE;begin;logicalSAVERA;SAVERA:=R10;OUTLTAB;ifDEBUGthenbegin;R3:=EDITINDEX;MVI(LTAB1,EDITCODE(R3+3));;end;R10:=SAVERA;;end;procedureBOOLVALUE(R10);comment VALUE IN R0, POINTER IN R1;begin;R9:=@B9(4);STC(R0,OP(R9));comment OUTPUT OPERATOR;POINTER(R9):=R1;R0:=6;V2(R8):=R0;comment SET VALUE STACK;R0:=0;V34(R8):=R0;V5(R8):=R9;;end;procedureREFBIND(R10);begin;integerRASAVE,R4SAVE,R5SAVE;shortintegerB5syn#5000;R3:=SIMTYPEINFO(R1);RASAVE:=R10;ifR3=0thenbegin;R0:=@REFRECERROR;ERROR;;endelsebegin;STM(R4,R5,R4SAVE);F01:=V(R8);R4:=0;R5:=REFRECBASE;R5:=@REFRECLIST(R3);R3:=B5;whileR3~=0dobegin;V1(R7):=R3;DECLARETEST;R3:=V1(R8);IC(R0,RCCLNUMBER(R3));R3:=R0shll1;R3:=BITTABLE(R3);R4:=R4orR3;R5:=R5+2;R3:=B5;;end;SIMTYPEINFO(R1):=R4;V(R8):=F01;LM(R4,R5,R4SAVE);;end;R10:=RASAVE;;end;procedureALIGNSIMPVAR(R10);comment ALIGNSIMPVAR ADJUSTS R4 TO THE APPROPRIATE HALF-WORD,WORD,OR DOUBLE-WORD BOUNDARY - AS DETERMINED BY THE SIMPLE TYPE IN R3. R3 IS NOT DESTROYED ;ifR3=3orR3=5thenR4:=R4+7and#FFFFFFF8elseifR3~=7andR3~=6thenR4:=R4+3and#FFFFFFFC;procedureMAXREG(R10);comment SETS REGISTER COUNTS TO MAXIMUM OF V(R8) AND V(8)(R8);begin;IC(R0,V3(R8+8));R1:=0;IC(R1,V3(R8));ifR1V1(I)thenSTC(R1,CONV(R9));;end;;end;procedureCASECOUNT(R10);comment COUNT CASES, SET CONV(R1) AND SIMPLE TYPE(R2), R0 = OP;begin;R3:=0;R4:=R9;R5:=0;whileR0~=CASEIDXXdobegin;R3:=R3+1;IC(R0,CONV(R4-4));ifR0~=R1thenSTC(R1,CONV(R4-4))elseSTC(R5,CONV(R4-4));R4:=POINTER(R4)-4+OUTBASE;IC(R0,OP(R4));ifR0=CARDDthenbegin;R4:=R4-4;IC(R0,OP(R4));;end;;end;STC(R2,CONV(R4));POINTER(R4):=R3;;end;procedureCASEJUMP(R10);comment FIXES EDITCODE JUMP FOR CONDITIONALS;ifDEBUGthenbegin;R3:=VX(J);R1:=EDITBASE-EDITINDEX;STC(R1,EDITCODE(R3+1));R1:=R1shrl8;STC(R1,EDITCODE(R3));;end;procedureOPENSEGMENT(R5);begin;R9:=@B9(12);comment TREE ORIGIN FOR NEW SEGMENT;comment STACK AND INCREMENT COMPILER VARIABLES;R1:=CTPNT;PSTACK(R9-8):=R1;R2:=LABELADDR;CONSTANTTABLE(R1):=R2;R1:=R1+4;CTORG:=R1;R4:=@CONSTANTTABLE(R1);MVC(11,B4,CONSTANTTABLE(4));R1:=R1+12;CTPNT:=R1;R1:=32;LABELADDR:=R1;R1:=LITPNT;PSTACK(R9-6):=R1;R3:=LITBASE;R1:=R1+7and#FFF8;LITORG:=R1;R2:=LITERALTABLE(0);LITERALTABLE(R1):=R2;R1:=R1+4;LITPNT:=R1;R2:=IHN;STC(R2,PSTACK(R9-4));R3:=SNC;STC(R3,PSTACK(R9-3));R2:=HN-1;HN:=R2;IHN:=R2;ifR2<5thenbegin;R0:=@HIERARCHYERROR;ERROR;;end;R3:=SN+1;SN:=R3;SNC:=R3;ifR3>=XSNthenbegin;R0:=@NPROCERROR;ERROR;;end;R1:=V1(J);STC(R2,HIERARCHY(R1));STC(R3,PROGSEG(R1));R4:=DRELAD;PSTACK(R9-2):=R4;R4:=DISPLAYORG;PSTACK(R9):=R4;comment TREE HEADER INFO;R0:=0;R1:=TYPEINFO(R1)shla2;if~=thenR1:=BLENGTH(R1)/12;R1:=R1shla3+DPDORG;DISPLAYORG:=R1;R4:=12-R2shla2+7and#FFF8+R1;DRELAD:=R4;R4:=OUTBASE;V34(J):=R4;OUTBASE:=R9;R0:=@PROCDC;OUTID;;end;segmentprocedureCLOSESEGMENT(R5);begin;procedureWRITETREE(R10);comment WRITES TREE, CONSTANT POINTER TABLE, AND CONSTANT TABLE;begin;array3logicalSAVE;integerTEMP;integerOPBASEsynSAVE(0);segmentbaseR2;array880byteOPTABL=("+-*/**L:=A:=","S:=R:=F:=STEPUNTIDIV_____REM<","<=>>==~=L:=2A:=2","S:=2R:=2AP)INDX____REFX","IFEXP,L,SHL_____SHR_____BB______END_____PCL","SUBSTRIN|AP,R,AR,AR)R)LOGOR","BITOR___LOGAND__BITAND__FORST___FORST2__FORLIST_FORCL___ENDFORLI","UJIFEXP_UJ______CL______IFST::IS______IFST2,","WHILEOP_WHILEST_IFJ_____U-ABS_____________________LOG~","BIT~ASSERT__EXIT____GOTO:STACKADD________CARD","CASE____COUNT___________BEGIN___________INUMBER_NUMBER__ID","LABELID_ARRAYID_FUNCID__RCCLID__FIELDID_CONID___FTN_____PROCDC","RCCLDC__CONTROL_BIT_____STRING__TRUE____FALSE___ITERN___NULL","NULLST__ARRAYDC_AR*STFUNCIDSTPROCIDIF");STM(R2,R4,SAVE);MVC(130,BUFFER(1),BUFFER);R3:=R3+R4;TEMP:=R3;R0:=@BUFFER;OI("0",CARRCONT);MVC(16,BUFFER(1),"PROGRAM_SEGMENT");MVC(5,BUFFER(18),MASK2);R3:=SNC;CVD(R3,DEC);ED(5,BUFFER(18),DEC(5));PRINT;MVC(36,BUFFER(1),"LOC__FLAG__OPCODE__CONV__POINTER");PRINT;MVC(130,BUFFER(1),BUFFER);MVC(3,BUFFER(4),"0000");R1:=@P(R4);UNPK(4,2,BUFFER(16),B1(0));TR(3,BUFFER(16),TRANSTABLE(_240));UNPK(4,2,BUFFER(34),B1(2));TR(3,BUFFER(34),TRANSTABLE(_240));MVI("",BUFFER(20));MVI("",BUFFER(38));PRINT;R1:=0;R3:=0;forR4:=R4+4step4untilTEMPdobegin;R3:=R3+4;HEX:=R3;UNPK(4,2,BUFFER(4),HEX(2));MVI("",BUFFER(8));TR(3,BUFFER(4),TRANSTABLE(_240));IC(R1,OP(R4));ifR1>#7Fthenbegin;R2:=1;R1:=R1and#7F;;endelseR2:=0;R2:=R2or#F0;STC(R2,BUFFER(13));R2:=R1shll3;R2:=R2+OPBASE;MVC(7,BUFFER(16),B2);MVI("",BUFFER(25));MVC(4,BUFFER(26),BUFFER(25));begin;IC(R1,CONV(R4));ifR1~=0thenbegin;CVD(R1,DEC);MVC(5,BUFFER(25),MASK);ED(5,BUFFER(25),DEC(5));;end;R2:=POINTER(R4);;end;HEX:=R2;UNPK(4,2,BUFFER(34),HEX(2));MVI("",BUFFER(38));TR(3,BUFFER(34),TRANSTABLE(_240));PRINT;R1:=0;;end;MVC(38,BUFFER(1),BUFFER);OI("0",CARRCONT);MVC(15,BUFFER(1),"LITERAL_ORIGIN-");UNPK(4,2,BUFFER(18),LABELADDR(2));TR(3,BUFFER(18),TRANSTABLE(_240));MVI("",BUFFER(22));PRINT;MVC(20,BUFFER(1),"LITERAL_POINTER_TABLE");PRINT;MVC(28,BUFFER(1),"LOC__LENGTH__TYPE__POINTER");PRINT;MVC(28,BUFFER(1),BUFFER);R4:=CTORG;R1:=0;R2:=R4+CTPNT-CTORG-4;TEMP:=R2;R3:=0;forR4:=R4step4untilTEMPdobegin;HEX:=R3;UNPK(4,2,BUFFER(3),HEX(2));MVI("",BUFFER(7));TR(3,BUFFER(3),TRANSTABLE(_240));R2:=CADDR(R4);HEX:=R2;UNPK(4,2,BUFFER(26),HEX(2));TR(3,BUFFER(26),TRANSTABLE(_240));MVI("",BUFFER(30));MVC(5,BUFFER(15),MASK2);IC(R1,CTYPE(R4));CVD(R1,DEC);ED(5,BUFFER(15),DEC(5));ifR1=7thenMVC(5,BUFFER(9),MASK2)elseMVC(5,BUFFER(9),MASK);IC(R1,CLENGTH(R4));CVD(R1,DEC);ED(5,BUFFER(9),DEC(5));PRINT;R1:=0;R3:=R3+4;;end;MVC(30,BUFFER(1),BUFFER);R0:=R0-R0;R14:=SAVE14;LM(R3,R4,SAVE(4));;end;procedureCHECKSPACE(R10);comment INPUT AS MOVETREE. CHECKS FOR SPACE, COMPACTS IF POSSIBLE;if~COMMONFLAGthenbegin;logicalSAVERA;SAVERA:=R10;R10:=@B2(R1+3)-EDITINDEX;if>thenbegin;comment R10 = ADDITIONAL SPACE REQUIRED;R10:=NEG_R10+INPOINT-INPOINTSAVE-LITPNT;ifEDITINDEXthenbegin;comment SPACE NOT AVAILABLE;SET(COMMONFLAG);R0:=@TABLEERROR;ERROR;;endelsebegin;array4logicalSAVE03;STM(R0,R3,SAVE03);R3:=INPOINTSAVE+LITPNT;R1:=INPOINT;R0:=R1-R3and#3;R3:=R3+R0;comment ALIGN DELTA;INPOINT:=R3;comment R1, R3 = SOURCE, DEST;R0:=R1-R3;R10:=R2-R1;comment R0,R10=DELTA,BYTE CNT;whileR10>256dobegin;MVC(255,B3,B1);R10:=R10-256;R1:=@B1(256);R3:=@B3(256);;end;ifR10>0thenbegin;R10:=R10-1;EX(R10,MOVE31);;end;R2:=R2-R0;R1:=TREEBASE-R0;TREEBASE:=R1;R1:=@TREELINK;comment ADJUST TREE POINTERS;whileR1>0dobegin;R3:=MEM(R1)-R0;MEM(R1):=R3;R1:=R3;;end;LM(R0,R1,SAVE03);R3:=SAVE03(12);;end;;end;R10:=SAVERA;;end;procedureMOVETREE(R10);comment HEADER WORD IN R1, R1(16:31) = BYTE COUNT, R2 = DESTINATION, R4 = SOURCE;begin;integerR1SAVE,R4SAVE,RASAVE;RASAVE:=R10;R1SAVE:=R1;R1:=R1and#FFFF;R4SAVE:=R4;CHECKSPACE;R10:=RASAVE;ifNOGOthenR2:=@B2(R1+4)elsebegin;R4:=R1SAVE;TREE(R2):=R4;R4:=R4SAVE;whileR1>256dobegin;MVC(255,B2(4),B4);R2:=@B2(256);R4:=@B4(256);R1:=R1-256;;end;ifR1~=0thenbegin;R1:=R1-1;EX(R1,TREEMOVE);R2:=@B2(R1+1);;end;R2:=@B2(4);comment SET TO NEXT FREE WORD;;end;;end;comment COMPLETE AND OUTPUT TREE;R2:=DRELAD;ifR2>=4096thenbegin;R0:=@DATAERROR;ERROR;;end;R1:=V1(J);R3:=IDLOC1(R1)and#F000orR2;IDLOC1(R1):=R3;R0:=@PCL;OUTOP;R4:=OUTBASE;R3:=R9-R4;R1:=TREELENGTH+R3+4;TREELENGTH:=R1;R9:=R4;POINTER(R9):=R3;IC(R0,TRACE);ifR0>5thenWRITETREE;R1:=8;R2:=TREEORG;CHECKSPACE;if~NOGOthenbegin;array2integerSAVE45;STM(R4,R5,SAVE45);R5:=TREELINK;B2(0):=R5;TREELINK:=R2;MVC(7,B2(4),"");R4:=V1(J);R4:=IDNO(R4)shll2;R3:=IDDIRBASE;R5:=IDLENGTH(R4);ifR5>7thenR5:=7;R4:=IDPOINT(R4);R3:=IDLISTBASE;R4:=@IDLIST(R4);EX(R5,TREEMOVE);LM(R4,R5,SAVE45);;end;R1:=P(R9);R2:=@B2(12);R4:=@P(R9+4);MOVETREE;R4:=CTORG-4;R1:=LABELADDR;R3:=CONSTANTTABLE(R4);CONSTANTTABLE(R4):=R1;LABELADDR:=R3;R1:=CTPNT-R4;CTPNT:=R4;R4:=@CONSTANTTABLE(R4);MOVETREE;R3:=LITBASE;R4:=LITORG;R1:=LITPNT-R4;R4:=@LITERALTABLE(R4);MOVETREE;R2:=R2+3and#FFFFFC;TREEORG:=R2;comment RESTORE COMPILER VARIABLES;R4:=PSTACK(R9);DISPLAYORG:=R4;R4:=PSTACK(R9-2);DRELAD:=R4;IC(R0,PSTACK(R9-3));SNC:=R0;R2:=HN+1;HN:=R2;IC(R0,PSTACK(R9-4));IHN:=R0;R1:=V34(J);OUTBASE:=R1;R2:=PSTACK(R9-6);LITPNT:=R2;R2:=PSTACK(R1-8)+4;CTORG:=R2;R2:=PSTACK(R1-6)+7and#FFF8;LITORG:=R2;comment CLEAR TREE AND STACK AREA;R0:=R0-R0;R1:=R0;R2:=R9-8;R3:=R9+POINTER(R9);P(R2):=R0;R2:=R2+7and#FFF8;R2:=@P(R2);R3:=@P(R3);whileR2<=R3dobegin;STM(R0,R1,B2);R2:=@B2(8);;end;R9:=R9-12;;end;segmentprocedureEXECUTE1(R6);begin;procedureBNDPR(R10);comment BNDPR CHECKS THAT BOTH BOUNDS ARE INTEGER, INCREASES THE DIMENSION COUNT, AND OUTPUTS COLON;begin;integerRASAVE;RASAVE:=R10;IC(R0,V22(R8+8));comment GET SIMPLE TYPE OF LOWER BOUND;IC(R1,V22(R8+24));comment GET SIMPLE TYPE OF UPPER BOUND;TYPEINTEGER;R9:=@B9(4);comment STEP OUTPUT POINTER;R0:=@COLON;STC(R0,OP(R9));R1:=V5(R8+8)-OUTBASE;POINTER(R9):=R1;IC(R0,V4(R8));R0:=R0+1;STC(R0,V4(R8));R10:=RASAVE;;end;procedurePROCEDOPEN(R5);comment STEPS BN, OPENS NEW PROGRAM SEGMENT, ALLOCATES SPACE FOR DPDS, ASSIGNS RELATIVE ADDRESSES TO FORMAL NAME PARAMETERS;begin;integerR5SAVE,TEMP;R5SAVE:=R5;DECLAREID;BLOCKSTEP;OPENSEGMENT;R4:=0;R1:=V1(J);R2:=TYPEINFO(R1)shla2;comment BN OF FPARS;if~=thenbegin;R1:=NPOINT(R2);R3:=BLENGTH(R2);R2:=R1+R3;TEMP:=R2;R2:=0;R3:=R3/3+LABELADDR;LABELADDR:=R3;R2:=DPDORG;R3:=0;R5:=HN;whileR1=BLCthenR2:=#FE;R2:=R2shll3;R1:=V1(J);ifR2>#F0thenR2:=#F0;IC(R0,HIERARCHY(R1));R2:=R2orR0;STC(R2,HIERARCHY(R1));R1:=BLC-2;BLC:=R1;CLOSESEGMENT;R3:=EDITINDEX-1;R1:=VA(J)and#2;if~=thenbegin;R3:=R3-2;MVI(VRSTOP,EDITCODE(R3+2));MVI(PV,EDITCODE(R3+1));;end;R1:=CHARTLEVEL-3;CHARTLEVEL:=R1;EDITINDEX:=R3;MVI(LTAB0,EDITCODE(R3));R5:=R5SAVE;;end;procedureEXTERNALESDINDEX(R5);comment V(I) -> SEGMENT NAME, R2 := EXTERNAL SEGMENT NUMBER;begin;MVC(130,BUFFER(1),BUFFER);R2:=V1(I)+CTORG;R1:=LITBASE+LITORG+CADDR(R2);IC(R2,CLENGTH(R2));R2:=R2and#FF;ifR2>7thenR2:=7;EX(R2,MOVE);R3:=@ESDICT(0);forR2:=255step_1untilXSNdobegin;CLC(7,B3,BUFFER(75));if=thengotoX;R3:=@B3(8);;end;R2:=XSN-1;ifR2<224thenbegin;R0:=@NPROCERROR;ERROR;R2:=224;R3:=@ESDICT(248);;end;XSN:=R2;MVC(7,B3,BUFFER(75));X:R1:=CTORG+12;CTPNT:=R1;R1:=LITORG+4;LITPNT:=R1;R1:=#FF;T0(J+8):=R1;;end;procedureNAMEP(R5);begin;DECLAREID;R0:=R0-R0;V34(J):=R0;;end;procedureVALUEP(R5);begin;DECLAREID;R1:=V1(R8);R3:=TYPES(R1);ifR3~=9thenbegin;R4:=DRELAD;ALIGNSIMPVAR;IDLOC2(R1):=R4;ifR3~=7thenIC(R3,LENGTHTABLE(R3))elseR3:=SIMTYPEINFO(R1)+1;R4:=R4+R3;DRELAD:=R4;;end;R0:=1;V34(R8):=R0;;end;procedureRELADDRESS(R5);ifR1~=0thencomment ROUTINE EXECUTED ONLY IF ID DEFINED;begin;R4:=HN;IDLOC1(R1):=R4;R4:=DRELAD;R3:=TYPES(R1);ifR3~=9thenbegin;R0:=R3;ALIGNSIMPVAR;IDLOC2(R1):=R4;ifR3~=7thenIC(R3,LENGTHTABLE(R3))elseR3:=SIMTYPEINFO(R1)+1;R3:=R3+R4;DRELAD:=R3;;end;;end;procedureFIELDDC(R5);begin;DECLAREID;R1:=V1(J);R3:=0;IC(R3,SIMPLETYPE(R1));ifR3=3orR3=5thenbegin;R4:=V34(J)+7and#FF8;IDLOC2(R1):=R4;IC(R3,LENGTHTABLE(R3));R4:=R4+R3;V34(J):=R4;;end;;end;caseR5ofbegin;comment ::= , ALSO RULE SELECTION ;begin;DECLARETEST;IC(R0,V21(J));ifR0~=0thenbegin;R0:=R0-1shla2;comment MTB POINTER INCREMENT;R3:=R3SAVE+R0;R3SAVE:=R3;SET(FLAG);;endelsebegin;R0:=@ID;OUTID;IC(R0,TYPE(R1));ifR0>#FthenR2:=#0A04elsebegin;R2:=#FF;T0(J):=R2;R2:=R2-R2;;end;V34(J):=R2;R1:=SIMTYPEINFO(R1);V1(J):=R1;;end;;end;comment