%ROUTINESPEC READ SYMBOL(%INTEGERNAME I) %INTEGERFNSPEC NEXT SYMBOL %ROUTINESPEC SKIP SYMBOL %ROUTINESPEC PRINT SYMBOL(%INTEGER I) %ROUTINESPEC READ(%INTEGERNAME I) %ROUTINESPEC WRITE(%INTEGER I,J) %ROUTINESPEC SPACE %ROUTINESPEC SPACES(%INTEGER I) %ROUTINESPEC NEWLINE %ROUTINESPEC NEWLINES(%INTEGER I) %ROUTINESPEC NEWPAGE %BEGIN %ROUTINESPEC READ PS %ROUTINESPEC READ LINE %INTEGERFNSPEC COMPARE %ROUTINESPEC SS %ROUTINESPEC FAULT(%INTEGER A,B,C,D) %INTEGERFNSPEC CHNEXT %INTEGERFNSPEC NEWCELL %INTEGERFNSPEC RETURN CELL(%INTEGER I) %ROUTINESPEC PRINT NAME(%INTEGER I) %INTEGER AP,APP,TP,PSP,ASL,BTN,CTN,CHP,FAULTS,LEVEL,CA,COMP,SCF %INTEGERARRAY PS(-1000:-600) ;! REDUCED PHRASE STRUCTURE %INTEGERARRAY TAG,LINK(0:1023) ;! TAGS LISTS %INTEGERARRAY A(1:200) ;! ANALYSIS RECORD %INTEGERARRAY T(1:300) ;! SOURCE TEXT %INTEGERARRAY BAT,COT(0:1023) ;! BRANCH, CONST TABLES %INTEGERARRAY CH(1:512) ;! NAME CHAR TABLE %INTEGERARRAY JUMP,STAR,BRT,NAME,RTP,BR,CHPP,START,RAD(0:15) ;! LEVEL INFORMATION %INTEGERARRAY TRUE,FALSE(1:6) ;! CONDITIONAL BRANCH INSTRUCTIONS %INTEGERARRAY PREC,UCN(1:12) ;! OPERATOR PRECEDENCES, TYPES %INTEGERARRAY OPR(0:12) ;! MACHINE OPERATIONS %INTEGERARRAY PT,PN,PTC(1:15) ;! FOR RT SPECS, HEADINGS READ PS ;! READ IN AND REDUCE PHRASE STRUCTURE ASL=0 ;! CLEAR HASHING AREA & 10: TAG(ASL)=0 ;! CREATE AVAILABLE SPACE LIST LINK(ASL)=0 ;! IN REMAINDER %IF ASL>=256 %AND ASL<1023 %THEN LINK(ASL)=ASL+1 ASL=ASL+1 %IF ASL<=1023 %THEN ->10 ASL=256 ;! AVAILABLE SPACE LIST POINTER BR(0)=M'BR0' ;! BASE REGISTER MNEMONICS BR(1)=M'BR1' BR(2)=M'BR2' BR(3)=M'BR3' BR(4)=M'BR4' BR(5)=M'BR5' BR(6)=M'BR6' BR(7)=M'BR7' BR(8)=M'BR8' BR(9)=M'BR9' BR(10)=M'BR10' BR(11)=M'BR11' BR(12)=M'BR12' BR(13)=M'BR13' BR(14)=M'BR14' BR(15)=M'BR15' TRUE(1)=M'BZ' ;! CONDITIONAL BRANCH MNEMONICS FALSE(1)=M'BNZ' TRUE(2)=M'BNZ' FALSE(2)=M'BZ' TRUE(3)=M'BNG' FALSE(3)=M'BG' TRUE(4)=M'BL' FALSE(4)=M'BNL' TRUE(5)=M'BNL' FALSE(5)=M'BL' TRUE(6)=M'BG' FALSE(6)=M'BNG' PREC(1)=3 ;! OPERATOR PRECEDENCES PREC(2)=3 ;! 4 : HIGHEST PREC(3)=2 ;! 1 : LOWEST PREC(4)=1 PREC(5)=1 PREC(6)=3 PREC(7)=2 PREC(8)=2 PREC(9)=1 PREC(10)=1 PREC(11)=1 PREC(12)=4 OPR(0)=M'LOAD' ;! MACHINE INSTRUCTION MNEMONICS OPR(1)=M'SHL' OPR(2)=M'SHR' OPR(3)=M'AND' OPR(4)=M'XOR' OPR(5)=M'OR' OPR(6)=M'EXP' OPR(7)=M'DIV' OPR(8)=M'MLT' OPR(9)=M'ADD' OPR(10)=M'SUB' OPR(11)=M'NEG' OPR(12)=M'NOT' UCN(1)=3 ;! OPERATOR TYPES UCN(2)=3 ;! 1 : UNARY UCN(3)=2 ;! 2 : BINARY COMMUTATIVE UCN(3)=2 ;! 3 : BINARY NON-COMMUTATIVE UCN(4)=2 UCN(5)=2 UCN(6)=3 UCN(7)=3 UCN(8)=2 UCN(9)=2 UCN(10)=3 UCN(11)=1 UCN(12)=1 BTN=0 ;! BRANCH TABLE POINTER CTN=0 ;! CONSTANT TABLE POINTER CHP=1 ;! NAME CHARACTER TABLE POINTER FAULTS=0 ;! FAULT COUNT LEVEL=0 ;! TEXTUAL LEVEL SCF=0 ;! CONDITION FLAG JUMP(0)=0 ;! JUMP LIST POINTER STAR(0)=0 ;! STORAGE ALLOCATION POSITION IN COT NAME(0)=0 ;! NAME LIST POINTER RTP(0)=-1 ;! ROUTINE TYPE CHPP(0)=0 ;! NAME CHARACTER TABLE POSITION START(0)=0 ;! START/FINISH LIST RAD(0)=10 ;! NEXT RELATIVE ADDRESS TO BE ALLOCATED CA=0 ;! CURRENT CODE DUMPING ADDRESS PRINT SYMBOL('P') PRINT SYMBOL('R') PRINT SYMBOL('G') PRINT SYMBOL(':') ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! 1: READ LINE TP=1 ;! TEXT POINTER 2: %IF T(TP)='!' %THEN ->3 ;! COMMENT - SKIP TO END PSP=-1000 ;! START OF IN PHRASE STRUCTURE TABLES AP=1 %IF COMPARE=1 %THEN %START ;! SUCCESSFUL ANALYSIS AP=1 ;! ANALYSIS RECORD POINTER SS ;! PROCESS SOURCE STATEMENT %IF T(TP-1)=';' %THEN ->2 ;! FURTHER STATEMENT ON THIS LINE ->1 ; %FINISH ;! GO TO READ NEXT LINE FAULT(M'SYNT',M'AX ?',M' ',M' ') ;! UNSUCCESSFUL ANALYSIS 5: %IF T(TP)=10 %THEN ->1 ;! NEWLINE - READ NEXT LINE %IF T(TP)=';' %THEN %START ;! END OF STATEMENT TP=TP+1 ;! TP TO START OF NEXT STATEMENT ->2 ; %FINISH ;! GO TO EXAMINE NEXT STATEMENT 3: TP=TP+1 ;! SKIP TO NEXT CHARACTER OF STATEMENT ->5 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE READ PS ! READ IN AND REDUCE PHRASE STRUCTURE %INTEGER PNP,ALT,P,I,J,K %INTEGERARRAY PN,PSP(256:300) ;! PHRASE NAME CHARS & POINTERS TO START OF PHRASES IN PS %ROUTINESPEC INSERT LIT %INTEGERFNSPEC GET PN PNP=256 ;! PN POINTER P=-1000 ;! PS POINTER 1: READ SYMBOL(I) %IF I='B' %THEN %START ;! BUILT-IN PHRASE 2: READ SYMBOL(I) ;! SKIP TO < %IF I\='<' %THEN ->2 J=GET PN ;! READ PHRASE NAME & GET POSITION IN PSP 3: READ SYMBOL(I) ;! SKIP TO = %IF I\='=' %THEN ->3 READ(K) ;! READ PHRASE NUMBER PSP(J)=K ;! FILL IN PHRASE NUMBER ->1 ; %FINISH ;! GO TO DEAL WITH NEXT PHRASE %IF I='P' %THEN %START ;! PHRASE 4: READ SYMBOL(I) ;! SKIP TO < %IF I\='<' %THEN ->4 PSP(GET PN)=P ;! READ PHRASE NAME & FILL IN PS POSITION 7: ALT=P ;! REMEMBER START POSITION IN PS OF THIS ALTERNATIVE 6: P=P+1 ;! NEXT PS POSITION 5: READ SYMBOL(I) ;! START OF NEXT ITEM IN THIS ALTERNATIVE %IF I='''' %THEN %START ;! LITERAL TEXT INSERT LIT ;! READ LITERAL & INSERT IN PS ->5 ; %FINISH ;! GO FOR NEXT ITEM %IF I='<' %THEN %START ;! ITEM IS A PHRASE NAME PS(P)=GET PN ;! READ PHRASE NAME & FILL IN PS WITH PSP POSITION ->6 ; %FINISH ;! GO FOR NEXT ITEM %IF I=',' %THEN %START ;! END OF THIS ALTERNATIVE PS(ALT)=P ;! FILL IN POINTER TO END OF ALTERNATIVE ->7 ; %FINISH ;! GO FOR START OF NEXT ALTERNATIVE %IF I=';' %THEN %START ;! END OF PHRASE DEFINITION PS(ALT)=P ;! FILL IN POINTER TO END OF ALTERNATIVE PS(P)=0 ;! FILL IN END OF PHRASE MARKER P=P+1 ;! NEXT PS POSITION FOR START OF NEXT PHRASE DEFINITION ->1 ; %FINISH ;! GO FOR NEXT PHRASE ->5 ; %FINISH ;! SKIP TO SOMETHING SIGNIFICANT %IF I='E' %THEN %START ;! END OF PHRASE STRUCTURE DEFINITIONS I=-1000 ;! REPLACE ALL POINTERS TO PSP WITH CORRECT PS POINTERS 8: %IF PS(I)>=256 %THEN PS(I)=PSP(PS(I)) I=I+1 %IF I\=P %THEN ->8 %RETURN ; %FINISH ->1 ;! SKIP TO SOMETHING SIGNIFICANT ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE INSERT LIT ! INSERT LITERAL TEXT INTO 'PS' %INTEGER SH,I SH=0 ;! % SHIFT VALUE TO 0 1: READ SYMBOL(I) %IF I='''' %THEN %START %IF NEXT SYMBOL\='''' %THEN %RETURN ;! END OF LITERAL READ SYMBOL(I) ;! QUOTE INSIDE LITERAL - IGNORE ONE %FINISH %IF I='%' %THEN SH=128 %ELSE %START ;! SHIFT VALUE TO 128 FOR % %IF I<'A' %OR I>'Z' %THEN SH=0 ;! END OF KEYWORD - SHIFT VALUE TO 0 PS(P)=I+SH ;! STORE SHIFTED (POSSIBLY) CHAR IN PS P=P+1 ;! MOVE TO NEXT POSITION IN PS %FINISH ->1 %END ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %INTEGERFN GET PN ! READ IN PHRASE NAME AND GET INDEX IN 'PSP' %INTEGER NP,S,I NP=0 ;! TO ACCUMULATE PHRASE NAME CHARS S=24 ;! INITIAL SHIFT VALUE TO PACK CHARS 1: READ SYMBOL(I) %IF I\='>' %THEN %START ;! NOT END OF NAME YET NP=NP!I<1 ; %FINISH %IF PNP\=256 %THEN %START ;! NOT FIRST PHRASE NAME I=256 ;! SCAN NAMES TO FIND IF ALREADY IN 2: %IF NP=PN(I) %THEN %RESULT=I I=I+1 %IF I\=PNP %THEN ->2 %FINISH PN(PNP)=NP ;! INSERT NEW NAME IN DICTIONARY PSP(PNP)=99999 ;! UNDEFINED PHRASE MARKER PNP=PNP+1 ;! MOVE TO NEXT DICTIONARY POSITION %RESULT=PNP-1 %END %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE READ LINE ! LEXICAL PHASE - READ & CLEAN UP NEXT LINE OF TEXT %ROUTINESPEC STORE(%INTEGER I) %INTEGER SH,I NEWLINES(2) PRINT SYMBOL(';') SH=0 ;! % & LITERAL SHIFT VALUE TO 0 TP=1 ;! POINTER TO TEXT ARRAY T 1: READ SYMBOL(I) %IF I=10 %AND TP=1 %THEN ->1 PRINT SYMBOL(I) %IF I='''' %THEN %START SH=128 ;! SHIFT VALUE FOR LITERAL 2: STORE(I) ;! STORE SHIFTED CHAR IN TEXT ARRAY READ SYMBOL(I) PRINT SYMBOL(I) %IF I=10 %THEN PRINT SYMBOL(';') %IF I\='''' %THEN ->2 ;! NOT END OF LITERAL YET READ SYMBOL(I) PRINT SYMBOL(I) %IF I='''' %THEN ->2 ;! QUOTE IN LITERAL - IGNORE ONE SH=0 ;! SHIFT VALUE TO 0 FOR END OF LITERAL STORE('''') ;! STORE UNSHIFTED VALUE TO MARK END %FINISH %IF I='%' %THEN SH=128 %ELSE %START ;! SHIFT VALUE TO 128 FOR KEYWORD %IF I<'A' %OR I>'Z' %THEN SH=0 ;! SHIFT VALUE TO 0 FOR END OF KEYWORD %IF I\=' ' %THEN %START ;! IGNORE SPACES STORE(I) %IF I=10 %THEN %START ;! NEWLINE CHAR %IF T(TP-2)='C'+128 %THEN %START TP=TP-2 PRINT SYMBOL(';') %FINISH %ELSE %RETURN %FINISH %FINISH %FINISH ->1 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE STORE(%INTEGER I) ! STORE (POSSIBLY) SHIFTED CHARACTER IN TEXT ARRAY & CHECK LINE NOT TOO LONG %IF TP>300 %THEN %START FAULT(M'STAT',M'MNT ',M'TOO ',M'LONG') TP=1 %FINISH T(TP)=I+SH ;! STORE CHAR IN TEXT ARRAY TP=TP+1 ;! MOVE TO NEXT POSITION %END %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN COMPARE ! ANALYSE PHRASE %INTEGERFNSPEC NAME ;! BUILT-IN PHRASE NAME %INTEGERFNSPEC CNST ;! BUILT-IN PHRASE %INTEGER APP,TPP,PSPP,AE,N TPP=TP ;! PRESERVE INITIAL TEXT POINTER APP=AP ;! PRESERVE INITIAL ANALYSIS RECORD A(AP)=1 ;! ALTERNATIVE 1 FIRST 11: AE=PS(PSP) ;! POINTER TO END OF ALTERNATIVE PSP=PSP+1 ;! FIRST ITEM OF ALTERNATIVE DEFN 12: %IF PSP=AE %THEN %RESULT=1 ;! END OF ALT REACHED - SUCCESS N=PS(PSP) ;! NEXT ITEM OF ALT DEFN PSP=PSP+1 ;! FOR FOLLOWING ITEM %IF N<0 %THEN %START ;! SUB-PHRASE PSPP=PSP ;! PRESERVE PS POINTER PSP=N ;! POINTER TO DEFN OF SUB-PHRASE AP=AP+1 ;! NEXT ANALYSIS RECORD POSITION N=COMPARE ;! RECURSIVE COMPARISON FOR SUB-PHRASE PSP=PSPP ;! RESTORE PS POINTER %IF N=1 %THEN ->12 ;! SUCCESSFUL COMPARISON - GO FOR NEXT ITEM ->13 ; %FINISH ;! UNSUCCESSFUL - GO FOR NEXT ALTERNATIVE %IF N=1 %THEN %START ;! BUILT-IN PHRASE %IF NAME=1 %THEN ->12 ;! SUCCESS ->13 ; %FINISH ;! FAILURE %IF N=2 %THEN %START ;! BUILT-IN PHRASE CNST %IF CNST=1 %THEN ->12 ;! SUCCESS ->13 ; %FINISH ;! FAILURE %IF N=T(TP) %THEN %START ;! LITERAL - MATCHES SOURCE CHAR TP=TP+1 ;! MOVE TO NEXT SOURCE CHAR ->12 ; %FINISH ;! GO FOR NEXT ITEM 13: %IF PS(AE)=0 %THEN %RESULT=0 ;! END OF PHRASE PSP=AE ;! START OF DEFN OF NEXT ALTERNATIVE TP=TPP ;! BACKTRACK SOURCE TEXT AP=APP ;! AND ANALYSIS RECORD POINTERS A(AP)=A(AP)+1 ;! COUNT ALTERNATIVE NUMBER ON ONE ->11 ;! GO TO ANALYSE NEW ALTERNATIVE ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %INTEGERFN NAME ! RECOGNISE AND INSERT NAME IN HASHING AREA OF TAG/LINK ARRAYS %INTEGER I,J,K,L,M,N I=T(TP) ;! FIRST SOURCE CHAR %IF I<'A' %OR I>'Z' %OR (I='M' %AND T(TP+1)=''''+128) %THENRESULT=0 ;! FAILURE - NOT A LETTER OR AN M-TYPE CONSTANT J=CHP ;! NEXT POSITION IN CHARACTER ARRAY K=I<<16 ;! LEAVE HOLE FOR LENGTH & PACK FIRST CHAR L=1 ;! NO OF CHARS M=8 ;! NEXT SHIFT VALUE FOR PACKING N=I ;! SUM VALUE OF CHARS FOR HASHING 1: TP=TP+1 I=T(TP) ;! NEXT CHAR FROM TEXT ARRAY %IF ('0'<=I %AND I<='9') %OR ('A'<=I %AND I<='Z') %THEN %START ;! A DIGIT OR A LETTER K=K!I<1 ; %FINISH ;! GO FOR NEXT CHAR %IF K\=0 %THEN CH(CH NEXT)=K ;! STORE ANY REMAINING CHARS IN CHAR ARRAY CH(J)=CH(J)!L<<24 ;! FILL IN LENGTH IN HOLE LEFT IN FIRST WORD I=(N&15)<<4!N>>4&15 ;! HASH VALUE K=I ;! SCAN DICTIONARY FOR NAME 2: %IF TAG(K)\=0 %THEN %START ;! A NAME IN THIS POSITION L=TAG(K) ;! CHAR ARRAY POSITION M=J ;! CHAR ARRAY POSITION OF NEW NAME 4: %IF CH(L)=CH(M) %THEN %START ;! PACKED WORDS MATCH M=M+1 ;! NEXT WORD OF NEW NAME %IF M=CHP %THEN %START ;! NAMES MATCH CHP=J ;! MOVE CHP BACK SINCE NAME ALREADY IN ->3 ; %FINISH L=L+1 ;! NEXT WORD OF OLD NAME ->4 ; %FINISH ;! GO FOR NEXT WORD K=(K+1)&255 ;! NO MATCH SO TRY NEXT DICTIONARY POSITION %IF K=I %THEN %START ;! STARTING POSITION REACHED AGAIN FAULT(M'DICT',M'IONA',M'RY F',M'ULL ') %STOP ; %FINISH ->2 ; %FINISH TAG(K)=J ;! STORE CHAR ARRAY POSITION OF NAME 3: AP=AP+1 ;! NEXT ANALYSIS RECORD POSITION A(AP)=K ;! STORE IDENTIFICATION NO OF NAME %RESULT=1 ;! SUCCESS %END ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %INTEGERFN CNST ! RECOGNISE INTEGER AND LITERAL TEXT CONSTANTS %INTEGER I,J,K I=T(TP) ;! FIRST CHAR %IF I='M' %AND T(TP+1)=''''+128 %THEN %START ;! M-TYPE CONSTANT TP=TP+1 ;! IGNORE THE M I=T(TP) %FINISH %IF I=''''+128 %THEN %START ;! START OF A LITERAL J=0 ;! TO ACCUMULATE LITERAL VALUE K=0 ;! CHARACTER COUNT 1: TP=TP+1 I=T(TP) ;! NEXT CHAR %IF I\='''' %THEN %START ;! NOT END OF LITERAL J=J<<8!I&127 ;! PACK CHAR K=K+1 ;! COUNT CHAR ->1 ; %FINISH TP=TP+1 ;! POINTER AFTER QUOTE %IF K>4 %THEN FAULT(M'STRI',M'NG T',M'OO L',M'ONG ') ->2 ; %FINISH %IF I<'0' %OR I>'9' %THEN %RESULT=0 ;! NOT A CONSTANT J=0 3: J=10*J+I-'0' ;! ACCUMULATE DECIMAL VALUE TP=TP+1 I=T(TP) ;! NEXT CHAR %IF '0'<=I %AND I<='9' %THEN ->3 ;! A DIGIT - STILL PART OF CONSTANT 2: AP=AP+1 ;! NEXT ANALYSIS RECORD POSITION A(AP)=J ;! FILL IN VALUE OF CONSTANT %RESULT=1 ;! SUCCESS %END %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE SS ! COMPILE SOURCE STATEMENT %ROUTINESPEC UI %ROUTINESPEC SCCOND(%INTEGERNAME LABEL) %ROUTINESPEC SEXPR %INTEGERFNSPEC FIND LABEL %ROUTINESPEC CHECK %ROUTINESPEC UNSET %ROUTINESPEC PUSH START(%INTEGER FLAG,LABEL) %INTEGERFNSPEC BT NEXT %INTEGERFNSPEC CT NEXT %INTEGERFNSPEC WS NEXT %ROUTINESPEC STORE TAG(%INTEGER NAME,FORM,TYPE,DIM,LEV,AD) %ROUTINESPEC DUMP(%INTEGER OP,REG,BASE,DISP) %ROUTINESPEC SKIP SEXPR %ROUTINESPEC SKIP APP %ROUTINESPEC RT %ROUTINESPEC ARRAD %ROUTINESPEC ENTER(%INTEGER TYPE,ALLOC) %ROUTINESPEC RETURN %INTEGER I,J,K,L,M,N,P,Q,R,WS,LABEL I=A(AP) ;! ANALYSIS RECORD ENTRY AP=AP+1 ;! FOR FOLLOWING ENTRY WS=2 ;! SET WORKSPACE POINTER %IF I=1 %THEN ->10 ;! UNCONDITIONAL INSTRUCTION %IF I=2 %THEN ->20 ;! CONDITIONAL STATEMENT %IF I=3 %THEN ->30 ;! LABEL %IF I=4 %THEN ->40 ;! %FINISH %IF I=5 %THEN ->50 ;! DECLARATIONS %IF I=6 %THEN ->60 ;! ROUTINE/FN SPEC %IF I=7 %THEN ->70 ;! %END %IF I=8 %THEN ->80 ;! %BEGIN %IF I=9 %THEN ->90 ;! %ENDOFPROGRAM %RETURN ;! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! UI 10: UI ;! COMPILE UNCONDITIONAL INSTRUCTION %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %IF . . . %THEN . . . %ELSE 20: SCCOND(I) ;! COMPILE CONDITION %IF A(AP)=2 %THEN %START ;! AP ON - JUMP INSTRUCTION AP=AP+2 ;! AP ON J=-1 ;! MARKER FOR 'JUMP' %FINISH %ELSE %START ;! NOT A JUMP %IF A(AP)=3 %THEN %START ;! %START %IF A(AP+1)=1 %THEN FAULT(M'%STA',M'RT %',M'ELSE',M' ? ') PUSH START(0,I) %RETURN ; %FINISH UI ;! COMPILE REMAINING UNCOND. INSTNS. J=0 ;! 'NOT JUMP' MARKER %FINISH %IF A(AP)=1 %THEN %START ;! -CLAUSE PRESENT %IF J=0 %THEN %START ;! WAS NOT A JUMP J=BT NEXT ;! JUMP ROUND -CLAUSE DUMP('B',0,M'BT',J) %FINISH %IF I>=0 %THEN BAT(I)=CA ;! FILL IN LABEL ON -CLAUSE AP=AP+1 ;! AP ON %IF A(AP)=3 %THEN %START ;! %START PUSH START(1,J) %RETURN ; %FINISH UI ;! COMPILE REMAINING S I=J ;! JUMP AROUND LABEL %FINISH %IF I>=0 %THEN BAT(I)=CA ;! TO BRANCH ROUND THE UI %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! CONST: . . . 30: I=FIND LABEL ;! LOCATE/INSERT LABEL IN JUMP LIST %IF I>=0 %THEN %START ;! VALID LABEL %IF BAT(I)>=0 %THEN %START WRITE(LABEL,1) SPACES(2) FAULT(M'LABE',M'L SE',M'T TW',M'ICE ') %FINISH BAT(I)=CA ;! FILL IN LABEL ADDRESS %FINISH SS ;! COMPILE STATEMENT AFTER LABEL %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %FINISH . . . 40: I=START(LEVEL) ;! LINK TO FIRST CELL IN START LIST %IF I=0 %THEN %START ;! NO CELLS IN LIST FAULT(M'SPUR',M'IOUS',M' %FI',M'NISH') %RETURN ; %FINISH J=TAG(I)&65535 ;! JUMP AROUND LABEL K=TAG(I)>>16 ;! BEFORE OR AFTER %ELSE MARKER START(LEVEL)=RETURN CELL(I) ;! POP UP CELL %IF A(AP)=1 %THEN %START ;! %ELSE PRESENT %IF K=1 %THEN FAULT(M'TWO ',M'%ELS',M'ES !',M' ') K=BT NEXT ;! JUMP AROUND DUMP('B',0,M'BT',K) %IF J\=65535 %THEN BAT(J)=CA ;! FILL IN LABEL ON IF NECESSARY AP=AP+1 ;! AP ON %IF A(AP)=3 %THEN %START ;! %START PUSH START(1,K) %RETURN ; %FINISH UI ;! COMPILE REMAINING S J=K ;! JUMP AROUND LABEL %FINISH %IF J\=65535 %THEN BAT(J)=CA ;! FILL IN JUMP AROUND LABEL IF NECESSARY %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! DECLARATIONS 50: %IF A(AP)=1 %THEN %START ;! = %ARRAY APP=AP ;! SAVE AP 51: AP=AP+2 ;! AP ON %IF A(AP)=1 %THEN ->51 ;! SKIP DOWN TO END OF LIST OF NAMES AP=AP+1 ;! AP ON <+-\> SEXPR ;! COMPILE EXPRESSION - LOWER BOUND DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! STORE VALUE IN WORKSPACE SEXPR ;! COMPILE EXPRESSION - UPPER BOUND DUMP(M'LDA',M'ACC',M'ACC',1) ;! INCREMENT VALUE BY 1 %IF A(AP)=1 %THEN %START ;! 2-DIM ARRAYS DUMP(M'SUB',M'ACC',BR(LEVEL),WS-1) ;! PERFORM 2-DIM ARRAY DECLARATION CALCULATIONS DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) AP=AP+1 SEXPR ;! LOWER BOUND EXPR FOR 2ND DIM DUMP(M'MLT',M'ACC',BR(LEVEL),WS-1) DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) SEXPR ;! UPPER BOUND EXPR FOR 2ND DIM DUMP(M'LDA',M'ACC',M'ACC',1) DUMP(M'MLT',M'ACC',BR(LEVEL),WS-2) DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) WS=WS-4 ;! RESTORE WORKSPACE POINTER I=2 ;! NO OF DIMS %FINISH %ELSE %START ;! 1-DIM ARRAYS DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) WS=WS-2 ;! RESTORE WORKSPACE POINTER I=1 ;! NO OF DIMS %FINISH J=2 ;! TAG FOR 'ARRAY' AP=APP ;! RESTORE AP TO BEFORE LIST OF NAMES %FINISH %ELSE %START ;! SCALAR DECLARATIONS I=0 ;! DIMS=0 FOR SCALARS J=0 ;! TAG FOR SCALAR %FINISH 52: STORE TAG(A(AP+1),J,1,I,LEVEL,RAD(LEVEL)) ;! PUSHDOWN TAG FOR THIS NAME %IF I=0 %THEN RAD(LEVEL)=RAD(LEVEL)+1 %ELSE %START;! ONE RELATIVE LOCATION FOR SCALARS %IF I=1 %THEN %START ;! 1-DIM ARRAYS DUMP(M'SUB',M'STP',BR(LEVEL),WS) DUMP(M'STR',M'STP',BR(LEVEL),RAD(LEVEL)) DUMP(M'ADD',M'STP',BR(LEVEL),WS+1) %FINISH %ELSE %START ;! 2-DIM ARRAYS DUMP(M'LOAD',M'ACC',BR(LEVEL),WS+1) DUMP(M'STR',M'ACC',BR(LEVEL),RAD(LEVEL)) DUMP(M'SUB',M'STP',BR(LEVEL),WS+2) DUMP(M'LDA',M'ACC',M'STP',0) DUMP(M'SUB',M'ACC',BR(LEVEL),WS) DUMP(M'STR',M'ACC',BR(LEVEL),RAD(LEVEL)+1) DUMP(M'ADD',M'STP',BR(LEVEL),WS+3) %FINISH RAD(LEVEL)=RAD(LEVEL)+2 ;! 2 RELATIVE LOCATIONS FOR ARRAYS %FINISH AP=AP+2 ;! AP ON %IF A(AP)=1 %THEN ->52 ;! MORE NAMES IN LIST OF NAMES %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! RT SPEC? . . . 60: I=A(AP)-1 ;! ROUTINE/FN J=A(AP+1) ;! SPEC ? K=A(AP+2) ;! NAME OF ROUTIINE OR FN AP=AP+3 ;! AP ON L=0 ;! PARAMETER COUNT M=10 ;! FIRST RELATIVE ADDRESS TO BE ALLOCATED 63: %IF A(AP)=1 %THEN %START ;! PARAMETERS PRESENT AP=AP+1 ;! AP ON %IF A(AP)=1 %THEN N=3 %ELSE N=3-A(AP) ;! SET TAG FOR PARAMETER FORM P=N<<28!1<<24!(LEVEL+1)<<16 ;! SET UP PATTERN FOR WHOLE TAG 62: L=L+1 ;! PARAMETER COUNT %IF L>15 %THEN %START FAULT(M'TOO ',M'MANY',M' PAR',M'AMS ') ->61 ; %FINISH ;! IGNORE SUPERFLUOUS PARAMS PT(L)=P!M ;! STORE TAG FOR THIS PARAM PN(L)=A(AP+1) ;! STORE THE NAMES IDENT. NO %IF N=3 %THEN M=M+2 %ELSE M=M+1 ;! NEXT RELATIVE ADDRESS AP=AP+2 ;! AP ON %IF A(AP)=1 %THEN ->62 ;! MORE NAMES IN LIST AP=AP+1 ;! AP ON ->63 ; %FINISH 61: N=LINK(K) ;! LINK TO TAG FOR NAME OF ROUTINE OR FN %IF N=0 %OR TAG(N)>>16&150 %THEN %START ;! PARAMETERS PRESENT P=1 ;! PARAMETER COUNT Q=K ;! 'INSERT AFTER' POINTER 64: R=NEWCELL ;! PUSHDOWN TAG FOR PARAMETER TAG(R)=PT(P) LINK(R)=LINK(Q) PTC(P)=R ;! SAVE POINTER TO TAG CELL LINK(Q)=R Q=R ;! NEW VALUE FOR 'INSERT AFTER' POINTER P=P+1 ;! PARAMETER COUNT %IF P<=L %THEN ->64 ;! MORE PARAMETERS YET %FINISH STORE TAG(K,4,I,L,LEVEL,BT NEXT) ;! PUSHDOWN TAG FOR NAME OF ROUTINE OR FN %IF LEVEL=0 %THEN BAT(BTN-1)=K+65536 ;! FLAG FOR EXTERNAL SPECS %FINISH %ELSE %START ;! NAME ALREADY SET AT THIS LEVEL %IF J=2 %AND TAG(N)>>28=4 %THEN %START ;! STATEMENT NOT A SPEC & FORM OF NAME IS RT %IF TAG(N)>>24&15\=I %THEN %START PRINT NAME(K) FAULT(M'RT N',M'OT A',M'S SP',M'EC ') %FINISH %IF BAT(TAG(N)&65535)>=0 %THEN %START PRINT NAME(K) FAULT(M'RT A',M'PPEA',M'RS T',M'WICE') %FINISH P=TAG(N)>>20&15 ;! NO OF PARAMS IN SPEC %IF L\=P %THEN %START FAULT(M'PARS',M' NOT',M' AS ',M'SPEC') %IF L>P %THEN L=P ;! IGNORE SUPERFLUOUS PARAMS %FINISH %IF L>0 %THEN %START ;! PARAMS PRESENT P=1 ;! PARAM COUNT Q=LINK(N) ;! LINK TO TAG OF FIRST PARAM 67: %IF PT(P)!TAG(Q)&15<<20\=TAG(Q) %THEN %START PRINT NAME(PN(P)) FAULT(M'PAR ',M'NOT ',M'AS S',M'PEC ') %FINISH PTC(P)=Q ;! SAVE POINTER TO TAG CELL P=P+1 ;! PARAM COUNT Q=LINK(Q) ;! NEXT TAG CELL %IF P<=L %THEN ->67 ;! MORE PARAMS %FINISH %FINISH %ELSE %START PRINT NAME(K) FAULT(M'NAME',M' SET',M' TWI',M'CE ') %FINISH %FINISH 68: %IF J=2 %THEN %START ;! STATEMENT NOT A SPEC BRT(LEVEL)=BT NEXT ;! BRANCH ROUND ROUTINE OR FN DUMP('B',0,M'BT',BRT(LEVEL)) BAT(TAG(LINK(K))&65535)=CA ;! FILL IN ADDRESS OF THIS ROUTINE OR FN %IF LEVEL=15 %THEN FAULT(M'TOO ',M'MANY',M' LEV',M'ELS ') %C %ELSE LEVEL=LEVEL+1 ;! NEXT TEXTUAL LEVEL ENTER(I,M) %IF L>0 %THEN %START ;! PARAMS PRESENT P=1 ;! PARAM COUNT 69: I=PT(P) ;! PUSHDOWN TAGS FOR PARAMS %IF I>>28=3 %THEN STORE TAG(PN(P),3,1,0,LEVEL,PTC(P)) %C %ELSE STORE TAG(PN(P),I>>28,1,0,LEVEL,I&65535) ;! TREAT ARRAYNAMES SPECIALLY P=P+1 %IF P<=L %THEN ->69 ;! MORE PARAMS YET %FINISH %FINISH %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %END 70: CHECK ;! CHECK LABELS & START/FINISH BLOCKS COT(STAR(LEVEL))=RAD(LEVEL) ;! STORE STATIC ALLOCATION FOR THIS LEVEL UNSET ;! UNSET NAMES DECLARED AT THIS LEVEL CHP=CHPP(LEVEL) %IF RTP(LEVEL)\=0 %THEN DUMP(M'STOP',0,0,0) ;! %STOP FOR FNS RETURN ;! DUMP %RETURN CODE LEVEL=LEVEL-1 ;! DECREMENT TEXTUAL LEVEL COUNT %IF LEVEL<1 %THEN %START ;! NOT BACK AT OUTER LEVEL YET FAULT(M'EXCE',M'SS %',M'END ',M' ') ->71 ; %FINISH ;! TREAT AS %ENDOFPROGRAM BAT(BRT(LEVEL))=CA ;! FILL ADDR FOR BRANCH ROUND ROUTINE/FN %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %BEGIN 80: %IF LEVEL\=0 %THEN %START FAULT(M'%BEG',M'IN E',M'XTRA',M' ') ;! NO INTERNAL BLOCKS ALLOWED %RETURN ; %FINISH %IF CA\=0 %OR RAD(0)\=10 %THEN %START FAULT(M'%BEG',M'IN N',M'OT F',M'IRST') %RETURN ; %FINISH LEVEL=1 ;! TEXTUAL LEVEL COUNT TO 1 ENTER(-1,10) %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ENDOFPROGRAM 90: CHECK ;! CHECK LABELS & START/FINISHES COT(STAR(LEVEL))=RAD(LEVEL) ;! FILL IN STATIC ALLOCATION FOR OUTER BLOCK UNSET ;! UNSET NAMES DECLARED AT THIS LEVEL %IF LEVEL\=1 %THEN FAULT(M'TOO ',M'FEW ',M'%END',M'S ') 71: DUMP(M'STOP',0,0,0) ;! %STOP PRINT SYMBOL('B') ;! PRINT OUT BRANCH TABLE PRINT SYMBOL('T') PRINT SYMBOL(':') NEWLINE CA=0 93: %IF CA\=BTN %THEN %START DUMP('B',0,M'PRG',BAT(CA)) ;! BRANCH RELATIVE TO START OF PROGRAM ->93 ; %FINISH PRINT SYMBOL('C') ;! PRINT OUT CONSTANT TABLE PRINT SYMBOL('T') PRINT SYMBOL(':') NEWLINE I=0 91: %IF I\=CTN %THEN %START WRITE(COT(I),10) NEWLINE I=I+1 ->91 ; %FINISH PRINT SYMBOL(';') WRITE(FAULTS,1) ;! NUMBER OF PROGRAM FAULTS FAULT(M' FAU',M'LTS ',M'IN P',M'ROGM') %STOP !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE UI ! COMPILE UNCONDITIONAL INSTRUCTION %INTEGER I,J,K,L I=A(AP) ;! NEXT ANALYSIS RECORD ENTRY AP=AP+1 %IF I=1 %THEN ->10 ;! ROUTINE CALL OR ASSIGNMENT STATEMENT %IF I=2 %THEN ->20 ;! JUMP INSTRUCTION %IF I=3 %THEN ->30 ;! %START %IF I=4 %THEN ->40 ;! %RETURN %IF I=5 %THEN ->50 ;! %RESULT= DUMP(M'STOP',0,0,0) ;! %STOP %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! NAME APP ASS 10: I=LINK(A(AP)) ;! POINTER TO NAME TAGS %IF I=0 %THEN %START PRINT NAME(A(AP)) FAULT(M'NAME',M' NOT',M' SET',0) %FINISH %ELSE I=TAG(I) ;! NAME TAGS OR ZERO TO AVOID DIAGNOSTICS J=AP ;! PRESERVE ANALYSIS RECORD POINTER AP=AP+1 ;! AP ON SKIP APP ;! SKIP TO %IF A(AP)=2 %THEN %START ;! ROUTINE CALL %IF I>>24=64 %THEN %START ;! 'FORM/TYPE' IS ROUTINE AP=J ;! RESTORE AP TO RT ;! CALL ROUTINE %FINISH %ELSE %START %IF I\=0 %THEN %START PRINT NAME(A(J)) FAULT(M'NOT ',M'ROUT',M'INE ',M'NAME') %FINISH %FINISH AP=AP+1 ;! AP AFTER %RETURN ; %FINISH K=I>>28 ;! 'FORM' OF NAME %IF K=4 %THEN %START PRINT NAME(A(J)) FAULT(M'NAME',M' NOT',M' A D',M'ESTN') ;! ROUTINE/FN FORM I=0 ;! CLEAR TAGS TO AVOID FURTHER DIAGNOSTIC %FINISH AP=AP+1 ;! AP ON <+-\> SEXPR %IF I=0 %THEN %RETURN ;! LHS NAME NOT SET %IF K>=2 %THEN %START ;! LHS AN ARRAY TYPE DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! PRESERVE ACCUMMULATOR K=AP ;! PRESERVE AP AP=J ;! RESTORE INITIALANAL REC POINTER ARRAD ;! CALCULATE ARRAY ELEMENT ADDRESS WS=WS-1 ;! RESTORE WORKSPACE POINTER DUMP(M'LOAD',M'WK',BR(LEVEL),WS) ;! RESTORE ACCUMMULATOR DUMP(M'STR',M'WK',M'ACC',0) ;! DUMP ASSIGNMENT AP=K ;! RESTORE AP TO AFTER %RETURN ; %FINISH %IF K=1 %THEN %START DUMP(M'LOAD',M'WK',BR(I>>16&15),I&65535);! INDIRECT ASSIGMENT DUMP(M'STR',M'ACC',M'WK',0) %FINISH %ELSE DUMP(M'STR',M'ACC',BR(I>>16&15),I&65535) %IF A(J+1)=1 %THEN %START PRINT NAME(A(J)) FAULT(M'SCAL',M'AR H',M'AS P',M'ARAM') %FINISH %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! -> CONST PRINT SYMBOL('B') ;! PRINT OUT BRANCH TABLE PRINT SYMBOL('T') PRINT SYMBOL(':') NEWLINE CA=0 93: %IF CA\=BTN %THEN %START DUMP('B',0,M'PRG',BAT(CA)) ;! BRANCH RELATIVE TO START OF PROGRAM ->93 ; %FINISH PRINT SYMBOL('C') ;! PRINT OUT CONSTANT TABLE PRINT SYMBOL('T') PRINT SYMBOL(':') NEWLINE I=0 91: %IF I\=CTN %THEN %START WRITE(COT(I),10) NEWLINE I=I+1 ->91 ; %FINISH PRINT SYMBOL(';') WRITE(FAULTS,1) ;! NUMBER OF PROGRAM FAULTS FAULT(M' FAU',M'LTS ',M'IN P',M'ROGM') %STOP !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE UI ! COMPILE UNCONDITIONAL INSTRUCTION %INTEGER I,J,K,L I=A(AP) ;! NEXT ANALYSIS RECORD ENTRY AP=AP+1 %IF I=1 %THEN ->10 ;! ROUTINE CALL OR ASSIGNMENT STATEMENT %IF I=2 %THEN ->20 ;! JUMP INSTRUCTION %IF I=3 %THEN ->30 ;! %START %IF I=4 %THEN ->40 ;! %RETURN %IF I=5 %THEN ->50 ;! %RESULT= DUMP(M'STOP',0,0,0) ;! %STOP %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! NAME APP ASS 10: I=LINK(A(AP)) ;! POINTER TO NAME TAGS %IF I=0 %THEN %START PRINT NAME(A(AP)) FAULT(M'NAME',M' NOT',M' SET',0) %FINISH %ELSE I=TAG(I) ;! NAME TAGS OR ZERO TO AVOID DIAGNOSTICS J=AP ;! PRESERVE ANALYSIS RECORD POINTER AP=AP+1 ;! AP ON SKIP APP ;! SKIP TO %IF A(AP)=2 %THEN %START ;! ROUTINE CALL %IF I>>24=64 %THEN %START ;! 'FORM/TYPE' IS ROUTINE AP=J ;! RESTORE AP TO RT ;! CALL ROUTINE %FINISH %ELSE %START %IF I\=0 %THEN %START PRINT NAME(A(J)) FAULT(M'NOT ',M'ROUT',M'INE ',M'NAME') %FINISH %FINISH AP=AP+1 ;! AP AFTER %RETURN ; %FINISH K=I>>28 ;! 'FORM' OF NAME %IF K=4 %THEN %START PRINT NAME(A(J)) FAULT(M'NAME',M' NOT',M' A D',M'ESTN') ;! ROUTINE/FN FORM I=0 ;! CLEAR TAGS TO AVOID FURTHER DIAGNOSTIC %FINISH AP=AP+1 ;! AP ON <+-\> SEXPR %IF I=0 %THEN %RETURN ;! LHS NAME NOT SET %IF K>=2 %THEN %START ;! LHS AN ARRAY TYPE DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! PRESERVE ACCUMMULATOR K=AP ;! PRESERVE AP AP=J ;! RESTORE INITIALANAL REC POINTER ARRAD ;! CALCULATE ARRAY ELEMENT ADDRESS WS=WS-1 ;! RESTORE WORKSPACE POINTER DUMP(M'LOAD',M'WK',BR(LEVEL),WS) ;! RESTORE ACCUMMULATOR DUMP(M'STR',M'WK',M'ACC',0) ;! DUMP ASSIGNMENT AP=K ;! RESTORE AP TO AFTER %RETURN ; %FINISH %IF K=1 %THEN %START DUMP(M'LOAD',M'WK',BR(I>>16&15),I&65535);! INDIRECT ASSIGMENT DUMP(M'STR',M'ACC',M'WK',0) %FINISH %ELSE DUMP(M'STR',M'ACC',BR(I>>16&15),I&65535) %IF A(J+1)=1 %THEN %START PRINT NAME(A(J)) FAULT(M'SCAL',M'AR H',M'AS P',M'ARAM') %FINISH %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! -> CONST 20: DUMP('B',0,M'BT',FIND LABEL) ;! SCAN/INSERT JUMP LIST AND DUMP JUMP %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %START 30: FAULT(M'%STA',M'RT ?',M' ',M' ') ;! %START ALONE SHOULD NOT BE A SOURCE STATEMENT %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %RETURN 40: %IF RTP(LEVEL)\=0 %THEN FAULT(M'%RET',M'URN ',M'CONT',M'EXT ') RETURN ;! DUMP %RETURN CODE - INCORRECT FOR FN %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %RESULT= 50: I=RTP(LEVEL) ;! ROUTINE/FN TYPE %IF I<=0 %THEN FAULT(M'%RES',M'ULT ',M'CONT',M'EXT ') ;! %BEGIN/%ROUTINE SEXPR ;! COMPILE RESULT EXPRESSION RETURN ;! LEAVE RESULT IN ACC & DUMP RETURN CODE %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE SEXPR ! COMPILE ARITHMETIC EXPRESSION %ROUTINESPEC TORP %ROUTINESPEC PSEVAL %ROUTINESPEC EVAL(%INTEGER P) %INTEGER RPP,APP %INTEGERARRAY RP,PT(1:32) ;! REVERSE POLISH, POINTER/TYPE ARRAYS RPP=1 ;! RP POINTER TORP ;! EXPR TO REV POLISH %IF SCF=1 %THEN %START ;! PART OF A SIMPLE CONDITION SCF=0 ;! RESET FLAG COMP=A(AP) ;! COMPARATOR NUMBER %IF A(AP+3)=0 %AND A(AP+4)=2 %THEN AP=AP+5 %ELSE %START AP=AP+1 ;! 2ND EXPR NON-ZERO TORP ;! 2ND EXPRESSION TO REVERSE POLISH RP(RPP)=10 ;! CODE FOR '-' I.E. (1ST-2ND) PT(RPP)=1 ;! FLAG=OPERATOR RPP=RPP+1 ;! INCREMENT RP POINTER %FINISH %FINISH APP=AP ;! SAVE FINAL ANAL REC POINTER PSEVAL ;! PSEUDO-EVALUATE EXPRESSION EVAL(RPP-1) ;! DUMP CODE FOR EXPR EVALUATION AP=APP ;! RESTORE FINAL ANAL REC POINTER ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE TORP ! TRANSFORM EXPRESSION TO REVERSE POLISH %ROUTINESPEC STORE(%INTEGER I,J) %INTEGERARRAY OP(1:4) %INTEGER OPP,I OPP=0 ;! OPERATOR STACK POINTER I=A(AP) ;! <+-\> AP=AP+1 %IF I=1 %OR I=4 %THEN ->1 ;! + OR NULL I=I+9 ;! CODES FOR - & \ 3: OPP=OPP+1 ;! STACK OPERATOR OP(OPP)=I 1: I=A(AP) ;! %IF I=3 %THEN %START ;! SUB-EXPRESSION AP=AP+1 ;! AP TO <+-\> TORP ;! TRANSFORM SUB-EXPR TO REV POL %FINISH %ELSE %START STORE(AP,0) ;! STORE ANAL REC POSITION OF OPERAND AP=AP+2 ;! AP ON OR AFTER %IF I=1 %THEN SKIP APP ;! OPERAND A NAME %FINISH %IF A(AP)=2 %THEN %START ;! END OF AP=AP+1 ;! AP AFTER EXPRESSION 2: %IF OPP=0 %THEN %RETURN ;! OPERATOR STACK EMPTIED STORE(OP(OPP),1) ;! UNSTACK REMAINING OPERATORS OPP=OPP-1 ->2 ; %FINISH I=A(AP+1) ;! AP=AP+2 ;! AP ON 4: %IF OPP=0 %OR PREC(I)>PREC(OP(OPP)) %THEN ->3 ;! OP STACK EMPTY OR NEW OP HIGHER PREC STORE(OP(OPP),1) ;! UNSTACK TOP OPERATOR OPP=OPP-1 ->4 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE STORE(%INTEGER I,J) ! STORE IN RP & PT ARRAYS, I=ANAL REC PTR , J= OP/OPD FLAG %IF RPP>32 %THEN %START ;! REV POL ARRAY FULL FAULT(M'EXPR',M' TOO',M' LON',M'G ') RPP=1 ;! IN ORDER TO CONTINUE %FINISH RP(RPP)=I ;! STORE OP/OPD PT(RPP)=J ;! STORE FLAG RPP=RPP+1 ;! NEXT POSITION %END %END ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE PSEVAL ! PSEUDO-EVALUATION, CHECKING OPERANDS %INTEGERARRAY PST(1:32) ;! OPERAND POINTER STACK %INTEGER PSTP,I,J,K PSTP=0 ;! PST POINTER I=1 ;! REV POL ARRAY POINTER 3: AP=RP(I) ;! ANAL REC POSITION OF OPERAND %IF A(AP)=1 %THEN %START ;! OPERAND A NAME J=LINK(A(AP+1)) ;! LINK TO TAG OF NAME %IF J=0 %THEN %START PRINT NAME(A(AP+1)) FAULT(M'NAME',M' NOT',M' SET',0) K=0 ;! DUMMY TAG VALUE ->1 ; %FINISH K=TAG(J) ;! TAG OF NAME J=K>>28 ;! 'FORM' OF NAME %IF J>1 %THEN %START ;! ARRAY OR ROUTINE/FN TYPE RP(I)=AP+1 ;! STORE ANAL REC POSITION OF %IF J=4 %THEN %START ;! NAME IS ROUTINE/FN TYPE %IF K>>24&15=0 %THEN %START PRINT NAME(A(AP+1)) FAULT(M'RT N',M'AME ',M'IN E',M'XPR ') K=0 ;! DUMMY TAG VALUE ->1 ; %FINISH PT(I)=-1 ;! FLAG FOR FUNCTION %FINISH %ELSE PT(I)=-2 ;! FLAG FOR ARRAY ->2 ; %FINISH ;! GO TO STACK POINTER %IF A(AP+2)=1 %THEN %START PRINT NAME(A(AP+1)) FAULT(M'SCAL',M'AR H',M'AS P',M'ARAM') %FINISH 1: RP(I)=K ;! STORE TAG OF NAME FOR SCALARS PT(I)=-3 ;! FLAG FOR SCALARS %FINISH %ELSE %START ;! OPERAND IS A RP(I)=A(AP+1) ;! STORE VALUE OF CONSTANT PT(I)=-4 ;! FLAG FOR CONSTANTS %FINISH 2: PSTP=PSTP+1 ;! STACK OPERAND POINTER 4: PST(PSTP)=I I=I+1 ;! REV POL ARRAY POINTER %IF I3 ;! AN OPERAND IS NEXT %IF RP(I)<=10 %THEN %START ;! BINARY OPERATORS PSTP=PSTP-1 ;! PSEUDO-EVALUATE POINTERS PT(I)=PST(PSTP) ;! STACK POINTER TO RESULT %FINISH ->4 ; %FINISH %END ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE EVAL(%INTEGER P) ! DUMP CODE FOR EVALUATION OF EXPRESSION %ROUTINESPEC OPN(%INTEGER OP,L) %INTEGER I,J,K I=PT(P) ;! POINTER/TYPE OF LAST REV POL ENTRY %IF I<0 %THEN %START ;! OPERAND OPN(0,P) ;! LOAD OPERAND %RETURN ; %FINISH J=RP(P) ;! OPERATOR K=P-1 ;! START OF 2ND OPERAND %IF UCN(J)=1 %THEN %START ;! UNARY OPERATOR %IF PT(K)>=-2 %THEN EVAL(K) %ELSE OPN(0,K) ;! EVAL IF NODE OTHERWISE LOAD OPERAND DUMP(OPR(J),M'ACC',0,0) ;! DUMP UNARY OPERATION %RETURN ; %FINISH %IF PT(I)>=-2 %THEN %START ;! FIRST OPERAND A NODE %IF PT(K)>=-2 %THEN %START ;! SECOND OPERAND A NODE EVAL(K) ;! EVALUATE 2ND OPERAND DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! & STORE IT IN WORKSPACE EVAL(I) ;! EVALUATE 1ST OPERAND WS=WS-1 ;! RESTORE WORKSPACE POINTER DUMP(OPR(J),M'ACC',BR(LEVEL),WS) ;! DUMP OPERATION %FINISH %ELSE %START ;! 2ND OPERAND NOT A NODE EVAL(I) ;! EVALUATE 1ST OPERAND OPN(J,K) ;! OPERATION WITH 2ND OPERAND %FINISH %FINISH %ELSE %START ;! 1ST OPERAND NOT A NODE %IF PT(K)>=-2 %THEN %START ;! 2ND OPERAND A NODE EVAL(K) ;! EVALUATE 2ND OPERAND %IF UCN(J)=2 %THEN %START ;! OPERATOR IS COMMUTATIVE OPN(J,I) ;! OPERATION WITH 1ST OPERAND %RETURN ; %FINISH DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! STORE VALUE OF 2ND OPERAND IN WORKSPACE OPN(0,I) ;! LOAD 1ST OPERAND WS=WS-1 ;! RESTORE WORKSPACE POINTER DUMP(OPR(J),M'ACC',BR(LEVEL),WS) ;! DUMP OPERATION WITH 2ND OPERAND %FINISH %ELSE %START ;! 2ND OPERAND NOT A NODE OPN(0,I) ;! LOAD 1ST OPERAND OPN(J,K) ;! OPERATION WITH 2ND OPERAND %FINISH %FINISH %RETURN ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE OPN(%INTEGER OP,L) ! DUMP SIMPLE OPERATION, OP=OPERATOR, L=RP POSITION OF OPERAND %INTEGER I,J I=PT(L) ;! KIND OF OPERAND AP=RP(L) ;! ANAL REC POINTER OR NAME TAGS %IF I=-1 %THEN %START ;! ROUTINE/FN TYPE RT ;! DUMP CALL ON FUNCTION %RETURN ; %FINISH %IF I=-2 %THEN %START ;! ARRAY ACCESS ARRAD ;! CALCULATE ARRAY ELEMENT ADDRESS DUMP(M'LOAD',M'ACC',M'ACC',0) ;! LOAD VALUE %RETURN ; %FINISH %IF I=-3 %THEN %START ;! SCALAR TYPE %IF AP>>28=1 %THEN %START ;! %NAME TYPE DUMP(M'LOAD',M'WK',BR(AP>>16&15),AP&65535) ;! LOAD INDIRECT DUMP(OPR(OP),M'ACC',M'WK',0) %FINISH %ELSE DUMP(OPR(OP),M'ACC',BR(AP>>16&15),AP&65535) %RETURN ; %FINISH %IF OP\=0 %OR AP>65535 %THEN %START ;! CONSTANT NOT 'LDA'-ABLE J=CT NEXT ;! NEXT HOLE IN CONSTANT TABLE COT(J)=AP ;! STORE VALUE DUMP(OPR(OP),M'ACC',M'CT',J) %FINISH %ELSE DUMP(M'LDA',M'ACC',0,AP) %END %END %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE SKIP SEXPR ! SKIP PAST <+-\> IN ANALYSIS RECORD, AP INITIALLY ON <+-\> 1: AP=AP+2 ;! AP ON +1 %IF A(AP-1)=3 %THEN SKIP SEXPR %ELSE %START ;! SKIP SUB-EXPR ELSE OR AP=AP+1 ;! AP ON OR AFTER %IF A(AP-2)=1 %THEN SKIP APP ;! OPERAND IS A NAME %FINISH AP=AP+1 ;! AP AFTER %IF A(AP-1)=1 %THEN ->1 ;! MORE OPERANDS %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE SKIP APP ! SKIP PAST IN ANALYSIS RECORD 1: AP=AP+1 ;! POINTER TO +1 OR +1 %IF A(AP-1)=1 %THEN %START ;! EXPRESSIONS TO SKIP SKIP SEXPR ->1 ; %FINISH %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE SCCOND(%INTEGERNAME LABEL) ! COMPILE CONDITION I.E. , LABEL SET FOR POSITION AFTER UI %ROUTINESPEC SC %ROUTINESPEC COND %ROUTINESPEC STORE(%INTEGER FT) %INTEGER I,J,K,L,APP %INTEGERARRAY CAP,LVL,TF,JMP,LBL(1:16) ;! ANAL REC POINTERS, NESTING LEVEL, ;! TRUE/FALSE, JUMP & LABEL ARRAYS I=1 ;! INDEX TO ARRAYS L=0 ;! NESTING LEVEL SC ;! PROCESS COND ;! PROCESS APP=AP ;! PRESERVE FINAL ANAL REC POINTER L=-1 STORE(1) ;! PSEUDO-FALSE AT LEVEL -1 L=-2 STORE(2) ;! PSEUDO-TRUE AT LEVEL -2 K=I-1 ;! LAST POSITION FILLED IN IN ARRAYS I=1 2: J=I ;! FIND POSITIONS TO JUMP TO 1: J=J+1 ;! AFTER COMPARISONS %IF LVL(J)>=LVL(I) %OR TF(J)=TF(I) %THEN ->1 ;! SKIP HIGHER LEVELS ETC JMP(I)=J ;! JUMP TO COMPARISON POSITION J I=I+1 %IF I2 ;! MORE JUMPS TO FILL IN YET %IF A(AP)\=2 %THEN ->3 ;! UI NOT A JUMP INSTRUCTION AP=AP+1 ;! TO J=K-1 ;! LAST POSITION FILLED IN TF(J)=2 ;! SET AS 'TRUE' JMP(J)=J ;! SET JUMP AS THE UI JUMP LBL(J)=FIND LABEL ;! FILL IN BRANCH TABLE POSITION 3: I=1 ;! FILL IN PSEUDO-LABELS FOR INNER JUMPS 4: %IF LBL(JMP(I))<0 %THEN LBL(JMP(I))=BT NEXT ;! NEXT BAT POSITION I=I+1 %IF I4 ;! MORE TO FILL IN I=1 7: AP=CAP(I) ;! ANAL REC POINTER FOR 1ST EXPR OF COMP SCF=1 ;! SET FLAG FOR SEXPR SEXPR ;! TO EVALUATE (1ST - 2ND) %IF TF(I)=1 %THEN L=FALSE(COMP) %ELSE L=TRUE(COMP) DUMP(L,M'ACC',M'BT',LBL(JMP(I))) ;! BRANCH TO REQUIRED POSITION %IF LBL(I)>=0 %AND (I\=K-1 %OR TF(I)=1) %THEN BAT(LBL(I))=CA I=I+1 ;! FILL IN LABEL ADDRESS %IF I7 ;! MORE COMPARISONS YET LABEL=LBL(K) ;! FINAL LABEL AP=APP ;! FINAL ANALYSIS RECORD POINTER ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE STORE(%INTEGER FT) ! STORE LEVEL & TRUE/FALSE FLAG %IF I>16 %THEN %START ;! ARRAYS FULL FAULT(M'COND',M'N TO',M'O LO',M'NG ') I=1 ;! TO CONTINUE %FINISH LVL(I)=L ;! SAVE NESTING LEVEL TF(I)=FT ;! SAVE TRUE/FALSE FLAG LBL(I)=-1 ;! SET 'LABEL NOT FILLED IN YET' FLAG I=I+1 ;! NEXT ARRAY POSITION %END ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE SC AP=AP+1 %IF A(AP-1)=2 %THEN %START L=L+1 ;! NESTING LEVEL UP 1 FOR SUB-CONDITION SC ;! PROCESS SUB- COND ;! PROCESS SUB- L=L-1 ;! NESTING LEVEL DOWN AFTER SUB-CONDITION %FINISH %ELSE %START CAP(I)=AP ;! ANAL REC POINTER FOR SIMPLE COMPARISON SKIP SEXPR ;! SKIP 1ST EXPR OF COMPARISON AP=AP+1 ;! SKIP COMPARATOR SKIP SEXPR ;! SKIP 2ND EXPR %FINISH %END ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE COND ! PROCESS FOR SIMPLE COMPARISONS %INTEGER I I=A(AP) ;! AP=AP+1 ;! AP ON %IF I\=3 %THEN %START ;! NOT NULL ALTERNATIVE OF 1: STORE(I) ;! SAVE %AND OR %OR TYPE OF CONDITION SC ;! PROCESS AP=AP+1 ;! POINTER ON +1 OR +1 %IF A(AP-1)=1 %THEN ->1 ;! MORE %ANDS OR %ORS %FINISH %END %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE CHECK ! CHECK LABELS ALL SET & STARTS MATCH FINISHES %INTEGER I,J I=JUMP(LEVEL) ;! POINTER TO JUMP LIST FOR THIS LEVEL 1: %IF I\=0 %THEN %START ;! NO LABELS OR JUMPS USED AT THIS LEVEL %IF BAT(TAG(I)&65535)<0 %THEN %START ;! LABEL SET INCORRECTLY WRITE(TAG(I)>>16,1) ;! PRINT OUT LABEL NO OF LABEL NOT SET FAULT(M' LAB',M'EL N',M'OT S',M'ET ') %FINISH I=RETURN CELL(I) ;! RETURN JUMP LIST CELL TO ASL ->1 ; %FINISH I=START(LEVEL) ;! LINK TO START LIST 2: %IF I\=0 %THEN %START ;! A CELL STILL IN LIST FAULT(M'%FIN',M'ISH ',M'MISS',M'ING ') I=RETURN CELL(I) ;! POP UP CELL ->2 ; %FINISH %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE UNSET ! UNSET NAMES AND CHECK FOR MISSING ROUTINES %INTEGER I,J,K I=NAME(LEVEL) ;! NAME LIST POINTER 1: %IF I\=0 %THEN %START ;! UNSET NAMES DECLARED AT THIS LEVEL J=TAG(I) ;! NAME IDENT NO K=TAG(LINK(J)) ;! TAG WORD AT TOP OF LIST LINK(J)=RETURN CELL(LINK(J)) ;! POP UP CELL %IF K>>28=4 %THEN %START ;! ROUTINE/FN TYPE %IF BAT(K&65535)<0 %THEN %START PRINT NAME(J) FAULT(M'ROUT',M'INE ',M'MISS',M'ING ') %FINISH K=K>>20&15 ;! NO OF PARAMS 2: %IF K\=0 %THEN %START ;! PARAMS PRESENT LINK(J)=RETURN CELL(LINK(J)) ;! POP UP CELLS K=K-1 ;! PARAM COUNT ->2 ; %FINISH %FINISH %IF LINK(J)=0 %THEN TAG(J)=0 ;! A PREVIOUS DECLARATION OF SAME NAME I=RETURN CELL(I) ;! RETURN NAME LIST CELL ->1 ; %FINISH %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE PUSH START(%INTEGER FLAG,LABEL) ! PUSHDOWN START/FINISH BLOCK INFORMATION %INTEGER I I=NEWCELL TAG(I)=FLAG<<16!LABEL&65535 ;! PACK FLAG & LABEL LINK(I)=START(LEVEL) ;! PUSH CELL DOWN START(LEVEL)=I ;! ONTO START LIST %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE ENTER(%INTEGER TYPE,ALLOC) ! DUMP CODE FOR NEW LEVEL & INITIALISE LEVEL ARRAYS %INTEGER I DUMP(M'STR',BR(LEVEL),M'STP',0) ;! ENTRY SEQUENCE DUMP(M'LDA',BR(LEVEL),M'STP',0) DUMP(M'STR',M'WK',M'STP',1) I=CT NEXT ;! STATIC ALLOCATION HOLE IN CONST TABLE DUMP(M'ADD',M'STP',M'CT',I) STAR(LEVEL)=I ;! REMEMBER POSITION OF HOLE JUMP(LEVEL)=0 ;! NO JUMPS AT NEW LEVEL YET NAME(LEVEL)=0 ;! NO NAMES AT NEW LEVEL YET RTP(LEVEL)=TYPE ;! BLOCK/ROUTINE/FN TYPE CHPP(LEVEL)=CHP ;! SAVE CHARACTER ARRAY POINTER START(LEVEL)=0 ;! NO START/FINISH BLOCKS YET RAD(LEVEL)=ALLOC ;! NEXT RELATIVE ADDRESS TO BE ASSIGNED %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE RETURN ! DUMP CODE FOR %RETURN DUMP(M'LDA',M'STP',BR(LEVEL),0) ;! RESTORE DIJKSTRA DISPLAY DUMP(M'LOAD',BR(LEVEL),M'STP',0) DUMP(M'LOAD',M'WK',M'STP',1) DUMP('B',0,M'WK',0) ;! BRANCH TO RETURN ADDRESS %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE RT ! DUMP CODE FOR A ROUTINE OR FUNCTION CALL %INTEGER I,J,K,L,M,N,P I=LINK(A(AP)) ;! LINK TO TAG FOR NAME AP=AP+1 ;! AP ON J=TAG(I) ;! TAG OF NAME K=J>>20&15+1 ;! NO OF PARAMS +1 1: K=K-1 ;! COUNT PARAMS AP=AP+1 ;! AP ON +1 %IF A(AP-1)=2 %THEN %START ;! PARAMS ABSENT OR NO MORE TO PROCESS DUMP(M'BAL',M'WK',M'BT',J&65535) ;! DUMP BRANCH TO ROUTINE/FN %IF K>0 %THEN FAULT(M'TOO ',M'FEW ',M'PARA',M'MS ') %RETURN ; %FINISH %IF K<=0 %THEN %START ;! MORE PARAMS THAN SPEC %IF K=0 %THEN FAULT(M'TOO ',M'MANY',M' PAR',M'AMS ') ;! ONLY MONITOR ONCE ->2 ; %FINISH I=LINK(I) ;! LINK TO NEXT PARAM CELL L=TAG(I) ;! TAG OF PARAM %IF L>>28=0 %THEN %START ;! SCALAR VALUE SEXPR ;! COMPILE EXPRESSION ->3 ; %FINISH %IF A(AP)=4 %AND A(AP+1)=1 %THEN ->4 ;! <+-\> IS NULL & IS A NAME 5: FAULT(M'NOT ',M'A NA',M'ME P',M'ARAM') 2: SKIP SEXPR ;! SKIP INVALID PARAM TO CONTINUE ->1 4: M=LINK(A(AP+2)) ;! LINK TO TAG FOR PARAM NAME %IF M=0 %THEN %START PRINT NAME(A(AP+2)) FAULT(M'NAME',M' NOT',M' SET',M' ') ->2 ; %FINISH N=TAG(M) ;! TAG OF PARAM NAME %IF L>>28=1 %THEN %START ;! PARAM IS SCALAR NAME TYPE %IF N>>28=4 %THEN %START ;! ACTUAL NAME IS ROUTINE/FN TYPE PRINT NAME(A(AP+2)) ->5 ; %FINISH %IF N>>28>=2 %THEN %START ;! ACTUAL NAME IS AN ARRAY AP=AP+2 ;! AP ON ARRAD ;! CALCULATE ARRAY ELEMENT ADDRESS AP=AP+1 ;! AP ON +1 - SHOULD BE %IF A(AP-1)=1 %THEN ->5 ;! FURTHER OPERAND - INVALID ->3 ; %FINISH %IF A(AP+3)=1 %THEN %START ;! NOT NULL PRINT NAME(A(AP+2)) FAULT(M'SCAL',M'AR H',M'AS P',M'ARAM') ->2 ; %FINISH %IF A(AP+4)=1 %THEN ->5 ;! FURTHER OPERANDS - INVALID %IF N>>28=1 %THEN P=M'LOAD' %ELSE P=M'LDA' ;! LOAD FOR NAME TYPE & LDA FOR VALUE TYPE DUMP(P,M'ACC',BR(N>>16&15),N&65535) %FINISH %ELSE %START ;! PARAM IS ARRAY NAME %IF A(AP+3)\=2 %OR A(AP+4)\=2 %THEN ->5 ;! NOT NULL OR MORE OPERANDS %IF N>>28&2=0 %THEN %START ;! 'FORM' OF ACTUAL IS NOT ARRAY PRINT NAME(A(AP+2)) FAULT(M'NOT ',M'AN A',M'RRAY',M' NME') ->2 ; %FINISH %IF N>>28=3 %THEN %START ;! ACTUAL IS ARRAY NAME M=N&65535 ;! POINTER TO TAG CELL OF PARAM LIST N=TAG(M) ;! CORRECT TAG FOR PARAM %FINISH %IF N>>20&15\=L>>20&15 %THEN %START ;! DIMENSIONS DIFFERENT %IF L>>20&15=0 %THEN %START ;! FORMAL PARAM DIMENSION UNKNOWN L=TAG(I)!N&15<<20 ;! FILL FORMAL TAG WITH DIMENSION TAG(I)=L ;! OF ACTUAL PARAM %FINISH %ELSE %START ;! DIMENSION OF FORMAL KNOWN %IF N>>20&15=0 %THEN TAG(M)=TAG(M)!L&15<<20 %ELSE %START ;! FILL IN DIMENSION OF ACTUAL IF UNKNOWN PRINT NAME(A(AP+2)) FAULT(M'ARRA',M'Y DI',M'MENS',M'ION?') ->2 ; %FINISH %FINISH %FINISH DUMP(M'LOAD',M'ACC',BR(N>>16&15),N&65535) %IF L>>20&15\=1 %THEN %START ;! NOT 1-DIM ARRAY DUMP(M'STR',M'ACC',M'STP',L&65535) DUMP(M'LOAD',M'ACC',BR(N>>16&15),N&65535+1) L=L+1 %FINISH %FINISH AP=AP+5 ;! AP ON 3: DUMP(M'STR',M'ACC',M'STP',L&65535) ->1 %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE ARRAD ! DUMP CODE TO CALCULATE ARRAY ELEMENT ADDRESS %INTEGER I,J,K,L L=A(AP) I=LINK(L) ;! LINK TO TAG FOR NAME OF ARRAY J=TAG(I) %IF J>>28=3 %THEN %START ;! NAME IS AN ARRAY NAME I=J&65535 ;! SUBSTITUTE CORRECT TAG VALUE J=TAG(I) %FINISH AP=AP+2 ;! AP ON +1 %IF A(AP-1)=1 %THEN %START ;! INDEXES PRESENT SEXPR ;! COMPILE EXPR FOR FIRST INDEX AP=AP+1 ;! AP ON +1 %IF A(AP-1)=1 %THEN %START ;! 2ND INDEX PRESENT DUMP(M'STR',M'ACC',BR(LEVEL),WS NEXT) ;! STORE 1ST INDEX IN WORKSPACE SEXPR ;! COMPILE EXPR FOR 2ND INDEX %IF A(AP)=1 %THEN %START ;! 3RD INDEX PRESENT PRINT NAME(L) FAULT(M'TOO ',M'MANY',M' IND',M'EXES') SKIP APP ;! SKIP EXCESS INDEXES %FINISH %ELSE AP=AP+1 ;! AP AFTER EXPRESSION DUMP(M'MLT',M'ACC',BR(J>>16&15),J&65535) WS=WS-1 ;! RESTORE WORKSPACE POINTER DUMP(M'ADD',M'ACC',BR(LEVEL),WS) DUMP(M'ADD',M'ACC',BR(J>>16&15),J&65535+1) K=2 ;! DIMENSION MARKER %FINISH %ELSE %START ;! ONLY ONE INDEX PRESENT DUMP(M'ADD',M'ACC',BR(J>>16&15),J&65535) K=1 ;! DIMENSION MARKER %FINISH %IF K\=J>>20&15 %THEN %START ;! DIMS FOUND DO NOT AGREE WITH TAG %IF J>>20&15=0 %THEN TAG(I)=TAG(I)!K<<20 %ELSE %C PRINT NAME(L) FAULT(M'ARRA',M'Y DI',M'MENS',M'ION?') ;! FILL IN DIMS IF UNKNOWN %FINISH %FINISH %ELSE %START PRINT NAME(L) FAULT(M'NO A',M'RRAY',M' IND',M'EXES') %FINISH %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN BT NEXT ! ALLOCATE NEXT POSITION IN BRANCH TABLE %IF BTN>1023 %THEN %START ;! FULL FAULT(M'TOO ',M'MANY',M'LABE',M'LS ') BTN=0 ;! TRY TO CONTINUE %FINISH BAT(BTN)=-1 ;! MARKER FOR ADDRESS NOT FILLED IN YET BTN=BTN+1 ;! NEXT POSITION %RESULT=BTN-1 ;! THIS POSITION %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN CT NEXT ! ALLOCATE NEXT POSITION IN CONSTANT TABLE %IF CTN>1023 %THEN %START ;! FULL FAULT(M'TOO ',M'MANY',M' CON',M'STS ') CTN=0 ;! TRY TO CONTINUE %FINISH CTN=CTN+1 ;! NEXT POSITION %RESULT=CTN-1 ;! THIS POSITION %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN WS NEXT ! ALLOCATE NEXT WORK SPACE POSITION WS=WS+1 %IF WS=11 %THEN FAULT(M'COMP',M'ILER',M' WKS',M'PACE') %RESULT=WS-1 %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN FIND LABEL ! CHECK & LOCATE OR INSERT LABEL IN JUMP LIST FOR THIS LEVEL %INTEGER I,J LABEL=A(AP) ;! VALUE OF CONST AP=AP+1 ;! AFTER %IF LABEL>>16\=0 %THEN %START ;! INVALID LABEL NUMBER WRITE(LABEL,1) SPACES(2) FAULT(M'INVA',M'LID ',M'LABE',M'L ') %RESULT=-1 ;! 'FAULTY' RESULT %FINISH I=JUMP(LEVEL) ;! JUMP LIST POINTER 1: %IF I\=0 %THEN %START ;! SOMETHING IN LIST %IF LABEL=TAG(I)>>16 %THEN %RESULT=TAG(I)&65535 ;! LABEL ALREADY IN I=LINK(I) ;! NEXT CELL IN LIST ->1 ; %FINISH I=NEWCELL ;! LABEL NOT IN LIST SO GET NEW CELL J=BT NEXT ;! GET NEXT BRANCH TABLE POSITION TAG(I)=LABEL<<16!J ;! FILL IN LIST ENTRY LINK(I)=JUMP(LEVEL) ;! PUSHDOWN ONTO JUMP LIST JUMP(LEVEL)=I ;! NEW JUMP LIST POINTER %RESULT=J ;! NEW BRANCH TABLE POSITION %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE STORE TAG(%INTEGER NAM,FORM,TYPE,DIM,LEV,AD) ! STORE TAGS I.E. SET NAME & CHECK NOT SET ALREADY %INTEGER M,N M=LINK(NAM) ;! POINTER TO EXISTING TAGS WORD FOR THIS %IF M\=0 %AND LEV=TAG(M)>>16&15 %AND FORM\=4 %THEN %START PRINT NAME(NAM) FAULT(M'NAME',M' SET',M' TWI',M'CE ') %RETURN ; %FINISH N=NEWCELL ;! NEW CELL FOR TAGS TAG(N)=FORM<<28!TYPE<<24!DIM<<20!LEV<<16!AD ;! FILL IN TAGS LINK(N)=LINK(NAM) ;! PUSHDOWN ONTO TAGS LIST FOR THIS NAME LINK(NAM)=N N=NEWCELL TAG(N)=NAM ;! PUSHDOWN NEW CELL ONTO NAME LIST LINK(N)=NAME(LEVEL) ;! FOR NAMES DECLARED AT THIS LEVEL NAME(LEVEL)=N %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE DUMP(%INTEGER OP,REG,BASE,DISP) ! PRINT OUT CURRENT ADDRESS, OPERATION MNEMONIC & OPERANDS %ROUTINESPEC PMN(%INTEGER I) %INTEGER COM SPACES(10) COM=' ' PMN(OP) ;! OPERATOR MNEMONIC COM=',' PMN(REG) ;! REGISTER MNEMONIC %IF DISP>=65536 %THEN %START PRINT SYMBOL(',') SPACES(7) PRINT NAME(DISP-65536) %FINISH %ELSE %START %IF BASE=M'BT' %OR BASE=M'CT' %OR BASE=M'PRG' %THEN %START PRINT SYMBOL(',') SPACES(7) %FINISH PMN(BASE) ;! BASE MNEMONIC WRITE(DISP,1) ;! DISPLACEMENT %FINISH NEWLINE CA=CA+1 ;! INCREMENT CURRENT ADDRESS COUNT ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE PMN(%INTEGER I) ! PRINT MNEMONIC - CHARS INTO ONE WORD %INTEGER J,K,L J=2 ;! AT LEAST TWO SPACES K=24 ;! FIRST SHIFT VALUE 1: L=I>>K&255 ;! UNPACK NEXT CHARACTER %IF L=0 %THEN J=J+1 %ELSE PRINT SYMBOL(L) K=K-8 ;! NEXT SHIFT VALUE %IF K>=0 %THEN ->1 ;! MORE CHARS POSSIBLY YET %IF I=M'BT' %OR I=M'CT' %OR I=M'PRG' %THEN %C PRINT SYMBOL('+') %ELSE %START PRINT SYMBOL(COM) SPACES(J) ;! TO ALLIGN FIELDS CORRECTLY %FINISH %END %END %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE FAULT(%INTEGER A,B,C,D) ! MONITOR FAULT - A 'PRINT STRING' ROUTINE %ROUTINESPEC OUT(%INTEGER I) OUT(A) OUT(B) OUT(C) OUT(D) NEWLINE FAULTS=FAULTS+1 ;! INCREMENT FAULT COUNT ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! %ROUTINE OUT(%INTEGER I) ! PRINT OUT PACKED CHARS PRINT SYMBOL(I>>24) PRINT SYMBOL(I>>16&255) PRINT SYMBOL(I>>8&255) PRINT SYMBOL(I&255) %END %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN CH NEXT ! ALLOCATE NEXT POSITION IN 'CH' ARRAY %IF CHP>512 %THEN %START ;! CHARACTER ARRAY FULL FAULT(M'NAME',M'S TO',M'O LO',M'NG ') %STOP ; %FINISH CHP=CHP+1 %RESULT=CHP-1 %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN NEWCELL ! ALLOCATE NEW CELL FOR LIST PROCESSING %INTEGER I %IF ASL=0 %THEN %START ;! END OF AVAILABLE SPACE LIST FAULT(M'ASL ',M'EMPT',M'Y ',M' ') %STOP ; %FINISH I=ASL ;! POINTER TO TOP CELL OF ASL ASL=LINK(ASL) ;! ASL POINTER TO NEXT CELL DOWN TAG(I)=0 ;! CLEAR NEW CELL OUT LINK(I)=0 %RESULT=I ;! INDEX TO NEW CELL %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %INTEGERFN RETURN CELL(%INTEGER I) ! DEALLOCATE CELL AND RETURN IT TO ASL %INTEGER J J=LINK(I) ;! PRESENT LINK VALUE OF CELL LINK(I)=ASL ;! LINK TO TOP OF ASL ASL=I ;! ASL POINTER TO RETURNED CELL %RESULT=J ;! RETURN VALUE OF LINK %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ROUTINE PRINT NAME(%INTEGER I) ! PRINT NAME FROM HASH POSITION %INTEGER J,K,L,M J=TAG(I) ;! POINTER TO CH ARRAY K=CH(J) ;! LENGTH & FIRST 3 CHARS L=K>>24 ;! NUMBER OF CHARS IN NAME M=16 ;! FIRST SHIFT VALUE 1: PRINT SYMBOL(K>>M&255) L=L-1 %IF L=0 %THEN %START SPACES(2) %RETURN ; %FINISH M=M-8 ;! NEXT SHIFT VALUE %IF M<0 %THEN %START J=J+1 K=CH(J) ;! NEXT WORD OF CHARS M=24 %FINISH ->1 %END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %ENDOFPROGRAM