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}