%EXTERNALROUTINESPEC DEFINE(%STRING (63)S)
%SYSTEMROUTINESPEC OPENIN(%INTEGER CHANNEL, %STRING (8)S)
%SYSTEMROUTINESPEC SELIN(%INTEGER CHANNEL)
%SYSTEMROUTINESPEC READ BYTE(%INTEGERNAME N)
%SYSTEMROUTINESPEC TERMIN(%INTEGER CHANNEL)
!!
%DYNAMICINTEGERFNSPEC TIME40(%INTEGER IN)
%DYNAMICINTEGERFNSPEC TIME03(%INTEGER IN)
%EXTERNALINTEGERFNSPEC TIME45(%INTEGER IN)
!!


%EXTERNALROUTINE RECODE(%STRING (63)S)
      %INTEGER LNUM, CURRENT LINE, ADDR, CA, SI, TIMER, T, TOTT
      %STRING (45)SOURCE, OBJECT, OUTPUT, TYPES
      %STRING (100) INLINE


      !!
      !!
      %INTEGERFN ITEM
         %OWNINTEGERARRAY BUF(1:5000)
         %INTEGER S, L1, L2
         %OWNINTEGER BP, LEFT


         %ROUTINE GET(%INTEGERNAME N)
            %INTEGER S
            READ BYTE(N);  READ BYTE(S)
            N = N+S << 8
         %END 
         BP = BP+1;  LEFT = LEFT-1;  ADDR = ADDR+2
         %IF LEFT <= 0 %START 
            READ BYTE(S) %UNTIL S = 1;  READ BYTE(S)
            GET(LEFT);  GET(ADDR)
            LEFT = (LEFT-6)//2
            %STOPIF LEFT <= 0
            %CYCLE S = 1, 1, LEFT
               GET(BUF(S))
            %REPEAT 
            READ BYTE(S)
            READ BYTE(L1);  READ BYTE(L2)
            CURRENT LINE = L2 << 6+L1 >> 1
            BP = 1
         %FINISH 
         %RESULT = BUF(BP)
      %END 


      %ROUTINE POCT(%INTEGER N)
         %INTEGER J
         %CYCLE J = 15, -3, 0
            PRINT SYMBOL(N >> J&7+'0')
         %REPEAT 
      %END 


      %ROUTINE UNCODE(%INTEGER NN)
         %CONSTINTEGER PC = 7
         %CONSTINTEGER REG
         %CONSTINTEGER INDEX = 6
         %CONSTINTEGER AUTO I = 2
         %CONSTINTEGER AUTO D = 4
         %INTEGER SM, SR, SD, DM, DR, DD
         %CONSTSTRING (3) %ARRAY RX(0:7) = 'R0', 'R1', 'R2', 'R3',  %C
           'GLA', 'LNB', 'SP', 'PC'
         %INTEGER A, V, SPAC
         %SWITCH TT(-1:7)
         %STRING (4)OP
         %INTEGER T
         %OWNINTEGER HERE, LINE
         %OWNINTEGERARRAY CUR LINE(0:3)
         %OWNINTEGERARRAY PEND(0:3)
         %OWNINTEGER P, Q, N


         %ROUTINE SPOCT(%INTEGER N)
            %HALFINTEGER NN


            %ROUTINE P(%INTEGER N)
               P(N >> 3) %IF N&(\7) # 0
               PRINT SYMBOL(N&7+'0')
            %END 
            NN <- N
            %IF NN < 0 %START 
               NN <- -NN
               PRINT SYMBOL('-') %IF NN > 0
            %FINISH 
            P(NN)
         %END 


         %INTEGERFN NEXT
            %INTEGER A
            N = N-1;  Q = Q+1;  A = PEND(Q&3)
            %IF TIMER&1 = 0 %START
               SPACE;  POCT(A)
            %FINISH
            SPAC = SPAC-7
            %RESULT = A
         %END 


         %ROUTINE ADDR(%INTEGER V, %INTEGERNAME REG, MODE, DISP)
            MODE = V >> 3;  REG = V&7
            DISP = NEXT %IF MODE >= INDEX %OR (REG = PC %AND MODE >= 2)
         %END 


         %ROUTINE OPERAND(%INTEGER MODE, BASE, DISP)
            %INTEGER M
            %IF BASE = PC %AND MODE > 1 %START 
               PRINTSYMBOL('@') %IF MODE&1 # 0
               PRINTSYMBOL('#') %IF MODE < AUTO D
               SPOCT(DISP)
            %FINISHELSESTART 
               PRINTSYMBOL('@') %IF MODE&1 # 0 %AND MODE # 1
               M = MODE&6
               PRINTSYMBOL('-') %IF M = AUTO D
               SPOCT(DISP) %IF M = INDEX
               PRINTSYMBOL('(') %UNLESS MODE = REG
               PRINTSTRING(RX(BASE))
               PRINTSYMBOL(')') %UNLESS MODE = REG
               PRINTSYMBOL('+') %IF M = AUTO I
            %FINISH 
         %END 


         %ROUTINE GET LINE
            %INTEGER S
            LNUM = LNUM+1
            WRITE(LNUM, 4);  SPACES(2)
            %IF TIMER&1 = 0 %START
            %UNTIL S = NL %CYCLE 
               READSYMBOL(S);  PRINTSYMBOL(S)
            %REPEAT 
            %FINISH %ELSE %START
               INLINE = ''
               %UNTIL S = NL %CYCLE
                  READSYMBOL(S)
                  INLINE = INLINE.TOSTRING(S)
               %REPEAT
            %FINISH
         %END 


         %ROUTINE FIND(%INTEGER V)
            %CONSTSTRING (4) %ARRAY TEXT(1:84) = 'HALT', 'WAIT',  %C
              'RTI ', 'BPT ', 'IOT ', 'RSET', 'RTT ', 'NOP ', 
            'CC  ', 'JMP ', 'RTS ', 'SPL ', 'SWAB', 'BR  ', 'BNE ',  %C
              'BEQ ', 
            'BGE ', 'BLT ', 'BGT ', 'BLE ', 'JSR ', 'CLR ', 'COM ',  %C
              'INC ', 
            'DEC ', 'NEG ', 'ADC ', 'SBC ', 'TST ', 'ROR ', 'ROL ',  %C
              'ASR ', 
            'ASL ', 'MARK', 'MFPI', 'MTPI', 'SXT ', 'MOV ', 'CMP ',  %C
              'BIT ', 
            'BIC ', 'BIS ', 'ADD ', 'MUL ', 'DIV ', 'ASH ', 'ASHC',  %C
              'XOR ', 
            'FADD', 'FSUB', 'FMUL', 'FDIV', 'SOB ', 'BPL ', 'BMI ',  %C
              'BHI ', 
            'BLOS', 'BVC ', 'BVS ', 'BCC ', 'BCS ', 'EMT ', 'TRAP',  %C
              'CLRB', 
            'COMB', 'INCB', 'DECB', 'NEGB', 'ADCB', 'SBCB', 'TSTB',  %C
              'RORB', 
            'ROLB', 'ASRB', 'ASLB', 'MFPD', 'MTPD', 'MOVB', 'CMPB',  %C
              'BITB', 
            'BICB', 'BISB', 'SUB ', 'REAL'
            %CONSTINTEGERARRAY MASK(1:84) = K'177777'(8), K'177740', %C
              K'177700', K'177770'(2), K'177700', 
            K'177400'(7), K'177000', K'177700'(8), K'177700'(8), K %C
              '170000'(6), 
            K'177000'(5), K'177770'(4), K'177000', K'177400'(5), K %C
              '177400'(5), 
            K'177700'(7), K'177700'(7), K'170000'(7)
            %CONSTINTEGERARRAY VALUE(1:84) = K'000000', K'000001', K %C
              '000002', K'000003', K'000004', K'000005', 
            K'000006', K'000240', K'000240', K'000100', K'000200', K %C
              '000230', 
            K'000300', K'000400', K'001000', K'001400', K'002000', K %C
              '002400', 
            K'003000', K'003400', K'004000', K'005000', K'005100', K %C
              '005200', 
            K'005300', K'005400', K'005500', K'005600', K'005700', K %C
              '006000', 
            K'006100', K'006200', K'006300', K'006400', K'006500', K %C
              '006600', 
            K'006700', K'010000', K'020000', K'030000', K'040000', K %C
              '050000', 
            K'060000', K'070000', K'071000', K'072000', K'073000', K %C
              '074000', 
            K'075000', K'075010', K'075020', K'075030', K'077000', K %C
              '100000', 
            K'100400', K'101000', K'101400', K'102000', K'102400', K %C
              '103000', 
            K'103400', K'104000', K'104400', K'105000', K'105100', K %C
              '105200', 
            K'105300', K'105400', K'105500', K'105600', K'105700', K %C
              '106000', 
            K'106100', K'106200', K'106300', K'106500', K'106600', K %C
              '110000', 
            K'120000', K'130000', K'140000', K'150000', K'160000', K %C
              '170000'
            %CONSTINTEGERARRAY TYPE(1:84) = 0, 0, 0, 0, 0, 0, 0, 0, %C
              7, 1, 3, 3, 1, 4, 4, 4, 4, 4, 4, 4, 5, 1, 
            1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 6, 1, 1, 1, 2, 2, 2, 2, %C
              2, 2, 5, 
            5, 5, 5, 5, 3, 3, 3, 3, 6, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, %C
              1, 1, 1, 
            1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 0
            %INTEGER J
            T =- 1
            %CYCLE J = 1, 1, 84
               %IF V&MASK(J) = VALUE(J) %START 
                  OP = TEXT(J);  T = TYPE(J)
               %FINISH 
            %REPEAT 
         %END 
         N = N+1;  P = P+1;  PEND(P&3) = NN;  DD = 0;  SD = 0
         CUR LINE(P&3) = CURRENT LINE
         %RETURNIF N < 3
         SPAC = 24
         %IF SOURCE # '' %START
            LINE = CUR LINE((Q+1)&3)
            %IF LINE # HERE %START 
               HERE = LINE
               %UNTIL LNUM >= HERE %CYCLE
                  %IF INLINE # '' %START
                     SPACES(3);  POCT(CA-4)
                     PRINTSTRING(' (')
                     PRINT(TOTT/100, 2, 2)
                     PRINTSTRING(   ')  ')
                     PRINTSTRING(INLINE)
                     INLINE = ''; TOTT = 0
                  %FINISH
                  GET LINE 
               %REPEAT
            %FINISH 
         %FINISH
         %IF TIMER&1 = 0 %START
            SPACES(5);  POCT(CA-4);  SPACE
         %FINISH
         A = NEXT;  FIND(A)
         DM =- 1;  SM =- 1
         -> TT(T)
TT(2):   ADDR(A >> 6&K'77', SR, SM, SD)
TT(1):   ADDR(A&K'77', DR, DM, DD);  -> PUT
TT(5):   ADDR(A&K'77', DR, DM, DD)
         SM = 0;  SD = 0;  SR = A >> 6&7;  -> PUT
TT(3):   DM = 0;  DR = A&7;  -> PUT
TT(4):   V = A&K'377';  V = V!K'177400' %IF V&K'200' # 0
         DM = INDEX;  DR = PC;  DD = V*2+CA-2;  -> PUT
TT(6):   DM = INDEX;  DR = PC;  DD = A&K'77';  -> PUT
TT(7):   SM = INDEX;  SR = PC;  SD = A&K'17'
TT(0):   
PUT:
         %IF TIMER&2 = 2 %START
            T = TIME03(A)
         %FINISHELSESTART
            %IF TIMER&4 = 4 %THEN T = TIME45(A) %ELSE T = TIME40(A)
         %FINISH
         TOTT = TOTT+T
         %IF TIMER & 1 # 0 %THEN %RETURN
         SPACES(SPAC)
         PRINTSYMBOL('(')
         PRINT(T/100, 2, 2)
         PRINTSTRING(      ')  ')
         PRINTSTRING(OP)
         %UNLESS (SM =- 1 %AND DM =- 1) %OR T = 0 %START 
            SPACES(2)
            OPERAND(SM, SR, SD) %UNLESS SM < 0
            %IF DM >= 0 %START 
               PRINTSTRING(', ') %UNLESS SM < 0
               OPERAND(DM, DR, DD)
            %FINISH 
         %FINISH 
TT(-1):  
         NEWLINE
      %END 
      INLINE = '';  TOTT=0
      %UNLESS S-> SOURCE.(",").OBJECT.("/").OUTPUT %START 
         PRINTSTRING('PARAMETERS?');  %STOP 
      %FINISH 
      TIMER = 0
      %IF OUTPUT->OUTPUT.(":").TYPES %START
         %IF TYPES = 'NOCODE' %THEN TIMER=1
         %IF TYPES = 'LSI11' %THEN TIMER=2
         %IF TYPES = 'LSI11NOCODE' %THEN TIMER = 3
         %IF TYPES = "45" %THEN TIMER=4
         %IF TYPES = "45NOCODE" %THEN TIMER = 5
      %FINISH
      %IF SOURCE#'' %START
         DEFINE('STREAM71,'.SOURCE)
         SELECT INPUT(71)
      %FINISH
      OPENIN(77, OBJECT)
      DEFINE('STREAM78,'.OUTPUT.',1000')
      SELIN(77);  SELECTOUTPUT(78)
      PRINTSTRING('SOURCE: '); PRINTSTRING(SOURCE)
      NEWLINE
      PRINTSTRING('OBJECT: '); PRINTSTRING(OBJECT)
      NEWLINES(5)
      CA = 0;  CURRENT LINE = 0;  LNUM = 0;  ADDR = 0
      %IF SOURCE # '' %START
         PRINTSTRING('HEADER:  ');  POCT(ITEM)
         SPACE;  POCT(ITEM)
         SPACE;  POCT(ITEM)
         NEWLINE
         %CYCLE 
            SI = ITEM
            %IF ADDR = CA %START 
               CA = ADDR
               UNCODE(SI)
               CA = CA+2
            %FINISH 
         %REPEAT 
         UNCODE(0);  UNCODE(0);            ! flush buffer
      %FINISH %ELSE %START
         !! JUST AN OBJECT FILE
         %CYCLE
            SI = ITEM
               CA = ADDR
               UNCODE(SI)
               CA = CA+2
         %REPEAT
         UNCODE(0); UNCODE(0)
      %FINISH
%END 
%ENDOFFILE