mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-12-22 23:29:27 +00:00
384 lines
9.0 KiB
Plaintext
384 lines
9.0 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';
|
|
opt[pc_mpq] := 'mpq';
|
|
opt[pc_umq] := 'umq';
|
|
opt[pc_dvq] := 'dvq';
|
|
opt[pc_udq] := 'udq';
|
|
opt[pc_mdq] := 'mdq';
|
|
opt[pc_uqm] := 'uqm';
|
|
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}
|