ORCA-C/Gen.pas
Stephen Heumann 6b7414384f Fix code generation bug for indirect load/store of 64-bit values.
The issue was that if a 64-bit value was being loaded via one pointer and stored via another, the load and store parts could both be using y for their indexing, but they would clash with each other, potentially leading to loads coming from the wrong place.

Here are some examples that illustrate the problem:

/* example 1 */
int main(void) {
        struct {
                char c[16];
                long long x;
        } s = {.x = 0x1234567890abcdef}, *sp = &s;
        long long ll, *llp = ≪
        *llp = sp->x;
        return ll != s.x; // should return 0
}

/* example 2 */
int main(void) {
        struct {
                char c[16];
                long long x;
        } s = {.x = 0x1234567890abcdef}, *sp = &s;
        long long ll, *llp = ≪
        unsigned i = 0;
        *llp = sp[i].x;
        return ll != s.x; // should return 0
}

/* example 3 */
int main(void) {
        long long x[2] = {0, 0x1234567890abcdef}, *xp = x;
        long long ll, *llp = ≪
        unsigned i = 1;
        *llp = xp[i];
        return ll != x[1]; // should return 0
}
2024-04-10 20:49:17 -05:00

7920 lines
256 KiB
ObjectPascal

{$optimize 7}
{---------------------------------------------------------------}
{ }
{ Gen }
{ }
{ Generates native code from intermediate code instructions. }
{ }
{---------------------------------------------------------------}
unit Gen;
interface
{$segment 'gen'}
{$LibPrefix '0/obj/'}
uses CCommon, CGI, CGC, ObjOut, Native;
{---------------------------------------------------------------}
function LabelToDisp (lab: integer): integer;
{ convert a local label number to a stack frame displacement }
{ }
{ parameters: }
{ lab - label number }
procedure Gen (blk: blockPtr);
{ Generates native code for a list of blocks }
{ }
{ parameters: }
{ blk - first of the list of blocks }
{---------------------------------------------------------------}
implementation
const
{longword/quadword locations}
A_X = 1; {longword only}
onStack = 2;
inPointer = 4;
localAddress = 8;
globalLabel = 16;
constant = 32;
nowhere = 64;
inStackLoc = 128;
{stack frame locations}
{---------------------}
returnSize = 3; {size of return address}
type
{possible locations for 4 byte values}
longType = record {description of current four byte value}
preference: integer; {where you want the value (bitmask)}
where: integer; {where the value is at}
fixedDisp: boolean; {is the displacement a fixed value?}
isLong: boolean; {is long addr required for named labs?}
disp: integer; {fixed displacement/local addr}
lval: longint; {value}
lab: stringPtr; {global label name}
end;
{possible locations for 8 byte values}
{note: these always have fixed disp}
quadType = record {description of current 8 byte value}
preference: integer; {where you want the value (single value)}
where: integer; {where the value is at}
disp: integer; {fixed displacement/local addr}
lval: longlong; {value}
lab: stringPtr; {global label name}
end;
var
gLong: longType; {info about last long value}
gQuad: quadType; {info about last quad value}
namePushed: boolean; {has a name been pushed in this proc?}
skipLoad: boolean; {skip load for a pc_lli, etc?}
stackSaveDepth: integer; {nesting depth of saved stack positions}
argsSize: integer; {total size of argument to a function}
isQuadFunction: boolean; {is the return type cg(U)Quad?}
{stack frame locations}
{---------------------}
bankLoc: integer; {disp in dp where bank reg is stored}
dworkLoc: integer; {disp in dp of 4 byte work spage for cg}
funLoc: integer; {loc of fn ret value in stack frame}
localSize: integer; {local space for current proc}
parameterSize: integer; {# bytes of parameters for current proc}
stackLoc: integer; {disp in dp where stack reg is stored}
{---------------------------------------------------------------}
procedure GenTree (op: icptr); forward;
procedure OperA (mop: integer; op: icptr);
{ Do an operation on op that has addr modes equivalent to STA }
{ }
{ parameters: }
{ op - node to generate the leaf for }
{ mop - operation }
var
loc: integer; {stack frame position}
opcode: pcodes; {temp storage}
begin {OperA}
opcode := op^.opcode;
case opcode of
pc_ldo,pc_gil,pc_gli,pc_gdl,pc_gld: begin
case mop of
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 opcode = pc_gil then
GenNative(m_inc_abs, absolute, op^.q, op^.lab, 0)
else if opcode = pc_gdl then
GenNative(m_dec_abs, absolute, op^.q, op^.lab, 0);
if smallMemoryModel then
GenNative(mop, absolute, op^.q, op^.lab, 0)
else
GenNative(mop+2, longAbs, op^.q, op^.lab, 0);
if opcode in [pc_gli,pc_gld] then begin
if mop in [m_sbc_dir,m_cmp_dir] then
GenImplied(m_php);
if opcode = pc_gli then
GenNative(m_inc_abs, absolute, op^.q, op^.lab, 0)
else {if opcode = pc_gld then}
GenNative(m_dec_abs, absolute, op^.q, op^.lab, 0);
if mop in [m_sbc_dir,m_cmp_dir] then
GenImplied(m_plp);
end; {else}
end; {case pc_ldo,pc_gil,pc_gli,pc_gdl,pc_gld}
pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl: begin
case mop of
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);
if opcode = pc_lod then
loc := loc + op^.q;
if opcode = pc_lil then
GenNative(m_inc_dir, direct, loc, nil, 0)
else if opcode = pc_ldl then
GenNative(m_dec_dir, direct, loc, nil, 0);
GenNative(mop, direct, loc, nil, 0);
if opcode in [pc_lli,pc_lld] then begin
if mop in [m_sbc_dir,m_cmp_dir] then
GenImplied(m_php);
if opcode = pc_lli then
GenNative(m_inc_dir, direct, loc, nil, 0)
else {if opc = pc_lld then}
GenNative(m_dec_dir, direct, loc, nil, 0);
if mop in [m_sbc_dir,m_cmp_dir] then
GenImplied(m_plp);
end; {else}
end; {case pc_lod,pc_lli,pc_lil,pc_lld,pc_ldl}
pc_ldc:
GenNative(mop, immediate, op^.q, nil, 0);
otherwise:
Error(cge1);
end; {case}
end; {OperA}
function Complex (op: icptr): boolean;
{ determine if loading the intermediate code involves anything }
{ but one reg }
{ }
{ parameters: }
{ code - intermediate code to check }
{ }
{ NOTE: for one and two byte values only!!! }
begin {Complex}
Complex := true;
if op^.opcode in [pc_ldo,pc_ldc] then
Complex := false
else if op^.opcode in [pc_gil,pc_gli,pc_gdl,pc_gld] then
Complex := smallMemoryModel
else if op^.opcode = pc_lod then
if LabelToDisp(op^.r) + op^.q < 256 then
Complex := false
else if op^.opcode in [pc_lli,pc_lil,pc_ldl,pc_lld] then
if LabelToDisp(op^.r) < 256 then
Complex := false;
if op^.optype in [cgByte,cgUByte] then
Complex := true;
end; {Complex}
procedure DoOp(op_imm, op_abs, op_dir: integer; icode: icptr; disp: integer);
{ Do an operation. }
{ }
{ Parameters: }
{ op_imm,op_abs,op_dir - op codes for the various }
{ addressing modes }
{ icode - intermediate code record }
{ disp - disp past the location (1 or 2) }
var
val: integer; {value for immediate operations}
lval: longint; {long value for immediate operations}
begin {DoOp}
if icode^.opcode = pc_ldc then begin
lval := icode^.lval;
if disp = 0 then
val := long(lval).lsw
else
val := long(lval).msw;
GenNative(op_imm, immediate, val, nil, 0);
end {if}
else if icode^.opcode in [pc_lod,pc_str] then
GenNative(op_dir, direct, LabelToDisp(icode^.r) + icode^.q + disp, nil, 0)
else {if icode^.opcode in [pc_ldo, pc_sro] then}
GenNative(op_abs, absolute, icode^.q + disp, icode^.lab, 0);
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);
offset := offset + op^.q;
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}
function SimplestQuadLoad(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 }
{ and for which those operations will not modify X or Y. }
{ }
{ parameters: }
{ op - node to check }
begin {SimplestQuadLoad}
case op^.opcode of
pc_ldo,pc_ldc:
SimplestQuadLoad := true;
pc_lod:
SimplestQuadLoad := LabelToDisp(op^.r) + op^.q < 250;
pc_ind,otherwise:
SimplestQuadLoad := false;
end; {case}
end; {SimplestQuadLoad}
procedure StoreWordOfQuad(offset: integer);
{ Store one word of a quad value to the location specified by }
{ gQuad.preference. The word value to store must be in A. }
{ }
{ The generated code may modify X, and may set Y to offset. }
{ It does not modify A or the carry flag. }
{ }
{ parameters: }
{ offset - offset of the word to store (0, 2, 4, or 6) }
{ }
{ Note: If gQuad.preference is onStack, this just generates a }
{ PHA. That is suitable if storing a value starting from }
{ the most significant word, but not in other cases. For }
{ other gQuad.preference values, any order is okay. }
begin {StoreWordOfQuad}
case gQuad.preference of
localAddress: begin
if gQuad.disp+offset <= 255 then
GenNative(m_sta_dir, direct, gQuad.disp+offset, nil, 0)
else begin
GenNative(m_ldx_imm, immediate, gQuad.disp+offset, nil, 0);
GenNative(m_sta_dirX, direct, 0, nil, 0);
end; {else}
end;
globalLabel: begin
if smallMemoryModel then
GenNative(m_sta_abs, absolute, gQuad.disp+offset, gQuad.lab, 0)
else
GenNative(m_sta_long, longabsolute, gQuad.disp+offset, gQuad.lab, 0);
end;
inPointer: begin
if (gQuad.disp > 255) or (gQuad.disp < 0) then
Error(cge1);
if offset = 0 then
GenNative(m_sta_indl, direct, gQuad.disp, nil, 0)
else begin
GenNative(m_ldy_imm, immediate, offset, nil, 0);
GenNative(m_sta_indly, direct, gQuad.disp, nil, 0);
end; {else}
end;
inStackLoc:
GenNative(m_sta_s, direct, gQuad.disp+offset, nil, 0);
onStack:
GenImplied(m_pha);
nowhere: ; {discard the value}
otherwise: Error(cge1);
end; {case}
end; {StoreWordOfQuad}
procedure GetPointer (op: icptr);
{ convert a tree into a usable pointer for indirect }
{ loads/stores }
{ }
{ parameters: }
{ op - pointer tree }
begin {GetPointer}
gLong.preference := A_X+inPointer+localAddress+globalLabel;
GenTree(op);
if gLong.where = onStack then begin
GenImplied(m_pla);
GenImplied(m_plx);
gLong.where := A_X;
end; {if}
if gLong.where = A_X then begin
GenNative(m_sta_dir, direct, dworkLoc, nil, 0);
GenNative(m_stx_dir, direct, dworkLoc+2, nil, 0);
gLong.where := inPointer;
gLong.fixedDisp := true;
gLong.disp := dworkLoc;
end; {else if}
end; {GetPointer}
procedure IncAddr (size: integer);
{ add a two byte constant to a four byte value - generally an }
{ address }
{ }
{ parameters: }
{ size - integer to add }
var
lab1: integer; {branch point}
begin {IncAddr}
if size <> 0 then
case gLong.where of
onStack: begin
lab1 := GenLabel;
GenImplied(m_pla);
if size = 1 then begin
GenImplied(m_ina);
GenNative(m_bne, relative, lab1, nil, 0);
end {if}
else begin
GenImplied(m_clc);
GenNative(m_adc_imm, immediate, size, nil, 0);
GenNative(m_bcc, relative, lab1, nil, 0);
end; {else}
GenImplied(m_plx);
GenImplied(m_inx);
GenImplied(m_phx);
GenLab(lab1);
GenImplied(m_pha);
end;
A_X: begin
lab1 := GenLabel;
if size = 1 then begin
GenImplied(m_ina);
GenNative(m_bne, relative, lab1, nil, 0);
end {if}
else begin
GenImplied(m_clc);
GenNative(m_adc_imm, immediate, size, nil, 0);
GenNative(m_bcc, relative, lab1, nil, 0);
end; {else}
GenImplied(m_inx);
GenLab(lab1);
end;
inPointer:
if gLong.fixedDisp then begin
gLong.fixedDisp := false;
GenNative(m_ldy_imm, immediate, size, nil, 0);
end {if}
else if size <= 4 then begin
while size <> 0 do begin
GenImplied(m_iny);
size := size - 1;
end; {while}
end {else if}
else begin
GenImplied(m_tya);
GenImplied(m_clc);
GenNative(m_adc_imm, immediate, size, nil, 0);
GenImplied(m_tay);
end; {else}
localAddress,globalLabel:
gLong.disp := gLong.disp+size;
otherwise:
Error(cge1);
end; {case}
end; {IncAddr}
procedure LoadX (op: icptr);
{ Load X with a two byte value }
{ }
{ parameters: }
{ op - value to load }
var
q, r: integer;
lab: stringPtr;
begin {LoadX}
q := op^.q;
r := op^.r;
lab := op^.lab;
case op^.opcode of
pc_lao,pc_lda:
Error(cge1);
pc_ldc:
GenNative(m_ldx_imm, immediate, q, nil, 0);
pc_ldo:
GenNative(m_ldx_abs, absolute, q, lab, 0);
pc_gli: begin
GenNative(m_ldx_abs, absolute, q, lab, 0);
GenNative(m_inc_abs, absolute, q, lab, 0);
end; {if}
pc_gil: begin
GenNative(m_inc_abs, absolute, q, lab, 0);
GenNative(m_ldx_abs, absolute, q, lab, 0);
end; {if}
pc_gld: begin
GenNative(m_ldx_abs, absolute, q, lab, 0);
GenNative(m_dec_abs, absolute, q, lab, 0);
end; {if}
pc_gdl: begin
GenNative(m_dec_abs, absolute, q, lab, 0);
GenNative(m_ldx_abs, absolute, q, lab, 0);
end; {if}
pc_lod:
GenNative(m_ldx_dir, direct, LabelToDisp(r) + q, nil, 0);
pc_lli: begin
GenNative(m_ldx_dir, direct, LabelToDisp(r), nil, 0);
GenNative(m_inc_dir, direct, LabelToDisp(r), nil, 0);
end; {if}
pc_lil: begin
GenNative(m_inc_dir, direct, LabelToDisp(r), nil, 0);
GenNative(m_ldx_dir, direct, LabelToDisp(r), nil, 0);
end; {if}
pc_lld: begin
GenNative(m_ldx_dir, direct, LabelToDisp(r), nil, 0);
GenNative(m_dec_dir, direct, LabelToDisp(r), nil, 0);
end; {if}
pc_ldl: begin
GenNative(m_dec_dir, direct, LabelToDisp(r), nil, 0);
GenNative(m_ldx_dir, direct, LabelToDisp(r), nil, 0);
end; {if}
otherwise:
Error(cge1);
end; {case}
end; {LoadX}
function NeedsCondition (opcode: pcodes): boolean;
{ See if the operation is one that doesn't set the condition }
{ code reliably }
{ }
{ Parameters: }
{ opcodes - operation to check }
{ }
{ Returns: True if the condition code is not set properly for }
{ an operand type of cgByte,cgUByte,cgWord,cgUWord, else }
{ false }
begin {NeedsCondition}
NeedsCondition := opcode in
[pc_and,pc_ior,pc_cui,pc_cup,pc_ldl,pc_lil,pc_lld,
pc_lli,pc_gil,pc_gli,pc_gdl,pc_gld,pc_iil,pc_ili,pc_idl,pc_ild,
pc_cop,pc_cpo,pc_cpi,pc_dvi,pc_mpi,pc_adi,pc_sbi,pc_mod,pc_bno,
pc_udi,pc_uim,pc_umi,pc_cnv,pc_rbo,pc_shl,pc_shr,pc_usr,pc_lbf,
pc_lbu,pc_cbf,pc_tri];
end; {NeedsCondition}
function SameLoc (load, save: icptr): boolean;
{ See if load and save represent the same location (which must }
{ be a direct page value or a global label). }
{ }
{ parameters: }
{ load - load operation }
{ save - save operation }
{ }
{ Returns: True the the same location is used, else false }
begin {SameLoc}
SameLoc := false;
if save <> nil then begin
if load^.opcode = pc_lod then begin
if LabelToDisp(load^.r) + load^.q < 254 then
if save^.opcode = pc_str then
if save^.q = load^.q then
if save^.r = load^.r then
SameLoc := true;
end {if}
else if smallMemoryModel then
if load^.opcode = pc_ldo then
if save^.opcode = pc_sro then
if load^.lab^ = save^.lab^ then
if load^.q = save^.q then
SameLoc := true;
end; {if}
end; {SameLoc}
procedure SaveRetValue (optype: baseTypeEnum);
{ save a value returned by a function }
{ }
{ parameters: }
{ optype - function type }
begin {SaveRetValue}
if optype in [cgLong,cgULong] then begin
if (A_X & gLong.preference) = 0 then begin
gLong.where := onStack;
GenImplied(m_phx);
GenImplied(m_pha);
end
else
gLong.where := A_X;
end {if}
else if optype in [cgReal,cgDouble,cgExtended,cgComp] then
GenCall(8);
end; {SaveRetValue}
procedure GenAdlSbl (op, save: icptr);
{ generate code for pc_adl, pc_sbl }
{ }
{ parameters: }
{ op - pc_adl or pc_sbl operation }
{ save - save location (pc_str or pc_sro) or nil }
var
bcc,clc,adc_imm,inc_dir,adc_abs, {for op-code insensitive code}
adc_dir,inc_abs,adc_s: integer;
disp: integer; {direct page location}
lab1: integer; {label number}
nd: icptr; {for swapping left/right children}
opcode: pcodes; {temp storage; for efficiency}
simpleStore: boolean; {is the store absolute or direct?}
val: longint; {long constant value}
function Simple (icode: icptr): boolean;
{ See if the intermediate code is simple; i.e., can be }
{ reached by direct page or absolute addressing. }
begin {Simple}
Simple := false;
if icode^.opcode = pc_ldc then
Simple := true
else if icode^.opcode in [pc_lod,pc_str] then begin
if LabelToDisp(icode^.r) + icode^.q < 254 then
Simple := true;
end {else if}
else if icode^.opcode in [pc_ldo,pc_sro] then
Simple := smallMemoryModel;
end; {Simple}
begin {GenAdlSbl}
{determine where the result goes}
if save <> nil then
gLong.preference :=
A_X+onStack+inPointer+localAddress+globalLabel+constant;
{set up the master instructions}
opcode := op^.opcode;
if opcode = pc_adl then begin
clc := m_clc;
bcc := m_bcc;
adc_imm := m_adc_imm;
adc_abs := m_adc_abs;
adc_dir := m_adc_dir;
adc_s := m_adc_s;
inc_dir := m_inc_dir;
inc_abs := m_inc_abs;
end {if}
else begin
clc := m_sec;
bcc := m_bcs;
adc_imm := m_sbc_imm;
adc_abs := m_sbc_abs;
adc_dir := m_sbc_dir;
adc_s := m_sbc_s;
inc_dir := m_dec_dir;
inc_abs := m_dec_abs;
end; {else}
{if the lhs is a constant, swap the nodes}
if ((op^.left^.opcode = pc_ldc) and (opcode = pc_adl)) then begin
nd := op^.left;
op^.left := op^.right;
op^.right := nd;
end; {if}
{handle a constant rhs}
if op^.right^.opcode = pc_ldc then
val := op^.right^.lval
else
val := -1;
if SameLoc(op^.left, save) and (long(val).msw = 0) then begin
lab1 := GenLabel;
if val = 1 then begin
if opcode = pc_adl then begin
DoOp(0, m_inc_abs, m_inc_dir, op^.left, 0);
GenNative(m_bne, relative, lab1, nil, 0);
DoOp(0, m_inc_abs, m_inc_dir, op^.left, 2);
GenLab(lab1);
end {if}
else {if opcode = pc_sbl then} begin
DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0);
GenNative(m_beq, relative, lab1, nil, 0);
DoOp(0, m_dec_abs, m_dec_dir, op^.left, 0);
GenLab(lab1);
DoOp(0, m_dec_abs, m_dec_dir, op^.left, 2);
end; {else}
end {if}
else begin {rhs in [2..65535]}
GenImplied(clc);
DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0);
GenNative(adc_imm, immediate, long(val).lsw, nil, 0);
DoOp(0, m_sta_abs, m_sta_dir, op^.left, 0);
GenNative(bcc, relative, lab1, nil, 0);
if opcode = pc_adl then
DoOp(0, m_inc_abs, m_inc_dir, op^.left, 2)
else
DoOp(0, m_dec_abs, m_dec_dir, op^.left, 2);
GenLab(lab1);
end; {else}
end {if constant rhs}
else begin
simpleStore := false;
if save <> nil then
simpleStore := Simple(save);
if (opcode = pc_adl) and Simple(op^.left) then begin
nd := op^.left;
op^.left := op^.right;
op^.right := nd;
end; {if}
if simpleStore and Simple(op^.right) then begin
if Simple(op^.left) then begin
GenImplied(clc);
DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 0);
DoOp(adc_imm, adc_abs, adc_dir, op^.right, 0);
DoOp(0, m_sta_abs, m_sta_dir, save, 0);
DoOp(m_lda_imm, m_lda_abs, m_lda_dir, op^.left, 2);
DoOp(adc_imm, adc_abs, adc_dir, op^.right, 2);
DoOp(0, m_sta_abs, m_sta_dir, save, 2);
end {if}
else begin
gLong.preference := A_X;
GenTree(op^.left);
GenImplied(clc);
if gLong.where = onStack then
GenImplied(m_pla);
DoOp(adc_imm, adc_abs, adc_dir, op^.right, 0);
DoOp(0, m_sta_abs, m_sta_dir, save, 0);
if gLong.where = onStack then
GenImplied(m_pla)
else
GenImplied(m_txa);
DoOp(adc_imm, adc_abs, adc_dir, op^.right, 2);
DoOp(0, m_sta_abs, m_sta_dir, save, 2);
end; {else}
end {if}
else if (save = nil) and Simple(op^.right) then begin
gLong.preference := gLong.preference & A_X;
GenTree(op^.left);
GenImplied(clc);
if gLong.where = onStack then begin
GenImplied(m_pla);
DoOp(adc_imm, adc_abs, adc_dir, op^.right, 0);
GenImplied(m_pha);
GenNative(m_lda_s, direct, 3, nil, 0);
DoOp(adc_imm, adc_abs, adc_dir, op^.right, 2);
GenNative(m_sta_s, direct, 3, nil, 0);
end {if}
else begin
DoOp(adc_imm, adc_abs, adc_dir, op^.right, 0);
GenImplied(m_tay);
GenImplied(m_txa);
DoOp(adc_imm, adc_abs, adc_dir, op^.right, 2);
GenImplied(m_tax);
GenImplied(m_tya);
end; {else}
end {else if}
else begin {doing it the hard way}
gLong.preference := onStack;
GenTree(op^.right);
gLong.preference := onStack;
GenTree(op^.left);
GenImplied(clc);
GenImplied(m_pla);
GenNative(adc_s, direct, 3, nil, 0);
GenNative(m_sta_s, direct, 3, nil, 0);
GenImplied(m_pla);
GenNative(adc_s, direct, 3, nil, 0);
GenNative(m_sta_s, direct, 3, nil, 0);
if save = nil then
gLong.where := onStack
else if save^.opcode = pc_str then begin
disp := LabelToDisp(save^.r) + save^.q;
if disp < 254 then begin
GenImplied(m_pla);
GenNative(m_sta_dir, direct, disp, nil, 0);
GenImplied(m_pla);
GenNative(m_sta_dir, direct, disp+2, nil, 0);
end {else if}
else begin
GenNative(m_ldx_imm, immediate, disp, nil, 0);
GenImplied(m_pla);
GenNative(m_sta_dirX, direct, 0, nil, 0);
GenImplied(m_pla);
GenNative(m_sta_dirX, direct, 2, nil, 0);
end; {else}
end {else if}
else {if save^.opcode = pc_sro then} begin
GenImplied(m_pla);
if smallMemoryModel then
GenNative(m_sta_abs, absolute, save^.q, save^.lab, 0)
else
GenNative(m_sta_long, longabsolute, save^.q, save^.lab, 0);
GenImplied(m_pla);
if smallMemoryModel then
GenNative(m_sta_abs, absolute, save^.q+2, save^.lab, 0)
else
GenNative(m_sta_long, longabsolute, save^.q+2, save^.lab, 0);
end; {else}
end; {else}
end; {else}
end; {GenAdlSbl}
procedure GenAdqSbq (op: icptr);
{ generate code for pc_adq, pc_sbq }
{ }
{ parameters: }
{ op - pc_adq or pc_sbq operation }
begin {GenAdqSbq}
if op^.opcode = pc_adq then begin
if SimpleQuadLoad(op^.left) and SimpleQuadLoad(op^.right) then begin
gQuad.where := gQuad.preference;
if gQuad.preference = onStack then begin
GenImplied(m_tsc);
GenImplied(m_sec);
GenNative(m_sbc_imm, immediate, 8, nil, 0);
GenImplied(m_tcs);
gQuad.preference := inStackLoc;
gQuad.disp := 1;
end; {if}
GenImplied(m_clc);
OpOnWordOfQuad(m_lda_imm, op^.left, 0);
OpOnWordOfQuad(m_adc_imm, op^.right, 0);
StoreWordOfQuad(0);
OpOnWordOfQuad(m_lda_imm, op^.left, 2);
OpOnWordOfQuad(m_adc_imm, op^.right, 2);
StoreWordOfQuad(2);
OpOnWordOfQuad(m_lda_imm, op^.left, 4);
OpOnWordOfQuad(m_adc_imm, op^.right, 4);
StoreWordOfQuad(4);
OpOnWordOfQuad(m_lda_imm, op^.left, 6);
OpOnWordOfQuad(m_adc_imm, op^.right, 6);
StoreWordOfQuad(6);
end {if}
else begin
gQuad.preference := onStack;
GenTree(op^.right);
gQuad.preference := onStack;
GenTree(op^.left);
GenImplied(m_clc);
GenImplied(m_pla);
GenNative(m_adc_s, direct, 7, nil, 0);
GenNative(m_sta_s, direct, 7, nil, 0);
GenImplied(m_pla);
GenNative(m_adc_s, direct, 7, nil, 0);
GenNative(m_sta_s, direct, 7, nil, 0);
GenImplied(m_pla);
GenNative(m_adc_s, direct, 7, nil, 0);
GenNative(m_sta_s, direct, 7, nil, 0);
GenImplied(m_pla);
GenNative(m_adc_s, direct, 7, nil, 0);
GenNative(m_sta_s, direct, 7, nil, 0);
gQuad.where := onStack;
end; {else}
end {if}
else {if op^.opcode = pc_sbq then} begin
if SimpleQuadLoad(op^.left) and SimpleQuadLoad(op^.right) then begin
gQuad.where := gQuad.preference;
if gQuad.preference = onStack then begin
GenImplied(m_tsc);
GenImplied(m_sec);
GenNative(m_sbc_imm, immediate, 8, nil, 0);
GenImplied(m_tcs);
gQuad.preference := inStackLoc;
gQuad.disp := 1;
end; {if}
GenImplied(m_sec);
OpOnWordOfQuad(m_lda_imm, op^.left, 0);
OpOnWordOfQuad(m_sbc_imm, op^.right, 0);
StoreWordOfQuad(0);
OpOnWordOfQuad(m_lda_imm, op^.left, 2);
OpOnWordOfQuad(m_sbc_imm, op^.right, 2);
StoreWordOfQuad(2);
OpOnWordOfQuad(m_lda_imm, op^.left, 4);
OpOnWordOfQuad(m_sbc_imm, op^.right, 4);
StoreWordOfQuad(4);
OpOnWordOfQuad(m_lda_imm, op^.left, 6);
OpOnWordOfQuad(m_sbc_imm, op^.right, 6);
StoreWordOfQuad(6);
end {if}
else begin
gQuad.preference := onStack;
GenTree(op^.right);
gQuad.preference := onStack;
GenTree(op^.left);
GenImplied(m_sec);
GenImplied(m_pla);
GenNative(m_sbc_s, direct, 7, nil, 0);
GenNative(m_sta_s, direct, 7, nil, 0);
GenImplied(m_pla);
GenNative(m_sbc_s, direct, 7, nil, 0);
GenNative(m_sta_s, direct, 7, nil, 0);
GenImplied(m_pla);
GenNative(m_sbc_s, direct, 7, nil, 0);
GenNative(m_sta_s, direct, 7, nil, 0);
GenImplied(m_pla);
GenNative(m_sbc_s, direct, 7, nil, 0);
GenNative(m_sta_s, direct, 7, nil, 0);
gQuad.where := onStack;
end; {else}
end; {else}
end; {GenAdqSbq}
procedure GenCkp (op: icptr);
{ generate code for pc_ckp }
{ }
{ parameters: }
{ op - pc_ckp operation }
begin {GenCkp}
if op^.left^.opcode in [pc_lda,pc_lad,pc_lca,pc_lao] then
GenTree(op^.left)
else begin
gLong.preference := onStack;
GenTree(op^.left);
GenCall(98);
end; {else}
end; {GenCkp}
procedure GenCmp (op: icptr; rOpcode: pcodes; lb: integer);
{ generate code for pc_les, pc_leq, pc_grt or pc_geq }
{ }
{ parameters: }
{ op - operation }
{ rOpcode - Opcode that will use the result of the }
{ compare. If the result is used by a tjp or fjp, }
{ this procedure generated special code and does the }
{ branch internally. }
{ lb - For fjp, tjp, this is the label to branch to if }
{ the condition is satisfied. }
var
i: integer; {loop variable}
lab1,lab2,lab3,lab4: integer; {label numbers}
num: integer; {constant to compare to}
simple: boolean; {is this a simple case?}
alwaysFalse: boolean; {is the comparison always false?}
procedure Switch;
{ switch the operands }
var
nd: icptr; {used to switch nodes}
begin {Switch}
nd := op^.left;
op^.left := op^.right;
op^.right := nd;
end; {Switch}
procedure ReverseConditional;
{ Change tjp to an equivalent fjp, or vice versa. }
{ }
{ Note: assumes opcode is pc_geq or pc_grt. }
begin {ReverseConditional}
if rOpcode in [pc_tjp,pc_fjp] then begin
if op^.opcode = pc_geq then
op^.opcode := pc_grt
else
op^.opcode := pc_geq;
if rOpcode = pc_tjp then
rOpcode := pc_fjp
else
rOpcode := pc_tjp;
Switch;
end; {if}
end; {ReverseConditional}
function SimpleLongOp(op: icptr): boolean;
{ Is op an operation on cg(U)Long that can be done using the }
{ addressing modes of CPX? }
begin {SimpleLongOp}
SimpleLongOp :=
(op^.opcode = pc_ldc)
or (op^.opcode = pc_lao)
or ((op^.opcode = pc_lod) and (LabelToDisp(op^.r) + op^.q <= 253))
or ((op^.opcode = pc_ldo) and smallMemoryModel);
end; {SimpleLongOp}
begin {GenCmp}
{To reduce the number of possibilities that must be handled, pc_les }
{and pc_leq compares are reduced to their equivalent pc_grt and }
{pc_geq instructions. }
if op^.opcode = pc_les then begin
Switch;
op^.opcode := pc_grt;
end {if}
else if op^.opcode = pc_leq then begin
Switch;
op^.opcode := pc_geq;
end; {else if}
{To take advantage of shortcuts, switch operands if generating }
{for a tjp or fjp with a constant left operand. }
if op^.optype in [cgByte,cgUByte,cgWord,cgUWord] then
if op^.left^.opcode = pc_ldc then
ReverseConditional;
{Short cuts are available for single-word operands where the }
{right operand is a constant. }
if (op^.optype in [cgByte,cgUByte,cgWord,cgUWord]) and
(op^.right^.opcode = pc_ldc) then begin
GenTree(op^.left);
num := op^.right^.q;
{Convert x > N comparisons to x >= N+1, unless N is max value }
{(in which case x > N is always false). }
alwaysFalse := false;
if op^.opcode = pc_grt then begin
if ((op^.optype in [cgByte,cgWord]) and (num = 32767))
or ((op^.optype in [cgUByte,cgUWord]) and (num = -1)) then
alwaysFalse := true
else begin
op^.opcode := pc_geq;
num := num+1;
end; {else}
end; {if}
lab1 := GenLabel;
if rOpcode = pc_fjp then begin
if alwaysFalse then
GenNative(m_brl, longrelative, lb, nil, 0)
else if op^.optype in [cgByte,cgWord] then begin
if NeedsCondition(op^.left^.opcode) then
GenImpliedForFlags(m_tax);
if (num >= 0) and (num < 3) then begin
if num = 0 then
GenNative(m_bpl, relative, lab1, nil, 0)
else begin
lab2 := GenLabel;
GenNative(m_bmi, relative, lab2, nil, 0);
if num = 2 then
GenImplied(m_lsr_a);
GenNative(m_bne, relative, lab1, nil, 0);
GenLabUsedOnce(lab2);
end; {else}
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab1);
end {if (num >= 0) and (num < 3)}
else begin
lab2 := GenLabel;
if num > 0 then
GenNative(m_bmi, relative, lab1, nil, 0)
else
GenNative(m_bpl, relative, lab1, nil, 0);
GenNative(m_cmp_imm, immediate, num, nil, 0);
GenNative(m_bcs, relative, lab2, nil, 0);
if num > 0 then begin
GenLabUsedOnce(lab1);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab2);
end {if}
else begin
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab2);
GenLab(lab1);
end; {else}
end; {else if}
end {if}
else {if optype in [cgUByte,cgUWord] then} begin
if num <> 0 then begin
if num in [1,2] then begin
if num = 1 then
GenImpliedForFlags(m_tax)
else
GenImplied(m_lsr_a);
GenNative(m_bne, relative, lab1, nil, 0);
end {if}
else begin
GenNative(m_cmp_imm, immediate, num, nil, 0);
GenNative(m_bcs, relative, lab1, nil, 0);
end; {else}
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab1);
end; {if}
end; {else}
end {if rOpcode = pc_fjp}
else if rOpcode = pc_tjp then begin
if alwaysFalse then
{nothing to generate}
else if op^.optype in [cgByte,cgWord] then begin
if NeedsCondition(op^.left^.opcode) then
GenImpliedForFlags(m_tax);
if (num >= 0) and (num < 3) then begin
GenNative(m_bmi, relative, lab1, nil, 0);
if num > 0 then begin
if num = 2 then
GenImplied(m_lsr_a);
GenNative(m_beq, relative, lab1, nil, 0);
end; {if}
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab1);
end {if (num >= 0) and (num < 3)}
else begin
lab2 := GenLabel;
if num > 0 then
GenNative(m_bmi, relative, lab1, nil, 0)
else
GenNative(m_bpl, relative, lab1, nil, 0);
GenNative(m_cmp_imm, immediate, num, nil, 0);
GenNative(m_bcc, relative, lab2, nil, 0);
if num > 0 then begin
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab2);
GenLab(lab1);
end {if}
else begin
GenLabUsedOnce(lab1);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab2);
end; {else}
end; {else}
end {if}
else {if optype in [cgUByte,cgUWord] then} begin
if num <> 0 then begin
if num in [1,2] then begin
if num = 1 then
GenImpliedForFlags(m_tax)
else
GenImplied(m_lsr_a);
GenNative(m_beq, relative, lab1, nil, 0);
end {if}
else begin
GenNative(m_cmp_imm, immediate, num, nil, 0);
GenNative(m_bcc, relative, lab1, nil, 0);
end; {else}
end; {if}
GenNative(m_brl, longrelative, lb, nil, 0);
if num <> 0 then
GenLab(lab1);
end; {else}
end {if rOpcode = pc_tjp}
else if alwaysFalse then
GenNative(m_lda_imm, immediate, 0, nil, 0)
else if op^.optype in [cgByte,cgWord] then begin
lab2 := GenLabel;
GenNative(m_ldx_imm, immediate, 1, nil, 0);
GenImplied(m_sec);
GenNative(m_sbc_imm, immediate, num, nil, 0);
GenNative(m_bvc, relative, lab1, nil, 0);
GenImplied(m_ror_a);
GenLab(lab1);
GenNative(m_bpl, relative, lab2, nil, 0);
GenImplied(m_dex);
GenLab(lab2);
GenImplied(m_txa);
end {else if}
else begin
GenNative(m_cmp_imm, immediate, num, nil, 0);
GenNative(m_lda_imm, immediate, 0, nil, 0);
GenImplied(m_rol_a);
end; {else if}
end {if (op^.optype in [cgByte,cgUByte,cgWord,cgUWord]) and
(op^.right^.opcode = pc_ldc)}
{This section of code handles the cases where the above short }
{cuts cannot be used. }
else
case op^.optype of
cgByte,cgUByte,cgWord,cgUWord: begin
if ((op^.opcode = pc_grt) and (Complex(op^.left) <= Complex(op^.right)))
or (Complex(op^.right) and not Complex(op^.left)) then
ReverseConditional;
if Complex(op^.right) then begin
GenTree(op^.right);
if Complex(op^.left) then begin
GenImplied(m_pha);
GenTree(op^.left);
GenImplied(m_ply);
GenNative(m_sty_dir, direct, dworkLoc, nil, 0);
end {if}
else begin
GenNative(m_sta_dir, direct, dworkLoc, nil, 0);
GenTree(op^.left);
end; {else}
if not (rOpcode in [pc_fjp,pc_tjp]) then
GenNative(m_ldx_imm, immediate, 1, nil, 0);
if op^.optype in [cgByte,cgWord] then begin
GenImplied(m_sec);
GenNative(m_sbc_dir, direct, dworkLoc, nil, 0);
end {if}
else
GenNative(m_cmp_dir, direct, dworkLoc, nil, 0);
end {if}
else begin
GenTree(op^.left);
if not (rOpcode in [pc_fjp,pc_tjp]) then
GenNative(m_ldx_imm, immediate, 1, nil, 0);
if op^.optype in [cgByte,cgWord] then begin
GenImplied(m_sec);
OperA(m_sbc_imm, op^.right);
if op^.right^.opcode in [pc_lld,pc_lli,pc_gli,pc_gld] then
GenImplied(m_tay);
end {if}
else
OperA(m_cmp_imm, op^.right);
end; {else}
if rOpcode = pc_fjp then begin
lab2 := GenLabel;
if op^.opcode = pc_grt then begin
lab3 := GenLabel;
GenNative(m_beq, relative, lab3, nil, 0);
end; {if}
if op^.optype in [cgByte,cgWord] then begin
lab1 := GenLabel;
GenNative(m_bvc, relative, lab1, nil, 0);
GenImplied(m_ror_a);
GenLab(lab1);
GenNative(m_bpl, relative, lab2, nil, 0);
end {if}
else
GenNative(m_bcs, relative, lab2, nil, 0);
if op^.opcode = pc_grt then
GenLabUsedOnce(lab3);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab2);
end {if}
else if rOpcode = pc_tjp then begin
lab2 := GenLabel;
if op^.opcode = pc_grt then begin
lab3 := GenLabel;
GenNative(m_beq, relative, lab3, nil, 0);
end; {if}
if op^.optype in [cgByte,cgWord] then begin
lab1 := GenLabel;
GenNative(m_bvc, relative, lab1, nil, 0);
GenImplied(m_ror_a);
GenLab(lab1);
GenNative(m_bmi, relative, lab2, nil, 0);
end {if}
else
GenNative(m_bcc, relative, lab2, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab2);
if op^.opcode = pc_grt then
GenLab(lab3);
end {else if}
else begin
lab2 := GenLabel;
if op^.opcode = pc_grt then begin
lab3 := GenLabel;
GenNative(m_beq, relative, lab3, nil, 0);
end; {if}
if op^.optype in [cgByte,cgWord] then begin
lab1 := GenLabel;
GenNative(m_bvc, relative, lab1, nil, 0);
GenImplied(m_ror_a);
GenLab(lab1);
GenNative(m_bpl, relative, lab2, nil, 0);
end {if}
else
GenNative(m_bcs, relative, lab2, nil, 0);
if op^.opcode = pc_grt then
GenLab(lab3);
GenImplied(m_dex);
GenLab(lab2);
GenImplied(m_txa);
end; {else}
end; {case optype of cgByte,cgUByte,cgWord,cgUWord}
cgULong: begin
lab1 := GenLabel;
lab2 := GenLabel;
simple := false;
if SimpleLongOp(op^.right) then
simple := true
else if rOpcode in [pc_fjp,pc_tjp] then
if SimpleLongOp(op^.left) then begin
ReverseConditional;
simple := true;
end; {if}
if simple then begin
if op^.opcode = pc_grt then begin
if SimpleLongOp(op^.left) then
ReverseConditional;
if op^.opcode = pc_grt then
if op^.right^.opcode = pc_ldc then
if op^.right^.lval <> $ffffffff then begin
op^.right^.lval := op^.right^.lval + 1;
op^.opcode := pc_geq;
end; {if}
end; {if}
gLong.preference := A_X;
GenTree(op^.left);
if gLong.where = onStack then begin
GenImplied(m_pla);
GenImplied(m_plx);
end; {if}
if op^.opcode = pc_grt then
if not (rOpcode in [pc_fjp,pc_tjp]) then
GenNative(m_ldy_imm, immediate, 0, nil, 0);
with op^.right^ do
case opcode of
pc_ldc:
GenNative(m_cpx_imm, immediate, long(lval).msw, nil, 0);
pc_lao:
GenNative(m_cpx_imm, immediate, q, lab, shift16);
pc_lod:
GenNative(m_cpx_dir, direct, LabelToDisp(r)+q+2, nil, 0);
pc_ldo:
GenNative(m_cpx_abs, absolute, q+2, lab, 0);
end; {case}
GenNative(m_bne, relative, lab1, nil, 0);
with op^.right^ do
case opcode of
pc_ldc:
GenNative(m_cmp_imm, immediate, long(lval).lsw, nil, 0);
pc_lao:
GenNative(m_cmp_imm, immediate, q, lab, 0);
pc_lod:
GenNative(m_cmp_dir, direct, LabelToDisp(r)+q, nil, 0);
pc_ldo:
GenNative(m_cmp_abs, absolute, q, lab, 0);
end; {case}
GenLab(lab1);
if rOpcode = pc_fjp then begin
if op^.opcode = pc_grt then begin
lab3 := GenLabel;
GenNative(m_beq, relative, lab3, nil, 0);
end; {if}
GenNative(m_bcs, relative, lab2, nil, 0);
if op^.opcode = pc_grt then
GenLabUsedOnce(lab3);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab2);
end {if}
else if rOpcode = pc_tjp then begin
if op^.opcode = pc_grt then
GenNative(m_beq, relative, lab2, nil, 0);
GenNative(m_bcc, relative, lab2, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab2);
end {else if}
else if op^.opcode = pc_geq then begin
GenNative(m_lda_imm, immediate, 0, nil, 0);
GenImplied(m_rol_a);
end {else if}
else {if op^.opcode = pc_grt then} begin
GenNative(m_beq, relative, lab2, nil, 0);
GenNative(m_bcc, relative, lab2, nil, 0);
GenImplied(m_iny);
GenLab(lab2);
GenImplied(m_tya);
end; {else}
end {if}
else begin
gLong.preference := onStack;
GenTree(op^.right);
gLong.preference := A_X;
GenTree(op^.left);
if gLong.where = onStack then begin
GenImplied(m_ply);
GenImplied(m_pla);
end {if}
else begin
GenImplied(m_tay);
GenImplied(m_txa);
end; {else}
GenNative(m_ldx_imm, immediate, 1, nil, 0);
GenNative(m_cmp_s, direct, 3, nil, 0);
GenNative(m_bne, relative, lab1, nil, 0);
GenImplied(m_tya);
GenNative(m_cmp_s, direct, 1, nil, 0);
GenLab(lab1);
if op^.opcode = pc_grt then begin
lab3 := GenLabel;
GenNative(m_beq, relative, lab3, nil, 0);
end; {if}
GenNative(m_bcs, relative, lab2, nil, 0);
if op^.opcode = pc_grt then
GenLab(lab3);
GenImplied(m_dex);
GenLab(lab2);
GenImplied(m_pla);
GenImplied(m_pla);
GenImplied(m_txa);
if rOpcode = pc_fjp then begin
lab4 := GenLabel;
GenNative(m_bne, relative, lab4, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab4);
end {if}
else if rOpcode = pc_tjp then begin
lab4 := GenLabel;
GenNative(m_beq, relative, lab4, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab4);
end; {else if}
end; {else}
end;
cgReal,cgDouble,cgComp,cgExtended: begin
GenTree(op^.left);
GenTree(op^.right);
num := 31;
if op^.opcode = pc_geq then
GenCall(32)
else
GenCall(31);
if (rOpcode = pc_fjp) or (rOpcode = pc_tjp) then begin
lab1 := GenLabel;
if rOpcode = pc_fjp then
GenNative(m_bne, relative, lab1, nil, 0)
else
GenNative(m_beq, relative, lab1, nil, 0);
GenNative(m_brl,longrelative,lb,nil,0);
GenLab(lab1);
end; {if}
end; {case optype of cgReal..cgExtended}
cgLong: begin
gLong.preference := onStack;
GenTree(op^.left);
if op^.opcode = pc_geq then begin
gLong.preference := A_X;
GenTree(op^.right);
if gLong.where = onStack then begin
GenImplied(m_pla);
GenImplied(m_plx);
end; {if}
num := 30;
end {if}
else begin
gLong.preference := onStack;
GenTree(op^.right);
num := 29;
end; {else}
GenCall(num);
if (rOpcode = pc_fjp) or (rOpcode = pc_tjp) then begin
lab1 := GenLabel;
if rOpcode = pc_fjp then
GenNative(m_bne, relative, lab1, nil, 0)
else
GenNative(m_beq, relative, lab1, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab1);
end; {if}
end; {case optype of cgLong}
cgQuad: begin
if op^.opcode = pc_geq then begin
gQuad.preference := onStack;
GenTree(op^.left);
gQuad.preference := onStack;
GenTree(op^.right);
end {if}
else {if op^.opcode = pc_grt then} begin
gQuad.preference := onStack;
GenTree(op^.right);
gQuad.preference := onStack;
GenTree(op^.left);
end; {else}
GenCall(88);
if (rOpcode = pc_fjp) or (rOpcode = pc_tjp) then begin
lab1 := GenLabel;
if (rOpcode = pc_fjp) <> (op^.opcode = pc_grt) then
GenNative(m_bcs, relative, lab1, nil, 0)
else
GenNative(m_bcc, relative, lab1, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab1);
end {if}
else begin
if op^.opcode = pc_geq then begin
GenNative(m_lda_imm, immediate, 0, nil, 0);
GenImplied(m_rol_a);
end {if}
else {if op^.opcode = pc_grt then} begin
lab1 := GenLabel;
GenNative(m_lda_imm, immediate, 1, nil, 0);
GenNative(m_bcc, relative, lab1, nil, 0);
GenImplied(m_dea);
GenLab(lab1);
end; {else}
end; {else}
end; {case optype of cgQuad}
cgUQuad: begin
simple :=
SimplestQuadLoad(op^.left) and SimplestQuadLoad(op^.right)
and not volatile;
if not simple then begin
gQuad.preference := onStack;
GenTree(op^.left);
gQuad.preference := onStack;
GenTree(op^.right);
end; {if}
if op^.opcode = pc_geq then
GenNative(m_ldx_imm, immediate, 1, nil, 0)
else {if op^.opcode = pc_grt then}
GenNative(m_ldx_imm, immediate, 0, nil, 0);
lab1 := GenLabel;
lab2 := GenLabel;
if simple then begin
OpOnWordOfQuad(m_lda_imm, op^.left, 6);
OpOnWordOfQuad(m_cmp_imm, op^.right, 6);
GenNative(m_bne, relative, lab1, nil, 0);
OpOnWordOfQuad(m_lda_imm, op^.left, 4);
OpOnWordOfQuad(m_cmp_imm, op^.right, 4);
GenNative(m_bne, relative, lab1, nil, 0);
OpOnWordOfQuad(m_lda_imm, op^.left, 2);
OpOnWordOfQuad(m_cmp_imm, op^.right, 2);
GenNative(m_bne, relative, lab1, nil, 0);
OpOnWordOfQuad(m_lda_imm, op^.left, 0);
OpOnWordOfQuad(m_cmp_imm, op^.right, 0);
end {if}
else begin
GenNative(m_lda_s, direct, 15, nil, 0);
GenNative(m_cmp_s, direct, 7, nil, 0);
GenNative(m_bne, relative, lab1, nil, 0);
GenNative(m_lda_s, direct, 13, nil, 0);
GenNative(m_cmp_s, direct, 5, nil, 0);
GenNative(m_bne, relative, lab1, nil, 0);
GenNative(m_lda_s, direct, 11, nil, 0);
GenNative(m_cmp_s, direct, 3, nil, 0);
GenNative(m_bne, relative, lab1, nil, 0);
GenNative(m_lda_s, direct, 9, nil, 0);
GenNative(m_cmp_s, direct, 1, nil, 0);
end; {else}
GenLab(lab1);
if op^.opcode = pc_geq then begin
GenNative(m_bcs, relative, lab2, nil, 0);
GenImplied(m_dex);
end {if}
else begin {if op^.opcode = pc_grt then}
GenNative(m_bcc, relative, lab2, nil, 0);
GenNative(m_beq, relative, lab2, nil, 0);
GenImplied(m_inx);
end; {else}
GenLab(lab2);
if not simple then begin
GenImplied(m_tsc);
GenImplied(m_clc);
GenNative(m_adc_imm, immediate, 16, nil, 0);
GenImplied(m_tcs);
end; {if}
GenImplied(m_txa);
if rOpcode = pc_fjp then begin
lab3 := GenLabel;
GenNative(m_bne, relative, lab3, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab3);
end {if}
else if rOpcode = pc_tjp then begin
lab3 := GenLabel;
GenNative(m_beq, relative, lab3, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab3);
end; {else if}
end; {case optype of cgUQuad}
otherwise:
Error(cge1);
end; {case}
end; {GenCmp}
procedure GenCnv (op: icptr);
{ generate a pc_cnv instruction }
const {note: these constants list all legal }
{ conversions; others are ignored}
cReal = $06;
cDouble = $07;
cComp = $08;
cExtended = $09;
cVoid = $0B;
cLong = $04;
cULong = $05;
byteToWord = $02;
byteToUword = $03;
byteToLong = $04;
byteToUlong = $05;
byteToQuad = $0C;
byteToUQuad = $0D;
byteToReal = $06;
byteToDouble = $07;
ubyteToLong = $14;
ubyteToUlong = $15;
ubyteToQuad = $1C;
ubyteToUQuad = $1D;
ubyteToReal = $16;
ubyteToDouble = $17;
wordToByte = $20;
wordToUByte = $21;
wordToLong = $24;
wordToUlong = $25;
wordToQuad = $2C;
wordToUQuad = $2D;
wordToReal = $26;
wordToDouble = $27;
uwordToByte = $30;
uwordToUByte = $31;
uwordToLong = $34;
uwordToUlong = $35;
uwordToQuad = $3C;
uwordToUQuad = $3D;
uwordToReal = $36;
uwordToDouble = $37;
longTobyte = $40;
longToUbyte = $41;
longToWord = $42;
longToUword = $43;
longToQuad = $4C;
longToUQuad = $4D;
longToReal = $46;
longToDouble = $47;
longToVoid = $4B;
ulongTobyte = $50;
ulongToUbyte = $51;
ulongToWord = $52;
ulongToUword = $53;
ulongToQuad = $5C;
ulongToUQuad = $5D;
ulongToReal = $56;
ulongToDouble = $57;
ulongToVoid = $5B;
realTobyte = $60;
realToUbyte = $61;
realToWord = $62;
realToUword = $63;
realToLong = $64;
realToUlong = $65;
realToQuad = $6C;
realToUQuad = $6D;
realToVoid = $6B;
doubleTobyte = $70;
doubleToUbyte = $71;
doubleToWord = $72;
doubleToUword = $73;
doubleToLong = $74;
doubleToUlong = $75;
doubleToQuad = $7C;
doubleToUQuad = $7D;
quadToByte = $C0;
quadToUByte = $C1;
quadToWord = $C2;
quadToUword = $C3;
quadToLong = $C4;
quadToULong = $C5;
quadToReal = $C6;
quadToDouble = $C7;
quadToVoid = $CB;
uquadToByte = $D0;
uquadToUByte = $D1;
uquadToWord = $D2;
uquadToUword = $D3;
uquadToLong = $D4;
uquadToULong = $D5;
uquadToReal = $D6;
uquadToDouble = $D7;
uquadToVoid = $DB;
var
toRealType: baseTypeEnum; {real type converted to}
lab1: integer; {used for branches}
lLong: longType; {used to reserve gLong}
begin {GenCnv}
lLong := gLong;
gLong.preference := onStack+A_X+constant;
gLong.where := onStack;
if op^.q in [quadToVoid,uQuadToVoid] then
gQuad.preference := nowhere
else
gQuad.preference := onStack;
if ((op^.q & $00F0) >> 4) in [cDouble,cExtended,cComp] then begin
op^.q := (op^.q & $000F) | (cReal * 16);
end; {if}
if (op^.q & $000F) in [cDouble,cExtended,cComp,cReal] then begin
toRealType := baseTypeEnum(op^.q & $000F);
op^.q := (op^.q & $00F0) | cReal;
end {if}
else
toRealType := cgVoid;
GenTree(op^.left);
if op^.q in [wordToLong,wordToUlong] then begin
lab1 := GenLabel;
GenNative(m_ldx_imm, immediate, 0, nil, 0);
GenImpliedForFlags(m_tay);
GenNative(m_bpl, relative, lab1, nil, 0);
GenImplied(m_dex);
GenLab(lab1);
if (lLong.preference & A_X) <> 0 then
gLong.where := A_X
else begin
gLong.where := onStack;
GenImplied(m_phx);
GenImplied(m_pha);
end; {else}
end {if}
else if op^.q in [byteToLong,byteToUlong] then begin
lab1 := GenLabel;
GenNative(m_ldx_imm, immediate, 0, nil, 0);
GenNative(m_bit_imm, immediate, $0080, nil, 0);
GenNative(m_beq, relative, lab1, nil, 0);
GenImplied(m_dex);
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
GenLab(lab1);
if (lLong.preference & A_X) <> 0 then
gLong.where := A_X
else begin
gLong.where := onStack;
GenImplied(m_phx);
GenImplied(m_pha);
end; {else}
end {else if}
else if op^.q in [byteToWord,byteToUword] then begin
lab1 := GenLabel;
GenNative(m_bit_imm, immediate, $0080, nil, 0);
GenNative(m_beq, relative, lab1, nil, 0);
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
GenLab(lab1);
end {else if}
else if op^.q in [ubyteToLong,ubyteToUlong,uwordToLong,uwordToUlong] then
begin
if (lLong.preference & A_X) <> 0 then begin
gLong.where := A_X;
GenNative(m_ldx_imm, immediate, 0, nil, 0);
end {if}
else begin
gLong.where := onStack;
GenNative(m_pea, immediate, 0, nil, 0);
GenImplied(m_pha);
end; {else}
end {else if}
else if op^.q in [wordToUbyte,uwordToUbyte] then
GenNative(m_and_imm, immediate, $00FF, nil, 0)
else if op^.q in [wordToByte,uwordToByte] then begin
lab1 := GenLabel;
GenNative(m_and_imm, immediate, $00FF, nil, 0);
GenNative(m_bit_imm, immediate, $0080, nil, 0);
GenNative(m_beq, relative, lab1, nil, 0);
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
GenLab(lab1);
end {else if}
else if op^.q in [byteToReal,uByteToReal,wordToReal] then begin
GenCall(11);
toRealType := cgExtended;
end {else if}
else if op^.q = uwordToReal then begin
GenNative(m_ldx_imm, immediate, 0, nil, 0);
GenCall(12);
toRealType := cgExtended;
end {else if}
else if op^.q in [longToUbyte,ulongToUbyte] then begin
if gLong.where = A_X then
GenNative(m_and_imm, immediate, $00FF, nil, 0)
else if gLong.where = constant then
GenNative(m_lda_imm, immediate, long(gLong.lval).lsw & $00FF, nil, 0)
else {if gLong.where = onStack then} begin
GenImplied(m_pla);
GenImplied(m_plx);
GenNative(m_and_imm, immediate, $00FF, nil, 0);
end; {else if}
end {else if}
else if op^.q in [longToByte,ulongToByte] then begin
if gLong.where = A_X then
GenNative(m_and_imm, immediate, $00FF, nil, 0)
else if gLong.where = constant then
GenNative(m_lda_imm, immediate, long(gLong.lval).lsw & $00FF, nil, 0)
else {if gLong.where = onStack then} begin
GenImplied(m_pla);
GenImplied(m_plx);
GenNative(m_and_imm, immediate, $00FF, nil, 0);
end; {else if}
lab1 := GenLabel;
GenNative(m_bit_imm, immediate, $0080, nil, 0);
GenNative(m_beq, relative, lab1, nil, 0);
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
GenLab(lab1);
end {else if}
else if op^.q in [longToWord,longToUword,ulongToWord,ulongToUword] then begin
{Note: if the result is in A_X, no further action is needed}
if gLong.where = constant then
GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0)
else if gLong.where = onStack then begin
GenImplied(m_pla);
GenImplied(m_plx);
end; {else if}
end {else if}
else if op^.q in [longToReal,uLongToReal] then begin
if gLong.where = constant then begin
GenNative(m_lda_imm, immediate, long(gLong.lval).lsw, nil, 0);
GenNative(m_ldx_imm, immediate, long(gLong.lval).msw, nil, 0);
end {if}
else if gLong.where = onStack then begin
GenImplied(m_pla);
GenImplied(m_plx);
end; {else if}
if op^.q = longToReal then
GenCall(12)
else
GenCall(13);
if toRealType <> cgReal then
toRealType := cgExtended;
end {else if}
else if op^.q = realToWord then
GenCall(14)
else if op^.q = realToUbyte then begin
GenCall(14);
GenNative(m_and_imm, immediate, $00FF, nil, 0);
end {else if}
else if op^.q = realToByte then begin
lab1 := GenLabel;
GenCall(14);
GenNative(m_and_imm, immediate, $00FF, nil, 0);
GenNative(m_bit_imm, immediate, $0080, nil, 0);
GenNative(m_beq, relative, lab1, nil, 0);
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
GenLab(lab1);
end {else if}
else if op^.q = realToUword then
GenCall(15)
else if op^.q in [realToLong,realToUlong] then begin
if op^.q & $00FF = 5 then
GenCall(17)
else
GenCall(16);
if (lLong.preference & A_X) <> 0 then
gLong.where := A_X
else begin
gLong.where := onStack;
GenImplied(m_phx);
GenImplied(m_pha);
end; {else}
end {else if}
else if op^.q = realToVoid then begin
GenImplied(m_tsc);
GenImplied(m_clc);
GenNative(m_adc_imm, immediate, 10, nil, 0);
GenImplied(m_tcs);
end {else if}
else if op^.q in [longToVoid,ulongToVoid] then begin
if gLong.where = onStack then begin
GenImplied(m_pla);
GenImplied(m_plx);
gLong.where := A_X;
end; {if}
end {else if}
else if op^.q in [ubyteToQuad,ubyteToUQuad,uwordToQuad,uwordToUQuad] then begin
GenNative(m_ldy_imm, immediate, 0, nil, 0);
GenImplied(m_phy);
GenImplied(m_phy);
GenImplied(m_phy);
GenImplied(m_pha);
gQuad.where := onStack;
end {else if}
else if op^.q in [byteToQuad,byteToUQuad] then begin
lab1 := GenLabel;
GenNative(m_ldx_imm, immediate, 0, nil, 0);
GenNative(m_bit_imm, immediate, $0080, nil, 0);
GenNative(m_beq, relative, lab1, nil, 0);
GenImplied(m_dex);
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
GenLab(lab1);
GenImplied(m_phx);
GenImplied(m_phx);
GenImplied(m_phx);
GenImplied(m_pha);
gQuad.where := onStack;
end {else if}
else if op^.q in [wordToQuad,wordToUQuad] then begin
lab1 := GenLabel;
GenNative(m_ldx_imm, immediate, 0, nil, 0);
GenImpliedForFlags(m_tay);
GenNative(m_bpl, relative, lab1, nil, 0);
GenImplied(m_dex);
GenLab(lab1);
GenImplied(m_phx);
GenImplied(m_phx);
GenImplied(m_phx);
GenImplied(m_pha);
gQuad.where := onStack;
end {else if}
else if op^.q in [ulongToQuad,ulongToUQuad] then begin
if gLong.where = A_X then begin
GenNative(m_pea, immediate, 0, nil, 0);
GenNative(m_pea, immediate, 0, nil, 0);
GenImplied(m_phx);
GenImplied(m_pha);
end {if}
else if gLong.where = constant then begin
GenNative(m_pea, immediate, 0, nil, 0);
GenNative(m_pea, immediate, 0, nil, 0);
GenNative(m_pea, immediate, long(gLong.lval).msw, nil, 0);
GenNative(m_pea, immediate, long(gLong.lval).lsw, nil, 0);
end {else if}
else {if gLong.where = onStack then} begin
GenImplied(m_pla);
GenImplied(m_plx);
GenNative(m_pea, immediate, 0, nil, 0);
GenNative(m_pea, immediate, 0, nil, 0);
GenImplied(m_phx);
GenImplied(m_pha);
end; {else}
gQuad.where := onStack;
end {else if}
else if op^.q in [longToQuad,longToUQuad] then begin
if gLong.where = constant then begin
if glong.lval < 0 then begin
GenNative(m_pea, immediate, -1, nil, 0);
GenNative(m_pea, immediate, -1, nil, 0);
GenNative(m_pea, immediate, long(gLong.lval).msw, nil, 0);
GenNative(m_pea, immediate, long(gLong.lval).lsw, nil, 0);
end {if}
else begin
GenNative(m_pea, immediate, 0, nil, 0);
GenNative(m_pea, immediate, 0, nil, 0);
GenNative(m_pea, immediate, long(gLong.lval).msw, nil, 0);
GenNative(m_pea, immediate, long(gLong.lval).lsw, nil, 0);
end; {else}
end {if}
else begin
GenNative(m_ldy_imm, immediate, 0, nil, 0);
if gLong.where = onStack then begin
GenImplied(m_pla);
GenImplied(m_plx);
end {if}
else {if gLong.where = A_X then}
GenNative(m_cpx_imm, immediate, 0, nil, 0);
lab1 := GenLabel;
GenNative(m_bpl, relative, lab1, nil, 0);
GenImplied(m_dey);
GenLab(lab1);
GenImplied(m_phy);
GenImplied(m_phy);
GenImplied(m_phx);
GenImplied(m_pha);
end; {else}
gQuad.where := onStack;
end {else if}
else if op^.q = realToQuad then begin
GenCall(89);
gQuad.where := onStack;
end {else if}
else if op^.q = realToUQuad then begin
GenCall(90);
gQuad.where := onStack;
end {else if}
else if op^.q in [quadToWord,uquadToWord,quadToUWord,uquadToUWord] then begin
GenImplied(m_pla);
GenImplied(m_plx);
GenImplied(m_plx);
GenImplied(m_plx);
end {else if}
else if op^.q in [quadToUByte,uquadToUByte] then begin
GenImplied(m_pla);
GenImplied(m_plx);
GenImplied(m_plx);
GenImplied(m_plx);
GenNative(m_and_imm, immediate, $00FF, nil, 0);
end {else if}
else if op^.q in [quadToByte,uquadToByte] then begin
GenImplied(m_pla);
GenImplied(m_plx);
GenImplied(m_ply);
GenImplied(m_ply);
GenNative(m_and_imm, immediate, $00FF, nil, 0);
lab1 := GenLabel;
GenNative(m_bit_imm, immediate, $0080, nil, 0);
GenNative(m_beq, relative, lab1, nil, 0);
GenNative(m_ora_imm, immediate, $FF00, nil, 0);
GenLab(lab1);
end {else if}
else if op^.q in [quadToLong,uquadToLong,quadToULong,uquadToULong] then begin
GenImplied(m_pla);
GenImplied(m_plx);
GenImplied(m_ply);
GenImplied(m_ply);
if (lLong.preference & A_X) <> 0 then
gLong.where := A_X
else begin
gLong.where := onStack;
GenImplied(m_phx);
GenImplied(m_pha);
end; {else}
end {else if}
else if op^.q in [quadToVoid,uquadToVoid] then begin
if gQuad.where = onStack then begin
GenImplied(m_tsc);
GenImplied(m_clc);
GenNative(m_adc_imm, immediate, 8, nil, 0);
GenImplied(m_tcs);
end; {if}
end {else if}
else if op^.q = quadToReal then
GenCall(83)
else if op^.q = uquadToReal then
GenCall(84)
else if (op^.q & $000F) = cVoid then
{do nothing}
else if (op^.q & $000F) in [cLong,cULong] then
if (lLong.preference & gLong.where) = 0 then begin
if gLong.where = constant then begin
GenNative(m_pea, immediate, long(gLong.lval).msw, nil, 0);
GenNative(m_pea, immediate, long(gLong.lval).lsw, nil, 0);
end {if}
else if gLong.where = A_X then begin
GenImplied(m_phx);
GenImplied(m_pha);
end; {else if}
gLong.where := onStack;
end; {if}
if toRealType <> cgVoid then
case toRealType of
cgReal: GenCall(91);
cgDouble: GenCall(92);
cgComp: GenCall(93);
cgExtended: ;
end; {case}
end; {GenCnv}
procedure GenEquNeq (op: icptr; opcode: pcodes; lb: integer);
{ generate a pc_equ or pc_neq instruction }
{ }
{ parameters: }
{ op - node to generate the compare for }
{ opcode - Opcode that will use the result of the compare. }
{ If the result is used by a tjp or fjp, this procedure }
{ generates special code and does the branch internally. }
{ lb - For fjp, tjp, this is the label to branch to if }
{ the condition is satisfied. }
var
nd: icptr; {work node}
num: integer; {constant to compare to}
lab1,lab2,lab3: integer; {label numbers}
bne: integer; {instruction for a pc_equ bne branch}
beq: integer; {instruction for a pc_equ beq branch}
leftOp,rightOp: pcodes; {opcode codes to left, right}
procedure DoOr (op: icptr);
{ or the two halves of a four byte value }
{ }
{ parameters: }
{ operand to or }
var
disp: integer; {disp of value on stack frame}
begin {DoOr}
with op^ do begin
if opcode = pc_ldo then begin
if smallMemoryModel then begin
GenNative(m_lda_abs, absolute, q, lab, 0);
GenNative(m_ora_abs, absolute, q+2, lab, 0);
end {if}
else begin
GenNative(m_lda_long, longabsolute, q, lab, 0);
GenNative(m_ora_long, longabsolute, q+2, lab, 0);
end; {else}
end {if}
else begin
disp := LabelToDisp(r) + q;
if disp < 254 then begin
GenNative(m_lda_dir, direct, disp, nil, 0);
GenNative(m_ora_dir, direct, disp+2, nil, 0);
end {if}
else begin
GenNative(m_ldx_imm, immediate, disp, nil, 0);
GenNative(m_lda_dirX, direct, 0, nil, 0);
GenNative(m_ora_dirX, direct, 2, nil, 0);
end; {else}
end; {else}
end; {with}
end; {DoOr}
procedure DoCmp (op: icPtr);
{ compare a long value in A_X to a local or global scalar }
{ }
{ parameters: }
{ op - value to compare to }
var
disp: integer; {disp of value on stack frame}
lab1: integer; {label numbers}
begin {DoCmp}
lab1 := GenLabel;
with op^ do begin
if opcode = pc_ldo then begin
if smallMemoryModel then begin
GenNative(m_cmp_abs, absolute, q, lab, 0);
GenNative(m_bne, relative, lab1, nil, 0);
GenNative(m_cpx_abs, absolute, q+2, lab, 0);
end {if}
else begin
GenNative(m_cmp_long, longabsolute, q, lab, 0);
GenNative(m_bne, relative, lab1, nil, 0);
GenImplied(m_txa);
GenNative(m_cmp_long, longabsolute, q+2, lab, 0);
end; {else}
end {if}
else begin
disp := LabelToDisp(r) + q;
if disp < 254 then begin
GenNative(m_cmp_dir, direct, disp, nil, 0);
GenNative(m_bne, relative, lab1, nil, 0);
GenNative(m_cpx_dir, direct, disp+2, nil, 0);
end {if}
else begin
GenImplied(m_txy);
GenNative(m_ldx_imm, immediate, disp, nil, 0);
GenNative(m_cmp_dirX, direct, 0, nil, 0);
GenNative(m_bne, relative, lab1, nil, 0);
GenImplied(m_tya);
GenNative(m_cmp_dirX, direct, 2, nil, 0);
end; {else}
end; {else}
GenLab(lab1);
end; {with}
end; {DoCmp}
begin {GenEquNeq}
if op^.opcode = pc_equ then begin
bne := m_bne;
beq := m_beq;
end {if}
else begin
bne := m_beq;
beq := m_bne;
end; {else}
if op^.left^.opcode in [pc_lod,pc_ldo] then begin
nd := op^.left;
op^.left := op^.right;
op^.right := nd;
end; {if}
if op^.left^.opcode = pc_ldc then begin
nd := op^.left;
op^.left := op^.right;
op^.right := nd;
end; {if}
leftOp := op^.left^.opcode; {set op codes for fast access}
rightOp := op^.right^.opcode;
if (op^.optype in [cgByte,cgUByte,cgWord,cgUWord]) and
(rightOp = pc_ldc) then begin
GenTree(op^.left);
num := op^.right^.q;
lab1 := GenLabel;
if opcode in [pc_fjp,pc_tjp] then begin
if num = 0 then begin
if NeedsCondition(leftOp) then
GenImpliedForFlags(m_tay);
end {if}
else if num = 1 then
GenImplied(m_dea)
else
GenNative(m_cmp_imm, immediate, num, nil, 0);
if opcode = pc_fjp then
GenNative(beq, relative, lab1, nil, 0)
else
GenNative(bne, relative, lab1, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab1);
end {if}
else begin
if num <> 0 then
GenNative(m_eor_imm, immediate, num, nil, 0)
else if NeedsCondition(leftOp) then
GenImpliedForFlags(m_tax);
GenNative(m_beq, relative, lab1, nil, 0);
if op^.opcode = pc_equ then begin
GenNative(m_lda_imm, immediate, $ffff, nil, 0);
GenLab(lab1);
GenImplied(m_ina);
end {if}
else begin
GenNative(m_lda_imm, immediate, 1, nil, 0);
GenLab(lab1);
end; {else}
end; {else}
end {if}
else if (op^.optype in [cgLong,cgULong]) and (leftOp in [pc_ldo,pc_lod])
and (rightOp = pc_ldc) and (op^.right^.lval = 0) then begin
if opcode in [pc_fjp,pc_tjp] then begin
DoOr(op^.left);
lab1 := GenLabel;
if opcode = pc_fjp then
GenNative(beq, relative, lab1, nil, 0)
else
GenNative(bne, relative, lab1, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab1);
end {if}
else begin
lab1 := GenLabel;
DoOr(op^.left);
GenNative(m_beq, relative, lab1, nil, 0);
if op^.opcode = pc_equ then begin
GenNative(m_lda_imm, immediate, $ffff, nil, 0);
GenLab(lab1);
GenImplied(m_ina);
end {if}
else begin
GenNative(m_lda_imm, immediate, 1, nil, 0);
GenLab(lab1);
end; {else}
end; {else}
end {else if}
else if (op^.optype in [cgLong,cgULong]) and (rightOp in [pc_ldo,pc_lod]) then begin
gLong.preference := A_X;
GenTree(op^.left);
if gLong.where = onStack then begin
GenImplied(m_pla);
GenImplied(m_plx);
end; {if}
if opcode in [pc_fjp,pc_tjp] then begin
DoCmp(op^.right);
lab1 := GenLabel;
if opcode = pc_fjp then
GenNative(beq, relative, lab1, nil, 0)
else
GenNative(bne, relative, lab1, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab1);
end {if}
else begin
lab1 := GenLabel;
lab2 := GenLabel;
DoCmp(op^.right);
GenNative(bne, relative, lab1, nil, 0);
GenNative(m_lda_imm, immediate, 1, nil, 0);
GenNative(m_bra, relative, lab2, nil, 0);
GenLab(lab1);
GenNative(m_lda_imm, immediate, 0, nil, 0);
GenLab(lab2);
end; {else}
end {else if}
else
case op^.optype of
cgByte,cgUByte,cgWord,cgUWord: begin
if not Complex(op^.left) then
if Complex(op^.right) then begin
nd := op^.left;
op^.left := op^.right;
op^.right := nd;
end; {if}
GenTree(op^.left);
if Complex(op^.right) or (not (opcode in [pc_fjp,pc_tjp])) then begin
GenImplied(m_pha);
GenTree(op^.right);
GenNative(m_eor_s, direct, 1, nil, 0);
GenImplied(m_plx);
GenImplied(m_tax);
if opcode in [pc_fjp,pc_tjp] then begin
lab1 := GenLabel;
if opcode = pc_fjp then
GenNative(beq, relative, lab1, nil, 0)
else
GenNative(bne, relative, lab1, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab1);
end {if}
else begin
lab1 := GenLabel;
GenNative(m_beq, relative, lab1, nil, 0);
if op^.opcode = pc_equ then begin
GenNative(m_lda_imm, immediate, $ffff, nil, 0);
GenLab(lab1);
GenImplied(m_ina);
end {if}
else begin
GenNative(m_lda_imm, immediate, 1, nil, 0);
GenLab(lab1);
end; {else}
end; {else}
end {if}
else begin
OperA(m_cmp_imm, op^.right);
lab1 := GenLabel;
if opcode = pc_fjp then
GenNative(beq, relative, lab1, nil, 0)
else
GenNative(bne, relative, lab1, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab1);
end; {else}
end; {case optype of cgByte,cgUByte,cgWord,cgUWord}
cgLong,cgULong: begin
gLong.preference := onStack;
GenTree(op^.left);
gLong.preference := A_X;
GenTree(op^.right);
if gLong.where = onStack then begin
GenImplied(m_pla);
GenImplied(m_plx);
end; {if}
GenNative(m_ldy_imm, immediate, 1, nil, 0);
GenNative(m_cmp_s, direct, 1, nil, 0);
lab1 := GenLabel;
GenNative(m_beq, relative, lab1, nil, 0);
GenImplied(m_dey);
GenLab(lab1);
GenImplied(m_txa);
GenNative(m_cmp_s, direct, 3, nil, 0);
lab1 := GenLabel;
GenNative(m_beq, relative, lab1, nil, 0);
GenNative(m_ldy_imm, immediate, 0, nil, 0);
GenLab(lab1);
GenImplied(m_pla);
GenImplied(m_pla);
GenImplied(m_tya);
if opcode in [pc_fjp,pc_tjp] then begin
lab1 := GenLabel;
if opcode = pc_fjp then
GenNative(bne, relative, lab1, nil, 0)
else
GenNative(beq, relative, lab1, nil, 0);
GenNative(m_brl, longrelative, lb, nil, 0);
GenLab(lab1);
end {if}
else if op^.opcode = pc_neq then
GenNative(m_eor_imm, immediate, 1, nil, 0);
end; {case optype of cgLong,cgULong}
cgReal,cgDouble,cgComp,cgExtended: begin
GenTree(op^.left);
GenTree(op^.right);
GenCall(36);
if opcode in [pc_fjp,pc_tjp] then begin
lab1 := GenLabel;