From 043124db9372e0d103c21817247e700b2ee6c747 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Wed, 24 Feb 2021 19:44:28 -0600 Subject: [PATCH] Implement support for doing quad ops without loading operands on stack. This works when both operands are simple loads, such that they can be broken up into operations on their subwords in a standard format. Currently, this is implemented for bitwise binary ops, but it can also be expanded to arithmetic, etc. --- CGI.pas | 6 ++ Gen.pas | 291 +++++++++++++++++++++++++++++++++++++++++++------------- 2 files changed, 229 insertions(+), 68 deletions(-) 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}