%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 K<LP %THEN ->4
        %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 L<LP %THEN ->12
        %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 J<LP %THEN ->20
     %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 M<RP %THEN ->22
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<CT %OR 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)<<S(M)
     SP=SP+1
     ->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)<ST %THEN %START
        OUT(M'STP<')
        OUT(M'ST: ')
        NEWLINE
        %RETURN ; %FINISH
     I=ST
     J=0
2:   %IF J=0 %THEN %START
        NEWLINE
        WRITE(I,5)
        SPACES(4)
        %FINISH
     WRITE(S(I),6)
     I=I+1
     J=J+1
     %IF J=8 %THEN J=0
     %IF I<=REG(14) %THEN ->2
%END
%ENDOFPROGRAM