ORCA-C/CGI.Debug

procedure InitWriteCode;                    {debug}

{ initialize the intermediate code opcode table                 }

begin {InitWriteCode}
opt[pc_adi] := 'adi';
opt[pc_adr] := 'adr';
opt[pc_psh] := 'psh';
opt[pc_and] := 'and';
opt[pc_dvi] := 'dvi';
opt[pc_dvr] := 'dvr';
opt[pc_cnn] := 'cnn';
opt[pc_cnv] := 'cnv';
opt[pc_ior] := 'ior';
opt[pc_mod] := 'mod';
opt[pc_mpi] := 'mpi';
opt[pc_mpr] := 'mpr';
opt[pc_ngi] := 'ngi';
opt[pc_ngr] := 'ngr';
opt[pc_not] := 'not';
opt[pc_sbi] := 'sbi';
opt[pc_sbr] := 'sbr';
opt[pc_sto] := 'sto';
opt[pc_dec] := 'dec';
opt[dc_loc] := 'LOC';
opt[pc_ent] := 'ent';
opt[pc_fjp] := 'fjp';
opt[pc_inc] := 'inc';
opt[pc_ind] := 'ind';
opt[pc_ixa] := 'ixa';
opt[pc_lao] := 'lao';
opt[pc_lca] := 'lca';
opt[pc_ldo] := 'ldo';
opt[pc_mov] := 'mov';
opt[pc_ret] := 'ret';
opt[pc_sro] := 'sro';
opt[pc_xjp] := 'xjp';
opt[pc_cup] := 'cup';
opt[pc_equ] := 'equ';
opt[pc_geq] := 'geq';
opt[pc_grt] := 'grt';
opt[pc_lda] := 'lda';
opt[pc_ldc] := 'ldc';
opt[pc_ldl] := 'ldl';
opt[pc_leq] := 'leq';
opt[pc_les] := 'les';
opt[pc_lil] := 'lil';
opt[pc_lld] := 'lld';
opt[pc_lli] := 'lli';
opt[pc_lod] := 'lod';
opt[pc_neq] := 'neq';
opt[pc_str] := 'str';
opt[pc_ujp] := 'ujp';
opt[pc_add] := 'add';
opt[pc_lnm] := 'lnm';
opt[pc_nam] := 'nam';
opt[pc_cui] := 'cui';
opt[pc_lad] := 'lad';
opt[pc_tjp] := 'tjp';
opt[dc_lab] := 'LAB';
opt[pc_usr] := 'usr';
opt[pc_umi] := 'umi';
opt[pc_udi] := 'udi';
opt[pc_uim] := 'uim';
opt[dc_enp] := 'ENP';
opt[pc_stk] := 'stk';
opt[dc_glb] := 'GLB';
opt[dc_dst] := 'DST';
opt[dc_str] := 'STR';
opt[pc_cop] := 'cop';
opt[pc_cpo] := 'cpo';
opt[pc_tl1] := 'tl1';
opt[dc_pin] := 'PIN';
opt[pc_shl] := 'shl';
opt[pc_shr] := 'shr';
opt[pc_bnd] := 'bnd';
opt[pc_bor] := 'bor';
opt[pc_bxr] := 'bxr';
opt[pc_bnt] := 'bnt';
opt[pc_bnl] := 'bnl';
opt[pc_mpl] := 'mpl';
opt[pc_dvl] := 'dvl';
opt[pc_mdl] := 'mdl';
opt[pc_sll] := 'sll';
opt[pc_slr] := 'slr';
opt[pc_bal] := 'bal';
opt[pc_ngl] := 'ngl';
opt[pc_adl] := 'adl';
opt[pc_sbl] := 'sbl';
opt[pc_blr] := 'blr';
opt[pc_blx] := 'blx';
opt[dc_sym] := 'SYM';
opt[pc_lnd] := 'lnd';
opt[pc_lor] := 'lor';
opt[pc_vsr] := 'vsr';
opt[pc_uml] := 'uml';
opt[pc_udl] := 'udl';
opt[pc_ulm] := 'ulm';
opt[pc_pop] := 'pop';
opt[pc_gil] := 'gil';
opt[pc_gli] := 'gli';
opt[pc_gdl] := 'gdl';
opt[pc_gld] := 'gld';
opt[pc_iil] := 'iil';
opt[pc_ili] := 'ili';
opt[pc_idl] := 'idl';
opt[pc_ild] := 'ild';
opt[pc_cpi] := 'cpi';
opt[pc_tri] := 'tri';
opt[pc_lbu] := 'lbu';
opt[pc_lbf] := 'lbf';
opt[pc_sbf] := 'sbf';
opt[pc_cbf] := 'cbf';
opt[dc_cns] := 'CNS';
opt[dc_prm] := 'PRM';
opt[pc_nat] := 'nat';
opt[pc_bno] := 'bno';
opt[pc_nop] := 'nop';
end; {InitWriteCode}


procedure PrintDAG (tag: stringPtr; code: icptr);

{ print a DAG							}
{								}
{ parameters:							}
{    tag - label for lines					}
{    code - first node in DAG					}

begin {PrintDAG}
while code <> nil do begin
   PrintDAG(tag, code^.left);
   PrintDAG(tag, code^.right);
   write(tag^);
   WriteCode(code);
   code := code^.next;
   end; {while}
end; {PrintDAG}


procedure PrintBlocks {tag: stringPtr; bp: blockPtr}; {debug}

{ print a series of basic blocks				}
{								}
{ parameters:							}
{    tag - label for lines					}
{    bp - first block to print					}


   procedure PrintDOM (dp: blockListPtr);

   { print a list of dominators					}
   {								}
   { parameters:						}
   {    dp - list to print					}

   begin {PrintDOM}
   while dp <> nil do begin
      write(dp^.dfn:1);
      if dp^.next <> nil then
         write(',');
      dp := dp^.next;
      end; {while}
   end; {PrintDOM}


   procedure PrintList (tag: stringPtr; lp: iclist);

   { print an operation list					}
   {								}
   { parameters:						}
   {    tag - label for lines					}
   {    lp - list to print					}


      procedure PrintTree (tag: stringPtr; op: icptr);

      { print an operation tree					}
      {								}
      { parameters:						}
      {    tag - label for lines				}
      {    op - operation tree to print				}

      begin {PrintTree}
      if op^.left <> nil then
         printTree(@'>>    : ', op^.left);
      if op^.right <> nil then
         printTree(@'>>    : ', op^.right);
      write(tag^);
      WriteCode(op);
      end; {PrintTree}


   begin {PrintList}
   while lp <> nil do begin
      PrintTree(tag, lp^.op);
      lp := lp^.next;
      end; {while}
   end; {PrintList}


begin {PrintBlocks}
while bp <> nil do begin
   write(tag^, 'BLOCK(', bp^.dfn:1, ')  [');
   PrintDOM(bp^.dom);
   writeln(']');
   PrintList(@'>>In  : ', bp^.c_in);
   PrintList(@'>>Out : ', bp^.c_out);
   PrintList(@'>>Gen : ', bp^.c_gen);
   PrintDAG(tag, bp^.code);
   bp := bp^.next;
   end; {while}
end; {PrintBlocks}


procedure WriteCode {code: icptr};      {debug}

{ print an intermediate code instruction                        }
{                                                               }
{ Parameters:                                                   }
{    code - intermediate code instruction to write              }

var
   i: integer;                          {work variable}


   procedure WriteType(tp: baseTypeEnum);

   { print the operand type                                     }
   {                                                            }
   { parameters:                                                }
   {    tp - type                                               }

   begin {WriteType}
   case tp of
      cgByte:   write('b');
      cgUByte:  write('ub');
      cgWord:   write('i');
      cgUWord:  write('u');
      cgLong:   write('l');
      cgULong:  write('ul');
      cgReal:   write('r');
      cgDouble: write('d');
      cgComp:   write('c');
      cgExtended: write('e');
      cgString: write('s');
      cgVoid:   write('void');
      ccPointer: write('p');
      otherwise: write('(', ord(tp):1, ')');
      end; {case}
   end; {WriteType}


begin {WriteCode}
write(opt[code^.opcode]);
with code^ do
   case opcode of
      dc_enp,dc_pin,dc_sym,pc_adl,pc_bal,pc_dvl,pc_ent,pc_mpl,pc_sbl,
      pc_uml,pc_adr,pc_dvr,pc_mpr,pc_adi,pc_sbi,pc_mpi,pc_dvi,
      pc_umi,pc_shl,pc_nop,pc_and,pc_lnd,pc_bnd,pc_lor,pc_ior,pc_bxr,
      pc_bnt,pc_blx,pc_bnl,pc_ngi,pc_ngl,pc_ngr,pc_ixa,pc_mdl,
      pc_udi,pc_udl: ;

      dc_prm:
         write('  ', q:1, ':', r:1, ':', s:1);

      pc_equ,pc_neq,pc_geq,pc_leq,pc_grt,pc_les,pc_pop,pc_ret,pc_bno,
      pc_cpi,pc_sto,pc_tri,pc_stk,pc_idl,pc_iil,pc_ili,pc_ild:
         WriteType(optype);

      pc_cnv,pc_cnn: begin
         write('  ');
         i := (q>>4) & 15;
         WriteType(baseTypeEnum(i));
         write(':');
         i := q & 15;
         WriteType(baseTypeEnum(i));
         end;

      pc_lil,pc_lli,pc_ldl,pc_lld: begin
         WriteType(optype);
         write(' ', q:1, ',', r:1);
         end;

      pc_lod,pc_str,pc_cop: begin
         WriteType(optype);
         write(' ', r:1, ':', q:1);
         end;

      dc_loc,pc_lda,pc_mov:
         write('  ', r:1, ':', q:1);

      pc_ind,pc_inc,pc_dec: begin
         WriteType(optype);
         write(' ', q:1);
         end;

      dc_lab,pc_fjp,pc_tjp,pc_ujp,pc_add:
         write('  ', q:1);

      pc_ldc: begin
         WriteType(optype);
         if optype in [cgByte,cgUByte,cgWord,cgUWord] then
            write(' ', q:1)
         else if optype in [cgLong,cgULong] then
            write(' ', lval:1)
         else if optype in [cgReal,cgDouble,cgComp,cgExtended] then
            write(' ', rval:1)
         else
            write('***');
         end;

      pc_cup,pc_lad: begin
         WriteType(optype);
         write(' ', lab^);
         end;

      pc_cpo,pc_lao,pc_ldo,pc_sro: begin
         WriteType(optype);
         write(' ', q:1, ':', lab^);
         end;

      dc_str,dc_glb,pc_gli,pc_gld,pc_gil,pc_gdl:
         write(' ', r:1, ':', q:1, ':', lab^);

      dc_cns: begin
         WriteType(optype);
         write(' ', q:1, ':');
         case optype of
            cgByte,cgUByte,cgWord,cgUWord:
               write(r:1);
            cgLong,cgULong:
               write(lval:1);
            cgReal,cgDouble,cgComp,cgExtended:
               write('***');
            cgString: begin
               write('''');
               for i := 1 to q do
                  write(str^.str[i]);
               write('''');
               end;
            ccPointer:
               if lab = nil then
                  write('***')
               else
                  write(lab^, '+', pval:1);
            end; {case}
         end;

      pc_lca: begin
         WriteType(optype);
         write(' ');
         if optype = cgString then begin
            write('''');
            for i := 1 to q do
               write(str^.str[i]);
            write('''');
            end {if}
         else
            write('***');
         end;

      otherwise:
         write('  ***');

      end; {case}
writeln;
end; {WriteCode}