!
! RECODE for IMP programs.
!

%const %integer ext name len = 10
%const %integer max glap     = 8191
%const %integer max specs    = 150
%const %integer Max Defs     = 150
%const %integer codelength   = 511
%const %integer linelength   = 54
%const %integer source       = 1
%const %integer object       = 2
%const %integer page         = 62
%const %string(3) tab        = "   "

%control 15;! turn off integer size checks

%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 "

%external %string(127) %function %spec cli param
%external %predicate %spec exists(%string(63) file)

%begin
   %string(127) parm = cli param
   %string(63) source file, object file,output
   %string(63) junk1, junk2
   %owninteger left = page
   %string(ext name len) %array xtext(1:max specs)
   %record %format Def Fm ( %byte Type, Next, %short Addr,
                            %string(Ext Name Len) Text )
   %record(Def Fm) %array Defs ( 1: Max Defs )
   %integer Last Def = 0
   %integer glap length
   %short %array glap(0:max glap)
   %byte  %array gmark(0:maxglap)

   %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 replace(%string(63)%name file, %string(4) ext)
      %string(63) grot, new
      %return %if exists(file)
      %unless file -> new.(".").grot %start
         new = file.ext
         file = new %and %return %if exists(new)
      %finish
      croak(file." does not exist", 0)
   %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 Mode)
         %string(ext name len) x
         %integer s, j, Type, Addr
         %if Mode = 0 %start;       !definition
            Addr = Word
            Space ; Print Octal(Addr)
         %else
            spaces(4)
            n = n+1 ; write(n, 2) ; printstring(" =")
         %finish
         readsymbol(Type) ; write(Type, 1)
         space
         readsymbol(j);                 !length
         x = ""
         %while j > 0 %cycle
            j = j-1
            readsymbol(s)
            x = x.tostring(s)
         %repeat
         printstring(x)
         newline
         %if Mode = 0 %start
            Last Def = Last Def + 1
            Croak("Too many entry points",0) %if Last Def > Max Defs
            Defs(Last Def)_Type = Type
            Defs(Last Def)_Addr = Addr
            Defs(Last Def)_Text = X
         %else
            Xtext(N) = X %if N <= Max Specs
         %finish
      %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, Last Def %cycle
               %if Defs(J)_Type = 2 %and Defs(J)_Addr = Load %start
                  Print String(Defs(J)_Text)
                  Print String("::")
                  New Line
                  Print Octal(Load)
                  Print Symbol(':') ; Space
               %finish
            %repeat
            %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

      %routine expand(%integer n)
         %if n = 0 %then spaces(2) %else print string("c ")
      %end

      %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) ; expand(gmark(k)) ; space
         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

   output = ".tt" %unless parm -> parm.("/").output
   %unless parm -> source file.(",").object file %start
      source file = parm
      object file = parm %unless parm -> object file.(".").parm
      object file = object file.".rel"
   %finish
   replace(source file, ".imp")
   replace(object file, ".rel")
   output = output . ".rec" %unless output -> junk1 . (".") . junk2
   object file = object file . "-b"
   open input(source, source file)
   open input(object, object file)
   open output(3, output)
   select input(object)
   selectoutput(3)
   header
   recode file
   recode glap
%end

%end %of %file