{$T-}
program intprint;
{INTPRINT: program to print the intermediate code
 file produced by pass 1 of the NBS Pascal compiler.
 
 V1A - 04 Apr 78 - Bill Heidebrecht, TRW DSSG
 
 This version of INTPRINT asks the user
 to select the procedures to be printed.
 Allowed user responses are:
  Y - print the current procedure;
  N - do not print;
  E - wrapup files and exit.
 
 RSX-11 usage:
 MCR>ITP - infile.INT outfile.LST
}
 
const nl=chr(10); ff=chr(12);
 
var int, lst: text;
    nch: integer;
    done, select, prnt: boolean;
    ch: char;
 
 
procedure nextch;
begin
  ch := int@;
  nch := ord(ch);
  get(int)
end; {NEXTCH}
 
procedure outmne (i: integer);
const mtabsize = 179;
type mtabtype = array [0..mtabsize] of array [0..4] of char;
const mtab = mtabtype(                                             {opcode}
  'nop  ','xch  ','del  ','error','error','ident','proc ','end  ', {0 - 7}
  'null ','refer','stol ','stor ','error','error','error','error', {8 - 15}
  'succ ','pred ','error','error','error','error','error','error', {16 - 23}
  'uceq ','ucne ','ucgt ','ucle ','ucge ','uclt ','umax ','umin ', {24 - 31}
  'iadd ','isub ','imul ','idiv ','imod ','error','error','error', {32 - 39}
  'ineg ','iabs ','odd  ','float','ceil ','floor','error','error', {40 - 47}
  'iinc ','idec ','error','error','error','error','error','error', {48 - 55}
  'iceq ','icne ','icgt ','icle ','icge ','iclt ','imax ','imin ', {56 - 63}
  'fadd ','fsub ','fmul ','fdiv ','error','error','error','error', {64 - 71}
  'fneg ','fabs ','round','trunc','error','error','error','error', {72 - 79}
  'error','error','error','error','error','error','error','error', {80 - 87}
  'fceq ','fcne ','fcgt ','fcle ','fcge ','fclt ','fmax ','fmin ', {88 - 95}
  'not  ','error','error','error','error','error','nor  ','nand ', {96 - 103}
  'eqv  ','xor  ','nimp ','rimp ','imp  ','nrimp','or   ','and  ', {104 - 111}
  'compl','union','inter','sdiff','error','sgens','sadel','empty', {112 - 119}
  'sceq ','scne ','scgt ','scle ','scge ','sclt ','in   ','sany ', {120 - 127}
  'lit8 ','lit16','error','field','ofset','indir','index','movem', {128 - 135}
  'byte ','word ','invok','error','rtemp','dtemp','swtch','error', {136 - 143}
  'if   ','case ','entry','loop ','exit ','for  ','error','error', {144 - 151}
  'seq  ','error','error','error','error','error','begin','retn ', {152 - 159}
  'error','error','liter','rdata','error','error','error','error', {160 - 167}
  'vceq ','vcne ','vcgt ','vcle ','vcge ','vclt ','error','error', {168 - 175}
  'varbl','param','call ','error');                                {176 - 179}
 
begin
  write(lst,mtab[i]:5,'  ')
end; {OUTMNE}
 
procedure outc (c: char);
begin
  if prnt then write(lst,c)
end; {OUTC}
 
procedure out8;
begin
  nextch; if prnt then write(lst,nch)
end; {OUT8}
 
procedure out16;
var i:integer;
begin
  nextch; i := nch*256;
  nextch; if prnt then write(lst, nch+i)
end; {OUT16}
 
procedure outlevel;
begin
  if prnt then write(lst, nch mod 16)
end; {OUTLEVEL}
 
procedure outsize;
begin
  nextch;
  if prnt then write(lst, ':', nch)
end; {OUTSIZE}
 
procedure outds;
begin
  outsize;
  outc(','); out16
end; {OUTDS}
 
procedure option;
var ch: char;
begin
  write(output,nl,'Do you wish to select procedures?');
  break(output); read(input,ch);
  select := (ch='Y') or (ch='y')
end; {OPTION}
 
procedure ask_user;
var ch: char;
begin
  write(output,'?'); break(output);
  read(input,ch);
  prnt := (ch='Y') or (ch='y');
  if (ch='E') or (ch='e') then done := true
end; {ASK_USER}
 
procedure scan;
var i, n, opcode, opcode2: integer;
begin
  repeat
    nextch;
    opcode := nch;
    if opcode > 223 then opcode2 := 179
    else if opcode > 207 then opcode2 := 178 {call}
    else if opcode > 191 then opcode2 := 177 {param}
    else if opcode > 175 then opcode2 := 176 {varbl}
    else opcode2 := opcode;
    if opcode2 = 5 {ident} then prnt := true;
    if prnt then
    begin
      write(lst, nl, opcode:4, '  '); {print op code number}
      outmne(opcode2)                 {print mnemonic}
    end;
 
case opcode2 of
  0,1,2,3,4: ;
  5: begin {ident}
      outc('''');
      if select then write(output,nl);
      nextch; n := nch;
      for i := 1 to n do
      begin
        nextch;
        write(lst,ch);
        if select then write(output,ch)
      end;
      outc('''');
      if select then ask_user;
     end;
 
  7: begin {end}
      out8;  outc(',');
      out8;  outc(',');
      out16; outc(',');
      out16; outc(',');
      out16; outc(nl); outc(nl)
     end;
 
  6,8,9,10,11,12,13,14,15,16,17,18,19,20,
  21,22,23,24,25,26,27,28,29,30,31,32,33,34,
  35,36,37,38,39,40,41,42,43,44,45,46,47,48,
  49,50,51,52,53,54,55,56,57,58,59,60,61,
  62,63,64,65,66,67,68,69,70,71,72,73,74,75,
  76,77,78,79,80,81,82,83,84,85,86,87,88,89,
  90,91,92,93,94,95,96,97,98,99,100,
  101,102,103,104,105,106,107,108,109,110,
  111,112,113,114,115,116,117,118,119,120,
  121,122,123,124,125,126,127,128,129,130: ;
 
  131,132,133,134,135: {field,ofset,indir,index,movem}
    outds;
 
  136,137: ;
 
  138: begin {invok}
        out8; outc(','); out8
       end;
 
  139: ;
 
  140,141: out8; {rtemp,dtemp}
 
  142,143,144: ;
 
  145: begin {case}
        out8; outc(','); out8
       end;
 
  146,147,152: out8; {entry,loop,seq}
 
  148,149: ; {exit,for}
 
  150,151,153,154,155,156,157,158,159,160,161: ;
 
  162: out16; {liter}
 
  163: begin {rdata}
        out8; outc(','); out16
       end;
 
  164,165,166,167,168,169,170,171,172,173,174,175: ;
 
  176,177: begin {varbl,param}
            outlevel; outds
           end;
 
  178: begin {call}
        outlevel; outsize;
        outc('('); out8; outc(')');
        outc(','); out8
       end;
 
  179:
 
end; {case}
 
    if eof(int) then done := true
  until done
 
end; {SCAN}
 
begin {INTPRINT}
  reset(int, argv[2]@);
  rewrite(lst, argv[3]@,2 {fd.cr attribute} );
  option;
  done := false; prnt := true;
  scan;
  write(lst,nl); break(lst);
  write(output,nl,'end INTPRT',nl); break(output)
end.