%CONTROL 0 %BEGIN %INTEGERARRAY RMN,REG(0:15) %INTEGERARRAY IMN(1:31) %INTEGERARRAY LMN,LAD(1:20) %INTEGERARRAY R(1:4000) %INTEGERARRAY S(0:16383) %INTEGER LP,RP,SP,I,J,K,L,M,N,F,MR,TR,ST,CT %ROUTINESPEC READMN(%INTEGERNAME MN,NEXT) %ROUTINESPEC FAULT(%INTEGER I,J,K,L) %ROUTINESPEC OUT(%INTEGER I) %ROUTINESPEC DUMP %SWITCH INS(1:31) %SWITCH IOR(0:10) %EXTERNALROUTINESPEC DEFINE(%STRING(63) S) RMN(0)=M'BR0' ; RMN(1)=M'BR1' ; RMN(2)=M'BR2' RMN(3)=M'BR3' ; RMN(4)=M'BR4' ; RMN(5)=M'BR5' RMN(6)=M'BR6' ; RMN(7)=M'BR7' ; RMN(8)=M'BR8' RMN(9)=M'BR9' ; RMN(10)=M'BR10'; RMN(11)=M'BR11' RMN(12)=M'BR12'; RMN(13)=M'WK' ; RMN(14)=M'STP' RMN(15)=M'ACC' IMN(1)=M'LOAD' ; IMN(2)=M'LDA' ; IMN(3)=M'ADD' IMN(4)=M'SUB' ; IMN(5)=M'MLT' ; IMN(6)=M'DIV' IMN(7)=M'EXP' ; IMN(8)=M'STR' ; IMN(9)=M'NEG' IMN(10)=M'NOT' ; IMN(11)=M'SHL' ; IMN(12)=M'SHR' IMN(13)=M'AND' ; IMN(14)=M'OR' ; IMN(15)=M'XOR' IMN(16)=M'BAL' ; IMN(17)=M'B' ; IMN(18)=M'BZ' IMN(19)=M'BNZ' ; IMN(20)=M'BG' ; IMN(21)=M'BNG' IMN(22)=M'BL' ; IMN(23)=M'BNL' ; IMN(24)=M'STOP' IMN(25)=M'ADDF'; IMN(26)=M'SUBF'; IMN(27)=M'MLTF' IMN(28)=M'DIVF'; IMN(29)=M'EXPF'; IMN(30)=M'NEGF' IMN(31)=M'FLT' LP=1 RP=1 SP=0 F=0 MR=0 TR=0 DEFINE('STREAM01,SKIMPO') SELECT INPUT(1) 1: READ SYMBOL(I) %IF I='''' %THEN %START 10: READ SYMBOL(I) %IF I\='''' %THEN ->10 ->1 ; %FINISH %IF I\='.' %THEN ->1 READMN(I,J) %IF J=':' %THEN %START %IF LP=1 %THEN ->2 K=1 4: %IF I=LMN(K) %THEN %START %IF LAD(K)>=0 %THEN FAULT(M'LABE',M'L SE',M'T TW',M'ICE ') ->3 ; %FINISH K=K+1 %IF K4 %IF LP>20 %THEN %START FAULT(M'TOO ',M'MANY',M' LAB',M'ELS ') ->25 ; %FINISH 2: LMN(LP)=I K=LP LP=LP+1 3: LAD(K)=SP 25: %IF I=M'ST' %THEN %START ST=SP ->18 ; %FINISH ->1 ; %FINISH %IF J='=' %THEN %START READ(K) %IF K<0 %OR K>15 %THEN %START FAULT(M'EQUA',M'TE N',M'UMBE',M'R ? ') ->1 ; %FINISH RMN(K)=I ->1 ; %FINISH %IF I=M'REGS' %AND J=10 %THEN %START MR=MR!128 ->1 ; %FINISH %IF I=M'TON' %AND J=10 %THEN %START MR=MR!64 ->1 ; %FINISH %IF I=M'TOFF' %AND J=10 %THEN %START MR=MR!32 ->1 ; %FINISH %IF J\=',' %THEN FAULT(M'SYNT',M'AX ?',0,0) %IF I=0 %THEN %START READMN(I,J) %IF I\=0 %OR J\=',' %THEN FAULT(M'SYNT',M'AX ?',0,0) READMN(I,J) %IF I\=0 %OR J\=',' %THEN FAULT(M'SYNT',M'AX ?',0,0) %IF SP>=16384 %THEN %START FAULT(M'PROG',M'RAM ',M'TOO ',M'BIG ') %STOP ; %FINISH READ(S(SP)) SP=SP+1 MR=0 ->1 ; %FINISH K=1 6: %IF I=IMN(K) %THEN ->5 K=K+1 %IF K<=31 %THEN ->6 FAULT(M'INST',M'RUCT',M'ION ',M'? ') 5: READMN(I,J) %IF J\=',' %THEN FAULT(M'SYNT',M'AX ?',0,0) %IF I=0 %THEN L=0 %ELSE %START L=0 8: %IF I=RMN(L) %THEN ->7 L=L+1 %IF L<=15 %THEN ->8 FAULT(M'REGI',M'STER',M' ? ',0) %FINISH 7: K=K<<4!L READMN(I,J) %IF J='+' %THEN %START READ(M) %IF M>=65536 %THEN FAULT(M'DISP',M'. TO',M'O BI',M'G ') %IF LP=1 %THEN ->9 L=1 12: %IF I=LMN(L) %THEN %START %IF LAD(L)<0 %THEN ->11 K=K<<20!(LAD(L)+M) ->13 ; %FINISH L=L+1 %IF L12 %IF LP>20 %THEN %START FAULT(M'TOO ',M'MANY',M' LAB',M'ELS ') ->11 ; %FINISH 9: LMN(LP)=I LAD(LP)=-1 L=LP LP=LP+1 11: %IF RP>4000 %THEN %START FAULT(M'TOO ',M'MANY',M' REL',M'OCS.') %STOP ; %FINISH R(RP)=L<<16!SP RP=RP+1 14: K=K<<20!M 13: %IF SP>=16384 %THEN %START FAULT(M'PROG',M'RAM ',M'TOO ',M'BIG ') %STOP ; %FINISH S(SP)=K!MR<<24 SP=SP+1 MR=0 ->1 ; %FINISH %IF ('A'<=J %AND J<='Z') %OR J=10 %THEN %START %IF I=M'READ' %AND J='S' %THEN %START M=16384 15: READMN(I,J) %IF I\=M'YMBO' %OR J\='L' %THEN ->26 READ SYMBOL(I) %IF I\=10 %THEN ->26 ->14 ; %FINISH %IF I=M'NEXT' %AND J='S' %THEN %START M=16385 ->15 ; %FINISH %IF I=M'SKIP' %AND J='S' %THEN %START M=16386 ->15 ; %FINISH %IF I=M'PRIN' %AND J='T' %THEN %START READ SYMBOL(I) %IF I\='S' %THEN ->26 M=16387 ->15 ; %FINISH %IF I=M'SPAC' %AND J='E' %THEN %START READMN(I,J) %IF I=0 %AND J=10 %THEN %START M=16388 ->14 ; %FINISH %IF I='S' %AND J=10 %THEN %START M=16389 ->14 ; %FINISH ->26 %FINISH %IF I=M'NEWL' %AND J='I' %THEN %START READMN(I,J) %IF I=M'NE' %AND J=10 %THEN %START M=16390 ->14 ; %FINISH %IF I=M'NES' %AND J=10 %THEN %START M=16391 ->14 ; %FINISH ->26 %FINISH %IF I=M'NEWP' %AND J='A' %THEN %START READMN(I,J) %IF I\=M'GE' %OR J\=10 %THEN ->26 M=16392 ->14 ; %FINISH %IF I=M'READ' %AND J=10 %THEN %START M=16393 ->14 ; %FINISH %IF I=M'WRIT' %AND J='E' %THEN %START READ SYMBOL(I) %IF I\=10 %THEN ->26 M=16394 ->14 ; %FINISH 26: FAULT(M'I-O ',M'NAME',M' ? ',0) ->13 %FINISH %IF J\=',' %THEN FAULT(M'SYNT',M'AX ?',0,0) %IF I=0 %THEN L=0 %ELSE %START L=0 17: %IF I=RMN(L) %THEN ->16 L=L+1 %IF L<=15 %THEN ->17 FAULT(M'BASE',M' REG',M'ISTE',M'R ? ') %FINISH 16: K=K<<4!L READ(M) %IF M>=65536 %THEN FAULT(M'DISP',M'. TO',M'O BI',M'G ') K=K<<16!M ->13 18: READ(I) %IF I\=0 %THEN %START NEWLINE OUT(M'PROG') ; OUT(M'RAM ') ; OUT(M'FAUL') ; OUT(M'TY !') NEWLINE %STOP ; %FINISH 38: READ SYMBOL(I) %IF I\='.' %THEN ->38 SELECT INPUT(0) I=ST 28: %IF I>16383 %THEN ->29 S(I)=999999 I=I+1 ->28 29: NEWLINE OUT(M'LABE') ; OUT(M'LS ') NEWLINE I=0 J=1 20: OUT(LMN(J)) ; OUT(M' : ') %IF LAD(J)<0 %THEN %START OUT(M'NOT ') ; OUT(M'SET ') I=1 %FINISH %ELSE WRITE(LAD(J),1) NEWLINE %IF LMN(J)=M'CT' %THEN CT=LAD(J) J=J+1 %IF J20 %IF I\=0 %OR F\=0 %THEN %STOP %IF RP=1 %THEN ->21 M=1 22: I=R(M)>>16 J=R(M)&65535 K=S(J)&65535 L=LAD(I)+K %IF L>=65536 %THEN %START OUT(M'ADDR') ; OUT(M' TRU') ; OUT(M'NCAT') ; OUT(M'ED ') WRITE(J,1) NEWLINE L=L&65535 %FINISH S(J)=S(J)>>16<<16!L M=M+1 %IF M22 21: I=0 23: REG(I)=0 I=I+1 %IF I<=15 %THEN ->23 SP=0 24: %IF SP<0 %OR SP>=CT %THEN %START %IF SP>=16384 %AND SP<=16394 %THEN ->IOR(SP-16384) NEWLINE OUT(M'** ') WRITE(SP,1) SPACES(4) OUT(M'INST') ; OUT(M'R AD') ; OUT(M'DR ?') %STOP ; %FINISH I=S(SP) J=I>>20&15 K=I>>16&15 L=I&65535 %IF K=0 %THEN M=L %ELSE M=REG(K)+L I=I>>24 %IF I>128 %THEN %START NEWLINE N=0 27: OUT(RMN(N)) OUT(M' : ') WRITE(REG(N),1) NEWLINE N=N+1 %IF N<=15 %THEN ->27 I=I-128 %FINISH %IF I>64 %THEN %START TR=1 I=I-64 %FINISH %IF I>32 %THEN %START TR=0 I=I-32 %FINISH %IF X'3E00F9FA'>>I&1\=0 %AND (M=16384) %THEN %START NEWLINE OUT(M'** ') WRITE(SP,1) SPACES(4) OUT(M'EFFE') ; OUT(M'CTIV') ; OUT(M'E AD') ; OUT(M'DR ?') WRITE(M,1) DUMP %STOP ; %FINISH %IF I=0 %THEN %START NEWLINE OUT(M'** ') WRITE(SP,1) SPACES(4) OUT(M'INST') ; OUT(M'RUCT') ; OUT(M'ION?') DUMP %STOP ; %FINISH %IF TR#0 %THEN %START NEWLINE WRITE(SP,3) SPACES(2) OUT(IMN(I)) SPACES(2) OUT(RMN(J)) WRITE(M,4) SPACES(6) %FINISH ->INS(I) INS(1):! LOAD REG(J)=S(M) SP=SP+1 ->24 INS(2):! LDA REG(J)=M SP=SP+1 ->24 INS(3):! ADD REG(J)=REG(J)+S(M) SP=SP+1 ->24 INS(4):! SUB REG(J)=REG(J)-S(M) SP=SP+1 ->24 INS(5):! MLT REG(J)=REG(J)*S(M) SP=SP+1 ->24 INS(6):! DIV REG(J)=REG(J)//S(M) SP=SP+1 ->24 INS(7):! EXP REG(J)=REG(J)**S(M) SP=SP+1 ->24 INS(8):! STR S(M)=REG(J) SP=SP+1 ->24 INS(9):! NEG REG(J)=-REG(J) SP=SP+1 ->24 INS(10):! NOT REG(J)=\REG(J) SP=SP+1 ->24 INS(11):! SHL REG(J)=REG(J)<24 INS(12):! SHR REG(J)=REG(J)>>S(M) SP=SP+1 ->24 INS(13):! AND REG(J)=REG(J)&S(M) SP=SP+1 ->24 INS(14):! OR REG(J)=REG(J)!S(M) SP=SP+1 ->24 INS(15):! XOR REG(J)=REG(J)!!S(M) SP=SP+1 ->24 INS(16):! BAL REG(J)=SP+1 SP=M ->24 INS(17):! B SP=M ->24 INS(18):! BZ %IF REG(J)=0 %THEN SP=M %ELSE SP=SP+1 ->24 INS(19):! BNZ %IF REG(J)\=0 %THEN SP=M %ELSE SP=SP+1 ->24 INS(20):! BG %IF REG(J)>0 %THEN SP=M %ELSE SP=SP+1 ->24 INS(21):! BNG %IF REG(J)<=0 %THEN SP=M %ELSE SP=SP+1 ->24 INS(22):! BL %IF REG(J)<0 %THEN SP=M %ELSE SP=SP+1 ->24 INS(23):! BNL %IF REG(J)>=0 %THEN SP=M %ELSE SP=SP+1 ->24 INS(24):! STOP NEWLINE OUT(M'STOP') ; OUT(M'PED ') ; OUT(M'AT ') WRITE(SP,1) %STOP INS(25):! ADDF REAL(ADDR(REG(J)))=REAL(ADDR(REG(J)))+REAL(ADDR(S(M))) SP=SP+1 ->24 INS(26):! SUBF REAL(ADDR(REG(J)))=REAL(ADDR(REG(J)))-REAL(ADDR(S(M))) SP=SP+1 ->24 INS(27):! MLTF REAL(ADDR(REG(J)))=REAL(ADDR(REG(J)))*REAL(ADDR(S(M))) SP=SP+1 ->24 INS(28):! DIVF REAL(ADDR(REG(J)))=REAL(ADDR(REG(J)))/REAL(ADDR(S(M))) SP=SP+1 ->24 INS(29):! EXPF REAL(ADDR(REG(J)))=REAL(ADDR(REG(J)))**S(M) SP=SP+1 ->24 INS(30):! NEGF REAL(ADDR(REG(J)))=-REAL(ADDR(REG(J))) SP=SP+1 ->24 INS(31):! FLT REAL(ADDR(REG(J)))=REG(J) SP=SP+1 ->24 IOR(0):! READ SYMBOL READ SYMBOL(S(S(REG(14)+10))) SP=REG(13) ->24 IOR(1):! NEXT SYMBOL REG(15)=NEXT SYMBOL SP=REG(13) ->24 IOR(2):! SKIP SYMBOL SKIP SYMBOL SP=REG(13) ->24 IOR(3):! PRINT SYMBOL PRINT SYMBOL(S(REG(14)+10)) SP=REG(13) ->24 IOR(4):! SPACE SPACE SP=REG(13) ->24 IOR(5):! SPACES SPACES(S(REG(14)+10)) SP=REG(13) ->24 IOR(6):! NEWLINE NEWLINE SP=REG(13) ->24 IOR(7):! NEWLINES NEWLINES(S(REG(14)+10)) SP=REG(13) ->24 IOR(8):! NEWPAGE NEWPAGE SP=REG(13) ->24 IOR(9):! READ READ(S(S(REG(14)+10))) SP=REG(13) ->24 IOR(10):! WRITE WRITE(S(REG(14)+10),S(REG(14)+11)) SP=REG(13) ->24 %ROUTINE READMN(%INTEGERNAME MN,NEXT) %INTEGER I,J,K 1: READ SYMBOL(I) %IF I=' ' %THEN ->1 %IF I<'A' %OR I>'Z' %THEN %START MN=0 NEXT=I %RETURN ; %FINISH J=1 2: READ SYMBOL(K) %IF J=4 %OR K<'0' %OR (K>'9' %AND K<'A') %OR K>'Z' %THEN %START MN=I NEXT=K %RETURN ; %FINISH I=I<<8!K J=J+1 ->2 %END %ROUTINE FAULT(%INTEGER I,J,K,L) OUT(M'*** ') WRITE(SP,4) SPACES(6) OUT(I) OUT(J) OUT(K) OUT(L) NEWLINE F=F+1 %END %ROUTINE OUT(%INTEGER I) PRINT SYMBOL(I>>24) PRINT SYMBOL(I>>16&255) PRINT SYMBOL(I>>8&255) PRINT SYMBOL(I&255) %END %ROUTINE DUMP %INTEGER I,J NEWLINE I=0 1: OUT(RMN(I)) OUT(M' : ') WRITE(REG(I),1) NEWLINE I=I+1 %IF I<=15 %THEN ->1 %IF REG(14)2 %END %ENDOFPROGRAM