Apple-2gs-SW/ORCA-C
1
0
Fork 0
mirror of https://github.com/byteworksinc/ORCA-C.git synced 2025-02-18 23:30:41 +00:00
Code Issues Projects Releases Wiki Activity

Implement support for doing quad ops without loading operands on stack.

Browse Source 
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.
This commit is contained in:
Stephen Heumann 2021-02-24 19:44:28 -06:00
parent 4020098dd6
commit 043124db93
2 changed files with 229 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
CGI.pas
View File

@ -49,10 +49,12 @@ const
m_adc_dir = $65; m_adc_dir = $65;
m_adc_imm = $69; m_adc_imm = $69;
m_adc_s = $63; m_adc_s = $63;
m_adc_indl = $67;
m_and_abs = $2D; m_and_abs = $2D;
m_and_dir = $25; m_and_dir = $25;
m_and_imm = $29; m_and_imm = $29;
m_and_s = $23; m_and_s = $23;
m_and_indl = $27;
m_asl_a = $0A; m_asl_a = $0A;
m_bcc = $90; m_bcc = $90;
m_bcs = $B0; m_bcs = $B0;
@ -71,6 +73,7 @@ const
m_cmp_imm = $C9; m_cmp_imm = $C9;
m_cmp_long = $CF; m_cmp_long = $CF;
m_cmp_s = $C3; m_cmp_s = $C3;
m_cmp_indl = $C7;
m_cop = $02; m_cop = $02;
m_cpx_abs = 236; m_cpx_abs = 236;
m_cpx_dir = 228; m_cpx_dir = 228;
@ -86,6 +89,7 @@ const
m_eor_dir = 69; m_eor_dir = 69;
m_eor_imm = 73; m_eor_imm = 73;
m_eor_s = 67; m_eor_s = 67;
m_eor_indl = $47;
m_ina = 26; m_ina = 26;
m_inc_abs = 238; m_inc_abs = 238;
m_inc_absX = $FE; m_inc_absX = $FE;
@ -122,6 +126,7 @@ const
m_ora_long = 15; m_ora_long = 15;
m_ora_longX = 31; m_ora_longX = 31;
m_ora_s = 3; m_ora_s = 3;
m_ora_indl = $07;
m_pea = 244; m_pea = 244;
m_pei_dir = 212; m_pei_dir = 212;
m_pha = 72; m_pha = 72;
@ -143,6 +148,7 @@ const
m_sbc_dir = 229; m_sbc_dir = 229;
m_sbc_imm = 233; m_sbc_imm = 233;
m_sbc_s = 227; m_sbc_s = 227;
m_sbc_indl = $E7;
m_sec = 56; m_sec = 56;
m_sep = 226; m_sep = 226;
m_sta_abs = 141; m_sta_abs = 141;

291
Gen.pas
View File

@ -238,6 +238,126 @@ else {if icode^.opcode in [pc_ldo, pc_sro] then}
end; {DoOp} 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); procedure StoreWordOfQuad(offset: integer);
{ Store one word of a quad value to the location specified by } { 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, } { generate one of: pc_bqr, pc_bqx, pc_baq, pc_mpq, pc_umq, }
{ pc_dvq, pc_udq, pc_mdq, pc_uqm } { pc_dvq, pc_udq, pc_mdq, pc_uqm }
procedure GenOp (ops: integer); procedure GenBitwiseOp;
{ generate a 64-bit binary bitwise operation } { generate a 64-bit binary bitwise operation }
{ } { }
{ parameters: } { parameters: }
{ ops - stack version of operation } { ops - stack version of operation }
begin {GenOp} var
GenImplied(m_pla); mop: integer; {machine opcode}
GenNative(ops, direct, 7, nil, 0);
GenNative(m_sta_s, direct, 7, nil, 0); begin {GenBitwiseOp}
GenImplied(m_pla); if SimpleQuadLoad(op^.left) and SimpleQuadLoad(op^.right) then begin
GenNative(ops, direct, 7, nil, 0); case op^.opcode of
GenNative(m_sta_s, direct, 7, nil, 0); pc_bqr: mop := m_ora_imm;
GenImplied(m_pla); pc_bqx: mop := m_eor_imm;
GenNative(ops, direct, 7, nil, 0); pc_baq: mop := m_and_imm;
GenNative(m_sta_s, direct, 7, nil, 0); end; {case}
GenImplied(m_pla); OpOnWordOfQuad(m_lda_imm, op^.left, 6);
GenNative(ops, direct, 7, nil, 0); OpOnWordOfQuad(mop, op^.right, 6);
GenNative(m_sta_s, direct, 7, nil, 0); StoreWordOfQuad(6);
end; {GenOp} 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} begin {GenBinQuad}
gQuad.preference := onStack; if op^.opcode in [pc_bqr,pc_bqx,pc_baq] then
GenTree(op^.left); GenBitwiseOp
gQuad.preference := onStack; else begin
GenTree(op^.right); gQuad.preference := onStack;
case op^.opcode of GenTree(op^.left);
pc_bqr: GenOp(m_ora_s); gQuad.preference := onStack;
pc_bqx: GenOp(m_eor_s); GenTree(op^.right);
pc_baq: GenOp(m_and_s); 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 pc_udq: begin
GenCall(81); {do division} GenCall(82); {do division}
GenImplied(m_pla); {get quotient, discarding remainder} GenImplied(m_pla); {get quotient, discarding remainder}
GenNative(m_sta_s, direct, 7, nil, 0); GenNative(m_sta_s, direct, 7, nil, 0);
GenImplied(m_pla); GenImplied(m_pla);
GenNative(m_sta_s, direct, 7, nil, 0); GenNative(m_sta_s, direct, 7, nil, 0);
GenImplied(m_pla); GenImplied(m_pla);
GenNative(m_sta_s, direct, 7, nil, 0); GenNative(m_sta_s, direct, 7, nil, 0);
GenImplied(m_pla); GenImplied(m_pla);
GenNative(m_sta_s, direct, 7, nil, 0); GenNative(m_sta_s, direct, 7, nil, 0);
end; 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 pc_mdq: begin
GenCall(81); {do division} GenCall(81); {do division}
GenImplied(m_tsc); {discard quotient, leaving remainder} GenImplied(m_tsc); {discard quotient, leaving remainder}
GenImplied(m_clc); GenImplied(m_clc);
GenNative(m_adc_imm, immediate, 8, nil, 0); GenNative(m_adc_imm, immediate, 8, nil, 0);
GenImplied(m_tcs); GenImplied(m_tcs);
end; end;
pc_uqm: begin pc_uqm: begin
GenCall(82); {do division} GenCall(82); {do division}
GenImplied(m_tsc); {discard quotient, leaving remainder} GenImplied(m_tsc); {discard quotient, leaving remainder}
GenImplied(m_clc); GenImplied(m_clc);
GenNative(m_adc_imm, immediate, 8, nil, 0); GenNative(m_adc_imm, immediate, 8, nil, 0);
GenImplied(m_tcs); GenImplied(m_tcs);
end; 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); otherwise: Error(cge1);
end; {case} end; {case}
gQuad.where := onStack; gQuad.where := onStack;
end; {else}
end; {GenBinQuad} end; {GenBinQuad}