{$T-}
program PRINTINT;
{This version of PRINTINT 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.}
const NL=CHR(10); FF=CHR(12); HT=CHR(9);
  RETN=255;
  MLIT8=128; MVAR=144; MCALL=145; MIF=146; MERROR=127;
var INT, LST: TEXT;
    SIZE, N: INTEGER;
    DONE, SELECT, PRNT: BOOLEAN;
 
procedure OUTMNE(I: INTEGER);
const MTABSIZE=162;
type MTABTYPE=array[0..MTABSIZE-1] of array[0..4] of CHAR;
const MTAB=MTABTYPE(
  'nop  ','xch  ','del  ','null ','error','error','error','error',
  'error','refer','stol ','stor ','error','error','error','pop  ',
  'uinc ','udec ','error','error','error','error','error','error',
  'uceq ','ucne ','ucgt ','ucle ','ucge ','uclt ','umax ','umin ',
  'iadd ','isub ','impy ','idiv ','imod ','error','error','error',
  'ineg ','iabs ','odd  ','float','ceil ','floor','error','error',
  'iinc ','idec ','error','error','error','error','error','error',
  'iceq ','icne ','icgt ','icle ','icge ','iclt ','imax ','imin ',
  'fadd ','fsub ','fmpy ','fdiv ','error','error','error','error',
  'fneg ','fabs ','round','trunc','error','error','error','error',
  'error','error','error','error','error','error','error','error',
  'fceq ','fcne ','fcgt ','fcle ','fcge ','fclt ','fmax ','fmin ',
  'not  ','error','error','error','error','error','nor  ','nand ',
  'eqv  ','xor  ','nimp ','rimp ','imp  ','nrimp','or   ','and  ',
  'compl','union','inter','sdiff','error','sgens','sadel','empty',
  'sceq ','scne ','scgt ','scle ','scge ','sclt ','in   ','error',
  'lit8 ','lit16','rdata','field','ofset','indir','index','movem',
  'byte ','word ','invok','error','rtemp','dtemp','swtch','ident',
  'varbl','call ',
  'if   ','case ','entry','loop ','exit ','for  ','error','error',
  'seq  ','error','error','error','error','proc ','begin','retn ');
begin
  if PRNT then WRITE(LST,MTAB[I],HT)
end;
 
procedure OUTC(C: CHAR);
begin
  if PRNT then WRITE(LST,C)
end;
 
procedure OUT8;
begin
  GET(INT); if PRNT then WRITE(LST,ORD(INT@))
end;
 
procedure OUTBYTE;
var I: INTEGER;
begin
  GET(INT);
  if PRNT then begin
    I:= ORD(INT@); WRITE(LST,I);
    if (I>=32) & (I<=126) then
      WRITE(LST,'    ',CHR(I));
  end;
end;
 
procedure OUT16;
var I:INTEGER;
begin
  GET(INT); I:=ORD(INT@)*256;
  GET(INT); if PRNT then WRITE(LST,ORD(INT@)+I)
end;
 
procedure OUTLEVEL;
begin
  if PRNT then WRITE(LST,ORD(INT@)/16)
end;
 
procedure GETSIZE;
begin
  GET(INT); SIZE:=ORD(INT@)
end;
 
procedure OUTSIZE;
begin
  if PRNT then WRITE(LST,':',SIZE)
end;
 
procedure OUTDS;
begin
  GETSIZE; OUT16; OUTSIZE
end;
 
procedure OPTION;
var CH: CHAR;
begin
  WRITE(OUT,NL,'Do you wish to select procedures?');
  BREAK(OUT); READ(INP,CH);
  SELECT:= (CH='Y') ! (CH='y')
end;
 
procedure ASK;
var CH: CHAR;
begin
  WRITE(OUT,'?'); BREAK(OUT);
  READ(INP,CH);
  PRNT:= (CH='Y') ! (CH='y');
  DONE:= (CH='E') ! (CH='e')
end;
 
 
begin
RESET(INT,'PASCAL.TMP ');
REWRITE(LST,'INT.LST ');
OPTION;
DONE:= FALSE; PRNT:= TRUE;
repeat
  if ORD(INT@) = 248 {ident} then
    begin PRNT:= TRUE; OUTC(NL) end;
  if PRNT then WRITE(LST,ORD(INT@):4, '  ');	{print intermediate op code number}
  case ORD(INT@) mod 16 of
  0,1,2,3,4,5,6,7: OUTMNE((ORD(INT@)mod 16)*16+(ORD(INT@)/16));
  8: begin OUTMNE(ORD(INT@)/16+MLIT8);
    case ORD(INT@)/16 of
    0,12,13,14: OUT8;				{lit8,dtemp,rtemp,swtch}
    8:   OUTBYTE;				{byte}
    1,9: OUT16;					{lit16,word}
    2: begin OUT8; OUTC(','); OUT16 end;	{rdata}
    3,4,5,6,7: OUTDS;				{field,ofset,indir,index,movem}
    10: begin OUT8; OUTC(','); OUT8 end;	{invok}
    15: begin					{ident}
      OUTC('''');
      if SELECT then WRITE(OUT,NL);
      GET(INT); N:=ORD(INT@);
      while N>0 do begin
        GET(INT);
        WRITE(LST,INT@); N:=N-1;
        if SELECT then WRITE(OUT,INT@)
      end;
      OUTC(''''); if SELECT then ASK; end
    end end;
  9: begin OUTMNE(MVAR); OUTLEVEL; OUTC(','); OUTDS end; {varbl}
  10: begin OUTMNE(MCALL); OUTLEVEL; OUTC('(');	{call}
    GETSIZE; OUT8; OUTC(')'); OUTSIZE; OUTC(','); OUT8 end;
  11,12,13,14: OUTMNE(MERROR);			{not used}
  15: begin OUTMNE(ORD(INT@)/16+MIF);		{control structures}
    case ORD(INT@)/16 of
    1: begin OUT8; OUTC(','); OUT8 end;	{case}
    2,3,8: OUT8;				{entry,loop,seq}
    14: begin OUT8; OUTC(';'); OUT8; OUTC(',');	{begin}
      OUT16; OUTC(','); OUT16 end;
    15: OUTC(FF)				{retn}
    end end
  end; {case}
  OUTC(NL);
  GET(INT);
  if EOF(INT) then DONE:= TRUE
  until DONE;
  WRITE(OUT,NL,'end PRINTI',NL); BREAK(OUT)
end.