! 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

%external %routine code11(%string (63) file)
   %const %integer max specs= 100
   %own %integer main prog= 0
   %string (63) source file,object file,output,sdisp
   %integer disp,i

   %external %integer %function %spec exist %alias "S#EXIST"(%string %c
      (255) file)
   %routine define(%string (255) s)
      %external %routine %spec emas3(%string %name command,params,
         %integer %name flag)
      %integer flag
      emas3("DEFINE",s,flag)
   %end;                                 ! Of %routine define.
!   %external %integer %fn %spec time40(%integer inst)
   %const %integer source= 1, oy = 2
   %const %integer page= 62

   %own %integer left= page-3-12
   %routine show time(%integer inst)
      %integer j,k
!      j = time40(inst)
!      print(j/100,2,1)
   %end
   %routine %spec header
   %routine %spec recode file
   %routine %spec recode glap
   %routine %spec print octal(%integer n)
   %integer %fn %spec word
   %const %string (3) tab= "   "
   %string (10) %array xtext(1:max specs)
   %const %integer maxglap=8191
   %integer glap length
   %integer %array glap(0:max glap)
   %byte %integer %array gmark(0:maxglap)
   %const %integer %array 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'
   %const %string (5) %array domnem(1:12)= %c
                         "mov  ","cmp  ","bit  ","bic  ","bis  ",
                         "add  ","movb ","cmpb ","bitb ","bicb ",
                         "bisb ","sub  "

   %const %integer %array 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'

   %const %string (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 "

   %const %integer %array 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'

   %const %string (5) %array brmnem(1:15)= %c
                         "br   ","bne  ","beq  ","bge  ","blt  ","bgt  ",
                         "ble  ","bpl  ","bmi  ","bhi  ","blos ","bvc  ",
                         "bvs  ","bhis ","blo  "

   %const %integer %array eisinstr(1:6)= %c
                         k'070000',k'071000',k'072000',k'073000',
                         k'074000',k'077000'

   %const %string (5) %array eismnem(1:6)= %c
                         "mul  ","div  ","ash  ","ashc ","xor  ","sob  "

   %const %string (5) %array miscinstr(0:6)= "halt ","wait ","rti  ","bpt  ",
                                     "iot  ","reset","rtt  "

   %const %string (3) %array register(0:7)= "r0","r1","r2","r3","lnb","ds",
                                         "sp","pc"

   %const %string (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

      %routine %spec 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

         %integer %fn %spec class(%integer instr)
         %routine %spec octal(%integer number,flag)
         %routine %spec evalmode(%integer mode)
         %routine %spec brdst(%integer offset)
         %routine %spec evalccod(%integer instr)
         %routine %spec recode(%integer instr)
         %routine %spec store(%string (10) str)
         %routine %spec storeint(%integer n)
         %integer %fn %spec nextword

         %const %integer codelength= 511
         %const %integer linelength= 54
         %integer codept,wc,j,k,linept
         %integer %array code(0:codelength),words(1:3)
         %integer %array mark(0:codelength),marks(1:3)
         %byte %integer %array line(0:linelength)
         %switch t(1:11)
         %integer s,blkl,key
         %own %integer 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 " %then octal(instr&x'3F',1) %else %c
                     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  " %then brdst(-(instr&x'3F')) %else %c
                     %start
                     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") %and %return
            %if instr>>5&1=1 %then evalccod(instr)
            %return

misc(3):
            store("swab    ")
            evalmode(instr&x'3F')
            %return

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

         %integer %fn class(%integer inst)
            %if inst>>12&7#0 %start
               %if inst>>12&7#7 %then %result = 1 %else %result = 5
            %finish %else %start; %if inst>>11&15#0 %start
                  %if inst>>9&k'77'=4 %then %result = 4 %else %result = 2
               %finish %else %start; %if inst>>8&x'FF'=0 %then %c
                     %result = 6 %else %result = 3
               %finish; %finish
         %end
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

         %routine brdst(%integer offset)
            %integer off
            %if offset&k'200'=k'200' %then off = offset!x'FFFFFF00' %else %c
               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) %else %c
                  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)

            %const %string (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
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

         %integer %fn nextword
            %integer z
            codept = codept+1
            %if codept>codelength %then %result = 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 (10) 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

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

   %integer %fn word
      %integer left,right
      read ch(right)
      read ch(left)
      %result = left<<8!right&x'FF'
   %end

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


%end
%end %of %file