mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-09-10 11:54:44 +00:00
19683706cc
Previously, the assembly-level optimizations applied to code in asm statements. In many cases, this was fine (and could even do useful optimizations), but occasionally the optimizations could be invalid. This was especially the case if the assembly involved tricky things like self-modifying code. To avoid these problems, this patch makes the assembly optimizers ignore code from asm statements, so it is always emitted as-is, without any changes. This fixes #34.
7647 lines
247 KiB
ObjectPascal
7647 lines
247 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);
|
|
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_lor,pc_lnd,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}
|
|
lLong: longType; {used to reserve gLong}
|
|
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. }
|
|
|
|
var
|
|
load: icptr; {left opcode}
|
|
|
|
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;
|
|
lLong := gLong;
|
|
|
|
{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 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}
|
|
|
|
begin {GenCmp}
|
|
{To reduct 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
|
|
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}
|
|
|
|
{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 begin
|
|
lab2 := GenLabel;
|
|
GenNative(m_bmi, relative, lab2, nil, 0);
|
|
for i := 1 to num do
|
|
GenImplied(m_dea);
|
|
end; {if}
|
|
GenNative(m_bpl, relative, lab1, nil, 0);
|
|
if num <> 0 then
|
|
GenLab(lab2);
|
|
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
|
|
GenLab(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
|
|
GenNative(m_cmp_imm, immediate, num, nil, 0);
|
|
GenNative(m_bcs, relative, lab1, nil, 0);
|
|
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
|
|
for i := 1 to num do
|
|
GenImplied(m_dea);
|
|
GenNative(m_bmi, 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
|
|
GenLab(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
|
|
GenNative(m_cmp_imm, immediate, num, nil, 0);
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
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_bvs, relative, lab1, nil, 0);
|
|
GenNative(m_eor_imm, immediate, $8000, nil, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_bmi, 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 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_bvs, relative, lab1, nil, 0);
|
|
GenNative(m_eor_imm, immediate, $8000, nil, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_bmi, relative, lab2, nil, 0);
|
|
end {if}
|
|
else
|
|
GenNative(m_bcs, relative, lab2, nil, 0);
|
|
if op^.opcode = pc_grt then
|
|
GenLab(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_bvs, relative, lab1, nil, 0);
|
|
GenNative(m_eor_imm, immediate, $8000, nil, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_bpl, 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_bvs, relative, lab1, nil, 0);
|
|
GenNative(m_eor_imm, immediate, $8000, nil, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_bmi, 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
|
|
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}
|
|
lab1 := GenLabel;
|
|
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);
|
|
lab2 := GenLabel;
|
|
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;
|
|
|
|
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}
|
|
lLong: longType; {local long value information}
|
|
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
|
|
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
|
|
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
|
|
GenNative(m_cmp_imm, immediate, num, nil, 0)
|
|
else if NeedsCondition(leftOp) then
|
|
GenImpliedForFlags(m_tay);
|
|
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
|
|
GenNative(m_ldx_imm, immediate, 0, nil, 0);
|
|
GenNative(m_cmp_imm, immediate, num, nil, 0);
|
|
GenNative(bne, relative, lab1, nil, 0);
|
|
GenImplied(m_inx);
|
|
GenLab(lab1);
|
|
GenImplied(m_txa);
|
|
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 if op^.opcode = pc_equ then begin
|
|
lab1 := GenLabel;
|
|
lab2 := GenLabel;
|
|
DoOr(op^.left);
|
|
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 if}
|
|
else {if op^.opcode = pc_neq then} begin
|
|
lab1 := GenLabel;
|
|
DoOr(op^.left);
|
|
GenNative(m_beq, relative, lab1, nil, 0);
|
|
GenNative(m_lda_imm, immediate, 1, nil, 0);
|
|
GenLab(lab1);
|
|
end; {else if}
|
|
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);
|
|
GenImplied(m_sec);
|
|
GenNative(m_sbc_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);
|
|
GenNative(m_lda_imm, immediate, 1, nil, 0);
|
|
GenLab(lab1);
|
|
if op^.opcode = pc_equ then
|
|
GenNative(m_eor_imm, immediate, 1, nil, 0);
|
|
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);
|
|
lLong := gLong;
|
|
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;
|
|
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 cgReal..cgExtended}
|
|
|
|
cgQuad,cgUQuad: begin
|
|
if SimpleQuadLoad(op^.left) and (op^.right^.opcode = pc_ldc)
|
|
and (op^.right^.qval.hi = 0) and (op^.right^.qval.lo = 0) then begin
|
|
lab1 := GenLabel;
|
|
OpOnWordOfQuad(m_lda_imm, op^.left, 0);
|
|
if not volatile then
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
OpOnWordOfQuad(m_ora_imm, op^.left, 2);
|
|
OpOnWordOfQuad(m_ora_imm, op^.left, 4);
|
|
OpOnWordOfQuad(m_ora_imm, op^.left, 6);
|
|
GenLab(lab1);
|
|
end {if}
|
|
else if SimpleQuadLoad(op^.left) and SimpleQuadLoad(op^.right)
|
|
and not volatile then begin
|
|
lab1 := GenLabel;
|
|
OpOnWordOfQuad(m_lda_imm, op^.left, 0);
|
|
OpOnWordOfQuad(m_eor_imm, op^.right, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
OpOnWordOfQuad(m_lda_imm, op^.left, 2);
|
|
OpOnWordOfQuad(m_eor_imm, op^.right, 2);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
OpOnWordOfQuad(m_lda_imm, op^.left, 4);
|
|
OpOnWordOfQuad(m_eor_imm, op^.right, 4);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
OpOnWordOfQuad(m_lda_imm, op^.left, 6);
|
|
OpOnWordOfQuad(m_eor_imm, op^.right, 6);
|
|
GenLab(lab1);
|
|
end {if}
|
|
else begin
|
|
gQuad.preference := onStack;
|
|
GenTree(op^.left);
|
|
gQuad.preference := onStack;
|
|
GenTree(op^.right);
|
|
|
|
lab1 := GenLabel;
|
|
lab2 := GenLabel;
|
|
GenImplied(m_pla);
|
|
GenImplied(m_plx);
|
|
GenImplied(m_ply);
|
|
GenNative(m_eor_s, direct, 3, nil, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
GenImplied(m_txa);
|
|
GenNative(m_eor_s, direct, 5, nil, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
GenImplied(m_tya);
|
|
GenNative(m_eor_s, direct, 7, nil, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
GenImplied(m_pla);
|
|
GenNative(m_eor_s, direct, 7, nil, 0);
|
|
GenNative(m_bra, relative, lab2, nil, 0);
|
|
GenLab(lab1);
|
|
GenImplied(m_plx);
|
|
GenLab(lab2);
|
|
GenImplied(m_tax);
|
|
|
|
GenImplied(m_tsc);
|
|
GenImplied(m_clc);
|
|
GenNative(m_adc_imm, immediate, 8, nil, 0);
|
|
GenImplied(m_tcs);
|
|
|
|
GenImplied(m_txa);
|
|
end; {else}
|
|
|
|
if opcode in [pc_fjp,pc_tjp] then begin
|
|
lab3 := GenLabel;
|
|
if opcode = pc_fjp then
|
|
GenNative(beq, relative, lab3, nil, 0)
|
|
else
|
|
GenNative(bne, relative, lab3, nil, 0);
|
|
GenNative(m_brl, longrelative, lb, nil, 0);
|
|
GenLab(lab3);
|
|
end {if}
|
|
else begin
|
|
lab3 := GenLabel;
|
|
GenNative(m_beq, relative, lab3, nil, 0);
|
|
GenNative(m_lda_imm, immediate, 1, nil, 0);
|
|
GenLab(lab3);
|
|
if op^.opcode = pc_equ then
|
|
GenNative(m_eor_imm, immediate, 1, nil, 0);
|
|
end; {else}
|
|
end; {case optype of cgQuad,cgUQuad}
|
|
|
|
otherwise:
|
|
Error(cge1);
|
|
end; {case}
|
|
end; {GenEquNeq}
|
|
|
|
|
|
procedure GenGilGliGdlGld (op: icptr);
|
|
|
|
{ Generate code for a pc_gil, pc_gli, pc_gdl or pc_gld }
|
|
|
|
var
|
|
lab1: integer; {branch point}
|
|
lab: stringPtr; {op^.lab}
|
|
opcode: pcodes; {op^.opcode}
|
|
q: integer; {op^.q}
|
|
|
|
|
|
procedure DoGIncDec (opcode: pcodes; lab: stringPtr; p, q: integer);
|
|
|
|
{ Do a decrement or increment on a global four byte value }
|
|
{ }
|
|
{ parameters }
|
|
{ opcode - operation code }
|
|
{ lab - label }
|
|
{ q - disp to value }
|
|
{ p - number to ind/dec by }
|
|
|
|
var
|
|
lab1: integer; {branch point}
|
|
|
|
begin {DoGIncDec}
|
|
if smallMemoryModel then begin
|
|
if opcode in [pc_gil,pc_gli] then begin
|
|
lab1 := GenLabel;
|
|
if p = 1 then begin
|
|
GenNative(m_inc_abs, absolute, q, lab, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_clc);
|
|
GenNative(m_lda_abs, absolute, q, lab, 0);
|
|
GenNative(m_adc_imm, immediate, p, nil, 0);
|
|
GenNative(m_sta_abs, absolute, q, lab, 0);
|
|
GenNative(m_bcc, relative, lab1, nil, 0);
|
|
end; {else}
|
|
GenNative(m_inc_abs, absolute, q+2, lab, 0);
|
|
GenLab(lab1);
|
|
end {if}
|
|
else {if opcode in [pc_gdl,pc_gld] then} begin
|
|
lab1 := GenLabel;
|
|
if p = 1 then begin
|
|
GenNative(m_lda_abs, absolute, q, lab, 0);
|
|
GenNative(m_bne, relative, lab1, nil, 0);
|
|
GenNative(m_dec_abs, absolute, q+2, lab, 0);
|
|
GenLab(lab1);
|
|
GenNative(m_dec_abs, absolute, q, lab, 0);
|
|
end {if}
|
|
else begin
|
|
GenImplied(m_sec);
|
|
GenNative(m_lda_abs, absolute, q, lab, 0);
|
|
GenNative(m_sbc_imm, immediate, p, nil, 0);
|
|
GenNative(m_sta_abs, absolute, q, lab, 0);
|
|
GenNative(m_bcs, relative, lab1, nil, 0);
|
|
GenNative(m_dec_abs, absolute, q+2, lab, 0);
|