ORCA-C/CGI.Debug

378 lines
8.9 KiB
Plaintext

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';
opt[pc_bqr] := 'bqr';
opt[pc_bqx] := 'bqx';
opt[pc_baq] := 'baq';
opt[pc_bnq] := 'bnq';
opt[pc_ngq] := 'ngq';
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');
cgQuad: write('q');
cgUQuad: write('uq');
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,pc_bqr,pc_bqx,pc_baq: ;
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);
cgQuad,cgUQuad:
write('***');
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}