!
! RECODE for IMP programs.
!

%const %integer ext name len = 10
%const %integer max glap     = 8191
%const %integer max specs    = 100
%const %integer codelength   = 511
%const %integer linelength   = 54
%const %integer source       = 1
%const %integer object       = 2
%const %integer page         = 62
%const %string(3) tab        = "   "
%const %string(39) form err  = "Form is RECODE source,object/listing"

%const %integer %array doinstr(1:12) =
      8_010000, 8_020000, 8_030000, 8_040000,
      8_050000, 8_060000, 8_110000, 8_120000,
      8_130000, 8_140000, 8_150000, 8_160000

%const %string(5) %array domnem(1:12) =
      "mov  ","cmp  ","bit  ","bic  ","bis  ",
      "add  ","movb ","cmpb ","bitb ","bicb ",
      "bisb ","sub  "

%const %integer %array soinstr(1:30) =
      8_005000, 8_005100,8_005200,
      8_005300, 8_005400,
      8_005500, 8_005600,
      8_005700, 8_006000,
      8_006100, 8_006200,
      8_006300, 8_006400,
      8_006500, 8_006600,
      8_006700, 8_105000,
      8_105100, 8_105200,
      8_105300, 8_105400,
      8_105500, 8_105600,
      8_105700, 8_106000,
      8_106100, 8_106200,
      8_106300, 8_106500,
      8_106600

%const %string(5) %array somnem (1:30) =
      "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) =
      8_000400,
      8_001000, 8_001400,
      8_002000, 8_002400,
      8_003000, 8_003400,
      8_100000, 8_100400,
      8_101000, 8_101400,
      8_102000, 8_102400,
      8_103000, 8_103400

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

%const %integer %array eisinstr(1:6) =
      8_070000, 8_071000, 8_072000, 8_073000,
      8_074000, 8_077000

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

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

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

%const %string(2) %array fregister(0:3) =
      "f0", "f1", "f2", "f3"

%const %string(5) %array flt(1:5) =
      "cfcc ", "setf ", "seti ", "setd ", "setl "

%const %integer %array flti(1:5) =
      8_170000, 8_170001, 8_170002,
      8_170011, 8_170012

%const %string(5) %array flt1(1:7) =
      "ldfps", "stfps", "stst ",
      "clrf ", "tstf ", "absf ", "negf "

%const %string(5) %array flt2(2:15) =
      "mulf ", "modf ", "addf ", "ldf  ",
      "subf ", "cmpf ", "stf  ", "divf ",
      "stexp", "stcfi", "stcfd", "ldexp",
      "ldcif", "ldcf "


%begin
   %own %integer  left = page
   %string(ext name len) %array  xtext (1 : max specs)
   %integer  glap length
   %short %array  glap  (0 : max glap)
   %byte  %array  gmark (0 : max glap)

   %routine croak ( %string(63) s, %integer item )
      select output(0)
      print string("*** RECODE fails -- ".s)
      write(item,0) %if charno(s,length(s)) = '='
      newline
      %stop
   %end

   %routine print octal( %integer n )
      %integer i
      n = n&16_FFFF
      %for i=15,-3,0 %cycle
        print symbol('0' +(n>>i&7))
      %repeat
   %end

   %integer %function word
      %integer left,right
      read symbol(right)
      read symbol(left)
      %result = left<<8 ! right & 16_ff
   %end

   %routine test page
      left = left-1
      %if left <= 0 %start
         left = page
!         printsymbol(12)
      %finish
   %end

   %routine newline
      printsymbol(nl)
      test page
   %end

   %routine header
      %integer k, n

      %routine dump external(%integer type)
         %string(ext name len) x
         %integer s, j
         %if type = 0 %start;       !definition
            space ; print octal(word)
         %else
            spaces(4)
            n = n+1 ; write(n, 2) ; printstring(" =")
         %finish
         readsymbol(s) ; write(s, 1)
         space
         readsymbol(j);                 !length
         x = ""
         %while j > 0 %cycle
            j = j-1
            readsymbol(s)
            x = x.tostring(s)
         %repeat
         printstring(x)
         newline
         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 symbol('(') ; print octal(k)
      print symbol(')')
      newline
      glap length = word
      printstring("glap length ")
      write(glap length,5)
      spaces(2)
      print symbol('(') ; print octal(glap length)
      print symbol(')')
      newline
      glap length = glap length>>1
      croak("glap array too short, want=", glap length) %if glap length > maxglap
      newline
   %end

   %routine recode file
      %integer ga = -1
      %integer type
      %integer pc = 0

      %routine recode blok
         %integer codept, wc, j, k, linept
         %shortintegerarray code(0:codelength), words(1:3)
         %shortintegerarray mark(0:codelength), marks(1:3)
         %byteintegerarray line(0:linelength)
         %switch t(1:11)
         %integer s
         %integer key  = 0
         %integer blkl = 0
         %owninteger oldline = 1, load, linenum = 1, new pc = -1

         %integer %function nextword
            codept = codept+1
            %result = 0 %if codept > codelength
            wc = wc+1
            croak("Internal failure G3W",0) %if wc > 3
            words(wc) = code(codept)
            marks(wc) = mark(codept)
            pc = pc+2
            %result = code(codept)
         %end

         %routine store int(%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

         %routine store(%string(8) str)
           %integer i
           %for i = 1, 1, length(str) %cycle
              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

         %integer %function class(%integer inst)
            %if inst>>12 & 7 # 0 %start
              %if inst>>12 & 7 # 7 %thenresult = 1 %elseresult = 5
            %else %if inst>>11 &15 # 0
              %if inst>> 9 & 8_77 = 4 %thenresult = 4 %elseresult = 2
            %else
               %if inst>> 8 & 16_FF = 0 %thenresult = 6 %elseresult = 3
            %finish
         %end

         %routine octal ( %integer number, flag )
            %integer j, k = 15
            %switch fl(-1:1)
            -> fl(flag)
fl(-1):   ! Signed
            %if number < 0 %start
               store int('-')
               number = -number
            %finish
fl(1):   ! Zero-suppressed
            k = k-3 %while number>> k & 7 = 0 %and k>0
fl(0):   ! Print unsigned number
            number = number & 16_FFFF
            %for j = k, -3, 0 %cycle
               store int('0' +(number>>j&7))
            %repeat
         %end

         %routine brdst(%integer offset)
            offset = offset ! 16_ffffff00 %if offset & 8_200 # 0
            octal(offset*2 + pc, -1)
         %end

         %routine show(%integer n, m, f)
            %integer 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&16_ff00 # 0 %start
               store int(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 ex = 0 %then octal(n, f) %else %start
               %if n # 0 %start
                  store int(ex) %if n > 0
                  octal(n, -1)
               %finish
            %finish
         %end

         %routine evalccod(%integer instr)
            %conststring(2)%array ccode(0:3) = "c ","v ","z ","n "
            %string(2) secl
            %integer k
            %if instr = 8_277 %then store("scc")
            %if instr = 8_257 %then store("ccc")
            %if instr>> 4 & 1 = 1 %then secl = "se" %else secl = "cl"
            instr = instr&15
            %for k = 0, 1, 3 %cycle
               %if instr>> k & 1 = 1 %start
                  store(secl)
                  store(ccode(k))
               %finish
            %repeat
         %end

         %routine eval mode(%integer mode)
            %switch adrmode(0:7)
            %integer mod = mode>>3 & 7
            %integer reg = mode & 7
            %string(4) r = register(reg)
            %integer x
            ->adrmode(mod)
         
adrmode(0): store(r); %return

adrmode(1): store int('(')
            store(r)
            store int(')')
            %return

adrmode(2):
adrmode(3): store int('@') %if mod = 3
            %if reg # 7 %start
               store int('(')
               store(r)
               store(")+")
               %return
            %finish
            store int('#')
            show(nextword, marks(wc), -1)
            %return

adrmode(4):
adrmode(5): store int('@') %if mod = 5
            store("-(")
            store(r)
            store int(')')
            %return

adrmode(6):
adrmode(7): store int('@') %if mod = 7
            k = nextword ; x = marks(wc)
            %if reg # 7 %start
               show(k, x, -1)
               store int('(')
               store(r)
               store int(')')
               %return
            %finish
            show(pc+k, x, 1)
         %end

         %routine recode(%integer instr)
            %switch inclass(1:6)
            %string(8) str
            %switch misc(0:3)
            %integer i, n

            instr = instr&16_FFFF
            -> inclass(class(instr))

         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         !!! double operand instructions !!!!!!!!!!!!!!!!!!!!!!!!
         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

         inclass(1):
            %for i=1,1,12 %cycle
               %if (instr & 16_f000) = doinstr(i) %start
                  str = domnem(i)
                  store(str)
                  store(tab)
                  eval mode(instr>>6)
                  store int(',')
                  eval mode(instr)
                  %return
               %finish
            %repeat
            %return

         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         !!! single operand instructions !!!!!!!!!!!!!!!!!!!!!!!!!
         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

         inclass(2):
            %for i=1,1,30 %cycle
               %if instr & 16_ffc0 = soinstr(i) %start
                  str = somnem(i)
                  store(str)
                  store(tab)
                  %if somnem(i) = "mark " %then octal(instr&16_3f,1) %c
                                          %else eval mode(instr)
                  %return
               %finish
            %repeat
            %return

         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         !!! branch instructions !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

         inclass(3):
            %for i=1,1,15 %cycle
               %if instr & 16_ff00 = brinstr(i) %start
                  str = brmnem(i)
                  store(str)
                  store(tab)
                  brdst(instr&16_ff)
                  %return
               %finish
            %repeat
            %return

         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         !!! jsr and trap instructions !!!!!!!!!!!!!!!!!!!!!!!!!
         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

         inclass(4):
            %if instr & 16_8000 = 0 %start
               store("jsr     ")
               str = register(instr>>6&7)
               store(str)
               store int(',')
               eval mode(instr)
               %return
            %finish
            %if instr>>8&1 = 1 %then store("trap ") %else store("emt  ")
            store(tab)
            octal(instr&255, 1)
            %return
          
         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         !!! floating point instructions !!!!!!!!!!!!!!!!!!!!!!!
         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

         inclass(5):
            %if instr & 16_8000 # 0 %start
               n = instr>>8&15
               %if n >= 2 %start
                  store(flt2(n)) ; store(tab)
                  store(fregister(instr>>6&3))
                  store int(',')
                  eval mode(instr&8_77)
                  %return
               %finish
               %if n = 1 %or instr&8_300 # 0 %start
                  store(flt1(instr>>6&7)) ; store(tab)
                  eval mode(instr&8_77)
                  %return
               %finish
               %for i = 1, 1, 5 %cycle
                  %if flti(i) = instr %start
                     store(flt(i))
                     %return
                  %finish
               %repeat
               %return
            %finish
            %for i=1,1,6 %cycle
               %if instr & 16_fe00=eisinstr(i) %start
                  str = eismnem(i)
                  store(str)
                  store(tab)
                  str = register(instr>>6&7)
                  store(str)
                  store int(',')
                  %if eismnem(i) = "sob  " %start
                     brdst(-(instr&16_3f))
                  %else
                     eval mode(instr)
                  %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     ")
            eval mode(instr)
            %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 &16_3f = 8_40 %then store("nop") %and %return
            %if instr>>5&1 = 1 %then evalccod(instr)
            %return

         misc(3):
            store("swab    ")
            eval mode(instr)
         %end

         select input(object)
         %cycle
            readsymbol(type) ; ->t(type) %if 1 <= type <= 11
            croak("Corrupt object file, item=",type)

t(1):       s = word
            blkl = blkl+1 ; code(blkl) = s
            mark(blkl) = key ; key = 0
            %continue

t(2):       s = word
            ga = ga+1
            croak("Internal failure GKEY=",key) %if key&(\2_010) # 0
            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):    select input (source)
         %while %not end of input %cycle
            write (oldline, 6);  space
            %cycle
               readsymbol (k);  print symbol (k)
            %repeat %until k = nl
            test page
            old line = old line + 1
         %repeat
         %return

t(6):    line num = word
try:     select input(source)
         %if oldline # line num %start
            %for j=oldline,1,line num-1 %cycle
               %exit %if end of input
               write(j,6)
               space
               %cycle
                  readsymbol(k) ; printsymbol(k)
               %repeat %until k = nl
               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
            k = nextword
            %if marks(1) = 0 %then recode(k) %else show(k,marks(1),-1)
            print octal(load);
            print symbol(':') ; space
            %for j=1,1,wc %cycle
               print octal(words(j))
               spaces(2)
            %repeat
            spaces( (3-wc)<<3+3 ) %if linept # 0
            j=0
            %while line(j) # 0 %cycle
               printsymbol(line(j))
               j = j+1
            %repeat
            newline
         %repeat
         pc = new pc %if new pc # -1
         new pc = -1
      %end

      recode blok %until type = 8
   %end

   %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
            print octal(k*2)
            print symbol(':') ; print symbol(' ')
            count = 0
         %finish
         print octal(w) 
         %if gmark(k) = 0 %then spaces(3) %c
                          %else print string ("c  ")
         k = k + 1 ;  count = count + 1
      %repeat
   %end

   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   !!!!!!!! M A I N  P R O G R A M !!!!!!!
   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   %on %event 9 %start
      recode glap
      %stop
   %finish

   croak (form err, 0) %unless in type > 0 <= out type
   select input (object)
   croak (form err, 0) %unless in type > 0
   select output(1)
   header
   recode file
   recode glap
%end %of %program