mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-11-12 18:05:57 +00:00
a6ef872513
This adds debugging code to detect null pointer dereferences, as well as pointer arithmetic on null pointers (which is also undefined behavior, and can lead to later dereferences of the resulting pointers).
Note that ORCA/Pascal can already detect null pointer dereferences as part of its more general range-checking code. This implementation for ORCA/C will report the same error as ORCA/Pascal ("Subrange exceeded"). However, it does not include any of the other forms of range checking that ORCA/Pascal does, and (unlike in ORCA/Pascal) it is controlled by a separate flag from stack overflow checking.
396 lines
9.4 KiB
Plaintext
396 lines
9.4 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_adq] := 'adq';
|
|
opt[pc_sbq] := 'sbq';
|
|
opt[pc_mpq] := 'mpq';
|
|
opt[pc_umq] := 'umq';
|
|
opt[pc_dvq] := 'dvq';
|
|
opt[pc_udq] := 'udq';
|
|
opt[pc_mdq] := 'mdq';
|
|
opt[pc_uqm] := 'uqm';
|
|
opt[pc_slq] := 'slq';
|
|
opt[pc_sqr] := 'sqr';
|
|
opt[pc_wsr] := 'wsr';
|
|
opt[pc_rbo] := 'rbo';
|
|
opt[pc_rev] := 'rev';
|
|
opt[pc_ckp] := 'ckp';
|
|
opt[pc_ckn] := 'ckn';
|
|
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,pc_bnq,pc_ngq,pc_adq,pc_sbq,
|
|
pc_mpq,pc_umq,pc_dvq,pc_udq,pc_mdq,pc_uqm,pc_slq,pc_sqr,pc_wsr,
|
|
pc_rbo,pc_sll,pc_shr,pc_usr,pc_slr,pc_vsr,pc_ckp,pc_ckn: ;
|
|
|
|
|
|
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,pc_rev:
|
|
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}
|