! RECODE FOR IMP PROGRAMS
! THIS PROGRAM TAKES THE THIRD PASS
! OUTPUT OF THE IMP COMPILER
! AND MAKES A RECODE IN ASSEMBLY
! OF EVERY IMP SOURCE LINE
! AUTHOR K. STRAATMAN
! MATHEMATISCH INSTITUUT
! RIJKSUNIVERSITEIT TE GRONINGEN
! POSTBUS 800, GRONINGEN, THE NETHERLANDS
! 24 JAN 1978
! COMMAND: RECODE SOURCE OY / OUTPUT

%EXTERNALROUTINE CODE11(%STRING(63) FILE)
   %CONSTINTEGER MAX SPECS = 100
   %OWNINTEGER MAIN PROG = 0
   %STRING(63) SOURCE FILE, OBJECT FILE,OUTPUT,SDISP
%INTEGER DISP,I

   %EXTERNALINTEGERFNSPEC EXIST(%STRING(63) FILE)
   %EXTERNALROUTINESPEC DEFINE(%STRING(63) S)
   %EXTERNALINTEGERFNSPEC TIME40(%INTEGER INST)
   %CONSTINTEGER SOURCE = 1, OY = 2
   %CONSTINTEGER PAGE = 62

   %OWNINTEGER LEFT = PAGE-3-12
   %ROUTINE SHOW TIME(%INTEGER INST)
     %INTEGER J,K
     J = TIME40(INST)
      PRINT(J/100, 2, 1)
   %END
   %ROUTINESPEC HEADER
   %ROUTINESPEC RECODE FILE
   %ROUTINESPEC RECODE GLAP
   %ROUTINESPEC PRINT OCTAL(%INTEGER N)
   %INTEGERFNSPEC WORD
   %CONSTSTRING(3) TAB = "   "
   %STRING(10)%ARRAY XTEXT(1:MAX SPECS)
   %CONSTINTEGER MAXGLAP =8191
   %INTEGER GLAP LENGTH
   %INTEGERARRAY GLAP(0:MAX GLAP)
   %BYTEINTEGERARRAY GMARK(0:MAXGLAP)
   %CONSTINTEGERARRAY DOINSTR(1:12) = %C
                         K'010000',K'020000',K'030000',K'040000',
                         K'050000',K'060000',K'110000',K'120000',
                         K'130000',K'140000',K'150000',K'160000'
   %CONSTSTRING(5)%ARRAY DOMNEM(1:12) = %C
                         "mov  ","cmp  ","bit  ","bic  ","bis  ",
                         "add  ","movb ","cmpb ","bitb ","bicb ",
                         "bisb ","sub  "
 
   %CONSTINTEGERARRAY SOINSTR(1:30) = %C
                         K'005000',K'005100',K'005200',
                         K'005300',K'005400',
                         K'005500',K'005600',
                         K'005700',K'006000',
                         K'006100',K'006200',
                         K'006300',K'006400',
                         K'006500',K'006600',
                         K'006700',K'105000',
                         K'105100',K'105200',
                         K'105300',K'105400',
                         K'105500',K'105600',
                         K'105700',K'106000',
                         K'106100',K'106200',
                         K'106300',K'106500',
                         K'106600'
 
   %CONSTSTRING(5)%ARRAY SOMNEM (1:30) = %C
                         "clr  ",
                         "com  ","inc  ",
                         "dec  ","neg  ",
                         "adc  ","sbc  ",
                         "tst  ","ror  ",
                         "rol  ","asr  ",
                         "asl  ","mark ",
                         "mfpi ","mtpi ",
                         "sxt  ","clrb ",
                         "comb ","incb ",
                         "decb ","negb ",
                         "adcb ","sbcb ",
                         "tstb ","rorb ",
                         "rolb ","asrb ",
                         "aslb ","mfpd ",
                         "mtpd "
 
   %CONSTINTEGERARRAY BRINSTR(1:15) = %C
                         K'000400',
                         K'001000',K'001400',
                         K'002000',K'002400',
                         K'003000',K'003400',
                         K'100000',K'100400',
                         K'101000',K'101400',
                         K'102000',K'102400',
                         K'103000',K'103400'
 
   %CONSTSTRING(5)%ARRAY BRMNEM(1:15)  = %C
                         "br   ","bne  ","beq  ","bge  ","blt  ","bgt  ",
                         "ble  ","bpl  ","bmi  ","bhi  ","blos ","bvc  ",
                         "bvs  ","bhis ","blo  "
 
   %CONSTINTEGERARRAY EISINSTR(1:6) = %C
                         K'070000',K'071000',K'072000',K'073000',
                         K'074000',K'077000'
 
   %CONSTSTRING(5)%ARRAY EISMNEM(1:6) = %C
                         "mul  ","div  ","ash  ","ashc ","xor  ","sob  "
 
   %CONSTSTRING(5)%ARRAY MISCINSTR(0:6) = "halt ","wait ","rti  ","bpt  ",
                                     "iot  ","reset","rtt  "
 
   %CONSTSTRING(3)%ARRAY REGISTER(0:7) = "r0","r1","r2","r3","lnb","ds",
                                         "sp","pc"
 
   %CONSTSTRING(5)%ARRAY FLPT(0:3) ="fadd ","fsub ","fmul ","fdiv "
 
      %ROUTINE REPLACE(%STRING(63)%NAME FILE, %STRING(4) EXT)
         %STRING(63) GROT, NEW
         %RETURN %IF EXIST(FILE) # 0
         %UNLESS FILE -> NEW.("#").GROT %START
            NEW = FILE.EXT
            FILE = NEW %AND %RETURN %IF EXIST(NEW) # 0
         %FINISH
         SELECT OUTPUT(0)
         PRINTSTRING(FILE." does not exist");  NEWLINE
         %STOP
      %END
   %ON %EVENT 9 %START
      RECODE GLAP
      %STOP
   %FINISH
   OUTPUT = ".OUT" %UNLESS FILE -> FILE.("/").OUTPUT
     %IF FILE ->SOURCE FILE.(",").OBJECT FILE.(",").SDISP %START
        DISP=0
       I=1
        %WHILE I<=LENGTH(SDISP)  %CYCLE
           DISP=(DISP<<3)+(CHARNO(SDISP,I)-'0')
           I=I+1
        %REPEAT
         FILE=SOURCE FILE.",".OBJECT FILE
      %FINISH %ELSE DISP=0
      %UNLESS FILE -> SOURCE FILE.(",").OBJECT FILE %START
         SOURCE FILE = FILE
         OBJECT FILE = FILE %UNLESS FILE -> OBJECT FILE.("#").FILE
         OBJECT FILE = OBJECT FILE."#REL"
      %FINISH
      REPLACE(SOURCE FILE, "#IMP")
      REPLACE(OBJECT FILE, "#REL")
   DEFINE("ST1,".SOURCE FILE)
   DEFINE("ST2,".OBJECT FILE)
   DEFINE("ST3,".OUTPUT)

   SELECT INPUT(OY)
   SELECTOUTPUT(3)
   HEADER
   RECODE FILE
   RECODE GLAP
   %STOP

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

%ROUTINE TEST PAGE
   LEFT = LEFT-1
   %IF LEFT <= 0 %START
      LEFT = PAGE
      PRINTCH(12)
   %FINISH
%END
%ROUTINE NEWLINE
   PRINTCH(NL)
   TEST PAGE
%END
%ROUTINE HEADER
   %INTEGER K, N

   %ROUTINE DUMP EXTERNAL(%INTEGER TYPE)
      %STRING(10) X
      %INTEGER S, J
      %IF TYPE = 0 %START;       !DEFINITION
         SPACE;  PRINT OCTAL(WORD+DISP)
      %FINISH %ELSE %START
         SPACES(4)
         N = N+1;  WRITE(N, 2);  PRINTSTRING(" =")
      %FINISH
      READCH(S);  WRITE(S, 1)
      SPACE
      READCH(J);                 !LENGTH
      X = ""
      %WHILE J > 0 %CYCLE
         J = J-1
         READCH(S)
         X = X.TOSTRING(S)
      %REPEAT
      PRINTSTRING(X)
      NEWLINE
      %IF X = "$GO" %THEN MAIN PROG = 40
      XTEXT(N) = X %IF TYPE # 0 %AND N <= MAX SPECS
   %END

   K = WORD;   !NUMBER OF MODULES (1?)
   K = WORD
   %IF K # 0 %START
      NEWLINE
      PRINTSTRING("Entry points");  NEWLINE
      PRINTSTRING("============");  NEWLINE;  NEWLINE
      %WHILE K > 0 %CYCLE
         K = K-1;  DUMP EXTERNAL(0)
      %REPEAT
      NEWLINE
   %FINISH
   N = 0
   K = WORD
   %IF K # 0 %START
      PRINTSTRING("External references");  NEWLINE
      PRINTSTRING("===================");  NEWLINE;  NEWLINE
      %WHILE K > 0 %CYCLE
         K = K-1
         DUMP EXTERNAL(1)
      %REPEAT
      NEWLINE
   %FINISH

   K=WORD
   PRINTSTRING("code length ")
   WRITE(K,5)
   SPACES(2)
   PRINT CH('('); PRINT OCTAL(K)
   PRINT CH(')')
   NEWLINE
   GLAP LENGTH = WORD
   PRINTSTRING("glap length ")
   WRITE(GLAP LENGTH,5)
   SPACES(2)
   PRINT CH('('); PRINT OCTAL(GLAP LENGTH)
   PRINT CH(')')
   NEWLINE
   GLAP LENGTH = GLAP LENGTH>>1
   %IF GLAP LENGTH > MAXGLAP %START
     SELECT OUTPUT(0)
     PRINTSTRING("glap array too short")
     NEWLINE; %STOP
   %FINISH
   NEWLINE
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE PRINT OCTAL(%INTEGER N)
   %INTEGER I
   %CYCLE I=15,-3,0
     PRINT CH('0' +(N>>I&7))
   %REPEAT
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

%ROUTINE EXPAND(%INTEGER N)
   %INTEGER M
   %IF N = 0 %THEN SPACES(2) %ELSE %START
      M = N>>8;  M = ':' %IF M = 0
      N = N&255;  N = ' ' %IF N = 0
      PRINTSYMBOL(M);  PRINTSYMBOL(N)
   %FINISH
%END
%ROUTINE RECODE FILE

   %ROUTINESPEC RECODE BLOK
      %INTEGER GA, TYPE
      %INTEGER I,J,K,BLOKL,PC

      GA = -1
      %CYCLE
         RECODE BLOK
         %RETURN %IF TYPE = 8
      %REPEAT
! FORMAL END OF RECODE FILE

%ROUTINE RECODE BLOK

   %INTEGERFNSPEC CLASS(%INTEGER INSTR)
   %ROUTINESPEC OCTAL(%INTEGER NUMBER,FLAG)
   %ROUTINESPEC EVALMODE(%INTEGER MODE)
   %ROUTINESPEC BRDST(%INTEGER OFFSET)
   %ROUTINESPEC EVALCCOD(%INTEGER INSTR)
   %ROUTINESPEC RECODE(%INTEGER INSTR)
   %ROUTINESPEC STORE(%STRING(8) STR)
   %ROUTINESPEC STOREINT(%INTEGER N)
   %INTEGERFNSPEC NEXTWORD

   %CONSTINTEGER CODELENGTH = 511
   %CONSTINTEGER LINELENGTH = 54
   %INTEGER CODEPT,WC,J,K,LINEPT
   %INTEGERARRAY CODE(0:CODELENGTH),WORDS(1:3)
   %INTEGERARRAY MARK(0:CODELENGTH), MARKS(1:3)
   %BYTEINTEGERARRAY LINE(0:LINELENGTH)
   %SWITCH T(1:11)
   %INTEGER S, BLKL, KEY
   %OWNINTEGER OLDLINE = 1, LOAD, LINENUM = 1, NEW PC = -1

   SELECT INPUT(OY)
   BLKL = 0;  KEY = 0
   %CYCLE
      READCH(TYPE);  ->T(TYPE) %IF 1 <= TYPE <= 11
      SELECTOUTPUT(0)
      PRINTSTRING("Corrupt object file")
      WRITE(TYPE, 1);  NEWLINE
      %STOP
T(1):
      S = WORD
      BLKL = BLKL+1;  CODE(BLKL) = S
      MARK(BLKL) = KEY;  KEY = 0
      %CONTINUE
T(2):
      S = WORD
      GA = GA+1
      GLAP(GA) = S;  GMARK(GA) = KEY;  KEY = 0
      %CONTINUE
T(4): K = WORD;    !WHAT
      S = WORD>>1; !WHERE
      GLAP(S) = K
      GMARK(S) = 2
      %CONTINUE
T(7):K = WORD
     KEY = KEY!(K)<<8
     %CONTINUE
T(9):T(10):T(11):
     KEY = KEY! 1<<(TYPE-9)
     %CONTINUE
T(5):NEW PC = WORD;  ->TRY
   %REPEAT
T(8):%RETURN
T(6):LINE NUM = WORD
TRY:
   SELECT INPUT(SOURCE)
   %IF OLDLINE # LINE NUM %START
      %CYCLE J=OLDLINE,1,LINE NUM-1
        %EXIT %IF NEXTCH < 0
        WRITE(J,6)
        SPACE
        %CYCLE
           READCH(K);  PRINTCH(K)
        %EXIT %IF K = NL
        %REPEAT
        TEST PAGE
      %REPEAT
      OLDLINE = LINE NUM
      %FINISH
   CODE(BLKL+1) = 0;  CODE(BLKL+2) = 0
   MARK(BLKL+1) = 10;  MARK(BLKL+2) = 10
   CODEPT = 0
!
   %WHILE CODEPT < BLKL %CYCLE
      LOAD = PC
     WC = 0
     LINEPT = 0 ; LINE(0) = 0
     RECODE(NEXTWORD)
     PRINTOCTAL(LOAD+DISP+MAIN PROG);
     PRINTCH(':');  SHOW TIME(WORDS(1));  SPACE
     %CYCLE J=1,1,WC
       PRINT OCTAL(WORDS(J))
       SPACES(2)
     %REPEAT
     SPACES( (3-WC)<<3+3 ) %IF LINEPT # 0

     J=0
     %WHILE LINE(J) # 0 %CYCLE
       PRINTCH(LINE(J))
       J = J+1
     %REPEAT
     NEWLINE

   %REPEAT
   PC = NEW PC %IF NEW PC # -1
   NEW PC = -1

! FORMAL END OF RECODE BLOK
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

%ROUTINE OCTAL(%INTEGER NUMBER,FLAG)

   %INTEGER J,K
   %SWITCH FL(-1:1)

   K = 15
   -> FL(FLAG)

FL(-1):   %IF NUMBER < 0 %THEN STOREINT('-') %AND NUMBER = -NUMBER
FL(1):    K = K-3 %WHILE NUMBER>> K & 7 = 0 %AND K>0
FL(0):    %CYCLE J=K,-3,0;  STOREINT('0' +(NUMBER>>J&7));  %REPEAT

%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

%ROUTINE RECODE(%INTEGER INSTR)

   %SWITCH INCLASS(1:6)
   %STRING(8) STR
   %SWITCH MISC(0:3)
   %INTEGER I

   -> INCLASS(CLASS(INSTR))

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! DOUBLE OPERAND INSTRUCTIONS !!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

INCLASS(1):
   %CYCLE I=1,1,12

   %IF (INSTR & X'F000') = DOINSTR(I) %START
      STR = DOMNEM(I)
      STORE(STR)
      STORE(TAB)
      EVALMODE(INSTR>>6&X'3F')
      STOREINT(',')
      EVALMODE(INSTR&X'3F')
      %RETURN
    %FINISH
  %REPEAT
  %RETURN

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! SINGLE OPERAND INSTRUCTIONS !!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

INCLASS(2):
  %CYCLE I=1,1,30
    %IF INSTR & X'FFC0' = SOINSTR(I) %START
      STR = SOMNEM(I)
      STORE(STR)
      STORE(TAB)
      %IF SOMNEM(I) = "mark " %THENC
        OCTAL(INSTR&X'3F',1) %ELSEC
        EVALMODE(INSTR&X'3F')
      %RETURN
    %FINISH
  %REPEAT
  %RETURN

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! BRANCH INSTRUCTIONS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

INCLASS(3):
  %CYCLE I=1,1,15
    %IF INSTR & X'FF00' = BRINSTR(I) %START
      STR = BRMNEM(I)
      STORE(STR)
      STORE(TAB)
      BRDST(INSTR&X'FF')
      %RETURN
    %FINISH
  %REPEAT
  %RETURN

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! JSR AND TRAP INSTRUCTIONS !!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

INCLASS(4):
  %IF INSTR & X'8000' = 0 %START
    STORE("jsr     ")
    STR = REGISTER(INSTR>>6&7)
    STORE(STR)
    STOREINT(',')
    EVALMODE(INSTR&X'3F')
    %RETURN
  %FINISH
  %IF INSTR>>8&1 = 1 %THEN STORE("trap") %ELSE STORE("emt")
  %RETURN

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! FLOATING POINT INSTRUCTIONS !!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

INCLASS(5):
  %IF INSTR >> 9 & 7 = 5 %START
    STR = FLPT(INSTR>>3&7)
    STORE(STR)
    STORE(TAB)
    STR = REGISTER(INSTR&7)
    STORE(STR)
    %RETURN
  %FINISH
  %CYCLE I=1,1,6
    %IF INSTR & X'FE00'=EISINSTR(I) %START
      STR = EISMNEM(I)
      STORE(STR)
      STORE(TAB)
      STR = REGISTER(INSTR>>6&7)
      STORE(STR)
      %IF EISMNEM(I) = "sob  " %THENC
        BRDST(-(INSTR&X'3F')) %ELSESTART
        STOREINT(',')
        EVALMODE(INSTR&X'3F')
      %FINISH
      %RETURN
    %FINISH
  %REPEAT
  %RETURN

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! MISCELLANEOUS INSTRUCTIONS !!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

INCLASS(6):
  -> MISC(INSTR>>6 &3)

  MISC(0):
      STR = MISCINSTR(INSTR&7)
      STORE(STR)
      %RETURN

  MISC(1):
      STORE("jmp     ")
      EVALMODE(INSTR&X'3F')
      %RETURN

  MISC(2):
      I = INSTR>>3 &7
      %IF I=0 %START
        STORE("rts     ")
        STR = REGISTER(INSTR&7)
        STORE(STR)
        %RETURN
      %FINISH

      %IF I=3 %START
        STORE("spl     ")
        OCTAL(INSTR&7,0)
        %RETURN
      %FINISH
     %IF INSTR &X'3F' = K'40' %THEN STORE("nop") %ANDRETURN
      %IF INSTR>>5&1 = 1 %THEN EVALCCOD(INSTR)
      %RETURN

  MISC(3):
      STORE("swab    ")
      EVALMODE(INSTR&X'3F')
      %RETURN

%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! END OF RECODE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

%INTEGERFN CLASS(%INTEGER INST)
   %IF INST>>12 & 7 # 0 %START
     %IF INST>>12 & 7 # 7 %THENRESULT = 1 %ELSERESULT = 5
   %FINISH %ELSE %START;  %IF INST>>11 &15 # 0 %START
     %IF INST>> 9 & K'77' = 4 %THENRESULT = 4 %ELSERESULT = 2
   %FINISH %ELSE %START;  %IF INST>> 8 & X'FF' = 0 %THENRESULT = 6 %ELSERESULT = 3
   %FINISH;  %FINISH
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

%ROUTINE BRDST(%INTEGER OFFSET)
  %INTEGER OFF
  %IF OFFSET&K'200' = K'200' %THEN OFF =OFFSET ! X'FFFFFF00' %ELSEC
   OFF = OFFSET
  OCTAL(PC + 2 * OFF,-1)
  %RETURN
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

%ROUTINE SHOW(%INTEGER N, M, F)
   %INTEGER EX
   EX = 0
   %IF M&1 # 0 %START
      STORE("Code");  EX = '+'
   %FINISH
   %IF M&2 # 0 %START
         STORE INT(EX) %IF EX # 0
      EX = '+'
      STORE("Gla")
   %FINISH
   %IF M&4 # 0 %START
      N = N-PC
   %FINISH
   %IF M&X'FF00' # 0 %START
      STOREINT(EX) %IF EX # 0
      EX = '+'
      M = M>>8
      %IF M > MAX SPECS %THEN STORE("Ext#") %AND OCTAL(M, 0) %C
                        %ELSE STORE(XTEXT(M))
   %FINISH
   %IF N # 0 %START
      STORE INT(EX) %IF EX # 0 %AND N > 0
      OCTAL(N, F)
   %FINISH
%END
%ROUTINE EVALMODE(%INTEGER MODE)

  %STRING(4) R
  %INTEGER MOD,REG,X

  %SWITCH ADRMODE(0:7)

  MOD = MODE>>3 & 7
  REG = MODE & 7

  R = REGISTER(REG)
  ->ADRMODE(MOD)

ADRMODE(0):
        STORE(R); %RETURN

ADRMODE(1):
        STOREINT('(')
        STORE(R)
        STOREINT(')')
        %RETURN

ADRMODE(2):
ADRMODE(3):
        %IF MOD = 3 %THEN STOREINT('@')

        %IF REG # 7 %START
          STOREINT('(')
          STORE(R)
          STORE(")+")
          %RETURN
       %FINISH
       STOREINT('#')
       SHOW(NEXTWORD, MARKS(WC), -1)
       %RETURN

ADRMODE(4):
ADRMODE(5):
        %IF MOD = 5 %THEN STOREINT('@')
        STORE("-(")
        STORE(R)
        STOREINT(')')
        %RETURN

ADRMODE(6):
ADRMODE(7):
        %IF MOD = 7 %THEN STOREINT('@')

        K = NEXTWORD;  X = MARKS(WC)
        %IF REG # 7 %START
          SHOW(K, X, -1)
          STOREINT('(')
          STORE(R)
          STOREINT(')')
          %RETURN
       %FINISH
       %IF MOD = 7 %THEN SHOW(PC + K, X,1) %ELSE SHOW(PC+K, X,-1)
       %RETURN

%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

%ROUTINE EVALCCOD(%INTEGER INSTR)

   %CONSTSTRING(2)%ARRAY CCODE(0:3) = "c ","v ","z ","n "
   %STRING(2) SECL,R
   %INTEGER K
   %IF INSTR = K'277' %THEN STORE("scc")
   %IF INSTR = K'257' %THEN STORE("ccc")
   %IF INSTR>> 4 & 1 = 1 %THEN SECL = "se" %ELSE SECL = "cl"
   INSTR = INSTR&15
   %CYCLE K=0,1,3
     %IF INSTR>> K & 1 = 1 %START
       STORE(SECL)
       R = CCODE(K)
       STORE(R)
     %FINISH
   %REPEAT
   %RETURN
%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

%INTEGERFN NEXTWORD
   %INTEGER Z
   CODEPT = CODEPT+1
   %IF CODEPT >CODELENGTH %THENRESULT = 0
   WC = WC+1
   %IF WC > 3 %START
     NEWLINE
     PRINTSTRING("instr has more than 3 words")
     NEWLINE
     %RESULT=0
   %FINISH
   WORDS(WC) = CODE(CODEPT)
   Z = MARK(CODEPT)
   MARKS(WC) = Z
   PC = PC+2
   %RESULT = CODE(CODEPT)
%END  ;! END NEXTWORD

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE STORE(%STRING(8) STR)
  %INTEGER I
  %CYCLE I= 1,1,LENGTH(STR)
    LINE(LINEPT) = CHARNO(STR,I)
    LINEPT = LINEPT+1
    %IF LINEPT>LINELENGTH %START
      PRINTSTRING("line too long")
      NEWLINE
      LINEPT = 0
    %FINISH
  %REPEAT
  LINE(LINEPT) = 0

%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%ROUTINE STOREINT(%INTEGER N)
  LINE(LINEPT) = N
  LINEPT = LINEPT+1
   %IF N = ',' %START
      LINE(LINEPT) = ' ';  LINEPT = LINEPT+1
   %FINISH
  %IF LINEPT>LINELENGTH %START
    PRINTSTRING("line too long")
    NEWLINE
    LINEPT = 0
  %FINISH
  LINE(LINEPT) = 0

%END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%END ;!END RECODE BLOK
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
%END  ;! END RECODE FILE

%ROUTINE RECODE GLAP
   %INTEGER K,W,COUNT

   %RETURN %IF GLAP LENGTH <= 0
   NEWLINE
   NEWLINE
   PRINTSTRING("glap");  NEWLINE
   PRINTSTRING("====");  NEWLINE
   K = 0
   COUNT = 8
   %WHILE K<GLAP LENGTH  %CYCLE
    W = GLAP(K)
     %IF COUNT>7 %START
       NEWLINE
       PRINTOCTAL(K*2)
       SPACES(2)
       COUNT = 0
     %FINISH
     PRINTOCTAL(W);  EXPAND(GMARK(K));  SPACE
     K = K+1;  COUNT = COUNT+1
   %REPEAT
%END ;! END RECODE GLAP

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

%INTEGERFN WORD
   %INTEGER LEFT,RIGHT
   READ CH(RIGHT)
   READ CH(LEFT)
   %RESULT = LEFT<<8 ! RIGHT & X'FF'
%END

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


%END
%ENDOFFILE