%BEGIN;  !DECODE
%OWNINTEGER POS,LINE,ICOUNT,DCOUNT,LCOUNT,SECTION
%OWNINTEGER LMAX,TMAX,TEXT,FIRST
%INTEGER CODE,N1,N2,N3,N4,NUMS
%OWNINTEGERARRAY TAB(1:50) = %C
    40_SZL,8_741400, 40_SPA,8_741100, 40_SNA,8_741200, 40_SKP,8_741000,
    40_SNL,8_740400, 40_SMA,8_740100, 40_SZA,8_740200, 40_STL,8_744002,
    40_RCL,8_744010, 40_RCR,8_744020, 40_CLL,8_744000, 40_CLC,8_750001,
    40_LAS,8_750004, 40_CLA,8_750000, 40_CMA,8_740001, 40_CML,8_740002,
    40_RTL,8_742010, 40_RTR,8_742020, 40_RAL,8_740010, 40_RAR,8_740020,
    40_OAS,8_740004, 40_HLT,8_740040, 40_NOP,8_740000, 0(*)
%INTEGERARRAY LVAL(1:1000)
%SWITCH C(0:47)

%ROUTINE READ ITEM
%ROUTINE READ(%INTEGERNAME N)
%INTEGER SHIFT,SIGN
    N = 0;  SHIFT = 0;  SIGN = 0
L1:  READ SYMBOL(CODE)
    %IF CODE = '-' %THEN %START
        SIGN = 1;  ->L1
    %FINISH
    %IF '0' <= CODE <= '?' %THEN %START
        N = (CODE&15)<<SHIFT+N
        SHIFT = SHIFT+4
        ->L1
    %FINISH
    N = -N %IF SIGN # 0;  NUMS = NUMS+1
%END
    NUMS = 0
L1:  READ(N1)
    %RETURN %UNLESS CODE = ' '
    N4 = N3;  N3 = N2;  N2 = N1
    ->L1
%END

%ROUTINE PSYM(%INTEGER K)
    PRINT SYMBOL(K);  POS = POS+1
%END

%ROUTINE WRITE(%INTEGER V,P)
%INTEGER SIGN,D
%ROUTINE TRY(%INTEGER N)
    ->L3 %IF N = -1
    D = 0
L1:  ->L2 %IF V+N < 0;  V = V+N;  D = D+1;  ->L1
L2:  ->L4 %IF SIGN = 0 %OR D # 0
    P = P+1
    %RETURN
L3:  D = V
L4:  %IF SIGN # 0 %THEN %START
        %IF P-6 > 0 %THEN %START
            SPACES(P-6);  POS = POS+P-6
        %FINISH
        PSYM(SIGN) %IF SIGN # ' '
        SIGN = 0
    %FINISH
    PSYM(D+'0')
%END
    SIGN = ' '
    ->L1 %IF V >= 0;  V = -V;  SIGN = '-'
L1:  TRY(-100000);  TRY(-10000);  TRY(-1000)
    TRY(-100);  TRY(-10);  TRY(-1)
%END

%ROUTINE COUNT(%INTEGER K)
    %IF SECTION=0 %THEN ICOUNT=ICOUNT+1 %ELSE DCOUNT=DCOUNT+1
    %IF FIRST = 1 %THEN %START
        SPACES(9-POS) %AND POS = 9 %IF POS < 9
        FIRST = 0
        %RETURN
    %FINISH
    %IF POS <= 60 %THEN %START
        PSYM(';');  PSYM(' ');  PSYM(K) %IF K # 0
    %FINISH %ELSE %START
        NEWLINE;  SPACES(9);  POS = 9
    %FINISH
%END

%ROUTINE PRINT(%INTEGER X)
%INTEGER I,J,K
%ROUTINE PR(%INTEGER D)
    %IF D<10 %THEN D=D+'0' %ELSE D=D-10+'A'
    PRINT SYMBOL(D)
%END
    J = X//40;  K = X-40*J
    I = J//40;  J = J-40*I
    PR(I);  PR(J);  PR(K)
    POS = POS+3
%END

%ROUTINE TRANSLATE(%INTEGER V)
%INTEGER I,J,U
    U = 0
    %CYCLE I = 2,2,50
        J = TAB(I)
        %IF \V&J = 0 %AND \U&J # 0 %THEN %START
            PSYM('!') %IF U # 0 %AND \32767&J = \32767
            PRINT(TAB(I-1))
            U = U!J;  %RETURN %IF U = V
        %FINISH
    %REPEAT
    PSYM(' ');  WRITE(\U&V,4)
%END

%ROUTINE JMS(%INTEGER T)
%SWITCH SUB(4:56)
    ->SUB(T)
SUB(4):  PRINT STRING("MON");  ->P3
SUB(5):  PRINT STRING("NEST"); ->P4
SUB(6):  PRINT STRING("LE"); ->P2
SUB(7):  PRINT STRING("GE"); ->P2
SUB(8):  PRINT STRING("AREF"); ->P4
SUB(9):  PRINT STRING("ADEC"); ->P4
SUB(10): PRINT STRING("SHIFT"); ->P5
SUB(11): PRINT STRING("OR"); ->P2
SUB(12): PRINT STRING("MULT"); ->P4
SUB(13): PRINT STRING("IDIV"); ->P4
SUB(14): PRINT STRING("DIV"); ->P3
SUB(15): PRINT STRING("EXP"); ->P3
SUB(16): PRINT STRING("ENTRY"); ->P5
SUB(17): PRINT STRING("FTRAP"); ->P5
SUB(18): PRINT STRING("DA"); ->P2
SUB(19): PRINT STRING("S");  ->P6
SUB(20): PRINT STRING("BAR");  ->P3
SUB(21): PRINT STRING("BGET");  ->P4
SUB(22): PRINT STRING("BPUT");  ->P4
SUB(23): PRINT STRING("W");  ->P6
SUB(24): PRINT STRING("X");  ->P6
SUB(25): PRINT STRING("PTEXT");  TEXT = 1;  ->P5
SUB(26): PRINT STRING("Z");  ->P6
SUB(27): PRINT STRING("NL");  ->P2
SUB(28): PRINT STRING("ADDR");  ->P4
SUB(29): PRINT STRING("INT"); ->P3
SUB(30): PRINT STRING("SELIN");  ->P5
SUB(31): PRINT STRING("SELOUT");  ->P6
SUB(32): PRINT STRING("READCH");  ->P6
SUB(33): PRINT STRING("PRINCH");  ->P6
SUB(34): PRINT STRING("NSYM");  ->P4
SUB(35): PRINT STRING("RSYM");  ->P4
SUB(36): PRINT STRING("SSYM");  ->P4
SUB(37): PRINT STRING("PSYM");  ->P4
SUB(38): PRINT STRING("NLINE");  ->P5
SUB(39): PRINT STRING("NLINES");  ->P6
SUB(40): PRINT STRING("SPACE");  ->P5
SUB(41): PRINT STRING("SPACES");  ->P6
SUB(42): PRINT STRING("READ");  ->P4
SUB(43): PRINT STRING("WRITE");  ->P5
SUB(44): PRINT STRING("CLIN"); ->P4
SUB(45): PRINT STRING("CLOUT"); ->P5
SUB(46): PRINT STRING("RDA"); ->P3
SUB(47): PRINT STRING("WDA"); ->P3
SUB(48): PRINT STRING("INSTR"); ->P5
SUB(49): PRINT STRING("OUTSTR"); ->P6
SUB(50): PRINT STRING("INDEV"); ->P5
SUB(51): PRINT STRING("OUTDEV"); ->P6
SUB(52): PRINT STRING("INPUT"); ->P5
SUB(53): PRINT STRING("PROMPT"); ->P6
SUB(54): PRINT STRING("FREE"); ->P4
SUB(55): PRINT STRING("TINT");  ->P4
SUB(56): PRINT STRING("OUTPOS");  ->P6
P6: POS = POS+1
P5: POS = POS+1
P4: POS = POS+1
P3: POS = POS+1
P2: POS = POS+2
%END
%ROUTINE TAG(%INTEGER X)
    COUNT(' ')
    PRINT(X)
    PSYM(' ')
    %IF X=40_JMS %AND 4<=N1<=56 %THEN JMS(N1) %ELSE WRITE(N1,1)
%END

%ROUTINE IND(%INTEGER X)
    COUNT(' ')
    PRINT(X)
    PSYM('*');  PSYM(' ')
    %IF X=40_JMS %AND N1=4 %THEN PRINT(40_MON) %ELSE WRITE(N1,1)
%END

%ROUTINE LIT(%INTEGER X)
%INTEGER I
    COUNT(' ')
    PRINT(X)
    PSYM(' ');  PSYM('#')
    WRITE(N1,1)
    LCOUNT = LCOUNT+1
    %CYCLE I = 1,1,LMAX
        %RETURN %IF LVAL(I) = N1
    %REPEAT
    LMAX = LMAX+1;  LVAL(LMAX) = N1
%END

%ROUTINE TRANS OPR(%INTEGER I)
    COUNT(' ')
    TRANSLATE(8_740000+I)
%END
    %OWNINTEGER FAULTLAB=0
    %ON %EVENT 9 %START
      ->L2 %IF FAULTLAB=2
      ->L99 %IF FAULTLAB=99
      PRINT STRING("CODE ERROR!"); NEWLINE; %STOP
    %FINISH

    open input(1, "hdcomp.o15");
    open input(2, "hdcomp.i15");
    select input(1);
    %IF NEXT SYMBOL = ' ' %THEN %START
        READ SYMBOL(CODE) %UNTIL CODE = ';' %OR CODE = NL
    %FINISH
L1:  NEWLINE;  FIRST = 1;  LINE = LINE+1
    WRITE(LINE,3);  SPACES(2);  POS = 5
    FAULTLAB=2;  SELECT INPUT(2)
    READ SYMBOL(CODE) %AND PRINT SYMBOL(CODE) %UNTIL CODE = NL
    SPACES(5)
L2:  FAULTLAB=99;  SELECT INPUT(1)
L3:  READ ITEM
    ->L1 %IF CODE = NL
    ->C(CODE&63)
C(0):  TAG(40_ADA);  ->L3
C(1):  TAG(40_DAC);  ->L3
C(2):  TAG(40_JMS);  ->L3
C(3):  TAG(40_DZM);  ->L3
C(4):  TAG(40_LAC);  ->L3
C(5):  TAG(40_XOR);  ->L3
C(6):  TAG(40_ADD);  ->L3
C(7):  TAG(40_TAD);  ->L3
C(8):  TAG(40_XCT);  ->L3
C(9):  TAG(40_ISZ);  ->L3
C(10): TAG(40_AND);  ->L3
C(11): TAG(40_SAD);  ->L3
C(12): TAG(40_JMP);  ->L3
C(13): TAG(40_EAE);  ->L3
C(14): TAG(40_IOT);  ->L3
C(15): TRANS OPR(N1);  ->L3
C(16): TAG(40_ADR);  ->L3
C(17): IND(40_DAC);  ->L3
C(18): IND(40_JMS);  ->L3
C(19): IND(40_DZM);  ->L3
C(20): IND(40_LAC);  ->L3
C(21): IND(40_XOR);  ->L3
C(22): IND(40_ADD);  ->L3
C(23): IND(40_TAD);  ->L3
C(24): IND(40_XCT);  ->L3
C(25): IND(40_ISZ);  ->L3
C(26): IND(40_AND);  ->L3
C(27): IND(40_SAD);  ->L3
C(28): IND(40_JMP);  ->L3
C(29): TAG(40_DAD);  ->L3
C(30): TAG(40_C30);  ->L3
C(31): TAG(40_LAD);  ->L3
C(32): TAG(40_C32);  ->L3
C(33): PSYM('!');  ->L4
C(34): TAG(40_C34);  ->L3
C(35): COUNT(0)
    %IF TEXT = 0 %THEN WRITE(N1,1) %ELSE %START
        PSYM('''');  PSYM(N1>>7&127)
        PSYM(N1&127) %IF N1&127 # 0;  PSYM('''')
        TEXT = 0 %IF N1 < 0
    %FINISH
    ->L3
C(36): LIT(40_LAC);  ->L3
C(37): LIT(40_XOR);  ->L3
C(38): LIT(40_ADD);  ->L3
C(39): LIT(40_TAD);  ->L3
C(40): PSYM('(');  POS = POS+1;  ->L3
C(41): PSYM(')');  POS = POS+1;  WRITE(N1,1);  ->L3
C(42): LIT(40_AND);  ->L3
C(43): LIT(40_SAD);  ->L3
C(44): PSYM(',');  ->L4
C(45): TAG(40_C45);  ->L3
C(46): NEWLINE %AND POS = 0 %IF POS > 5
    SPACES(5-POS);  POS = 5
    WRITE(N1,1)
    %IF NUMS = 1 %THEN %START
        PSYM(':');  SPACES(9-POS);  POS = 9
    %FINISH %ELSE %START
        PSYM('_');  WRITE(N2,1);  PSYM(':')
    %FINISH
    FIRST = 1
    TMAX = N1 %IF TMAX < N1 < 210
    ->L3
C(47): PSYM('/');  SECTION = SECTION!!1;  ->L3
L4:  WRITE(N1,1);  WRITE(N2,7) %IF N2 # 0
    WRITE(N3,7) %IF N3 # 0
    WRITE(N4,7) %IF N4 # 0
    ->L3
L99: PRINT STRING("$$$$$")
    NEWLINES(2)
    PRINT STRING("INSTRUCTIONS:");  WRITE(ICOUNT,9);  NEWLINE
    PRINT STRING("DATA SLOTS:");  WRITE(DCOUNT,11);  NEWLINE
    PRINT STRING("LITERALS:"); WRITE(LCOUNT,13);  NEWLINE
    PRINT STRING("DISTINCT LITERALS:");  WRITE(LMAX,4);  NEWLINE
    PRINT STRING("MAXIMUM TAG:");  WRITE(TMAX,10);  NEWLINE
    NEWLINE
%ENDOFPROGRAM