diff --git a/CGI.pas b/CGI.pas index a3d7e26..0046898 100644 --- a/CGI.pas +++ b/CGI.pas @@ -49,10 +49,12 @@ const m_adc_dir = $65; m_adc_imm = $69; m_adc_s = $63; + m_adc_indl = $67; m_and_abs = $2D; m_and_dir = $25; m_and_imm = $29; m_and_s = $23; + m_and_indl = $27; m_asl_a = $0A; m_bcc = $90; m_bcs = $B0; @@ -71,6 +73,7 @@ const m_cmp_imm = $C9; m_cmp_long = $CF; m_cmp_s = $C3; + m_cmp_indl = $C7; m_cop = $02; m_cpx_abs = 236; m_cpx_dir = 228; @@ -86,6 +89,7 @@ const m_eor_dir = 69; m_eor_imm = 73; m_eor_s = 67; + m_eor_indl = $47; m_ina = 26; m_inc_abs = 238; m_inc_absX = $FE; @@ -122,6 +126,7 @@ const m_ora_long = 15; m_ora_longX = 31; m_ora_s = 3; + m_ora_indl = $07; m_pea = 244; m_pei_dir = 212; m_pha = 72; @@ -143,6 +148,7 @@ const m_sbc_dir = 229; m_sbc_imm = 233; m_sbc_s = 227; + m_sbc_indl = $E7; m_sec = 56; m_sep = 226; m_sta_abs = 141; diff --git a/Gen.pas b/Gen.pas index e03a223..f9274a7 100644 --- a/Gen.pas +++ b/Gen.pas @@ -238,6 +238,126 @@ else {if icode^.opcode in [pc_ldo, pc_sro] then} end; {DoOp} +procedure OpOnWordOfQuad (mop: integer; op: icptr; offset: integer); + +{ Do an operation that has addr modes equivalent to LDA on the } +{ subword at specified offset of the location specified by op. } +{ } +{ The generated code may modify X, and may set Y to offset. } +{ } +{ parameters: } +{ mop - machine opcode } +{ op - node to generate the leaf for } +{ offset - offset of the word to access (0, 2, 4, or 6) } + +var + loc: integer; {stack frame position} + val: integer; {immediate value} + +begin {OpOnWordOfQuad} +case op^.opcode of + + pc_ldo: begin + case mop of + m_lda_imm: mop := m_lda_abs; + m_cmp_imm: mop := m_cmp_abs; + m_adc_imm: mop := m_adc_abs; + m_and_imm: mop := m_and_abs; + m_ora_imm: mop := m_ora_abs; + m_sbc_imm: mop := m_sbc_abs; + m_eor_imm: mop := m_eor_abs; + otherwise: Error(cge1); + end; {case} + if smallMemoryModel then + GenNative(mop, absolute, op^.q+offset, op^.lab, 0) + else + GenNative(mop+2, longAbs, op^.q+offset, op^.lab, 0); + end; {case pc_ldo} + + pc_lod: begin + case mop of + m_lda_imm: mop := m_lda_dir; + m_cmp_imm: mop := m_cmp_dir; + m_adc_imm: mop := m_adc_dir; + m_and_imm: mop := m_and_dir; + m_ora_imm: mop := m_ora_dir; + m_sbc_imm: mop := m_sbc_dir; + m_eor_imm: mop := m_eor_dir; + otherwise: Error(cge1); + end; {case} + loc := LabelToDisp(op^.r) + op^.q + offset; + if loc < 256 then + GenNative(mop, direct, loc, nil, 0) + else begin + GenNative(m_ldx_imm, immediate, loc, nil, 0); + GenNative(mop+$10, direct, 0, nil, 0); + end; {else} + end; {case pc_lod} + + pc_ldc: begin + case offset of + 0: val := long(op^.qval.lo).lsw; + 2: val := long(op^.qval.lo).msw; + 4: val := long(op^.qval.hi).lsw; + 6: val := long(op^.qval.hi).msw; + otherwise: Error(cge1); + end; {case} + GenNative(mop, immediate, val, nil, 0); + end; {case pc_ldc} + + pc_ind: begin + case mop of + m_lda_imm: mop := m_lda_indl; + m_cmp_imm: mop := m_cmp_indl; + m_adc_imm: mop := m_adc_indl; + m_and_imm: mop := m_and_indl; + m_ora_imm: mop := m_ora_indl; + m_sbc_imm: mop := m_sbc_indl; + m_eor_imm: mop := m_eor_indl; + otherwise: Error(cge1); + end; {case} + if op^.left^.opcode = pc_lod then + loc := LabelToDisp(op^.left^.r) + op^.left^.q; + if (op^.left^.opcode <> pc_lod) or (loc > 255) then + Error(cge1); + if offset = 0 then + GenNative(mop, direct, loc, nil, 0) + else begin + GenNative(m_ldy_imm, immediate, offset, nil, 0); + GenNative(mop+$10, direct, loc, nil, 0); + end; {else} + end; {case pc_ind} + + otherwise: + Error(cge1); + end; {case} +end; {OpOnWordOfQuad} + + +function SimpleQuadLoad(op: icptr): boolean; + +{ Is op a simple load operation on a cg(U)Quad, which can be } +{ broken up into word operations handled by OpOnWordOfQuad? } +{ } +{ parameters: } +{ op - node to check } + +begin {SimpleQuadLoad} +case op^.opcode of + pc_ldo,pc_lod,pc_ldc: + SimpleQuadLoad := true; + + pc_ind: + SimpleQuadLoad := + (op^.left^.opcode = pc_lod) + and (LabelToDisp(op^.left^.r) + op^.left^.q < 256); + + otherwise: + SimpleQuadLoad := false; + end; {case} +end; {SimpleQuadLoad} + + procedure StoreWordOfQuad(offset: integer); { Store one word of a quad value to the location specified by } @@ -4896,91 +5016,126 @@ procedure GenTree {op: icptr}; { generate one of: pc_bqr, pc_bqx, pc_baq, pc_mpq, pc_umq, } { pc_dvq, pc_udq, pc_mdq, pc_uqm } - procedure GenOp (ops: integer); + procedure GenBitwiseOp; { generate a 64-bit binary bitwise operation } { } { parameters: } { ops - stack version of operation } - begin {GenOp} - GenImplied(m_pla); - GenNative(ops, direct, 7, nil, 0); - GenNative(m_sta_s, direct, 7, nil, 0); - GenImplied(m_pla); - GenNative(ops, direct, 7, nil, 0); - GenNative(m_sta_s, direct, 7, nil, 0); - GenImplied(m_pla); - GenNative(ops, direct, 7, nil, 0); - GenNative(m_sta_s, direct, 7, nil, 0); - GenImplied(m_pla); - GenNative(ops, direct, 7, nil, 0); - GenNative(m_sta_s, direct, 7, nil, 0); - end; {GenOp} + var + mop: integer; {machine opcode} + + begin {GenBitwiseOp} + if SimpleQuadLoad(op^.left) and SimpleQuadLoad(op^.right) then begin + case op^.opcode of + pc_bqr: mop := m_ora_imm; + pc_bqx: mop := m_eor_imm; + pc_baq: mop := m_and_imm; + end; {case} + OpOnWordOfQuad(m_lda_imm, op^.left, 6); + OpOnWordOfQuad(mop, op^.right, 6); + StoreWordOfQuad(6); + OpOnWordOfQuad(m_lda_imm, op^.left, 4); + OpOnWordOfQuad(mop, op^.right, 4); + StoreWordOfQuad(4); + OpOnWordOfQuad(m_lda_imm, op^.left, 2); + OpOnWordOfQuad(mop, op^.right, 2); + StoreWordOfQuad(2); + OpOnWordOfQuad(m_lda_imm, op^.left, 0); + OpOnWordOfQuad(mop, op^.right, 0); + StoreWordOfQuad(0); + gQuad.where := gQuad.preference; + end {if} + else begin + case op^.opcode of + pc_bqr: mop := m_ora_s; + pc_bqx: mop := m_eor_s; + pc_baq: mop := m_and_s; + end; {case} + gQuad.preference := onStack; + GenTree(op^.left); + gQuad.preference := onStack; + GenTree(op^.right); + GenImplied(m_pla); + GenNative(mop, direct, 7, nil, 0); + GenNative(m_sta_s, direct, 7, nil, 0); + GenImplied(m_pla); + GenNative(mop, direct, 7, nil, 0); + GenNative(m_sta_s, direct, 7, nil, 0); + GenImplied(m_pla); + GenNative(mop, direct, 7, nil, 0); + GenNative(m_sta_s, direct, 7, nil, 0); + GenImplied(m_pla); + GenNative(mop, direct, 7, nil, 0); + GenNative(m_sta_s, direct, 7, nil, 0); + gQuad.where := onStack; + end; {else} + end; {GenBitwiseOp} begin {GenBinQuad} - gQuad.preference := onStack; - GenTree(op^.left); - gQuad.preference := onStack; - GenTree(op^.right); - case op^.opcode of - pc_bqr: GenOp(m_ora_s); - pc_bqx: GenOp(m_eor_s); - pc_baq: GenOp(m_and_s); + if op^.opcode in [pc_bqr,pc_bqx,pc_baq] then + GenBitwiseOp + else begin + gQuad.preference := onStack; + GenTree(op^.left); + gQuad.preference := onStack; + GenTree(op^.right); + case op^.opcode of + pc_mpq: GenCall(79); - pc_mpq: GenCall(79); + pc_umq: GenCall(80); - pc_umq: GenCall(80); + pc_dvq: begin + GenCall(81); {do division} + GenImplied(m_pla); {get quotient, discarding remainder} + GenNative(m_sta_s, direct, 7, nil, 0); + GenImplied(m_pla); + GenNative(m_sta_s, direct, 7, nil, 0); + GenImplied(m_pla); + GenNative(m_sta_s, direct, 7, nil, 0); + GenImplied(m_pla); + GenNative(m_sta_s, direct, 7, nil, 0); + end; - pc_dvq: begin - GenCall(81); {do division} - GenImplied(m_pla); {get quotient, discarding remainder} - GenNative(m_sta_s, direct, 7, nil, 0); - GenImplied(m_pla); - GenNative(m_sta_s, direct, 7, nil, 0); - GenImplied(m_pla); - GenNative(m_sta_s, direct, 7, nil, 0); - GenImplied(m_pla); - GenNative(m_sta_s, direct, 7, nil, 0); - end; - - pc_udq: begin - GenCall(82); {do division} - GenImplied(m_pla); {get quotient, discarding remainder} - GenNative(m_sta_s, direct, 7, nil, 0); - GenImplied(m_pla); - GenNative(m_sta_s, direct, 7, nil, 0); - GenImplied(m_pla); - GenNative(m_sta_s, direct, 7, nil, 0); - GenImplied(m_pla); - GenNative(m_sta_s, direct, 7, nil, 0); - end; + pc_udq: begin + GenCall(82); {do division} + GenImplied(m_pla); {get quotient, discarding remainder} + GenNative(m_sta_s, direct, 7, nil, 0); + GenImplied(m_pla); + GenNative(m_sta_s, direct, 7, nil, 0); + GenImplied(m_pla); + GenNative(m_sta_s, direct, 7, nil, 0); + GenImplied(m_pla); + GenNative(m_sta_s, direct, 7, nil, 0); + end; - pc_mdq: begin - GenCall(81); {do division} - GenImplied(m_tsc); {discard quotient, leaving remainder} - GenImplied(m_clc); - GenNative(m_adc_imm, immediate, 8, nil, 0); - GenImplied(m_tcs); - end; + pc_mdq: begin + GenCall(81); {do division} + GenImplied(m_tsc); {discard quotient, leaving remainder} + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, 8, nil, 0); + GenImplied(m_tcs); + end; - pc_uqm: begin - GenCall(82); {do division} - GenImplied(m_tsc); {discard quotient, leaving remainder} - GenImplied(m_clc); - GenNative(m_adc_imm, immediate, 8, nil, 0); - GenImplied(m_tcs); - end; + pc_uqm: begin + GenCall(82); {do division} + GenImplied(m_tsc); {discard quotient, leaving remainder} + GenImplied(m_clc); + GenNative(m_adc_imm, immediate, 8, nil, 0); + GenImplied(m_tcs); + end; - pc_slq: GenCall(85); + pc_slq: GenCall(85); - pc_sqr: GenCall(86); + pc_sqr: GenCall(86); - pc_wsr: GenCall(87); + pc_wsr: GenCall(87); - otherwise: Error(cge1); - end; {case} - gQuad.where := onStack; + otherwise: Error(cge1); + end; {case} + gQuad.where := onStack; + end; {else} end; {GenBinQuad}